2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 \section[TcExpr]{Typecheck an expression}
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
14 module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC,
15 tcInferRho, tcInferRhoNC,
16 tcSyntaxOp, tcCheckId,
17 addExprErrCtxt ) where
19 #include "HsVersions.h"
21 #ifdef GHCI /* Only if bootstrapped */
22 import {-# SOURCE #-} TcSplice( tcSpliceExpr, tcBracket )
23 import qualified DsMeta
49 import TysPrim( intPrimTy )
50 import PrimOp( tagToEnumKey )
62 %************************************************************************
64 \subsection{Main wrappers}
66 %************************************************************************
69 tcPolyExpr, tcPolyExprNC
70 :: LHsExpr Name -- Expression to type check
71 -> TcSigmaType -- Expected type (could be a polytpye)
72 -> TcM (LHsExpr TcId) -- Generalised expr with expected type
74 -- tcPolyExpr is a convenient place (frequent but not too frequent)
75 -- place to add context information.
76 -- The NC version does not do so, usually because the caller wants
79 tcPolyExpr expr res_ty
80 = addExprErrCtxt expr $
81 do { traceTc "tcPolyExpr" (ppr res_ty); tcPolyExprNC expr res_ty }
83 tcPolyExprNC expr res_ty
84 = do { traceTc "tcPolyExprNC" (ppr res_ty)
85 ; (gen_fn, expr') <- tcGen (GenSkol res_ty) res_ty $ \ _ rho ->
87 ; return (mkLHsWrap gen_fn expr') }
90 tcMonoExpr, tcMonoExprNC
91 :: LHsExpr Name -- Expression to type check
92 -> TcRhoType -- Expected type (could be a type variable)
93 -- Definitely no foralls at the top
96 tcMonoExpr expr res_ty
97 = addErrCtxt (exprCtxt expr) $
98 tcMonoExprNC expr res_ty
100 tcMonoExprNC (L loc expr) res_ty
101 = ASSERT( not (isSigmaTy res_ty) )
103 do { expr' <- tcExpr expr res_ty
104 ; return (L loc expr') }
107 tcInferRho, tcInferRhoNC :: LHsExpr Name -> TcM (LHsExpr TcId, TcRhoType)
108 -- Infer a *rho*-type. This is, in effect, a special case
109 -- for ids and partial applications, so that if
110 -- f :: Int -> (forall a. a -> a) -> Int
112 -- f 3 :: (forall a. a -> a) -> Int
113 -- And that in turn is useful
114 -- (a) for the function part of any application (see tcApp)
115 -- (b) for the special rule for '$'
116 tcInferRho expr = addErrCtxt (exprCtxt expr) (tcInferRhoNC expr)
118 tcInferRhoNC (L loc expr)
120 do { (expr', rho) <- tcInfExpr expr
121 ; return (L loc expr', rho) }
123 tcInfExpr :: HsExpr Name -> TcM (HsExpr TcId, TcRhoType)
124 tcInfExpr (HsVar f) = tcInferId f
125 tcInfExpr (HsPar e) = do { (e', ty) <- tcInferRhoNC e
126 ; return (HsPar e', ty) }
127 tcInfExpr (HsApp e1 e2) = tcInferApp e1 [e2]
128 tcInfExpr e = tcInfer (tcExpr e)
132 %************************************************************************
134 tcExpr: the main expression typechecker
136 %************************************************************************
139 tcExpr :: HsExpr Name -> TcRhoType -> TcM (HsExpr TcId)
140 tcExpr e res_ty | debugIsOn && isSigmaTy res_ty -- Sanity check
141 = pprPanic "tcExpr: sigma" (ppr res_ty $$ ppr e)
143 tcExpr (HsVar name) res_ty = tcCheckId name res_ty
145 tcExpr (HsApp e1 e2) res_ty = tcApp e1 [e2] res_ty
147 tcExpr (HsLit lit) res_ty = do { let lit_ty = hsLitType lit
148 ; tcWrapResult (HsLit lit) lit_ty res_ty }
150 tcExpr (HsPar expr) res_ty = do { expr' <- tcMonoExprNC expr res_ty
151 ; return (HsPar expr') }
153 tcExpr (HsSCC lbl expr) res_ty
154 = do { expr' <- tcMonoExpr expr res_ty
155 ; return (HsSCC lbl expr') }
157 tcExpr (HsTickPragma info expr) res_ty
158 = do { expr' <- tcMonoExpr expr res_ty
159 ; return (HsTickPragma info expr') }
161 tcExpr (HsCoreAnn lbl expr) res_ty
162 = do { expr' <- tcMonoExpr expr res_ty
163 ; return (HsCoreAnn lbl expr') }
165 tcExpr (HsOverLit lit) res_ty
166 = do { lit' <- newOverloadedLit (LiteralOrigin lit) lit res_ty
167 ; return (HsOverLit lit') }
169 tcExpr (NegApp expr neg_expr) res_ty
170 = do { neg_expr' <- tcSyntaxOp NegateOrigin neg_expr
171 (mkFunTy res_ty res_ty)
172 ; expr' <- tcMonoExpr expr res_ty
173 ; return (NegApp expr' neg_expr') }
175 tcExpr (HsIPVar ip) res_ty
176 = do { let origin = IPOccOrigin ip
177 -- Implicit parameters must have a *tau-type* not a
178 -- type scheme. We enforce this by creating a fresh
179 -- type variable as its type. (Because res_ty may not
181 ; ip_ty <- newFlexiTyVarTy argTypeKind -- argTypeKind: it can't be an unboxed tuple
182 ; ip_var <- emitWanted origin (mkIPPred ip ip_ty)
183 ; tcWrapResult (HsIPVar (IPName ip_var)) ip_ty res_ty }
185 tcExpr (HsLam match) res_ty
186 = do { (co_fn, match') <- tcMatchLambda match res_ty
187 ; return (mkHsWrap co_fn (HsLam match')) }
189 tcExpr (ExprWithTySig expr sig_ty) res_ty
190 = do { sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
192 -- Remember to extend the lexical type-variable environment
194 <- tcGen (SigSkol ExprSigCtxt) sig_tc_ty $ \ skol_tvs res_ty ->
195 tcExtendTyVarEnv2 (hsExplicitTvs sig_ty `zip` mkTyVarTys skol_tvs) $
196 -- See Note [More instantiated than scoped] in TcBinds
197 tcMonoExprNC expr res_ty
199 ; let inner_expr = ExprWithTySigOut (mkLHsWrap gen_fn expr') sig_ty
201 ; (inst_wrap, rho) <- deeplyInstantiate ExprSigOrigin sig_tc_ty
202 ; tcWrapResult (mkHsWrap inst_wrap inner_expr) rho res_ty }
205 = failWithTc (text "Can't handle type argument:" <+> ppr ty)
206 -- This is the syntax for type applications that I was planning
207 -- but there are difficulties (e.g. what order for type args)
208 -- so it's not enabled yet.
209 -- Can't eliminate it altogether from the parser, because the
210 -- same parser parses *patterns*.
214 %************************************************************************
216 Infix operators and sections
218 %************************************************************************
222 Left sections, like (4 *), are equivalent to
224 or, if PostfixOperators is enabled, just
226 With PostfixOperators we don't actually require the function to take
227 two arguments at all. For example, (x `not`) means (not x); you get
228 postfix operators! Not Haskell 98, but it's less work and kind of
231 Note [Typing rule for ($)]
232 ~~~~~~~~~~~~~~~~~~~~~~~~~~
236 runST :: (forall s. ST s a) -> a
237 that I have finally given in and written a special type-checking
238 rule just for saturated appliations of ($).
239 * Infer the type of the first argument
240 * Decompose it; should be of form (arg2_ty -> res_ty),
241 where arg2_ty might be a polytype
242 * Use arg2_ty to typecheck arg2
244 Note [Typing rule for seq]
245 ~~~~~~~~~~~~~~~~~~~~~~~~~~
248 which suggests this type for seq:
249 seq :: forall (a:*) (b:??). a -> b -> b,
250 with (b:??) meaning that be can be instantiated with an unboxed tuple.
251 But that's ill-kinded! Function arguments can't be unboxed tuples.
252 And indeed, you could not expect to do this with a partially-applied
253 'seq'; it's only going to work when it's fully applied. so it turns
255 case x of _ -> (# p,q #)
257 For a while I slid by by giving 'seq' an ill-kinded type, but then
258 the simplifier eta-reduced an application of seq and Lint blew up
259 with a kind error. It seems more uniform to treat 'seq' as it it
260 was a language construct.
262 See Note [seqId magic] in MkId, and
266 tcExpr (OpApp arg1 op fix arg2) res_ty
267 | (L loc (HsVar op_name)) <- op
268 , op_name `hasKey` seqIdKey -- Note [Typing rule for seq]
269 = do { arg1_ty <- newFlexiTyVarTy liftedTypeKind
270 ; let arg2_ty = res_ty
271 ; arg1' <- tcArg op (arg1, arg1_ty, 1)
272 ; arg2' <- tcArg op (arg2, arg2_ty, 2)
273 ; op_id <- tcLookupId op_name
274 ; let op' = L loc (HsWrap (mkWpTyApps [arg1_ty, arg2_ty]) (HsVar op_id))
275 ; return $ OpApp arg1' op' fix arg2' }
277 | (L loc (HsVar op_name)) <- op
278 , op_name `hasKey` dollarIdKey -- Note [Typing rule for ($)]
279 = do { traceTc "Application rule" (ppr op)
280 ; (arg1', arg1_ty) <- tcInferRho arg1
281 ; let doc = ptext (sLit "The first argument of ($) takes")
282 ; (co_arg1, [arg2_ty], op_res_ty) <- matchExpectedFunTys doc 1 arg1_ty
283 -- arg2_ty maybe polymorphic; that's the point
284 ; arg2' <- tcArg op (arg2, arg2_ty, 2)
285 ; co_res <- unifyType op_res_ty res_ty
286 ; op_id <- tcLookupId op_name
287 ; let op' = L loc (HsWrap (mkWpTyApps [arg2_ty, op_res_ty]) (HsVar op_id))
288 ; return $ mkHsWrapCoI co_res $
289 OpApp (mkLHsWrapCoI co_arg1 arg1') op' fix arg2' }
292 = do { traceTc "Non Application rule" (ppr op)
293 ; (op', op_ty) <- tcInferFun op
294 ; (co_fn, arg_tys, op_res_ty) <- unifyOpFunTys op 2 op_ty
295 ; co_res <- unifyType op_res_ty res_ty
296 ; [arg1', arg2'] <- tcArgs op [arg1, arg2] arg_tys
297 ; return $ mkHsWrapCoI co_res $
298 OpApp arg1' (mkLHsWrapCoI co_fn op') fix arg2' }
300 -- Right sections, equivalent to \ x -> x `op` expr, or
303 tcExpr (SectionR op arg2) res_ty
304 = do { (op', op_ty) <- tcInferFun op
305 ; (co_fn, [arg1_ty, arg2_ty], op_res_ty) <- unifyOpFunTys op 2 op_ty
306 ; co_res <- unifyType (mkFunTy arg1_ty op_res_ty) res_ty
307 ; arg2' <- tcArg op (arg2, arg2_ty, 2)
308 ; return $ mkHsWrapCoI co_res $
309 SectionR (mkLHsWrapCoI co_fn op') arg2' }
311 tcExpr (SectionL arg1 op) res_ty
312 = do { (op', op_ty) <- tcInferFun op
313 ; dflags <- getDOpts -- Note [Left sections]
314 ; let n_reqd_args | xopt Opt_PostfixOperators dflags = 1
317 ; (co_fn, (arg1_ty:arg_tys), op_res_ty) <- unifyOpFunTys op n_reqd_args op_ty
318 ; co_res <- unifyType (mkFunTys arg_tys op_res_ty) res_ty
319 ; arg1' <- tcArg op (arg1, arg1_ty, 1)
320 ; return $ mkHsWrapCoI co_res $
321 SectionL arg1' (mkLHsWrapCoI co_fn op') }
323 tcExpr (ExplicitTuple tup_args boxity) res_ty
324 | all tupArgPresent tup_args
325 = do { let tup_tc = tupleTyCon boxity (length tup_args)
326 ; (coi, arg_tys) <- matchExpectedTyConApp tup_tc res_ty
327 ; tup_args1 <- tcTupArgs tup_args arg_tys
328 ; return $ mkHsWrapCoI coi (ExplicitTuple tup_args1 boxity) }
331 = -- The tup_args are a mixture of Present and Missing (for tuple sections)
332 do { let kind = case boxity of { Boxed -> liftedTypeKind
333 ; Unboxed -> argTypeKind }
334 arity = length tup_args
335 tup_tc = tupleTyCon boxity arity
337 ; arg_tys <- newFlexiTyVarTys (tyConArity tup_tc) kind
339 = mkFunTys [ty | (ty, Missing _) <- arg_tys `zip` tup_args]
340 (mkTyConApp tup_tc arg_tys)
342 ; coi <- unifyType actual_res_ty res_ty
344 -- Handle tuple sections where
345 ; tup_args1 <- tcTupArgs tup_args arg_tys
347 ; return $ mkHsWrapCoI coi (ExplicitTuple tup_args1 boxity) }
349 tcExpr (ExplicitList _ exprs) res_ty
350 = do { (coi, elt_ty) <- matchExpectedListTy res_ty
351 ; exprs' <- mapM (tc_elt elt_ty) exprs
352 ; return $ mkHsWrapCoI coi (ExplicitList elt_ty exprs') }
354 tc_elt elt_ty expr = tcPolyExpr expr elt_ty
356 tcExpr (ExplicitPArr _ exprs) res_ty -- maybe empty
357 = do { (coi, elt_ty) <- matchExpectedPArrTy res_ty
358 ; exprs' <- mapM (tc_elt elt_ty) exprs
359 ; return $ mkHsWrapCoI coi (ExplicitPArr elt_ty exprs') }
361 tc_elt elt_ty expr = tcPolyExpr expr elt_ty
364 %************************************************************************
368 %************************************************************************
371 tcExpr (HsLet binds expr) res_ty
372 = do { (binds', expr') <- tcLocalBinds binds $
373 tcMonoExpr expr res_ty
374 ; return (HsLet binds' expr') }
376 tcExpr (HsCase scrut matches) exp_ty
377 = do { -- We used to typecheck the case alternatives first.
378 -- The case patterns tend to give good type info to use
379 -- when typechecking the scrutinee. For example
382 -- will report that map is applied to too few arguments
384 -- But now, in the GADT world, we need to typecheck the scrutinee
385 -- first, to get type info that may be refined in the case alternatives
386 (scrut', scrut_ty) <- tcInferRho scrut
388 ; traceTc "HsCase" (ppr scrut_ty)
389 ; matches' <- tcMatchesCase match_ctxt scrut_ty matches exp_ty
390 ; return (HsCase scrut' matches') }
392 match_ctxt = MC { mc_what = CaseAlt,
395 tcExpr (HsIf Nothing pred b1 b2) res_ty -- Ordinary 'if'
396 = do { pred' <- tcMonoExpr pred boolTy
397 ; b1' <- tcMonoExpr b1 res_ty
398 ; b2' <- tcMonoExpr b2 res_ty
399 ; return (HsIf Nothing pred' b1' b2') }
401 tcExpr (HsIf (Just fun) pred b1 b2) res_ty -- Note [Rebindable syntax for if]
402 = do { pred_ty <- newFlexiTyVarTy openTypeKind
403 ; b1_ty <- newFlexiTyVarTy openTypeKind
404 ; b2_ty <- newFlexiTyVarTy openTypeKind
405 ; let if_ty = mkFunTys [pred_ty, b1_ty, b2_ty] res_ty
406 ; fun' <- tcSyntaxOp IfOrigin fun if_ty
407 ; pred' <- tcMonoExpr pred pred_ty
408 ; b1' <- tcMonoExpr b1 b1_ty
409 ; b2' <- tcMonoExpr b2 b2_ty
410 -- Fundamentally we are just typing (ifThenElse e1 e2 e3)
411 -- so maybe we should use the code for function applications
412 -- (which would allow ifThenElse to be higher rank).
413 -- But it's a little awkward, so I'm leaving it alone for now
414 -- and it maintains uniformity with other rebindable syntax
415 ; return (HsIf (Just fun') pred' b1' b2') }
417 tcExpr (HsDo do_or_lc stmts body _) res_ty
418 = tcDoStmts do_or_lc stmts body res_ty
420 tcExpr (HsProc pat cmd) res_ty
421 = do { (pat', cmd', coi) <- tcProc pat cmd res_ty
422 ; return $ mkHsWrapCoI coi (HsProc pat' cmd') }
424 tcExpr e@(HsArrApp _ _ _ _ _) _
425 = failWithTc (vcat [ptext (sLit "The arrow command"), nest 2 (ppr e),
426 ptext (sLit "was found where an expression was expected")])
428 tcExpr e@(HsArrForm _ _ _) _
429 = failWithTc (vcat [ptext (sLit "The arrow command"), nest 2 (ppr e),
430 ptext (sLit "was found where an expression was expected")])
433 Note [Rebindable syntax for if]
434 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
435 The rebindable syntax for 'if' uses the most flexible possible type
437 ifThenElse :: p -> b1 -> b2 -> res
438 to support expressions like this:
440 ifThenElse :: Maybe a -> (a -> b) -> b -> b
441 ifThenElse (Just a) f _ = f a ifThenElse Nothing _ e = e
449 %************************************************************************
451 Record construction and update
453 %************************************************************************
456 tcExpr (RecordCon (L loc con_name) _ rbinds) res_ty
457 = do { data_con <- tcLookupDataCon con_name
459 -- Check for missing fields
460 ; checkMissingFields data_con rbinds
462 ; (con_expr, con_tau) <- tcInferId con_name
463 ; let arity = dataConSourceArity data_con
464 (arg_tys, actual_res_ty) = tcSplitFunTysN con_tau arity
465 con_id = dataConWrapId data_con
467 ; co_res <- unifyType actual_res_ty res_ty
468 ; rbinds' <- tcRecordBinds data_con arg_tys rbinds
469 ; return $ mkHsWrapCoI co_res $
470 RecordCon (L loc con_id) con_expr rbinds' }
473 Note [Type of a record update]
474 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
475 The main complication with RecordUpd is that we need to explicitly
476 handle the *non-updated* fields. Consider:
478 data T a b c = MkT1 { fa :: a, fb :: (b,c) }
479 | MkT2 { fa :: a, fb :: (b,c), fc :: c -> c }
482 upd :: T a b c -> (b',c) -> T a b' c
483 upd t x = t { fb = x}
485 The result type should be (T a b' c)
486 not (T a b c), because 'b' *is not* mentioned in a non-updated field
487 not (T a b' c'), becuase 'c' *is* mentioned in a non-updated field
488 NB that it's not good enough to look at just one constructor; we must
489 look at them all; cf Trac #3219
491 After all, upd should be equivalent to:
497 So we need to give a completely fresh type to the result record,
498 and then constrain it by the fields that are *not* updated ("p" above).
499 We call these the "fixed" type variables, and compute them in getFixedTyVars.
501 Note that because MkT3 doesn't contain all the fields being updated,
502 its RHS is simply an error, so it doesn't impose any type constraints.
503 Hence the use of 'relevant_cont'.
505 Note [Implict type sharing]
506 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
507 We also take into account any "implicit" non-update fields. For example
508 data T a b where { MkT { f::a } :: T a a; ... }
509 So the "real" type of MkT is: forall ab. (a~b) => a -> T a b
514 upd :: T a b -> a -> T a b
515 upd (t::T a b) (x::a)
516 = case t of { MkT (co:a~b) (_:a) -> MkT co x }
517 We can't give it the more general type
518 upd :: T a b -> c -> T c b
520 Note [Criteria for update]
521 ~~~~~~~~~~~~~~~~~~~~~~~~~~
522 We want to allow update for existentials etc, provided the updated
523 field isn't part of the existential. For example, this should be ok.
524 data T a where { MkT { f1::a, f2::b->b } :: T a }
528 The criterion we use is this:
530 The types of the updated fields
531 mention only the universally-quantified type variables
532 of the data constructor
534 NB: this is not (quite) the same as being a "naughty" record selector
535 (See Note [Naughty record selectors]) in TcTyClsDecls), at least
536 in the case of GADTs. Consider
537 data T a where { MkT :: { f :: a } :: T [a] }
538 Then f is not "naughty" because it has a well-typed record selector.
539 But we don't allow updates for 'f'. (One could consider trying to
540 allow this, but it makes my head hurt. Badly. And no one has asked
543 In principle one could go further, and allow
545 g t = t { f2 = \x -> x }
546 because the expression is polymorphic...but that seems a bridge too far.
548 Note [Data family example]
549 ~~~~~~~~~~~~~~~~~~~~~~~~~~
550 data instance T (a,b) = MkT { x::a, y::b }
552 data :TP a b = MkT { a::a, y::b }
553 coTP a b :: T (a,b) ~ :TP a b
555 Suppose r :: T (t1,t2), e :: t3
556 Then r { x=e } :: T (t3,t1)
559 MkT x y -> MkT e y |> co2
560 where co1 :: T (t1,t2) ~ :TP t1 t2
561 co2 :: :TP t3 t2 ~ T (t3,t2)
562 The wrapping with co2 is done by the constructor wrapper for MkT
566 In the outgoing (HsRecordUpd scrut binds cons in_inst_tys out_inst_tys):
568 * cons are the data constructors to be updated
570 * in_inst_tys, out_inst_tys have same length, and instantiate the
571 *representation* tycon of the data cons. In Note [Data
572 family example], in_inst_tys = [t1,t2], out_inst_tys = [t3,t2]
575 tcExpr (RecordUpd record_expr rbinds _ _ _) res_ty
576 = ASSERT( notNull upd_fld_names )
579 -- Check that the field names are really field names
580 ; sel_ids <- mapM tcLookupField upd_fld_names
581 -- The renamer has already checked that
582 -- selectors are all in scope
583 ; let bad_guys = [ setSrcSpan loc $ addErrTc (notSelector fld_name)
584 | (fld, sel_id) <- rec_flds rbinds `zip` sel_ids,
585 not (isRecordSelector sel_id), -- Excludes class ops
586 let L loc fld_name = hsRecFieldId fld ]
587 ; unless (null bad_guys) (sequence bad_guys >> failM)
590 -- Figure out the tycon and data cons from the first field name
591 ; let -- It's OK to use the non-tc splitters here (for a selector)
593 (tycon, _) = recordSelectorFieldLabel sel_id -- We've failed already if
594 data_cons = tyConDataCons tycon -- it's not a field label
595 -- NB: for a data type family, the tycon is the instance tycon
597 relevant_cons = filter is_relevant data_cons
598 is_relevant con = all (`elem` dataConFieldLabels con) upd_fld_names
599 -- A constructor is only relevant to this process if
600 -- it contains *all* the fields that are being updated
601 -- Other ones will cause a runtime error if they occur
603 -- Take apart a representative constructor
604 con1 = ASSERT( not (null relevant_cons) ) head relevant_cons
605 (con1_tvs, _, _, _, _, con1_arg_tys, _) = dataConFullSig con1
606 con1_flds = dataConFieldLabels con1
607 con1_res_ty = mkFamilyTyConApp tycon (mkTyVarTys con1_tvs)
610 -- Check that at least one constructor has all the named fields
611 -- i.e. has an empty set of bad fields returned by badFields
612 ; checkTc (not (null relevant_cons)) (badFieldsUpd rbinds)
614 -- STEP 3 Note [Criteria for update]
615 -- Check that each updated field is polymorphic; that is, its type
616 -- mentions only the universally-quantified variables of the data con
617 ; let flds1_w_tys = zipEqual "tcExpr:RecConUpd" con1_flds con1_arg_tys
618 upd_flds1_w_tys = filter is_updated flds1_w_tys
619 is_updated (fld,_) = fld `elem` upd_fld_names
621 bad_upd_flds = filter bad_fld upd_flds1_w_tys
622 con1_tv_set = mkVarSet con1_tvs
623 bad_fld (fld, ty) = fld `elem` upd_fld_names &&
624 not (tyVarsOfType ty `subVarSet` con1_tv_set)
625 ; checkTc (null bad_upd_flds) (badFieldTypes bad_upd_flds)
627 -- STEP 4 Note [Type of a record update]
628 -- Figure out types for the scrutinee and result
629 -- Both are of form (T a b c), with fresh type variables, but with
630 -- common variables where the scrutinee and result must have the same type
631 -- These are variables that appear in *any* arg of *any* of the
632 -- relevant constructors *except* in the updated fields
634 ; let fixed_tvs = getFixedTyVars con1_tvs relevant_cons
635 is_fixed_tv tv = tv `elemVarSet` fixed_tvs
636 mk_inst_ty tv result_inst_ty
637 | is_fixed_tv tv = return result_inst_ty -- Same as result type
638 | otherwise = newFlexiTyVarTy (tyVarKind tv) -- Fresh type, of correct kind
640 ; (_, result_inst_tys, result_inst_env) <- tcInstTyVars con1_tvs
641 ; scrut_inst_tys <- zipWithM mk_inst_ty con1_tvs result_inst_tys
643 ; let rec_res_ty = substTy result_inst_env con1_res_ty
644 con1_arg_tys' = map (substTy result_inst_env) con1_arg_tys
645 scrut_subst = zipTopTvSubst con1_tvs scrut_inst_tys
646 scrut_ty = substTy scrut_subst con1_res_ty
648 ; co_res <- unifyType rec_res_ty res_ty
651 -- Typecheck the thing to be updated, and the bindings
652 ; record_expr' <- tcMonoExpr record_expr scrut_ty
653 ; rbinds' <- tcRecordBinds con1 con1_arg_tys' rbinds
655 -- STEP 6: Deal with the stupid theta
656 ; let theta' = substTheta scrut_subst (dataConStupidTheta con1)
657 ; instStupidTheta RecordUpdOrigin theta'
659 -- Step 7: make a cast for the scrutinee, in the case that it's from a type family
660 ; let scrut_co | Just co_con <- tyConFamilyCoercion_maybe tycon
661 = WpCast $ mkTyConApp co_con scrut_inst_tys
665 ; return $ mkHsWrapCoI co_res $
666 RecordUpd (mkLHsWrap scrut_co record_expr') rbinds'
667 relevant_cons scrut_inst_tys result_inst_tys }
669 upd_fld_names = hsRecFields rbinds
671 getFixedTyVars :: [TyVar] -> [DataCon] -> TyVarSet
672 -- These tyvars must not change across the updates
673 getFixedTyVars tvs1 cons
674 = mkVarSet [tv1 | con <- cons
675 , let (tvs, theta, arg_tys, _) = dataConSig con
676 flds = dataConFieldLabels con
677 fixed_tvs = exactTyVarsOfTypes fixed_tys
678 -- fixed_tys: See Note [Type of a record update]
679 `unionVarSet` tyVarsOfTheta theta
680 -- Universally-quantified tyvars that
681 -- appear in any of the *implicit*
682 -- arguments to the constructor are fixed
683 -- See Note [Implict type sharing]
685 fixed_tys = [ty | (fld,ty) <- zip flds arg_tys
686 , not (fld `elem` upd_fld_names)]
687 , (tv1,tv) <- tvs1 `zip` tvs -- Discards existentials in tvs
688 , tv `elemVarSet` fixed_tvs ]
691 %************************************************************************
693 Arithmetic sequences e.g. [a,b..]
694 and their parallel-array counterparts e.g. [: a,b.. :]
697 %************************************************************************
700 tcExpr (ArithSeq _ seq@(From expr)) res_ty
701 = do { (coi, elt_ty) <- matchExpectedListTy res_ty
702 ; expr' <- tcPolyExpr expr elt_ty
703 ; enum_from <- newMethodFromName (ArithSeqOrigin seq)
705 ; return $ mkHsWrapCoI coi (ArithSeq enum_from (From expr')) }
707 tcExpr (ArithSeq _ seq@(FromThen expr1 expr2)) res_ty
708 = do { (coi, elt_ty) <- matchExpectedListTy res_ty
709 ; expr1' <- tcPolyExpr expr1 elt_ty
710 ; expr2' <- tcPolyExpr expr2 elt_ty
711 ; enum_from_then <- newMethodFromName (ArithSeqOrigin seq)
712 enumFromThenName elt_ty
713 ; return $ mkHsWrapCoI coi
714 (ArithSeq enum_from_then (FromThen expr1' expr2')) }
716 tcExpr (ArithSeq _ seq@(FromTo expr1 expr2)) res_ty
717 = do { (coi, elt_ty) <- matchExpectedListTy res_ty
718 ; expr1' <- tcPolyExpr expr1 elt_ty
719 ; expr2' <- tcPolyExpr expr2 elt_ty
720 ; enum_from_to <- newMethodFromName (ArithSeqOrigin seq)
721 enumFromToName elt_ty
722 ; return $ mkHsWrapCoI coi
723 (ArithSeq enum_from_to (FromTo expr1' expr2')) }
725 tcExpr (ArithSeq _ seq@(FromThenTo expr1 expr2 expr3)) res_ty
726 = do { (coi, elt_ty) <- matchExpectedListTy res_ty
727 ; expr1' <- tcPolyExpr expr1 elt_ty
728 ; expr2' <- tcPolyExpr expr2 elt_ty
729 ; expr3' <- tcPolyExpr expr3 elt_ty
730 ; eft <- newMethodFromName (ArithSeqOrigin seq)
731 enumFromThenToName elt_ty
732 ; return $ mkHsWrapCoI coi
733 (ArithSeq eft (FromThenTo expr1' expr2' expr3')) }
735 tcExpr (PArrSeq _ seq@(FromTo expr1 expr2)) res_ty
736 = do { (coi, elt_ty) <- matchExpectedPArrTy res_ty
737 ; expr1' <- tcPolyExpr expr1 elt_ty
738 ; expr2' <- tcPolyExpr expr2 elt_ty
739 ; enum_from_to <- newMethodFromName (PArrSeqOrigin seq)
740 enumFromToPName elt_ty
741 ; return $ mkHsWrapCoI coi
742 (PArrSeq enum_from_to (FromTo expr1' expr2')) }
744 tcExpr (PArrSeq _ seq@(FromThenTo expr1 expr2 expr3)) res_ty
745 = do { (coi, elt_ty) <- matchExpectedPArrTy res_ty
746 ; expr1' <- tcPolyExpr expr1 elt_ty
747 ; expr2' <- tcPolyExpr expr2 elt_ty
748 ; expr3' <- tcPolyExpr expr3 elt_ty
749 ; eft <- newMethodFromName (PArrSeqOrigin seq)
750 enumFromThenToPName elt_ty
751 ; return $ mkHsWrapCoI coi
752 (PArrSeq eft (FromThenTo expr1' expr2' expr3')) }
754 tcExpr (PArrSeq _ _) _
755 = panic "TcExpr.tcMonoExpr: Infinite parallel array!"
756 -- the parser shouldn't have generated it and the renamer shouldn't have
761 %************************************************************************
765 %************************************************************************
768 #ifdef GHCI /* Only if bootstrapped */
769 -- Rename excludes these cases otherwise
770 tcExpr (HsSpliceE splice) res_ty = tcSpliceExpr splice res_ty
771 tcExpr (HsBracket brack) res_ty = do { e <- tcBracket brack res_ty
773 tcExpr e@(HsQuasiQuoteE _) _ =
774 pprPanic "Should never see HsQuasiQuoteE in type checker" (ppr e)
779 %************************************************************************
783 %************************************************************************
786 tcExpr other _ = pprPanic "tcMonoExpr" (ppr other)
790 %************************************************************************
794 %************************************************************************
797 tcApp :: LHsExpr Name -> [LHsExpr Name] -- Function and args
798 -> TcRhoType -> TcM (HsExpr TcId) -- Translated fun and args
800 tcApp (L _ (HsPar e)) args res_ty
801 = tcApp e args res_ty
803 tcApp (L _ (HsApp e1 e2)) args res_ty
804 = tcApp e1 (e2:args) res_ty -- Accumulate the arguments
806 tcApp (L loc (HsVar fun)) args res_ty
807 | fun `hasKey` tagToEnumKey
809 = tcTagToEnum loc fun arg res_ty
811 tcApp fun args res_ty
812 = do { -- Type-check the function
813 ; (fun1, fun_tau) <- tcInferFun fun
815 -- Extract its argument types
816 ; (co_fun, expected_arg_tys, actual_res_ty)
817 <- matchExpectedFunTys (mk_app_msg fun) (length args) fun_tau
819 -- Typecheck the result, thereby propagating
820 -- info (if any) from result into the argument types
821 -- Both actual_res_ty and res_ty are deeply skolemised
822 ; co_res <- unifyType actual_res_ty res_ty
824 -- Typecheck the arguments
825 ; args1 <- tcArgs fun args expected_arg_tys
827 -- Assemble the result
828 ; let fun2 = mkLHsWrapCoI co_fun fun1
829 app = mkLHsWrapCoI co_res (foldl mkHsApp fun2 args1)
831 ; return (unLoc app) }
834 mk_app_msg :: LHsExpr Name -> SDoc
835 mk_app_msg fun = sep [ ptext (sLit "The function") <+> quotes (ppr fun)
836 , ptext (sLit "is applied to")]
839 tcInferApp :: LHsExpr Name -> [LHsExpr Name] -- Function and args
840 -> TcM (HsExpr TcId, TcRhoType) -- Translated fun and args
842 tcInferApp (L _ (HsPar e)) args = tcInferApp e args
843 tcInferApp (L _ (HsApp e1 e2)) args = tcInferApp e1 (e2:args)
845 = -- Very like the tcApp version, except that there is
846 -- no expected result type passed in
847 do { (fun1, fun_tau) <- tcInferFun fun
848 ; (co_fun, expected_arg_tys, actual_res_ty)
849 <- matchExpectedFunTys (mk_app_msg fun) (length args) fun_tau
850 ; args1 <- tcArgs fun args expected_arg_tys
851 ; let fun2 = mkLHsWrapCoI co_fun fun1
852 app = foldl mkHsApp fun2 args1
853 ; return (unLoc app, actual_res_ty) }
856 tcInferFun :: LHsExpr Name -> TcM (LHsExpr TcId, TcRhoType)
857 -- Infer and instantiate the type of a function
858 tcInferFun (L loc (HsVar name))
859 = do { (fun, ty) <- setSrcSpan loc (tcInferId name)
860 -- Don't wrap a context around a plain Id
861 ; return (L loc fun, ty) }
864 = do { (fun, fun_ty) <- tcInfer (tcMonoExpr fun)
866 -- Zonk the function type carefully, to expose any polymorphism
867 -- E.g. (( \(x::forall a. a->a). blah ) e)
868 -- We can see the rank-2 type of the lambda in time to genrealise e
869 ; fun_ty' <- zonkTcTypeCarefully fun_ty
871 ; (wrap, rho) <- deeplyInstantiate AppOrigin fun_ty'
872 ; return (mkLHsWrap wrap fun, rho) }
875 tcArgs :: LHsExpr Name -- The function (for error messages)
876 -> [LHsExpr Name] -> [TcSigmaType] -- Actual arguments and expected arg types
877 -> TcM [LHsExpr TcId] -- Resulting args
879 tcArgs fun args expected_arg_tys
880 = mapM (tcArg fun) (zip3 args expected_arg_tys [1..])
883 tcArg :: LHsExpr Name -- The function (for error messages)
884 -> (LHsExpr Name, TcSigmaType, Int) -- Actual argument and expected arg type
885 -> TcM (LHsExpr TcId) -- Resulting argument
886 tcArg fun (arg, ty, arg_no) = addErrCtxt (funAppCtxt fun arg arg_no)
887 (tcPolyExprNC arg ty)
890 tcTupArgs :: [HsTupArg Name] -> [TcSigmaType] -> TcM [HsTupArg TcId]
892 = ASSERT( equalLength args tys ) mapM go (args `zip` tys)
894 go (Missing {}, arg_ty) = return (Missing arg_ty)
895 go (Present expr, arg_ty) = do { expr' <- tcPolyExpr expr arg_ty
896 ; return (Present expr') }
899 unifyOpFunTys :: LHsExpr Name -> Arity -> TcRhoType
900 -> TcM (CoercionI, [TcSigmaType], TcRhoType)
901 -- A wrapper for matchExpectedFunTys
902 unifyOpFunTys op arity ty = matchExpectedFunTys herald arity ty
904 herald = ptext (sLit "The operator") <+> quotes (ppr op) <+> ptext (sLit "takes")
906 ---------------------------
907 tcSyntaxOp :: CtOrigin -> HsExpr Name -> TcType -> TcM (HsExpr TcId)
908 -- Typecheck a syntax operator, checking that it has the specified type
909 -- The operator is always a variable at this stage (i.e. renamer output)
910 -- This version assumes res_ty is a monotype
911 tcSyntaxOp orig (HsVar op) res_ty = do { (expr, rho) <- tcInferIdWithOrig orig op
912 ; tcWrapResult expr rho res_ty }
913 tcSyntaxOp _ other _ = pprPanic "tcSyntaxOp" (ppr other)
917 Note [Push result type in]
918 ~~~~~~~~~~~~~~~~~~~~~~~~~~
919 Unify with expected result before type-checking the args so that the
920 info from res_ty percolates to args. This is when we might detect a
921 too-few args situation. (One can think of cases when the opposite
922 order would give a better error message.)
923 experimenting with putting this first.
925 Here's an example where it actually makes a real difference
927 class C t a b | t a -> b
928 instance C Char a Bool
930 data P t a = forall b. (C t a b) => MkP b
931 data Q t = MkQ (forall a. P t a)
935 f2 = MkQ (MkP True :: forall a. P Char a)
937 With the change, f1 will type-check, because the 'Char' info from
938 the signature is propagated into MkQ's argument. With the check
939 in the other order, the extra signature in f2 is reqd.
942 %************************************************************************
946 %************************************************************************
949 tcCheckId :: Name -> TcRhoType -> TcM (HsExpr TcId)
950 tcCheckId name res_ty = do { (expr, rho) <- tcInferId name
951 ; tcWrapResult expr rho res_ty }
953 ------------------------
954 tcInferId :: Name -> TcM (HsExpr TcId, TcRhoType)
955 -- Infer type, and deeply instantiate
956 tcInferId n = tcInferIdWithOrig (OccurrenceOf n) n
958 ------------------------
959 tcInferIdWithOrig :: CtOrigin -> Name -> TcM (HsExpr TcId, TcRhoType)
960 -- Look up an occurrence of an Id, and instantiate it (deeply)
962 tcInferIdWithOrig orig id_name
963 = do { id <- lookup_id
964 ; (id_expr, id_rho) <- instantiateOuter orig id
965 ; (wrap, rho) <- deeplyInstantiate orig id_rho
966 ; return (mkHsWrap wrap id_expr, rho) }
968 lookup_id :: TcM TcId
970 = do { thing <- tcLookup id_name
972 ATcId { tct_id = id, tct_level = lvl }
973 -> do { check_naughty id -- Note [Local record selectors]
974 ; checkThLocalId id lvl
978 -> do { check_naughty id; return id }
979 -- A global cannot possibly be ill-staged
980 -- nor does it need the 'lifting' treatment
981 -- hence no checkTh stuff here
983 AGlobal (ADataCon con) -> return (dataConWrapId con)
985 other -> failWithTc (bad_lookup other) }
987 bad_lookup thing = ppr thing <+> ptext (sLit "used where a value identifer was expected")
990 | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel id)
991 | otherwise = return ()
993 ------------------------
994 instantiateOuter :: CtOrigin -> TcId -> TcM (HsExpr TcId, TcSigmaType)
995 -- Do just the first level of instantiation of an Id
996 -- a) Deal with method sharing
997 -- b) Deal with stupid checks
998 -- Only look at the *outer level* of quantification
999 -- See Note [Multiple instantiation]
1001 instantiateOuter orig id
1002 | null tvs && null theta
1003 = return (HsVar id, tau)
1006 = do { (_, tys, subst) <- tcInstTyVars tvs
1007 ; doStupidChecks id tys
1008 ; let theta' = substTheta subst theta
1009 ; traceTc "Instantiating" (ppr id <+> text "with" <+> (ppr tys $$ ppr theta'))
1010 ; wrap <- instCall orig tys theta'
1011 ; return (mkHsWrap wrap (HsVar id), substTy subst tau) }
1013 (tvs, theta, tau) = tcSplitSigmaTy (idType id)
1016 Note [Multiple instantiation]
1017 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1018 We are careful never to make a MethodInst that has, as its meth_id, another MethodInst.
1019 For example, consider
1020 f :: forall a. Eq a => forall b. Ord b => a -> b
1021 At a call to f, at say [Int, Bool], it's tempting to translate the call to
1025 f_m1 :: forall b. Ord b => Int -> b
1029 f_m2 = f_m1 Bool dOrdBool
1031 But notice that f_m2 has f_m1 as its meth_id. Now the danger is that if we do
1032 a tcSimplCheck with a Given f_mx :: f Int dEqInt, we may make a binding
1034 But it's entirely possible that f_m2 will continue to float out, because it
1035 mentions no type variables. Result, f_m1 isn't in scope.
1037 Here's a concrete example that does this (test tc200):
1040 f :: Eq b => b -> a -> Int
1041 baz :: Eq a => Int -> a -> Int
1043 instance C Int where
1046 Current solution: only do the "method sharing" thing for the first type/dict
1047 application, not for the iterated ones. A horribly subtle point.
1049 Note [No method sharing]
1050 ~~~~~~~~~~~~~~~~~~~~~~~~
1051 The -fno-method-sharing flag controls what happens so far as the LIE
1052 is concerned. The default case is that for an overloaded function we
1053 generate a "method" Id, and add the Method Inst to the LIE. So you get
1055 f :: Num a => a -> a
1056 f = /\a (d:Num a) -> let m = (+) a d in \ (x:a) -> m x x
1057 If you specify -fno-method-sharing, the dictionary application
1058 isn't shared, so we get
1059 f :: Num a => a -> a
1060 f = /\a (d:Num a) (x:a) -> (+) a d x x
1061 This gets a bit less sharing, but
1062 a) it's better for RULEs involving overloaded functions
1063 b) perhaps fewer separated lambdas
1066 doStupidChecks :: TcId
1069 -- Check two tiresome and ad-hoc cases
1070 -- (a) the "stupid theta" for a data con; add the constraints
1071 -- from the "stupid theta" of a data constructor (sigh)
1073 doStupidChecks fun_id tys
1074 | Just con <- isDataConId_maybe fun_id -- (a)
1075 = addDataConStupidTheta con tys
1077 | fun_id `hasKey` tagToEnumKey -- (b)
1078 = failWithTc (ptext (sLit "tagToEnum# must appear applied to one argument"))
1081 = return () -- The common case
1086 Nasty check to ensure that tagToEnum# is applied to a type that is an
1087 enumeration TyCon. Unification may refine the type later, but this
1088 check won't see that, alas. It's crude, because it relies on our
1089 knowing *now* that the type is ok, which in turn relies on the
1090 eager-unification part of the type checker pushing enough information
1091 here. In theory the Right Thing to do is to have a new form of
1092 constraint but I definitely cannot face that! And it works ok as-is.
1094 Here's are two cases that should fail
1096 f = tagToEnum# 0 -- Can't do tagToEnum# at a type variable
1099 g = tagToEnum# 0 -- Int is not an enumeration
1101 When data type families are involved it's a bit more complicated.
1103 data instance F [Int] = A | B | C
1104 Then we want to generate something like
1105 tagToEnum# R:FListInt 3# |> co :: R:FListInt ~ F [Int]
1106 Usually that coercion is hidden inside the wrappers for
1107 constructors of F [Int] but here we have to do it explicitly.
1109 It's all grotesquely complicated.
1112 tcTagToEnum :: SrcSpan -> Name -> LHsExpr Name -> TcRhoType -> TcM (HsExpr TcId)
1113 -- tagToEnum# :: forall a. Int# -> a
1114 -- See Note [tagToEnum#] Urgh!
1115 tcTagToEnum loc fun_name arg res_ty
1116 = do { fun <- tcLookupId fun_name
1117 ; ty' <- zonkTcType res_ty
1119 -- Check that the type is algebraic
1120 ; let mb_tc_app = tcSplitTyConApp_maybe ty'
1121 Just (tc, tc_args) = mb_tc_app
1122 ; checkTc (isJust mb_tc_app)
1123 (tagToEnumError ty' doc1)
1125 -- Look through any type family
1126 ; (coi, rep_tc, rep_args) <- get_rep_ty ty' tc tc_args
1128 ; checkTc (isEnumerationTyCon rep_tc)
1129 (tagToEnumError ty' doc2)
1131 ; arg' <- tcMonoExpr arg intPrimTy
1132 ; let fun' = L loc (HsWrap (WpTyApp rep_ty) (HsVar fun))
1133 rep_ty = mkTyConApp rep_tc rep_args
1135 ; return (mkHsWrapCoI coi $ HsApp fun' arg') }
1137 doc1 = vcat [ ptext (sLit "Specify the type by giving a type signature")
1138 , ptext (sLit "e.g. (tagToEnum# x) :: Bool") ]
1139 doc2 = ptext (sLit "Result type must be an enumeration type")
1140 doc3 = ptext (sLit "No family instance for this type")
1142 get_rep_ty :: TcType -> TyCon -> [TcType]
1143 -> TcM (CoercionI, TyCon, [TcType])
1144 -- Converts a family type (eg F [a]) to its rep type (eg FList a)
1145 -- and returns a coercion between the two
1146 get_rep_ty ty tc tc_args
1147 | not (isFamilyTyCon tc)
1148 = return (IdCo ty, tc, tc_args)
1150 = do { mb_fam <- tcLookupFamInst tc tc_args
1152 Nothing -> failWithTc (tagToEnumError ty doc3)
1153 Just (rep_tc, rep_args)
1154 -> return ( ACo (mkSymCoercion (mkTyConApp co_tc rep_args))
1155 , rep_tc, rep_args )
1157 co_tc = expectJust "tcTagToEnum" $
1158 tyConFamilyCoercion_maybe rep_tc }
1160 tagToEnumError :: TcType -> SDoc -> SDoc
1161 tagToEnumError ty what
1162 = hang (ptext (sLit "Bad call to tagToEnum#")
1163 <+> ptext (sLit "at type") <+> ppr ty)
1168 %************************************************************************
1170 Template Haskell checks
1172 %************************************************************************
1175 checkThLocalId :: Id -> ThLevel -> TcM ()
1176 #ifndef GHCI /* GHCI and TH is off */
1177 --------------------------------------
1178 -- Check for cross-stage lifting
1179 checkThLocalId _id _bind_lvl
1182 #else /* GHCI and TH is on */
1183 checkThLocalId id bind_lvl
1184 = do { use_stage <- getStage -- TH case
1185 ; let use_lvl = thLevel use_stage
1186 ; checkWellStaged (quotes (ppr id)) bind_lvl use_lvl
1187 ; traceTc "thLocalId" (ppr id <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl)
1188 ; when (use_lvl > bind_lvl) $
1189 checkCrossStageLifting id bind_lvl use_stage }
1191 --------------------------------------
1192 checkCrossStageLifting :: Id -> ThLevel -> ThStage -> TcM ()
1193 -- We are inside brackets, and (use_lvl > bind_lvl)
1194 -- Now we must check whether there's a cross-stage lift to do
1195 -- Examples \x -> [| x |]
1198 checkCrossStageLifting _ _ Comp = return ()
1199 checkCrossStageLifting _ _ Splice = return ()
1201 checkCrossStageLifting id _ (Brack _ ps_var lie_var)
1203 = -- Top-level identifiers in this module,
1204 -- (which have External Names)
1205 -- are just like the imported case:
1206 -- no need for the 'lifting' treatment
1207 -- E.g. this is fine:
1210 -- But we do need to put f into the keep-alive
1211 -- set, because after desugaring the code will
1212 -- only mention f's *name*, not f itself.
1215 | otherwise -- bind_lvl = outerLevel presumably,
1216 -- but the Id is not bound at top level
1217 = -- Nested identifiers, such as 'x' in
1218 -- E.g. \x -> [| h x |]
1219 -- We must behave as if the reference to x was
1221 -- We use 'x' itself as the splice proxy, used by
1222 -- the desugarer to stitch it all back together.
1223 -- If 'x' occurs many times we may get many identical
1224 -- bindings of the same splice proxy, but that doesn't
1225 -- matter, although it's a mite untidy.
1226 do { let id_ty = idType id
1227 ; checkTc (isTauTy id_ty) (polySpliceErr id)
1228 -- If x is polymorphic, its occurrence sites might
1229 -- have different instantiations, so we can't use plain
1230 -- 'x' as the splice proxy name. I don't know how to
1231 -- solve this, and it's probably unimportant, so I'm
1232 -- just going to flag an error for now
1234 ; lift <- if isStringTy id_ty then
1235 do { sid <- tcLookupId DsMeta.liftStringName
1236 -- See Note [Lifting strings]
1237 ; return (HsVar sid) }
1239 setConstraintVar lie_var $ do
1240 -- Put the 'lift' constraint into the right LIE
1241 newMethodFromName (OccurrenceOf (idName id))
1242 DsMeta.liftName id_ty
1244 -- Update the pending splices
1245 ; ps <- readMutVar ps_var
1246 ; writeMutVar ps_var ((idName id, nlHsApp (noLoc lift) (nlHsVar id)) : ps)
1252 Note [Lifting strings]
1253 ~~~~~~~~~~~~~~~~~~~~~~
1254 If we see $(... [| s |] ...) where s::String, we don't want to
1255 generate a mass of Cons (CharL 'x') (Cons (CharL 'y') ...)) etc.
1256 So this conditional short-circuits the lifting mechanism to generate
1257 (liftString "xy") in that case. I didn't want to use overlapping instances
1258 for the Lift class in TH.Syntax, because that can lead to overlapping-instance
1259 errors in a polymorphic situation.
1261 If this check fails (which isn't impossible) we get another chance; see
1262 Note [Converting strings] in Convert.lhs
1264 Local record selectors
1265 ~~~~~~~~~~~~~~~~~~~~~~
1266 Record selectors for TyCons in this module are ordinary local bindings,
1267 which show up as ATcIds rather than AGlobals. So we need to check for
1268 naughtiness in both branches. c.f. TcTyClsBindings.mkAuxBinds.
1271 %************************************************************************
1273 \subsection{Record bindings}
1275 %************************************************************************
1277 Game plan for record bindings
1278 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1279 1. Find the TyCon for the bindings, from the first field label.
1281 2. Instantiate its tyvars and unify (T a1 .. an) with expected_ty.
1283 For each binding field = value
1285 3. Instantiate the field type (from the field label) using the type
1288 4 Type check the value using tcArg, passing the field type as
1289 the expected argument type.
1291 This extends OK when the field types are universally quantified.
1297 -> [TcType] -- Expected type for each field
1298 -> HsRecordBinds Name
1299 -> TcM (HsRecordBinds TcId)
1301 tcRecordBinds data_con arg_tys (HsRecFields rbinds dd)
1302 = do { mb_binds <- mapM do_bind rbinds
1303 ; return (HsRecFields (catMaybes mb_binds) dd) }
1305 flds_w_tys = zipEqual "tcRecordBinds" (dataConFieldLabels data_con) arg_tys
1306 do_bind fld@(HsRecField { hsRecFieldId = L loc field_lbl, hsRecFieldArg = rhs })
1307 | Just field_ty <- assocMaybe flds_w_tys field_lbl
1308 = addErrCtxt (fieldCtxt field_lbl) $
1309 do { rhs' <- tcPolyExprNC rhs field_ty
1310 ; let field_id = mkUserLocal (nameOccName field_lbl)
1311 (nameUnique field_lbl)
1313 -- Yuk: the field_id has the *unique* of the selector Id
1314 -- (so we can find it easily)
1315 -- but is a LocalId with the appropriate type of the RHS
1316 -- (so the desugarer knows the type of local binder to make)
1317 ; return (Just (fld { hsRecFieldId = L loc field_id, hsRecFieldArg = rhs' })) }
1319 = do { addErrTc (badFieldCon data_con field_lbl)
1322 checkMissingFields :: DataCon -> HsRecordBinds Name -> TcM ()
1323 checkMissingFields data_con rbinds
1324 | null field_labels -- Not declared as a record;
1325 -- But C{} is still valid if no strict fields
1326 = if any isBanged field_strs then
1327 -- Illegal if any arg is strict
1328 addErrTc (missingStrictFields data_con [])
1332 | otherwise = do -- A record
1333 unless (null missing_s_fields)
1334 (addErrTc (missingStrictFields data_con missing_s_fields))
1336 warn <- doptM Opt_WarnMissingFields
1337 unless (not (warn && notNull missing_ns_fields))
1338 (warnTc True (missingFields data_con missing_ns_fields))
1342 = [ fl | (fl, str) <- field_info,
1344 not (fl `elem` field_names_used)
1347 = [ fl | (fl, str) <- field_info,
1349 not (fl `elem` field_names_used)
1352 field_names_used = hsRecFields rbinds
1353 field_labels = dataConFieldLabels data_con
1355 field_info = zipEqual "missingFields"
1359 field_strs = dataConStrictMarks data_con
1362 %************************************************************************
1364 \subsection{Errors and contexts}
1366 %************************************************************************
1368 Boring and alphabetical:
1370 addExprErrCtxt :: LHsExpr Name -> TcM a -> TcM a
1371 addExprErrCtxt expr = addErrCtxt (exprCtxt expr)
1373 exprCtxt :: LHsExpr Name -> SDoc
1375 = hang (ptext (sLit "In the expression:")) 2 (ppr expr)
1377 fieldCtxt :: Name -> SDoc
1378 fieldCtxt field_name
1379 = ptext (sLit "In the") <+> quotes (ppr field_name) <+> ptext (sLit "field of a record")
1381 funAppCtxt :: LHsExpr Name -> LHsExpr Name -> Int -> SDoc
1382 funAppCtxt fun arg arg_no
1383 = hang (hsep [ ptext (sLit "In the"), speakNth arg_no, ptext (sLit "argument of"),
1384 quotes (ppr fun) <> text ", namely"])
1385 2 (quotes (ppr arg))
1387 badFieldTypes :: [(Name,TcType)] -> SDoc
1389 = hang (ptext (sLit "Record update for insufficiently polymorphic field")
1390 <> plural prs <> colon)
1391 2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ])
1393 badFieldsUpd :: HsRecFields Name a -> SDoc
1395 = hang (ptext (sLit "No constructor has all these fields:"))
1396 2 (pprQuotedList (hsRecFields rbinds))
1398 naughtyRecordSel :: TcId -> SDoc
1399 naughtyRecordSel sel_id
1400 = ptext (sLit "Cannot use record selector") <+> quotes (ppr sel_id) <+>
1401 ptext (sLit "as a function due to escaped type variables") $$
1402 ptext (sLit "Probable fix: use pattern-matching syntax instead")
1404 notSelector :: Name -> SDoc
1406 = hsep [quotes (ppr field), ptext (sLit "is not a record selector")]
1408 missingStrictFields :: DataCon -> [FieldLabel] -> SDoc
1409 missingStrictFields con fields
1412 rest | null fields = empty -- Happens for non-record constructors
1413 -- with strict fields
1414 | otherwise = colon <+> pprWithCommas ppr fields
1416 header = ptext (sLit "Constructor") <+> quotes (ppr con) <+>
1417 ptext (sLit "does not have the required strict field(s)")
1419 missingFields :: DataCon -> [FieldLabel] -> SDoc
1420 missingFields con fields
1421 = ptext (sLit "Fields of") <+> quotes (ppr con) <+> ptext (sLit "not initialised:")
1422 <+> pprWithCommas ppr fields
1424 -- callCtxt fun args = ptext (sLit "In the call") <+> parens (ppr (foldl mkHsApp fun args))
1427 polySpliceErr :: Id -> SDoc
1429 = ptext (sLit "Can't splice the polymorphic local variable") <+> quotes (ppr id)