diff options
-rw-r--r-- | default.nix | 15 | ||||
-rw-r--r-- | lisk.cabal | 4 | ||||
-rw-r--r-- | src/Error.hs | 31 | ||||
-rw-r--r-- | src/Evaluator.hs | 22 | ||||
-rw-r--r-- | src/Operators.hs | 18 |
5 files changed, 72 insertions, 18 deletions
diff --git a/default.nix b/default.nix index 1890d35..90576e7 100644 --- a/default.nix +++ b/default.nix | |||
@@ -1,10 +1,19 @@ | |||
1 | { mkDerivation, base, parsec, readline, stdenv }: | 1 | { mkDerivation, base, mtl, parsec, QuickCheck, readline, stdenv |
2 | , test-framework, test-framework-hunit, test-framework-quickcheck2 | ||
3 | , test-framework-th | ||
4 | }: | ||
2 | mkDerivation { | 5 | mkDerivation { |
3 | pname = "lisk"; | 6 | pname = "lisk"; |
4 | version = "0.1.0.0"; | 7 | version = "0.1.0.0"; |
5 | src = ./.; | 8 | src = ./.; |
6 | isLibrary = false; | 9 | isLibrary = true; |
7 | isExecutable = true; | 10 | isExecutable = true; |
8 | executableHaskellDepends = [ base parsec readline ]; | 11 | libraryHaskellDepends = [ base mtl parsec ]; |
12 | executableHaskellDepends = [ base mtl parsec readline ]; | ||
13 | testHaskellDepends = [ | ||
14 | base parsec QuickCheck test-framework test-framework-hunit | ||
15 | test-framework-quickcheck2 test-framework-th | ||
16 | ]; | ||
17 | description = "a lisp interpreter"; | ||
9 | license = stdenv.lib.licenses.gpl3; | 18 | license = stdenv.lib.licenses.gpl3; |
10 | } | 19 | } |
@@ -26,7 +26,8 @@ library | |||
26 | exposed-modules: | 26 | exposed-modules: |
27 | Parser, | 27 | Parser, |
28 | Evaluator, | 28 | Evaluator, |
29 | Operators | 29 | Operators, |
30 | Error | ||
30 | 31 | ||
31 | executable lisk | 32 | executable lisk |
32 | default-language: Haskell2010 | 33 | default-language: Haskell2010 |
@@ -35,6 +36,7 @@ executable lisk | |||
35 | base >=4.12 && <4.13, | 36 | base >=4.12 && <4.13, |
36 | parsec == 3.*, | 37 | parsec == 3.*, |
37 | readline >= 1.0, | 38 | readline >= 1.0, |
39 | mtl >= 2.1, | ||
38 | lisk | 40 | lisk |
39 | hs-source-dirs: bin | 41 | hs-source-dirs: bin |
40 | 42 | ||
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 | ||