[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 14:46:34 UTC 2010
The following commit has been merged in the master branch:
commit 73fc47c376669bad2574dcacf9b3e024bf3ab850
Author: John Goerzen <jgoerzen at complete.org>
Date: Mon Nov 15 06:09:10 2004 +0100
Checkpointing
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.5--patch-37)
diff --git a/ChangeLog b/ChangeLog
index 05103ca..be68ac4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,23 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.5
#
+2004-11-14 23:09:10 GMT John Goerzen <jgoerzen at complete.org> patch-37
+
+ Summary:
+ Checkpointing
+ Revision:
+ missingh--head--0.5--patch-37
+
+
+ removed files:
+ libsrc/MissingH/Printf/Parser.lhs
+
+ modified files:
+ ChangeLog Makefile libsrc/MissingH/Printf.hs
+ libsrc/MissingH/Printf/Printer.lhs
+ libsrc/MissingH/Printf/Types.lhs
+
+
2004-11-14 05:22:45 GMT John Goerzen <jgoerzen at complete.org> patch-36
Summary:
diff --git a/Makefile b/Makefile
index 0064861..773081c 100644
--- a/Makefile
+++ b/Makefile
@@ -17,8 +17,11 @@
SOURCES := $(wildcard libsrc/MissingH/*.hs) \
$(wildcard libsrc/MissingH/*/*.hs) \
- $(wildcard libsrc/MissingH/*/*/*.hs)
-OBJS := $(SOURCES:.hs=.o)
+ $(wildcard libsrc/MissingH/*/*.lhs) \
+ $(wildcard libsrc/MissingH/*/*/*.hs) \
+ $(wildcard libsrc/MissingH/*/*/*.lhs)
+O1 := $(SOURCES:.hs=.o)
+OBJS := $(O1:.lhs=.o)
all: libmissingH.a
@@ -32,6 +35,10 @@ libmissingH.a: $(OBJS)
%.o: %.hs
ghc -fglasgow-exts -ilibsrc --make `echo $< | sed -e s,libsrc/,, -e s,.hs$$,, -e s,/,.,g`
+%.o: %.lhs
+ ghc -fglasgow-exts -ilibsrc --make `echo $< | sed -e s,libsrc/,, -e s,.lhs$$,, -e s,/,.,g`
+
+
doc:
-rm -rf html
mkdir html
diff --git a/libsrc/MissingH/Printf.hs b/libsrc/MissingH/Printf.hs
index c512fe4..96c3dea 100644
--- a/libsrc/MissingH/Printf.hs
+++ b/libsrc/MissingH/Printf.hs
@@ -51,48 +51,12 @@ module MissingH.Printf(-- * Variable-Argument Ouptut
import MissingH.Str
import Data.List
import System.IO
+import MissingH.Printf.Types
-data Value =
- ValueInt Int
- | ValueString String
- deriving (Eq, Show)
-
-class PFType a where
- toValue :: a -> Value
- fromValue :: Value -> a
-
-instance PFType Int where
- toValue = ValueInt
- fromValue (ValueInt x) = x
- fromValue _ = error "fromValue int"
-
-instance PFType String where
- toValue = ValueString
- fromValue (ValueString x) = x
- fromValue _ = error "fromValue string"
-
-{-
-instance PFType Value where
- toValue = id
- fromValue = id
--}
v :: PFType a => a -> Value
v = toValue
-class PFRun a where
- pfrun :: ([Value] -> String) -> a
-instance PFRun String where
- pfrun f = f $ []
-instance (PFType a, PFRun b) => PFRun (a -> b) where
- pfrun f x = pfrun (\xs -> f (toValue x : xs))
-
-class IOPFRun a where
- iopfrun :: Handle -> ([Value] -> String) -> a
-instance IOPFRun (IO ()) where
- iopfrun h f = hPutStr h $ pfrun f
-instance (PFType a, IOPFRun b) => IOPFRun (a -> b) where
- iopfrun h f x = iopfrun h (\xs -> f (toValue x : xs))
sprintf :: String -> [Value] -> String
sprintf [] [] = []
diff --git a/libsrc/MissingH/Printf/Parser.lhs b/libsrc/MissingH/Printf/Parser.lhs
deleted file mode 100644
index 0a1565e..0000000
--- a/libsrc/MissingH/Printf/Parser.lhs
+++ /dev/null
@@ -1,143 +0,0 @@
-arch-tag: Printf parser declarations
-
-\begin{code}
-module Parser (parse) where
-
-import Language.Haskell.THSyntax
-import Maybe (isJust, fromJust)
-import Printer (get_conversion_func)
-import Char (isDigit)
-import List (nub, delete)
-import Types
-
-{-
-xn where n is an integer refers to an argument to the function
-y*, n* is reserved for %n
-fw* is reserved for field width intermediates
-Everything else can be used by the conversion functions
--}
-
--- parse takes a format string and returns a list of Formats with which
--- to build the output and the number of arguments to take
-parse :: String -> ([Format], ArgNum)
-parse = parse' 1 0
-
-parse' :: ArgNum -- The next argument number
- -> ArgNum -- The maximum numbered argument number used so far
- -> String -- The format string
- -> ([Format], -- The bits of output
- ArgNum) -- The number of arguments to take
--- When we are at the end of the input there are no more bits of input
--- remaining. The number of arguments is the largest argument used.
-parse' x_var max_x_var "" = ([], (x_var - 1) `max` max_x_var)
-parse' x_var max_x_var xs
- = case parse_format x_var xs of
- (f, x_var', used, xs') ->
- case parse' x_var' (maximum (max_x_var:used)) xs' of
- (fs, final_max_x_var) -> (f:fs, final_max_x_var)
-
-parse_format :: ArgNum -- The next argument to use
- -> String -- The format string
- -> (Format, -- The Format we put together
- ArgNum, -- The new next argument to use
- [ArgNum], -- The argument numbers we've used
- String) -- The remainder of the format string
-parse_format x_var ('%':xs)
- = case conv_spec of
- 'n' -> (CharCount, x_var, [], xs5)
- '%' -> (Literal "%", x_var, [], xs5)
- _ -> (Conversion converted', x_var0, used, xs5)
- where (arg, used0, x_var0, xs0) = get_arg x_var3 xs
- (flags, xs1) = get_flags xs0
- flags' = if isJust mprec then delete ZeroPadded flags else flags
- (mfw, used2, x_var2, xs2) = get_min_field_width x_var xs1
- (mprec, used3, x_var3, xs3) = get_precision x_var2 xs2
- (_length_mod, xs4) = get_length_modifier xs3
- (conv_spec, xs5) = get_conversion_specifier xs4
- conv_func = get_conversion_func conv_spec
- used = used0 ++ used2 ++ used3
- converted = conv_func arg flags' mfw mprec
- converted' = fix_width flags' mfw converted
-parse_format x_var xs = case break ('%' ==) xs of
- (ys, zs) -> (Literal ys, x_var, [], zs)
-
-fix_width :: [Flag] -> Maybe Width -> ExpQ -> ExpQ
-fix_width _ Nothing e = e
-fix_width flags (Just w) e = letE [dec_e] exp_spaced
- where
- dec_e = valD (varP "e") (normalB e) []
- exp_num_spaces = [| abs $w - length $e |]
- exp_num_spaces' = [| 0 `max` $exp_num_spaces |]
- exp_spaces = [| replicate $exp_num_spaces' ' ' |]
- exp_left_padded = [| $(varE "e") ++ $exp_spaces |]
- exp_right_padded = [| $exp_spaces ++ $(varE "e") |]
- exp_spaced = if LeftAdjust `elem` flags
- then exp_left_padded
- else [| if $w < 0 then $exp_left_padded
- else $exp_right_padded |]
-
-get_flags :: String -> ([Flag], String)
-get_flags s = (flags'', s')
- where (cs, s') = span (`elem` "#0- +'I") s
- unique_cs = nub cs
- flags = map (fromJust . (`lookup` flag_mapping)) unique_cs
- flags' = if LeftAdjust `elem` flags then filter (/= ZeroPadded) flags
- else flags
- flags'' = if Plus `elem` flags then filter (/= BlankPlus) flags
- else flags'
- flag_mapping = [('#', AlternateForm),
- ('0', ZeroPadded),
- ('-', LeftAdjust),
- (' ', BlankPlus),
- ('+', Plus),
- ('\'', Thousands),
- ('I', AlternativeDigits)]
-
-get_min_field_width :: ArgNum
- -> String
- -> (Maybe Width, [ArgNum], ArgNum, String)
-get_min_field_width x_var s
- = case get_num s of
- Just (n, s') -> (Just [| n |], [], x_var, s')
- Nothing -> case get_star_arg x_var s of
- Just (a, used, x_var', s') -> (Just a, used, x_var', s')
- Nothing -> (Nothing, [], x_var, s)
-
--- Need to check prec >= 0 at some point?
-
-get_precision :: ArgNum
- -> String
- -> (Maybe Precision, [ArgNum], ArgNum, String)
-get_precision x_var ('.':s)
- = case get_num s of
- Just (n, s') -> (Just [| n |], [], x_var, s')
- Nothing -> case get_star_arg x_var s of
- Just (a, used, x_var', s') -> (Just a, used, x_var', s')
- Nothing -> (Just [| 0 |], [], x_var, s)
-get_precision x_var s = (Nothing, [], x_var, s)
-
-get_star_arg :: ArgNum -> String -> Maybe (Arg, [ArgNum], ArgNum, String)
-get_star_arg x_var ('*':s) = Just (get_arg x_var s)
-get_star_arg _ _ = Nothing
-
-get_arg :: ArgNum -> String -> (Arg, [ArgNum], ArgNum, String)
-get_arg x_var s = case get_num s of
- Just (i, '$':s') -> (varE (xvar i), [i], x_var, s')
- _ -> (varE (xvar x_var), [], x_var + 1, s)
-
-get_num :: String -> Maybe (Integer, String)
-get_num s = case span isDigit s of
- ("", _) -> Nothing
- (xs, s') -> Just ((read xs), s')
-
-get_length_modifier :: String -> (String, String)
-get_length_modifier s
- | take 2 s `elem` ["hh", "ll"] = splitAt 2 s
- | take 1 s `elem` ["h", "l", "L", "q", "j", "z", "t"] = splitAt 1 s
- | otherwise = ("", s)
-
-get_conversion_specifier :: String -> (Char, String)
-get_conversion_specifier (x:xs) = (x, xs) -- XXX errors
-get_conversion_specifier "" = error "Printf: get_conversion_specifier \"\""
-\end{code}
-
diff --git a/libsrc/MissingH/Printf/Printer.lhs b/libsrc/MissingH/Printf/Printer.lhs
index ceb28a4..9afe164 100644
--- a/libsrc/MissingH/Printf/Printer.lhs
+++ b/libsrc/MissingH/Printf/Printer.lhs
@@ -1,13 +1,13 @@
arch-tag: Printf printer declarations
\begin{code}
-module Printer (get_conversion_func, thousandify, octalify, hexify) where
+module MissingH.Printf.Printer (get_conversion_func, thousandify, octalify, hexify) where
-import Language.Haskell.THSyntax
import Maybe (fromMaybe)
import Numeric (showEFloat, showFFloat)
import Char (toLower, toUpper)
-import Types
+import MissingH.Printf.Types
+import Data.List(genericLength, genericReplicate)
{-
xn where n is an integer refers to an argument to the function
@@ -16,12 +16,6 @@ fw* is reserved for field width intermediates
Everything else can be used by the conversion functions
-}
-type ConversionFunc = Arg
- -> [Flag]
- -> Maybe Width
- -> Maybe Precision
- -> ExpQ
-
get_conversion_func :: Char -> ConversionFunc
get_conversion_func c = fromMaybe (error (c:": CF unknown")) $ lookup c cfs
where cfs = [
@@ -52,38 +46,38 @@ get_conversion_func c = fromMaybe (error (c:": CF unknown")) $ lookup c cfs
-- %d, %i
print_signed_int :: ConversionFunc
print_signed_int arg flags mw mp = res
- where preci = fromMaybe [| 1 |] mp
- width = fromMaybe [| 0 |] mw
- disp | Thousands `elem` flags = [| thousandify . show |]
- | otherwise = [| show |]
+ where preci = fromMaybe 1 mp
+ width = fromMaybe 0 mw
+ disp | Thousands `elem` flags = thousandify . show
+ | otherwise = show
plus_sign = if Plus `elem` flags
then "+"
else if BlankPlus `elem` flags
then " "
else ""
- res = [| let to_show = toInteger $arg
- shown = $disp $ abs to_show
- w = $( if ZeroPadded `elem` flags
- then [| $preci `max` $width - length sign |]
- else preci )
+ res = let to_show = toInteger arg
+ shown = disp $ abs to_show
+ w = ( if ZeroPadded `elem` flags
+ then (read preci `max` width - genericLength sign)::Width
+ else (read preci)::Width )
sign = if to_show < 0 then "-" else plus_sign
- num_zeroes = (w - length shown) `max` 0
- in sign ++ replicate num_zeroes '0' ++ shown
- |]
+ num_zeroes = (w - genericLength shown) `max` 0
+ in sign ++ genericReplicate num_zeroes '0' ++ shown
+
-- %o, u, x, X
print_unsigned_int :: Char -> ConversionFunc
print_unsigned_int base arg flags mw mp = res
- where preci = fromMaybe [| 1 |] mp
- width = fromMaybe [| 0 |] mw
- w = if ZeroPadded `elem` flags then [| $preci `max` $width |]
- else preci
+ where preci = fromMaybe 1 mp
+ width = fromMaybe 0 mw
+ w = if ZeroPadded `elem` flags then (read preci) `max` width
+ else read preci
disp = case base of
- 'o' -> [| octalify |]
- 'x' -> [| hexify $(lift lower_hex) |]
- 'X' -> [| hexify $(lift upper_hex) |]
- 'u' | Thousands `elem` flags -> [| thousandify . show |]
- | otherwise -> [| show |]
+ 'o' -> octalify
+ 'x' -> hexify ({-lift-} lower_hex)
+ 'X' -> hexify ({-lift-} upper_hex)
+ 'u' | Thousands `elem` flags -> thousandify . show
+ | otherwise -> show
_ -> err_letter
prefix = if AlternateForm `elem` flags then case base of
'o' -> "0"
@@ -92,29 +86,29 @@ print_unsigned_int base arg flags mw mp = res
'X' -> "0X"
_ -> err_letter
else ""
- res = [| let to_show = toInteger $arg `max` 0
- shown = $disp to_show
+ res = let to_show = toInteger arg `max` 0
+ shown = disp to_show
pref = if to_show == 0 then "" else prefix
- num_zeroes = ($w - length shown - length pref) `max` 0
- in pref ++ replicate num_zeroes '0' ++ shown
- |]
+ num_zeroes = (w - genericLength shown - genericLength pref) `max` 0
+ in pref ++ genericReplicate num_zeroes '0' ++ shown
+
err_letter = error "print_unsigned_int: Bad letter"
-- %e, E
print_exponent_double :: Char -> ConversionFunc
print_exponent_double e arg flags mw mp = res
- where preci = fromMaybe [| 6 |] mp
- width = fromMaybe [| 0 |] mw
+ where preci = fromMaybe 6 mp
+ width = fromMaybe 0 mw
plus_sign = if Plus `elem` flags
then "+"
else if BlankPlus `elem` flags
then " "
else ""
keep_dot = AlternateForm `elem` flags
- res = [| let to_show = (fromRational $ toRational $arg) :: Double
+ res = let to_show = (fromRational $ toRational arg) :: Double
shown = showEFloat (Just $preci) (abs to_show) ""
sign = if to_show < 0 then "-" else plus_sign
- fix_prec0 = if $preci == 0
+ fix_prec0 = if preci == 0
then case break (== '.') shown of
(xs, _:_:ys)
| keep_dot -> xs ++ '.':ys
@@ -127,48 +121,48 @@ print_exponent_double e arg flags mw mp = res
fix_exp = case break (== 'e') fix_exp_sign of
(xs, [_,s,y]) -> xs ++ [e,s,'0',y]
(xs, _:ys) -> xs ++ e:ys
- num_zeroes = ($width - length fix_exp - length sign)
+ num_zeroes = (width - length fix_exp - length sign)
`max` 0
in sign ++ replicate num_zeroes '0' ++ fix_exp
- |]
+
-- %f, F
print_fixed_double :: Char -> ConversionFunc
print_fixed_double f arg flags mw mp = res
- where preci = fromMaybe [| 6 |] mp
- width = fromMaybe [| 0 |] mw
+ where preci = fromMaybe 6 mp
+ width = fromMaybe 0 mw
plus_sign = if Plus `elem` flags
then "+"
else if BlankPlus `elem` flags
then " "
else ""
add_dot = AlternateForm `elem` flags
- fix_case | f == 'f' = [| map toLower |]
- | otherwise = [| map toUpper |]
- res = [| let to_show = (fromRational $ toRational $arg) :: Double
- shown = showFFloat (Just $preci) (abs to_show) ""
- shown' = if add_dot && $preci == 0 then shown ++ "."
+ fix_case | f == 'f' = map toLower
+ | otherwise = map toUpper
+ res = let to_show = (fromRational $ toRational arg) :: Double
+ shown = showFFloat (Just preci) (abs to_show) ""
+ shown' = if add_dot && preci == 0 then shown ++ "."
else shown
sign = if to_show < 0 then "-" else plus_sign
- num_zeroes = ($width - length shown' - length sign)
+ num_zeroes = (width - length shown' - length sign)
`max` 0
- in sign ++ replicate num_zeroes '0' ++ $fix_case shown'
- |]
+ in sign ++ replicate num_zeroes '0' ++ fix_case shown'
+
-- %c, C
print_char :: ConversionFunc
-print_char arg _ _ _ = [| [$arg] |]
+print_char arg _ _ _ = [arg]
-- %s, S
print_string :: ConversionFunc
print_string arg _ _ mp
= case mp of
- Just preci -> [| if $preci < 0 then $arg else take $preci $arg |]
+ Just preci -> if preci < 0 then arg else take preci arg
Nothing -> arg
-- Corresponds to %H (Haskell extension)
show_arg :: ConversionFunc
-show_arg arg flags mw mp = print_string [| show $arg |] flags mw mp
+show_arg arg flags mw mp = (print_string show arg) flags mw mp
lower_hex, upper_hex :: Bool
lower_hex = False
diff --git a/libsrc/MissingH/Printf/Types.lhs b/libsrc/MissingH/Printf/Types.lhs
index 8db2f63..4623917 100644
--- a/libsrc/MissingH/Printf/Types.lhs
+++ b/libsrc/MissingH/Printf/Types.lhs
@@ -1,18 +1,67 @@
arch-tag: Printf type declarations
\begin{code}
-module Types where
+module MissingH.Printf.Types where
+
+import System.IO
+
+data Value =
+ ValueInt Int
+ | ValueString String
+ deriving (Eq, Show)
+
+class PFType a where
+ toValue :: a -> Value
+ fromValue :: Value -> a
+
+instance PFType Int where
+ toValue = ValueInt
+ fromValue (ValueInt x) = x
+ fromValue _ = error "fromValue int"
+
+instance PFType String where
+ toValue = ValueString
+ fromValue (ValueString x) = x
+ fromValue _ = error "fromValue string"
+
+{-
+instance PFType Value where
+ toValue = id
+ fromValue = id
+-}
+class PFRun a where
+ pfrun :: ([Value] -> String) -> a
+instance PFRun String where
+ pfrun f = f $ []
+instance (PFType a, PFRun b) => PFRun (a -> b) where
+ pfrun f x = pfrun (\xs -> f (toValue x : xs))
+
+class IOPFRun a where
+ iopfrun :: Handle -> ([Value] -> String) -> a
+instance IOPFRun (IO ()) where
+ iopfrun h f = hPutStr h $ pfrun f
+instance (PFType a, IOPFRun b) => IOPFRun (a -> b) where
+ iopfrun h f x = iopfrun h (\xs -> f (toValue x : xs))
+
+-------------------------------------------
+-- Begin code from Ian Lynagh
+
+type ConversionFunc = Arg
+ -> [Flag]
+ -> Maybe Width
+ -> Maybe Precision
+ -> String
+
-import Language.Haskell.THSyntax
data Format = Literal String
- | Conversion ExpQ
+ | Conversion ConversionFunc
| CharCount
type ArgNum = Integer
-type Arg = ExpQ
-type Width = ExpQ
-type Precision = ExpQ
+type Arg = String
+type Width = Integer
+type Precision = String
data Flag = AlternateForm -- "#"
| ZeroPadded -- "0"
| LeftAdjust -- "-"
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list