projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Super-monster patch implementing the new typechecker -- at last
[ghc-hetmet.git]
/
compiler
/
deSugar
/
DsUtils.lhs
diff --git
a/compiler/deSugar/DsUtils.lhs
b/compiler/deSugar/DsUtils.lhs
index
9a0e752
..
4c05f5e
100644
(file)
--- a/
compiler/deSugar/DsUtils.lhs
+++ b/
compiler/deSugar/DsUtils.lhs
@@
-221,7
+221,7
@@
wrapBinds ((new,old):prs) e = wrapBind new old (wrapBinds prs e)
wrapBind :: Var -> Var -> CoreExpr -> CoreExpr
wrapBind new old body -- Can deal with term variables *or* type variables
| new==old = body
wrapBind :: Var -> Var -> CoreExpr -> CoreExpr
wrapBind new old body -- Can deal with term variables *or* type variables
| new==old = body
- | isTyVar new = Let (mkTyBind new (mkTyVarTy old)) body
+ | isTyCoVar new = Let (mkTyBind new (mkTyVarTy old)) body
| otherwise = Let (NonRec new (Var old)) body
seqVar :: Var -> CoreExpr -> CoreExpr
| otherwise = Let (NonRec new (Var old)) body
seqVar :: Var -> CoreExpr -> CoreExpr
@@
-419,7
+419,7
@@
But that is bad for two reasons:
Seq is very, very special! So we recognise it right here, and desugar to
case x of _ -> case y of _ -> (# x,y #)
Seq is very, very special! So we recognise it right here, and desugar to
case x of _ -> case y of _ -> (# x,y #)
-Note [Desugaring seq (2)] cf Trac #2231
+Note [Desugaring seq (2)] cf Trac #2273
~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
let chp = case b of { True -> fst x; False -> 0 }
~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
let chp = case b of { True -> fst x; False -> 0 }
@@
-447,10
+447,14
@@
should have said explicitly
But that's painful. So the code here does a little hack to make seq
more robust: a saturated application of 'seq' is turned *directly* into
But that's painful. So the code here does a little hack to make seq
more robust: a saturated application of 'seq' is turned *directly* into
-the case expression. So we desugar to:
+the case expression, thus:
+ x `seq` e2 ==> case x of x -> e2 -- Note shadowing!
+ e1 `seq` e2 ==> case x of _ -> e2
+
+So we desugar our example to:
let chp = case b of { True -> fst x; False -> 0 }
case chp of chp { I# -> ...chp... }
let chp = case b of { True -> fst x; False -> 0 }
case chp of chp { I# -> ...chp... }
-Notice the shadowing of the case binder! And now all is well.
+And now all is well.
The reason it's a hack is because if you define mySeq=seq, the hack
won't work on mySeq.
The reason it's a hack is because if you define mySeq=seq, the hack
won't work on mySeq.
@@
-471,7
+475,7
@@
mkCoreAppDs (Var f `App` Type ty1 `App` Type ty2 `App` arg1) arg2
where
case_bndr = case arg1 of
Var v1 | isLocalId v1 -> v1 -- Note [Desugaring seq (2) and (3)]
where
case_bndr = case arg1 of
Var v1 | isLocalId v1 -> v1 -- Note [Desugaring seq (2) and (3)]
- _ -> mkWildBinder ty1
+ _ -> mkWildValBinder ty1
mkCoreAppDs fun arg = mkCoreApp fun arg -- The rest is done in MkCore
mkCoreAppDs fun arg = mkCoreApp fun arg -- The rest is done in MkCore
@@
-546,8
+550,7
@@
mkSelectorBinds pat val_expr
error_expr <- mkErrorAppDs iRREFUT_PAT_ERROR_ID tuple_ty (ppr pat)
tuple_expr <- matchSimply val_expr PatBindRhs pat local_tuple error_expr
tuple_var <- newSysLocalDs tuple_ty
error_expr <- mkErrorAppDs iRREFUT_PAT_ERROR_ID tuple_ty (ppr pat)
tuple_expr <- matchSimply val_expr PatBindRhs pat local_tuple error_expr
tuple_var <- newSysLocalDs tuple_ty
- let
- mk_tup_bind binder
+ let mk_tup_bind binder
= (binder, mkTupleSelector binders binder tuple_var (Var tuple_var))
return ( (tuple_var, tuple_expr) : map mk_tup_bind binders )
where
= (binder, mkTupleSelector binders binder tuple_var (Var tuple_var))
return ( (tuple_var, tuple_expr) : map mk_tup_bind binders )
where
@@
-600,7
+603,7
@@
mkLHsVarPatTup bs = mkLHsPatTup (map nlVarPat bs)
mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
-- A vanilla tuple pattern simply gets its type from its sub-patterns
mkVanillaTuplePat pats box
mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
-- A vanilla tuple pattern simply gets its type from its sub-patterns
mkVanillaTuplePat pats box
- = TuplePat pats box (mkTupleTy box (length pats) (map hsLPatType pats))
+ = TuplePat pats box (mkTupleTy box (map hsLPatType pats))
-- The Big equivalents for the source tuple expressions
mkBigLHsVarTup :: [Id] -> LHsExpr Id
-- The Big equivalents for the source tuple expressions
mkBigLHsVarTup :: [Id] -> LHsExpr Id