Commit f761d6d0 authored by simonpj's avatar simonpj

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

Wibbles to the new datacon story; fixes ds002
parent d7a583e3
......@@ -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
......
......@@ -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
......
......@@ -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 ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment