shithub: MicroHs

Download patch

ref: b96d264b5f18fbecc584f36ff502f73a4dc8319b
parent: 638e7ca702c9c27bd58a72d68b0862c86e68c25b
author: Lennart Augustsson <lennart@augustsson.net>
date: Thu Nov 2 09:29:21 EDT 2023

More show instances

--- a/Example.hs
+++ b/Example.hs
@@ -10,4 +10,4 @@
   let
     rs = map fac [1,2,3,10]
   putStrLn "Some factorials"
-  putStrLn $ show rs
+  print rs
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1195
-((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 _1067) _21)) ((A :23 (((S' _1067) _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 _1067) (_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 (((_1165 (K ((P (_1174 "False")) (_1174 "True")))) (_1170 _67)) (_1171 _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 (((_1165 (K ((B (_120 (_1173 #39))) (((C' _120) ((B _1174) _86)) (_1173 #39))))) (_1170 _85)) ((B (_120 (_1173 #34))) (Y ((B (P (_1173 #34))) ((C' B) ((B _120) ((B _1174) _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
+1190
+((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/Maybe.hs
+++ b/lib/Data/Maybe.hs
@@ -19,7 +19,7 @@
   _       == _        =  False
 
 instance forall a . (Show a) => Show (Maybe a) where
-  showsPrec _ Nothing  = showsPrec 0 "Nothing"
+  showsPrec _ Nothing  = showString "Nothing"
   showsPrec p (Just a) = showParen (p >= 11) (showString "Just " . showsPrec 11 a)
 
 -- XXX instance Monad Maybe
--- a/lib/System/IO.hs
+++ b/lib/System/IO.hs
@@ -18,6 +18,7 @@
 import Data.Functor
 import Data.Maybe
 import Data.Tuple
+import Text.Show
 
 type FilePath = String
 
@@ -107,8 +108,11 @@
 getChar :: IO Char
 getChar = hGetChar stdin
 
-print :: forall a . a -> IO ()
-print = primHPrint stdout
+cprint :: forall a . a -> IO ()
+cprint = primHPrint stdout
+
+print :: forall a . (Show a) => a -> IO ()
+print a = putStrLn (show a)
 
 {-
 mapM :: forall a b . (a -> IO b) -> [a] -> IO [b]
--- a/lib/Text/String.hs
+++ b/lib/Text/String.hs
@@ -36,6 +36,7 @@
 readDouble :: String -> Double
 readDouble = primDoubleRead
 
+{-
 showBool :: Bool -> String
 showBool arg =
   case arg of
@@ -52,9 +53,6 @@
   case ab of
     (a, b) -> "(" ++ sa a ++ "," ++ sb b ++ ")"
 
-xshowList :: forall a . (a -> String) -> [a] -> String
-xshowList sa as = "[" ++ intercalate "," (map sa as) ++ "]"
-
 showMaybe :: forall a . (a -> String) -> Maybe a -> String
 showMaybe _ Nothing = "Nothing"
 showMaybe fa (Just a) = "(Just " ++ fa a ++ ")"
@@ -67,6 +65,10 @@
 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 "" = []
--- a/tests/Class.hs
+++ b/tests/Class.hs
@@ -38,8 +38,8 @@
 
 main :: IO ()
 main = do
-  putStrLn $ showBool $ f 5
-  putStrLn $ showBool $ g 5
-  putStrLn $ showBool $ h 5 'a'
-  putStrLn $ showBool $ f [88]
-  putStrLn $ showBool $ f (1, 'a')
+  putStrLn $ show $ f 5
+  putStrLn $ show $ g 5
+  putStrLn $ show $ h 5 'a'
+  putStrLn $ show $ f [88]
+  putStrLn $ show $ f (1, 'a')
--- a/tests/Fac.ref
+++ b/tests/Fac.ref
@@ -1,2 +1,2 @@
-#720
-#6321337
+720
+6321337
--- a/tests/IOTest.hs
+++ b/tests/IOTest.hs
@@ -23,7 +23,7 @@
   p
   p
   p
-  print (+)
+  cprint (+)
   hout <- openFile "test.tmp" WriteMode
   hPutChar hout 'a'
   hPutChar hout 'z'
@@ -31,7 +31,7 @@
   hin <- openFile "test.tmp" ReadMode
   c1 <- hGetChar hin
   c2 <- hGetChar hin
-  putStrLn $ showPair show show (c1, c2)
+  putStrLn $ show (c1, c2)
   writeFile "test2.tmp" "more\n"
   s <- readFile "test2.tmp"
   putStrLn (show s)
--- a/tests/Infix.hs
+++ b/tests/Infix.hs
@@ -16,4 +16,4 @@
 
 main :: IO ()
 main = do
-  putStrLn $ showBool $ 2 +++ 3 &&& 4 === 17
+  putStrLn $ show $ 2 +++ 3 &&& 4 === 17
--- a/tests/ListTest.hs
+++ b/tests/ListTest.hs
@@ -3,7 +3,7 @@
 
 main :: IO ()
 main = do
-  putStrLn $ showInt $ sum [1,2,3]
-  putStrLn $ showInt $ product [1,2,3,4]
-  putStrLn $ showBool $ and [True]
-  putStrLn $ showBool $ and [True, False]
+  putStrLn $ show $ sum [1,2,3]
+  putStrLn $ show $ product [1,2,3,4]
+  putStrLn $ show $ and [True]
+  putStrLn $ show $ and [True, False]
--- a/tests/LocalPoly.hs
+++ b/tests/LocalPoly.hs
@@ -3,7 +3,7 @@
 
 main :: IO ()
 main = do
-  putStrLn $ showPair (showPair show show) (showPair show show) $ f 1 "a"
+  putStrLn $ show $ f 1 "a"
 
 f :: forall b . Int -> b -> ((Int, b), (b, b))
 f x b = (i x, i b)
--- a/tests/Misc.ref
+++ b/tests/Misc.ref
@@ -1,1 +1,1 @@
-#10
+10
--- a/tests/Rank2.hs
+++ b/tests/Rank2.hs
@@ -14,7 +14,7 @@
 
 main :: IO ()
 main = do
-  putStrLn $ showPair showInt showBool $ f id
-  putStrLn $ showPair showInt showBool $ g const
+  putStrLn $ show $ f id
+  putStrLn $ show $ g const
   case iD of
-    Id i -> putStrLn $ showPair showInt showBool (i 1, i True)
+    Id i -> putStrLn $ show (i 1, i True)
--- a/tests/StringTest.hs
+++ b/tests/StringTest.hs
@@ -15,8 +15,8 @@
   putStrLn $ show [1,20,3]
   putStrLn $ show [1]
   putStrLn $ show ([] :: [Int])
-  putStrLn $ showPair show show (123, 'a')
-  putStrLn $ showMaybe show (Nothing :: Maybe Int)
-  putStrLn $ showMaybe show (Just 890)
-  putStrLn $ showEither show show (Left   678 :: Either Int Bool)
-  putStrLn $ showEither show show (Right True :: Either Int Bool)
+  putStrLn $ show (123, 'a')
+  putStrLn $ show (Nothing :: Maybe Int)
+  putStrLn $ show (Just 890)
+  putStrLn $ show (Left   678 :: Either Int Bool)
+  putStrLn $ show (Right True :: Either Int Bool)
--- a/tests/StringTest.ref
+++ b/tests/StringTest.ref
@@ -11,6 +11,6 @@
 []
 (123,'a')
 Nothing
-(Just 890)
-(Left 678)
-(Right True)
+Just 890
+Left 678
+Right True
--