shithub: MicroHs

Download patch

ref: f3dc111723afd8cead7d14a788d141f4fa07aef4
parent: c84bc8caf669ced82e2d067a1373f7eedd839857
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Mon Sep 18 18:08:51 EDT 2023

Clean up Text.String

--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v3.4
-828
-(($A :0 ((_624 _576) (($B ((($S' ($C ((($C' ($S' _624)) (($B ($C _2)) _560)) (($B ($B (_624 _653))) ((($C' ($C' $C)) ((($C' ($S' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $S)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' $C))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($C' ($C' ($S' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($S' $B) ($B' ($B' (($B ($S' $B)) (($B ($B _625)) ((($C' $B) (($B _722) (($B _643) ((($C' _759) _8) 0)))) (($B (_722 _646)) (($B (_659 "top level defns: ")) _605)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _625)) ((($C' $B) (($B _722) (($B _643) ((($C' _759) _8) 1)))) (_642 ($T (($B ($B (_722 _646))) ((($C' $B) (($B _659) ((($C' _659) _566) " = "))) _392)))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _625))) ((($C' $B) ($B' (($B _722) (($B _648) _11)))) (($B _659) ((($C' _659) (($B (_659 _1)) _605)) (($O 10) $K)))))) (($B ($B (_624 _653))) ((($C' $B) ($B' (($B _722) (($B _643) ((($C' _759) _8) 0))))) (($B ($B (_722 _646))) ((($C' ($C' _659)) (($B ($B (_659 "final pass            "))) (($B ($B (_619 6))) (($B ($B _605)) _753)))) "ms"))))))) _3))))) (($B (($C' $C) (($B ($C _664)) _392))) (($C _677) (_694 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) ((($C' ($C' ($C' ($C' _659)))) (($B ($C' ($C' _659))) ((($C' ($C' ($C' _659))) (($B (($C' $B) (($B _659) ((($C' _659) (($B (_659 "(($A :")) _605)) (($O 32) $K))))) ($B _392))) ") "))) (($O 41) $K)))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _368)) $I))) ($BK $K))) $K))))) (($B (($S' _722) (($B _719) (($B (_722 _766)) (($B (_659 "main: findIdent: ")) _566))))) (($C' _595) _563)))) _602))) (($B ($B _599)) ((($C' $B) (($B _661) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _563))) $K)))))) (($C _677) (_694 0))))))) ($T $A))) ($T $K))) $I)) (($B (_722 _367)) (($B (_722 _560)) (($B (_659 (($O 95) $K))) _605)))))))) (($S (($S ((($S' _7) (($B _676) (_663 (_617 "-v")))) ((_693 _617) "-r"))) (($B (_657 (($O 46) $K))) (($B _721) (_662 ((_681 _744) "-i")))))) (($B (_722 _688)) ((($C' _659) (($B _721) (_662 ((_681 _744) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _755) _676) 1)) (_766 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _688)) (_663 ((_723 _764) ((_723 (_617 (($O 45) $K))) (_674 1))))))) (_684 ((_723 _764) (_617 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _624)) _16) (($B ($B ($B (_624 _653)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _625) (($B (_722 _644)) (($B (_722 (_675 1000000))) _192)))))) (($B ($B ($B ($B (_624 _653))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _625))) ((($C' $B) ($B' (($B _722) (($B _643) ((($C' _759) _8) 0))))) (($B ($B (_722 _646))) ((($C' ($C' _659)) (($B ($B (_659 "combinator conversion "))) (($B ($B (_619 6))) (($B ($B _605)) _753)))) "ms")))))) (($B ($B _626)) (($B $P) (($C _569) (_560 "main")))))))) (_661 ($T ((($C' ($C' $O)) ((($C' $B) $P) _395)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_624 _576)))) (($B ($B ($B (($C' _577) ((($C' _748) (($B _676) (_684 ((_723 _764) (_617 "--"))))) 1))))) (($B ($B ($B (_722 _6)))) ($C $C))))) (($B ($B $Y)) (($B ($B ($B _551))) (($C' ($C' _661)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _722) (($B _719) (($B (_722 _766)) (($B (_659 "not found ")) _566))))) ($C _552))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _394))) (($B (_722 (_719 (_766 "primlookup")))) (($C (_699 _617)) _5)))) $K))) (_766 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "
\ No newline at end of file
+829
+(($A :0 ((_625 _576) (($B ((($S' ($C ((($C' ($S' _625)) (($B ($C _2)) _560)) (($B ($B (_625 _654))) ((($C' ($C' $C)) ((($C' ($S' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $S)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' $C))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($C' ($C' ($S' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($S' $B) ($B' ($B' (($B ($S' $B)) (($B ($B _626)) ((($C' $B) (($B _723) (($B _644) ((($C' _760) _8) 0)))) (($B (_723 _647)) (($B (_660 "top level defns: ")) _606)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _626)) ((($C' $B) (($B _723) (($B _644) ((($C' _760) _8) 1)))) (_643 ($T (($B ($B (_723 _647))) ((($C' $B) (($B _660) ((($C' _660) _566) " = "))) _392)))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _626))) ((($C' $B) ($B' (($B _723) (($B _649) _11)))) (($B _660) ((($C' _660) (($B (_660 _1)) _606)) (($O 10) $K)))))) (($B ($B (_625 _654))) ((($C' $B) ($B' (($B _723) (($B _644) ((($C' _760) _8) 0))))) (($B ($B (_723 _647))) ((($C' ($C' _660)) (($B ($B (_660 "final pass            "))) (($B ($B (_620 6))) (($B ($B _606)) _754)))) "ms"))))))) _3))))) (($B (($C' $C) (($B ($C _665)) _392))) (($C _678) (_695 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) ((($C' ($C' ($C' ($C' _660)))) (($B ($C' ($C' _660))) ((($C' ($C' ($C' _660))) (($B (($C' $B) (($B _660) ((($C' _660) (($B (_660 "(($A :")) _606)) (($O 32) $K))))) ($B _392))) ") "))) (($O 41) $K)))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _368)) $I))) ($BK $K))) $K))))) (($B (($S' _723) (($B _720) (($B (_723 _767)) (($B (_660 "main: findIdent: ")) _566))))) (($C' _595) _563)))) _602))) (($B ($B _599)) ((($C' $B) (($B _662) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _563))) $K)))))) (($C _678) (_695 0))))))) ($T $A))) ($T $K))) $I)) (($B (_723 _367)) (($B (_723 _560)) (($B (_660 (($O 95) $K))) _606)))))))) (($S (($S ((($S' _7) (($B _677) (_664 (_618 "-v")))) ((_694 _618) "-r"))) (($B (_658 (($O 46) $K))) (($B _722) (_663 ((_682 _745) "-i")))))) (($B (_723 _689)) ((($C' _660) (($B _722) (_663 ((_682 _745) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _756) _677) 1)) (_767 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _689)) (_664 ((_724 _765) ((_724 (_618 (($O 45) $K))) (_675 1))))))) (_685 ((_724 _765) (_618 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _625)) _16) (($B ($B ($B (_625 _654)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _626) (($B (_723 _645)) (($B (_723 (_676 1000000))) _192)))))) (($B ($B ($B ($B (_625 _654))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _626))) ((($C' $B) ($B' (($B _723) (($B _644) ((($C' _760) _8) 0))))) (($B ($B (_723 _647))) ((($C' ($C' _660)) (($B ($B (_660 "combinator conversion "))) (($B ($B (_620 6))) (($B ($B _606)) _754)))) "ms")))))) (($B ($B _627)) (($B $P) (($C _569) (_560 "main")))))))) (_662 ($T ((($C' ($C' $O)) ((($C' $B) $P) _395)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_625 _576)))) (($B ($B ($B (($C' _577) ((($C' _749) (($B _677) (_685 ((_724 _765) (_618 "--"))))) 1))))) (($B ($B ($B (_723 _6)))) ($C $C))))) (($B ($B $Y)) (($B ($B ($B _551))) (($C' ($C' _662)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _723) (($B _720) (($B (_723 _767)) (($B (_660 "not found ")) _566))))) ($C _552))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _394))) (($B (_723 (_720 (_767 "primlookup")))) (($C (_700 _618)) _5)))) $K))) (_767 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "
\ No newline at end of file
--- a/lib/Text/String.hs
+++ b/lib/Text/String.hs
@@ -12,41 +12,37 @@
 import Data.Tuple
 
 showChar :: Char -> String
-showChar c =
+showChar c = "'" ++ encodeChar c ++ "'"
+
+encodeChar :: Char -> String
+encodeChar c =
   let
-    spec = [('\n', "'\\n'"), ('\r', "'\\r'"), ('\t', "'\\t'"),
-            ('\\', "'\\\\'"), ('\'', "'\\''")]
+    spec = [('\n', "\\n"), ('\r', "\\r"), ('\t', "\\t"), ('\b', "\\b"),
+            ('\\', "\\\\"), ('\'', "\\'"), ('"', "\"")]
   in
     case lookupBy eqChar c spec of
-      Nothing -> if isPrint c then ['\'', c, '\''] else "'\\" ++ showInt (ord c) ++ "'"
+      Nothing -> if isPrint c then [c] else "'\\" ++ showInt (ord c) ++ "'"
       Just s  -> s
 
 showString :: String -> String
-showString s =
-  let
-    loop arg =
-      case arg of
-        [] -> "\""
-        c : cs ->
-          case ord c == ord '\n' of
-            False -> c : loop cs
-            True  -> '\\' : 'n' : loop cs
-  in '"' : loop s
+showString s = "\"" ++ concatMap encodeChar s ++ "\""
 
 -- XXX wrong for minInt
 showInt :: Int -> String
 showInt n =
-  case n < 0 of
-    False -> showUnsignedInt n
-    True  -> '-' : showUnsignedInt (negate 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  case n < 10 of
-        False -> showUnsignedInt (quot n 10) ++ [c]
-        True  -> [c]
+  in  if n < 10 then
+        [c]
+      else
+        showUnsignedInt (quot n 10) ++ [c]
 
 readInt :: String -> Int
 readInt cs =
@@ -71,28 +67,15 @@
     (a, b) -> "(" ++ sa a ++ "," ++ sb b ++ ")"
 
 showList :: forall a . (a -> String) -> [a] -> String
-showList sa arg =
-  let
-    showRest as =
-      case as of
-        [] -> "]"
-        x : xs -> "," ++ sa x ++ showRest xs
-  in
-    case arg of
-      [] -> "[]"
-      a : as -> "[" ++ sa a ++ showRest as
+showList sa as = "[" ++ intercalate "," (map sa as) ++ "]"
 
 showMaybe :: forall a . (a -> String) -> Maybe a -> String
-showMaybe fa arg =
-  case arg of
-    Nothing -> "Nothing"
-    Just a  -> "(Just " ++ fa a ++ ")"
+showMaybe _ Nothing = "Nothing"
+showMaybe fa (Just a) = "(Just " ++ fa a ++ ")"
 
 showEither :: forall a b . (a -> String) -> (b -> String) -> Either a b -> String
-showEither fa fb arg =
-  case arg of
-    Left  a -> "(Left " ++ fa a ++ ")"
-    Right b -> "(Right " ++ fb b ++ ")"
+showEither fa _ (Left  a) = "(Left "  ++ fa a ++ ")"
+showEither _ fb (Right b) = "(Right " ++ fb b ++ ")"
 
 lines :: String -> [String]
 lines "" = []
@@ -104,7 +87,7 @@
 unlines = concatMap (++ "\n")
 
 unwords :: [String] -> String
-unwords ss = concat (intersperse " " ss)
+unwords ss = intercalate " " ss
 
 -- Using a primitive for string equality makes a huge speed difference.
 eqString :: String -> String -> Bool
--