ref: 98b9766e697d613874e67aaa1503d9accc94ae59
parent: 50a42f8f9a96bac7632b8a71dfba15f339ff54bb
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Nov 2 09:53:55 EDT 2023
More Show stuff
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-1190
+1192
((A :0 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :1 (T (BK (BK (BK K))))) ((A :2 (T (K (BK (BK K))))) ((A :3 (T (K (K (BK K))))) ((A :4 (T (K (K (K K))))) ((A :5 (T (K (K (K A))))) ((A :6 (K (noDefault "Alternative.empty"))) ((A :7 (K (noDefault "Alternative.<|>"))) ((A :8 ((S (((S' S') ((B _14) _1)) (((C' _132) ((B _12) _1)) _240))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _239))) ((A :10 (((S' P) _2) (((C' _13) _1) _953))) ((A :11 ((B (B (B (B C)))) ((B (B (B C))) ((B (B C)) P)))) ((A :12 (T (BK (BK (BK K))))) ((A :13 (T (K (BK (BK K))))) ((A :14 (T (K (K (BK K))))) ((A :15 (T (K (K (K K))))) ((A :16 (T (K (K (K A))))) ((A :17 (K (noDefault "Applicative.pure"))) ((A :18 (K (noDefault "Applicative.<*>"))) ((A :19 (((S' B) _14) (((C' _129) _12) _121))) ((A :20 (((S' B) _14) (((C' _132) _12) _122))) ((A :21 _1025) ((A :22 ((B _1068) _21)) ((A :23 (((S' _1068) _21) I)) ((A :24 _995) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1024) ((C _120) _26))) ((A :28 (((C' _27) ((_128 _1038) _109)) ((_120 (_34 _1040)) _108))) ((A :29 ((B ((S _1068) (_34 _1040))) _24)) ((A :30 ((B (B (B C))) ((B (B C)) P))) ((A :31 (T (BK (BK K)))) ((A :32 (T (K (BK K)))) ((A :33 (T (K (K K)))) ((A :34 (T (K (K A)))) ((A :35 (K (noDefault "Monad.>>="))) ((A :36 (((C' (C' B)) _32) K)) ((A :37 ((B _13) _31)) ((A :38 (((S' (C' B)) _32) (((S' (C' B)) _32) (B' _34)))) ((A :39 P) ((A :40 (T K)) ((A :41 (T A)) ((A :42 (K _24)) ((A :43 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _239)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _240)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _953)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _953))) ((A :46 ((C _43) _121)) ((A :47 ((B _123) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _123) _48)) ((A :50 T) ((A :51 ((_127 ((B (B (_118 _50))) ((B ((C' C) _54)) (B P)))) (_131 _51))) ((A :52 (((((_11 _51) ((B (_118 _50)) P)) (_38 _53)) ((B (B (_118 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_118 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_120 _274)) _54)) ((A :56 ((B (_118 _50)) (B (P _953)))) ((A :57 ((B (_118 _50)) (BK (P _953)))) ((A :58 ((_118 _50) ((S P) I))) ((A :59 ((B (_118 _50)) ((C (S' P)) I))) ((A :60 ((_113 ((C ((C S') _63)) I)) (_117 _60))) ((A :61 (R _69)) ((A :62 (T _68)) ((A :63 ((P _69) _68)) ((A :64 _69) ((A :65 ((C ((C S') _63)) I)) ((A :66 ((C S) _63)) ((A :67 (((_1166 (K ((P (_1175 "False")) (_1175 "True")))) (_1171 _67)) (_1172 _67))) ((A :68 K) ((A :69 A) ((A :70 ((_113 _989) _990)) ((A :71 ((((((((_252 _70) (_261 _71)) _991) _992) _993) _994) (_266 _71)) (_267 _71))) ((A :72 ((_113 _999) (_117 _72))) ((A :73 ((((((((_252 _72) _998) (((C' (C' (_114 _268))) _998) _271)) (((C' (C' (_115 _268))) _998) _273)) (((C' (C' (_114 _268))) _998) _273)) (((C' (C' (_115 _268))) _998) _273)) (_266 _73)) (_267 _73))) ((A :74 _1000) ((A :75 _1001) ((A :76 (((S' _62) (_992 #97)) ((C _992) #122))) ((A :77 (((S' _62) (_992 #65)) ((C _992) #90))) ((A :78 (((S' _61) _76) _77)) ((A :79 (((S' _62) (_992 #48)) ((C _992) #57))) ((A :80 (((S' _61) _78) _79)) ((A :81 (((S' _62) (_992 #32)) ((C _992) #126))) ((A :82 (((S' _61) ((C (_114 _70)) #32)) (((S' _61) ((C (_114 _70)) #9)) ((C (_114 _70)) #10)))) ((A :83 ((S ((S (((S' _62) (_992 #65)) ((C _992) #90))) (_69 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _74) (((C' _133) (((C' _134) _75) (_75 #65))) (_75 #97))))) ((A :84 ((S ((S (((S' _62) (_992 #97)) ((C _992) #97))) (_69 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _74) (((C' _133) (((C' _134) _75) (_75 #97))) (_75 #65))))) ((A :85 (((_1166 (K ((B (_120 (_1174 #39))) (((C' _120) ((B _1175) _86)) (_1174 #39))))) (_1171 _85)) ((B (_120 (_1174 #34))) (Y ((B (P (_1174 #34))) ((C' B) ((B _120) ((B _1175) _86)))))))) ((A :86 (((C' Y) (((S' B) ((B P) ((S ((C _81) "XXX")) ((C O) K)))) ((B (B (C B))) (B' ((B C) (C (_114 _70))))))) ((O ((P #10) "\92&n")) ((O ((P #13) "\92&r")) ((O ((P #9) "\92&t")) ((O ((P #8) "\92&b")) ((O ((P #9
\ No newline at end of file
--- a/lib/Data/Int.hs
+++ b/lib/Data/Int.hs
@@ -65,22 +65,22 @@
--------------------------------
instance Show Int where
- show = showInt
+ show = showInt_
-- XXX these should not be exported
-- XXX wrong for minInt
-showInt :: Int -> String
-showInt n =
+showInt_ :: Int -> String
+showInt_ n =
if n < 0 then
- '-' : showUnsignedInt (negate n)
+ '-' : showUnsignedInt_ (negate n)
else
- showUnsignedInt n
+ showUnsignedInt_ n
-showUnsignedInt :: Int -> String
-showUnsignedInt n =
+showUnsignedInt_ :: Int -> String
+showUnsignedInt_ n =
let
c = primChr (primOrd '0' + rem n 10)
in if n < 10 then
[c]
else
- showUnsignedInt (quot n 10) ++ [c]
+ showUnsignedInt_ (quot n 10) ++ [c]
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -7,7 +7,7 @@
import Data.Eq
import qualified Data.Int as I
import Data.List
-import Text.String
+import Text.Show
infixl 6 +,-
infixl 7 *,`quot`,`rem`
@@ -61,10 +61,13 @@
--------------------------------
-showWord :: Word -> C.String
-showWord n =
- let
- c = C.chr ((I.+) (C.ord '0') (wordToInt (rem n (intToWord 10))))
- in case n < intToWord 10 of
- False -> showWord (quot n (intToWord 10)) ++ [c]
- True -> [c]
+instance Show Word where
+ show = showWord
+ where
+ showWord :: Word -> C.String
+ showWord n =
+ let
+ c = C.chr ((I.+) (C.ord '0') (wordToInt (rem n (intToWord 10))))
+ in case n < intToWord 10 of
+ False -> showWord (quot n (intToWord 10)) ++ [c]
+ True -> [c]
--- a/lib/Text/Show.hs
+++ b/lib/Text/Show.hs
@@ -11,13 +11,9 @@
show :: a -> String
showList :: [a] -> ShowS
- showsPrec _ x s = show x ++ s
- show x = showsPrec 0 x ""
- showList [] s = '[' : ']' : s
- showList (x:xs) s = '[' : shows x (shl xs)
- where
- shl [] = ']' : s
- shl (y:ys) = ',' : shows y (shl ys)
+ showsPrec _ x s = show x ++ s
+ show x = showsPrec 0 x ""
+ showList = showListWith shows
shows :: forall a . Show a => a -> ShowS
shows = showsPrec 0
@@ -31,3 +27,10 @@
showParen :: Bool -> ShowS -> ShowS
showParen False sh = sh
showParen True sh = \ x -> '(' : sh (')' : x)+
+showListWith :: forall a . (a -> ShowS) -> [a] -> ShowS
+showListWith _ [] s = '[' : ']' : s
+showListWith sh (x:xs) s = '[' : sh x (shl xs)
+ where
+ shl [] = ']' : s
+ shl (y:ys) = ',' : sh y (shl ys)
--- a/lib/Text/String.hs
+++ b/lib/Text/String.hs
@@ -8,11 +8,11 @@
import Data.Eq
import Data.Function
import Data.Int
-import qualified Data.Double as DD
import Data.List
import Data.Maybe
import Data.Ord
import Data.Tuple
+import Text.Show
xshowChar :: Char -> String
xshowChar c = "'" ++ xencodeChar c ++ "'"
@@ -24,7 +24,7 @@
('\\', "\\\\"), ('\'', "\\'"), ('"', "\"")]in
case lookup c spec of
- Nothing -> if isPrint c then [c] else "'\\" ++ showInt (ord c) ++ "'"
+ Nothing -> if isPrint c then [c] else "'\\" ++ show (ord c) ++ "'"
Just s -> s
readInt :: String -> Int
@@ -36,40 +36,12 @@
readDouble :: String -> Double
readDouble = primDoubleRead
-{--showBool :: Bool -> String
-showBool arg =
- case arg of
- False -> "False"
- True -> "True"
+showListS :: forall a . (a -> String) -> [a] -> String
+showListS sa as = showListWith (\ a s -> sa a ++ s) as ""
-showUnit :: () -> String
-showUnit arg =
- case arg of
- () -> "()"
+showPairS :: forall a b . (a -> String) -> (b -> String) -> (a, b) -> String
+showPairS sa sb (a, b) = "(" ++ sa a ++ "," ++ sb b ++ ")"-showPair :: forall a b . (a -> String) -> (b -> String) -> (a, b) -> String
-showPair sa sb ab =
- case ab of
- (a, b) -> "(" ++ sa a ++ "," ++ sb b ++ ")"-
-showMaybe :: forall a . (a -> String) -> Maybe a -> String
-showMaybe _ Nothing = "Nothing"
-showMaybe fa (Just a) = "(Just " ++ fa a ++ ")"
-
-showEither :: forall a b . (a -> String) -> (b -> String) -> Either a b -> String
-showEither fa _ (Left a) = "(Left " ++ fa a ++ ")"
-showEither _ fb (Right b) = "(Right " ++ fb b ++ ")"
-
-showOrdering :: Ordering -> String
-showOrdering LT = "LT"
-showOrdering EQ = "EQ"
-showOrdering GT = "GT"
--}
-
-xshowList :: forall a . (a -> String) -> [a] -> String
-xshowList sa as = "[" ++ intercalate "," (map sa as) ++ "]"
-
lines :: String -> [String]
lines "" = []
lines s =
@@ -79,7 +51,6 @@
unlines :: [String] -> String
unlines = concatMap (++ "\n")
-
words :: String -> [String]
words s =
case dropWhile isSpace s of
@@ -89,16 +60,6 @@
unwords :: [String] -> String
unwords ss = intercalate " " ss
-
-{---- Using a primitive for string equality makes a huge speed difference.
-eqString :: String -> String -> Bool
-eqString = primStringEQ
-
-leString :: String -> String -> Bool
-leString s t = compareString s t /= GT
- --not (eqOrdering GT (compareString s t))
--}
padLeft :: Int -> String -> String
padLeft n s = replicate (n - length s) ' ' ++ s
--- a/src/Compat.hs
+++ b/src/Compat.hs
@@ -35,26 +35,11 @@
readDouble :: String -> Double
readDouble = read
-showInt :: Int -> String
-showInt = show
-
-showDouble :: Double -> String
-showDouble = show
-
xshowChar :: Char -> String
xshowChar = show
-showBool :: Bool -> String
-showBool = show
-
-showUnit :: () -> String
-showUnit = show
-
-showString :: String -> String
-showString = show
-
-xshowList :: (a -> String) -> [a] -> String
-xshowList sa arg =
+showListS :: (a -> String) -> [a] -> String
+showListS sa arg =
let
showRest as =
case as of
@@ -65,11 +50,8 @@
[] -> "[]"
a : as -> "[" ++ sa a ++ showRest as
-showMaybe :: (a -> String) -> Maybe a -> String
-showMaybe fa arg =
- case arg of
- Nothing -> "Nothing"
- Just a -> "(Just " ++ fa a ++ ")"
+showPairS :: (a -> String) -> (b -> String) -> (a, b) -> String
+showPairS f g (a, b) = "(" ++ f a ++ "," ++ g b ++ ")"elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy eq a = any (eq a)
@@ -89,35 +71,6 @@
lookupBy :: (a -> a -> Bool) -> a -> [(a, b)] -> Maybe b
lookupBy eq x xys = fmap snd (find (eq x . fst) xys)
-
-pair :: a -> b -> (a, b)
-pair = (,)
-
-eqList :: (a -> a -> Bool) -> [a] -> [a] -> Bool
-eqList eq axs ays =
- case axs of
- [] ->
- case ays of
- [] -> True
- _:_ -> False
- x:xs ->
- case ays of
- [] -> False
- y:ys -> eq x y && eqList eq xs ys
-
-eqPair :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
-eqPair eqa eqb ab1 ab2 =
- case ab1 of
- (a1, b1) ->
- case ab2 of
- (a2, b2) ->
- eqa a1 a2 && eqb b1 b2
-
-showPair :: (a -> String) -> (b -> String) -> (a, b) -> String
-showPair f g (a, b) = "(" ++ f a ++ "," ++ g b ++ ")"-
-eqInt :: Int -> Int -> Bool
-eqInt = (==)
openFileM :: FilePath -> IOMode -> IO (Maybe Handle)
openFileM path m = do
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -73,7 +73,7 @@
() <- IO.return (rnf dsn)
t2 <- getTimeMilli
IO.when (verbose flags > 0) $
- putStrLn $ "combinator conversion " ++ padLeft 6 (showInt (t2-t1)) ++ "ms"
+ putStrLn $ "combinator conversion " ++ padLeft 6 (show (t2-t1)) ++ "ms"
IO.return (dsn, ch')
--compileTop :: Flags -> IdentModule -> IO [LDef]
@@ -84,7 +84,7 @@
compile flags nm ach = IO.do
((_, t), ch) <- runStateIO (compileModuleCached flags nm) ach
IO.when (verbose flags > 0) $
- putStrLn $ "total import time " ++ padLeft 6 (showInt t) ++ "ms"
+ putStrLn $ "total import time " ++ padLeft 6 (show t) ++ "ms"
IO.return (concatMap bindingsOf $ M.elems $ cache ch, ch)
-- Compile a module with the given name.
@@ -102,8 +102,8 @@
liftIO $ putStrLn $ "importing " ++ showIdent mn
(cm, tp, tt, ts) <- compileModule flags mn
S.when (verbose flags > 0) $
- liftIO $ putStrLn $ "importing done " ++ showIdent mn ++ ", " ++ showInt (tp + tt) ++
- "ms (" ++ showInt tp ++ " + " ++ showInt tt ++ ")"+ liftIO $ putStrLn $ "importing done " ++ showIdent mn ++ ", " ++ show (tp + tt) ++
+ "ms (" ++ show tp ++ " + " ++ show tt ++ ")"S.when (loading flags && mn /= mkIdent "Interactive") $
liftIO $ putStrLn $ "import " ++ showIdent mn
c <- get
@@ -150,7 +150,7 @@
readFilePath path name = IO.do
mh <- openFilePath path name
case mh of
- Nothing -> error $ "File not found: " ++ show name ++ "\npath=" ++ xshowList show path
+ Nothing -> error $ "File not found: " ++ show name ++ "\npath=" ++ show path
Just (fn, h) -> IO.do
file <- IO.hGetContents h
IO.return (fn, file)
--- a/src/MicroHs/Desugar.hs
+++ b/src/MicroHs/Desugar.hs
@@ -34,12 +34,12 @@
case adef of
Data _ cs ->
let
- f i = mkIdent ("$f" ++ showInt i)+ f i = mkIdent ("$f" ++ show i)fs = [f i | (i, _) <- zip (enumFrom 0) cs]
dsConstr i (Constr c ets) =
let
ts = either id (map snd) ets
- xs = [mkIdent ("$x" ++ showInt j) | (j, _) <- zip (enumFrom 0) ts]+ xs = [mkIdent ("$x" ++ show j) | (j, _) <- zip (enumFrom 0) ts]in (qualIdent mn c, lams xs $ lams fs $ apps (Var (f i)) (map Var xs))
in zipWith dsConstr (enumFrom 0) cs
Newtype _ (Constr c _) -> [ (qualIdent mn c, Lit (LPrim "I")) ]
@@ -55,7 +55,7 @@
meths = [ qualIdent mn i | (BSign i _) <- bs ]
supers :: [Ident]
supers = [ qualIdent mn $ mkSuperSel c i | i <- [1 .. length ctx] ]
- xs = [ mkIdent ("$x" ++ showInt j) | j <- [ 1 .. length ctx + length meths ] ]+ xs = [ mkIdent ("$x" ++ show j) | j <- [ 1 .. length ctx + length meths ] ]in (qualIdent mn $ mkClassConstructor c, lams xs $ Lam f $ apps (Var f) (map Var xs)) :
zipWith (\ i x -> (expectQualified i, Lam f $ App (Var f) (lams xs $ Var x))) (supers ++ meths) xs
Instance _ _ _ _ -> []
@@ -205,7 +205,7 @@
case getTupleConstr ci of
Just n ->
let
- xs = [mkIdent ("x" ++ showInt i) | i <- enumFromTo 1 n ]+ xs = [mkIdent ("x" ++ show i) | i <- enumFromTo 1 n ]body = mkTupleE $ map Var xs
in foldr Lam body xs
Nothing -> Var (conIdent c)
@@ -219,7 +219,7 @@
mkTupleSelE :: Int -> Int -> Exp -> Exp
mkTupleSelE m n tup =
let
- xs = [mkIdent ("x" ++ showInt i) | i <- enumFromTo 1 n ]+ xs = [mkIdent ("x" ++ show i) | i <- enumFromTo 1 n ]in App tup (foldr Lam (Var (xs !! m)) xs)
-- Handle special syntax for lists and tuples
@@ -262,7 +262,7 @@
apps f = foldl App f
newVars :: String -> [Ident] -> [Ident]
-newVars s is = deleteAllsBy (==) [ mkIdent (s ++ showInt i) | i <- enumFrom 1 ] is
+newVars s is = deleteAllsBy (==) [ mkIdent (s ++ show i) | i <- enumFrom 1 ] is
newVar :: [Ident] -> Ident
newVar = head . newVars "q"
@@ -292,7 +292,7 @@
type Matrix = [Arm]
--showArm :: Arm -> String
---showArm (ps, _, b) = xshowList showExpr ps ++ "," ++ showBool b
+--showArm (ps, _, b) = showListS showExpr ps ++ "," ++ show b
newIdents :: Int -> M [Ident]
newIdents n = S.do
--- a/src/MicroHs/Exp.hs
+++ b/src/MicroHs/Exp.hs
@@ -174,7 +174,7 @@
let
achar c =
if c == '"' || c == '\\' || c < ' ' || c > '~' then
- '\\' : showInt (ord c) ++ ['&']
+ '\\' : show (ord c) ++ ['&']
else
[c]
in '"' : concatMap achar s ++ ['"']
@@ -449,7 +449,7 @@
let
fe = allVarsExp e
ase = allVarsExp se
- j = head [ v | n <- enumFrom 0, let { v = mkIdent ("a" ++ showInt n) }, not (elem v ase), not (elem v fe) ]+ j = head [ v | n <- enumFrom 0, let { v = mkIdent ("a" ++ show n) }, not (elem v ase), not (elem v fe) ]in
--trace ("substExp " ++ unwords [si, i, j]) $Lam j (substExp si se (substExp i (Var j) e))
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -409,7 +409,7 @@
Nothing -> empty
Just (h, is) -> text (if h then " hiding" else "") <> parens (hsep $ punctuate (text ", ") (map ppImportItem is))
ForImp ie i t -> text ("foreign import ccall " ++ show ie) <+> ppIdent i <+> text "::" <+> ppEType t- Infix (a, p) is -> text ("infix" ++ f a) <+> text (showInt p) <+> hsep (punctuate (text ", ") (map ppIdent is))+ Infix (a, p) is -> text ("infix" ++ f a) <+> text (show p) <+> hsep (punctuate (text ", ") (map ppIdent is))where f AssocLeft = "l"; f AssocRight = "r"; f AssocNone = ""
Class sup lhs fds bs -> ppWhere (text "class" <+> ctx sup <+> ppLHS lhs <+> ppFunDeps fds) bs
Instance vs ct ty bs -> ppWhere (text "instance" <+> ppForall vs <+> ctx ct <+> ppEType ty) bs
@@ -474,7 +474,7 @@
EListish l -> ppListish l
ESign e t -> ppExpr e <+> text "::" <+> ppEType t
EAt i e -> ppIdent i <> text "@" <> ppExpr e
- EUVar i -> text ("a" ++ showInt i)+ EUVar i -> text ("a" ++ show i)ECon c -> ppCon c
EForall iks e -> ppForall iks <+> ppEType e
where
--- a/src/MicroHs/Interactive.hs
+++ b/src/MicroHs/Interactive.hs
@@ -154,7 +154,7 @@
Left e -> err e
Right val ->
if primIsInt val then
- putStrLn $ showInt $ unsafeCoerce val
+ putStrLn $ show (unsafeCoerce val :: Int)
else do
putStrLn "Warning: not an Int"
mio <- try (print (force ((unsafeCoerce val)::Int)))
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -38,8 +38,8 @@
let
mainName = qualIdent mn (mkIdent "main")
cmdl = (mainName, ds)
- ref i = Var $ mkIdent $ "_" ++ showInt i
- defs = M.fromList [ (n, ref i) | ((n, _), i) <- zip ds (enumFrom 0) ]
+ ref i = Var $ mkIdent $ "_" ++ show i
+ defs = M.fromList [ (n, ref i) | ((n, _), i) <- zip ds (enumFrom (0::Int)) ]
findIdent n = fromMaybe (error $ "main: findIdent: " ++ showIdent n) $
M.lookup n defs
emain = findIdent mainName
@@ -50,11 +50,11 @@
e -> e
def :: ((Ident, Exp), Int) -> (String -> String) -> (String -> String)
def ((_, e), i) r =
- (("((A :" ++ showInt i ++ " ") ++) . toStringP (substv e) . (") " ++) . r . (")" ++)+ (("((A :" ++ show i ++ " ") ++) . toStringP (substv e) . (") " ++) . r . (")" ++)res = foldr def (toStringP emain) (zip ds (enumFrom 0)) ""
numDefs = M.size defs
when (verbose flags > 0) $
- putStrLn $ "top level defns: " ++ showInt numDefs
+ putStrLn $ "top level defns: " ++ show numDefs
when (verbose flags > 1) $
mapM_ (\ (i, e) -> putStrLn $ showIdent i ++ " = " ++ toStringP e "") ds
if runIt flags then do
@@ -65,10 +65,10 @@
prg
-- putStrLn "done"
else do
- writeFile (output flags) $ version ++ showInt numDefs ++ "\n" ++ res
+ writeFile (output flags) $ version ++ show numDefs ++ "\n" ++ res
t2 <- getTimeMilli
when (verbose flags > 0) $
- putStrLn $ "final pass " ++ padLeft 6 (showInt (t2-t1)) ++ "ms"
+ putStrLn $ "final pass " ++ padLeft 6 (show (t2-t1)) ++ "ms"
version :: String
version = "v4.0\n"
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -312,7 +312,7 @@
allClasses =
let
clss (_, TModule _ _ _ _ ces _ _ _) = ces
- in --(\ m -> trace ("allClasses: " ++ xshowList showIdentClassInfo (M.toList m)) m) $+ in --(\ m -> trace ("allClasses: " ++ showListS showIdentClassInfo (M.toList m)) m) $M.fromList $ concatMap clss mdls
allInsts :: InstTable
allInsts =
@@ -509,7 +509,7 @@
initTC :: IdentModule -> FixTable -> TypeTable -> SynTable -> ClassTable -> InstTable -> ValueTable -> AssocTable -> TCState
initTC mn fs ts ss cs is vs as =
--- trace ("**** initTC " ++ showIdent mn ++ ": " ++ xshowList (showPair showIdent showEType) (M.toList ss)) $+-- trace ("**** initTC " ++ showIdent mn ++ ": " ++ showListS (showPairS showIdent showEType) (M.toList ss)) $let
xts = foldr (uncurry stInsertGlb) ts primTypes
xvs = foldr (uncurry stInsertGlb) vs primValues
@@ -582,7 +582,7 @@
tuple n =
let
c = tupleConstr builtinLoc n
- vks = [IdKind (mkIdent ("a" ++ showInt i)) kType | i <- enumFromTo 1 n]+ vks = [IdKind (mkIdent ("a" ++ show i)) kType | i <- enumFromTo 1 n]ts = map tVarK vks
r = tApps c ts
in (c, [Entry (ECon $ ConData [(c, n)] c) $ EForall vks $ foldr tArrow r ts ])
@@ -762,7 +762,7 @@
newIdent :: SLoc -> String -> T Ident
newIdent loc s = T.do
u <- newUniq
- T.return $ mkIdentSLoc loc $ s ++ "$" ++ showInt u
+ T.return $ mkIdentSLoc loc $ s ++ "$" ++ show u
tLookup :: --XHasCallStack =>
String -> Ident -> T (Expr, EType)
@@ -799,7 +799,7 @@
tDict :: (Expr, EType) -> T (Expr, EType)
tDict (ae, at) | Just (ctx, t) <- getImplies at = T.do
u <- newUniq
- let d = mkIdentSLoc loc ("dict$" ++ showInt u)+ let d = mkIdentSLoc loc ("dict$" ++ show u)loc = getSLocExpr ae
--traceM $ "addConstraint: " ++ showIdent d ++ " :: " ++ showEType ctx ++ " " ++ showSLoc loc
addConstraint d ctx
@@ -1285,7 +1285,7 @@
tCheckExpr t e | Just (ctx, t') <- getImplies t = T.do
_ <- undefined -- XXX
u <- newUniq
- let d = mkIdentSLoc (getSLocExpr e) ("adict$" ++ showInt u)+ let d = mkIdentSLoc (getSLocExpr e) ("adict$" ++ show u)e' <- withDict d ctx $ tCheckExpr t' e
T.return $ eLam [EVar d] e'
tCheckExpr t e = tCheck tcExpr t e
@@ -1823,7 +1823,7 @@
allBinders :: [Ident] -- a,b,..z, a1, b1,... z1, a2, b2,...
allBinders = [ mkIdent [chr x] | x <- [ord 'a' .. ord 'z'] ] ++
- [ mkIdent (chr x : showInt i) | i <- [1 ..], x <- [ord 'a' .. ord 'z']]
+ [ mkIdent (chr x : show i) | i <- [1 ..], x <- [ord 'a' .. ord 'z']]
-}
skolemise :: --XHasCallStack =>
@@ -1848,7 +1848,7 @@
newSkolemTyVar :: Ident -> T Ident
newSkolemTyVar tv = T.do
uniq <- newUniq
- T.return (mkIdentSLoc (getSLocIdent tv) (unIdent tv ++ "#" ++ showInt uniq))
+ T.return (mkIdentSLoc (getSLocIdent tv) (unIdent tv ++ "#" ++ show uniq))
freeTyVars :: [EType] -> [TyVar]
-- Get the free TyVars from a type; no duplicates in result
@@ -1973,7 +1973,7 @@
mkSuperSel :: --XHasCallStack =>
Ident -> Int -> Ident
-mkSuperSel c i = addIdentSuffix c ("$super" ++ showInt i)+mkSuperSel c i = addIdentSuffix c ("$super" ++ show i)---------------------------------
@@ -1991,7 +1991,7 @@
{-showInstInfo :: InstInfo -> String
-showInstInfo (InstInfo m ds) = "InstInfo " ++ xshowList (showPair showIdent showExpr) (M.toList m) ++ " " ++ showList showInstDict ds
+showInstInfo (InstInfo m ds) = "InstInfo " ++ showListS (showPair showIdent showExpr) (M.toList m) ++ " " ++ showList showInstDict ds
showInstDict :: InstDict -> String
showInstDict (e, iks, ctx, ts) = showExpr e ++ " :: " ++ showEType (eForall iks $ addConstraints ctx (tApps (mkIdent "X") ts))
@@ -1998,13 +1998,13 @@
showInstDef :: InstDef -> String
showInstDef (cls, InstInfo m ds) = "instDef " ++ showIdent cls ++ ": "
- ++ xshowList (showPair showIdent showExpr) (M.toList m) ++ ", " ++ showList showInstDict ds
+ ++ showListS (showPair showIdent showExpr) (M.toList m) ++ ", " ++ showList showInstDict ds
showConstraint :: (Ident, EConstraint) -> String
showConstraint (i, t) = showIdent i ++ " :: " ++ showEType t
showMatch :: (Expr, [EConstraint]) -> String
-showMatch (e, ts) = showExpr e ++ " " ++ xshowList showEType ts
+showMatch (e, ts) = showExpr e ++ " " ++ showListS showEType ts
-}
-- Solve as many constraints as possible.
@@ -2031,7 +2031,7 @@
case getTupleConstr iCls of
Just _ -> T.do
goals <- T.mapM (\ c -> T.do { d <- newIdent loc "dict"; T.return (d, c) }) cts--- traceM ("split tuple " ++ xshowList showConstraint goals)+-- traceM ("split tuple " ++ showListS showConstraint goals)solve (goals ++ cnss) uns ((di, ETuple (map (EVar . fst) goals)) : sol)
Nothing ->
case M.lookup iCls it of
@@ -2053,7 +2053,7 @@
-- traceM ("solveGen " ++ showEType ct)let (_, ts) = getApp ct
matches = getBestMatches $ findMatches insts ts
--- traceM ("matches " ++ xshowList showMatch matches)+-- traceM ("matches " ++ showListS showMatch matches)case matches of
[] -> solve cnss (cns : uns) sol
[(de, ctx)] ->
@@ -2084,7 +2084,7 @@
let rrr =
[ (length s, (de, map (substEUVar s) ctx))
| (de, ctx, ts) <- ds, Just s <- [matchTypes [] ts its] ]
- in --trace ("findMatches: " ++ xshowList showInstDict ds ++ "; " ++ showEType ct ++ "; " ++ show rrr)+ in --trace ("findMatches: " ++ showListS showInstDict ds ++ "; " ++ showEType ct ++ "; " ++ show rrr)rrr
where
@@ -2151,7 +2151,7 @@
Nothing ->
case M.lookup i genv of
Just [e] -> Right e
- Just es -> Left $ "ambiguous " ++ msg ++ ": " ++ showIdent i ++ " " ++ xshowList showExpr [ e | Entry e _ <- es ]
+ Just es -> Left $ "ambiguous " ++ msg ++ ": " ++ showIdent i ++ " " ++ showListS showExpr [ e | Entry e _ <- es ]
Nothing -> Left $ "undefined " ++ msg ++ ": " ++ showIdent i
-- ++ "\n" ++ show lenv ++ "\n" ++ show genv
@@ -2174,7 +2174,7 @@
-----------------------------
{-showSymTab :: SymTab Entry -> String
-showSymTab (SymTab im ies) = xshowList showIdent (map fst (M.toList im) ++ map fst ies)
+showSymTab (SymTab im ies) = showListS showIdent (map fst (M.toList im) ++ map fst ies)
showTModuleExps :: TModule a -> String
showTModuleExps (TModule mn _fxs tys _syns _clss _insts vals _defs) =
@@ -2188,10 +2188,10 @@
showTypeExport :: TypeExport -> String
showTypeExport (TypeExport i (Entry qi t) vs) =
- showIdent i ++ " = " ++ showExpr qi ++ " :: " ++ showEType t ++ " assoc=" ++ xshowList showValueExport vs
+ showIdent i ++ " = " ++ showExpr qi ++ " :: " ++ showEType t ++ " assoc=" ++ showListS showValueExport vs
showIdentClassInfo :: (Ident, ClassInfo) -> String
showIdentClassInfo (i, (_vks, _ctx, cc, ms)) =
showIdent i ++ " :: " ++ showEType cc ++
- " has " ++ xshowList showIdent ms
+ " has " ++ showListS showIdent ms
-}
--- a/tests/Foreign.hs
+++ b/tests/Foreign.hs
@@ -6,6 +6,6 @@
main :: IO ()
main = do
x1 <- abs (3 - 8)
- putStrLn $ showInt x1
+ putStrLn $ show x1
x2 <- abs (10 - 8)
- putStrLn $ showInt x2
+ putStrLn $ show x2
--- a/tests/Word.hs
+++ b/tests/Word.hs
@@ -4,10 +4,10 @@
main :: IO ()
main = do
- putStrLn $ showInt 4294967295
- putStrLn $ W.showWord (W.intToWord 1000)
- putStrLn $ W.showWord twoTo32M1
- putStrLn $ W.showWord $ (W.*) twoTo32M1 twoTo32M1
+ putStrLn $ show 4294967295
+ putStrLn $ show (W.intToWord 1000)
+ putStrLn $ show twoTo32M1
+ putStrLn $ show $ (W.*) twoTo32M1 twoTo32M1
twoTo32M1 :: W.Word
twoTo32M1 = W.intToWord 4294967295
--
⑨