From 206689c943ba93ad48ce2b41166ca1902ed920a9 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Thu, 21 Nov 2019 23:23:23 +0100
Subject: cons, cond, exit

---
 Compiler.hs       | 5 ++++-
 CompilerMacros.hs | 4 ++++
 VM.hs             | 1 +
 3 files changed, 9 insertions(+), 1 deletion(-)

diff --git a/Compiler.hs b/Compiler.hs
index b7f5639..6224ee0 100644
--- a/Compiler.hs
+++ b/Compiler.hs
@@ -87,7 +87,7 @@ newtype CM a = CM {unCM :: StateT CompState (Except String) a}
 builtinSet :: Set.Set Name
 builtinSet = Set.fromList [
     "+", "-", "*", "/", "mod", "<=", "=", "print",
-    "list", "car", "cdr", "null?",
+    "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"]
@@ -220,6 +220,9 @@ genTValue (TVList [TVName "if" _, cond, val1, val2]) nextnext = do
 
     return resref
 genTValue (TVList (TVName "if" _ : _)) _ = throwError "Invalid 'if' syntax"
+genTValue (TVList [TVName "exit" _]) _ = do
+    setTerm IExit
+    return RNone
 genTValue (TVList (funcexpr : args)) nextnext = do
     refs <- forM args $ \value -> do
         bnext <- newBlock
diff --git a/CompilerMacros.hs b/CompilerMacros.hs
index 610e659..ce7974c 100644
--- a/CompilerMacros.hs
+++ b/CompilerMacros.hs
@@ -37,6 +37,10 @@ process (VList [VName "let", VList args, body]) =
             error "Invalid 'let' syntax: Invalid variable list (not all pairs)"
 process (VList (VName "let" : _)) = error "Invalid 'let' syntax: Invalid argument list"
 
+process (VList [VName "cond", defval]) = process defval
+process (VList (VName "cond" : cond1 : val1 : rest)) =
+    process (VList [VName "if", cond1, val1, VList (VName "cond" : rest)])
+
 process (VList values) = VList (map process values)
 
 process (VDefine name body) = VDefine name (process body)
diff --git a/VM.hs b/VM.hs
index b66cfc5..64674fb 100644
--- a/VM.hs
+++ b/VM.hs
@@ -127,6 +127,7 @@ vmRunBuiltin state "cdr" [RVList l] = case l of
     _ : a -> return (RVList a, state)
     _ -> throw "Empty list in 'cdr'"
 vmRunBuiltin state "list" values = return (RVList values, state)
+vmRunBuiltin state "cons" [val, RVList l] = return (RVList (val : l), state)
 vmRunBuiltin state "sys-open-file" [RVNum modenum, RVString path] = do
     let mode = [ReadMode, WriteMode] !! modenum
         fid = sUniq state
-- 
cgit v1.2.3-54-g00ecf