From cd19f02b2c4b63bb36522279b88eed42c142fef3 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Tue, 11 Mar 2003 09:05:00 +0000
Subject: [PATCH] [project @ 2003-03-11 09:04:59 by simonpj] Buglet in
 external-core parsing

---
 ghc/compiler/parser/ParserCore.y |   14 +++++++++-----
 ghc/compiler/parser/RdrHsSyn.lhs |   11 ++++++-----
 2 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/ghc/compiler/parser/ParserCore.y b/ghc/compiler/parser/ParserCore.y
index 9318892..af591fa 100644
--- a/ghc/compiler/parser/ParserCore.y
+++ b/ghc/compiler/parser/ParserCore.y
@@ -79,11 +79,15 @@ tdef	:: { RdrNameHsDecl }
 	: '%data' q_tc_name tbinds '=' '{' cons1 '}'
                 { TyClD (mkTyData DataType ([], $2, $3) (DataCons $6) Nothing noSrcLoc) }
 	| '%newtype' q_tc_name tbinds trep 
-		{ TyClD (mkTyData NewType ([], $2, $3) ($4 $2 $3) Nothing noSrcLoc) }
-
-trep    :: { (RdrName -> [HsTyVarBndr RdrName] -> DataConDetails (ConDecl RdrName)) }
-        : {- empty -}   { (\ x ts -> Unknown) }
-        | '=' ty        { (\ x ts -> DataCons [ConDecl x ts [] (PrefixCon [unbangedType $2]) noSrcLoc]) }
+		{ TyClD (mkTyData NewType ([], $2, $3) ($4 $2) Nothing noSrcLoc) }
+
+-- For a newtype we have to invent a fake data constructor name
+-- It doesn't matter what it is, because it won't be used
+trep    :: { (RdrName -> DataConDetails (ConDecl RdrName)) }
+        : {- empty -}   { (\ tc_name -> Unknown) }
+        | '=' ty        { (\ tc_name -> let { dc_name  = setRdrNameSpace tc_name dataName ;
+			                      con_info = PrefixCon [unbangedType $2] }
+			                in DataCons [ConDecl dc_name [] [] con_info noSrcLoc]) }
 
 tbind	:: { HsTyVarBndr RdrName }
 	:  name                    { IfaceTyVar $1 liftedTypeKind }
diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 729b416..eb9a8a4 100644
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -516,11 +516,12 @@ checkInstType t
 	      	returnP (HsForAllTy Nothing [] dict_ty)
 
 checkTyVars :: [RdrNameHsType] -> P [RdrNameHsTyVar]
-checkTyVars tvs = mapP chk tvs
-	        where
-		  chk (HsKindSig (HsTyVar tv) k) = returnP (IfaceTyVar tv k)
-		  chk (HsTyVar tv) 	         = returnP (UserTyVar tv)
-		  chk other	 		 = parseError "Type found where type variable expected"
+checkTyVars tvs 
+  = mapP chk tvs
+  where
+    chk (HsKindSig (HsTyVar tv) k) | isRdrTyVar tv = returnP (IfaceTyVar tv k)
+    chk (HsTyVar tv) 	           | isRdrTyVar tv = returnP (UserTyVar tv)
+    chk other	 		   = parseError "Type found where type variable expected"
 
 checkTyClHdr :: RdrNameHsType -> P (RdrName, [RdrNameHsTyVar])
 -- The header of a type or class decl should look like
-- 
1.7.10.4