X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSimplify.lhs;h=932cb68f425ba706a4114cbd1a1c2e3396a72c60;hp=cb6021ccf429a81927e02ac693fa01c8ab793608;hb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569;hpb=fbbd2bfaa54b4424edc70cbc4bd4ff29e324f6a2 diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index cb6021c..932cb68 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -16,6 +16,8 @@ module TcSimplify ( tcSimplifyDeriv, tcSimplifyDefault, bindInstsOfLocalFuns, + + tcSimplifyStagedExpr, misMatchMsg ) where @@ -58,6 +60,7 @@ import Util import SrcLoc import DynFlags import FastString + import Control.Monad import Data.List \end{code} @@ -861,7 +864,7 @@ Note [NO TYVARS] The excitement comes when simplifying the bindings for h. Initially try to simplify {y @ [[t1]] t2, 0 @ t1}, with initial qtvs = {t2}. -From this we get t1:=:t2, but also various bindings. We can't forget +From this we get t1~t2, but also various bindings. We can't forget the bindings (because of [LOOP]), but in fact t1 is what g is polymorphic in. @@ -977,7 +980,7 @@ makeImplicationBind :: InstLoc -> [TcTyVar] -- (ir1, .., irn) = f qtvs givens -- where f is (evidence for) the new implication constraint -- f :: forall qtvs. givens => (ir1, .., irn) --- qtvs includes coercion variables. +-- qtvs includes coercion variables -- -- This binding must line up the 'rhs' in reduceImplication makeImplicationBind loc all_tvs @@ -997,7 +1000,7 @@ makeImplicationBind loc all_tvs name = mkInternalName uniq (mkVarOcc "ic") span implic_inst = ImplicInst { tci_name = name, tci_tyvars = all_tvs, - tci_given = (eq_givens ++ dict_givens), + tci_given = eq_givens ++ dict_givens, -- same order as binders tci_wanted = irreds, tci_loc = loc } @@ -3014,6 +3017,26 @@ tcSimplifyDefault theta = do doc = ptext (sLit "default declaration") \end{code} +@tcSimplifyStagedExpr@ performs a simplification but does so at a new +stage. This is used when typechecking annotations and splices. + +\begin{code} + +tcSimplifyStagedExpr :: ThStage -> TcM a -> TcM (a, TcDictBinds) +-- Type check an expression that runs at a top level stage as if +-- it were going to be spliced and then simplify it +tcSimplifyStagedExpr stage tc_action + = setStage stage $ do { + -- Typecheck the expression + (thing', lie) <- getLIE tc_action + + -- Solve the constraints + ; const_binds <- tcSimplifyTop lie + + ; return (thing', const_binds) } + +\end{code} + %************************************************************************ %* *