From d3271899e5cda93552d9ccd0cc6e2b0b3cafe325 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Fri, 22 Nov 2019 19:53:37 +0100 Subject: More builtins: type queries, and error --- Compiler.hs | 4 +++- VM.hs | 5 +++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/Compiler.hs b/Compiler.hs index 70a35ae..59b82af 100644 --- a/Compiler.hs +++ b/Compiler.hs @@ -90,7 +90,9 @@ builtinSet = Set.fromList [ "list", "cons", "car", "cdr", "null?", "sys-open-file", "sys-close-file", "sys-get-char", "sys-put-string", "sys-flush", "sys-stdin", "sys-stdout", "sys-stderr", - "length", "substr", "ord", "chr", "concat"] + "length", "substr", "ord", "chr", "concat", + "type-list?", "type-number?", "type-string?", "type-quoted?", "type-symbol?", + "error"] bbId :: BB -> Int bbId (BB i _ _) = i diff --git a/VM.hs b/VM.hs index 883066f..138bf26 100644 --- a/VM.hs +++ b/VM.hs @@ -160,6 +160,11 @@ vmRunBuiltin state "chr" [RVNum num] = return (RVString [chr num], state) vmRunBuiltin state "concat" values | Just strings <- sequence (map fromRVString values) = return (RVString (concat strings), state) | otherwise = throw "Non-string arguments to 'concat'" +vmRunBuiltin state "type-list?" [value] = return (RVNum (case value of { RVList _ -> 1; _ -> 0 }), state) +vmRunBuiltin state "type-number?" [value] = return (RVNum (case value of { RVNum _ -> 1; _ -> 0 }), state) +vmRunBuiltin state "type-string?" [value] = return (RVNum (case value of { RVString _ -> 1; _ -> 0 }), state) +vmRunBuiltin state "type-quoted?" [value] = return (RVNum (case value of { RVQuoted _ -> 1; _ -> 0 }), state) +vmRunBuiltin state "type-symbol?" [value] = return (RVNum (case value of { RVName _ -> 1; _ -> 0 }), state) vmRunBuiltin _ name args = error (name ++ " " ++ show args) equalOp :: RunValue -> RunValue -> Bool -- cgit v1.2.3-54-g00ecf