diff options
-rw-r--r-- | lisk.cabal | 1 | ||||
-rw-r--r-- | src/Operators.hs | 39 |
2 files changed, 8 insertions, 32 deletions
@@ -22,6 +22,7 @@ library | |||
22 | build-depends: | 22 | build-depends: |
23 | base == 4.*, | 23 | base == 4.*, |
24 | parsec == 3.*, | 24 | parsec == 3.*, |
25 | containers >= 0.6, | ||
25 | mtl >= 2.1 | 26 | mtl >= 2.1 |
26 | exposed-modules: | 27 | exposed-modules: |
27 | Base, | 28 | Base, |
diff --git a/src/Operators.hs b/src/Operators.hs index bab888d..23b17ea 100644 --- a/src/Operators.hs +++ b/src/Operators.hs | |||
@@ -3,9 +3,11 @@ module Operators (primitives) where | |||
3 | import Base | 3 | import Base |
4 | import Control.Monad.Except | 4 | import Control.Monad.Except |
5 | import Error.Base (LispError (..), LispResult (..)) | 5 | import Error.Base (LispError (..), LispResult (..)) |
6 | import qualified Data.Map as M | ||
6 | 7 | ||
7 | primitives :: [(String, [Expr] -> LispResult Expr)] | 8 | -- primitives :: [(String, [Expr] -> LispResult Expr)] |
8 | primitives = map (\(n, f) -> (n, f n)) | 9 | primitives :: M.Map String ([Expr] -> LispResult Expr) |
10 | primitives = M.fromList $ map (\(n, f) -> (n, f n)) | ||
9 | [ | 11 | [ |
10 | ("+", arithmetic (+)) | 12 | ("+", arithmetic (+)) |
11 | , ("-", arithmetic (-)) | 13 | , ("-", arithmetic (-)) |
@@ -26,28 +28,6 @@ primitives = map (\(n, f) -> (n, f n)) | |||
26 | , ("null?", isNull) | 28 | , ("null?", isNull) |
27 | ] | 29 | ] |
28 | 30 | ||
29 | data LispNumber = I Integer | ||
30 | | F Double | ||
31 | deriving (Eq, Ord) | ||
32 | |||
33 | instance Num LispNumber where | ||
34 | -- TODO: | ||
35 | -- float op anything = float | ||
36 | -- int op int = int | ||
37 | -- int op float = float | ||
38 | (I a) + (I b) = I $ a + b | ||
39 | (F a) + (F b) = F $ a + b | ||
40 | (I a) - (I b) = I $ a - b | ||
41 | (F a) - (F b) = F $ a - b | ||
42 | (I a) * (I b) = I $ a * b | ||
43 | (F a) * (F b) = F $ a * b | ||
44 | |||
45 | instance Fractional LispNumber where | ||
46 | (I a) / (I b) = F $ fromIntegral a / fromIntegral b | ||
47 | (F a) / (I b) = F $ a / fromIntegral b | ||
48 | (I a) / (F b) = F $ fromIntegral a / b | ||
49 | (F a) / (F b) = F $ a / b | ||
50 | |||
51 | type FName = String | 31 | type FName = String |
52 | type Arithmetic = LispNumber -> LispNumber -> LispNumber | 32 | type Arithmetic = LispNumber -> LispNumber -> LispNumber |
53 | type Comparator = LispNumber -> LispNumber -> Bool | 33 | type Comparator = LispNumber -> LispNumber -> Bool |
@@ -59,7 +39,7 @@ arithmetic op name args | |||
59 | | null args = throwError $ ArgCount name 1 args | 39 | | null args = throwError $ ArgCount name 1 args |
60 | | otherwise = do | 40 | | otherwise = do |
61 | as <- mapM unwrapNum args | 41 | as <- mapM unwrapNum args |
62 | return . wrapNum $ foldl1 op as | 42 | return . Number $ foldl1 op as |
63 | 43 | ||
64 | comparator :: Comparator -> FName -> [Expr] -> LispResult Expr | 44 | comparator :: Comparator -> FName -> [Expr] -> LispResult Expr |
65 | comparator op name args | 45 | comparator op name args |
@@ -81,13 +61,8 @@ naryBool op name args | |||
81 | return . BoolLiteral $ foldl1 op as | 61 | return . BoolLiteral $ foldl1 op as |
82 | 62 | ||
83 | unwrapNum :: Expr -> LispResult LispNumber | 63 | unwrapNum :: Expr -> LispResult LispNumber |
84 | unwrapNum (IntLiteral n) = return $ I n | 64 | unwrapNum (Number x) = return x |
85 | unwrapNum (FloatLiteral n) = return $ F n | 65 | unwrapNum x = throwError $ TypeMismatch "number" x |
86 | unwrapNum x = throwError $ TypeMismatch "number" x | ||
87 | |||
88 | wrapNum :: LispNumber -> Expr | ||
89 | wrapNum (I n) = IntLiteral n | ||
90 | wrapNum (F n) = FloatLiteral n | ||
91 | 66 | ||
92 | unwrapBool :: Expr -> LispResult Bool | 67 | unwrapBool :: Expr -> LispResult Bool |
93 | unwrapBool (BoolLiteral s) = return s | 68 | unwrapBool (BoolLiteral s) = return s |