aboutsummaryrefslogtreecommitdiff
path: root/src/Operators.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Operators.hs')
-rw-r--r--src/Operators.hs15
1 files changed, 10 insertions, 5 deletions
diff --git a/src/Operators.hs b/src/Operators.hs
index 45be7f3..84d2894 100644
--- a/src/Operators.hs
+++ b/src/Operators.hs
@@ -46,26 +46,31 @@ instance Fractional LispNumber where
46 (I a) / (F b) = F $ fromIntegral a / b 46 (I a) / (F b) = F $ fromIntegral a / b
47 (F a) / (F b) = F $ a / b 47 (F a) / (F b) = F $ a / b
48 48
49arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr 49type Arithmetic = LispNumber -> LispNumber -> LispNumber
50type Comparator = LispNumber -> LispNumber -> Bool
51type UnaryBool = Bool -> Bool
52type NaryBool = Bool -> Bool -> Bool
53
54arithmetic :: Arithmetic -> [Expr] -> LispResult Expr
50arithmetic op args 55arithmetic op args
51 | length args < 2 = throwError $ ArgCount 2 args 56 | null args = throwError $ ArgCount 1 args
52 | otherwise = do 57 | otherwise = do
53 as <- mapM unwrapNum args 58 as <- mapM unwrapNum args
54 return . wrapNum $ foldl1 op as 59 return . wrapNum $ foldl1 op as
55 60
56comparator :: (LispNumber -> LispNumber -> Bool) -> [Expr] -> LispResult Expr 61comparator :: Comparator -> [Expr] -> LispResult Expr
57comparator op args 62comparator op args
58 | length args < 2 = throwError $ ArgCount 2 args 63 | length args < 2 = throwError $ ArgCount 2 args
59 | otherwise = do 64 | otherwise = do
60 as <- mapM unwrapNum args 65 as <- mapM unwrapNum args
61 return . BoolLiteral . all (== True) $ zipWith op as (tail as) 66 return . BoolLiteral . all (== True) $ zipWith op as (tail as)
62 67
63unaryBool :: (Bool -> Bool) -> [Expr] -> LispResult Expr 68unaryBool :: UnaryBool -> [Expr] -> LispResult Expr
64unaryBool op args 69unaryBool op args
65 | length args /= 1 = throwError $ ArgCount 1 args 70 | length args /= 1 = throwError $ ArgCount 1 args
66 | otherwise = BoolLiteral . op <$> unwrapBool (head args) 71 | otherwise = BoolLiteral . op <$> unwrapBool (head args)
67 72
68naryBool :: (Bool -> Bool -> Bool) -> [Expr] -> LispResult Expr 73naryBool :: NaryBool -> [Expr] -> LispResult Expr
69naryBool op args 74naryBool op args
70 | length args < 2 = throwError $ ArgCount 2 args 75 | length args < 2 = throwError $ ArgCount 2 args
71 | otherwise = do 76 | otherwise = do