aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Operators.hs58
1 files changed, 45 insertions, 13 deletions
diff --git a/src/Operators.hs b/src/Operators.hs
index 051655a..c5812ea 100644
--- a/src/Operators.hs
+++ b/src/Operators.hs
@@ -9,19 +9,23 @@ import Parser
9primitives :: [(String, [Expr] -> LispResult Expr)] 9primitives :: [(String, [Expr] -> LispResult Expr)]
10primitives = map (\(n, f) -> (n, f n)) 10primitives = map (\(n, f) -> (n, f n))
11 [ 11 [
12 ("+" , arithmetic (+)) 12 ("+", arithmetic (+))
13 , ("-" , arithmetic (-)) 13 , ("-", arithmetic (-))
14 , ("*" , arithmetic (*)) 14 , ("*", arithmetic (*))
15 , ("/" , arithmetic (/)) 15 , ("/", arithmetic (/))
16 , (">" , comparator (>)) 16 , (">", comparator (>))
17 , ("<" , comparator (<)) 17 , ("<", comparator (<))
18 , (">=" , comparator (>=)) 18 , (">=", comparator (>=))
19 , ("<=" , comparator (<=)) 19 , ("<=", comparator (<=))
20 , ("=" , comparator (==)) 20 , ("=" , comparator (==))
21 , ("!=" , comparator (/=)) 21 , ("!=" , comparator (/=))
22 , ("not" , unaryBool not) 22 , ("not", unaryBool not)
23 , ("or" , naryBool (||)) 23 , ("or", naryBool (||))
24 , ("and" , naryBool (&&)) 24 , ("and", naryBool (&&))
25 , ("car", car)
26 , ("cdr", cdr)
27 , ("cons", cons)
28 , ("null?", isNull)
25 ] 29 ]
26 30
27data LispNumber = I Integer 31data LispNumber = I Integer
@@ -90,3 +94,31 @@ wrapNum (F n) = FloatLiteral n
90unwrapBool :: Expr -> LispResult Bool 94unwrapBool :: Expr -> LispResult Bool
91unwrapBool (BoolLiteral s) = return s 95unwrapBool (BoolLiteral s) = return s
92unwrapBool x = throwError $ TypeMismatch "boolean" x 96unwrapBool x = throwError $ TypeMismatch "boolean" x
97
98-- list primitives
99
100car :: FName -> [Expr] -> LispResult Expr
101car _ [List (x:xs)] = return x
102car _ [DottedList (x:xs) _ ] = return x
103car _ [somethingElse] = throwError $ TypeMismatch "pair" somethingElse
104car fn mulArgs = throwError $ ArgCount fn 1 mulArgs
105
106cdr :: FName -> [Expr] -> LispResult Expr
107cdr _ [List (x:xs)] = return $ List xs
108cdr _ [DottedList [_] tail] = return tail
109cdr _ [DottedList (_:xs) t] = return $ DottedList xs t
110cdr _ [somethingElse] = throwError $ TypeMismatch "pair" somethingElse
111cdr fn mulArgs = throwError $ ArgCount fn 1 mulArgs
112
113cons :: FName -> [Expr] -> LispResult Expr
114cons _ [val, List []] = return $ List [val]
115cons _ [val, List ls] = return $ List $ val:ls
116cons _ [val, DottedList ls tail] = return $ DottedList (val:ls) tail
117cons _ [v1, v2] = return $ DottedList [v1] v2
118cons fn mulArgs = throwError $ ArgCount fn 2 mulArgs
119
120isNull :: FName -> [Expr] -> LispResult Expr
121isNull _ [List []] = return $ BoolLiteral True
122isNull _ [List _] = return $ BoolLiteral False
123isNull _ [arg] = throwError $ TypeMismatch "pair" arg
124isNull fn args = throwError $ ArgCount fn 1 args