%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[TcExpr]{Typecheck an expression}
#ifdef GHCI /* Only if bootstrapped */
import {-# SOURCE #-} TcSplice( tcSpliceExpr, tcBracket )
-import HsSyn ( nlHsVar )
-import Id ( Id, idName )
-import Name ( isExternalName )
-import TcType ( isTauTy )
-import TcEnv ( checkWellStaged )
-import HsSyn ( nlHsApp )
import qualified DsMeta
#endif
-import HsSyn ( HsExpr(..), LHsExpr, ArithSeqInfo(..), recBindFields,
- HsMatchContext(..), HsRecordBinds, mkHsWrap,
- mkHsApp, mkLHsWrap )
-import TcHsSyn ( hsLitType )
+import HsSyn
+import TcHsSyn
import TcRnMonad
-import TcUnify ( tcInfer, tcSubExp, tcFunResTy, tcGen, boxyUnify, subFunTys, zapToMonotype, stripBoxyType,
- boxySplitListTy, boxySplitTyConApp, wrapFunResCoercion, preSubType,
- unBox )
-import BasicTypes ( Arity, isMarkedStrict )
-import Inst ( newMethodFromName, newIPDict, instCall,
- newMethodWithGivenTy, instStupidTheta )
-import TcBinds ( tcLocalBinds )
-import TcEnv ( tcLookup, tcLookupDataCon, tcLookupField )
-import TcArrows ( tcProc )
-import TcMatches ( tcMatchesCase, tcMatchLambda, tcDoStmts, tcBody,
- TcMatchCtxt(..) )
-import TcHsType ( tcHsSigType, UserTypeCtxt(..) )
-import TcPat ( tcOverloadedLit, addDataConStupidTheta, badFieldCon )
-import TcMType ( tcInstTyVars, newFlexiTyVarTy, newBoxyTyVars,
- readFilledBox, zonkTcTypes )
-import TcType ( TcType, TcSigmaType, TcRhoType, TvSubst,
- BoxySigmaType, BoxyRhoType, ThetaType,
- mkTyVarTys, mkFunTys,
- tcMultiSplitSigmaTy, tcSplitFunTysN,
- tcSplitTyConApp_maybe,
- isSigmaTy, mkFunTy, mkTyConApp, isLinearPred,
- exactTyVarsOfType, exactTyVarsOfTypes,
- zipTopTvSubst, zipOpenTvSubst, substTys, substTyVar
- )
-import {- Kind parts of -}
- Type ( argTypeKind )
-
-import Id ( idType, recordSelectorFieldLabel,
- isRecordSelector, isNaughtyRecordSelector,
- isDataConId_maybe )
-import DataCon ( DataCon, dataConFieldLabels, dataConStrictMarks,
- dataConSourceArity,
- dataConWrapId, isVanillaDataCon, dataConUnivTyVars,
- dataConOrigArgTys )
-import Name ( Name )
-import TyCon ( FieldLabel, tyConStupidTheta, tyConDataCons,
- isEnumerationTyCon )
-import Type ( substTheta, substTy )
-import Var ( TyVar, tyVarKind )
-import VarSet ( emptyVarSet, elemVarSet, unionVarSet )
-import TysWiredIn ( boolTy, parrTyCon, tupleTyCon )
-import PrelNames ( enumFromName, enumFromThenName,
- enumFromToName, enumFromThenToName,
- enumFromToPName, enumFromThenToPName, negateName,
- hasKey
- )
-import PrimOp ( tagToEnumKey )
-
+import TcUnify
+import BasicTypes
+import Inst
+import TcBinds
+import TcEnv
+import TcArrows
+import TcMatches
+import TcHsType
+import TcPat
+import TcMType
+import TcType
+import Id
+import DataCon
+import Name
+import TyCon
+import Type
+import Var
+import VarSet
+import TysWiredIn
+import PrelNames
+import PrimOp
import DynFlags
-import StaticFlags ( opt_NoMethodSharing )
-import HscTypes ( TyThing(..) )
-import SrcLoc ( Located(..), unLoc )
+import StaticFlags
+import HscTypes
+import SrcLoc
import Util
-import ListSetOps ( assocMaybe )
-import Maybes ( catMaybes )
+import ListSetOps
+import Maybes
import Outputable
import FastString
-
-#ifdef DEBUG
-import TyCon ( tyConArity )
-#endif
\end{code}
%************************************************************************
tcPolyExprNC expr res_ty
| isSigmaTy res_ty
- = do { (gen_fn, expr') <- tcGen res_ty emptyVarSet (tcPolyExprNC expr)
+ = do { (gen_fn, expr') <- tcGen res_ty emptyVarSet (\_ -> tcPolyExprNC expr)
-- Note the recursive call to tcPolyExpr, because the
-- type may have multiple layers of for-alls
; return (mkLHsWrap gen_fn expr') }
tcExpr in_expr@(ExprWithTySig expr sig_ty) res_ty
= do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
- ; expr' <- tcPolyExpr expr sig_tc_ty
+
+ -- Remember to extend the lexical type-variable environment
+ ; (gen_fn, expr') <- tcGen sig_tc_ty emptyVarSet (\ skol_tvs res_ty ->
+ tcExtendTyVarEnv2 (hsExplicitTvs sig_ty `zip` mkTyVarTys skol_tvs) $
+ tcPolyExprNC expr res_ty)
+
; co_fn <- tcSubExp sig_tc_ty res_ty
- ; return (mkHsWrap co_fn (ExprWithTySigOut expr' sig_ty)) }
+ ; return (mkHsWrap co_fn (ExprWithTySigOut (mkLHsWrap gen_fn expr') sig_ty)) }
tcExpr (HsType ty) res_ty
= failWithTc (text "Can't handle type argument:" <+> ppr ty)
= do { co_fn <- instCall orig tys theta
; go False (HsWrap co_fn fun) prs }
- -- Hack Alert (want_method_inst)!
-- See Note [No method sharing]
- -- If f :: (%x :: T) => Int -> Int
- -- Then if we have two separate calls, (f 3, f 4), we cannot
- -- make a method constraint that then gets shared, thus:
- -- let m = f %x in (m 3, m 4)
- -- because that loses the linearity of the constraint.
- -- The simplest thing to do is never to construct a method constraint
- -- in the first place that has a linear implicit parameter in it.
- want_method_inst theta = not (null theta) -- Overloaded
- && not (any isLinearPred theta) -- Not linear
+ want_method_inst theta = not (null theta) -- Overloaded
&& not opt_NoMethodSharing
- -- See Note [No method sharing] below
\end{code}
Note [Multiple instantiation]