diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/LexCore.hs | 86 | ||||
| -rw-r--r-- | compiler/parser/Lexer.x | 2 | ||||
| -rw-r--r-- | compiler/parser/Parser.y.pp | 25 |
3 files changed, 47 insertions, 66 deletions
diff --git a/compiler/parser/LexCore.hs b/compiler/parser/LexCore.hs index b3d8d63fbd..861fffb7f6 100644 --- a/compiler/parser/LexCore.hs +++ b/compiler/parser/LexCore.hs @@ -1,11 +1,3 @@ - -{-# OPTIONS -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module LexCore where import ParserCoreUtils @@ -15,39 +7,39 @@ import Numeric isNameChar :: Char -> Bool isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'') - || (c == '$') || (c == '-') || (c == '.') + || (c == '$') || (c == '-') || (c == '.') isKeywordChar :: Char -> Bool -isKeywordChar c = isAlpha c || (c == '_') +isKeywordChar c = isAlpha c || (c == '_') -lexer :: (Token -> P a) -> P a -lexer cont [] = cont TKEOF [] -lexer cont ('\n':cs) = \line -> lexer cont cs (line+1) +lexer :: (Token -> P a) -> P a +lexer cont [] = cont TKEOF [] +lexer cont ('\n':cs) = \line -> lexer cont cs (line+1) lexer cont ('-':'>':cs) = cont TKrarrow cs -lexer cont (c:cs) - | isSpace c = lexer cont cs +lexer cont (c:cs) + | isSpace c = lexer cont cs | isLower c || (c == '_') = lexName cont TKname (c:cs) - | isUpper c = lexName cont TKcname (c:cs) + | isUpper c = lexName cont TKcname (c:cs) | isDigit c || (c == '-') = lexNum cont (c:cs) -lexer cont ('%':cs) = lexKeyword cont cs -lexer cont ('\'':cs) = lexChar cont cs -lexer cont ('\"':cs) = lexString [] cont cs -lexer cont ('#':cs) = cont TKhash cs -lexer cont ('(':cs) = cont TKoparen cs -lexer cont (')':cs) = cont TKcparen cs -lexer cont ('{':cs) = cont TKobrace cs -lexer cont ('}':cs) = cont TKcbrace cs +lexer cont ('%':cs) = lexKeyword cont cs +lexer cont ('\'':cs) = lexChar cont cs +lexer cont ('\"':cs) = lexString [] cont cs +lexer cont ('#':cs) = cont TKhash cs +lexer cont ('(':cs) = cont TKoparen cs +lexer cont (')':cs) = cont TKcparen cs +lexer cont ('{':cs) = cont TKobrace cs +lexer cont ('}':cs) = cont TKcbrace cs lexer cont ('=':cs) = cont TKeq cs lexer cont (':':'=':':':cs) = cont TKcoloneqcolon cs lexer cont (':':':':cs) = cont TKcoloncolon cs -lexer cont ('*':cs) = cont TKstar cs -lexer cont ('.':cs) = cont TKdot cs +lexer cont ('*':cs) = cont TKstar cs +lexer cont ('.':cs) = cont TKdot cs lexer cont ('\\':cs) = cont TKlambda cs -lexer cont ('@':cs) = cont TKat cs -lexer cont ('?':cs) = cont TKquestion cs -lexer cont (';':cs) = cont TKsemicolon cs +lexer cont ('@':cs) = cont TKat cs +lexer cont ('?':cs) = cont TKquestion cs +lexer cont (';':cs) = cont TKsemicolon cs -- 20060420 GHC spits out constructors with colon in them nowadays. jds -- 20061103 but it's easier to parse if we split on the colon, and treat them -- as several tokens @@ -68,7 +60,7 @@ lexChar _ cs = panic ("lexChar: " ++ show cs) lexString :: String -> (Token -> [Char] -> Int -> ParseResult a) -> String -> Int -> ParseResult a -lexString s cont ('\\':'x':h1:h0:cs) +lexString s cont ('\\':'x':h1:h0:cs) | isHexEscape [h1,h0] = lexString (s++[hexToChar h1 h0]) cont cs lexString _ _ ('\\':_) = failP "invalid string character" ['\\'] lexString _ _ ('\'':_) = failP "invalid string character" ['\''] @@ -86,14 +78,14 @@ lexNum :: (Token -> String -> a) -> String -> a lexNum cont cs = case cs of ('-':cs) -> f (-1) cs - _ -> f 1 cs - where f sgn cs = + _ -> f 1 cs + where f sgn cs = case span isDigit cs of - (digits,'.':c:rest) - | isDigit c -> cont (TKrational (fromInteger sgn * r)) rest' - where ((r,rest'):_) = readFloat (digits ++ ('.':c:rest)) - -- When reading a floating-point number, which is - -- a bit complicated, use the standard library function + (digits,'.':c:rest) + | isDigit c -> cont (TKrational (fromInteger sgn * r)) rest' + where ((r,rest'):_) = readFloat (digits ++ ('.':c:rest)) + -- When reading a floating-point number, which is + -- a bit complicated, use the standard library function -- "readFloat" (digits,rest) -> cont (TKinteger (sgn * (read digits))) rest @@ -103,21 +95,21 @@ lexName cont cstr cs = cont (cstr name) rest lexKeyword :: (Token -> [Char] -> Int -> ParseResult a) -> String -> Int -> ParseResult a -lexKeyword cont cs = +lexKeyword cont cs = case span isKeywordChar cs of ("module",rest) -> cont TKmodule rest ("data",rest) -> cont TKdata rest ("newtype",rest) -> cont TKnewtype rest - ("forall",rest) -> cont TKforall rest - ("rec",rest) -> cont TKrec rest - ("let",rest) -> cont TKlet rest - ("in",rest) -> cont TKin rest - ("case",rest) -> cont TKcase rest - ("of",rest) -> cont TKof rest - ("cast",rest) -> cont TKcast rest - ("note",rest) -> cont TKnote rest + ("forall",rest) -> cont TKforall rest + ("rec",rest) -> cont TKrec rest + ("let",rest) -> cont TKlet rest + ("in",rest) -> cont TKin rest + ("case",rest) -> cont TKcase rest + ("of",rest) -> cont TKof rest + ("cast",rest) -> cont TKcast rest + ("note",rest) -> cont TKnote rest ("external",rest) -> cont TKexternal rest ("local",rest) -> cont TKlocal rest ("_",rest) -> cont TKwild rest - _ -> failP "invalid keyword" ('%':cs) + _ -> failP "invalid keyword" ('%':cs) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index e0e97fed4a..6e74cfbc4a 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -509,8 +509,6 @@ data Token | ITocurly -- special symbols | ITccurly - | ITocurlybar -- {|, for type applications - | ITccurlybar -- |}, for type applications | ITvocurly | ITvccurly | ITobrack diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 9803650842..b664861c44 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -294,8 +294,6 @@ incorrect. '{' { L _ ITocurly } -- special symbols '}' { L _ ITccurly } - '{|' { L _ ITocurlybar } - '|}' { L _ ITccurlybar } vocurly { L _ ITvocurly } -- virtual open curly (from layout) vccurly { L _ ITvccurly } -- virtual close curly (from layout) '[' { L _ ITobrack } @@ -1432,14 +1430,6 @@ aexp1 :: { LHsExpr RdrName } ; checkRecordSyntax (LL r) }} | aexp2 { $1 } --- Here was the syntax for type applications that I was planning --- but there are difficulties (e.g. what order for type args) --- so it's not enabled yet. --- But this case *is* used for the left hand side of a generic definition, --- which is parsed as an expression before being munged into a pattern - | qcname '{|' type '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1))) - (sL (getLoc $3) (HsType $3)) } - aexp2 :: { LHsExpr RdrName } : ipvar { L1 (HsIPVar $! unLoc $1) } | qcname { L1 (HsVar $! unLoc $1) } @@ -1591,16 +1581,17 @@ squals :: { Located [LStmt RdrName] } -- In reverse order, because the last -- | '{|' pquals '|}' { L1 [$2] } --- It is possible to enable bracketing (associating) qualifier lists by uncommenting the lines with {| |} --- above. Due to a lack of consensus on the syntax, this feature is not being used until we get user --- demand. +-- It is possible to enable bracketing (associating) qualifier lists +-- by uncommenting the lines with {| |} above. Due to a lack of +-- consensus on the syntax, this feature is not being used until we +-- get user demand. transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) } -- Function is applied to a list of stmts *in order* - : 'then' exp { LL $ \leftStmts -> (mkTransformStmt leftStmts $2) } - | 'then' exp 'by' exp { LL $ \leftStmts -> (mkTransformByStmt leftStmts $2 $4) } - | 'then' 'group' 'using' exp { LL $ \leftStmts -> (mkGroupUsingStmt leftStmts $4) } - | 'then' 'group' 'by' exp 'using' exp { LL $ \leftStmts -> (mkGroupByUsingStmt leftStmts $4 $6) } + : 'then' exp { LL $ \ss -> (mkTransformStmt ss $2) } + | 'then' exp 'by' exp { LL $ \ss -> (mkTransformByStmt ss $2 $4) } + | 'then' 'group' 'using' exp { LL $ \ss -> (mkGroupUsingStmt ss $4) } + | 'then' 'group' 'by' exp 'using' exp { LL $ \ss -> (mkGroupByUsingStmt ss $4 $6) } -- Note that 'group' is a special_id, which means that you can enable -- TransformListComp while still using Data.List.group. However, this |