shithub: MicroHs

Download patch

ref: e30c1f64330c04c4a587dff80c171416a18acf74
parent: 37db0dde2cd7ae6a243056e12834ec545f559a3b
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Mon Oct 23 07:14:12 EDT 2023

Get rid of eqString

--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1120
-((A :0 _943) ((A :1 ((B _989) _0)) ((A :2 (((S' _989) _0) I)) ((A :3 _913) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _942) ((C _84) _5))) ((A :7 (((C' _6) (_960 _73)) ((_84 _958) _72))) ((A :8 ((B ((S _989) _958)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_84 _209)) _10)) ((A :12 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_82 _9)) P)) ((A :15 ((B (B (_82 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 (((C' B) _12) (((C' B) _12) (B _14)))) ((A :18 ((B (_82 _9)) (B (P _871)))) ((A :19 ((B (_82 _9)) (BK (P _871)))) ((A :20 ((_82 _9) ((S P) I))) ((A :21 ((B (_82 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _122)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _123)))))) ((A :23 ((B Y) ((B (B (P (_14 _871)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _871))) ((A :26 (_22 _85)) ((A :27 (R _34)) ((A :28 (T _33)) ((A :29 ((P _34) _33)) ((A :30 _34) ((A :31 ((C ((C S') _29)) I)) ((A :32 ((C S) _29)) ((A :33 K) ((A :34 A) ((A :35 ((_76 _907) _908)) ((A :36 ((_76 _917) (_80 _36))) ((A :37 _918) ((A :38 _919) ((A :39 (((S' _28) (_910 #97)) ((C _910) #122))) ((A :40 (((S' _28) (_910 #65)) ((C _910) #90))) ((A :41 (((S' _27) _39) _40)) ((A :42 (((S' _28) (_910 #48)) ((C _910) #57))) ((A :43 (((S' _28) (_910 #32)) ((C _910) #126))) ((A :44 _907) ((A :45 _908) ((A :46 _910) ((A :47 _909) ((A :48 (((S' _27) ((C (_77 _35)) #32)) (((S' _27) ((C (_77 _35)) #9)) ((C (_77 _35)) #10)))) ((A :49 ((S ((S (((S' _28) (_46 #65)) ((C _46) #90))) (_34 (((_870 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #65))) (_38 #97))))) ((A :50 ((S ((S (((S' _28) (_46 #97)) ((C _46) #97))) (_34 (((_870 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #97))) (_38 #65))))) ((A :51 _878) ((A :52 _879) ((A :53 _880) ((A :54 _881) ((A :55 (_52 %0.0)) ((A :56 _51) ((A :57 _52) ((A :58 _53) ((A :59 _54) ((A :60 ((_76 _882) _883)) ((A :61 (_77 _60)) ((A :62 (_78 _60)) ((A :63 _884) ((A :64 _885) ((A :65 _886) ((A :66 _887) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _66) ((A :71 _888) ((A :72 ((B BK) T)) ((A :73 (BK T)) ((A :74 (((S' _76) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _77) (T K)))) (K _33)))) ((B ((C' B) (T (K _33)))) ((B _77) (T A))))) ((B _80) ((B _74) (((S' P) (T K)) (T A)))))) ((A :75 P) ((A :76 P) ((A :77 (T K)) ((A :78 (T A)) ((A :79 (K (noDefault "Eq.=="))) ((A :80 ((B (B (B _29))) _77)) ((A :81 ((_76 ((C ((C S') _29)) I)) (_80 _81))) ((A :82 I) ((A :83 (S _915)) ((A :84 B) ((A :85 I) ((A :86 K) ((A :87 C) ((A :88 _914) ((A :89 ((C ((C S') _209)) _210)) ((A :90 (((C' (S' (C' B))) B) I)) ((A :91 _872) ((A :92 _873) ((A :93 _874) ((A :94 _875) ((A :95 _876) ((A :96 _877) ((A :97 (_92 #0)) ((A :98 ((_76 _895) _896)) ((A :99 _897) ((A :100 _898) ((A :101 _899) ((A :102 _900) ((A :103 (BK K)) ((A :104 ((B BK) ((B (B BK)) P))) ((A :105 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :106 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_100 #0))) ((C (_77 _98)) #0)))) ((B (B ((C' P) (_96 #1)))) _91))) (C P))) _94)) _95)) ((A :107 _103) ((A :108 (((S' C) ((B (P _196)) (((C' (C' B)) (((C' C) (_77 _98)) _196)) _197))) ((B ((C' (C' (C' C))) (((C' (C' (C' C))) (((C' (C' (C' (C' S')))) ((B (B (B (B C)))) ((B ((C' (C' (C' C))) ((B (B (B ((S' S') ((C (_77 _98)) #0))))) ((B ((C' (C' C)) ((B (B ((S' S') ((C (_77 _98)) #1)))) ((B ((C' C) ((B ((C' S') ((C (_77 _98)) #2))) (C _108)))) (C _108))))) (C _108))))) (C _108)))) (T K))) (T A)))) ((C _106) #4)))) ((A :109 (_115 _86)) ((A :110 ((_131 (_89 _109)) _107)) ((A :111 ((C (((C' B) ((P _122) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _112)))) (((S' (C' (C' B))) ((B (B (B _112))) (((S' (C' B)) ((B (B _112)) (((C' B) ((B _129) (T #0))) _111))) (((C' B) ((B _129) (T #1))) _111)))) (((C' B) ((B _129) (T #2))) _111)))) (((C' B) ((B _129) (T #3))) _111)))) ((B T) ((B (B P)) ((C' _91) (_93 #4)))))) ((A :112 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C') 
\ No newline at end of file
+1121
+((A :0 _944) ((A :1 ((B _990) _0)) ((A :2 (((S' _990) _0) I)) ((A :3 _914) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _943) ((C _84) _5))) ((A :7 (((C' _6) (_961 _73)) ((_84 _959) _72))) ((A :8 ((B ((S _990) _959)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_84 _210)) _10)) ((A :12 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_82 _9)) P)) ((A :15 ((B (B (_82 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 (((C' B) _12) (((C' B) _12) (B _14)))) ((A :18 ((B (_82 _9)) (B (P _872)))) ((A :19 ((B (_82 _9)) (BK (P _872)))) ((A :20 ((_82 _9) ((S P) I))) ((A :21 ((B (_82 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _122)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _123)))))) ((A :23 ((B Y) ((B (B (P (_14 _872)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _872))) ((A :26 (_22 _85)) ((A :27 (R _34)) ((A :28 (T _33)) ((A :29 ((P _34) _33)) ((A :30 _34) ((A :31 ((C ((C S') _29)) I)) ((A :32 ((C S) _29)) ((A :33 K) ((A :34 A) ((A :35 ((_76 _908) _909)) ((A :36 ((_76 _918) (_80 _36))) ((A :37 _919) ((A :38 _920) ((A :39 (((S' _28) (_911 #97)) ((C _911) #122))) ((A :40 (((S' _28) (_911 #65)) ((C _911) #90))) ((A :41 (((S' _27) _39) _40)) ((A :42 (((S' _28) (_911 #48)) ((C _911) #57))) ((A :43 (((S' _28) (_911 #32)) ((C _911) #126))) ((A :44 _908) ((A :45 _909) ((A :46 _911) ((A :47 _910) ((A :48 (((S' _27) ((C (_77 _35)) #32)) (((S' _27) ((C (_77 _35)) #9)) ((C (_77 _35)) #10)))) ((A :49 ((S ((S (((S' _28) (_46 #65)) ((C _46) #90))) (_34 (((_871 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #65))) (_38 #97))))) ((A :50 ((S ((S (((S' _28) (_46 #97)) ((C _46) #97))) (_34 (((_871 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #97))) (_38 #65))))) ((A :51 _879) ((A :52 _880) ((A :53 _881) ((A :54 _882) ((A :55 (_52 %0.0)) ((A :56 _51) ((A :57 _52) ((A :58 _53) ((A :59 _54) ((A :60 ((_76 _883) _884)) ((A :61 (_77 _60)) ((A :62 (_78 _60)) ((A :63 _885) ((A :64 _886) ((A :65 _887) ((A :66 _888) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _66) ((A :71 _889) ((A :72 ((B BK) T)) ((A :73 (BK T)) ((A :74 (((S' _76) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _77) (T K)))) (K _33)))) ((B ((C' B) (T (K _33)))) ((B _77) (T A))))) ((B _80) ((B _74) (((S' P) (T K)) (T A)))))) ((A :75 P) ((A :76 P) ((A :77 (T K)) ((A :78 (T A)) ((A :79 (K (noDefault "Eq.=="))) ((A :80 ((B (B (B _29))) _77)) ((A :81 ((_76 ((C ((C S') _29)) I)) (_80 _81))) ((A :82 I) ((A :83 (S _916)) ((A :84 B) ((A :85 I) ((A :86 K) ((A :87 C) ((A :88 _915) ((A :89 ((C ((C S') _210)) _211)) ((A :90 (((C' (S' (C' B))) B) I)) ((A :91 _873) ((A :92 _874) ((A :93 _875) ((A :94 _876) ((A :95 _877) ((A :96 _878) ((A :97 (_92 #0)) ((A :98 ((_76 _896) _897)) ((A :99 _898) ((A :100 _899) ((A :101 _900) ((A :102 _901) ((A :103 (BK K)) ((A :104 ((B BK) ((B (B BK)) P))) ((A :105 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :106 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_100 #0))) ((C (_77 _98)) #0)))) ((B (B ((C' P) (_96 #1)))) _91))) (C P))) _94)) _95)) ((A :107 _103) ((A :108 (((S' C) ((B (P _197)) (((C' (C' B)) (((C' C) (_77 _98)) _197)) _198))) ((B ((C' (C' (C' C))) (((C' (C' (C' C))) (((C' (C' (C' (C' S')))) ((B (B (B (B C)))) ((B ((C' (C' (C' C))) ((B (B (B ((S' S') ((C (_77 _98)) #0))))) ((B ((C' (C' C)) ((B (B ((S' S') ((C (_77 _98)) #1)))) ((B ((C' C) ((B ((C' S') ((C (_77 _98)) #2))) (C _108)))) (C _108))))) (C _108))))) (C _108)))) (T K))) (T A)))) ((C _106) #4)))) ((A :109 (_115 _86)) ((A :110 ((_131 (_89 _109)) _107)) ((A :111 ((C (((C' B) ((P _122) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _112)))) (((S' (C' (C' B))) ((B (B (B _112))) (((S' (C' B)) ((B (B _112)) (((C' B) ((B _129) (T #0))) _111))) (((C' B) ((B _129) (T #1))) _111)))) (((C' B) ((B _129) (T #2))) _111)))) (((C' B) ((B _129) (T #3))) _111)))) ((B T) ((B (B P)) ((C' _91) (_93 #4)))))) ((A :112 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C') 
\ No newline at end of file
--- a/lib/Data/Char.hs
+++ b/lib/Data/Char.hs
@@ -12,8 +12,10 @@
   (==) = primCharEQ
   (/=) = primCharNE
 
+--Y{-  Overlapping instance for ghc
 instance Eq [Char] where
   (==) = primStringEQ
+--Y-}
 
 chr :: Int -> Char
 chr = primChr
--- a/lib/Data/List.hs
+++ b/lib/Data/List.hs
@@ -223,6 +223,9 @@
 elem :: forall a . (Eq a) => a -> [a] -> Bool
 elem = elemBy (==)
 
+notElem :: forall a . (Eq a) => a -> [a] -> Bool
+notElem a as = not (elem a as)
+
 elemBy :: forall a . (a -> a -> Bool) -> a -> [a] -> Bool
 elemBy eq a = any (eq a)
 
--- a/src/MicroHs/Exp.hs
+++ b/src/MicroHs/Exp.hs
@@ -82,7 +82,7 @@
 isPrim :: String -> Exp -> Bool
 isPrim s ae =
   case ae of
-    Lit (LPrim ss) -> eqString s ss
+    Lit (LPrim ss) -> s == ss
     _       -> False
 
 isK :: Exp -> Bool
--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -147,9 +147,9 @@
 eqLit :: Lit -> Lit -> Bool
 eqLit (LInt x)  (LInt  y) = x == y
 eqLit (LChar x) (LChar y) = x == y
-eqLit (LStr  x) (LStr  y) = eqString x y
-eqLit (LPrim x) (LPrim y) = eqString x y
-eqLit (LForImp x) (LForImp y) = eqString x y
+eqLit (LStr  x) (LStr  y) = x == y
+eqLit (LPrim x) (LPrim y) = x == y
+eqLit (LForImp x) (LForImp y) = x == y
 eqLit _         _         = False
 
 type ECaseArm = (EPat, EAlts)
@@ -458,10 +458,10 @@
     EForall iks e -> ppForall iks <+> ppEType e
   where
     ppApp as (EApp f a) = ppApp (a:as) f
-    ppApp as (EVar i) | eqString op "->", [a, b] <- as = parens $ ppExpr a <+> text "->" <+> ppExpr b
-                      | eqString op "=>", [a, b] <- as = parens $ ppExpr a <+> text "=>" <+> ppExpr b
+    ppApp as (EVar i) | op == "->", [a, b] <- as = parens $ ppExpr a <+> text "->" <+> ppExpr b
+                      | op == "=>", [a, b] <- as = parens $ ppExpr a <+> text "=>" <+> ppExpr b
                       | head op == ',' = ppExpr (ETuple as)
-                      | eqString op "[]", length as == 1 = ppExpr (EListish (LList as))
+                      | op == "[]", length as == 1 = ppExpr (EListish (LList as))
                         where op = unQualString (unIdent i)
     ppApp as f = parens $ hsep (map ppExpr (f:as))
 
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -66,7 +66,7 @@
 ppIdent (Ident _ i) = text i
 
 eqIdent :: Ident -> Ident -> Bool
-eqIdent (Ident _ i) (Ident _ j) = eqString i j
+eqIdent (Ident _ i) (Ident _ j) = i == j
 
 leIdent :: Ident -> Ident -> Bool
 leIdent (Ident _ i) (Ident _ j) = leString i j
@@ -96,7 +96,7 @@
 isConIdent (Ident _ i) =
   let
     c = head i
-  in isUpper c || c == ':' || c == ',' || eqString i "[]"  || eqString i "()"
+  in isUpper c || c == ':' || c == ',' || i == "[]"  || i == "()"
 
 isOperChar :: Char -> Bool
 isOperChar c = elem c "@\\=+-:<>.!#$%^&*/|~?"
--- a/src/MicroHs/Lex.hs
+++ b/src/MicroHs/Lex.hs
@@ -108,7 +108,7 @@
 number :: Loc -> String -> String -> [Token]   -- neg=1 means negative, neg=0 means positive
 number loc sign cs =
   case span isDigit cs of
-    (ds, rs) | null rs || not (head rs == '.') || eqString (take 2 rs) ".." ->
+    (ds, rs) | null rs || not (head rs == '.') || (take 2 rs) == ".." ->
                let s = sign ++ ds
                    i = readInt s
                in  TInt loc i : lex (addCol loc $ length s) rs
@@ -185,7 +185,7 @@
       _ -> TIdent sloc (reverse qs) ds : lex (addCol loc $ length ds) rs
 
 tIdent :: Loc -> [String] -> String -> [Token] -> [Token]
-tIdent loc qs kw ats | elemBy eqString kw ["let", "where", "do", "of"]
+tIdent loc qs kw ats | elem kw ["let", "where", "do", "of"]
                                  = ti : tBrace ats
                      | otherwise = ti : ats
   where {
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -18,10 +18,10 @@
 main = do
   aargs <- getArgs
   let
-    args = takeWhile (not . eqString "--") aargs
-    ss = filter (not . (eqString "-") . take 1) args
-    flags = Flags (length (filter (eqString "-v") args))
-                  (elemBy eqString "-r" args)
+    args = takeWhile (/= "--") aargs
+    ss = filter ((/= "-") . take 1) args
+    flags = Flags (length (filter (== "-v") args))
+                  (elem "-r" args)
                   ("." : catMaybes (map (stripPrefix "-i") args))
                   (head $ catMaybes (map (stripPrefix "-o") args) ++ ["out.comb"])
   case ss of
--- a/src/MicroHs/Parse.hs
+++ b/src/MicroHs/Parse.hs
@@ -9,7 +9,6 @@
 import MicroHs.Lex
 import MicroHs.Expr
 import MicroHs.Ident
---Ximport Compat
 
 
 type P a = Prsr FilePath Token a
@@ -102,7 +101,7 @@
 pLIdent = P.do
   fn <- getFileName
   let
-    is (TIdent loc [] s) | isLower_ (head s) && not (elemBy eqString s keywords) = Just (mkIdentLoc fn loc s)
+    is (TIdent loc [] s) | isLower_ (head s) && not (elem s keywords) = Just (mkIdentLoc fn loc s)
     is _ = Nothing
   satisfyM "LIdent" is
 
@@ -110,7 +109,7 @@
 pLQIdent = P.do
   fn <- getFileName
   let
-    is (TIdent loc qs s) | isLower_ (head s) && not (elemBy eqString s keywords) = Just (qualName fn loc qs s)
+    is (TIdent loc qs s) | isLower_ (head s) && not (elem s keywords) = Just (qualName fn loc qs s)
     is _ = Nothing
   satisfyM "LQIdent" is
 
@@ -129,7 +128,7 @@
 pSymbol :: String -> P ()
 pSymbol sym = () <$ satisfy sym is
   where
-    is (TIdent _ [] s) = eqString s sym
+    is (TIdent _ [] s) = s == sym
     is _ = False
 
 pOper :: P Ident
@@ -139,7 +138,7 @@
 pQSymOper = P.do
   fn <- getFileName
   let
-    is (TIdent loc qs s) | not (isAlpha_ (head s)) && not (elemBy eqString s reservedOps) = Just (qualName fn loc qs s)
+    is (TIdent loc qs s) | not (isAlpha_ (head s)) && not (elem s reservedOps) = Just (qualName fn loc qs s)
     is _ = Nothing
   satisfyM "QSymOper" is
 
@@ -147,7 +146,7 @@
 pSymOper = P.do
   fn <- getFileName
   let
-    is (TIdent loc [] s) | not (isAlpha_ (head s)) && not (elemBy eqString s reservedOps) = Just (mkIdentLoc fn loc s)
+    is (TIdent loc [] s) | not (isAlpha_ (head s)) && not (elem s reservedOps) = Just (mkIdentLoc fn loc s)
     is _ = Nothing
   satisfyM "SymOper" is
 
@@ -235,7 +234,7 @@
 pKeyword :: String -> P ()
 pKeyword kw = () <$ satisfy kw is
   where
-    is (TIdent _ [] s) = eqString kw s
+    is (TIdent _ [] s) = kw == s
     is _ = False
 
 pBlock :: forall a . P a -> P [a]
@@ -563,4 +562,4 @@
   in
     showSLoc sloc ++ ":\n"
       ++ "  found:    " ++ head (map showToken ts ++ ["EOF"]) ++ "\n"
-      ++ "  expected: " ++ unwords (nubBy eqString msgs)
+      ++ "  expected: " ++ unwords (nub msgs)
--- a/src/MicroHs/Translate.hs
+++ b/src/MicroHs/Translate.hs
@@ -22,7 +22,7 @@
   -- Drop all argument up to '--'
   args <- getArgs
   let prog = unsafeCoerce $ translate defs
-  withDropArgs (length (takeWhile (not . eqString "--") args) + 1)
+  withDropArgs (length (takeWhile (/= "--") args) + 1)
     prog
 
 --translate :: (Ident, [LDef]) -> Any
@@ -40,7 +40,7 @@
     App f a -> unsafeCoerce (trans r f) (trans r a)
     Lit (LInt i) -> unsafeCoerce i
     Lit (LStr s) -> trans r (encodeString s)
-    Lit (LPrim p) -> fromMaybe (error $ "primlookup: " ++ p) $ lookupBy eqString p primTable
+    Lit (LPrim p) -> fromMaybe (error $ "primlookup: " ++ p) $ lookup p primTable
     _ -> error "trans: impossible"
 
 -- Use linear search in this table.
--