aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Error.hs8
-rw-r--r--src/Evaluator.hs16
-rw-r--r--src/Operators.hs19
-rw-r--r--src/Parser.hs31
4 files changed, 50 insertions, 24 deletions
diff --git a/src/Error.hs b/src/Error.hs
index 5ba48bf..bfc8d14 100644
--- a/src/Error.hs
+++ b/src/Error.hs
@@ -18,10 +18,10 @@ unwordsList :: [Expr] -> String
18unwordsList = unwords . map show 18unwordsList = unwords . map show
19 19
20instance Show LispError where 20instance Show LispError where
21 show (Parse e) = "Parser Error: " ++ show e 21 show (Parse e) = "Parser Error: " ++ show e
22 show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr 22 show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr
23 show (ArgCount n es) = "Invalid arity, expected " ++ show n ++ ", got value(s): " ++ unwordsList es 23 show (ArgCount n es) = "Invalid arity, expected " ++ show n ++ ", got value(s): " ++ unwordsList es
24 show (UnknownFunction fn) = "Cannot apply function: " ++ fn 24 show (UnknownFunction fn) = "Cannot apply function: " ++ fn
25 show (TypeMismatch msg got) = "Type mismatch, expected " ++ msg ++ ", got: " ++ show got 25 show (TypeMismatch msg got) = "Type mismatch, expected " ++ msg ++ ", got: " ++ show got
26 26
27type LispResult = Either LispError 27type LispResult = Either LispError
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
index c8d8d34..10e5e58 100644
--- a/src/Evaluator.hs
+++ b/src/Evaluator.hs
@@ -10,10 +10,10 @@ import Parser
10import Text.ParserCombinators.Parsec 10import Text.ParserCombinators.Parsec
11 11
12apply :: String -> [Expr] -> LispResult Expr 12apply :: String -> [Expr] -> LispResult Expr
13apply fn args = 13apply fn args = maybe
14 case lookup fn primitives of 14 (throwError $ UnknownFunction fn)
15 Just f -> f args 15 ($ args)
16 _ -> throwError $ UnknownFunction fn 16 (lookup fn primitives)
17 17
18eval :: Expr -> LispResult Expr 18eval :: Expr -> LispResult Expr
19eval v@(StringLiteral s) = return v 19eval v@(StringLiteral s) = return v
@@ -21,9 +21,11 @@ eval v@(IntLiteral i) = return v
21eval v@(BoolLiteral b) = return v 21eval v@(BoolLiteral b) = return v
22eval v@(FloatLiteral f) = return v 22eval v@(FloatLiteral f) = return v
23-- handle quotes as literals 23-- handle quotes as literals
24eval (List[Id "quote", val]) = return val 24eval (List[Id "quote", val]) = return val
25eval (List (Id fn : args)) = mapM eval args >>= apply fn 25eval (List[Id "quasiquote", val]) = undefined
26eval (List[Id "unquote", val]) = undefined
27eval (List (Id fn : args)) = mapM eval args >>= apply fn
26 28
27-- handle bad forms 29-- handle bad forms
28eval idk = throwError $ BadForm "lisk can't recognize this form" idk 30eval invalidForm = throwError $ BadForm "lisk can't recognize this form" invalidForm
29 31
diff --git a/src/Operators.hs b/src/Operators.hs
index beb6364..e607250 100644
--- a/src/Operators.hs
+++ b/src/Operators.hs
@@ -19,6 +19,7 @@ primitives =
19 , ("<=", comparator (<=)) 19 , ("<=", comparator (<=))
20 , ("=", comparator (==)) 20 , ("=", comparator (==))
21 , ("!=", comparator (/=)) 21 , ("!=", comparator (/=))
22 , ("not", unaryBool not)
22 ] 23 ]
23 24
24data LispNumber = I Integer 25data LispNumber = I Integer
@@ -38,7 +39,9 @@ instance Num LispNumber where
38 (F a) * (F b) = F $ a * b 39 (F a) * (F b) = F $ a * b
39 40
40instance Fractional LispNumber where 41instance Fractional LispNumber where
41 (I a) / (I b) = I $ a `div` b 42 (I a) / (I b) = F $ fromIntegral a / fromIntegral b
43 (F a) / (I b) = F $ a / fromIntegral b
44 (I a) / (F b) = F $ fromIntegral a / b
42 (F a) / (F b) = F $ a / b 45 (F a) / (F b) = F $ a / b
43 46
44arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr 47arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr
@@ -55,6 +58,16 @@ comparator op args
55 as <- mapM unwrapNum args 58 as <- mapM unwrapNum args
56 return . BoolLiteral . all (== True) $ zipWith op as (tail as) 59 return . BoolLiteral . all (== True) $ zipWith op as (tail as)
57 60
61unaryBool :: (Bool -> Bool) -> [Expr] -> LispResult Expr
62unaryBool op args
63 | length args /= 1 = throwError $ ArgCount 1 args
64 | otherwise = BoolLiteral . op <$> unwrapBool (head args)
65
66naryBool :: (Bool -> Bool -> Bool) -> [Expr] -> LispResult Expr
67naryBool op args
68 | length args < 2 = throwError $ ArgCount 2 args
69
70
58unwrapNum :: Expr -> LispResult LispNumber 71unwrapNum :: Expr -> LispResult LispNumber
59unwrapNum (IntLiteral n) = return $ I n 72unwrapNum (IntLiteral n) = return $ I n
60unwrapNum (FloatLiteral n) = return $ F n 73unwrapNum (FloatLiteral n) = return $ F n
@@ -63,3 +76,7 @@ unwrapNum x = throwError $ TypeMismatch "number" x
63wrapNum :: LispNumber -> Expr 76wrapNum :: LispNumber -> Expr
64wrapNum (I n) = IntLiteral n 77wrapNum (I n) = IntLiteral n
65wrapNum (F n) = FloatLiteral n 78wrapNum (F n) = FloatLiteral n
79
80unwrapBool :: Expr -> LispResult Bool
81unwrapBool (BoolLiteral s) = return s
82unwrapBool x = throwError $ TypeMismatch "boolean" x
diff --git a/src/Parser.hs b/src/Parser.hs
index 9813f5c..5053d0a 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -13,16 +13,14 @@ import Control.Applicative ((<$>))
13import Control.Monad (liftM) 13import Control.Monad (liftM)
14import Text.ParserCombinators.Parsec 14import Text.ParserCombinators.Parsec
15 15
16 16-- TODO: use LispNumber (src/Operators.hs) here instead of IntLiteral and FloatLiteral
17type Ident = String
18
19data Expr = List [Expr] 17data Expr = List [Expr]
20 | DottedList [Expr] Expr 18 | DottedList [Expr] Expr
21 | StringLiteral String 19 | StringLiteral String
22 | IntLiteral Integer 20 | IntLiteral Integer
23 | FloatLiteral Double 21 | FloatLiteral Double
24 | BoolLiteral Bool 22 | BoolLiteral Bool
25 | Id Ident 23 | Id String
26 deriving (Eq) 24 deriving (Eq)
27 25
28parseString :: Parser Expr 26parseString :: Parser Expr
@@ -68,12 +66,17 @@ parseDottedList = do
68 whiteSpace 66 whiteSpace
69 DottedList head <$> parseLispValue 67 DottedList head <$> parseLispValue
70 68
71parseQuote :: Parser Expr 69type Alias = String
72parseQuote = do 70parseModifier :: Char -> Alias -> Parser Expr
73 char '\'' 71parseModifier c alias = do
72 char c
74 x <- parseLispValue 73 x <- parseLispValue
75 return $ List [Id "quote", x] 74 return $ List [Id alias, x]
76 75
76parseQuote = parseModifier '\'' "quote"
77parseQuasiquote = parseModifier '`' "quasiquote"
78parseUnquote = parseModifier ',' "unquote"
79-- TODO: add modifier for unquote splicing
77 80
78parseLispValue :: Parser Expr 81parseLispValue :: Parser Expr
79parseLispValue = 82parseLispValue =
@@ -82,7 +85,8 @@ parseLispValue =
82 <|> try parseFloat 85 <|> try parseFloat
83 <|> parseInt 86 <|> parseInt
84 <|> parseQuote 87 <|> parseQuote
85 -- TODO: figure out a way to have floats and dotted lists 88 <|> parseQuasiquote
89 <|> parseUnquote
86 <|> do 90 <|> do
87 char '(' 91 char '('
88 x <- try parseList <|> parseDottedList 92 x <- try parseList <|> parseDottedList
@@ -90,12 +94,15 @@ parseLispValue =
90 return x 94 return x
91 <?> "expected lisp value!" 95 <?> "expected lisp value!"
92 96
97showLispList :: [Expr] -> String
98showLispList = unwords . map show
99
93instance Show Expr where 100instance Show Expr where
94 show (DottedList xs x) = "(" ++ unwords (map show xs) ++ " . " ++ show x ++ ")" 101 show (DottedList xs x) = "(" ++ showLispList xs ++ " . " ++ show x ++ ")"
95 show (List xs) = "(" ++ unwords (map show xs) ++ ")" 102 show (List xs) = "(" ++ showLispList xs ++ ")"
96 show (StringLiteral s) = "\"" ++ s ++ "\"" 103 show (StringLiteral s) = "\"" ++ s ++ "\""
97 show (IntLiteral n) = show n 104 show (IntLiteral n) = show n
98 show (FloatLiteral n) = show n 105 show (FloatLiteral n) = show n
99 show (BoolLiteral True) = "#t" 106 show (BoolLiteral True) = "#t"
100 show (BoolLiteral False) = "#f" 107 show (BoolLiteral False) = "#f"
101 show (Id i) = i 108 show (Id i) = i