From c52f850d362bc16fc616c08d84f3c83fbbdea464 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 28 Jun 1999 16:42:24 +0000 Subject: [PATCH] [project @ 1999-06-28 16:42:22 by simonmar] Back out changes for "specialid"s. It didn't work this way: there was a conflict in the grammar. --- ghc/compiler/parser/Lex.lhs | 22 ++++++++++++---------- ghc/compiler/parser/ParseUtil.lhs | 31 +++++++++++-------------------- ghc/compiler/parser/Parser.y | 19 +++++++++++++------ ghc/compiler/rename/ParseIface.y | 6 ++++++ 4 files changed, 42 insertions(+), 36 deletions(-) diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs index 727039c..d705043 100644 --- a/ghc/compiler/parser/Lex.lhs +++ b/ghc/compiler/parser/Lex.lhs @@ -96,13 +96,15 @@ Laziness, you know it makes sense :-) \begin{code} data Token - = ITcase -- Haskell keywords + = ITas -- Haskell keywords + | ITcase | ITclass | ITdata | ITdefault | ITderiving | ITdo | ITelse + | IThiding | ITif | ITimport | ITin @@ -114,6 +116,7 @@ data Token | ITmodule | ITnewtype | ITof + | ITqualified | ITthen | ITtype | ITwhere @@ -242,6 +245,7 @@ pragmaKeywordsFM = listToUFM $ haskellKeywordsFM = listToUFM $ map (\ (x,y) -> (_PK_ x,y)) [( "_", ITunderscore ), + ( "as", ITas ), ( "case", ITcase ), ( "class", ITclass ), ( "data", ITdata ), @@ -249,6 +253,7 @@ haskellKeywordsFM = listToUFM $ ( "deriving", ITderiving ), ( "do", ITdo ), ( "else", ITelse ), + ( "hiding", IThiding ), ( "if", ITif ), ( "import", ITimport ), ( "in", ITin ), @@ -260,6 +265,7 @@ haskellKeywordsFM = listToUFM $ ( "module", ITmodule ), ( "newtype", ITnewtype ), ( "of", ITof ), + ( "qualified", ITqualified ), ( "then", ITthen ), ( "type", ITtype ), ( "where", ITwhere ), @@ -335,10 +341,6 @@ 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} ----------------------------------------------------------------------------- @@ -977,11 +979,9 @@ lex_id3 cont glaexts mod buf just_a_conid -- real lexeme is M. new_buf = mergeLexemes buf buf' in - case lookupUFM haskellKeySymsFM lexeme of { - 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 - }} + cont (mk_qvar_token mod lexeme) new_buf + -- wrong, but arguably morally right: M... is now a qvarsym + } | otherwise = let @@ -1002,6 +1002,8 @@ 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 2be5030..ce4f71b 100644 --- a/ghc/compiler/parser/ParseUtil.lhs +++ b/ghc/compiler/parser/ParseUtil.lhs @@ -14,10 +14,6 @@ module ParseUtil ( , mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp , groupBindings - , checkAs - , checkHiding - , checkQualified - , checkPrec -- String -> P String , checkCallConv -- FAST_STRING -> P CallConv , checkContext -- HsType -> P HsContext @@ -37,9 +33,10 @@ module ParseUtil ( , funTyCon_RDR -- pseudo-keywords, in var and tyvar forms (all :: RdrName) - , forall_var_RDR + , as_var_RDR, hiding_var_RDR, qualified_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 @@ -72,9 +69,6 @@ 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 "), @@ -83,18 +77,6 @@ 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 @@ -446,18 +428,27 @@ 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 f97ff96..3348da9 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.8 1999/06/28 15:42:33 simonmar Exp $ +$Id: Parser.y,v 1.9 1999/06/28 16:42:23 simonmar Exp $ Haskell grammar. @@ -61,6 +61,7 @@ Conflicts: 14 shift/reduce %token '_' { ITunderscore } -- Haskell keywords + 'as' { ITas } 'case' { ITcase } 'class' { ITclass } 'data' { ITdata } @@ -68,6 +69,7 @@ Conflicts: 14 shift/reduce 'deriving' { ITderiving } 'do' { ITdo } 'else' { ITelse } + 'hiding' { IThiding } 'if' { ITif } 'import' { ITimport } 'in' { ITin } @@ -79,6 +81,7 @@ Conflicts: 14 shift/reduce 'module' { ITmodule } 'newtype' { ITnewtype } 'of' { ITof } + 'qualified' { ITqualified } 'then' { ITthen } 'type' { ITtype } 'where' { ITwhere } @@ -857,6 +860,9 @@ 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 } @@ -865,16 +871,14 @@ 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 @@ -966,6 +970,9 @@ 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 419fa11..5d58b40 100644 --- a/ghc/compiler/rename/ParseIface.y +++ b/ghc/compiler/rename/ParseIface.y @@ -69,6 +69,9 @@ import Ratio ( (%) ) 'then' { ITthen } 'type' { ITtype } 'where' { ITwhere } + 'as' { ITas } + 'qualified' { ITqualified } + 'hiding' { IThiding } 'forall' { ITforall } -- GHC extension keywords 'foreign' { ITforeign } @@ -456,6 +459,9 @@ 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