aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Evaluator.hs22
-rw-r--r--src/Operators.hs22
-rw-r--r--src/Parser.hs101
3 files changed, 145 insertions, 0 deletions
diff --git a/src/Evaluator.hs b/src/Evaluator.hs
new file mode 100644
index 0000000..f264ee0
--- /dev/null
+++ b/src/Evaluator.hs
@@ -0,0 +1,22 @@
1module Evaluator (
2 eval
3 ) where
4
5import Operators
6import Parser
7import Text.ParserCombinators.Parsec
8
9apply :: String -> [Expr] -> Expr
10apply fn args =
11 case lookup fn primitives of
12 Just f -> f args
13 _ -> BoolLiteral False -- TODO: error out instead
14
15eval :: Expr -> Expr
16eval v@(StringLiteral s) = v
17eval v@(IntLiteral i) = v
18eval v@(BoolLiteral b) = v
19-- handle quotes as literals
20eval (List[Id "quote", val]) = val
21eval (List (Id fn : args)) = apply fn $ map eval args
22
diff --git a/src/Operators.hs b/src/Operators.hs
new file mode 100644
index 0000000..e57f885
--- /dev/null
+++ b/src/Operators.hs
@@ -0,0 +1,22 @@
1module Operators (
2 primitives
3 ) where
4
5import Parser
6
7primitives :: [(String, [Expr] -> Expr)]
8primitives =
9 [
10 ("+", arithmetic (+))
11 , ("-", arithmetic (-))
12 , ("*", arithmetic (*))
13 , ("/", arithmetic div)
14 ]
15
16arithmetic :: (Integer -> Integer -> Integer) -> [Expr] -> Expr
17arithmetic op args = IntLiteral $ foldl1 op $ map unwrapNum args
18
19unwrapNum :: Expr -> Integer
20unwrapNum (IntLiteral n) = n
21unwrapNum _ = undefined
22
diff --git a/src/Parser.hs b/src/Parser.hs
new file mode 100644
index 0000000..dcbfdb1
--- /dev/null
+++ b/src/Parser.hs
@@ -0,0 +1,101 @@
1module Parser ( parseLispValue
2 , Expr(..)
3 , parseString
4 , parseInt
5 , parseFloat
6 , parseAtom
7 , parseList
8 , parseQuote
9 , parseDottedList
10 ) where
11
12import Control.Applicative ((<$>))
13import Control.Monad (liftM)
14import Text.ParserCombinators.Parsec
15
16
17type Ident = String
18
19data Expr = List [Expr]
20 | DottedList [Expr] Expr
21 | StringLiteral String
22 | IntLiteral Integer
23 | FloatLiteral Double
24 | BoolLiteral Bool
25 | Id Ident
26 deriving (Eq)
27
28parseString :: Parser Expr
29parseString = do
30 char '"'
31 innards <- many (noneOf "\"")
32 char '"'
33 return (StringLiteral innards)
34
35parseInt :: Parser Expr
36parseInt = IntLiteral . read <$> many1 digit
37
38parseFloat :: Parser Expr
39parseFloat = do
40 characteristic <- many digit
41 char '.'
42 mantissa <- many1 digit
43 return $ (FloatLiteral . read) $ characteristic ++ "." ++ mantissa
44
45symbol :: Parser Char
46symbol = oneOf "!#$%&|*+:/-=<?>@^_~"
47
48parseAtom :: Parser Expr
49parseAtom = do
50 first <- letter <|> symbol
51 rest <- many (letter <|> symbol <|> digit)
52 let atom = first:rest
53 return $ case atom of
54 "#t" -> BoolLiteral True
55 "#f" -> BoolLiteral False
56 _ -> Id atom
57
58whiteSpace :: Parser ()
59whiteSpace = skipMany1 space
60
61parseList :: Parser Expr
62parseList = List <$> sepBy parseLispValue whiteSpace
63
64parseDottedList :: Parser Expr
65parseDottedList = do
66 head <- endBy parseLispValue whiteSpace
67 char '.'
68 whiteSpace
69 DottedList head <$> parseLispValue
70
71parseQuote :: Parser Expr
72parseQuote = do
73 char '\''
74 x <- parseLispValue
75 return $ List [Id "quote", x]
76
77
78parseLispValue :: Parser Expr
79parseLispValue =
80 try parseAtom
81 <|> parseString
82 <|> parseInt
83 <|> parseQuote
84 -- TODO: figure out a way to have floats and dotted lists
85 -- <|> parseFloat
86 <|> do
87 char '('
88 x <- try parseList <|> parseDottedList
89 char ')'
90 return x
91 <?> "expected lisp value!"
92
93instance Show Expr where
94 show (DottedList xs x) = "(" ++ unwords (map show xs) ++ " . " ++ show x ++ ")"
95 show (List xs) = "(" ++ unwords (map show xs) ++ ")"
96 show (StringLiteral s) = "\"" ++ s ++ "\""
97 show (IntLiteral n) = show n
98 show (FloatLiteral n) = show n
99 show (BoolLiteral True) = "#t"
100 show (BoolLiteral False) = "#f"
101 show (Id i) = i