[project @ 1999-06-28 15:42:33 by simonmar]

Fix some pretty subtle bugs in the lexing of qualified names.

diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index 25aa14c..727039c 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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") }