aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAkshay <[email protected]>2020-10-09 07:58:15 +0100
committerAkshay <[email protected]>2020-10-09 07:58:15 +0100
commit3ef6ec4bd3314efcac2504bd3a25e380d5e9514f (patch)
treee3c7a0f50eb7c5997d60abb923b813c1d1ebe3fa /src
parentc785a95f14f8bb3887cdc411ef3329533a2c819a (diff)
add experimental floating point handling
Diffstat (limited to 'src')
-rw-r--r--src/Evaluator.hs1
-rw-r--r--src/Operators.hs31
-rw-r--r--src/Parser.hs12
3 files changed, 32 insertions, 12 deletions
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
index 28ee79b..c8d8d34 100644
--- a/src/Evaluator.hs
+++ b/src/Evaluator.hs
@@ -19,6 +19,7 @@ eval :: Expr -> LispResult Expr
19eval v@(StringLiteral s) = return v 19eval v@(StringLiteral s) = return v
20eval v@(IntLiteral i) = return v 20eval v@(IntLiteral i) = return v
21eval v@(BoolLiteral b) = return v 21eval v@(BoolLiteral b) = return v
22eval v@(FloatLiteral f) = return v
22-- handle quotes as literals 23-- handle quotes as literals
23eval (List[Id "quote", val]) = return val 24eval (List[Id "quote", val]) = return val
24eval (List (Id fn : args)) = mapM eval args >>= apply fn 25eval (List (Id fn : args)) = mapM eval args >>= apply fn
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
18arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> LispResult Expr 18data LispNumber = I Integer
19 | F Double
20
21instance 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
29instance Fractional LispNumber where
30 (I a) / (I b) = I $ a `div` b
31 (F a) / (F b) = F $ a / b
32
33arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr
19arithmetic op args 34arithmetic 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
25unwrapNum :: Expr -> LispResult Integer 40unwrapNum :: Expr -> LispResult LispNumber
26unwrapNum (IntLiteral n) = return n 41unwrapNum (IntLiteral n) = return $ I n
27unwrapNum x = throwError $ TypeMismatch "number" x 42unwrapNum (FloatLiteral n) = return $ F n
43unwrapNum x = throwError $ TypeMismatch "number" x
28 44
45wrapNum :: LispNumber -> Expr
46wrapNum (I n) = IntLiteral n
47wrapNum (F n) = FloatLiteral n
diff --git a/src/Parser.hs b/src/Parser.hs
index dcbfdb1..9813f5c 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -3,7 +3,7 @@ module Parser ( parseLispValue
3 , parseString 3 , parseString
4 , parseInt 4 , parseInt
5 , parseFloat 5 , parseFloat
6 , parseAtom 6 , parseId
7 , parseList 7 , parseList
8 , parseQuote 8 , parseQuote
9 , parseDottedList 9 , parseDottedList
@@ -37,7 +37,7 @@ parseInt = IntLiteral . read <$> many1 digit
37 37
38parseFloat :: Parser Expr 38parseFloat :: Parser Expr
39parseFloat = do 39parseFloat = do
40 characteristic <- many digit 40 characteristic <- many1 digit
41 char '.' 41 char '.'
42 mantissa <- many1 digit 42 mantissa <- many1 digit
43 return $ (FloatLiteral . read) $ characteristic ++ "." ++ mantissa 43 return $ (FloatLiteral . read) $ characteristic ++ "." ++ mantissa
@@ -45,8 +45,8 @@ parseFloat = do
45symbol :: Parser Char 45symbol :: Parser Char
46symbol = oneOf "!#$%&|*+:/-=<?>@^_~" 46symbol = oneOf "!#$%&|*+:/-=<?>@^_~"
47 47
48parseAtom :: Parser Expr 48parseId :: Parser Expr
49parseAtom = do 49parseId = do
50 first <- letter <|> symbol 50 first <- letter <|> symbol
51 rest <- many (letter <|> symbol <|> digit) 51 rest <- many (letter <|> symbol <|> digit)
52 let atom = first:rest 52 let atom = first:rest
@@ -77,12 +77,12 @@ parseQuote = do
77 77
78parseLispValue :: Parser Expr 78parseLispValue :: Parser Expr
79parseLispValue = 79parseLispValue =
80 try parseAtom 80 try parseId
81 <|> parseString 81 <|> parseString
82 <|> try parseFloat
82 <|> parseInt 83 <|> parseInt
83 <|> parseQuote 84 <|> parseQuote
84 -- TODO: figure out a way to have floats and dotted lists 85 -- TODO: figure out a way to have floats and dotted lists
85 -- <|> parseFloat
86 <|> do 86 <|> do
87 char '(' 87 char '('
88 x <- try parseList <|> parseDottedList 88 x <- try parseList <|> parseDottedList