[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.

4 files changed, 42 insertions, 36 deletions

diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index 727039c7d8..d705043da6 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.<sym>
        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 2be5030193..ce4f71bfcf 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 f97ff966db..3348da9d3c 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 419fa11947..5d58b407a6 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") }