From a3c2420909c41eecbd52c1792bbfb823a49ad04f Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Thu, 14 Nov 2019 11:44:38 +0100 Subject: Equality operator --- VM.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'VM.hs') 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 -- cgit v1.2.3-70-g09d2