diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Error.hs | 8 | ||||
-rw-r--r-- | src/Evaluator.hs | 16 | ||||
-rw-r--r-- | src/Operators.hs | 19 | ||||
-rw-r--r-- | src/Parser.hs | 31 |
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 | |||
18 | unwordsList = unwords . map show | 18 | unwordsList = unwords . map show |
19 | 19 | ||
20 | instance Show LispError where | 20 | instance 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 | ||
27 | type LispResult = Either LispError | 27 | type 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 | |||
10 | import Text.ParserCombinators.Parsec | 10 | import Text.ParserCombinators.Parsec |
11 | 11 | ||
12 | apply :: String -> [Expr] -> LispResult Expr | 12 | apply :: String -> [Expr] -> LispResult Expr |
13 | apply fn args = | 13 | apply 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 | ||
18 | eval :: Expr -> LispResult Expr | 18 | eval :: Expr -> LispResult Expr |
19 | eval v@(StringLiteral s) = return v | 19 | eval v@(StringLiteral s) = return v |
@@ -21,9 +21,11 @@ eval v@(IntLiteral i) = return v | |||
21 | eval v@(BoolLiteral b) = return v | 21 | eval v@(BoolLiteral b) = return v |
22 | eval v@(FloatLiteral f) = return v | 22 | eval v@(FloatLiteral f) = return v |
23 | -- handle quotes as literals | 23 | -- handle quotes as literals |
24 | eval (List[Id "quote", val]) = return val | 24 | eval (List[Id "quote", val]) = return val |
25 | eval (List (Id fn : args)) = mapM eval args >>= apply fn | 25 | eval (List[Id "quasiquote", val]) = undefined |
26 | eval (List[Id "unquote", val]) = undefined | ||
27 | eval (List (Id fn : args)) = mapM eval args >>= apply fn | ||
26 | 28 | ||
27 | -- handle bad forms | 29 | -- handle bad forms |
28 | eval idk = throwError $ BadForm "lisk can't recognize this form" idk | 30 | eval 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 | ||
24 | data LispNumber = I Integer | 25 | data 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 | ||
40 | instance Fractional LispNumber where | 41 | instance 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 | ||
44 | arithmetic :: (LispNumber -> LispNumber -> LispNumber) -> [Expr] -> LispResult Expr | 47 | arithmetic :: (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 | ||
61 | unaryBool :: (Bool -> Bool) -> [Expr] -> LispResult Expr | ||
62 | unaryBool op args | ||
63 | | length args /= 1 = throwError $ ArgCount 1 args | ||
64 | | otherwise = BoolLiteral . op <$> unwrapBool (head args) | ||
65 | |||
66 | naryBool :: (Bool -> Bool -> Bool) -> [Expr] -> LispResult Expr | ||
67 | naryBool op args | ||
68 | | length args < 2 = throwError $ ArgCount 2 args | ||
69 | |||
70 | |||
58 | unwrapNum :: Expr -> LispResult LispNumber | 71 | unwrapNum :: Expr -> LispResult LispNumber |
59 | unwrapNum (IntLiteral n) = return $ I n | 72 | unwrapNum (IntLiteral n) = return $ I n |
60 | unwrapNum (FloatLiteral n) = return $ F n | 73 | unwrapNum (FloatLiteral n) = return $ F n |
@@ -63,3 +76,7 @@ unwrapNum x = throwError $ TypeMismatch "number" x | |||
63 | wrapNum :: LispNumber -> Expr | 76 | wrapNum :: LispNumber -> Expr |
64 | wrapNum (I n) = IntLiteral n | 77 | wrapNum (I n) = IntLiteral n |
65 | wrapNum (F n) = FloatLiteral n | 78 | wrapNum (F n) = FloatLiteral n |
79 | |||
80 | unwrapBool :: Expr -> LispResult Bool | ||
81 | unwrapBool (BoolLiteral s) = return s | ||
82 | unwrapBool 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 ((<$>)) | |||
13 | import Control.Monad (liftM) | 13 | import Control.Monad (liftM) |
14 | import Text.ParserCombinators.Parsec | 14 | import Text.ParserCombinators.Parsec |
15 | 15 | ||
16 | 16 | -- TODO: use LispNumber (src/Operators.hs) here instead of IntLiteral and FloatLiteral | |
17 | type Ident = String | ||
18 | |||
19 | data Expr = List [Expr] | 17 | data 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 | ||
28 | parseString :: Parser Expr | 26 | parseString :: Parser Expr |
@@ -68,12 +66,17 @@ parseDottedList = do | |||
68 | whiteSpace | 66 | whiteSpace |
69 | DottedList head <$> parseLispValue | 67 | DottedList head <$> parseLispValue |
70 | 68 | ||
71 | parseQuote :: Parser Expr | 69 | type Alias = String |
72 | parseQuote = do | 70 | parseModifier :: Char -> Alias -> Parser Expr |
73 | char '\'' | 71 | parseModifier 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 | ||
76 | parseQuote = parseModifier '\'' "quote" | ||
77 | parseQuasiquote = parseModifier '`' "quasiquote" | ||
78 | parseUnquote = parseModifier ',' "unquote" | ||
79 | -- TODO: add modifier for unquote splicing | ||
77 | 80 | ||
78 | parseLispValue :: Parser Expr | 81 | parseLispValue :: Parser Expr |
79 | parseLispValue = | 82 | parseLispValue = |
@@ -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 | ||
97 | showLispList :: [Expr] -> String | ||
98 | showLispList = unwords . map show | ||
99 | |||
93 | instance Show Expr where | 100 | instance 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 |