\begin{code}
module TcSimplify(
- simplifyInfer, simplifySuperClass,
+ simplifyInfer,
simplifyDefault, simplifyDeriv, simplifyBracket,
simplifyRule, simplifyTop, simplifyInteractive
) where
import Data.List ( partition )
import Outputable
import FastString
-import Control.Monad ( unless )
\end{code}
\begin{code}
simplifyTop :: WantedConstraints -> TcM (Bag EvBind)
-- Simplify top-level constraints
--- Usually these will be implications, when there is
--- nothing to quanitfy we don't wrap in a degenerate implication,
--- so we do that here instead
+-- Usually these will be implications,
+-- but when there is nothing to quantify we don't wrap
+-- in a degenerate implication, so we do that here instead
simplifyTop wanteds
= simplifyCheck SimplCheck wanteds
*********************************************************************************
* *
-* Superclasses *
-* *
-***********************************************************************************
-
-When constructing evidence for superclasses in an instance declaration,
- * we MUST have the "self" dictionary available
-
-Moreover, we must *completely* solve the constraints right now,
-not wrap them in an implication constraint to solve later. Why?
-Because when that implication constraint is solved there may
-be some unrelated other solved top-level constraints that
-recursively depend on the superclass we are building. Consider
- class Ord a => C a where
- instance C [Int] where ...
-Then we get
- dCListInt :: C [Int]
- dCListInt = MkC $cNum ...
-
- $cNum :: Ord [Int] -- The superclass
- $cNum = let self = dCListInt in <solve Ord [Int]>
-
-Now, if there is some *other* top-level constraint solved
-looking like
- foo :: Ord [Int]
- foo = scsel dCInt
-we must not solve the (Ord [Int]) wanted from foo!
-
-Note [Dependencies in self dictionaries]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Moreover, notice that when solving for a superclass, we record the dependency of
-self on the superclass. This is because this dependency is not evident in the
-EvBind of the self dictionary, which only involves a call to a DFun. Example:
-
-class A a => C a
-instance B a => C a
-
-When we check the instance declaration, we pass in a self dictionary that is merely
- self = dfun b
-But we will be asked to solve that from:
- [Given] d : B a
- [Derived] self : C a
-We can show:
- [Wanted] sc : A a
-The problem is that self *depends* on the sc variable, but that is not apparent in
-the binding self = dfun b. So we record the extra dependency, using the evidence bind:
- EvBind self (EvDFunApp dfun [b] [b,sc])
-It is these dependencies that are the ''true'' dependencies in an EvDFunApp, and those
-that we must chase in function isGoodRecEv (in TcSMonad)
-
-\begin{code}
-simplifySuperClass :: [TyVar]
- -> [EvVar] -- givens
- -> EvVar -- the superclass we must solve for
- -> EvBind -- the 'self' evidence bind
- -> TcM TcEvBinds
--- Post:
--- ev_binds <- simplifySuperClasses tvs inst_givens sc_dict self_ev_bind
--- Then:
--- 1) ev_binds already contains self_ev_bind
--- 2) if successful then ev_binds contains binding for
--- the wanted superclass, sc_dict
-simplifySuperClass tvs inst_givens sc_dict (EvBind self_dict self_ev)
- = do { giv_loc <- getCtLoc InstSkol -- For the inst_givens
- ; want_loc <- getCtLoc ScOrigin -- As wanted/derived (for the superclass and self)
- ; lcl_env <- getLclTypeEnv
-
- -- Record the dependency of self_dict to sc_dict, see Note [Dependencies in self dictionaries]
- ; let wanted = unitBag $ WcEvVar $ WantedEvVar sc_dict want_loc
- self_ev_with_dep
- = case self_ev of
- EvDFunApp df tys insts deps -> EvDFunApp df tys insts (sc_dict:deps)
- _ -> panic "Self-dictionary not EvDFunApp!"
-
- -- And solve for it
- ; ((unsolved_flats, unsolved_implics), frozen_errors, ev_binds)
- <- runTcS SimplCheck NoUntouchables $
- do { -- Record a binding for self_dict that *depends on sc_dict*
- -- And canonicalise self_dict (which adds its superclasses)
- -- with a Derived origin, which in turn triggers the
- -- goodRecEv recursive-evidence check
- ; setEvBind self_dict self_ev_with_dep
- -- The rest is just like solveImplication
- ; let cts = mapBag (\d -> (Given giv_loc, d)) (listToBag inst_givens)
- `snocBag` (Derived want_loc DerSelf, self_dict)
- ; inert <- solveInteract emptyInert cts
-
- ; solveWanteds inert wanted }
-
- -- For error reporting, conjure up a fake implication,
- -- so that we get decent error messages
- ; let implic = Implic { ic_untch = NoUntouchables
- , ic_env = lcl_env
- , ic_skols = mkVarSet tvs
- , ic_given = inst_givens
- , ic_wanted = mapBag WcEvVar unsolved_flats
- , ic_scoped = panic "super1"
- , ic_binds = panic "super2"
- , ic_loc = giv_loc }
- ; ASSERT (isEmptyBag unsolved_implics) -- Impossible to have any implications!
- unless (isEmptyBag unsolved_flats) $
- reportUnsolved (emptyBag, unitBag implic) frozen_errors
-
- ; return (EvBinds ev_binds) }
-\end{code}
-
-
-*********************************************************************************
-* *
* RULES *
* *
***********************************************************************************
Note [Simplifying RULE lhs constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-On the LHS of transformation rules we only simplify only equalitis,
+On the LHS of transformation rules we only simplify only equalities,
but not dictionaries. We want to keep dictionaries unsimplified, to
serve as the available stuff for the RHS of the rule. We *do* want to
simplify equalities, however, to detect ill-typed rules that cannot be
projects / ghc-hetmet.git / blobdiff