blob: 4f9e965cb173353399838d5f1c74a99921649d2e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
module Parser(parseProgram, parseExpression) where
import Control.Monad
import Data.Char
import Text.Parsec
import AST
type Parser = Parsec String ()
parseProgram :: String -> Either ParseError Program
parseProgram = parse pProgram ""
pProgram :: Parser Program
pProgram = between pWhiteComment eof (liftM Program (many pValue))
parseExpression :: String -> Either ParseError Value
parseExpression = parse pExpression ""
pExpression :: Parser Value
pExpression = between pWhiteComment eof pValue
pValue :: Parser Value
pValue = pVEllipsis <|> pVList <|> pVNum <|> pVString <|> pVName <|> pVQuoted <?> "value"
pVList :: Parser Value
pVList = flip label "list" $ do
symbol "("
exs <- many pValue
symbol ")"
return $ VList exs
pVNum :: Parser Value
pVNum = liftM (VNum . read) (many1 digit) <* pWhiteComment <?> "number"
pVString :: Parser Value
pVString = flip label "string" $ do
void $ char '"'
s <- manyTill anyChar (symbol "\"")
return $ VString s
pVName :: Parser Value
pVName = flip label "name" $ do
first <- satisfy isFirstNameChar
rest <- many (satisfy isNameChar)
pWhiteComment
return $ VName $ first : rest
where
isNameChar c = ((c >= '*' && c <= 'z') || c `elem` "!#$%&|~") && c /= ';'
isFirstNameChar c = isNameChar c && not (isDigit c)
pVQuoted :: Parser Value
pVQuoted = char '\'' >> liftM VQuoted pValue <?> "quoted value"
pVEllipsis :: Parser Value
pVEllipsis = symbol "..." >> return VEllipsis <?> "ellipsis"
symbol :: String -> Parser ()
symbol s = try (string s) >> pWhiteComment
pWhiteComment :: Parser ()
pWhiteComment = do
pWhitespace
void $ many $ pComment >> pWhitespace
where
pWhitespace :: Parser ()
pWhitespace = void (many space) <?> "whitespace"
pComment :: Parser ()
pComment = flip label "comment" $ do
void $ char ';'
void (manyTill anyChar (void endOfLine <|> eof))
|
