aboutsummaryrefslogtreecommitdiff
path: root/src/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Parser.hs')
-rw-r--r--src/Parser.hs101
1 files changed, 101 insertions, 0 deletions
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