From f761d6d07c3948fe7356170b5516687e1d6c4f33 Mon Sep 17 00:00:00 2001 From: simonpj Date: Wed, 19 Feb 2003 13:05:47 +0000 Subject: [PATCH] [project @ 2003-02-19 13:05:45 by simonpj] Wibbles to the new datacon story; fixes ds002 --- ghc/compiler/deSugar/Desugar.lhs | 4 ++-- ghc/compiler/deSugar/DsGRHSs.lhs | 8 ++++++-- ghc/compiler/deSugar/DsListComp.lhs | 16 +++++++--------- 3 files changed, 15 insertions(+), 13 deletions(-) diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs index 9c4f03c..7c5cc8c 100644 --- 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 --- 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 --- 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 -> -- 1.7.10.4