import qualified DsMeta
#endif
import HsSyn ( HsExpr(..), LHsExpr, HsLit(..), ArithSeqInfo(..), recBindFields,
import qualified DsMeta
#endif
import HsSyn ( HsExpr(..), LHsExpr, HsLit(..), ArithSeqInfo(..), recBindFields,
- HsMatchContext(..), HsRecordBinds, mkHsApp, nlHsVar,
- nlHsApp )
+ HsMatchContext(..), HsRecordBinds, mkHsApp, nlHsVar )
import TcHsSyn ( hsLitType, mkHsDictApp, mkHsTyApp, (<$>) )
import TcRnMonad
import TcUnify ( Expected(..), newHole, zapExpectedType, zapExpectedTo, tcSubExp, tcGen,
import TcHsSyn ( hsLitType, mkHsDictApp, mkHsTyApp, (<$>) )
import TcRnMonad
import TcUnify ( Expected(..), newHole, zapExpectedType, zapExpectedTo, tcSubExp, tcGen,
tcSplitFunTys, tcSplitTyConApp, mkTyVarTys,
isSigmaTy, mkFunTy, mkFunTys,
mkTyConApp, tyVarsOfTypes, isLinearPred,
tcSplitFunTys, tcSplitTyConApp, mkTyVarTys,
isSigmaTy, mkFunTy, mkFunTys,
mkTyConApp, tyVarsOfTypes, isLinearPred,
import FieldLabel ( FieldLabel, fieldLabelName, fieldLabelType, fieldLabelTyCon )
import Id ( idType, recordSelectorFieldLabel, isRecordSelector )
import DataCon ( DataCon, dataConFieldLabels, dataConStrictMarks, dataConWrapId )
import FieldLabel ( FieldLabel, fieldLabelName, fieldLabelType, fieldLabelTyCon )
import Id ( idType, recordSelectorFieldLabel, isRecordSelector )
import DataCon ( DataCon, dataConFieldLabels, dataConStrictMarks, dataConWrapId )
-- type scheme. We enforce this by creating a fresh
-- type variable as its type. (Because res_ty may not
-- be a tau-type.)
-- type scheme. We enforce this by creating a fresh
-- type variable as its type. (Because res_ty may not
-- be a tau-type.)
newIPDict (IPOccOrigin ip) ip ip_ty `thenM` \ (ip', inst) ->
extendLIE inst `thenM_`
tcSubExp res_ty ip_ty `thenM` \ co_fn ->
newIPDict (IPOccOrigin ip) ip ip_ty `thenM` \ (ip', inst) ->
extendLIE inst `thenM_`
tcSubExp res_ty ip_ty `thenM` \ co_fn ->
tcHsSigType ExprSigCtxt poly_ty `thenM` \ sig_tc_ty ->
tcThingWithSig sig_tc_ty (tcCheckRho expr) res_ty `thenM` \ (co_fn, expr') ->
returnM (co_fn <$> unLoc expr')
tcHsSigType ExprSigCtxt poly_ty `thenM` \ sig_tc_ty ->
tcThingWithSig sig_tc_ty (tcCheckRho expr) res_ty `thenM` \ (co_fn, expr') ->
returnM (co_fn <$> unLoc expr')
newOverloadedLit (LiteralOrigin lit) lit res_ty' `thenM` \ lit_expr ->
returnM (unLoc lit_expr) -- ToDo: nasty unLoc
newOverloadedLit (LiteralOrigin lit) lit res_ty' `thenM` \ lit_expr ->
returnM (unLoc lit_expr) -- ToDo: nasty unLoc
tcDoStmts do_or_lc stmts method_names res_ty' `thenM` \ (stmts', methods') ->
returnM (HsDo do_or_lc stmts' methods' res_ty')
tcDoStmts do_or_lc stmts method_names res_ty' `thenM` \ (stmts', methods') ->
returnM (HsDo do_or_lc stmts' methods' res_ty')