diff options
Diffstat (limited to 'VM.hs')
| -rw-r--r-- | VM.hs | 15 |
1 files changed, 13 insertions, 2 deletions
@@ -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 |