git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #779 from purescript/lexer3

New lexer

commit8c16ed7fbe2b1b9e26e6e355fdb21a8ad46d2d94 authorPhil Freeman <paf31@cantab.net> dateWed 24 Dec 2014, 11:16 (12 years ago) parent513ded4820a885
12 files changed+730−530
compare with golang
unifiedsplit
hierarchy/Main.hs+3−3 psci/Main.hs+5−3 psci/Parser.hs+49−79 purescript.cabal+7−6 src/Language/PureScript.hs+1−1 src/Language/PureScript/Parser.hs+1 src/Language/PureScript/Parser/Common.hs+26−280 src/Language/PureScript/Parser/Declarations.hs+127−123 src/Language/PureScript/Parser/Kinds.hs+9−9 src/Language/PureScript/Parser/Lexer.hs+476 src/Language/PureScript/Parser/Types.hs+25−25 src/Language/PureScript/Pretty/Common.hs+1−1
hierarchy/Main.hs+3−3
@@ -55,9 +55,9 @@ runModuleName :: P.ModuleName -> String
5555runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
5656
5757readInput :: FilePath -> IO (Either Par.ParseError [P.Module])
58−readInput p = do
59− text <- U.readFile p
60− return $ P.runIndentParser p P.parseModules text
58+readInput filename = do
59+ content <- U.readFile filename
60+ return $ fmap (map snd) $ P.parseModulesFromFiles id [(filename, content)]
6161
6262compile :: HierarchyOptions -> IO ()
6363compile (HierarchyOptions input mOutput) = do
psci/Main.hs+5−3
@@ -127,7 +127,9 @@ getHistoryFilename = do
127127-- Loads a file for use with imports.
128128--
129129loadModule :: FilePath -> IO (Either String [P.Module])
130−loadModule filename = either (Left . show) Right . P.runIndentParser filename P.parseModules <$> U.readFile filename
130+loadModule filename = do
131+ content <- U.readFile filename
132+ return $ either (Left . show) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
131133
132134-- |
133135-- Load all modules, including the Prelude
@@ -441,7 +443,7 @@ handleKindOf typ = do
441443-- |
442444-- Parses the input and returns either a Metacommand or an expression.
443445--
444−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either Par.ParseError (Maybe Command))
446+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
445447getCommand singleLineMode = do
446448 firstLine <- getInputLine "> "
447449 case firstLine of
@@ -519,7 +521,7 @@ loop (PSCiOptions singleLineMode files) = do
519521 go = do
520522 c <- getCommand singleLineMode
521523 case c of
522− Left err -> outputStrLn (show err) >> go
524+ Left err -> outputStrLn err >> go
523525 Right Nothing -> go
524526 Right (Just Quit) -> outputStrLn quitMessage
525527 Right (Just c') -> runPSCI (handleCommand c') >> go
psci/Parser.hs+49−79
@@ -17,6 +17,8 @@ module Parser (
1717 parseCommand
1818 ) where
1919
20+import Prelude hiding (lex)
21+
2022import Commands
2123
2224import Data.Char (isSpace)
@@ -28,85 +30,53 @@ import Text.Parsec hiding ((<|>))
2830import qualified Language.PureScript as P
2931import qualified Language.PureScript.Parser.Common as C (mark, same)
3032
31−-- |
32−-- PSCI version of @let@.
33−-- This is essentially let from do-notation.
34−-- However, since we don't support the @Eff@ monad,
35−-- we actually want the normal @let@.
36−--
37−psciLet :: Parsec String P.ParseState Command
38−psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> C.mark (many1 (C.same *> P.parseDeclaration))))
39−
4033-- |
4134-- Parses PSCI metacommands or expressions input from the user.
4235--
43−parseCommand :: String -> Either ParseError Command
44−parseCommand = P.runIndentParser "" $ choice
45− [ P.whiteSpace *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf <|> psciKindOf <|> psciBrowse <|> psciShowModules)
46− , try psciLet
47− , psciExpression
48− ] <* eof
49−
50−-- |
51−-- Parses expressions entered at the PSCI repl.
52−--
53−psciExpression :: Parsec String P.ParseState Command
54−psciExpression = Expression <$> P.parseValue
55−
56−-- |
57−-- Parses 'Commands.Help' command.
58−--
59−psciHelp :: Parsec String P.ParseState Command
60−psciHelp = Help <$ char '?'
61−
62−-- |
63−-- Parses 'Commands.Import' command.
64−--
65−psciImport :: Parsec String P.ParseState Command
66−psciImport = Import <$> (char 'i' *> P.whiteSpace *> P.moduleName)
67−
68−-- |
69−-- Parses 'Commands.LoadFile' command.
70−--
71−psciLoadFile :: Parsec String P.ParseState Command
72−psciLoadFile = LoadFile . trimEnd <$> (char 'm' *> P.whiteSpace *> manyTill anyChar eof)
73−
74−-- | Trim end of input string
75−trimEnd :: String -> String
76−trimEnd = reverse . dropWhile isSpace . reverse
77−
78−-- |
79−-- Parses 'Commands.Quit' command.
80−--
81−psciQuit :: Parsec String P.ParseState Command
82−psciQuit = Quit <$ char 'q'
83−
84−-- |
85−-- Parses 'Commands.Reload' command.
86−--
87−psciReload :: Parsec String P.ParseState Command
88−psciReload = Reset <$ char 'r'
89−
90−-- |
91−-- Parses 'Commands.TypeOf' command.
92−--
93−psciTypeOf :: Parsec String P.ParseState Command
94−psciTypeOf = TypeOf <$> (char 't' *> P.whiteSpace *> P.parseValue)
95−
96−
97−-- |
98−-- Parses 'Commands.KindOf' command.
99−--
100−psciKindOf :: Parsec String P.ParseState Command
101−psciKindOf = KindOf <$> (char 'k' *> P.whiteSpace *> P.parseType)
102−
103−-- |
104−-- Parses 'Commands.Browse' command.
105−--
106−psciBrowse :: Parsec String P.ParseState Command
107−psciBrowse = Browse <$> (char 'b' *> P.whiteSpace *> P.moduleName)
108−
109−-- |
110−-- Show Command
111−psciShowModules :: Parsec String P.ParseState Command
112−psciShowModules = Show . trimEnd <$> (char 's' *> P.whiteSpace *> manyTill anyChar eof)
36+parseCommand :: String -> Either String Command
37+parseCommand cmdString =
38+ case splitCommand cmdString of
39+ Just ('?', _) -> return Help
40+ Just ('q', _) -> return Quit
41+ Just ('r', _) -> return Reset
42+ Just ('i', moduleName) -> Import <$> parseRest P.moduleName moduleName
43+ Just ('b', moduleName) -> Browse <$> parseRest P.moduleName moduleName
44+ Just ('m', filename) -> return $ LoadFile (trimEnd filename)
45+ Just ('s', command) -> return $ Show (trimEnd command)
46+ Just ('t', expr) -> TypeOf <$> parseRest P.parseValue expr
47+ Just ('k', ty) -> KindOf <$> parseRest P.parseType ty
48+ Just _ -> Left $ "Unrecognized command. Type :? for help."
49+ Nothing -> parseRest (psciLet <|> psciExpression) cmdString
50+ where
51+ parseRest :: P.TokenParser a -> String -> Either String a
52+ parseRest p s = either (Left . show) Right $ do
53+ ts <- P.lex "" s
54+ P.runTokenParser "" (p <* eof) ts
55+
56+ trimEnd :: String -> String
57+ trimEnd = reverse . dropWhile isSpace . reverse
58+
59+ -- |
60+ -- Split a command into a command char and the trailing string
61+ --
62+ splitCommand :: String -> Maybe (Char, String)
63+ splitCommand (':' : c : s) = Just (c, dropWhile isSpace s)
64+ splitCommand _ = Nothing
65+
66+ -- |
67+ -- Parses expressions entered at the PSCI repl.
68+ --
69+ psciExpression :: P.TokenParser Command
70+ psciExpression = Expression <$> P.parseValue
71+
72+ -- |
73+ -- PSCI version of @let@.
74+ -- This is essentially let from do-notation.
75+ -- However, since we don't support the @Eff@ monad,
76+ -- we actually want the normal @let@.
77+ --
78+ psciLet :: P.TokenParser Command
79+ psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> manyDecls))
80+ where
81+ manyDecls :: P.TokenParser [P.Declaration]
82+ manyDecls = C.mark (many1 (C.same *> P.parseDeclaration))
purescript.cabal+7−6
@@ -74,6 +74,7 @@ library
7474 Language.PureScript.Names
7575 Language.PureScript.Options
7676 Language.PureScript.Parser
77+ Language.PureScript.Parser.Lexer
7778 Language.PureScript.Parser.Common
7879 Language.PureScript.Parser.Declarations
7980 Language.PureScript.Parser.Kinds
@@ -112,7 +113,7 @@ library
112113 buildable: True
113114 hs-source-dirs: src
114115 other-modules: Paths_purescript
115− ghc-options: -Wall -O2
116+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2
116117
117118executable psc
118119 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
@@ -122,7 +123,7 @@ executable psc
122123 buildable: True
123124 hs-source-dirs: psc
124125 other-modules:
125− ghc-options: -Wall -O2 -fno-warn-unused-do-bind
126+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind
126127
127128executable psc-make
128129 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
@@ -132,7 +133,7 @@ executable psc-make
132133 buildable: True
133134 hs-source-dirs: psc-make
134135 other-modules:
135− ghc-options: -Wall -O2 -fno-warn-unused-do-bind
136+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind
136137
137138executable psci
138139 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
@@ -145,7 +146,7 @@ executable psci
145146 hs-source-dirs: psci
146147 other-modules: Commands
147148 Parser
148− ghc-options: -Wall -O2
149+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2
149150
150151executable psc-docs
151152 build-depends: base >=4 && <5, purescript -any, utf8-string -any,
@@ -154,7 +155,7 @@ executable psc-docs
154155 buildable: True
155156 hs-source-dirs: psc-docs
156157 other-modules:
157− ghc-options: -Wall -O2
158+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2
158159
159160executable hierarchy
160161 build-depends: base >=4 && <5, purescript -any, utf8-string -any, optparse-applicative >= 0.10.0,
@@ -163,7 +164,7 @@ executable hierarchy
163164 buildable: True
164165 hs-source-dirs: hierarchy
165166 other-modules:
166− ghc-options: -Wall -O2
167+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2
167168
168169test-suite tests
169170 build-depends: base >=4 && <5, containers -any, directory -any,
src/Language/PureScript.hs+1−1
@@ -219,7 +219,7 @@ make outputDir opts ms prefix = do
219219 rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do
220220 let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"
221221 externs <- readTextFile externsFile
222− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
222+ externsModules <- liftError . fmap (map snd) . either (Left . show) Right $ P.parseModulesFromFiles id [(externsFile, externs)]
223223 case externsModules of
224224 [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'
225225 _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"
src/Language/PureScript/Parser.hs+1
@@ -31,4 +31,5 @@ import Language.PureScript.Parser.Common as P
3131import Language.PureScript.Parser.Types as P
3232import Language.PureScript.Parser.State as P
3333import Language.PureScript.Parser.Kinds as P
34+import Language.PureScript.Parser.Lexer as P
3435import Language.PureScript.Parser.Declarations as P
src/Language/PureScript/Parser/Common.hs+26−280
@@ -17,299 +17,46 @@
1717
1818module Language.PureScript.Parser.Common where
1919
20−import Data.Functor.Identity
2120import Control.Applicative
22−import Control.Monad
23−import Language.PureScript.Parser.State
24−import qualified Text.Parsec as P
25−import qualified Text.Parsec.Token as PT
21+import Control.Monad (guard)
2622
23+import Language.PureScript.Parser.Lexer
24+import Language.PureScript.Parser.State
2725import Language.PureScript.Names
2826
29−-- |
30−-- A list of purescript reserved identifiers
31−--
32−reservedPsNames :: [String]
33−reservedPsNames = [ "data"
34− , "newtype"
35− , "type"
36− , "foreign"
37− , "import"
38− , "infixl"
39− , "infixr"
40− , "infix"
41− , "class"
42− , "instance"
43− , "module"
44− , "case"
45− , "of"
46− , "if"
47− , "then"
48− , "else"
49− , "do"
50− , "let"
51− , "true"
52− , "false"
53− , "in"
54− , "where"
55− ]
56−
57−-- |
58−-- The characters allowed for use in operators
59−--
60−opChars :: [Char]
61−opChars = ":!#$%&*+./<=>?@\\^|-~"
62−
63−-- |
64−-- A list of reserved identifiers for types
65−--
66−reservedTypeNames :: [String]
67−reservedTypeNames = [ "forall"
68− , "where" ]
69−
70−-- |
71−-- A list of reserved operators
72−--
73−reservedOpNames :: [String]
74−reservedOpNames = [ "=>", "->", "=", ".", "\\", "|" ]
75−
76−-- |
77−-- Valid first characters for an identifier
78−--
79−identStart :: P.Parsec String u Char
80−identStart = P.lower <|> P.oneOf "_"
81−
82−-- |
83−-- Valid identifier characters
84−--
85−identLetter :: P.Parsec String u Char
86−identLetter = P.alphaNum <|> P.oneOf "_'"
87−
88−-- |
89−-- Valid first characters for an operator
90−--
91−opStart :: P.Parsec String u Char
92−opStart = P.oneOf opChars
93−
94−-- |
95−-- Valid operators characters
96−--
97−opLetter :: P.Parsec String u Char
98−opLetter = P.oneOf opChars
99−
100−-- |
101−-- The PureScript language definition
102−--
103−langDef :: PT.GenLanguageDef String u Identity
104−langDef = PT.LanguageDef
105− { PT.reservedNames = reservedPsNames
106− , PT.reservedOpNames = reservedOpNames
107− , PT.commentStart = "{-"
108− , PT.commentEnd = "-}"
109− , PT.commentLine = "--"
110− , PT.nestedComments = True
111− , PT.identStart = identStart
112− , PT.identLetter = identLetter
113− , PT.opStart = opStart
114− , PT.opLetter = opLetter
115− , PT.caseSensitive = True
116− }
117−
118−-- |
119−-- A token parser based on the language definition
120−--
121−tokenParser :: PT.GenTokenParser String u Identity
122−tokenParser = PT.makeTokenParser langDef
123−
124−-- |
125−-- Parse a token
126−--
127−lexeme :: P.Parsec String u a -> P.Parsec String u a
128−lexeme = PT.lexeme tokenParser
129−
130−-- |
131−-- Parse an identifier
132−--
133−identifier :: P.Parsec String u String
134−identifier = PT.identifier tokenParser
135−
136−-- |
137−-- Parse an identifier in a more permissive position
138−--
139−identifierName :: P.Parsec String u String
140−identifierName = lexeme $ (:) <$> identStart <*> many identLetter
141−
142−-- |
143−-- Parse a reserved word
144−--
145−reserved :: String -> P.Parsec String u ()
146−reserved = PT.reserved tokenParser
147−
148−-- |
149−-- Parse a reserved operator
150−--
151−reservedOp :: String -> P.Parsec String u ()
152−reservedOp = PT.reservedOp tokenParser
153−
154−-- |
155−-- Parse an operator
156−--
157−operator :: P.Parsec String u String
158−operator = PT.operator tokenParser
159−
160−-- |
161−-- Parse a string literal
162−--
163−stringLiteral :: P.Parsec String u String
164−stringLiteral = lexeme blockString <|> PT.stringLiteral tokenParser
165− where delimeter = P.try (P.string "\"\"\"")
166− blockString = delimeter >> P.manyTill P.anyChar delimeter
167−
168−-- |
169−-- Parse whitespace
170−--
171−whiteSpace :: P.Parsec String u ()
172−whiteSpace = PT.whiteSpace tokenParser
173−
174−-- |
175−-- Semicolon
176−--
177−semi :: P.Parsec String u String
178−semi = PT.semi tokenParser
179−
180−-- |
181−-- Colon
182−--
183−colon :: P.Parsec String u String
184−colon = PT.colon tokenParser
185−
186−-- |
187−-- Period
188−--
189−dot :: P.Parsec String u String
190−dot = PT.dot tokenParser
191−
192−-- |
193−-- Comma
194−--
195−comma :: P.Parsec String u String
196−comma = PT.comma tokenParser
197−
198−-- |
199−-- Backtick
200−--
201−tick :: P.Parsec String u Char
202−tick = lexeme $ P.char '`'
203−
204−-- |
205−-- Pipe character
206−--
207−pipe :: P.Parsec String u Char
208−pipe = lexeme $ P.char '|'
209−
210−-- |
211−-- Natural number
212−--
213−natural :: P.Parsec String u Integer
214−natural = PT.natural tokenParser
27+import qualified Text.Parsec as P
21528
216−-- |
217−-- Parse a proper name
218−--
219−properName :: P.Parsec String u ProperName
220−properName = lexeme $ ProperName <$> P.try ((:) <$> P.upper <*> many P.alphaNum P.<?> "name")
29+properName :: TokenParser ProperName
30+properName = ProperName <$> uname
22131
22232-- |
22333-- Parse a module name
22434--
225−moduleName :: P.Parsec String ParseState ModuleName
226−moduleName = ModuleName <$> P.try (sepBy properName dot)
35+moduleName :: TokenParser ModuleName
36+moduleName = part []
37+ where
38+ part path = (do name <- ProperName <$> P.try qualifier
39+ part (path `snoc` name))
40+ <|> (ModuleName . snoc path <$> properName)
41+ snoc path name = path ++ [name]
22742
22843-- |
22944-- Parse a qualified name, i.e. M.name or just name
23045--
231−parseQualified :: P.Parsec String ParseState a -> P.Parsec String ParseState (Qualified a)
46+parseQualified :: TokenParser a -> TokenParser (Qualified a)
23247parseQualified parser = part []
23348 where
234− part path = (do name <- P.try (properName <* delimiter)
49+ part path = (do name <- ProperName <$> P.try qualifier
23550 part (updatePath path name))
23651 <|> (Qualified (qual path) <$> P.try parser)
237− delimiter = indented *> dot <* P.notFollowedBy dot
23852 updatePath path name = path ++ [name]
23953 qual path = if null path then Nothing else Just $ ModuleName path
24054
241−-- |
242−-- Parse an integer or floating point value
243−--
244−integerOrFloat :: P.Parsec String u (Either Integer Double)
245−integerOrFloat = (Right <$> P.try (PT.float tokenParser) <|>
246− Left <$> P.try (PT.natural tokenParser)) P.<?> "number"
247−
24855-- |
24956-- Parse an identifier or parenthesized operator
25057--
251−parseIdent :: P.Parsec String ParseState Ident
252−parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
253−
254−-- |
255−-- Parse a token inside square brackets
256−--
257−squares :: P.Parsec String ParseState a -> P.Parsec String ParseState a
258−squares = P.between (lexeme $ P.char '[') (lexeme $ indented *> P.char ']') . (indented *>)
259−
260−-- |
261−-- Parse a token inside parentheses
262−--
263−parens :: P.Parsec String ParseState a -> P.Parsec String ParseState a
264−parens = P.between (lexeme $ P.char '(') (lexeme $ indented *> P.char ')') . (indented *>)
265−
266−-- |
267−-- Parse a token inside braces
268−--
269−braces :: P.Parsec String ParseState a -> P.Parsec String ParseState a
270−braces = P.between (lexeme $ P.char '{') (lexeme $ indented *> P.char '}') . (indented *>)
271−
272−-- |
273−-- Parse a token inside angle brackets
274−--
275−angles :: P.Parsec String ParseState a -> P.Parsec String ParseState a
276−angles = P.between (lexeme $ P.char '<') (lexeme $ indented *> P.char '>') . (indented *>)
277−
278−-- |
279−-- Parse zero or more values separated by a separator token
280−--
281−sepBy :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]
282−sepBy p s = P.sepBy (indented *> p) (indented *> s)
283−
284−-- |
285−-- Parse one or more values separated by a separator token
286−--
287−sepBy1 :: P.Parsec String ParseState a -> P.Parsec String ParseState sep -> P.Parsec String ParseState [a]
288−sepBy1 p s = P.sepBy1 (indented *> p) (indented *> s)
289−
290−-- |
291−-- Parse zero or more values separated by semicolons
292−--
293−semiSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
294−semiSep = flip sepBy semi
295−
296−-- |
297−-- Parse one or more values separated by semicolons
298−--
299−semiSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
300−semiSep1 = flip sepBy1 semi
301−
302−-- |
303−-- Parse zero or more values separated by commas
304−--
305−commaSep :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
306−commaSep = flip sepBy comma
307−
308−-- |
309−-- Parse one or more values separated by commas
310−--
311−commaSep1 :: P.Parsec String ParseState a -> P.Parsec String ParseState [a]
312−commaSep1 = flip sepBy1 comma
58+parseIdent :: TokenParser Ident
59+parseIdent = (Ident <$> identifier) <|> (Op <$> parens symbol)
31360
31461-- |
31562-- Run the first parser, then match the second if possible, applying the specified function on a successful match
@@ -343,13 +90,13 @@ buildPostfixParser fs first = do
34390-- |
34491-- Parse an identifier in backticks or an operator
34592--
346−parseIdentInfix :: P.Parsec String ParseState (Qualified Ident)
347−parseIdentInfix = P.between tick tick (parseQualified (Ident <$> identifier)) <|> (parseQualified (Op <$> operator))
93+parseIdentInfix :: TokenParser (Qualified Ident)
94+parseIdentInfix = P.between tick tick (parseQualified (Ident <$> identifier)) <|> (parseQualified (Op <$> symbol))
34895
34996-- |
35097-- Mark the current indentation level
35198--
352−mark :: P.Parsec String ParseState a -> P.Parsec String ParseState a
99+mark :: P.Parsec s ParseState a -> P.Parsec s ParseState a
353100mark p = do
354101 current <- indentationLevel <$> P.getState
355102 pos <- P.sourceColumn <$> P.getPosition
@@ -361,7 +108,7 @@ mark p = do
361108-- |
362109-- Check that the current identation level matches a predicate
363110--
364−checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String ParseState ()
111+checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec s ParseState ()
365112checkIndentation rel = do
366113 col <- P.sourceColumn <$> P.getPosition
367114 current <- indentationLevel <$> P.getState
@@ -370,18 +117,17 @@ checkIndentation rel = do
370117-- |
371118-- Check that the current indentation level is past the current mark
372119--
373−indented :: P.Parsec String ParseState ()
120+indented :: P.Parsec s ParseState ()
374121indented = checkIndentation (>) P.<?> "indentation"
375122
376123-- |
377124-- Check that the current indentation level is at the same indentation as the current mark
378125--
379−same :: P.Parsec String ParseState ()
126+same :: P.Parsec s ParseState ()
380127same = checkIndentation (==) P.<?> "no indentation"
381128
382129-- |
383−-- Run a parser which supports indentation
130+-- Run a parser
384131--
385−runIndentParser :: FilePath -> P.Parsec String ParseState a -> String -> Either P.ParseError a
386−runIndentParser filePath p = P.runParser p (ParseState 0) filePath
387−
132+runTokenParser :: FilePath -> TokenParser a -> [PositionedToken] -> Either P.ParseError a
133+runTokenParser filePath p = P.runParser p (ParseState 0) filePath
src/Language/PureScript/Parser/Declarations.hs+127−123
@@ -26,6 +26,8 @@ module Language.PureScript.Parser.Declarations (
2626 parseBinderNoParens,
2727) where
2828
29+import Prelude hiding (lex)
30+
2931import Data.Maybe (isJust, fromMaybe)
3032import Data.Traversable (forM)
3133
@@ -33,11 +35,11 @@ import Control.Applicative
3335import Control.Arrow ((+++))
3436
3537import Language.PureScript.Kinds
36−import Language.PureScript.Parser.State
3738import Language.PureScript.Parser.Common
3839import Language.PureScript.AST
3940import Language.PureScript.Parser.Types
4041import Language.PureScript.Parser.Kinds
42+import Language.PureScript.Parser.Lexer
4143import Language.PureScript.CodeGen.JS.AST
4244import Language.PureScript.Environment
4345
@@ -58,43 +60,43 @@ withSourceSpan f p = do
5860 where
5961 toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)
6062
61−kindedIdent :: P.Parsec String ParseState (String, Maybe Kind)
63+kindedIdent :: TokenParser (String, Maybe Kind)
6264kindedIdent = (, Nothing) <$> identifier
63− <|> parens ((,) <$> identifier <*> (Just <$> (indented *> lexeme (P.string "::") *> indented *> parseKind)))
65+ <|> parens ((,) <$> identifier <*> (Just <$> (indented *> doubleColon *> indented *> parseKind)))
6466
65−parseDataDeclaration :: P.Parsec String ParseState Declaration
67+parseDataDeclaration :: TokenParser Declaration
6668parseDataDeclaration = do
6769 dtype <- (reserved "data" *> return Data) <|> (reserved "newtype" *> return Newtype)
6870 name <- indented *> properName
6971 tyArgs <- many (indented *> kindedIdent)
7072 ctors <- P.option [] $ do
71− _ <- lexeme $ indented *> P.char '='
72− sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe
73+ indented *> equals
74+ P.sepBy1 ((,) <$> properName <*> P.many (indented *> noWildcards parseTypeAtom)) pipe
7375 return $ DataDeclaration dtype name tyArgs ctors
7476
75−parseTypeDeclaration :: P.Parsec String ParseState Declaration
77+parseTypeDeclaration :: TokenParser Declaration
7678parseTypeDeclaration =
77− TypeDeclaration <$> P.try (parseIdent <* lexeme (indented *> P.string "::"))
79+ TypeDeclaration <$> P.try (parseIdent <* indented <* doubleColon)
7880 <*> parsePolyType
7981
80−parseTypeSynonymDeclaration :: P.Parsec String ParseState Declaration
82+parseTypeSynonymDeclaration :: TokenParser Declaration
8183parseTypeSynonymDeclaration =
8284 TypeSynonymDeclaration <$> (P.try (reserved "type") *> indented *> properName)
8385 <*> many (indented *> kindedIdent)
84− <*> (lexeme (indented *> P.char '=') *> noWildcards parsePolyType)
86+ <*> (indented *> equals *> noWildcards parsePolyType)
8587
86−parseValueDeclaration :: P.Parsec String ParseState Declaration
88+parseValueDeclaration :: TokenParser Declaration
8789parseValueDeclaration = do
8890 name <- parseIdent
8991 binders <- P.many parseBinderNoParens
9092 value <- Left <$> (C.indented *>
9193 P.many1 ((,) <$> parseGuard
92− <*> (lexeme (indented *> P.char '=') *> parseValueWithWhereClause)
94+ <*> (indented *> equals *> parseValueWithWhereClause)
9395 ))
94− <|> Right <$> (lexeme (indented *> P.char '=') *> parseValueWithWhereClause)
96+ <|> Right <$> (indented *> equals *> parseValueWithWhereClause)
9597 return $ ValueDeclaration name Value binders value
9698 where
97− parseValueWithWhereClause :: P.Parsec String ParseState Expr
99+ parseValueWithWhereClause :: TokenParser Expr
98100 parseValueWithWhereClause = do
99101 value <- parseValue
100102 whereClause <- P.optionMaybe $ do
@@ -104,42 +106,42 @@ parseValueDeclaration = do
104106 C.mark $ P.many1 (C.same *> parseLocalDeclaration)
105107 return $ maybe value (`Let` value) whereClause
106108
107−parseExternDeclaration :: P.Parsec String ParseState Declaration
109+parseExternDeclaration :: TokenParser Declaration
108110parseExternDeclaration = P.try (reserved "foreign") *> indented *> reserved "import" *> indented *>
109111 (ExternDataDeclaration <$> (P.try (reserved "data") *> indented *> properName)
110− <*> (lexeme (indented *> P.string "::") *> parseKind)
112+ <*> (indented *> doubleColon *> parseKind)
111113 <|> (do reserved "instance"
112− name <- parseIdent <* lexeme (indented *> P.string "::")
114+ name <- parseIdent <* indented <* doubleColon
113115 deps <- P.option [] $ do
114116 deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
115117 indented
116− reservedOp "=>"
118+ rfatArrow
117119 return deps
118120 className <- indented *> parseQualified properName
119121 tys <- P.many (indented *> noWildcards parseTypeAtom)
120122 return $ ExternInstanceDeclaration name deps className tys)
121123 <|> (do ident <- parseIdent
122124 js <- P.optionMaybe (JSRaw <$> stringLiteral)
123− ty <- lexeme (indented *> P.string "::") *> noWildcards parsePolyType
125+ ty <- indented *> doubleColon *> noWildcards parsePolyType
124126 return $ ExternDeclaration (if isJust js then InlineJavascript else ForeignImport) ident js ty))
125127
126−parseAssociativity :: P.Parsec String ParseState Associativity
128+parseAssociativity :: TokenParser Associativity
127129parseAssociativity =
128130 (P.try (reserved "infixl") >> return Infixl) <|>
129131 (P.try (reserved "infixr") >> return Infixr) <|>
130132 (P.try (reserved "infix") >> return Infix)
131133
132−parseFixity :: P.Parsec String ParseState Fixity
134+parseFixity :: TokenParser Fixity
133135parseFixity = Fixity <$> parseAssociativity <*> (indented *> natural)
134136
135−parseFixityDeclaration :: P.Parsec String ParseState Declaration
137+parseFixityDeclaration :: TokenParser Declaration
136138parseFixityDeclaration = do
137139 fixity <- parseFixity
138140 indented
139− name <- operator
141+ name <- symbol
140142 return $ FixityDeclaration fixity name
141143
142−parseImportDeclaration :: P.Parsec String ParseState Declaration
144+parseImportDeclaration :: TokenParser Declaration
143145parseImportDeclaration = do
144146 reserved "import"
145147 indented
@@ -169,20 +171,20 @@ parseImportDeclaration = do
169171 return $ fromMaybe Unqualified (expectedType <$> idents)
170172
171173
172−parseDeclarationRef :: P.Parsec String ParseState DeclarationRef
174+parseDeclarationRef :: TokenParser DeclarationRef
173175parseDeclarationRef = withSourceSpan PositionedDeclarationRef $
174176 ValueRef <$> parseIdent
175177 <|> do name <- properName
176− dctors <- P.optionMaybe $ parens (lexeme (P.string "..") *> pure Nothing <|> Just <$> commaSep properName)
178+ dctors <- P.optionMaybe $ parens (symbol' ".." *> pure Nothing <|> Just <$> commaSep properName)
177179 return $ maybe (TypeClassRef name) (TypeRef name) dctors
178180
179−parseTypeClassDeclaration :: P.Parsec String ParseState Declaration
181+parseTypeClassDeclaration :: TokenParser Declaration
180182parseTypeClassDeclaration = do
181183 reserved "class"
182184 implies <- P.option [] $ do
183185 indented
184186 implies <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
185− reservedOp "<="
187+ lfatArrow
186188 return implies
187189 className <- indented *> properName
188190 idents <- P.many (indented *> kindedIdent)
@@ -191,14 +193,14 @@ parseTypeClassDeclaration = do
191193 mark (P.many (same *> positioned parseTypeDeclaration))
192194 return $ TypeClassDeclaration className idents implies members
193195
194−parseTypeInstanceDeclaration :: P.Parsec String ParseState Declaration
196+parseTypeInstanceDeclaration :: TokenParser Declaration
195197parseTypeInstanceDeclaration = do
196198 reserved "instance"
197− name <- parseIdent <* lexeme (indented *> P.string "::")
199+ name <- parseIdent <* indented <* doubleColon
198200 deps <- P.optionMaybe $ do
199201 deps <- parens (commaSep1 ((,) <$> parseQualified properName <*> P.many (noWildcards parseTypeAtom)))
200202 indented
201− reservedOp "=>"
203+ rfatArrow
202204 return deps
203205 className <- indented *> parseQualified properName
204206 ty <- P.many (indented *> (noWildcards parseTypeAtom))
@@ -207,13 +209,13 @@ parseTypeInstanceDeclaration = do
207209 mark (P.many (same *> positioned parseValueDeclaration))
208210 return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members
209211
210−positioned :: P.Parsec String ParseState Declaration -> P.Parsec String ParseState Declaration
212+positioned :: TokenParser Declaration -> TokenParser Declaration
211213positioned d = withSourceSpan PositionedDeclaration d
212214
213215-- |
214216-- Parse a single declaration
215217--
216−parseDeclaration :: P.Parsec String ParseState Declaration
218+parseDeclaration :: TokenParser Declaration
217219parseDeclaration = positioned (P.choice
218220 [ parseDataDeclaration
219221 , parseTypeDeclaration
@@ -226,7 +228,7 @@ parseDeclaration = positioned (P.choice
226228 , parseTypeInstanceDeclaration
227229 ]) P.<?> "declaration"
228230
229−parseLocalDeclaration :: P.Parsec String ParseState Declaration
231+parseLocalDeclaration :: TokenParser Declaration
230232parseLocalDeclaration = positioned (P.choice
231233 [ parseTypeDeclaration
232234 , parseValueDeclaration
@@ -235,13 +237,13 @@ parseLocalDeclaration = positioned (P.choice
235237-- |
236238-- Parse a module header and a collection of declarations
237239--
238−parseModule :: P.Parsec String ParseState Module
240+parseModule :: TokenParser Module
239241parseModule = do
240242 reserved "module"
241243 indented
242244 name <- moduleName
243245 exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef
244− _ <- lexeme $ P.string "where"
246+ reserved "where"
245247 decls <- mark (P.many (same *> parseDeclaration))
246248 return $ Module name decls exports
247249
@@ -250,9 +252,11 @@ parseModule = do
250252--
251253parseModulesFromFiles :: (k -> String) -> [(k, String)] -> Either P.ParseError [(k, Module)]
252254parseModulesFromFiles toFilePath input =
253− fmap collect . forM input $ \(filename, content) -> do
254− ms <- runIndentParser (toFilePath filename) parseModules content
255− return (filename, ms)
255+ fmap collect . forM input $ \(k, content) -> do
256+ let filename = toFilePath k
257+ ts <- lex filename content
258+ ms <- runTokenParser filename parseModules ts
259+ return (k, ms)
256260 where
257261 collect :: [(k, [v])] -> [(k, v)]
258262 collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]
@@ -260,77 +264,77 @@ parseModulesFromFiles toFilePath input =
260264-- |
261265-- Parse a collection of modules
262266--
263−parseModules :: P.Parsec String ParseState [Module]
264−parseModules = whiteSpace *> mark (P.many (same *> parseModule)) <* P.eof
267+parseModules :: TokenParser [Module]
268+parseModules = mark (P.many (same *> parseModule)) <* P.eof
265269
266−booleanLiteral :: P.Parsec String ParseState Bool
267−booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
270+booleanLiteral :: TokenParser Bool
271+booleanLiteral = (reserved "true" >> return True) P.<|> (reserved "false" >> return False)
268272
269−parseNumericLiteral :: P.Parsec String ParseState Expr
270−parseNumericLiteral = NumericLiteral <$> C.integerOrFloat
273+parseNumericLiteral :: TokenParser Expr
274+parseNumericLiteral = NumericLiteral <$> number
271275
272−parseStringLiteral :: P.Parsec String ParseState Expr
273−parseStringLiteral = StringLiteral <$> C.stringLiteral
276+parseStringLiteral :: TokenParser Expr
277+parseStringLiteral = StringLiteral <$> stringLiteral
274278
275−parseBooleanLiteral :: P.Parsec String ParseState Expr
279+parseBooleanLiteral :: TokenParser Expr
276280parseBooleanLiteral = BooleanLiteral <$> booleanLiteral
277281
278−parseArrayLiteral :: P.Parsec String ParseState Expr
279−parseArrayLiteral = ArrayLiteral <$> C.squares (C.commaSep parseValue)
282+parseArrayLiteral :: TokenParser Expr
283+parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)
280284
281−parseObjectLiteral :: P.Parsec String ParseState Expr
282−parseObjectLiteral = ObjectLiteral <$> C.braces (C.commaSep parseIdentifierAndValue)
285+parseObjectLiteral :: TokenParser Expr
286+parseObjectLiteral = ObjectLiteral <$> braces (commaSep parseIdentifierAndValue)
283287
284−parseIdentifierAndValue :: P.Parsec String ParseState (String, Expr)
285−parseIdentifierAndValue = (,) <$> (C.indented *> (C.identifierName <|> C.stringLiteral) <* C.indented <* C.colon)
288+parseIdentifierAndValue :: TokenParser (String, Expr)
289+parseIdentifierAndValue = (,) <$> (C.indented *> (lname <|> stringLiteral) <* C.indented <* colon)
286290 <*> (C.indented *> parseValue)
287291
288−parseAbs :: P.Parsec String ParseState Expr
292+parseAbs :: TokenParser Expr
289293parseAbs = do
290− C.reservedOp "\\"
294+ symbol' "\\"
291295 args <- P.many1 (C.indented *> (Abs <$> (Left <$> P.try C.parseIdent <|> Right <$> parseBinderNoParens)))
292− C.indented *> C.reservedOp "->"
296+ C.indented *> rarrow
293297 value <- parseValue
294298 return $ toFunction args value
295299 where
296300 toFunction :: [Expr -> Expr] -> Expr -> Expr
297301 toFunction args value = foldr ($) value args
298302
299−parseVar :: P.Parsec String ParseState Expr
303+parseVar :: TokenParser Expr
300304parseVar = Var <$> C.parseQualified C.parseIdent
301305
302−parseConstructor :: P.Parsec String ParseState Expr
306+parseConstructor :: TokenParser Expr
303307parseConstructor = Constructor <$> C.parseQualified C.properName
304308
305−parseCase :: P.Parsec String ParseState Expr
306−parseCase = Case <$> P.between (P.try (C.reserved "case")) (C.indented *> C.reserved "of") (return <$> parseValue)
309+parseCase :: TokenParser Expr
310+parseCase = Case <$> P.between (P.try (reserved "case")) (C.indented *> reserved "of") (return <$> parseValue)
307311 <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))
308312
309−parseCaseAlternative :: P.Parsec String ParseState CaseAlternative
313+parseCaseAlternative :: TokenParser CaseAlternative
310314parseCaseAlternative = CaseAlternative <$> (return <$> parseBinder)
311315 <*> (Left <$> (C.indented *>
312316 P.many1 ((,) <$> parseGuard
313− <*> (lexeme (indented *> C.reservedOp "->") *> parseValue)
317+ <*> (indented *> rarrow *> parseValue)
314318 ))
315− <|> Right <$> (lexeme (indented *> C.reservedOp "->") *> parseValue))
319+ <|> Right <$> (indented *> rarrow *> parseValue))
316320 P.<?> "case alternative"
317321
318−parseIfThenElse :: P.Parsec String ParseState Expr
319−parseIfThenElse = IfThenElse <$> (P.try (C.reserved "if") *> C.indented *> parseValue)
320− <*> (C.indented *> C.reserved "then" *> C.indented *> parseValue)
321− <*> (C.indented *> C.reserved "else" *> C.indented *> parseValue)
322+parseIfThenElse :: TokenParser Expr
323+parseIfThenElse = IfThenElse <$> (P.try (reserved "if") *> C.indented *> parseValue)
324+ <*> (C.indented *> reserved "then" *> C.indented *> parseValue)
325+ <*> (C.indented *> reserved "else" *> C.indented *> parseValue)
322326
323−parseLet :: P.Parsec String ParseState Expr
327+parseLet :: TokenParser Expr
324328parseLet = do
325− C.reserved "let"
329+ reserved "let"
326330 C.indented
327331 ds <- C.mark $ P.many1 (C.same *> parseLocalDeclaration)
328332 C.indented
329− C.reserved "in"
333+ reserved "in"
330334 result <- parseValue
331335 return $ Let ds result
332336
333−parseValueAtom :: P.Parsec String ParseState Expr
337+parseValueAtom :: TokenParser Expr
334338parseValueAtom = P.choice
335339 [ P.try parseNumericLiteral
336340 , P.try parseStringLiteral
@@ -344,32 +348,32 @@ parseValueAtom = P.choice
344348 , parseIfThenElse
345349 , parseDo
346350 , parseLet
347− , Parens <$> C.parens parseValue ]
351+ , Parens <$> parens parseValue ]
348352
349−parsePropertyUpdate :: P.Parsec String ParseState (String, Expr)
353+parsePropertyUpdate :: TokenParser (String, Expr)
350354parsePropertyUpdate = do
351− name <- C.lexeme (C.identifierName <|> C.stringLiteral)
352− _ <- C.lexeme $ C.indented *> P.char '='
355+ name <- lname <|> stringLiteral
356+ _ <- C.indented *> equals
353357 value <- C.indented *> parseValue
354358 return (name, value)
355359
356−parseAccessor :: Expr -> P.Parsec String ParseState Expr
360+parseAccessor :: Expr -> TokenParser Expr
357361parseAccessor (Constructor _) = P.unexpected "constructor"
358−parseAccessor obj = P.try $ Accessor <$> (C.indented *> C.dot *> P.notFollowedBy C.opLetter *> C.indented *> (C.identifierName <|> C.stringLiteral)) <*> pure obj
362+parseAccessor obj = P.try $ Accessor <$> (C.indented *> dot *> C.indented *> (lname <|> stringLiteral)) <*> pure obj
359363
360−parseDo :: P.Parsec String ParseState Expr
364+parseDo :: TokenParser Expr
361365parseDo = do
362− C.reserved "do"
366+ reserved "do"
363367 C.indented
364368 Do <$> C.mark (P.many (C.same *> C.mark parseDoNotationElement))
365369
366−parseDoNotationLet :: P.Parsec String ParseState DoNotationElement
367−parseDoNotationLet = DoNotationLet <$> (C.reserved "let" *> C.indented *> C.mark (P.many1 (C.same *> parseLocalDeclaration)))
370+parseDoNotationLet :: TokenParser DoNotationElement
371+parseDoNotationLet = DoNotationLet <$> (reserved "let" *> C.indented *> C.mark (P.many1 (C.same *> parseLocalDeclaration)))
368372
369−parseDoNotationBind :: P.Parsec String ParseState DoNotationElement
370−parseDoNotationBind = DoNotationBind <$> parseBinder <*> (C.indented *> C.reservedOp "<-" *> parseValue)
373+parseDoNotationBind :: TokenParser DoNotationElement
374+parseDoNotationBind = DoNotationBind <$> parseBinder <*> (C.indented *> larrow *> parseValue)
371375
372−parseDoNotationElement :: P.Parsec String ParseState DoNotationElement
376+parseDoNotationElement :: TokenParser DoNotationElement
373377parseDoNotationElement = P.choice
374378 [ P.try parseDoNotationBind
375379 , parseDoNotationLet
@@ -378,7 +382,7 @@ parseDoNotationElement = P.choice
378382-- |
379383-- Parse a value
380384--
381−parseValue :: P.Parsec String ParseState Expr
385+parseValue :: TokenParser Expr
382386parseValue = withSourceSpan PositionedValue
383387 (P.buildExpressionParser operators
384388 . C.buildPostfixParser postfixTable2
@@ -386,68 +390,68 @@ parseValue = withSourceSpan PositionedValue
386390 where
387391 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom
388392 postfixTable1 = [ parseAccessor
389− , \v -> P.try $ flip ObjectUpdate <$> (C.indented *> C.braces (C.commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]
393+ , \v -> P.try $ flip ObjectUpdate <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]
390394 postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v
391− , \v -> flip (TypedValue True) <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) <*> pure v
395+ , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v
392396 ]
393− operators = [ [ P.Prefix (C.lexeme (P.try (C.indented *> P.char '-') >> return UnaryMinus))
397+ operators = [ [ P.Prefix (P.try (C.indented *> symbol' "-") >> return UnaryMinus)
394398 ]
395− , [ P.Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->
396− return (BinaryNoParens ident))) P.AssocRight
399+ , [ P.Infix (P.try (C.indented *> C.parseIdentInfix P.<?> "operator") >>= \ident ->
400+ return (BinaryNoParens ident)) P.AssocRight
397401 ]
398402 ]
399403
400−parseStringBinder :: P.Parsec String ParseState Binder
401−parseStringBinder = StringBinder <$> C.stringLiteral
404+parseStringBinder :: TokenParser Binder
405+parseStringBinder = StringBinder <$> stringLiteral
402406
403−parseBooleanBinder :: P.Parsec String ParseState Binder
407+parseBooleanBinder :: TokenParser Binder
404408parseBooleanBinder = BooleanBinder <$> booleanLiteral
405409
406−parseNumberBinder :: P.Parsec String ParseState Binder
407−parseNumberBinder = NumberBinder <$> (C.lexeme sign <*> C.integerOrFloat)
410+parseNumberBinder :: TokenParser Binder
411+parseNumberBinder = NumberBinder <$> (sign <*> number)
408412 where
409− sign :: P.Parsec String ParseState (Either Integer Double -> Either Integer Double)
410− sign = (P.char '-' >> return (negate +++ negate))
411− <|> (P.char '+' >> return id)
413+ sign :: TokenParser (Either Integer Double -> Either Integer Double)
414+ sign = (symbol' "-" >> return (negate +++ negate))
415+ <|> (symbol' "+" >> return id)
412416 <|> return id
413417
414−parseVarBinder :: P.Parsec String ParseState Binder
418+parseVarBinder :: TokenParser Binder
415419parseVarBinder = VarBinder <$> C.parseIdent
416420
417−parseNullaryConstructorBinder :: P.Parsec String ParseState Binder
418−parseNullaryConstructorBinder = ConstructorBinder <$> C.lexeme (C.parseQualified C.properName) <*> pure []
421+parseNullaryConstructorBinder :: TokenParser Binder
422+parseNullaryConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> pure []
419423
420−parseConstructorBinder :: P.Parsec String ParseState Binder
421−parseConstructorBinder = ConstructorBinder <$> C.lexeme (C.parseQualified C.properName) <*> many (C.indented *> parseBinderNoParens)
424+parseConstructorBinder :: TokenParser Binder
425+parseConstructorBinder = ConstructorBinder <$> C.parseQualified C.properName <*> many (C.indented *> parseBinderNoParens)
422426
423−parseObjectBinder :: P.Parsec String ParseState Binder
424−parseObjectBinder = ObjectBinder <$> C.braces (C.commaSep (C.indented *> parseIdentifierAndBinder))
427+parseObjectBinder :: TokenParser Binder
428+parseObjectBinder = ObjectBinder <$> braces (commaSep (C.indented *> parseIdentifierAndBinder))
425429
426−parseArrayBinder :: P.Parsec String ParseState Binder
427−parseArrayBinder = C.squares $ ArrayBinder <$> C.commaSep (C.indented *> parseBinder)
430+parseArrayBinder :: TokenParser Binder
431+parseArrayBinder = squares $ ArrayBinder <$> commaSep (C.indented *> parseBinder)
428432
429−parseNamedBinder :: P.Parsec String ParseState Binder
430−parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* C.lexeme (P.char '@'))
433+parseNamedBinder :: TokenParser Binder
434+parseNamedBinder = NamedBinder <$> (C.parseIdent <* C.indented <* at)
431435 <*> (C.indented *> parseBinder)
432436
433−parseNullBinder :: P.Parsec String ParseState Binder
434−parseNullBinder = C.lexeme (P.char '_' *> P.notFollowedBy C.identLetter) *> return NullBinder
437+parseNullBinder :: TokenParser Binder
438+parseNullBinder = reserved "_" *> return NullBinder
435439
436−parseIdentifierAndBinder :: P.Parsec String ParseState (String, Binder)
440+parseIdentifierAndBinder :: TokenParser (String, Binder)
437441parseIdentifierAndBinder = do
438− name <- C.lexeme (C.identifierName <|> C.stringLiteral)
439− _ <- C.lexeme $ C.indented *> (P.char '=' <|> P.char ':')
442+ name <- lname <|> stringLiteral
443+ C.indented *> (equals <|> colon)
440444 binder <- C.indented *> parseBinder
441445 return (name, binder)
442446
443447-- |
444448-- Parse a binder
445449--
446−parseBinder :: P.Parsec String ParseState Binder
450+parseBinder :: TokenParser Binder
447451parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators parseBinderAtom P.<?> "expression")
448452 where
449− operators = [ [ P.Infix ( C.lexeme (P.try $ C.indented *> C.reservedOp ":") >> return ConsBinder) P.AssocRight ] ]
450− parseBinderAtom :: P.Parsec String ParseState Binder
453+ operators = [ [ P.Infix (P.try $ C.indented *> colon *> return ConsBinder) P.AssocRight ] ]
454+ parseBinderAtom :: TokenParser Binder
451455 parseBinderAtom = P.choice (map P.try
452456 [ parseNullBinder
453457 , parseStringBinder
@@ -458,12 +462,12 @@ parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators
458462 , parseConstructorBinder
459463 , parseObjectBinder
460464 , parseArrayBinder
461− , C.parens parseBinder ]) P.<?> "binder"
465+ , parens parseBinder ]) P.<?> "binder"
462466
463467-- |
464468-- Parse a binder as it would appear in a top level declaration
465469--
466−parseBinderNoParens :: P.Parsec String ParseState Binder
470+parseBinderNoParens :: TokenParser Binder
467471parseBinderNoParens = P.choice (map P.try
468472 [ parseNullBinder
469473 , parseStringBinder
@@ -474,11 +478,11 @@ parseBinderNoParens = P.choice (map P.try
474478 , parseNullaryConstructorBinder
475479 , parseObjectBinder
476480 , parseArrayBinder
477− , C.parens parseBinder ]) P.<?> "binder"
481+ , parens parseBinder ]) P.<?> "binder"
478482-- |
479483-- Parse a guard
480484--
481−parseGuard :: P.Parsec String ParseState Guard
482−parseGuard = C.pipe *> C.indented *> parseValue
485+parseGuard :: TokenParser Guard
486+parseGuard = pipe *> C.indented *> parseValue
483487
484488
src/Language/PureScript/Parser/Kinds.hs+9−9
@@ -18,19 +18,19 @@ module Language.PureScript.Parser.Kinds (
1818) where
1919
2020import Language.PureScript.Kinds
21−import Language.PureScript.Parser.State
2221import Language.PureScript.Parser.Common
22+import Language.PureScript.Parser.Lexer
2323import Control.Applicative
2424import qualified Text.Parsec as P
2525import qualified Text.Parsec.Expr as P
2626
27−parseStar :: P.Parsec String ParseState Kind
28−parseStar = const Star <$> lexeme (P.char '*')
27+parseStar :: TokenParser Kind
28+parseStar = const Star <$> symbol' "*"
2929
30−parseBang :: P.Parsec String ParseState Kind
31−parseBang = const Bang <$> lexeme (P.char '!')
30+parseBang :: TokenParser Kind
31+parseBang = const Bang <$> symbol' "!"
3232
33−parseTypeAtom :: P.Parsec String ParseState Kind
33+parseTypeAtom :: TokenParser Kind
3434parseTypeAtom = indented *> P.choice (map P.try
3535 [ parseStar
3636 , parseBang
@@ -38,8 +38,8 @@ parseTypeAtom = indented *> P.choice (map P.try
3838-- |
3939-- Parse a kind
4040--
41−parseKind :: P.Parsec String ParseState Kind
41+parseKind :: TokenParser Kind
4242parseKind = P.buildExpressionParser operators parseTypeAtom P.<?> "kind"
4343 where
44− operators = [ [ P.Prefix (lexeme (P.char '#') >> return Row) ]
45− , [ P.Infix (lexeme (P.try (P.string "->")) >> return FunKind) P.AssocRight ] ]
44+ operators = [ [ P.Prefix (symbol' "#" >> return Row) ]
45+ , [ P.Infix ((P.try rarrow) >> return FunKind) P.AssocRight ] ]
src/Language/PureScript/Parser/Lexer.hsnew file+476
@@ -0,0 +1,476 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Parser.Lexer
4+-- Copyright : (c) Phil Freeman 2014
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- The first step in the parsing process - turns source code into a list of lexemes
13+--
14+-----------------------------------------------------------------------------
15+
16+{-# LANGUAGE TupleSections #-}
17+
18+module Language.PureScript.Parser.Lexer
19+ ( PositionedToken(..)
20+ , Token()
21+ , TokenParser()
22+ , lex
23+ , token
24+ , match
25+ , lparen
26+ , rparen
27+ , parens
28+ , lbrace
29+ , rbrace
30+ , braces
31+ , lsquare
32+ , rsquare
33+ , squares
34+ , indent
35+ , indentAt
36+ , larrow
37+ , rarrow
38+ , lfatArrow
39+ , rfatArrow
40+ , colon
41+ , doubleColon
42+ , equals
43+ , pipe
44+ , tick
45+ , dot
46+ , comma
47+ , semi
48+ , at
49+ , semiSep
50+ , semiSep1
51+ , commaSep
52+ , commaSep1
53+ , lname
54+ , qualifier
55+ , uname
56+ , uname'
57+ , reserved
58+ , symbol
59+ , symbol'
60+ , identifier
61+ , stringLiteral
62+ , number
63+ , natural
64+ , reservedPsNames
65+ , reservedTypeNames
66+ , opChars
67+ )
68+ where
69+
70+import Prelude hiding (lex)
71+
72+import Data.Functor (void)
73+import Data.Functor.Identity
74+
75+import Control.Applicative
76+
77+import Language.PureScript.Parser.State
78+
79+import qualified Text.Parsec as P
80+import qualified Text.Parsec.Token as PT
81+
82+data Comment
83+ = LineComment String
84+ | BlockComment String
85+ deriving (Show, Eq, Ord)
86+
87+data Token
88+ = LParen
89+ | RParen
90+ | LBrace
91+ | RBrace
92+ | LSquare
93+ | RSquare
94+ | Indent Int
95+ | LArrow
96+ | RArrow
97+ | LFatArrow
98+ | RFatArrow
99+ | Colon
100+ | DoubleColon
101+ | Equals
102+ | Pipe
103+ | Tick
104+ | Dot
105+ | Comma
106+ | Semi
107+ | At
108+ | LName String
109+ | UName String
110+ | Qualifier String
111+ | Symbol String
112+ | StringLiteral String
113+ | Number (Either Integer Double)
114+ deriving (Show, Eq, Ord)
115+
116+prettyPrintToken :: Token -> String
117+prettyPrintToken LParen = "("
118+prettyPrintToken RParen = ")"
119+prettyPrintToken LBrace = "{"
120+prettyPrintToken RBrace = "}"
121+prettyPrintToken LSquare = "["
122+prettyPrintToken RSquare = "]"
123+prettyPrintToken LArrow = "<-"
124+prettyPrintToken RArrow = "->"
125+prettyPrintToken LFatArrow = "<="
126+prettyPrintToken RFatArrow = "=>"
127+prettyPrintToken Colon = ":"
128+prettyPrintToken DoubleColon = "::"
129+prettyPrintToken Equals = "="
130+prettyPrintToken Pipe = "|"
131+prettyPrintToken Tick = "`"
132+prettyPrintToken Dot = "."
133+prettyPrintToken Comma = ","
134+prettyPrintToken Semi = ";"
135+prettyPrintToken At = "@"
136+prettyPrintToken (Indent n) = "indentation at level " ++ show n
137+prettyPrintToken (LName s) = show s
138+prettyPrintToken (UName s) = show s
139+prettyPrintToken (Qualifier _) = "qualifier"
140+prettyPrintToken (Symbol s) = s
141+prettyPrintToken (StringLiteral s) = show s
142+prettyPrintToken (Number n) = either show show n
143+
144+data PositionedToken = PositionedToken
145+ { ptSourcePos :: P.SourcePos
146+ , ptToken :: Token
147+ , ptComments :: [Comment]
148+ } deriving (Eq)
149+
150+instance Show PositionedToken where
151+ show = show . ptToken
152+
153+lex :: FilePath -> String -> Either P.ParseError [PositionedToken]
154+lex filePath input = P.parse parseTokens filePath input
155+
156+parseTokens :: P.Parsec String u [PositionedToken]
157+parseTokens = whitespace *> P.many parsePositionedToken <* P.skipMany parseComment <* P.eof
158+
159+whitespace :: P.Parsec String u ()
160+whitespace = P.skipMany (P.oneOf " \t\r\n")
161+
162+parseComment :: P.Parsec String u Comment
163+parseComment = (BlockComment <$> blockComment <|> LineComment <$> lineComment) <* whitespace
164+ where
165+ blockComment :: P.Parsec String u String
166+ blockComment = P.try $ P.string "{-" *> P.manyTill P.anyChar (P.try (P.string "-}"))
167+
168+ lineComment :: P.Parsec String u String
169+ lineComment = P.try $ P.string "--" *> P.manyTill P.anyChar (P.try (void (P.char '\n') <|> P.eof))
170+
171+parsePositionedToken :: P.Parsec String u PositionedToken
172+parsePositionedToken = P.try $ do
173+ comments <- P.many parseComment
174+ pos <- P.getPosition
175+ tok <- parseToken
176+ return $ PositionedToken pos tok comments
177+
178+parseToken :: P.Parsec String u Token
179+parseToken = P.choice
180+ [ P.try $ P.string "<-" *> P.notFollowedBy symbolChar *> pure LArrow
181+ , P.try $ P.string "<=" *> P.notFollowedBy symbolChar *> pure LFatArrow
182+ , P.try $ P.string "->" *> P.notFollowedBy symbolChar *> pure RArrow
183+ , P.try $ P.string "=>" *> P.notFollowedBy symbolChar *> pure RFatArrow
184+ , P.try $ P.string "::" *> P.notFollowedBy symbolChar *> pure DoubleColon
185+ , P.try $ P.char '(' *> pure LParen
186+ , P.try $ P.char ')' *> pure RParen
187+ , P.try $ P.char '{' *> pure LBrace
188+ , P.try $ P.char '}' *> pure RBrace
189+ , P.try $ P.char '[' *> pure LSquare
190+ , P.try $ P.char ']' *> pure RSquare
191+ , P.try $ P.char '`' *> pure Tick
192+ , P.try $ P.char ',' *> pure Comma
193+ , P.try $ P.char '=' *> P.notFollowedBy symbolChar *> pure Equals
194+ , P.try $ P.char ':' *> P.notFollowedBy symbolChar *> pure Colon
195+ , P.try $ P.char '|' *> P.notFollowedBy symbolChar *> pure Pipe
196+ , P.try $ P.char '.' *> P.notFollowedBy symbolChar *> pure Dot
197+ , P.try $ P.char ';' *> P.notFollowedBy symbolChar *> pure Semi
198+ , P.try $ P.char '@' *> P.notFollowedBy symbolChar *> pure At
199+ , LName <$> parseLName
200+ , do uName <- parseUName
201+ (Qualifier uName <$ P.char '.') <|> pure (UName uName)
202+ , Symbol <$> parseSymbol
203+ , StringLiteral <$> parseStringLiteral
204+ , Number <$> parseNumber
205+ ] <* whitespace
206+
207+ where
208+ parseLName :: P.Parsec String u String
209+ parseLName = (:) <$> identStart <*> P.many identLetter
210+
211+ parseUName :: P.Parsec String u String
212+ parseUName = (:) <$> P.upper <*> P.many P.alphaNum
213+
214+ parseSymbol :: P.Parsec String u String
215+ parseSymbol = P.many1 symbolChar
216+
217+ identStart :: P.Parsec String u Char
218+ identStart = P.lower <|> P.oneOf "_"
219+
220+ identLetter :: P.Parsec String u Char
221+ identLetter = P.alphaNum <|> P.oneOf "_'"
222+
223+ symbolChar :: P.Parsec String u Char
224+ symbolChar = P.oneOf opChars
225+
226+ parseStringLiteral :: P.Parsec String u String
227+ parseStringLiteral = blockString <|> PT.stringLiteral tokenParser
228+ where
229+ delimeter = P.try (P.string "\"\"\"")
230+ blockString = delimeter >> P.manyTill P.anyChar delimeter
231+
232+ parseNumber :: P.Parsec String u (Either Integer Double)
233+ parseNumber = (Right <$> P.try (PT.float tokenParser) <|>
234+ Left <$> P.try (PT.natural tokenParser)) P.<?> "number"
235+
236+-- |
237+-- We use Text.Parsec.Token to implement the string and number lexemes
238+--
239+langDef :: PT.GenLanguageDef String u Identity
240+langDef = PT.LanguageDef
241+ { PT.reservedNames = []
242+ , PT.reservedOpNames = []
243+ , PT.commentStart = ""
244+ , PT.commentEnd = ""
245+ , PT.commentLine = ""
246+ , PT.nestedComments = True
247+ , PT.identStart = fail "Identifiers not supported"
248+ , PT.identLetter = fail "Identifiers not supported"
249+ , PT.opStart = fail "Operators not supported"
250+ , PT.opLetter = fail "Operators not supported"
251+ , PT.caseSensitive = True
252+ }
253+
254+-- |
255+-- A token parser based on the language definition
256+--
257+tokenParser :: PT.GenTokenParser String u Identity
258+tokenParser = PT.makeTokenParser langDef
259+
260+type TokenParser a = P.Parsec [PositionedToken] ParseState a
261+
262+token :: (Token -> Maybe a) -> TokenParser a
263+token f = P.token (prettyPrintToken . ptToken) ptSourcePos (f . ptToken)
264+
265+match :: Token -> TokenParser ()
266+match tok = token (\tok' -> if tok == tok' then Just () else Nothing) P.<?> prettyPrintToken tok
267+
268+lparen :: TokenParser ()
269+lparen = match LParen
270+
271+rparen :: TokenParser ()
272+rparen = match RParen
273+
274+parens :: TokenParser a -> TokenParser a
275+parens = P.between lparen rparen
276+
277+lbrace :: TokenParser ()
278+lbrace = match LBrace
279+
280+rbrace :: TokenParser ()
281+rbrace = match RBrace
282+
283+braces :: TokenParser a -> TokenParser a
284+braces = P.between lbrace rbrace
285+
286+lsquare :: TokenParser ()
287+lsquare = match LSquare
288+
289+rsquare :: TokenParser ()
290+rsquare = match RSquare
291+
292+squares :: TokenParser a -> TokenParser a
293+squares = P.between lsquare rsquare
294+
295+indent :: TokenParser Int
296+indent = token go P.<?> "indentation"
297+ where
298+ go (Indent n) = Just n
299+ go _ = Nothing
300+
301+indentAt :: P.Column -> TokenParser ()
302+indentAt n = token go P.<?> "indentation at level " ++ show n
303+ where
304+ go (Indent n') | n == n' = Just ()
305+ go _ = Nothing
306+
307+larrow :: TokenParser ()
308+larrow = match LArrow
309+
310+rarrow :: TokenParser ()
311+rarrow = match RArrow
312+
313+lfatArrow :: TokenParser ()
314+lfatArrow = match LFatArrow
315+
316+rfatArrow :: TokenParser ()
317+rfatArrow = match RFatArrow
318+
319+colon :: TokenParser ()
320+colon = match Colon
321+
322+doubleColon :: TokenParser ()
323+doubleColon = match DoubleColon
324+
325+equals :: TokenParser ()
326+equals = match Equals
327+
328+pipe :: TokenParser ()
329+pipe = match Pipe
330+
331+tick :: TokenParser ()
332+tick = match Tick
333+
334+dot :: TokenParser ()
335+dot = match Dot
336+
337+comma :: TokenParser ()
338+comma = match Comma
339+
340+semi :: TokenParser ()
341+semi = match Semi
342+
343+at :: TokenParser ()
344+at = match At
345+
346+-- |
347+-- Parse zero or more values separated by semicolons
348+--
349+semiSep :: TokenParser a -> TokenParser [a]
350+semiSep = flip P.sepBy semi
351+
352+-- |
353+-- Parse one or more values separated by semicolons
354+--
355+semiSep1 :: TokenParser a -> TokenParser [a]
356+semiSep1 = flip P.sepBy1 semi
357+
358+-- |
359+-- Parse zero or more values separated by commas
360+--
361+commaSep :: TokenParser a -> TokenParser [a]
362+commaSep = flip P.sepBy comma
363+
364+-- |
365+-- Parse one or more values separated by commas
366+--
367+commaSep1 :: TokenParser a -> TokenParser [a]
368+commaSep1 = flip P.sepBy1 comma
369+
370+lname :: TokenParser String
371+lname = token go P.<?> "identifier"
372+ where
373+ go (LName s) = Just s
374+ go _ = Nothing
375+
376+qualifier :: TokenParser String
377+qualifier = token go P.<?> "qualifier"
378+ where
379+ go (Qualifier s) = Just s
380+ go _ = Nothing
381+
382+reserved :: String -> TokenParser ()
383+reserved s = token go P.<?> show s
384+ where
385+ go (LName s') | s == s' = Just ()
386+ go _ = Nothing
387+
388+uname :: TokenParser String
389+uname = token go P.<?> "proper name"
390+ where
391+ go (UName s) = Just s
392+ go _ = Nothing
393+
394+uname' :: String -> TokenParser ()
395+uname' s = token go P.<?> show s
396+ where
397+ go (UName s') | s == s' = Just ()
398+ go _ = Nothing
399+
400+symbol :: TokenParser String
401+symbol = token go P.<?> "symbol"
402+ where
403+ go (Symbol s) = Just s
404+ go Colon = Just ":"
405+ go LFatArrow = Just "<="
406+ go _ = Nothing
407+
408+symbol' :: String -> TokenParser ()
409+symbol' s = token go P.<?> show s
410+ where
411+ go (Symbol s') | s == s' = Just ()
412+ go Colon | s == ":" = Just ()
413+ go LFatArrow | s == "<=" = Just ()
414+ go _ = Nothing
415+
416+stringLiteral :: TokenParser String
417+stringLiteral = token go P.<?> "string literal"
418+ where
419+ go (StringLiteral s) = Just s
420+ go _ = Nothing
421+
422+number :: TokenParser (Either Integer Double)
423+number = token go P.<?> "number"
424+ where
425+ go (Number n) = Just n
426+ go _ = Nothing
427+
428+natural :: TokenParser Integer
429+natural = token go P.<?> "natural"
430+ where
431+ go (Number (Left n)) = Just n
432+ go _ = Nothing
433+
434+identifier :: TokenParser String
435+identifier = token go P.<?> "identifier"
436+ where
437+ go (LName s) | s `notElem` reservedPsNames = Just s
438+ go _ = Nothing
439+
440+-- |
441+-- A list of purescript reserved identifiers
442+--
443+reservedPsNames :: [String]
444+reservedPsNames = [ "data"
445+ , "newtype"
446+ , "type"
447+ , "foreign"
448+ , "import"
449+ , "infixl"
450+ , "infixr"
451+ , "infix"
452+ , "class"
453+ , "instance"
454+ , "module"
455+ , "case"
456+ , "of"
457+ , "if"
458+ , "then"
459+ , "else"
460+ , "do"
461+ , "let"
462+ , "true"
463+ , "false"
464+ , "in"
465+ , "where"
466+ ]
467+
468+reservedTypeNames :: [String]
469+reservedTypeNames = [ "forall", "where" ]
470+
471+-- |
472+-- The characters allowed for use in operators
473+--
474+opChars :: [Char]
475+opChars = ":!#$%&*+./<=>?@\\^|-~"
476+
src/Language/PureScript/Parser/Types.hs+25−25
@@ -24,46 +24,46 @@ import Control.Applicative
2424import Control.Monad (when, unless)
2525
2626import Language.PureScript.Types
27−import Language.PureScript.Parser.State
2827import Language.PureScript.Parser.Common
2928import Language.PureScript.Parser.Kinds
29+import Language.PureScript.Parser.Lexer
3030import Language.PureScript.Environment
3131
3232import qualified Text.Parsec as P
3333import qualified Text.Parsec.Expr as P
3434
35−parseArray :: P.Parsec String ParseState Type
35+parseArray :: TokenParser Type
3636parseArray = squares $ return tyArray
3737
38−parseArrayOf :: P.Parsec String ParseState Type
38+parseArrayOf :: TokenParser Type
3939parseArrayOf = squares $ TypeApp tyArray <$> parseType
4040
41−parseFunction :: P.Parsec String ParseState Type
42−parseFunction = parens $ P.try (lexeme (P.string "->")) >> return tyFunction
41+parseFunction :: TokenParser Type
42+parseFunction = parens $ rarrow >> return tyFunction
4343
44−parseObject :: P.Parsec String ParseState Type
44+parseObject :: TokenParser Type
4545parseObject = braces $ TypeApp tyObject <$> parseRow
4646
47−parseTypeWildcard :: P.Parsec String ParseState Type
48−parseTypeWildcard = lexeme (P.char '_') >> return TypeWildcard
47+parseTypeWildcard :: TokenParser Type
48+parseTypeWildcard = reserved "_" >> return TypeWildcard
4949
50−parseTypeVariable :: P.Parsec String ParseState Type
50+parseTypeVariable :: TokenParser Type
5151parseTypeVariable = do
5252 ident <- identifier
5353 when (ident `elem` reservedTypeNames) $ P.unexpected ident
5454 return $ TypeVar ident
5555
56−parseTypeConstructor :: P.Parsec String ParseState Type
56+parseTypeConstructor :: TokenParser Type
5757parseTypeConstructor = TypeConstructor <$> parseQualified properName
5858
59−parseForAll :: P.Parsec String ParseState Type
59+parseForAll :: TokenParser Type
6060parseForAll = mkForAll <$> (P.try (reserved "forall") *> P.many1 (indented *> identifier) <* indented <* dot)
6161 <*> parseConstrainedType
6262
6363-- |
6464-- Parse a type as it appears in e.g. a data constructor
6565--
66−parseTypeAtom :: P.Parsec String ParseState Type
66+parseTypeAtom :: TokenParser Type
6767parseTypeAtom = indented *> P.choice (map P.try
6868 [ parseArray
6969 , parseArrayOf
@@ -76,7 +76,7 @@ parseTypeAtom = indented *> P.choice (map P.try
7676 , parens parseRow
7777 , parens parsePolyType ])
7878
79−parseConstrainedType :: P.Parsec String ParseState Type
79+parseConstrainedType :: TokenParser Type
8080parseConstrainedType = do
8181 constraints <- P.optionMaybe . P.try $ do
8282 constraints <- parens . commaSep1 $ do
@@ -84,24 +84,24 @@ parseConstrainedType = do
8484 indented
8585 ty <- P.many parseTypeAtom
8686 return (className, ty)
87− _ <- lexeme $ P.string "=>"
87+ _ <- rfatArrow
8888 return constraints
8989 indented
9090 ty <- parseType
9191 return $ maybe ty (flip ConstrainedType ty) constraints
9292
93−parseAnyType :: P.Parsec String ParseState Type
93+parseAnyType :: TokenParser Type
9494parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable parseTypeAtom) P.<?> "type"
9595 where
9696 operators = [ [ P.Infix (return TypeApp) P.AssocLeft ]
97− , [ P.Infix (P.try (lexeme (P.string "->")) >> return function) P.AssocRight ] ]
98− postfixTable = [ \t -> KindedType t <$> (P.try (lexeme (indented *> P.string "::")) *> parseKind)
97+ , [ P.Infix (rarrow >> return function) P.AssocRight ] ]
98+ postfixTable = [ \t -> KindedType t <$> (P.try (indented *> doubleColon) *> parseKind)
9999 ]
100100
101101-- |
102102-- Parse a monotype
103103--
104−parseType :: P.Parsec String ParseState Type
104+parseType :: TokenParser Type
105105parseType = do
106106 ty <- parseAnyType
107107 unless (isMonoType ty) $ P.unexpected "polymorphic type"
@@ -110,23 +110,23 @@ parseType = do
110110-- |
111111-- Parse a polytype
112112--
113−parsePolyType :: P.Parsec String ParseState Type
113+parsePolyType :: TokenParser Type
114114parsePolyType = parseAnyType
115115
116116-- |
117117-- Parse an atomic type with no wildcards
118118--
119−noWildcards :: P.Parsec String ParseState Type -> P.Parsec String ParseState Type
119+noWildcards :: TokenParser Type -> TokenParser Type
120120noWildcards p = do
121121 ty <- p
122122 when (containsWildcards ty) $ P.unexpected "type wildcard"
123123 return ty
124124
125−parseNameAndType :: P.Parsec String ParseState t -> P.Parsec String ParseState (String, t)
126−parseNameAndType p = (,) <$> (indented *> (identifierName <|> stringLiteral) <* indented <* lexeme (P.string "::")) <*> p
125+parseNameAndType :: TokenParser t -> TokenParser (String, t)
126+parseNameAndType p = (,) <$> (indented *> (lname <|> stringLiteral) <* indented <* doubleColon) <*> p
127127
128−parseRowEnding :: P.Parsec String ParseState Type
129−parseRowEnding = P.option REmpty (TypeVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
128+parseRowEnding :: TokenParser Type
129+parseRowEnding = P.option REmpty (TypeVar <$> (indented *> pipe *> indented *> identifier))
130130
131−parseRow :: P.Parsec String ParseState Type
131+parseRow :: TokenParser Type
132132parseRow = (curry rowFromList <$> commaSep (parseNameAndType parsePolyType) <*> parseRowEnding) P.<?> "row"
src/Language/PureScript/Pretty/Common.hs+1−1
@@ -17,7 +17,7 @@ module Language.PureScript.Pretty.Common where
1717
1818import Control.Monad.State
1919import Data.List (intercalate)
20−import Language.PureScript.Parser.Common (reservedPsNames, opChars)
20+import Language.PureScript.Parser.Lexer (reservedPsNames, opChars)
2121
2222-- |
2323-- Wrap a string in parentheses