ref: eb6691cb4f14ed2613fd032f88e64e6ee31c7422
parent: 3fe400e38dab0f77ac0473d43607182c08d38353
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Thu Nov 2 07:40:35 EDT 2023
Half way converted to Text.Show.
--- a/Example.hs
+++ b/Example.hs
@@ -10,4 +10,4 @@
let
rs = map fac [1,2,3,10]
putStrLn "Some factorials"
- putStrLn $ showList showInt rs
+ putStrLn $ show rs
--- a/Makefile
+++ b/Makefile
@@ -55,6 +55,7 @@
$(GHCC) -c lib/Control/Error.hs
$(GHCC) -c lib/Data/Eq.hs
$(GHCC) -c lib/Data/Ord.hs
+ $(GHCC) -c lib/Text/Show.hs
$(GHCC) -c lib/Data/Bool.hs
$(GHCC) -c lib/Data/Tuple.hs
$(GHCC) -c lib/Data/Function.hs
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v4.0
-1171
-((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' _128) ((B _12) _1)) _235))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _234))) ((A :10 (((S' P) _2) (((C' _13) _1) _937))) ((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' _125) _12) _117))) ((A :20 (((S' B) _14) (((C' _128) _12) _118))) ((A :21 _1009) ((A :22 ((B _1051) _21)) ((A :23 (((S' _1051) _21) I)) ((A :24 _979) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1008) ((C _116) _26))) ((A :28 (((C' _27) ((_124 _1022) _106)) ((_116 (_34 _1024)) _105))) ((A :29 ((B ((S _1051) (_34 _1024))) _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) _234)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _235)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _937)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _937))) ((A :46 ((C _43) _117)) ((A :47 ((B _119) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _119) _48)) ((A :50 T) ((A :51 ((_123 ((B (B (_114 _50))) ((B ((C' C) _54)) (B P)))) (_127 _51))) ((A :52 (((((_11 _51) ((B (_114 _50)) P)) (_38 _53)) ((B (B (_114 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_114 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_116 _264)) _54)) ((A :56 ((B (_114 _50)) (B (P _937)))) ((A :57 ((B (_114 _50)) (BK (P _937)))) ((A :58 ((_114 _50) ((S P) I))) ((A :59 ((B (_114 _50)) ((C (S' P)) I))) ((A :60 ((_109 ((C ((C S') _63)) I)) (_113 _60))) ((A :61 (R _68)) ((A :62 (T _67)) ((A :63 ((P _68) _67)) ((A :64 _68) ((A :65 ((C ((C S') _63)) I)) ((A :66 ((C S) _63)) ((A :67 K) ((A :68 A) ((A :69 ((_109 _973) _974)) ((A :70 ((((((((_243 _69) (_252 _70)) _975) _976) _977) _978) (_257 _70)) (_258 _70))) ((A :71 ((_109 _983) (_113 _71))) ((A :72 ((((((((_243 _71) _982) (((C' (C' (_110 _259))) _982) _261)) (((C' (C' (_111 _259))) _982) _263)) (((C' (C' (_110 _259))) _982) _263)) (((C' (C' (_111 _259))) _982) _263)) (_257 _72)) (_258 _72))) ((A :73 _984) ((A :74 _985) ((A :75 (((S' _62) (_976 #97)) ((C _976) #122))) ((A :76 (((S' _62) (_976 #65)) ((C _976) #90))) ((A :77 (((S' _61) _75) _76)) ((A :78 (((S' _62) (_976 #48)) ((C _976) #57))) ((A :79 (((S' _61) _77) _78)) ((A :80 (((S' _62) (_976 #32)) ((C _976) #126))) ((A :81 (((S' _61) ((C (_110 _69)) #32)) (((S' _61) ((C (_110 _69)) #9)) ((C (_110 _69)) #10)))) ((A :82 ((S ((S (((S' _62) (_976 #65)) ((C _976) #90))) (_68 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _73) (((C' _129) (((C' _130) _74) (_74 #65))) (_74 #97))))) ((A :83 ((S ((S (((S' _62) (_976 #97)) ((C _976) #97))) (_68 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _73) (((C' _129) (((C' _130) _74) (_74 #97))) (_74 #65))))) ((A :84 _944) ((A :85 _945) ((A :86 _946) ((A :87 _947) ((A :88 (_85 %0.0)) ((A :89 _84) ((A :90 _85) ((A :91 _86) ((A :92 _87) ((A :93 ((_109 _948) _949)) ((A :94 (_110 _93)) ((A :95 (_111 _93)) ((A :96 _950) ((A :97 _951) ((A :98 _952) ((A :99 _953) ((A :100 _96) ((A :101 _97) ((A :102 _98) ((A :103 _99) ((A :104 _954) ((A :105 ((B BK) T)) ((A :106 (BK T)) ((A :107 (((S' _109) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _110) (T K)))) (K _67)))) ((B ((C' B) (T (K _67)))) ((B _110) (T
\ No newline at end of file
+1186
+((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' _131) ((B _12) _1)) _241))) _5)) ((A :9 ((S (((S' C') _3) _4)) (((C' _13) _1) _240))) ((A :10 (((S' P) _2) (((C' _13) _1) _944))) ((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' _128) _12) _120))) ((A :20 (((S' B) _14) (((C' _131) _12) _121))) ((A :21 _1016) ((A :22 ((B _1058) _21)) ((A :23 (((S' _1058) _21) I)) ((A :24 _986) ((A :25 (_24 "undefined")) ((A :26 I) ((A :27 (((C' B) _1015) ((C _119) _26))) ((A :28 (((C' _27) ((_127 _1029) _109)) ((_119 (_34 _1031)) _108))) ((A :29 ((B ((S _1058) (_34 _1031))) _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) _240)))) (((S' (C' B)) ((B (B (C' B))) (B' _32))) (((S' (C' (C' B))) (B' _32)) (((C' B) (B' _34)) _241)))))) ((A :44 ((B (B Y)) (((S' B) (B' ((B P) ((C _34) _944)))) (((C' (C' B)) ((B (B (C' B))) (B' _32))) BK)))) ((A :45 ((B T) ((C _34) _944))) ((A :46 ((C _43) _120)) ((A :47 ((B _122) _32)) ((A :48 ((B C) ((B C') _32))) ((A :49 ((B _122) _48)) ((A :50 T) ((A :51 ((_126 ((B (B (_117 _50))) ((B ((C' C) _54)) (B P)))) (_130 _51))) ((A :52 (((((_11 _51) ((B (_117 _50)) P)) (_38 _53)) ((B (B (_117 _50))) (((C' B) ((B C) _54)) (BK _54)))) (_20 _52))) ((A :53 ((((_30 _52) ((B (B (_117 _50))) (((C' B) ((B C) _54)) (B _54)))) (_15 _52)) (_13 _52))) ((A :54 (T I)) ((A :55 ((B (_119 _271)) _54)) ((A :56 ((B (_117 _50)) (B (P _944)))) ((A :57 ((B (_117 _50)) (BK (P _944)))) ((A :58 ((_117 _50) ((S P) I))) ((A :59 ((B (_117 _50)) ((C (S' P)) I))) ((A :60 ((_112 ((C ((C S') _63)) I)) (_116 _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 (((_1156 (K ((P (_1165 "False")) (_1165 "True")))) (_1161 _67)) (_1162 _67))) ((A :68 K) ((A :69 A) ((A :70 ((_112 _980) _981)) ((A :71 ((((((((_250 _70) (_259 _71)) _982) _983) _984) _985) (_264 _71)) (_265 _71))) ((A :72 ((_112 _990) (_116 _72))) ((A :73 ((((((((_250 _72) _989) (((C' (C' (_113 _266))) _989) _268)) (((C' (C' (_114 _266))) _989) _270)) (((C' (C' (_113 _266))) _989) _270)) (((C' (C' (_114 _266))) _989) _270)) (_264 _73)) (_265 _73))) ((A :74 _991) ((A :75 _992) ((A :76 (((S' _62) (_983 #97)) ((C _983) #122))) ((A :77 (((S' _62) (_983 #65)) ((C _983) #90))) ((A :78 (((S' _61) _76) _77)) ((A :79 (((S' _62) (_983 #48)) ((C _983) #57))) ((A :80 (((S' _61) _78) _79)) ((A :81 (((S' _62) (_983 #32)) ((C _983) #126))) ((A :82 (((S' _61) ((C (_113 _70)) #32)) (((S' _61) ((C (_113 _70)) #9)) ((C (_113 _70)) #10)))) ((A :83 ((S ((S (((S' _62) (_983 #65)) ((C _983) #90))) (_69 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _74) (((C' _132) (((C' _133) _75) (_75 #65))) (_75 #97))))) ((A :84 ((S ((S (((S' _62) (_983 #97)) ((C _983) #97))) (_69 (((noMatch "lib/Data/Char.hs") #3) #8)))) ((B _74) (((C' _132) (((C' _133) _75) (_75 #97))) (_75 #65))))) ((A :85 (((_1156 (K ((B (_119 (_1164 #39))) (((C' _119) ((B _1165) _86)) (_1164 #39))))) (_1161 _85)) ((B (_119 (_1164 #34))) (Y ((B (P (_1164 #34))) ((C' B) ((B _119) ((B _1165) _86)))))))) ((A :86 (((C' Y) (((S' B) ((B P) ((S ((C _81) "XXX")) ((C O) K)))) ((B (B (C B))) (B' ((B C) (C (_113 _70))))))) ((O ((P #10) "\92&n")) ((O ((P #13) "\92&r")) ((O ((P #9) "\92&t")) ((O ((P #8) "\92&b")) ((O ((P #92)
\ No newline at end of file
--- a/ghc/Data/List_Type.hs
+++ b/ghc/Data/List_Type.hs
@@ -1,2 +1,2 @@
-module Data.List_Type() where
+module Data.List_Type((++)) where
-- There is no need to export anything, ghc always provides the list syntax.
--- a/lib/Data/Bool.hs
+++ b/lib/Data/Bool.hs
@@ -7,6 +7,7 @@
import Primitives
import Data.Bool_Type
import Data.Eq
+import Text.Show
instance Eq Bool where
False == x = not x
@@ -36,3 +37,7 @@
neBool :: Bool -> Bool -> Bool
neBool True x = not x
neBool False x = x
+
+instance Show Bool where
+ showsPrec _ False = showString "False"
+ showsPrec _ True = showString "True"
--- a/lib/Data/Char.hs
+++ b/lib/Data/Char.hs
@@ -8,8 +8,11 @@
import Data.Bool
import Data.Char_Type
import Data.Eq
+import Data.Function
import Data.Int
+import Data.List_Type
import Data.Ord
+import Text.Show
instance Eq Char where
(==) = primCharEQ
@@ -79,3 +82,19 @@
toUpper :: Char -> Char
toUpper c | primCharLE 'a' c && primCharLE c 'a' = chr (ord c - ord 'a' + ord 'A')
| True = c
+
+instance Show Char where
+ showsPrec _ c = showChar '\'' . showString (encodeChar c) . showChar '\''
+ showList s = showChar '"' . f s
+ where f [] = showChar '"'
+ f (c:cs) = showString (encodeChar c) . f cs
+
+-- XXX should not export this
+encodeChar :: Char -> String
+encodeChar c =
+ let
+ spec = [('\n', "\\n"), ('\r', "\\r"), ('\t', "\\t"), ('\b', "\\b"),+ ('\\', "\\\\"), ('\'', "\\'"), ('"', "\"")]+ look [] = if isPrint c then [c] else "XXX" -- "'\\" ++ showInt (ord c) ++ "'"
+ look ((d,s):xs) = if d == c then s else look xs
+ in look spec
--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -4,6 +4,7 @@
import Primitives
import Data.Bool_Type
import Data.Eq
+import Text.Show
infixl 6 +,-
infixl 7 *
@@ -76,7 +77,7 @@
-- | this primitive will print doubles with up to 6 decimal points
-- it turns out that doubles are extremely tricky, and just printing them is a
-- herculean task of its own...
-showDouble :: Double -> [Char]
-showDouble = primDoubleShow
+instance Show Double where
+ show = primDoubleShow
--------------------------------
--- a/lib/Data/Int.hs
+++ b/lib/Data/Int.hs
@@ -3,8 +3,11 @@
module Data.Int(module Data.Int, Int) where
import Primitives
import Data.Bool_Type
+import Data.Char_Type
import Data.Eq
+import Data.List_Type
import Data.Ord
+import Text.Show
infixl 6 +,-
infixl 7 *,`quot`,`rem`
@@ -60,3 +63,24 @@
(>=) = primIntGE
--------------------------------
+
+instance Show Int where
+ show = showInt
+
+-- XXX these should not be exported
+-- XXX wrong for minInt
+showInt :: Int -> String
+showInt n =
+ if n < 0 then
+ '-' : showUnsignedInt (negate n)
+ else
+ 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]
--- a/lib/Data/List.hs
+++ b/lib/Data/List.hs
@@ -17,6 +17,7 @@
import Data.Ord
import Data.Maybe
import Data.Tuple
+import Text.Show
--Yimport Data.Char
@@ -38,14 +39,12 @@
instance MonadFail [] where
fail _ = []
+instance forall a . Show a => Show [a] where
+ showsPrec _ = showList
+
null :: forall a . [a] -> Bool
null [] = True
null _ = False
-
-infixr 5 ++
-(++) :: forall a . [a] -> [a] -> [a]
-(++) [] ys = ys
-(++) (x : xs) ys = x : xs ++ ys
concat :: forall a . [[a]] -> [a]
concat = foldr (++) []
--- a/lib/Data/List_Type.hs
+++ b/lib/Data/List_Type.hs
@@ -1,4 +1,12 @@
module Data.List_Type(module Data.List_Type) where
+import Primitives
infixr 5 :
data [] a = [] | (:) a [a] -- Parser hacks makes this acceptable
+
+-- This does not really belong here, but it makes the module structure
+-- much simpler.
+infixr 5 ++
+(++) :: forall a . [a] -> [a] -> [a]
+(++) [] ys = ys
+(++) (x : xs) ys = x : xs ++ ys
--- a/lib/Prelude.hs
+++ b/lib/Prelude.hs
@@ -16,6 +16,7 @@
module Data.Ord,
module Data.Tuple,
module System.IO,
+ module Text.Show,
module Text.String,
--Ymodule Primitives,
) where
@@ -35,6 +36,7 @@
import Data.Ord
import Data.Tuple
import System.IO
+import Text.Show
import Text.String
{---- a/lib/Primitives.hs
+++ b/lib/Primitives.hs
@@ -2,7 +2,7 @@
-- See LICENSE file for full license.
module Primitives(module Primitives) where
import Data.Bool_Type
-import Data.List_Type
+--import Data.List_Type
import Data.Ordering_Type
infixr -1 ->
@@ -18,8 +18,7 @@
data Word
-- Type equality as a constraint.
--- XXX No functional dependencies yet.
-class a ~ b {- a -> b, b -> a -}+class a ~ b {-x | a -> b, b -> a-}data () = () -- Parser hacks allows () to be used
--- a/lib/Text/Show.hs
+++ b/lib/Text/Show.hs
@@ -1,15 +1,33 @@
module Text.Show(module Text.Show) where
-import Data.Char
-import Data.Int
+import Primitives
+import Data.Bool_Type
+import Data.Char_Type
+import Data.List_Type
type ShowS = String -> String
class Show a where
showsPrec :: Int -> a -> ShowS
- show :: a -> String
- showList :: [a] -> ShowS
+ show :: a -> String
+ showList :: [a] -> ShowS
---showChar :: Char -> ShowS
---showParen :: Bool -> ShowS -> ShowS
---showString :: String -> ShowS
---shows :: forall a . Show a => 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)
+
+shows :: forall a . Show a => a -> ShowS
+shows = showsPrec 0
+
+showChar :: Char -> ShowS
+showChar = (:)
+
+showString :: String -> ShowS
+showString = (++)
+
+showParen :: Bool -> ShowS -> ShowS
+showParen False sh = sh
+showParen True sh = \ x -> '(' : sh (')' : x)--- a/lib/Text/String.hs
+++ b/lib/Text/String.hs
@@ -14,11 +14,11 @@
import Data.Ord
import Data.Tuple
-showChar :: Char -> String
-showChar c = "'" ++ encodeChar c ++ "'"
+xshowChar :: Char -> String
+xshowChar c = "'" ++ xencodeChar c ++ "'"
-encodeChar :: Char -> String
-encodeChar c =
+xencodeChar :: Char -> String
+xencodeChar c =
let
spec = [('\n', "\\n"), ('\r', "\\r"), ('\t', "\\t"), ('\b', "\\b"), ('\\', "\\\\"), ('\'', "\\'"), ('"', "\"")]@@ -27,26 +27,6 @@
Nothing -> if isPrint c then [c] else "'\\" ++ showInt (ord c) ++ "'"
Just s -> s
-showString :: String -> String
-showString s = "\"" ++ concatMap encodeChar s ++ "\""
-
--- XXX wrong for minInt
-showInt :: Int -> String
-showInt n =
- if n < 0 then
- '-' : showUnsignedInt (negate n)
- else
- showUnsignedInt n
-
-showUnsignedInt :: Int -> String
-showUnsignedInt n =
- let
- c = chr (ord '0' + rem n 10)
- in if n < 10 then
- [c]
- else
- showUnsignedInt (quot n 10) ++ [c]
-
readInt :: String -> Int
readInt cs =
let
@@ -72,8 +52,8 @@
case ab of
(a, b) -> "(" ++ sa a ++ "," ++ sb b ++ ")"-showList :: forall a . (a -> String) -> [a] -> String
-showList sa as = "[" ++ intercalate "," (map sa as) ++ "]"
+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"
--- a/src/Compat.hs
+++ b/src/Compat.hs
@@ -41,8 +41,8 @@
showDouble :: Double -> String
showDouble = show
-showChar :: Char -> String
-showChar = show
+xshowChar :: Char -> String
+xshowChar = show
showBool :: Bool -> String
showBool = show
@@ -53,8 +53,8 @@
showString :: String -> String
showString = show
-showList :: (a -> String) -> [a] -> String
-showList sa arg =
+xshowList :: (a -> String) -> [a] -> String
+xshowList sa arg =
let
showRest as =
case as of
--- a/src/MicroHs/Compile.hs
+++ b/src/MicroHs/Compile.hs
@@ -6,7 +6,7 @@
compileCacheTop,
Cache, emptyCache, deleteFromCache,
) where
-import Prelude --Xhiding (Monad(..), mapM, showString, showList)
+import Prelude --Xhiding (Monad(..), mapM)
import qualified System.IO as IO
import Control.DeepSeq
import qualified MicroHs.IdentMap as M
@@ -145,7 +145,7 @@
readFilePath path name = IO.do
mh <- openFilePath path name
case mh of
- Nothing -> error $ "File not found: " ++ showString name ++ "\npath=" ++ showList showString path
+ Nothing -> error $ "File not found: " ++ show name ++ "\npath=" ++ xshowList 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
@@ -5,7 +5,7 @@
desugar,
LDef, showLDefs,
) where
-import Prelude --Xhiding(showList)
+import Prelude
import Data.Char
import Data.List
import Data.Maybe
@@ -292,7 +292,7 @@
type Matrix = [Arm]
--showArm :: Arm -> String
---showArm (ps, _, b) = showList showExpr ps ++ "," ++ showBool b
+--showArm (ps, _, b) = xshowList showExpr ps ++ "," ++ showBool b
newIdents :: Int -> M [Ident]
newIdents n = S.do
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -34,7 +34,7 @@
Assoc(..), eqAssoc, Fixity,
getBindsVars,
) where
-import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>), showString, showChar, showList, (<>))
+import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>), (<>))
import Data.Maybe
import MicroHs.Ident
import qualified Data.Double as D
@@ -408,7 +408,7 @@
case mis of
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 " ++ showString ie) <+> ppIdent i <+> text "::" <+> ppEType t+ 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))where f AssocLeft = "l"; f AssocRight = "r"; f AssocNone = ""
Class sup lhs fds bs -> ppWhere (text "class" <+> ctx sup <+> ppLHS lhs <+> ppFunDeps fds) bs
@@ -508,10 +508,10 @@
showLit :: Lit -> String
showLit l =
case l of
- LInt i -> '#' : showInt i
- LDouble d -> '%' : D.showDouble d
- LChar c -> showChar c
- LStr s -> showString s
+ LInt i -> '#' : show i
+ LDouble d -> '%' : show d
+ LChar c -> xshowChar c
+ LStr s -> show s
LPrim s -> s
LForImp s -> '^' : s
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -17,12 +17,11 @@
expectQualified,
) where
import Data.Eq
-import Prelude --Xhiding(showString)
+import Prelude
import Data.Char
import Text.PrettyPrint.HughesPJ
--Ximport Control.DeepSeq
--Yimport Primitives(NFData(..))
---Ximport Compat
--Ximport GHC.Stack
type Line = Int
@@ -138,4 +137,4 @@
showSLoc :: SLoc -> String
showSLoc (SLoc fn l c) =
if null fn then "no location" else
- showString fn ++ ": " ++ "line " ++ showInt l ++ ", col " ++ showInt c
+ show fn ++ ": " ++ "line " ++ show l ++ ", col " ++ show c
--- a/src/MicroHs/Lex.hs
+++ b/src/MicroHs/Lex.hs
@@ -2,7 +2,7 @@
lexTop,
Token(..), showToken,
tokensLoc) where
-import Prelude --Xhiding(lex, showChar, showString)
+import Prelude --Xhiding(lex)
import Data.Char
import Data.List
import qualified Data.Double as D
@@ -23,10 +23,10 @@
showToken :: Token -> String
showToken (TIdent _ ss s) = intercalate "." (ss ++ [s])
-showToken (TString _ s) = showString s
-showToken (TChar _ c) = showChar c
-showToken (TInt _ i) = showInt i
-showToken (TDouble _ d) = D.showDouble d
+showToken (TString _ s) = show s
+showToken (TChar _ c) = show c
+showToken (TInt _ i) = show i
+showToken (TDouble _ d) = show d
showToken (TSpec _ c) = [c]
showToken (TError _ s) = "ERROR " ++ s
showToken (TBrace _) = "TBrace"
@@ -102,7 +102,7 @@
tchar _ = TError loc "Illegal Char literal"
in case takeChars loc tchar '\'' 0 [] cs of -- XXX head of
(t, n, rs) -> t : lex (addCol loc $ 2 + n) rs
-lex loc (d:_) = [TError loc $ "Unrecognized input: " ++ showChar d]
+lex loc (d:_) = [TError loc $ "Unrecognized input: " ++ xshowChar d]
lex _ [] = []
number :: Loc -> String -> String -> [Token] -- neg=1 means negative, neg=0 means positive
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -2,7 +2,7 @@
-- See LICENSE file for full license.
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-unused-do-bind #-}module MicroHs.Parse(pTop, parseDie, parse, pExprTop) where
-import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>), showString, showChar, showList)
+import Prelude --Xhiding (Monad(..), Applicative(..), MonadFail(..), Functor(..), (<$>))
import Data.Char
import Data.List
import Text.ParserComb as P
--- a/src/MicroHs/TypeCheck.hs
+++ b/src/MicroHs/TypeCheck.hs
@@ -13,7 +13,7 @@
listPrefix,
) where
import Data.Eq -- XXX why needed?
-import Prelude --Xhiding(showList)
+import Prelude
import Data.Char
import Data.List
import Data.Maybe
@@ -312,7 +312,7 @@
allClasses =
let
clss (_, TModule _ _ _ _ ces _ _ _) = ces
- in --(\ m -> trace ("allClasses: " ++ showList showIdentClassInfo (M.toList m)) m) $+ in --(\ m -> trace ("allClasses: " ++ xshowList 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 ++ ": " ++ showList (showPair showIdent showEType) (M.toList ss)) $+-- trace ("**** initTC " ++ showIdent mn ++ ": " ++ xshowList (showPair showIdent showEType) (M.toList ss)) $let
xts = foldr (uncurry stInsertGlb) ts primTypes
xvs = foldr (uncurry stInsertGlb) vs primValues
@@ -1991,7 +1991,7 @@
{-showInstInfo :: InstInfo -> String
-showInstInfo (InstInfo m ds) = "InstInfo " ++ showList (showPair showIdent showExpr) (M.toList m) ++ " " ++ showList showInstDict ds
+showInstInfo (InstInfo m ds) = "InstInfo " ++ xshowList (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 ++ ": "
- ++ showList (showPair showIdent showExpr) (M.toList m) ++ ", " ++ showList showInstDict ds
+ ++ xshowList (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 ++ " " ++ showList showEType ts
+showMatch (e, ts) = showExpr e ++ " " ++ xshowList 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 " ++ showList showConstraint goals)+-- traceM ("split tuple " ++ xshowList 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 " ++ showList showMatch matches)+-- traceM ("matches " ++ xshowList 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: " ++ showList showInstDict ds ++ "; " ++ showEType ct ++ "; " ++ show rrr)+ in --trace ("findMatches: " ++ xshowList 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 ++ " " ++ showList showExpr [ e | Entry e _ <- es ]
+ Just es -> Left $ "ambiguous " ++ msg ++ ": " ++ showIdent i ++ " " ++ xshowList 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) = showList showIdent (map fst (M.toList im) ++ map fst ies)
+showSymTab (SymTab im ies) = xshowList 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=" ++ showList showValueExport vs
+ showIdent i ++ " = " ++ showExpr qi ++ " :: " ++ showEType t ++ " assoc=" ++ xshowList showValueExport vs
showIdentClassInfo :: (Ident, ClassInfo) -> String
showIdentClassInfo (i, (_vks, _ctx, cc, ms)) =
showIdent i ++ " :: " ++ showEType cc ++
- " has " ++ showList showIdent ms
+ " has " ++ xshowList showIdent ms
-}
--- a/tests/Arith.hs
+++ b/tests/Arith.hs
@@ -3,6 +3,6 @@
main :: IO ()
main = do
- putStrLn $ showList showInt [ op x y | x <- [0 - 5,0 - 2,0 - 1,0,1,2,5], y <- [0 - 5,0 - 2,0 - 1,0,1,2,5], op <- [(+),( - ),(*)] ]
- putStrLn $ showList showInt [ op x y | x <- [0 - 5,0 - 2,0 - 1,0,1,2,5], y <- [0 - 5,0 - 2,0 - 1,1,2,5], op <- [quot, rem] ]
- putStrLn $ showList showBool [ op x y | x <- [0 - 5,0 - 2,0 - 1,0,1,2,5], y <- [0 - 5,0 - 2,0 - 1,0,1,2,5], op <- [(==),(/=),(<),(<=),(>),(>=)] ]
+ putStrLn $ show [ op x y | x <- [0 - 5,0 - 2,0 - 1,0,1,2,5], y <- [0 - 5,0 - 2,0 - 1,0,1,2,5], op <- [(+),( - ),(*)] ]
+ putStrLn $ show [ op x y | x <- [0 - 5,0 - 2,0 - 1,0,1,2,5], y <- [0 - 5,0 - 2,0 - 1,1,2,5], op <- [quot, rem] ]
+ putStrLn $ show [ op x y | x <- [0 - 5,0 - 2,0 - 1,0,1,2,5], y <- [0 - 5,0 - 2,0 - 1,0,1,2,5], op <- [(==),(/=),(<),(<=),(>),(>=)] ]
--- a/tests/Case.hs
+++ b/tests/Case.hs
@@ -3,16 +3,16 @@
main :: IO ()
main = do
- putStrLn $ showBool $ f1 False
- putStrLn $ showInt $ f2 False
- putStrLn $ showInt $ f2 True
+ putStrLn $ show $ f1 False
+ putStrLn $ show $ f2 False
+ putStrLn $ show $ f2 True
-- putStrLn $ showInt $ f3 False
- putStrLn $ showList showRGB $ map f4 [R,G,B]
- putStrLn $ showInt $ f5 [(3,4)]
+ putStrLn $ show $ map f4 [R,G,B]
+ putStrLn $ show $ f5 [(3,4)]
--putStrLn $ showInt $ f6 [(3,4)]
- putStrLn $ showList showInt $ [ i | Just i <- [Just 1, Nothing, Just 2] ]
+ putStrLn $ show $ [ i | Just i <- [Just 1, Nothing, Just 2] ]
(x,y) <- return (2,3)
- putStrLn $ showInt $ x + y
+ putStrLn $ show $ x + y
f1 :: Bool -> Bool
f1 b =
@@ -31,6 +31,9 @@
True -> 1
data RGB = R | G | B
+
+instance Show RGB where
+ show = showRGB
showRGB :: RGB -> String
showRGB c =
--- a/tests/Catch.hs
+++ b/tests/Catch.hs
@@ -5,6 +5,6 @@
main :: IO ()
main = do
x <- catch (return ("o" ++ "k")) (\ _ -> return "what?")- putStrLn $ showString x
+ putStrLn $ show x
y <- catch (do { error "bang!"; return "huh?" }) (\ (Exn s) -> return s)- putStrLn $ showString y
+ putStrLn $ show y
--- a/tests/Enum.hs
+++ b/tests/Enum.hs
@@ -3,10 +3,10 @@
main :: IO ()
main = do
- putStrLn $ showList showInt [1 .. 5]
- putStrLn $ showList showInt [1 .. 1]
- putStrLn $ showList showInt [1 .. 0]
- putStrLn $ showList showInt [1,3 .. 10]
- putStrLn $ showList showInt [1, -1 .. -5]
- putStrLn $ showList showInt $ take 5 [1 ..]
- putStrLn $ showList showInt $ take 5 [1,3 ..]
+ putStrLn $ show [1 .. 5]
+ putStrLn $ show [1 .. 1]
+ putStrLn $ show [1 .. 0]
+ putStrLn $ show [1,3 .. 10]
+ putStrLn $ show [1, -1 .. -5]
+ putStrLn $ show $ take 5 [1 ..]
+ putStrLn $ show $ take 5 [1,3 ..]
--- a/tests/Eq.hs
+++ b/tests/Eq.hs
@@ -4,18 +4,18 @@
main :: IO ()
main = do
- putStrLn $ showList showBool [1==1, 'a'=='a', 1.1==1.1,
- True==True, False==False,
- (Nothing::Maybe Int)==Nothing, Just 1 == Just 1,
- [1,2,3] == [1,2,3],
- (1,2) == (1,2),
- (Left 1 :: Either Int Char) == Left 1, (Right 'a' :: Either Int Char) == Right 'a'
- ]
- putStrLn $ showList showBool [1==2, 'a'=='b', 1.1==1.2,
- True==False, False==True,
- Nothing==Just 1, Just 1 == Nothing,
- [1,2,3] == [1,2,4],
- (1,2) == (1,4),
- Left 1 == Right 'a', Right 'a' == Left 1
- ]
+ putStrLn $ show [1==1, 'a'=='a', 1.1==1.1,
+ True==True, False==False,
+ (Nothing::Maybe Int)==Nothing, Just 1 == Just 1,
+ [1,2,3] == [1,2,3],
+ (1,2) == (1,2),
+ (Left 1 :: Either Int Char) == Left 1, (Right 'a' :: Either Int Char) == Right 'a'
+ ]
+ putStrLn $ show [1==2, 'a'=='b', 1.1==1.2,
+ True==False, False==True,
+ Nothing==Just 1, Just 1 == Nothing,
+ [1,2,3] == [1,2,4],
+ (1,2) == (1,4),
+ Left 1 == Right 'a', Right 'a' == Left 1
+ ]
--- a/tests/FArith.hs
+++ b/tests/FArith.hs
@@ -15,11 +15,11 @@
main :: IO ()
main = do
- putStrLn $ showList D.showDouble [ op x y | x <- list1, y <- list2, op <- [D.addDouble, D.subDouble, D.mulDouble, divide] ]
- putStrLn $ showList showBool [ op x y | x <- list1, y <- list2, op <- [D.eqDouble, D.neqDouble, D.ltDouble, D.leDouble, D.gtDouble, D.geDouble] ]
- putStrLn $ showList D.showDouble [ D.divDouble x y | x <- [2.234983, 1.232, 23.0], y <- [1.0, 5.0, 10.0, 100.0]]
- putStrLn $ showList D.showDouble [ D.divDouble x y | x <- [-2.234983, -1.232, -23.0], y <- [1.0, -5.0, 10.0, -100.0]]
+ putStrLn $ show [ op x y | x <- list1, y <- list2, op <- [D.addDouble, D.subDouble, D.mulDouble, divide] ]
+ putStrLn $ show [ op x y | x <- list1, y <- list2, op <- [D.eqDouble, D.neqDouble, D.ltDouble, D.leDouble, D.gtDouble, D.geDouble] ]
+ putStrLn $ show [ D.divDouble x y | x <- [2.234983, 1.232, 23.0], y <- [1.0, 5.0, 10.0, 100.0]]
+ putStrLn $ show [ D.divDouble x y | x <- [-2.234983, -1.232, -23.0], y <- [1.0, -5.0, 10.0, -100.0]]
let str = readDouble "1.576"
- putStrLn $ D.showDouble str
- putStrLn $ D.showDouble $ D.addDouble 1.0 $ readDouble "2.5"
- putStrLn $ showList D.showDouble $ map readDouble ["1.5e42", "1.2e-90"]
+ putStrLn $ show str
+ putStrLn $ show $ D.addDouble 1.0 $ readDouble "2.5"
+ putStrLn $ show $ map readDouble ["1.5e42", "1.2e-90"]
--- a/tests/Guard.hs
+++ b/tests/Guard.hs
@@ -12,4 +12,4 @@
main :: IO ()
main = do
- putStrLn $ showList showInt [f [0 - 7], f [5], f [20], f [2,3], f [1,2,3], f[1,2,3,4]]
+ putStrLn $ show [f [0 - 7], f [5], f [20], f [2,3], f [1,2,3], f[1,2,3,4]]
--- a/tests/IOTest.hs
+++ b/tests/IOTest.hs
@@ -31,18 +31,18 @@
hin <- openFile "test.tmp" ReadMode
c1 <- hGetChar hin
c2 <- hGetChar hin
- putStrLn $ showPair showChar showChar (c1, c2)
+ putStrLn $ showPair show show (c1, c2)
writeFile "test2.tmp" "more\n"
s <- readFile "test2.tmp"
- putStrLn (showString s)
+ putStrLn (show s)
writeSerialized "f.tmp" f
g <- readSerialized "f.tmp"
- putStrLn $ showInt $ g 5
+ putStrLn $ show $ (g 5 :: Int)
foo
- putStrLn $ showInt $ trace "tracing" 5
+ putStrLn $ show $ trace "tracing" 5
as <- getArgs
- putStrLn $ showList showString as
- putStrLn $ showInt $ seq (1 + 2) 5
- putStrLn $ showInt $ seq (1 + trace "seq" 2) 5
+ putStrLn $ show as
+ putStrLn $ show $ seq (1 + 2) 5
+ putStrLn $ show $ seq (1 + trace "seq" 2) 5
tend <- getTimeMilli
- putStrLn $ showInt (tend - tstart) ++ "ms execution time"
+ putStrLn $ show (tend - tstart) ++ "ms execution time"
--- a/tests/LitMatch.hs
+++ b/tests/LitMatch.hs
@@ -25,7 +25,7 @@
main :: IO ()
main = do
- putStrLn $ showList showInt [f 0, f 1, f 10]
- putStrLn $ showList showInt [g 1 0, g 1 1, g 2 0, g 2 1, g 2 2]
- putStrLn $ showList showInt [h 'a', h 'b', h 'c']
- putStrLn $ showList showInt [s "aaa", s "apa", s "foo"]
+ putStrLn $ show [f 0, f 1, f 10]
+ putStrLn $ show [g 1 0, g 1 1, g 2 0, g 2 1, g 2 2]
+ putStrLn $ show [h 'a', h 'b', h 'c']
+ putStrLn $ show [s "aaa", s "apa", s "foo"]
--- a/tests/LocalPoly.hs
+++ b/tests/LocalPoly.hs
@@ -3,7 +3,7 @@
main :: IO ()
main = do
- putStrLn $ showPair (showPair showInt showString) (showPair showString showString) $ f 1 "a"
+ putStrLn $ showPair (showPair show show) (showPair show show) $ f 1 "a"
f :: forall b . Int -> b -> ((Int, b), (b, b))
f x b = (i x, i b)
--- a/tests/MutRec.hs
+++ b/tests/MutRec.hs
@@ -5,4 +5,4 @@
main = do
let even i = if i == 0 then True else odd (i - 1)
odd i = if i == 0 then False else even (i - 1)
- putStrLn $ showList showBool $ map even [1 .. 5] ++ map odd [1 .. 5]
+ putStrLn $ show $ map even [1 .. 5] ++ map odd [1 .. 5]
--- a/tests/Newtype.hs
+++ b/tests/Newtype.hs
@@ -15,6 +15,5 @@
main :: IO ()
main = do
- putStrLn $ showList showInt [f (N 1), f (N 2)]
- putStrLn $ showM showInt (g (M (3,4)))
-
+ putStrLn $ show [f (N 1), f (N 2)]
+ putStrLn $ showM show (g (M (3,4)))
--- a/tests/StringTest.hs
+++ b/tests/StringTest.hs
@@ -5,18 +5,18 @@
main = do
putStrLn $ if (==) "abc" "abc" then "yes" else "no"
putStrLn $ if (==) "abc" "adc" then "yes" else "no"
- putStrLn $ showInt 1234
- putStrLn $ showInt 0
- putStrLn $ showInt (negate 567)
- putStrLn $ showChar 'x'
- putStrLn $ showChar '\n'
- putStrLn $ showBool False
+ putStrLn $ show 1234
+ putStrLn $ show 0
+ putStrLn $ show (negate 567)
+ putStrLn $ show 'x'
+ putStrLn $ show '\n'
+ putStrLn $ show False
-- putStrLn $ showUnit ()
- putStrLn $ showList showInt [1,20,3]
- putStrLn $ showList showInt [1]
- putStrLn $ showList showInt []
- putStrLn $ showPair showInt showChar (123, 'a')
- putStrLn $ showMaybe showInt Nothing
- putStrLn $ showMaybe showInt (Just 890)
- putStrLn $ showEither showInt showBool (Left 678)
- putStrLn $ showEither showInt showBool (Right True)
+ 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)
--
⑨