summaryrefslogtreecommitdiff
path: root/VM.hs
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2019-11-14 11:44:38 +0100
committertomsmeding <tom.smeding@gmail.com>2019-11-14 11:44:38 +0100
commita3c2420909c41eecbd52c1792bbfb823a49ad04f (patch)
treeaa262f26ac696a9a334d383333d5c3904d68a69f /VM.hs
parent019fadfaf181a8cdaa79334de0b1463a725bda42 (diff)
Equality operator
Diffstat (limited to 'VM.hs')
-rw-r--r--VM.hs15
1 files changed, 13 insertions, 2 deletions
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