aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Error.hs31
-rw-r--r--src/Evaluator.hs22
-rw-r--r--src/Operators.hs18
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 @@
1module Error (
2 LispError (..)
3 , LispResult (..)
4 , unwrap
5 ) where
6
7import Control.Monad.Except
8import Parser
9import Text.ParserCombinators.Parsec
10
11data LispError = Parse ParseError
12 | BadForm String Expr
13 | ArgCount Int [Expr]
14 | UnknownFunction String
15 | TypeMismatch String Expr
16
17unwordsList :: [Expr] -> String
18unwordsList = unwords . map show
19
20instance 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
27type LispResult = Either LispError
28
29unwrap :: LispResult t -> t
30unwrap (Right v) = v
31unwrap (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
5import Control.Monad.Except
6import Error (LispError (..), LispResult (..),
7 unwrap)
5import Operators 8import Operators
6import Parser 9import Parser
7import Text.ParserCombinators.Parsec 10import Text.ParserCombinators.Parsec
8 11
9apply :: String -> [Expr] -> Expr 12apply :: String -> [Expr] -> LispResult Expr
10apply fn args = 13apply 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
15eval :: Expr -> Expr 18eval :: Expr -> LispResult Expr
16eval v@(StringLiteral s) = v 19eval v@(StringLiteral s) = return v
17eval v@(IntLiteral i) = v 20eval v@(IntLiteral i) = return v
18eval v@(BoolLiteral b) = v 21eval v@(BoolLiteral b) = return v
19-- handle quotes as literals 22-- handle quotes as literals
20eval (List[Id "quote", val]) = val 23eval (List[Id "quote", val]) = return val
21eval (List (Id fn : args)) = apply fn $ map eval args 24eval (List (Id fn : args)) = mapM eval args >>= apply fn
25
26-- handle bad forms
27eval 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
5import Control.Monad.Except
6import Error (LispError (..), LispResult (..))
5import Parser 7import Parser
6 8
7primitives :: [(String, [Expr] -> Expr)] 9primitives :: [(String, [Expr] -> LispResult Expr)]
8primitives = 10primitives =
9 [ 11 [
10 ("+", arithmetic (+)) 12 ("+", arithmetic (+))
@@ -13,10 +15,14 @@ primitives =
13 , ("/", arithmetic div) 15 , ("/", arithmetic div)
14 ] 16 ]
15 17
16arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> Expr 18arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> LispResult Expr
17arithmetic op args = IntLiteral $ foldl1 op $ map unwrapNum args 19arithmetic 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
19unwrapNum :: Expr -> Integer 25unwrapNum :: Expr -> LispResult Integer
20unwrapNum (IntLiteral n) = n 26unwrapNum (IntLiteral n) = return n
21unwrapNum _ = undefined 27unwrapNum x = throwError $ TypeMismatch "number" x
22 28