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

Wibbles to the new datacon story; fixes ds002

diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs
index 9c4f03c..7c5cc8c 100644 (file)
--- a/ghc/compiler/deSugar/Desugar.lhs
+++ b/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

diff --git a/ghc/compiler/deSugar/DsGRHSs.lhs b/ghc/compiler/deSugar/DsGRHSs.lhs
index 5f101fc..0aef3a6 100644 (file)
--- a/ghc/compiler/deSugar/DsGRHSs.lhs
+++ b/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

diff --git a/ghc/compiler/deSugar/DsListComp.lhs b/ghc/compiler/deSugar/DsListComp.lhs
index f35a0a4..9824aa3 100644 (file)
--- a/ghc/compiler/deSugar/DsListComp.lhs
+++ b/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    ->