diff options
| author | tomsmeding <tom.smeding@gmail.com> | 2019-11-22 19:53:37 +0100 |
|---|---|---|
| committer | tomsmeding <tom.smeding@gmail.com> | 2019-11-22 19:53:37 +0100 |
| commit | d3271899e5cda93552d9ccd0cc6e2b0b3cafe325 (patch) | |
| tree | 5ed3bbe4728e84b9ff60fab95a9dc3bef8d6de3b | |
| parent | 466ba3ce75ca64a02f83ed84939cdd6e57aa8fa9 (diff) | |
More builtins: type queries, and error
| -rw-r--r-- | Compiler.hs | 4 | ||||
| -rw-r--r-- | VM.hs | 5 |
2 files changed, 8 insertions, 1 deletions
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 @@ -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 |