@@ -15,84 +15,148 @@
1515module PureScript.Parser.Common where
1616
1717import Control.Applicative
18+import Control.Monad
1819import qualified Text.Parsec as P
1920import qualified Text.Parsec.Indent as I
20−import qualified Text.Parsec.Token as PT
21−import qualified Text.Parsec.Language as PL
2221
2322import PureScript.Names
2423
25−langDef = PT.LanguageDef
26− { PT.reservedNames = [ "case"
27− , "data"
28− , "type"
29− , "var"
30− , "while"
31− , "for"
32− , "if"
33− , "then"
34− , "else"
35− , "return"
36− , "true"
37− , "false"
38− , "extern"
39− , "forall" ]
40− , PT.reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
41− , "==", "!=", "&", "^", "|", "&&", "||" ]
42− , PT.commentStart = "{-"
43− , PT.commentEnd = "-}"
44− , PT.commentLine = "--"
45− , PT.nestedComments = True
46− , PT.identStart = P.lower <|> P.oneOf "_$"
47− , PT.identLetter = P.alphaNum <|> P.oneOf "_'"
48− , PT.opStart = P.oneOf ":#?@\\"
49− , PT.opLetter = P.oneOf ":!#$%&*+./<=>?@\\^|-~"
50− , PT.caseSensitive = True
51− }
52−
53−tokenParser = PT.makeTokenParser langDef
54−
55−whiteSpace = P.skipMany $ (P.oneOf " \t" >> return ()) <|> P.try (P.skipMany1 (P.oneOf "\r\n")) >> I.indented <|> P.try lineComment <|> P.try blockComment
56−
24+reservedNames :: [String]
25+reservedNames = [ "case"
26+ , "data"
27+ , "type"
28+ , "var"
29+ , "while"
30+ , "for"
31+ , "if"
32+ , "then"
33+ , "else"
34+ , "return"
35+ , "true"
36+ , "false"
37+ , "extern"
38+ , "forall" ]
39+
40+reservedOpNames :: [String]
41+reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
42+ , "==", "!=", "&", "^", "|", "&&", "||" ]
43+
44+identStart :: I.IndentParser String u Char
45+identStart = P.lower <|> P.oneOf "_$"
46+
47+properNameStart :: I.IndentParser String u Char
48+properNameStart = P.upper
49+
50+identLetter :: I.IndentParser String u Char
51+identLetter = P.alphaNum <|> P.oneOf "_'"
52+
53+opStart :: I.IndentParser String u Char
54+opStart = P.oneOf ":!#$%&*+/<=>?@^|-~"
55+
56+opLetter :: I.IndentParser String u Char
57+opLetter = P.oneOf ":#$%&*+./<=>?@^|"
58+
59+whiteSpace :: I.IndentParser String u ()
60+whiteSpace = P.skipMany $ P.choice
61+ [ P.oneOf " \t" >> return ()
62+ , P.try $ P.skipMany1 (P.oneOf "\r\n") >> P.skipMany1 (P.oneOf " \t") >> I.indented
63+ , P.try lineComment
64+ , P.try blockComment ]
65+
66+lineComment :: I.IndentParser String u ()
5767lineComment = do
58− P.string $ PT.commentLine langDef
68+ P.string "--"
5969 P.skipMany $ P.satisfy (/= '\n')
60− I.indented
70+ return ()
6171
72+blockComment :: I.IndentParser String u ()
6273blockComment = do
63− P.string $ PT.commentStart langDef
64− P.manyTill P.anyChar $ P.try $ P.string $ PT.commentEnd langDef
74+ P.string "{--"
75+ P.manyTill P.anyChar $ P.try $ P.string "--}"
6576 return ()
6677
67−lexeme p = p <* whiteSpace
68−identifier = lexeme $ PT.identifier tokenParser
69−reserved s = lexeme $ PT.reserved tokenParser s
70−operator = lexeme $ PT.operator tokenParser
71−stringLiteral = lexeme $ PT.stringLiteral tokenParser
72−natural = lexeme $ PT.natural tokenParser
73−naturalOrFloat = lexeme $ PT.naturalOrFloat tokenParser
78+lexeme :: I.IndentParser String u a -> I.IndentParser String u a
79+lexeme p = p <* whiteSpace
80+
81+identifier :: I.IndentParser String u String
82+identifier = lexeme $ do
83+ name <- (:) <$> identStart <*> P.many identLetter
84+ when (name `elem` reservedNames) $ P.unexpected ("reserved word " ++ show name)
85+ return name
7486
75−semi = lexeme $ PT.semi tokenParser
76−comma = lexeme $ PT.comma tokenParser
77−colon = lexeme $ PT.colon tokenParser
78−dot = lexeme $ PT.dot tokenParser
87+properName :: I.IndentParser String u String
88+properName = lexeme $ do
89+ (:) <$> properNameStart <*> many identLetter P.<?> "name"
7990
80−semiSep p = P.sepBy p semi
81−semiSep1 p = P.sepBy1 p semi
82−commaSep p = P.sepBy p comma
83−commaSep1 p = P.sepBy1 p comma
91+reserved :: String -> I.IndentParser String u String
92+reserved name = lexeme $ P.string name <* P.notFollowedBy identLetter
8493
85−parens p = lexeme (P.char '(') *> lexeme p <* lexeme (P.char ')')
86−braces p = lexeme (P.char '{') *> lexeme p <* lexeme (P.char '}')
87−angles p = lexeme (P.char '<') *> lexeme p <* lexeme (P.char '>')
88−squares p = lexeme (P.char '[') *> lexeme p <* lexeme (P.char ']')
94+reservedOp :: String -> I.IndentParser String u String
95+reservedOp name = lexeme $ P.string name <* P.notFollowedBy opLetter
8996
90−tick = lexeme (P.char '`')
97+operator :: I.IndentParser String u String
98+operator = lexeme $ do
99+ name <- (:) <$> opStart <*> P.many opLetter
100+ when (name `elem` reservedOpNames) $ P.unexpected ("reserved operator " ++ show name)
101+ return name
91102
92−properName :: I.IndentParser String u String
93−properName = lexeme $ P.try properName'
94− where
95− properName' = (:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name"
103+stringLiteral :: I.IndentParser String u String
104+stringLiteral = lexeme $ P.between (P.char '"') (P.char '"') (P.many (P.noneOf "\""))
105+
106+number :: I.IndentParser String u String
107+number = do
108+ intPart <- P.many1 P.digit
109+ fracPart <- P.option "" $ (:) <$> P.char '.' <*> P.many1 P.digit
110+ expPart <- P.option "" $ (:) <$> P.oneOf "eE" <*> P.many1 P.digit
111+ return $ intPart ++ fracPart ++ expPart
112+
113+signedNumber :: I.IndentParser String u String
114+signedNumber = do
115+ s <- P.optionMaybe $ P.oneOf "-+"
116+ n <- number
117+ return $ maybe id (:) s n
118+
119+unsignedNumber :: I.IndentParser String u String
120+unsignedNumber = lexeme number
121+
122+semi :: I.IndentParser String u Char
123+semi = lexeme $ P.char ';'
124+
125+comma :: I.IndentParser String u Char
126+comma = lexeme $ P.char ','
127+
128+colon :: I.IndentParser String u Char
129+colon = lexeme $ P.char ':'
130+
131+dot :: I.IndentParser String u Char
132+dot = lexeme $ P.char '.'
133+
134+tick :: I.IndentParser String u Char
135+tick = lexeme $ P.char '`'
136+
137+semiSep :: I.IndentParser String u a -> I.IndentParser String u [a]
138+semiSep p = P.sepBy p semi
139+
140+semiSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
141+semiSep1 p = P.sepBy1 p semi
142+
143+commaSep :: I.IndentParser String u a -> I.IndentParser String u [a]
144+commaSep p = P.sepBy p comma
145+
146+commaSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
147+commaSep1 p = P.sepBy1 p comma
148+
149+parens :: I.IndentParser String u a -> I.IndentParser String u a
150+parens p = lexeme (P.char '(') *> lexeme p <* lexeme (P.char ')')
151+
152+braces :: I.IndentParser String u a -> I.IndentParser String u a
153+braces p = lexeme (P.char '{') *> lexeme p <* lexeme (P.char '}')
154+
155+angles :: I.IndentParser String u a -> I.IndentParser String u a
156+angles p = lexeme (P.char '<') *> lexeme p <* lexeme (P.char '>')
157+
158+squares :: I.IndentParser String u a -> I.IndentParser String u a
159+squares p = lexeme (P.char '[') *> lexeme p <* lexeme (P.char ']')
96160
97161augment :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
98162augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q