diff options
-rw-r--r-- | src/Error.hs | 2 | ||||
-rw-r--r-- | src/Operators.hs | 14 |
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 | |||
20 | instance Show LispError where | 20 | instance 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 | ||
18 | data LispNumber = I Integer | 24 | data LispNumber = I Integer |
19 | | F Double | 25 | | F Double |
26 | deriving (Eq, Ord) | ||
20 | 27 | ||
21 | instance Num LispNumber where | 28 | instance 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 | ||
51 | comparator :: (LispNumber -> LispNumber -> Bool) -> [Expr] -> LispResult Expr | ||
52 | comparator 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 | |||
44 | unwrapNum :: Expr -> LispResult LispNumber | 58 | unwrapNum :: Expr -> LispResult LispNumber |
45 | unwrapNum (IntLiteral n) = return $ I n | 59 | unwrapNum (IntLiteral n) = return $ I n |
46 | unwrapNum (FloatLiteral n) = return $ F n | 60 | unwrapNum (FloatLiteral n) = return $ F n |