summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
d7a583e)
Wibbles to the new datacon story; fixes ds002
hpt = hsc_HPT hsc_env
lookup n = case lookupType hpt pte n of {
Just v -> v ;
hpt = hsc_HPT hsc_env
lookup n = case lookupType hpt pte n of {
Just v -> v ;
case lookupNameEnv type_env n of
Just v -> v ;
case lookupNameEnv type_env n of
Just v -> v ;
- other -> pprPanic "Desugar: lookup:" (ppr n)
+ other -> pprPanic "Desugar: lookup:" (ppr n)
import DsMonad
import DsUtils
import DsMonad
import DsUtils
+import Unique ( Uniquable(..) )
import PrelInfo ( nON_EXHAUSTIVE_GUARDS_ERROR_ID )
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.
\end{code}
@dsGuarded@ is used for both @case@ expressions and pattern bindings.
-- Turn an "otherwise" guard is a no-op
matchGuard (ExprStmt (HsVar v) _ _ : stmts) ctx
| v `hasKey` otherwiseIdKey
-- 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
= matchGuard stmts ctx
matchGuard (ExprStmt expr _ locn : stmts) ctx
import Type ( mkTyVarTy, mkFunTys, mkFunTy, Type,
splitTyConApp_maybe )
import TysPrim ( alphaTyVar )
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 )
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 )
import PrelInfo ( pAT_ERROR_ID )
import SrcLoc ( noSrcLoc )
import Panic ( panic )
-- <<[:e' | qs:]>> (pa, p) (crossP ea ef)
--
dePArrComp (BindStmt p e _ : 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 ->
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
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 ->
in
newSysLocalDs ty'ce `thenDs` \v ->
matchSimply (Var v) (StmtCtxt PArrComp) p true false `thenDs` \pred ->