From 884ec3bb799d72dcca10c562277e7f31a0f1d283 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 28 Jun 1999 15:42:35 +0000 Subject: [PATCH] [project @ 1999-06-28 15:42:33 by simonmar] Fix some pretty subtle bugs in the lexing of qualified names. --- ghc/compiler/parser/Lex.lhs | 19 ++++++++----------- ghc/compiler/parser/ParseUtil.lhs | 31 ++++++++++++++++++++----------- ghc/compiler/parser/Parser.y | 19 ++++++------------- ghc/compiler/rename/ParseIface.y | 6 ------ 4 files changed, 34 insertions(+), 41 deletions(-) diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs index 25aa14c..727039c 100644 --- a/ghc/compiler/parser/Lex.lhs +++ b/ghc/compiler/parser/Lex.lhs @@ -96,15 +96,13 @@ Laziness, you know it makes sense :-) \begin{code} data Token - = ITas -- Haskell keywords - | ITcase + = ITcase -- Haskell keywords | ITclass | ITdata | ITdefault | ITderiving | ITdo | ITelse - | IThiding | ITif | ITimport | ITin @@ -116,7 +114,6 @@ data Token | ITmodule | ITnewtype | ITof - | ITqualified | ITthen | ITtype | ITwhere @@ -245,7 +242,6 @@ pragmaKeywordsFM = listToUFM $ haskellKeywordsFM = listToUFM $ map (\ (x,y) -> (_PK_ x,y)) [( "_", ITunderscore ), - ( "as", ITas ), ( "case", ITcase ), ( "class", ITclass ), ( "data", ITdata ), @@ -253,7 +249,6 @@ haskellKeywordsFM = listToUFM $ ( "deriving", ITderiving ), ( "do", ITdo ), ( "else", ITelse ), - ( "hiding", IThiding ), ( "if", ITif ), ( "import", ITimport ), ( "in", ITin ), @@ -265,7 +260,6 @@ haskellKeywordsFM = listToUFM $ ( "module", ITmodule ), ( "newtype", ITnewtype ), ( "of", ITof ), - ( "qualified", ITqualified ), ( "then", ITthen ), ( "type", ITtype ), ( "where", ITwhere ), @@ -341,6 +335,10 @@ haskellKeySymsFM = listToUFM $ ,("!", ITbang) ,(".", ITdot) -- sadly, for 'forall a . t' ] + +not_special_op ITminus = False +not_special_op ITbang = False +not_special_op _ = True \end{code} ----------------------------------------------------------------------------- @@ -980,8 +978,9 @@ lex_id3 cont glaexts mod buf just_a_conid new_buf = mergeLexemes buf buf' in case lookupUFM haskellKeySymsFM lexeme of { - Just kwd_token -> just_a_conid; -- avoid M.:: etc. - Nothing -> cont (mk_qvar_token mod lexeme) new_buf + Just kwd_token | not_special_op kwd_token + -> just_a_conid; -- avoid M.::, but not M.! + other -> cont (mk_qvar_token mod lexeme) new_buf }} | otherwise = @@ -1003,8 +1002,6 @@ lex_id3 cont glaexts mod buf just_a_conid case _scc_ "Lex.haskellKeyword" lookupUFM haskellKeywordsFM lexeme of { Just kwd_token -> just_a_conid; -- avoid M.where etc. Nothing -> is_a_qvarid - -- TODO: special ids (as, qualified, hiding) shouldn't be - -- recognised as keywords here. ie. M.as is a qualified varid. }}} diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs index ce4f71b..2be5030 100644 --- a/ghc/compiler/parser/ParseUtil.lhs +++ b/ghc/compiler/parser/ParseUtil.lhs @@ -14,6 +14,10 @@ module ParseUtil ( , mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp , groupBindings + , checkAs + , checkHiding + , checkQualified + , checkPrec -- String -> P String , checkCallConv -- FAST_STRING -> P CallConv , checkContext -- HsType -> P HsContext @@ -33,10 +37,9 @@ module ParseUtil ( , funTyCon_RDR -- pseudo-keywords, in var and tyvar forms (all :: RdrName) - , as_var_RDR, hiding_var_RDR, qualified_var_RDR, forall_var_RDR + , forall_var_RDR , export_var_RDR, label_var_RDR, dynamic_var_RDR, unsafe_var_RDR - , as_tyvar_RDR, hiding_tyvar_RDR, qualified_tyvar_RDR , export_tyvar_RDR, label_tyvar_RDR, dynamic_tyvar_RDR , unsafe_tyvar_RDR @@ -69,6 +72,9 @@ parseError s = getSrcLocP `thenP` \ loc -> failMsgP (hcat [ppr loc, text ": ", text s]) +parseErrorOnInput :: P a +parseErrorOnInput buf PState{ loc = loc } = PFailed (srcParseErr buf loc) + srcParseErr :: StringBuffer -> SrcLoc -> Message srcParseErr s l = hcat [ppr l, ptext SLIT(": parse error on input "), @@ -77,6 +83,18 @@ srcParseErr s l cbot = panic "CCall:result_ty" ----------------------------------------------------------------------------- +-- Special Ids + +checkAs, checkQualified, checkHiding :: FAST_STRING -> P () + +checkAs s | s == SLIT("as") = returnP () + | otherwise = parseErrorOnInput +checkQualified s | s == SLIT("qualified") = returnP () + | otherwise = parseErrorOnInput +checkHiding s | s == SLIT("hiding") = returnP () + | otherwise = parseErrorOnInput + +----------------------------------------------------------------------------- -- splitForConApp -- When parsing data declarations, we sometimes inadvertently parse @@ -428,27 +446,18 @@ unitName = SLIT("()") funName = SLIT("(->)") listName = SLIT("[]") -asName = SLIT("as") -hidingName = SLIT("hiding") -qualifiedName = SLIT("qualified") forallName = SLIT("forall") exportName = SLIT("export") labelName = SLIT("label") dynamicName = SLIT("dynamic") unsafeName = SLIT("unsafe") -as_var_RDR = mkSrcUnqual varName asName -hiding_var_RDR = mkSrcUnqual varName hidingName -qualified_var_RDR = mkSrcUnqual varName qualifiedName forall_var_RDR = mkSrcUnqual varName forallName export_var_RDR = mkSrcUnqual varName exportName label_var_RDR = mkSrcUnqual varName labelName dynamic_var_RDR = mkSrcUnqual varName dynamicName unsafe_var_RDR = mkSrcUnqual varName unsafeName -as_tyvar_RDR = mkSrcUnqual tvName asName -hiding_tyvar_RDR = mkSrcUnqual tvName hidingName -qualified_tyvar_RDR = mkSrcUnqual tvName qualifiedName export_tyvar_RDR = mkSrcUnqual tvName exportName label_tyvar_RDR = mkSrcUnqual tvName labelName dynamic_tyvar_RDR = mkSrcUnqual tvName dynamicName diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 475534f..f97ff96 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.7 1999/06/25 14:38:54 simonmar Exp $ +$Id: Parser.y,v 1.8 1999/06/28 15:42:33 simonmar Exp $ Haskell grammar. @@ -61,7 +61,6 @@ Conflicts: 14 shift/reduce %token '_' { ITunderscore } -- Haskell keywords - 'as' { ITas } 'case' { ITcase } 'class' { ITclass } 'data' { ITdata } @@ -69,7 +68,6 @@ Conflicts: 14 shift/reduce 'deriving' { ITderiving } 'do' { ITdo } 'else' { ITelse } - 'hiding' { IThiding } 'if' { ITif } 'import' { ITimport } 'in' { ITin } @@ -81,7 +79,6 @@ Conflicts: 14 shift/reduce 'module' { ITmodule } 'newtype' { ITnewtype } 'of' { ITof } - 'qualified' { ITqualified } 'then' { ITthen } 'type' { ITtype } 'where' { ITwhere } @@ -860,9 +857,6 @@ qvarid :: { RdrName } varid :: { RdrName } : VARID { mkSrcUnqual varName $1 } - | 'as' { as_var_RDR } - | 'qualified' { qualified_var_RDR } - | 'hiding' { hiding_var_RDR } | 'forall' { forall_var_RDR } | 'export' { export_var_RDR } | 'label' { label_var_RDR } @@ -871,14 +865,16 @@ varid :: { RdrName } varid_no_unsafe :: { RdrName } : VARID { mkSrcUnqual varName $1 } - | 'as' { as_var_RDR } - | 'qualified' { qualified_var_RDR } - | 'hiding' { hiding_var_RDR } | 'forall' { forall_var_RDR } | 'export' { export_var_RDR } | 'label' { label_var_RDR } | 'dynamic' { dynamic_var_RDR } +-- ``special'' Ids +'as' :: { () } : VARID {% checkAs $1 } +'qualified' :: { () } : VARID {% checkQualified $1 } +'hiding' :: { () } : VARID {% checkHiding $1 } + ----------------------------------------------------------------------------- -- ConIds @@ -970,9 +966,6 @@ qtycls :: { RdrName } tyvar :: { RdrName } : VARID { mkSrcUnqual tvName $1 } - | 'as' { as_tyvar_RDR } - | 'qualified' { qualified_tyvar_RDR } - | 'hiding' { hiding_tyvar_RDR } | 'export' { export_var_RDR } | 'label' { label_var_RDR } | 'dynamic' { dynamic_var_RDR } diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y index 5d58b40..419fa11 100644 --- a/ghc/compiler/rename/ParseIface.y +++ b/ghc/compiler/rename/ParseIface.y @@ -69,9 +69,6 @@ import Ratio ( (%) ) 'then' { ITthen } 'type' { ITtype } 'where' { ITwhere } - 'as' { ITas } - 'qualified' { ITqualified } - 'hiding' { IThiding } 'forall' { ITforall } -- GHC extension keywords 'foreign' { ITforeign } @@ -459,9 +456,6 @@ var_fs :: { EncodedFS } : VARID { $1 } | VARSYM { $1 } | '!' { SLIT("!") } - | 'as' { SLIT("as") } - | 'qualified' { SLIT("qualified") } - | 'hiding' { SLIT("hiding") } | 'forall' { SLIT("forall") } | 'foreign' { SLIT("foreign") } | 'export' { SLIT("export") } -- 1.7.10.4