[project @ 2003-02-19 13:05:45 by simonpj]

Wibbles to the new datacon story; fixes ds002

ghc/compiler/deSugar/Desugar.lhs

@@ -129,10 +129,10 @@ deSugar hsc_env pcs
     hpt      = hsc_HPT hsc_env
     lookup n = case lookupType hpt pte n of {
 		 Just v -> v ;
-		 other -> 
+		 other  -> 
 	       case lookupNameEnv type_env n of
 		 Just v -> v ;
-		 other	       -> pprPanic "Desugar: lookup:" (ppr n)
+		 other	-> pprPanic "Desugar: lookup:" (ppr n)
                }
 
 deSugarExpr :: HscEnv

ghc/compiler/deSugar/DsGRHSs.lhs

@@ -18,8 +18,10 @@ import Type		( Type )
 
 import DsMonad
 import DsUtils
+import Unique		( Uniquable(..) )
 import PrelInfo		( nON_EXHAUSTIVE_GUARDS_ERROR_ID )
-import PrelNames	( otherwiseIdKey, trueDataConKey, hasKey )
+import TysWiredIn	( trueDataConId )
+import PrelNames	( otherwiseIdKey, hasKey )
 \end{code}
 
 @dsGuarded@ is used for both @case@ expressions and pattern bindings.
@@ -85,7 +87,9 @@ matchGuard [ResultStmt expr locn] ctx
 	-- Turn an "otherwise" guard is a no-op
 matchGuard (ExprStmt (HsVar v) _ _ : stmts) ctx
   |  v `hasKey` otherwiseIdKey
-  || v `hasKey` trueDataConKey
+  || v `hasKey` getUnique trueDataConId	
+	-- trueDataConId doesn't have the same 
+	-- unique as trueDataCon
   = matchGuard stmts ctx
 
 matchGuard (ExprStmt expr _ locn : stmts) ctx

ghc/compiler/deSugar/DsListComp.lhs

@@ -29,12 +29,12 @@ import Var              ( Id )
 import Type		( mkTyVarTy, mkFunTys, mkFunTy, Type,
 			  splitTyConApp_maybe )
 import TysPrim		( alphaTyVar )
-import TysWiredIn	( nilDataCon, consDataCon, unitDataConId, unitTy,
+import TysWiredIn	( nilDataCon, consDataCon, trueDataConId, falseDataConId, 
+			  unitDataConId, unitTy,
 			  mkListTy, mkTupleTy )
 import Match		( matchSimply )
-import PrelNames	( trueDataConName, falseDataConName, foldrName,
-			  buildName, replicatePName, mapPName, filterPName,
-			  zipPName, crossPName, parrTyConName ) 
+import PrelNames	( foldrName, buildName, replicatePName, mapPName, 
+			  filterPName, zipPName, crossPName, parrTyConName ) 
 import PrelInfo		( pAT_ERROR_ID )
 import SrcLoc		( noSrcLoc )
 import Panic		( panic )
@@ -384,15 +384,13 @@ dePArrComp (ExprStmt b _ _ : qs) pa cea =
 --    <<[:e' | qs:]>> (pa, p) (crossP ea ef)
 --
 dePArrComp (BindStmt p e _ : qs) pa cea =
-  dsLookupGlobalId falseDataConName			  `thenDs` \falseId ->
-  dsLookupGlobalId trueDataConName			  `thenDs` \trueId ->
   dsLookupGlobalId filterPName			  `thenDs` \filterP ->
   dsLookupGlobalId crossPName			  `thenDs` \crossP  ->
-  dsExpr e						  `thenDs` \ce      ->
+  dsExpr e					  `thenDs` \ce      ->
   let ty'cea = parrElemType cea
       ty'ce  = parrElemType ce
-      false  = Var falseId
-      true   = Var trueId
+      false  = Var falseDataConId
+      true   = Var trueDataConId
   in
   newSysLocalDs ty'ce					  `thenDs` \v       ->
   matchSimply (Var v) (StmtCtxt PArrComp) p true false      `thenDs` \pred    ->