aboutsummaryrefslogtreecommitdiff
path: root/src/Operators.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Operators.hs')
-rw-r--r--src/Operators.hs19
1 files changed, 18 insertions, 1 deletions
diff --git a/src/Operators.hs b/src/Operators.hs
index beb6364..e607250 100644
--- a/src/Operators.hs
+++ b/src/Operators.hs
@@ -19,6 +19,7 @@ primitives =
19 , ("<=", comparator (<=)) 19 , ("<=", comparator (<=))
20 , ("=", comparator (==)) 20 , ("=", comparator (==))
21 , ("!=", comparator (/=)) 21 , ("!=", comparator (/=))
22 , ("not", unaryBool not)
22 ] 23 ]
23 24
24data LispNumber = I Integer 25data LispNumber = I Integer
@@ -38,7 +39,9 @@ instance Num LispNumber where
38 (F a) * (F b) = F $ a * b 39 (F a) * (F b) = F $ a * b
39 40
40instance Fractional LispNumber where 41instance Fractional LispNumber where
41 (I a) / (I b) = I $ a `div` b 42 (I a) / (I b) = F $ fromIntegral a / fromIntegral b
43 (F a) / (I b) = F $ a / fromIntegral b
44 (I a) / (F b) = F $ fromIntegral a / b
42 (F a) / (F b) = F $ a / b 45 (F a) / (F b) = F $ a / b
43 46
44arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr 47arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr
@@ -55,6 +58,16 @@ comparator op args
55 as <- mapM unwrapNum args 58 as <- mapM unwrapNum args
56 return . BoolLiteral . all (== True) $ zipWith op as (tail as) 59 return . BoolLiteral . all (== True) $ zipWith op as (tail as)
57 60
61unaryBool :: (Bool -> Bool) -> [Expr] -> LispResult Expr
62unaryBool op args
63 | length args /= 1 = throwError $ ArgCount 1 args
64 | otherwise = BoolLiteral . op <$> unwrapBool (head args)
65
66naryBool :: (Bool -> Bool -> Bool) -> [Expr] -> LispResult Expr
67naryBool op args
68 | length args < 2 = throwError $ ArgCount 2 args
69
70
58unwrapNum :: Expr -> LispResult LispNumber 71unwrapNum :: Expr -> LispResult LispNumber
59unwrapNum (IntLiteral n) = return $ I n 72unwrapNum (IntLiteral n) = return $ I n
60unwrapNum (FloatLiteral n) = return $ F n 73unwrapNum (FloatLiteral n) = return $ F n
@@ -63,3 +76,7 @@ unwrapNum x = throwError $ TypeMismatch "number" x
63wrapNum :: LispNumber -> Expr 76wrapNum :: LispNumber -> Expr
64wrapNum (I n) = IntLiteral n 77wrapNum (I n) = IntLiteral n
65wrapNum (F n) = FloatLiteral n 78wrapNum (F n) = FloatLiteral n
79
80unwrapBool :: Expr -> LispResult Bool
81unwrapBool (BoolLiteral s) = return s
82unwrapBool x = throwError $ TypeMismatch "boolean" x