From bb18191ce4b8ca5f1414ef3d1a1fb78ef8d57e51 Mon Sep 17 00:00:00 2001
From: "Yann Esposito (Yogsototh)" <Yann.Esposito@gmail.com>
Date: Fri, 26 Jul 2013 18:25:04 +0200
Subject: [PATCH] added some primitive

---
 test.sh    |  1 +
 tests/eval | 18 ++++++++++++++++
 y.hs       | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 82 insertions(+)
 create mode 100644 tests/eval

diff --git a/test.sh b/test.sh
index 4b663e4..06c16e9 100755
--- a/test.sh
+++ b/test.sh
@@ -16,6 +16,7 @@ if ((${#listfic}>1)); then
     # compile
     [[ ! -d .tmp ]] && mkdir .tmp
     ghc -O2 -hidir .tmp -odir .tmp y.hs
+    (($?!=0)) && exit 1
     cmd='./y'
 else
     cmd=(runghc y.hs)
diff --git a/tests/eval b/tests/eval
new file mode 100644
index 0000000..51d613e
--- /dev/null
+++ b/tests/eval
@@ -0,0 +1,18 @@
+(+ 2 2)
+4
+(* 3 5)
+15
+(/ 10 2)
+5
+(- 15 5 3 2)
+5
+(* (+ 2 2) (- 4 3))
+4
+(boolean? #t)
+#t
+(boolean? (+ 2 2))
+#f
+(string? "hello")
+#t
+(string? (* 3 2))
+#f
diff --git a/y.hs b/y.hs
index 2727031..dd27cd6 100644
--- a/y.hs
+++ b/y.hs
@@ -183,3 +183,66 @@ eval val@(Number _) = val
 eval val@(Float _) = val
 eval val@(Bool _) = val
 eval (List [Atom "quote", val]) = val
+
+-- strict evaluation here:
+eval (List (Atom func : args)) = apply func $ map eval args
+
+apply :: String -> [LispVal] -> LispVal
+apply func args = maybe (Bool False) ($ args) $ lookup func primitives
+
+primitives :: [(String, [LispVal] -> LispVal)]
+primitives =[ ("+", numericBinop (+))
+            , ("-", numericBinop (-))
+            , ("*", numericBinop (*))
+            , ("/", numericBinop div)
+            , ("mod", numericBinop mod)
+            , ("quotient", numericBinop quot)
+            , ("remainder", numericBinop rem)
+            , ("boolean?", isBool)
+            , ("string?", isString)
+            , ("number?", isNumber)
+            , ("float?", isFloat)
+            , ("character?", isCharacter)
+            , ("dottedlist?", isDottedList)
+            , ("list?", isList)
+            , ("symbol?", isAtom)
+            ]
+
+isBool :: [LispVal] -> LispVal
+isBool ((Bool _):_) = Bool True
+isBool _ = Bool False
+
+isString :: [LispVal] -> LispVal
+isString ((String _):_) = Bool True
+isString _ = Bool False
+
+isCharacter :: [LispVal] -> LispVal
+isCharacter ((Character _):_) = Bool True
+isCharacter _ = Bool False
+
+isNumber :: [LispVal] -> LispVal
+isNumber ((Number _):_) = Bool True
+isNumber _ = Bool False
+
+isFloat :: [LispVal] -> LispVal
+isFloat ((Float _):_) = Bool True
+isFloat _ = Bool False
+
+isDottedList :: [LispVal] -> LispVal
+isDottedList ((DottedList _ _):_) = Bool True
+isDottedList _ = Bool False
+
+isList :: [LispVal] -> LispVal
+isList ((List _):_) = Bool True
+isList _ = Bool False
+
+isAtom :: [LispVal] -> LispVal
+isAtom ((Atom _):_) = Bool True
+isAtom _ = Bool False
+
+numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> LispVal
+numericBinop op params = Number $ foldl1 op $ map unpackNum params
+
+unpackNum :: LispVal -> Integer
+unpackNum (Number n) = n
+unpackNum _ = 0