tcSimplifyDeriv, tcSimplifyDefault,
bindInstsOfLocalFuns,
- tcSimplifyStagedExpr,
-
misMatchMsg
) where
<.> mkWpTyApps eq_cotvs
<.> mkWpTyApps (mkTyVarTys all_tvs)
bind | [dict_irred_id] <- dict_irred_ids
- = VarBind dict_irred_id rhs
+ = mkVarBind dict_irred_id rhs
| otherwise
- = PatBind { pat_lhs = lpat
+ = L span $
+ PatBind { pat_lhs = lpat
, pat_rhs = unguardedGRHSs rhs
, pat_rhs_ty = hsLPatType lpat
, bind_fvs = placeHolderNames
}
; traceTc $ text "makeImplicationBind" <+> ppr implic_inst
- ; return ([implic_inst], unitBag (L span bind))
+ ; return ([implic_inst], unitBag bind)
}
-----------------------------------------------------------
eq_cotvs = map instToVar extra_eq_givens
dict_ids = map instToId extra_dict_givens
- -- Note [Always inline implication constraints]
- wrap_inline | null dict_ids = idHsWrapper
- | otherwise = WpInline
- co = wrap_inline
- <.> mkWpTyLams tvs
+ co = mkWpTyLams tvs
<.> mkWpTyLams eq_cotvs
<.> mkWpLams dict_ids
<.> WpLet (binds `unionBags` bind)
. filter (not . isEqInst)
$ wanteds
payload = mkBigLHsTup dict_bndrs
-
; traceTc (vcat [text "reduceImplication" <+> ppr name,
ppr simpler_implic_insts,
text "->" <+> ppr rhs])
- ; return (unitBag (L loc (VarBind (instToId orig_implic) rhs)),
+ ; return (unitBag (L loc (VarBind { var_id= instToId orig_implic
+ , var_rhs = rhs
+ , var_inline = notNull dict_ids }
+ -- See Note [Always inline implication constraints]
+ )),
simpler_implic_insts)
}
}
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}
%************************************************************************