From a3c2420909c41eecbd52c1792bbfb823a49ad04f Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Thu, 14 Nov 2019 11:44:38 +0100
Subject: Equality operator

---
 Compiler.hs      |  2 +-
 VM.hs            | 15 +++++++++++++--
 closuretest.lisp |  2 +-
 symbols.lisp     |  3 +++
 4 files changed, 18 insertions(+), 4 deletions(-)
 create mode 100644 symbols.lisp

diff --git a/Compiler.hs b/Compiler.hs
index 69b2fd8..c8771b9 100644
--- a/Compiler.hs
+++ b/Compiler.hs
@@ -74,7 +74,7 @@ newtype CM a = CM {unCM :: StateT CompState (Except String) a}
 -- TODO: extra info like number of arguments, dunno, might be useful
 builtinMap :: Map.Map Name ()
 builtinMap = Map.fromList [
-    ("+", ()), ("-", ()), ("<=", ()), ("print", ()),
+    ("+", ()), ("-", ()), ("<=", ()), ("=", ()), ("print", ()),
     ("list", ()), ("car", ()), ("cdr", ())]
 
 bbId :: BB -> Int
diff --git a/VM.hs b/VM.hs
index b3b19e4..12ccf60 100644
--- a/VM.hs
+++ b/VM.hs
@@ -100,6 +100,7 @@ assignRef _ ref _ = error $ "VM: Unexpected ref " ++ show ref ++ " assigned"
 vmRunBuiltin :: Name -> [RunValue] -> IO RunValue
 -- vmRunBuiltin name args | trace (name ++ " " ++ show args) False = undefined
 vmRunBuiltin "print" as = putStrLn (intercalate ", " (map printshow as)) >> return (RVList [])
+vmRunBuiltin "=" [a, b] = return (if equalOp a b then RVNum 1 else RVNum 0)
 vmRunBuiltin "<=" [RVNum a, RVNum b] = return (RVNum (fromEnum (a <= b)))
 vmRunBuiltin "+" [RVNum a, RVNum b] = return (RVNum (a + b))
 vmRunBuiltin "-" [RVNum a, RVNum b] = return (RVNum (a - b))
@@ -112,11 +113,21 @@ vmRunBuiltin "cdr" [RVList l] = case l of
 vmRunBuiltin "list" values = return (RVList values)
 vmRunBuiltin name args = error (name ++ " " ++ show args)
 
+equalOp :: RunValue -> RunValue -> Bool
+equalOp (RVClosure _ _) _ = error "Cannot compare closures in '='"
+equalOp _ (RVClosure _ _) = error "Cannot compare closures in '='"
+equalOp (RVList vs) (RVList ws) = length vs == length ws && all id (zipWith equalOp vs ws)
+equalOp (RVNum a) (RVNum b) = a == b
+equalOp (RVString s) (RVString t) = s == t
+equalOp (RVQuoted v) (RVQuoted w) = equalOp v w
+equalOp (RVName n) (RVName m) = n == m
+equalOp _ _ = False
+
 printshow :: RunValue -> String
 printshow (RVString str) = str
-printshow (RVList values) = show values
+printshow (RVList values) = "[" ++ intercalate "," (map printshow values) ++ "]"
 printshow (RVNum i) = show i
-printshow (RVQuoted value) = '\'' : show value
+printshow (RVQuoted value) = '\'' : printshow value
 printshow (RVClosure _ _) = "[closure]"
 printshow (RVName name) = name
 
diff --git a/closuretest.lisp b/closuretest.lisp
index 9827eb1..5d96c7f 100644
--- a/closuretest.lisp
+++ b/closuretest.lisp
@@ -1 +1 @@
-(((lambda (x) (lambda (y) (+ x y))) 1) 2)
+(print (((lambda (x) (lambda (y) (+ x y))) 1) 2))
diff --git a/symbols.lisp b/symbols.lisp
new file mode 100644
index 0000000..cba1302
--- /dev/null
+++ b/symbols.lisp
@@ -0,0 +1,3 @@
+(print '(1 2 3))
+(print (list 1 2 3))
+(print (= 'hoi 'hoi))
-- 
cgit v1.2.3-54-g00ecf