diff options
Diffstat (limited to 'src/Operators.hs')
-rw-r--r-- | src/Operators.hs | 14 |
1 files changed, 14 insertions, 0 deletions
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 |