diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-02-03 10:17:25 +0100 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-02-03 10:17:35 +0100 |
commit | 96c593562a50822f246284b1212e260a60bbbc9f (patch) | |
tree | 584e29b0ce8512a88362823c64d6142bcabf476e /src | |
parent | 52fd8201db77c6dd1d8d6a4ae7341460f26757a0 (diff) |
refactoring
Diffstat (limited to 'src')
-rw-r--r-- | src/LambdaCube/Compiler/Lexer.hs | 30 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Parser.hs | 8 |
2 files changed, 12 insertions, 26 deletions
diff --git a/src/LambdaCube/Compiler/Lexer.hs b/src/LambdaCube/Compiler/Lexer.hs index 2b2407dd..6a269f6b 100644 --- a/src/LambdaCube/Compiler/Lexer.hs +++ b/src/LambdaCube/Compiler/Lexer.hs | |||
@@ -533,29 +533,19 @@ symbol name | |||
533 | whiteSpace = ignoreAbsoluteIndentation (localTokenMode (const Pa.Any) whiteSpace') | 533 | whiteSpace = ignoreAbsoluteIndentation (localTokenMode (const Pa.Any) whiteSpace') |
534 | whiteSpace' = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "") | 534 | whiteSpace' = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "") |
535 | 535 | ||
536 | simpleSpace = | 536 | simpleSpace |
537 | skipMany1 (satisfy isSpace) | 537 | = skipMany1 (satisfy isSpace) |
538 | 538 | ||
539 | oneLineComment = | 539 | oneLineComment |
540 | do{ try (string "--" >> many (char '-') >> notFollowedBy opLetter) | 540 | = try (string "--" >> many (char '-') >> notFollowedBy opLetter) |
541 | ; skipMany (satisfy (/= '\n')) | 541 | >> skipMany (satisfy (/= '\n')) |
542 | ; return () | ||
543 | } | ||
544 | |||
545 | commentStart = "{-" | ||
546 | commentEnd = "-}" | ||
547 | 542 | ||
548 | multiLineComment = | 543 | multiLineComment = try (string "{-") *> inCommentMulti |
549 | do { try (string commentStart) | ||
550 | ; inCommentMulti | ||
551 | } | ||
552 | 544 | ||
553 | inCommentMulti | 545 | inCommentMulti |
554 | = do{ try (string commentEnd) ; return () } | 546 | = try (() <$ string "-}") |
555 | <|> do{ multiLineComment ; inCommentMulti } | 547 | <|> multiLineComment *> inCommentMulti |
556 | <|> do{ skipMany1 (noneOf startEnd) ; inCommentMulti } | 548 | <|> skipMany1 (noneOf "{}-") *> inCommentMulti |
557 | <|> do{ oneOf startEnd ; inCommentMulti } | 549 | <|> oneOf "{}-" *> inCommentMulti |
558 | <?> "end of comment" | 550 | <?> "end of comment" |
559 | where | ||
560 | startEnd = commentEnd ++ commentStart | ||
561 | 551 | ||
diff --git a/src/LambdaCube/Compiler/Parser.hs b/src/LambdaCube/Compiler/Parser.hs index 78942063..b7112bf4 100644 --- a/src/LambdaCube/Compiler/Parser.hs +++ b/src/LambdaCube/Compiler/Parser.hs | |||
@@ -363,7 +363,7 @@ parseTerm prec = withRange setSI $ case prec of | |||
363 | PrecApp -> | 363 | PrecApp -> |
364 | apps' <$> try "record" (sVar upperCase <* reservedOp "{") <*> (commaSep $ lowerCase *> reservedOp "=" *> ((,) Visible <$> parseTerm PrecLam)) <* reservedOp "}" | 364 | apps' <$> try "record" (sVar upperCase <* reservedOp "{") <*> (commaSep $ lowerCase *> reservedOp "=" *> ((,) Visible <$> parseTerm PrecLam)) <* reservedOp "}" |
365 | <|> apps' <$> parseTerm PrecSwiz <*> many (hiddenTerm (parseTTerm PrecSwiz) $ parseTerm PrecSwiz) | 365 | <|> apps' <$> parseTerm PrecSwiz <*> many (hiddenTerm (parseTTerm PrecSwiz) $ parseTerm PrecSwiz) |
366 | PrecSwiz -> level PrecProj $ \t -> try "swizzling" $ mkSwizzling t <$> lexeme (char '%' *> manyNM 1 4 (satisfy (`elem` ("xyzwrgba" :: String)))) | 366 | PrecSwiz -> level PrecProj $ \t -> mkSwizzling t <$> lexeme (try "swizzling" $ char '%' *> manyNM 1 4 (satisfy (`elem` ("xyzwrgba" :: String)))) |
367 | PrecProj -> level PrecAtom $ \t -> try "projection" $ mkProjection t <$ char '.' <*> sepBy1 (sLit . LString <$> lowerCase) (char '.') | 367 | PrecProj -> level PrecAtom $ \t -> try "projection" $ mkProjection t <$ char '.' <*> sepBy1 (sLit . LString <$> lowerCase) (char '.') |
368 | PrecAtom -> | 368 | PrecAtom -> |
369 | mkLit <$> namespace <*> try "literal" parseLit | 369 | mkLit <$> namespace <*> try "literal" parseLit |
@@ -998,12 +998,8 @@ extensionMap = Map.fromList $ map (show &&& id) [toEnum 0 .. ] | |||
998 | 998 | ||
999 | parseExtensions :: P [Extension] | 999 | parseExtensions :: P [Extension] |
1000 | parseExtensions | 1000 | parseExtensions |
1001 | = lexeme (try "language pragma" $ string "{-#") | 1001 | = try "pragma" (symbol "{-#") *> symbol "LANGUAGE" *> commaSep (lexeme ext) <* symbol "#-}" |
1002 | *> lexeme (string "LANGUAGE") | ||
1003 | *> lexeme (commaSep $ lexeme ext) | ||
1004 | <* lexeme (string "#-}") | ||
1005 | where | 1002 | where |
1006 | lexeme p = p <* skipMany (satisfy isSpace) | ||
1007 | ext = do | 1003 | ext = do |
1008 | s <- some $ satisfy isAlphaNum | 1004 | s <- some $ satisfy isAlphaNum |
1009 | maybe | 1005 | maybe |