diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Error.hs | 31 | ||||
-rw-r--r-- | src/Evaluator.hs | 22 | ||||
-rw-r--r-- | src/Operators.hs | 18 |
3 files changed, 57 insertions, 14 deletions
diff --git a/src/Error.hs b/src/Error.hs new file mode 100644 index 0000000..276d3e2 --- /dev/null +++ b/src/Error.hs | |||
@@ -0,0 +1,31 @@ | |||
1 | module Error ( | ||
2 | LispError (..) | ||
3 | , LispResult (..) | ||
4 | , unwrap | ||
5 | ) where | ||
6 | |||
7 | import Control.Monad.Except | ||
8 | import Parser | ||
9 | import Text.ParserCombinators.Parsec | ||
10 | |||
11 | data LispError = Parse ParseError | ||
12 | | BadForm String Expr | ||
13 | | ArgCount Int [Expr] | ||
14 | | UnknownFunction String | ||
15 | | TypeMismatch String Expr | ||
16 | |||
17 | unwordsList :: [Expr] -> String | ||
18 | unwordsList = unwords . map show | ||
19 | |||
20 | instance Show LispError where | ||
21 | show (Parse e) = "Parser Error: " ++ show e | ||
22 | show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr | ||
23 | show (ArgCount n es) = "Invalid arity, expected " ++ show n ++ ", got values: " ++ unwordsList es | ||
24 | show (UnknownFunction fn) = "Unknown reference to function: " ++ fn | ||
25 | show (TypeMismatch msg got) = "Type mismatch, expected " ++ msg ++ ", got: " ++ show got | ||
26 | |||
27 | type LispResult = Either LispError | ||
28 | |||
29 | unwrap :: LispResult t -> t | ||
30 | unwrap (Right v) = v | ||
31 | unwrap (Left _) = undefined -- should panic | ||
diff --git a/src/Evaluator.hs b/src/Evaluator.hs index f264ee0..28ee79b 100644 --- a/src/Evaluator.hs +++ b/src/Evaluator.hs | |||
@@ -2,21 +2,27 @@ module Evaluator ( | |||
2 | eval | 2 | eval |
3 | ) where | 3 | ) where |
4 | 4 | ||
5 | import Control.Monad.Except | ||
6 | import Error (LispError (..), LispResult (..), | ||
7 | unwrap) | ||
5 | import Operators | 8 | import Operators |
6 | import Parser | 9 | import Parser |
7 | import Text.ParserCombinators.Parsec | 10 | import Text.ParserCombinators.Parsec |
8 | 11 | ||
9 | apply :: String -> [Expr] -> Expr | 12 | apply :: String -> [Expr] -> LispResult Expr |
10 | apply fn args = | 13 | apply fn args = |
11 | case lookup fn primitives of | 14 | case lookup fn primitives of |
12 | Just f -> f args | 15 | Just f -> f args |
13 | _ -> BoolLiteral False -- TODO: error out instead | 16 | _ -> throwError $ UnknownFunction fn |
14 | 17 | ||
15 | eval :: Expr -> Expr | 18 | eval :: Expr -> LispResult Expr |
16 | eval v@(StringLiteral s) = v | 19 | eval v@(StringLiteral s) = return v |
17 | eval v@(IntLiteral i) = v | 20 | eval v@(IntLiteral i) = return v |
18 | eval v@(BoolLiteral b) = v | 21 | eval v@(BoolLiteral b) = return v |
19 | -- handle quotes as literals | 22 | -- handle quotes as literals |
20 | eval (List[Id "quote", val]) = val | 23 | eval (List[Id "quote", val]) = return val |
21 | eval (List (Id fn : args)) = apply fn $ map eval args | 24 | eval (List (Id fn : args)) = mapM eval args >>= apply fn |
25 | |||
26 | -- handle bad forms | ||
27 | eval idk = throwError $ BadForm "lisk can't recognize this form" idk | ||
22 | 28 | ||
diff --git a/src/Operators.hs b/src/Operators.hs index e57f885..3b96281 100644 --- a/src/Operators.hs +++ b/src/Operators.hs | |||
@@ -2,9 +2,11 @@ module Operators ( | |||
2 | primitives | 2 | primitives |
3 | ) where | 3 | ) where |
4 | 4 | ||
5 | import Control.Monad.Except | ||
6 | import Error (LispError (..), LispResult (..)) | ||
5 | import Parser | 7 | import Parser |
6 | 8 | ||
7 | primitives :: [(String, [Expr] -> Expr)] | 9 | primitives :: [(String, [Expr] -> LispResult Expr)] |
8 | primitives = | 10 | primitives = |
9 | [ | 11 | [ |
10 | ("+", arithmetic (+)) | 12 | ("+", arithmetic (+)) |
@@ -13,10 +15,14 @@ primitives = | |||
13 | , ("/", arithmetic div) | 15 | , ("/", arithmetic div) |
14 | ] | 16 | ] |
15 | 17 | ||
16 | arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> Expr | 18 | arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> LispResult Expr |
17 | arithmetic op args = IntLiteral $ foldl1 op $ map unwrapNum args | 19 | arithmetic op args |
20 | | length args < 2 = throwError $ ArgCount 2 args | ||
21 | | otherwise = do | ||
22 | as <- mapM unwrapNum args | ||
23 | return . IntLiteral $ foldl1 op as | ||
18 | 24 | ||
19 | unwrapNum :: Expr -> Integer | 25 | unwrapNum :: Expr -> LispResult Integer |
20 | unwrapNum (IntLiteral n) = n | 26 | unwrapNum (IntLiteral n) = return n |
21 | unwrapNum _ = undefined | 27 | unwrapNum x = throwError $ TypeMismatch "number" x |
22 | 28 | ||