diff options
Diffstat (limited to 'src/Operators.hs')
-rw-r--r-- | src/Operators.hs | 31 |
1 files changed, 25 insertions, 6 deletions
diff --git a/src/Operators.hs b/src/Operators.hs index 3b96281..9eaec38 100644 --- a/src/Operators.hs +++ b/src/Operators.hs | |||
@@ -12,17 +12,36 @@ primitives = | |||
12 | ("+", arithmetic (+)) | 12 | ("+", arithmetic (+)) |
13 | , ("-", arithmetic (-)) | 13 | , ("-", arithmetic (-)) |
14 | , ("*", arithmetic (*)) | 14 | , ("*", arithmetic (*)) |
15 | , ("/", arithmetic div) | 15 | , ("/", arithmetic (/)) |
16 | ] | 16 | ] |
17 | 17 | ||
18 | arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> LispResult Expr | 18 | data LispNumber = I Integer |
19 | | F Double | ||
20 | |||
21 | instance Num LispNumber where | ||
22 | (I a) + (I b) = I $ a + b | ||
23 | (F a) + (F b) = F $ a + b | ||
24 | (I a) - (I b) = I $ a - b | ||
25 | (F a) - (F b) = F $ a - b | ||
26 | (I a) * (I b) = I $ a * b | ||
27 | (F a) * (F b) = F $ a * b | ||
28 | |||
29 | instance Fractional LispNumber where | ||
30 | (I a) / (I b) = I $ a `div` b | ||
31 | (F a) / (F b) = F $ a / b | ||
32 | |||
33 | arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr | ||
19 | arithmetic op args | 34 | arithmetic op args |
20 | | length args < 2 = throwError $ ArgCount 2 args | 35 | | length args < 2 = throwError $ ArgCount 2 args |
21 | | otherwise = do | 36 | | otherwise = do |
22 | as <- mapM unwrapNum args | 37 | as <- mapM unwrapNum args |
23 | return . IntLiteral $ foldl1 op as | 38 | return . wrapNum $ foldl1 op as |
24 | 39 | ||
25 | unwrapNum :: Expr -> LispResult Integer | 40 | unwrapNum :: Expr -> LispResult LispNumber |
26 | unwrapNum (IntLiteral n) = return n | 41 | unwrapNum (IntLiteral n) = return $ I n |
27 | unwrapNum x = throwError $ TypeMismatch "number" x | 42 | unwrapNum (FloatLiteral n) = return $ F n |
43 | unwrapNum x = throwError $ TypeMismatch "number" x | ||
28 | 44 | ||
45 | wrapNum :: LispNumber -> Expr | ||
46 | wrapNum (I n) = IntLiteral n | ||
47 | wrapNum (F n) = FloatLiteral n | ||