more uniform handling of literals

3 files changed, 34 insertions, 20 deletions

diff --git a/lc/Builtins.lc b/lc/Builtins.lc
index b34f5fae..c0af99c2 100644
--- a/lc/Builtins.lc
+++ b/lc/Builtins.lc
@@ -10,8 +10,6 @@ id x = x
 
 ---------------------------------------
 
-data Nat = Zero | Succ Nat
-
 data List a = Nil | Cons a (List a)
 
 infixr 5 :
diff --git a/lc/Internals.lc b/lc/Internals.lc
index 0ea96032..b7d55b51 100644
--- a/lc/Internals.lc
+++ b/lc/Internals.lc
@@ -58,9 +58,12 @@ data Bool = False | True
 
 data Ordering = LT | EQ | GT
 
+data Nat = Zero | Succ Nat
+
 -- builtin primitives
 primIntToWord       :: Int   -> Word
 primIntToFloat      :: Int   -> Float
+primIntToNat        :: Int   -> Nat
 primCompareInt      :: Int   -> Int   -> Ordering
 primCompareWord     :: Word  -> Word  -> Ordering
 primCompareFloat    :: Float -> Float -> Ordering
@@ -80,6 +83,9 @@ primIfThenElse :: Bool -> a -> a -> a
 primIfThenElse True  a b = a
 primIfThenElse False a b = b
 
+isEQ EQ = True
+isEQ _ = False
+
 -- fromInt is needed for integer literal
 class Num a where
   fromInt :: Int -> a
@@ -98,5 +104,26 @@ instance Num Float where
   fromInt = primIntToFloat
   compare = primCompareFloat
   negate  = primNegateFloat
-
+instance Num Nat where
+  fromInt = primIntToNat --if isEQ (primCompareInt n zero') then Zero else Succ (fromInt (primSubInt n one'))
+  compare = undefined
+  negate  = undefined
+
+class Eq a where
+    (==) :: a -> a -> Bool     -- todo: use (==) sign
+
+infix 4 ==
+
+instance Eq String where a == b = isEQ (primCompareString a b)
+instance Eq Char where a == b = isEQ (primCompareChar a b)
+instance Eq Int where a == b = isEQ (primCompareInt a b)
+instance Eq Float where a == b = isEQ (primCompareFloat a b)
+instance Eq Bool where
+    True == True = True
+    False == False = True
+    _ == _ = False
+instance Eq Nat where
+    Zero   == Zero   = True
+    Succ a == Succ b = a == b
+    _      == _      = False
 
diff --git a/lc/Prelude.lc b/lc/Prelude.lc
index e8334192..13911a83 100644
--- a/lc/Prelude.lc
+++ b/lc/Prelude.lc
@@ -105,9 +105,6 @@ data RecordC (xs :: [(String, Type)])
 foldr1 f [x] = x
 foldr1 f (x: xs) = f x (foldr1 f xs)
 
-isEQ EQ = True
-isEQ _ = False
-
 False ||| x = x
 True ||| x = True
 
@@ -118,20 +115,12 @@ False &&& x = False
 
 infixr 3 &&&
 
-class Eq a where
-    (===) :: a -> a -> Bool     -- todo: use (==) sign
-
-infix 4 ===
-
-instance Eq String where
-    a === b = isEQ (primCompareString a b)
-
 ------------------------------------ Row polymorphism
 -- todo: sorted field names (more efficient & easier to use)
 
 {-
 isKey _ [] = False
-isKey s ((s', _): ss) = s === s' ||| isKey s ss
+isKey s ((s', _): ss) = s == s' ||| isKey s ss
 
 subList [] _ = []
 subList ((s, t): xs) ys = if isKey s ys then subList xs ys else (s, t): subList xs ys
@@ -140,7 +129,7 @@ addList [] ys = ys
 addList ((s, t): xs) ys = if isKey s ys then addList xs ys else (s, t): addList xs ys
 
 findEq x [] = 'Unit
-findEq (s, t) ((s', t'):xs) = if s === s' then 'T2 (t ~ t') (findEq (s, t) xs) else findEq (s, t) xs
+findEq (s, t) ((s', t'):xs) = if s == s' then 'T2 (t ~ t') (findEq (s, t) xs) else findEq (s, t) xs
 
 sameEq [] _ = 'Unit
 sameEq (x: xs) ys = 'T2 (findEq x ys) (sameEq xs ys)
@@ -162,11 +151,11 @@ record :: [(String, Type)] -> Type
 unsafeCoerce :: forall a b . a -> b
 
 isKeyC _ _ [] = 'Empty ""
-isKeyC s t ((s', t'): ss) = if s === s' then t ~ t' else isKeyC s t ss
+isKeyC s t ((s', t'): ss) = if s == s' then t ~ t' else isKeyC s t ss
 
 -- todo: don't use unsafeCoerce
 project :: forall a (xs :: [(String, Type)]) . forall (s :: String) -> 'isKeyC s a xs => RecordC xs -> a
-project @a @((s', a'): xs) s @_ (RecordCons ts) | s === s' = fst (unsafeCoerce @_ @(a, tuptype (map snd xs)) ts)
+project @a @((s', a'): xs) s @_ (RecordCons ts) | s == s' = fst (unsafeCoerce @_ @(a, tuptype (map snd xs)) ts)
 project @a @((s', a'): xs) s @_ (RecordCons ts) = project @a @xs s @(undefined @(isKeyC s a xs)) (RecordCons (snd (unsafeCoerce @_ @(a, tuptype (map snd xs)) ts)))
 
 --------------------------------------- HTML colors
@@ -250,7 +239,7 @@ refract = PrimRefract
 -- operators
 infixl 7  *, /, %
 infixl 6  +, -
-infix  4  ==, /=, <, <=, >=, >
+infix  4  /=, <, <=, >=, >
 
 infixr 3  &&
 infixr 2  ||
@@ -272,7 +261,7 @@ a % b = PrimMod a b
 neg a = PrimNeg a
 
 -- comparison
-a == b = PrimEqual a b
+--a == b = PrimEqual a b
 a /= b = PrimNotEqual a b
 a < b = PrimLessThan a b
 a <= b = PrimLessThanEqual a b