shithub: MicroHs

Download patch

ref: 9429b627b067daf9e1316f30915a41d3f6c23a62
parent: c293ac729fb9487933675258e8fff4caf205b372
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Sun Oct 22 11:18:02 EDT 2023

Add Eq instances.

--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
 v4.0
-1098
-((A :0 _921) ((A :1 ((B _967) _0)) ((A :2 (((S' _967) _0) I)) ((A :3 _891) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _920) ((C _81) _5))) ((A :7 (((C' _6) (_938 _72)) ((_81 _936) _71))) ((A :8 ((B ((S _967) _936)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_81 _196)) _10)) ((A :12 ((B (B (_79 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_79 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_79 _9)) P)) ((A :15 ((B (B (_79 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 (((C' B) _12) (((C' B) _12) (B _14)))) ((A :18 ((B (_79 _9)) (B (P _849)))) ((A :19 ((B (_79 _9)) (BK (P _849)))) ((A :20 ((_79 _9) ((S P) I))) ((A :21 ((B (_79 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _120)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _121)))))) ((A :23 ((B Y) ((B (B (P (_14 _849)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _849))) ((A :26 (_22 _82)) ((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 _896) ((A :36 _897) ((A :37 (((S' _28) (_888 #97)) ((C _888) #122))) ((A :38 (((S' _28) (_888 #65)) ((C _888) #90))) ((A :39 (((S' _27) _37) _38)) ((A :40 (((S' _28) (_888 #48)) ((C _888) #57))) ((A :41 (((S' _28) (_888 #32)) ((C _888) #126))) ((A :42 _885) ((A :43 _886) ((A :44 _888) ((A :45 _887) ((A :46 (((S' _27) ((C _42) #32)) (((S' _27) ((C _42) #9)) ((C _42) #10)))) ((A :47 ((S ((S (((S' _28) (_44 #65)) ((C _44) #90))) (_34 (((_847 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _88) (((C' _89) _36) (_36 #65))) (_36 #97))))) ((A :48 ((S ((S (((S' _28) (_44 #97)) ((C _44) #97))) (_34 (((_847 "lib/Data/Char.hs") #3) #8)))) ((B _35) (((C' _88) (((C' _89) _36) (_36 #97))) (_36 #65))))) ((A :49 _856) ((A :50 _857) ((A :51 _858) ((A :52 _859) ((A :53 (_50 %0.0)) ((A :54 _49) ((A :55 _50) ((A :56 _51) ((A :57 _52) ((A :58 _860) ((A :59 _861) ((A :60 _58) ((A :61 _59) ((A :62 _862) ((A :63 _863) ((A :64 _864) ((A :65 _865) ((A :66 _62) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _866) ((A :71 ((B BK) T)) ((A :72 (BK T)) ((A :73 P) ((A :74 P) ((A :75 (T K)) ((A :76 (T A)) ((A :77 (K (noDefault "Eq.=="))) ((A :78 ((B (B (B _29))) _75)) ((A :79 I) ((A :80 (S _893)) ((A :81 B) ((A :82 I) ((A :83 K) ((A :84 C) ((A :85 _892) ((A :86 ((C ((C S') _196)) _197)) ((A :87 (((C' (S' (C' B))) B) I)) ((A :88 _850) ((A :89 _851) ((A :90 _852) ((A :91 _853) ((A :92 _854) ((A :93 _855) ((A :94 (_89 #0)) ((A :95 ((_74 _873) _874)) ((A :96 _875) ((A :97 _876) ((A :98 _877) ((A :99 _878) ((A :100 (_75 _95)) ((A :101 (BK K)) ((A :102 ((B BK) ((B (B BK)) P))) ((A :103 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :104 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_97 #0))) ((C (_75 _95)) #0)))) ((B (B ((C' P) (_93 #1)))) _88))) (C P))) _91)) _92)) ((A :105 _101) ((A :106 (((S' C) ((B (P _184)) (((C' (C' B)) (((C' C) (_75 _95)) _184)) _185))) ((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 (_75 _95)) #0))))) ((B ((C' (C' C)) ((B (B ((S' S') ((C (_75 _95)) #1)))) ((B ((C' C) ((B ((C' S') ((C (_75 _95)) #2))) (C _106)))) (C _106))))) (C _106))))) (C _106)))) (T K))) (T A)))) ((C _104) #4)))) ((A :107 (_113 _83)) ((A :108 ((_128 (_86 _107)) _105)) ((A :109 ((C (((C' B) ((P _120) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _110)))) (((S' (C' (C' B))) ((B (B (B _110))) (((S' (C' B)) ((B (B _110)) (((C' B) ((B _126) (T #0))) _109))) (((C' B) ((B _126) (T #1))) _109)))) (((C' B) ((B _126) (T #2))) _109)))) (((C' B) ((B _126) (T #3))) _109)))) ((B T) ((B (B P)) ((C' _88) (_90 #4)))))) ((A :110 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C') S) ((B (B (B (S B)))) ((B (B (B (B (B BK))))) ((B ((S' (C' B)) ((B B') B'))) ((B (B (B (B (B (S B)))))) ((B (B (B (B (B (B (B BK))))))) (((C' B) (B' (B' ((B (C' (C' (C' C)))) ((B ((C' B) (B' ((B C) _96)))) ((B ((C' B) _121)) _110)))))) ((B ((C' B) _121)) (C _110)))))))))) (((_847 "lib/Data/IntMap.hs
\ No newline at end of file
+1115
+((A :0 _938) ((A :1 ((B _984) _0)) ((A :2 (((S' _984) _0) I)) ((A :3 _908) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _937) ((C _84) _5))) ((A :7 (((C' _6) (_955 _73)) ((_84 _953) _72))) ((A :8 ((B ((S _984) _953)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_84 _207)) _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 _866)))) ((A :19 ((B (_82 _9)) (BK (P _866)))) ((A :20 ((_82 _9) ((S P) I))) ((A :21 ((B (_82 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _123)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _124)))))) ((A :23 ((B Y) ((B (B (P (_14 _866)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _866))) ((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 _902) _903)) ((A :36 ((_76 _912) (_80 _36))) ((A :37 _913) ((A :38 _914) ((A :39 (((S' _28) (_905 #97)) ((C _905) #122))) ((A :40 (((S' _28) (_905 #65)) ((C _905) #90))) ((A :41 (((S' _27) _39) _40)) ((A :42 (((S' _28) (_905 #48)) ((C _905) #57))) ((A :43 (((S' _28) (_905 #32)) ((C _905) #126))) ((A :44 _902) ((A :45 _903) ((A :46 _905) ((A :47 _904) ((A :48 (((S' _27) ((C _44) #32)) (((S' _27) ((C _44) #9)) ((C _44) #10)))) ((A :49 ((S ((S (((S' _28) (_46 #65)) ((C _46) #90))) (_34 (((_865 "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 (((_865 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #97))) (_38 #65))))) ((A :51 _873) ((A :52 _874) ((A :53 _875) ((A :54 _876) ((A :55 (_52 %0.0)) ((A :56 _51) ((A :57 _52) ((A :58 _53) ((A :59 _54) ((A :60 ((_76 _877) _878)) ((A :61 (_77 _60)) ((A :62 (_78 _60)) ((A :63 _879) ((A :64 _880) ((A :65 _881) ((A :66 _882) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _66) ((A :71 _883) ((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 _910)) ((A :84 B) ((A :85 I) ((A :86 K) ((A :87 C) ((A :88 _909) ((A :89 ((C ((C S') _207)) _208)) ((A :90 (((C' (S' (C' B))) B) I)) ((A :91 _867) ((A :92 _868) ((A :93 _869) ((A :94 _870) ((A :95 _871) ((A :96 _872) ((A :97 (_92 #0)) ((A :98 ((_76 _890) _891)) ((A :99 _892) ((A :100 _893) ((A :101 _894) ((A :102 _895) ((A :103 (_77 _98)) ((A :104 (BK K)) ((A :105 ((B BK) ((B (B BK)) P))) ((A :106 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :107 (((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 :108 _104) ((A :109 (((S' C) ((B (P _194)) (((C' (C' B)) (((C' C) (_77 _98)) _194)) _195))) ((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 _109)))) (C _109))))) (C _109))))) (C _109)))) (T K))) (T A)))) ((C _107) #4)))) ((A :110 (_116 _86)) ((A :111 ((_132 (_89 _110)) _108)) ((A :112 ((C (((C' B) ((P _123) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _113)))) (((S' (C' (C' B))) ((B (B (B _113))) (((S' (C' B)) ((B (B _113)) (((C' B) ((B _130) (T #0))) _112))) (((C' B) ((B _130) (T #1))) _112)))) (((C' B) ((B _130) (T #2))) _112)))) (((C' B) ((B _130) (T #3))) _112)))) ((B T) ((B (B P)) ((C' _91) (_93 #4)))))) ((A :113 ((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
@@ -3,9 +3,17 @@
 module Data.Char(module Data.Char, Char) where
 import Primitives
 import Data.Bool
+import Data.Eq
 import Data.Int
 
 type String = [Char]
+
+instance Eq Char where
+  (==) = primCharEQ
+  (/=) = primCharNE
+
+instance Eq [Char] where
+  (==) = primStringEQ
 
 chr :: Int -> Char
 chr = primChr
--- a/lib/Data/Double.hs
+++ b/lib/Data/Double.hs
@@ -3,6 +3,7 @@
 module Data.Double(module Data.Double, Double) where
 import Primitives
 import Data.Bool_Type
+import Data.Eq
 
 infixl 6 +,-
 infixl 7 *
@@ -31,13 +32,20 @@
 
 --------------------------------
 
-infix 4 ==,/=,<,<=,>,>=
+--infix 4 ==,/=
+infix 4 <,<=,>,>=
 
+{-
 -- Comparison
 (==) :: Double -> Double -> Bool
 (==) = primDoubleEQ
 (/=) :: Double -> Double -> Bool
 (/=) = primDoubleNE
+-}
+
+instance Eq Double where
+  (==) = primDoubleEQ
+  (/=) = primDoubleNE
 
 eqDouble :: Double -> Double -> Bool
 eqDouble = (==)
--- a/lib/Data/Either.hs
+++ b/lib/Data/Either.hs
@@ -2,8 +2,15 @@
 -- See LICENSE file for full license.
 module Data.Either(module Data.Either) where
 import Primitives
+import Data.Bool
+import Data.Eq
 
 data Either a b = Left a | Right b
+
+instance forall a b . (Eq a, Eq b) => Eq (Either a b) where
+  Left  a == Left  a'  =  a == a'
+  Right b == Right b'  =  b == b'
+  _       == _         =  False
 
 either :: forall a b r . (a -> r) -> (b -> r) -> Either a b -> r
 either f _ (Left  a) = f a
--- a/lib/Data/Eq.hs
+++ b/lib/Data/Eq.hs
@@ -10,10 +10,8 @@
   (/=) :: a -> a -> Bool
   x /= y = not (x == y)
 
-{-
-instance Eq Int where
-  (==) = primIntEq
-
-instance Eq Char where
-  (==) = primCharEq
--}
+-- Put Eq instance here, it would be a circular dependency
+-- if it were in Data.Bool.
+instance Eq Bool where
+  False == x  =  not x
+  True  == x  =  x
--- a/lib/Data/IntMap.hs
+++ b/lib/Data/IntMap.hs
@@ -4,7 +4,7 @@
   IntMap,
   empty, lookup, insert, fromList, toList, insertWith, (!), keys
   ) where
-import Prelude --Xhiding(lookup)
+import Prelude hiding(lookup)
 
 data IntMap a
   = Empty
--- a/lib/Data/Integer.hs
+++ b/lib/Data/Integer.hs
@@ -26,7 +26,7 @@
 -- It has the following invariants:
 --  * each digit is >= 0 and < maxD
 --  * least signification digits first, most significant last
---  * no tariling 0s in the digits
+--  * no trailing 0s in the digits
 --  * 0 is positive
 data Integer = I Sign [Digit]
   --deriving Show
@@ -35,6 +35,12 @@
 
 data Sign = Plus | Minus
   --deriving Show
+
+instance Eq Integer where
+  x == y  =  isZero (subI x y)
+
+isZero :: Integer -> Bool
+isZero (I _ ds) = null ds
 
 eqSign :: Sign -> Sign -> Bool
 eqSign Plus Plus = True
--- a/lib/Data/List.hs
+++ b/lib/Data/List.hs
@@ -17,6 +17,11 @@
 data [] a = [] | (:) a [a]  -- Parser hacks makes this acceptable
 --Y-}
 
+instance forall a . Eq a => Eq [a] where
+  []     == []      =  True
+  (x:xs) == (y:ys)  =  x == y && xs == ys
+  _      == _       =  False
+
 null :: forall a . [a] -> Bool
 null [] = True
 null _  = False
@@ -234,12 +239,21 @@
 find p [] = Nothing
 find p (x:xs) = if p x then Just x else find p xs
 
+lookup :: forall a b . Eq a => a -> [(a, b)] -> Maybe b
+lookup = lookupBy (==)
+
 lookupBy :: forall a b . (a -> a -> Bool) -> a -> [(a, b)] -> Maybe b
 lookupBy eq x xys = fmapMaybe snd (find (eq x . fst) xys)
 
+union :: forall a . Eq a => [a] -> [a] -> [a]
+union = unionBy (==)
+
 unionBy :: forall a . (a -> a -> Bool) -> [a] -> [a] -> [a]
 unionBy eq xs ys =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
 
+intersect :: forall a . Eq a => [a] -> [a] -> [a]
+intersect = intersectBy (==)
+
 intersectBy :: forall a . (a -> a -> Bool) -> [a] -> [a] -> [a]
 intersectBy eq xs ys = filter (\ x -> not (elemBy eq x ys)) xs
 
@@ -251,6 +265,9 @@
 deleteAllBy _ _ [] = []
 deleteAllBy eq x (y:ys) = if eq x y then deleteAllBy eq x ys else y : deleteAllBy eq x ys
 
+nub :: forall a . Eq a => [a] -> [a]
+nub = nubBy (==)
+
 nubBy :: forall a . (a -> a -> Bool) -> [a] -> [a]
 nubBy _ [] = []
 nubBy eq (x:xs) = x : nubBy eq (filter (\ y -> not (eq x y)) xs)
@@ -264,6 +281,10 @@
     xs = x:xs
   in xs
 
+infix 5 \\
+(\\) :: forall a . Eq a => [a] -> [a] -> [a]
+(\\) = deleteFirstsBy (==)
+
 deleteFirstsBy :: forall a . (a -> a -> Bool) -> [a] -> [a] -> [a]
 deleteFirstsBy eq = foldl (flip (deleteBy eq))
 
@@ -317,6 +338,9 @@
 init [] = error "init: []"
 init [_] = []
 init (x:xs) = x : init xs
+
+anySame :: forall a . Eq a => [a] -> Bool
+anySame = anySameBy (==)
 
 anySameBy :: forall a . (a -> a -> Bool) -> [a] -> Bool
 anySameBy _ [] = False
--- a/lib/Data/Maybe.hs
+++ b/lib/Data/Maybe.hs
@@ -3,8 +3,14 @@
 module Data.Maybe(module Data.Maybe) where
 import Primitives
 import Data.Bool
+import Data.Eq
 
 data Maybe a = Nothing | Just a
+
+instance forall a . Eq a => Eq (Maybe a) where
+  Nothing == Nothing  =  True
+  Just x  == Just x'  =  x == x'
+  _       == _        =  False
 
 maybe :: forall a r . r -> (a -> r) -> Maybe a -> r
 maybe r _ Nothing = r
--- a/lib/Data/Tuple.hs
+++ b/lib/Data/Tuple.hs
@@ -7,6 +7,7 @@
                  ) where
 import Primitives  -- for ()
 import Data.Bool
+import Data.Eq
 
 --data (a,b) = (a,b)  -- all tuples are built in
 --data (a,b,c) = (a,b,c)
@@ -20,3 +21,12 @@
 
 eqPair :: forall a b . (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
 eqPair eqa eqb (a1, b1) (a2, b2) = eqa a1 a2 && eqb b1 b2
+
+instance forall a b . (Eq a, Eq b) => Eq (a, b) where
+  (a1, b1) == (a2, b2)  =  a1 == a2 && b1 == b2
+
+instance forall a b c . (Eq a, Eq b, Eq c) => Eq (a, b, c) where
+  (a1, b1, c1) == (a2, b2, c2)  =  a1 == a2 && b1 == b2 && c1 == c2
+
+instance forall a b c d . (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) where
+  (a1, b1, c1, d1) == (a2, b2, c2, d2)  =  a1 == a2 && b1 == b2 && c1 == c2 && d1 == d2
--- a/lib/Data/Word.hs
+++ b/lib/Data/Word.hs
@@ -4,6 +4,7 @@
 import Primitives
 import Data.Bool_Type
 import qualified Data.Char as C
+import Data.Eq
 import qualified Data.Int as I
 import Data.List
 import Text.String
@@ -25,13 +26,20 @@
 
 --------------------------------
 
-infix 4 ==,/=,<,<=,>,>=
+--infix 4 ==,/=
+infix 4 <,<=,>,>=
 
+{-
 -- Comparison
 (==) :: Word -> Word -> Bool
 (==) = primWordEQ
 (/=) :: Word -> Word -> Bool
 (/=) = primWordNE
+-}
+
+instance Eq Word where
+  (==) = primWordEQ
+  (/=) = primWordNE
 
 (<)  :: Word -> Word -> Bool
 (<)  = primWordLT
--- a/lib/Prelude.hs
+++ b/lib/Prelude.hs
@@ -15,7 +15,6 @@
   module System.IO,
   module Text.String,
   _noMatch,
-  _noDefault,
   ) where
 import Control.Error
 import Data.Bool
@@ -36,7 +35,3 @@
 _noMatch fn l c = error $ "no match at " ++
   if null fn then "no location" else
   showString fn ++ ": " ++ "line " ++ showInt l ++ ", col " ++ showInt c
-
--- Called when the default method is missing
-_noDefault :: forall a . [Char] -> a
-_noDefault s = error ("no default for " ++ s)
--