aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Error.hs2
-rw-r--r--src/Operators.hs14
2 files changed, 15 insertions, 1 deletions
diff --git a/src/Error.hs b/src/Error.hs
index 165cc5c..5ba48bf 100644
--- a/src/Error.hs
+++ b/src/Error.hs
@@ -20,7 +20,7 @@ unwordsList = unwords . map show
20instance Show LispError where 20instance Show LispError where
21 show (Parse e) = "Parser Error: " ++ show e 21 show (Parse e) = "Parser Error: " ++ show e
22 show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr 22 show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr
23 show (ArgCount n es) = "Invalid arity, expected " ++ show n ++ ", got values: " ++ unwordsList es 23 show (ArgCount n es) = "Invalid arity, expected " ++ show n ++ ", got value(s): " ++ unwordsList es
24 show (UnknownFunction fn) = "Cannot apply function: " ++ fn 24 show (UnknownFunction fn) = "Cannot apply function: " ++ fn
25 show (TypeMismatch msg got) = "Type mismatch, expected " ++ msg ++ ", got: " ++ show got 25 show (TypeMismatch msg got) = "Type mismatch, expected " ++ msg ++ ", got: " ++ show got
26 26
diff --git a/src/Operators.hs b/src/Operators.hs
index fc0608e..beb6364 100644
--- a/src/Operators.hs
+++ b/src/Operators.hs
@@ -13,10 +13,17 @@ primitives =
13 , ("-", arithmetic (-)) 13 , ("-", arithmetic (-))
14 , ("*", arithmetic (*)) 14 , ("*", arithmetic (*))
15 , ("/", arithmetic (/)) 15 , ("/", arithmetic (/))
16 , (">", comparator (>))
17 , ("<", comparator (<))
18 , (">=", comparator (>=))
19 , ("<=", comparator (<=))
20 , ("=", comparator (==))
21 , ("!=", comparator (/=))
16 ] 22 ]
17 23
18data LispNumber = I Integer 24data LispNumber = I Integer
19 | F Double 25 | F Double
26 deriving (Eq, Ord)
20 27
21instance Num LispNumber where 28instance Num LispNumber where
22 -- TODO: 29 -- TODO:
@@ -41,6 +48,13 @@ arithmetic op args
41 as <- mapM unwrapNum args 48 as <- mapM unwrapNum args
42 return . wrapNum $ foldl1 op as 49 return . wrapNum $ foldl1 op as
43 50
51comparator :: (LispNumber -> LispNumber -> Bool) -> [Expr] -> LispResult Expr
52comparator op args
53 | length args < 2 = throwError $ ArgCount 2 args
54 | otherwise = do
55 as <- mapM unwrapNum args
56 return . BoolLiteral . all (== True) $ zipWith op as (tail as)
57
44unwrapNum :: Expr -> LispResult LispNumber 58unwrapNum :: Expr -> LispResult LispNumber
45unwrapNum (IntLiteral n) = return $ I n 59unwrapNum (IntLiteral n) = return $ I n
46unwrapNum (FloatLiteral n) = return $ F n 60unwrapNum (FloatLiteral n) = return $ F n