From c25979b76c1dd22b6dc33acb994e9044c56a68f9 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Sun, 17 Dec 2017 22:31:01 +0100 Subject: #include --- vm.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'vm.hs') diff --git a/vm.hs b/vm.hs index 04de0c5..b3b19e4 100644 --- a/vm.hs +++ b/vm.hs @@ -5,6 +5,7 @@ import Data.List import Data.Maybe import qualified Data.Map.Strict as Map import Data.Map.Strict ((!)) +import System.IO import qualified System.IO.Error as IO import Debug.Trace @@ -28,6 +29,7 @@ data RunValue | RVNum Int | RVString String | RVQuoted RunValue + | RVName Name deriving Show kErrorExit :: String @@ -101,8 +103,12 @@ vmRunBuiltin "print" as = putStrLn (intercalate ", " (map printshow as)) >> retu 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)) -vmRunBuiltin "car" [RVList (a:_)] = return a -vmRunBuiltin "cdr" [RVList (_:a)] = return (RVList a) +vmRunBuiltin "car" [RVList l] = case l of + a : _ -> return a + _ -> throw "Empty list in 'car'" +vmRunBuiltin "cdr" [RVList l] = case l of + _ : a -> return (RVList a) + _ -> throw "Empty list in 'cdr'" vmRunBuiltin "list" values = return (RVList values) vmRunBuiltin name args = error (name ++ " " ++ show args) @@ -112,6 +118,7 @@ printshow (RVList values) = show values printshow (RVNum i) = show i printshow (RVQuoted value) = '\'' : show value printshow (RVClosure _ _) = "[closure]" +printshow (RVName name) = name truthy :: RunValue -> Bool truthy (RVNum n) = n /= 0 @@ -122,4 +129,8 @@ toRunValue (VList values) = RVList (map toRunValue values) toRunValue (VNum i) = RVNum i toRunValue (VString s) = RVString s toRunValue (VQuoted value) = RVQuoted (toRunValue value) +toRunValue (VName name) = RVName name toRunValue _ = undefined + +throw :: String -> IO a +throw s = hPutStrLn stderr s >> IO.ioError (IO.userError kErrorExit) -- cgit v1.2.3-54-g00ecf