projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
This BIG PATCH contains most of the work for the New Coercion Representation
[ghc-hetmet.git]
/
compiler
/
deSugar
/
DsBinds.lhs
diff --git
a/compiler/deSugar/DsBinds.lhs
b/compiler/deSugar/DsBinds.lhs
index
815c0d1
..
85883dc
100644
(file)
--- a/
compiler/deSugar/DsBinds.lhs
+++ b/
compiler/deSugar/DsBinds.lhs
@@
-11,7
+11,7
@@
lower levels it is preserved with @let@/@letrec@s).
\begin{code}
module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
\begin{code}
module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
- dsHsWrapper, dsTcEvBinds, dsEvBinds, wrapDsEvBinds,
+ dsHsWrapper, dsTcEvBinds, dsEvBinds, wrapDsEvBinds,
DsEvBind(..), AutoScc(..)
) where
DsEvBind(..), AutoScc(..)
) where
@@
-36,6
+36,7
@@
import Digraph
import TcType
import Type
import TcType
import Type
+import Coercion
import TysPrim ( anyTypeOfKind )
import CostCentre
import Module
import TysPrim ( anyTypeOfKind )
import CostCentre
import Module
@@
-230,8
+231,8
@@
dsEvBinds bs = return (map dsEvGroup sccs)
free_vars_of :: EvTerm -> [EvVar]
free_vars_of (EvId v) = [v]
free_vars_of :: EvTerm -> [EvVar]
free_vars_of (EvId v) = [v]
- free_vars_of (EvCast v co) = v : varSetElems (tyVarsOfType co)
- free_vars_of (EvCoercion co) = varSetElems (tyVarsOfType co)
+ free_vars_of (EvCast v co) = v : varSetElems (tyCoVarsOfCo co)
+ free_vars_of (EvCoercion co) = varSetElems (tyCoVarsOfCo co)
free_vars_of (EvDFunApp _ _ vs) = vs
free_vars_of (EvSuperClass d _) = [d]
free_vars_of (EvDFunApp _ _ vs) = vs
free_vars_of (EvSuperClass d _) = [d]
@@
-247,7
+248,7
@@
dsEvGroup (AcyclicSCC (EvBind co_var (EvSuperClass dict n)))
(arg_tys, _) = splitFunTys rho
bndrs = ex_tvs ++ map mk_wild_pred (theta `zip` [0..])
++ map mkWildValBinder arg_tys
(arg_tys, _) = splitFunTys rho
bndrs = ex_tvs ++ map mk_wild_pred (theta `zip` [0..])
++ map mkWildValBinder arg_tys
- mk_wild_pred (p, i) | i==n = ASSERT( p `tcEqPred` (coVarPred co_var))
+ mk_wild_pred (p, i) | i==n = ASSERT( p `eqPred` (coVarPred co_var))
co_var
| otherwise = mkWildEvBinder p
co_var
| otherwise = mkWildEvBinder p
@@
-263,7
+264,7
@@
dsEvTerm :: EvTerm -> CoreExpr
dsEvTerm (EvId v) = Var v
dsEvTerm (EvCast v co) = Cast (Var v) co
dsEvTerm (EvDFunApp df tys vars) = Var df `mkTyApps` tys `mkVarApps` vars
dsEvTerm (EvId v) = Var v
dsEvTerm (EvCast v co) = Cast (Var v) co
dsEvTerm (EvDFunApp df tys vars) = Var df `mkTyApps` tys `mkVarApps` vars
-dsEvTerm (EvCoercion co) = Type co
+dsEvTerm (EvCoercion co) = Coercion co
dsEvTerm (EvSuperClass d n)
= ASSERT( isClassPred (classSCTheta cls !! n) )
-- We can only select *dictionary* superclasses
dsEvTerm (EvSuperClass d n)
= ASSERT( isClassPred (classSCTheta cls !! n) )
-- We can only select *dictionary* superclasses
@@
-601,13
+602,9
@@
decomposeRuleLhs bndrs lhs
<+> ptext (sLit "is not bound in RULE lhs"))
2 (ppr opt_lhs)
pp_bndr bndr
<+> ptext (sLit "is not bound in RULE lhs"))
2 (ppr opt_lhs)
pp_bndr bndr
- | isTyVar bndr = ptext (sLit "type variable") <+> ppr bndr
- | isCoVar bndr = ptext (sLit "coercion variable") <+> ppr bndr
- | isDictId bndr = ptext (sLit "constraint") <+> ppr (get_pred bndr)
+ | isTyVar bndr = ptext (sLit "type variable") <+> ppr bndr
+ | isEvVar bndr = ptext (sLit "constraint") <+> ppr bndr <+> dcolon <+> ppr (evVarPred bndr)
| otherwise = ptext (sLit "variable") <+> ppr bndr
| otherwise = ptext (sLit "variable") <+> ppr bndr
-
- get_pred b = ASSERT( isId b ) expectJust "decomposeRuleLhs"
- (tcSplitPredTy_maybe (idType b))
\end{code}
Note [Simplifying the left-hand side of a RULE]
\end{code}
Note [Simplifying the left-hand side of a RULE]
@@
-634,7
+631,6
@@
otherwise we don't match when given an argument like
NB: tcSimplifyRuleLhs is very careful not to generate complicated
dictionary expressions that we might have to match
NB: tcSimplifyRuleLhs is very careful not to generate complicated
dictionary expressions that we might have to match
-
Note [Matching seqId]
~~~~~~~~~~~~~~~~~~~
The desugarer turns (seq e r) into (case e of _ -> r), via a special-case hack
Note [Matching seqId]
~~~~~~~~~~~~~~~~~~~
The desugarer turns (seq e r) into (case e of _ -> r), via a special-case hack