aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--default.nix15
-rw-r--r--lisk.cabal4
-rw-r--r--src/Error.hs31
-rw-r--r--src/Evaluator.hs22
-rw-r--r--src/Operators.hs18
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}:
2mkDerivation { 5mkDerivation {
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}
diff --git a/lisk.cabal b/lisk.cabal
index 627815d..bea3414 100644
--- a/lisk.cabal
+++ b/lisk.cabal
@@ -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
31executable lisk 32executable 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 @@
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