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 GenSigCtxt 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 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 <- addErrCtxt (funResCtxt fun) $
823 unifyType actual_res_ty res_ty
825 -- Typecheck the arguments
826 ; args1 <- tcArgs fun args expected_arg_tys
828 -- Assemble the result
829 ; let fun2 = mkLHsWrapCoI co_fun fun1
830 app = mkLHsWrapCoI co_res (foldl mkHsApp fun2 args1)
832 ; return (unLoc app) }
835 mk_app_msg :: LHsExpr Name -> SDoc
836 mk_app_msg fun = sep [ ptext (sLit "The function") <+> quotes (ppr fun)
837 , ptext (sLit "is applied to")]
840 tcInferApp :: LHsExpr Name -> [LHsExpr Name] -- Function and args
841 -> TcM (HsExpr TcId, TcRhoType) -- Translated fun and args
843 tcInferApp (L _ (HsPar e)) args = tcInferApp e args
844 tcInferApp (L _ (HsApp e1 e2)) args = tcInferApp e1 (e2:args)
846 = -- Very like the tcApp version, except that there is
847 -- no expected result type passed in
848 do { (fun1, fun_tau) <- tcInferFun fun
849 ; (co_fun, expected_arg_tys, actual_res_ty)
850 <- matchExpectedFunTys (mk_app_msg fun) (length args) fun_tau
851 ; args1 <- tcArgs fun args expected_arg_tys
852 ; let fun2 = mkLHsWrapCoI co_fun fun1
853 app = foldl mkHsApp fun2 args1
854 ; return (unLoc app, actual_res_ty) }
857 tcInferFun :: LHsExpr Name -> TcM (LHsExpr TcId, TcRhoType)
858 -- Infer and instantiate the type of a function
859 tcInferFun (L loc (HsVar name))
860 = do { (fun, ty) <- setSrcSpan loc (tcInferId name)
861 -- Don't wrap a context around a plain Id
862 ; return (L loc fun, ty) }
865 = do { (fun, fun_ty) <- tcInfer (tcMonoExpr fun)
867 -- Zonk the function type carefully, to expose any polymorphism
868 -- E.g. (( \(x::forall a. a->a). blah ) e)
869 -- We can see the rank-2 type of the lambda in time to genrealise e
870 ; fun_ty' <- zonkTcTypeCarefully fun_ty
872 ; (wrap, rho) <- deeplyInstantiate AppOrigin fun_ty'
873 ; return (mkLHsWrap wrap fun, rho) }
876 tcArgs :: LHsExpr Name -- The function (for error messages)
877 -> [LHsExpr Name] -> [TcSigmaType] -- Actual arguments and expected arg types
878 -> TcM [LHsExpr TcId] -- Resulting args
880 tcArgs fun args expected_arg_tys
881 = mapM (tcArg fun) (zip3 args expected_arg_tys [1..])
884 tcArg :: LHsExpr Name -- The function (for error messages)
885 -> (LHsExpr Name, TcSigmaType, Int) -- Actual argument and expected arg type
886 -> TcM (LHsExpr TcId) -- Resulting argument
887 tcArg fun (arg, ty, arg_no) = addErrCtxt (funAppCtxt fun arg arg_no)
888 (tcPolyExprNC arg ty)
891 tcTupArgs :: [HsTupArg Name] -> [TcSigmaType] -> TcM [HsTupArg TcId]
893 = ASSERT( equalLength args tys ) mapM go (args `zip` tys)
895 go (Missing {}, arg_ty) = return (Missing arg_ty)
896 go (Present expr, arg_ty) = do { expr' <- tcPolyExpr expr arg_ty
897 ; return (Present expr') }
900 unifyOpFunTys :: LHsExpr Name -> Arity -> TcRhoType
901 -> TcM (CoercionI, [TcSigmaType], TcRhoType)
902 -- A wrapper for matchExpectedFunTys
903 unifyOpFunTys op arity ty = matchExpectedFunTys herald arity ty
905 herald = ptext (sLit "The operator") <+> quotes (ppr op) <+> ptext (sLit "takes")
907 ---------------------------
908 tcSyntaxOp :: CtOrigin -> HsExpr Name -> TcType -> TcM (HsExpr TcId)
909 -- Typecheck a syntax operator, checking that it has the specified type
910 -- The operator is always a variable at this stage (i.e. renamer output)
911 -- This version assumes res_ty is a monotype
912 tcSyntaxOp orig (HsVar op) res_ty = do { (expr, rho) <- tcInferIdWithOrig orig op
913 ; tcWrapResult expr rho res_ty }
914 tcSyntaxOp _ other _ = pprPanic "tcSyntaxOp" (ppr other)
918 Note [Push result type in]
919 ~~~~~~~~~~~~~~~~~~~~~~~~~~
920 Unify with expected result before type-checking the args so that the
921 info from res_ty percolates to args. This is when we might detect a
922 too-few args situation. (One can think of cases when the opposite
923 order would give a better error message.)
924 experimenting with putting this first.
926 Here's an example where it actually makes a real difference
928 class C t a b | t a -> b
929 instance C Char a Bool
931 data P t a = forall b. (C t a b) => MkP b
932 data Q t = MkQ (forall a. P t a)
936 f2 = MkQ (MkP True :: forall a. P Char a)
938 With the change, f1 will type-check, because the 'Char' info from
939 the signature is propagated into MkQ's argument. With the check
940 in the other order, the extra signature in f2 is reqd.
943 %************************************************************************
947 %************************************************************************
950 tcCheckId :: Name -> TcRhoType -> TcM (HsExpr TcId)
951 tcCheckId name res_ty = do { (expr, rho) <- tcInferId name
952 ; tcWrapResult expr rho res_ty }
954 ------------------------
955 tcInferId :: Name -> TcM (HsExpr TcId, TcRhoType)
956 -- Infer type, and deeply instantiate
957 tcInferId n = tcInferIdWithOrig (OccurrenceOf n) n
959 ------------------------
960 tcInferIdWithOrig :: CtOrigin -> Name -> TcM (HsExpr TcId, TcRhoType)
961 -- Look up an occurrence of an Id, and instantiate it (deeply)
963 tcInferIdWithOrig orig id_name
964 = do { id <- lookup_id
965 ; (id_expr, id_rho) <- instantiateOuter orig id
966 ; (wrap, rho) <- deeplyInstantiate orig id_rho
967 ; return (mkHsWrap wrap id_expr, rho) }
969 lookup_id :: TcM TcId
971 = do { thing <- tcLookup id_name
973 ATcId { tct_id = id, tct_level = lvl }
974 -> do { check_naughty id -- Note [Local record selectors]
975 ; checkThLocalId id lvl
979 -> do { check_naughty id; return id }
980 -- A global cannot possibly be ill-staged
981 -- nor does it need the 'lifting' treatment
982 -- hence no checkTh stuff here
984 AGlobal (ADataCon con) -> return (dataConWrapId con)
986 other -> failWithTc (bad_lookup other) }
988 bad_lookup thing = ppr thing <+> ptext (sLit "used where a value identifer was expected")
991 | isNaughtyRecordSelector id = failWithTc (naughtyRecordSel id)
992 | otherwise = return ()
994 ------------------------
995 instantiateOuter :: CtOrigin -> TcId -> TcM (HsExpr TcId, TcSigmaType)
996 -- Do just the first level of instantiation of an Id
997 -- a) Deal with method sharing
998 -- b) Deal with stupid checks
999 -- Only look at the *outer level* of quantification
1000 -- See Note [Multiple instantiation]
1002 instantiateOuter orig id
1003 | null tvs && null theta
1004 = return (HsVar id, tau)
1007 = do { (_, tys, subst) <- tcInstTyVars tvs
1008 ; doStupidChecks id tys
1009 ; let theta' = substTheta subst theta
1010 ; traceTc "Instantiating" (ppr id <+> text "with" <+> (ppr tys $$ ppr theta'))
1011 ; wrap <- instCall orig tys theta'
1012 ; return (mkHsWrap wrap (HsVar id), substTy subst tau) }
1014 (tvs, theta, tau) = tcSplitSigmaTy (idType id)
1017 Note [Multiple instantiation]
1018 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1019 We are careful never to make a MethodInst that has, as its meth_id, another MethodInst.
1020 For example, consider
1021 f :: forall a. Eq a => forall b. Ord b => a -> b
1022 At a call to f, at say [Int, Bool], it's tempting to translate the call to
1026 f_m1 :: forall b. Ord b => Int -> b
1030 f_m2 = f_m1 Bool dOrdBool
1032 But notice that f_m2 has f_m1 as its meth_id. Now the danger is that if we do
1033 a tcSimplCheck with a Given f_mx :: f Int dEqInt, we may make a binding
1035 But it's entirely possible that f_m2 will continue to float out, because it
1036 mentions no type variables. Result, f_m1 isn't in scope.
1038 Here's a concrete example that does this (test tc200):
1041 f :: Eq b => b -> a -> Int
1042 baz :: Eq a => Int -> a -> Int
1044 instance C Int where
1047 Current solution: only do the "method sharing" thing for the first type/dict
1048 application, not for the iterated ones. A horribly subtle point.
1050 Note [No method sharing]
1051 ~~~~~~~~~~~~~~~~~~~~~~~~
1052 The -fno-method-sharing flag controls what happens so far as the LIE
1053 is concerned. The default case is that for an overloaded function we
1054 generate a "method" Id, and add the Method Inst to the LIE. So you get
1056 f :: Num a => a -> a
1057 f = /\a (d:Num a) -> let m = (+) a d in \ (x:a) -> m x x
1058 If you specify -fno-method-sharing, the dictionary application
1059 isn't shared, so we get
1060 f :: Num a => a -> a
1061 f = /\a (d:Num a) (x:a) -> (+) a d x x
1062 This gets a bit less sharing, but
1063 a) it's better for RULEs involving overloaded functions
1064 b) perhaps fewer separated lambdas
1067 doStupidChecks :: TcId
1070 -- Check two tiresome and ad-hoc cases
1071 -- (a) the "stupid theta" for a data con; add the constraints
1072 -- from the "stupid theta" of a data constructor (sigh)
1074 doStupidChecks fun_id tys
1075 | Just con <- isDataConId_maybe fun_id -- (a)
1076 = addDataConStupidTheta con tys
1078 | fun_id `hasKey` tagToEnumKey -- (b)
1079 = failWithTc (ptext (sLit "tagToEnum# must appear applied to one argument"))
1082 = return () -- The common case
1087 Nasty check to ensure that tagToEnum# is applied to a type that is an
1088 enumeration TyCon. Unification may refine the type later, but this
1089 check won't see that, alas. It's crude, because it relies on our
1090 knowing *now* that the type is ok, which in turn relies on the
1091 eager-unification part of the type checker pushing enough information
1092 here. In theory the Right Thing to do is to have a new form of
1093 constraint but I definitely cannot face that! And it works ok as-is.
1095 Here's are two cases that should fail
1097 f = tagToEnum# 0 -- Can't do tagToEnum# at a type variable
1100 g = tagToEnum# 0 -- Int is not an enumeration
1102 When data type families are involved it's a bit more complicated.
1104 data instance F [Int] = A | B | C
1105 Then we want to generate something like
1106 tagToEnum# R:FListInt 3# |> co :: R:FListInt ~ F [Int]
1107 Usually that coercion is hidden inside the wrappers for
1108 constructors of F [Int] but here we have to do it explicitly.
1110 It's all grotesquely complicated.
1113 tcTagToEnum :: SrcSpan -> Name -> LHsExpr Name -> TcRhoType -> TcM (HsExpr TcId)
1114 -- tagToEnum# :: forall a. Int# -> a
1115 -- See Note [tagToEnum#] Urgh!
1116 tcTagToEnum loc fun_name arg res_ty
1117 = do { fun <- tcLookupId fun_name
1118 ; ty' <- zonkTcType res_ty
1120 -- Check that the type is algebraic
1121 ; let mb_tc_app = tcSplitTyConApp_maybe ty'
1122 Just (tc, tc_args) = mb_tc_app
1123 ; checkTc (isJust mb_tc_app)
1124 (tagToEnumError ty' doc1)
1126 -- Look through any type family
1127 ; (coi, rep_tc, rep_args) <- get_rep_ty ty' tc tc_args
1129 ; checkTc (isEnumerationTyCon rep_tc)
1130 (tagToEnumError ty' doc2)
1132 ; arg' <- tcMonoExpr arg intPrimTy
1133 ; let fun' = L loc (HsWrap (WpTyApp rep_ty) (HsVar fun))
1134 rep_ty = mkTyConApp rep_tc rep_args
1136 ; return (mkHsWrapCoI coi $ HsApp fun' arg') }
1138 doc1 = vcat [ ptext (sLit "Specify the type by giving a type signature")
1139 , ptext (sLit "e.g. (tagToEnum# x) :: Bool") ]
1140 doc2 = ptext (sLit "Result type must be an enumeration type")
1141 doc3 = ptext (sLit "No family instance for this type")
1143 get_rep_ty :: TcType -> TyCon -> [TcType]
1144 -> TcM (CoercionI, TyCon, [TcType])
1145 -- Converts a family type (eg F [a]) to its rep type (eg FList a)
1146 -- and returns a coercion between the two
1147 get_rep_ty ty tc tc_args
1148 | not (isFamilyTyCon tc)
1149 = return (IdCo ty, tc, tc_args)
1151 = do { mb_fam <- tcLookupFamInst tc tc_args
1153 Nothing -> failWithTc (tagToEnumError ty doc3)
1154 Just (rep_tc, rep_args)
1155 -> return ( ACo (mkSymCoercion (mkTyConApp co_tc rep_args))
1156 , rep_tc, rep_args )
1158 co_tc = expectJust "tcTagToEnum" $
1159 tyConFamilyCoercion_maybe rep_tc }
1161 tagToEnumError :: TcType -> SDoc -> SDoc
1162 tagToEnumError ty what
1163 = hang (ptext (sLit "Bad call to tagToEnum#")
1164 <+> ptext (sLit "at type") <+> ppr ty)
1169 %************************************************************************
1171 Template Haskell checks
1173 %************************************************************************
1176 checkThLocalId :: Id -> ThLevel -> TcM ()
1177 #ifndef GHCI /* GHCI and TH is off */
1178 --------------------------------------
1179 -- Check for cross-stage lifting
1180 checkThLocalId _id _bind_lvl
1183 #else /* GHCI and TH is on */
1184 checkThLocalId id bind_lvl
1185 = do { use_stage <- getStage -- TH case
1186 ; let use_lvl = thLevel use_stage
1187 ; checkWellStaged (quotes (ppr id)) bind_lvl use_lvl
1188 ; traceTc "thLocalId" (ppr id <+> ppr bind_lvl <+> ppr use_stage <+> ppr use_lvl)
1189 ; when (use_lvl > bind_lvl) $
1190 checkCrossStageLifting id bind_lvl use_stage }
1192 --------------------------------------
1193 checkCrossStageLifting :: Id -> ThLevel -> ThStage -> TcM ()
1194 -- We are inside brackets, and (use_lvl > bind_lvl)
1195 -- Now we must check whether there's a cross-stage lift to do
1196 -- Examples \x -> [| x |]
1199 checkCrossStageLifting _ _ Comp = return ()
1200 checkCrossStageLifting _ _ Splice = return ()
1202 checkCrossStageLifting id _ (Brack _ ps_var lie_var)
1204 = -- Top-level identifiers in this module,
1205 -- (which have External Names)
1206 -- are just like the imported case:
1207 -- no need for the 'lifting' treatment
1208 -- E.g. this is fine:
1211 -- But we do need to put f into the keep-alive
1212 -- set, because after desugaring the code will
1213 -- only mention f's *name*, not f itself.
1216 | otherwise -- bind_lvl = outerLevel presumably,
1217 -- but the Id is not bound at top level
1218 = -- Nested identifiers, such as 'x' in
1219 -- E.g. \x -> [| h x |]
1220 -- We must behave as if the reference to x was
1222 -- We use 'x' itself as the splice proxy, used by
1223 -- the desugarer to stitch it all back together.
1224 -- If 'x' occurs many times we may get many identical
1225 -- bindings of the same splice proxy, but that doesn't
1226 -- matter, although it's a mite untidy.
1227 do { let id_ty = idType id
1228 ; checkTc (isTauTy id_ty) (polySpliceErr id)
1229 -- If x is polymorphic, its occurrence sites might
1230 -- have different instantiations, so we can't use plain
1231 -- 'x' as the splice proxy name. I don't know how to
1232 -- solve this, and it's probably unimportant, so I'm
1233 -- just going to flag an error for now
1235 ; lift <- if isStringTy id_ty then
1236 do { sid <- tcLookupId DsMeta.liftStringName
1237 -- See Note [Lifting strings]
1238 ; return (HsVar sid) }
1240 setConstraintVar lie_var $ do
1241 -- Put the 'lift' constraint into the right LIE
1242 newMethodFromName (OccurrenceOf (idName id))
1243 DsMeta.liftName id_ty
1245 -- Update the pending splices
1246 ; ps <- readMutVar ps_var
1247 ; writeMutVar ps_var ((idName id, nlHsApp (noLoc lift) (nlHsVar id)) : ps)
1253 Note [Lifting strings]
1254 ~~~~~~~~~~~~~~~~~~~~~~
1255 If we see $(... [| s |] ...) where s::String, we don't want to
1256 generate a mass of Cons (CharL 'x') (Cons (CharL 'y') ...)) etc.
1257 So this conditional short-circuits the lifting mechanism to generate
1258 (liftString "xy") in that case. I didn't want to use overlapping instances
1259 for the Lift class in TH.Syntax, because that can lead to overlapping-instance
1260 errors in a polymorphic situation.
1262 If this check fails (which isn't impossible) we get another chance; see
1263 Note [Converting strings] in Convert.lhs
1265 Local record selectors
1266 ~~~~~~~~~~~~~~~~~~~~~~
1267 Record selectors for TyCons in this module are ordinary local bindings,
1268 which show up as ATcIds rather than AGlobals. So we need to check for
1269 naughtiness in both branches. c.f. TcTyClsBindings.mkAuxBinds.
1272 %************************************************************************
1274 \subsection{Record bindings}
1276 %************************************************************************
1278 Game plan for record bindings
1279 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1280 1. Find the TyCon for the bindings, from the first field label.
1282 2. Instantiate its tyvars and unify (T a1 .. an) with expected_ty.
1284 For each binding field = value
1286 3. Instantiate the field type (from the field label) using the type
1289 4 Type check the value using tcArg, passing the field type as
1290 the expected argument type.
1292 This extends OK when the field types are universally quantified.
1298 -> [TcType] -- Expected type for each field
1299 -> HsRecordBinds Name
1300 -> TcM (HsRecordBinds TcId)
1302 tcRecordBinds data_con arg_tys (HsRecFields rbinds dd)
1303 = do { mb_binds <- mapM do_bind rbinds
1304 ; return (HsRecFields (catMaybes mb_binds) dd) }
1306 flds_w_tys = zipEqual "tcRecordBinds" (dataConFieldLabels data_con) arg_tys
1307 do_bind fld@(HsRecField { hsRecFieldId = L loc field_lbl, hsRecFieldArg = rhs })
1308 | Just field_ty <- assocMaybe flds_w_tys field_lbl
1309 = addErrCtxt (fieldCtxt field_lbl) $
1310 do { rhs' <- tcPolyExprNC rhs field_ty
1311 ; let field_id = mkUserLocal (nameOccName field_lbl)
1312 (nameUnique field_lbl)
1314 -- Yuk: the field_id has the *unique* of the selector Id
1315 -- (so we can find it easily)
1316 -- but is a LocalId with the appropriate type of the RHS
1317 -- (so the desugarer knows the type of local binder to make)
1318 ; return (Just (fld { hsRecFieldId = L loc field_id, hsRecFieldArg = rhs' })) }
1320 = do { addErrTc (badFieldCon data_con field_lbl)
1323 checkMissingFields :: DataCon -> HsRecordBinds Name -> TcM ()
1324 checkMissingFields data_con rbinds
1325 | null field_labels -- Not declared as a record;
1326 -- But C{} is still valid if no strict fields
1327 = if any isBanged field_strs then
1328 -- Illegal if any arg is strict
1329 addErrTc (missingStrictFields data_con [])
1333 | otherwise = do -- A record
1334 unless (null missing_s_fields)
1335 (addErrTc (missingStrictFields data_con missing_s_fields))
1337 warn <- doptM Opt_WarnMissingFields
1338 unless (not (warn && notNull missing_ns_fields))
1339 (warnTc True (missingFields data_con missing_ns_fields))
1343 = [ fl | (fl, str) <- field_info,
1345 not (fl `elem` field_names_used)
1348 = [ fl | (fl, str) <- field_info,
1350 not (fl `elem` field_names_used)
1353 field_names_used = hsRecFields rbinds
1354 field_labels = dataConFieldLabels data_con
1356 field_info = zipEqual "missingFields"
1360 field_strs = dataConStrictMarks data_con
1363 %************************************************************************
1365 \subsection{Errors and contexts}
1367 %************************************************************************
1369 Boring and alphabetical:
1371 addExprErrCtxt :: LHsExpr Name -> TcM a -> TcM a
1372 addExprErrCtxt expr = addErrCtxt (exprCtxt expr)
1374 exprCtxt :: LHsExpr Name -> SDoc
1376 = hang (ptext (sLit "In the expression:")) 2 (ppr expr)
1378 fieldCtxt :: Name -> SDoc
1379 fieldCtxt field_name
1380 = ptext (sLit "In the") <+> quotes (ppr field_name) <+> ptext (sLit "field of a record")
1382 funAppCtxt :: LHsExpr Name -> LHsExpr Name -> Int -> SDoc
1383 funAppCtxt fun arg arg_no
1384 = hang (hsep [ ptext (sLit "In the"), speakNth arg_no, ptext (sLit "argument of"),
1385 quotes (ppr fun) <> text ", namely"])
1386 2 (quotes (ppr arg))
1388 funResCtxt :: LHsExpr Name -> SDoc
1390 = ptext (sLit "In the return type of a call of") <+> quotes (ppr fun)
1392 badFieldTypes :: [(Name,TcType)] -> SDoc
1394 = hang (ptext (sLit "Record update for insufficiently polymorphic field")
1395 <> plural prs <> colon)
1396 2 (vcat [ ppr f <+> dcolon <+> ppr ty | (f,ty) <- prs ])
1398 badFieldsUpd :: HsRecFields Name a -> SDoc
1400 = hang (ptext (sLit "No constructor has all these fields:"))
1401 2 (pprQuotedList (hsRecFields rbinds))
1403 naughtyRecordSel :: TcId -> SDoc
1404 naughtyRecordSel sel_id
1405 = ptext (sLit "Cannot use record selector") <+> quotes (ppr sel_id) <+>
1406 ptext (sLit "as a function due to escaped type variables") $$
1407 ptext (sLit "Probable fix: use pattern-matching syntax instead")
1409 notSelector :: Name -> SDoc
1411 = hsep [quotes (ppr field), ptext (sLit "is not a record selector")]
1413 missingStrictFields :: DataCon -> [FieldLabel] -> SDoc
1414 missingStrictFields con fields
1417 rest | null fields = empty -- Happens for non-record constructors
1418 -- with strict fields
1419 | otherwise = colon <+> pprWithCommas ppr fields
1421 header = ptext (sLit "Constructor") <+> quotes (ppr con) <+>
1422 ptext (sLit "does not have the required strict field(s)")
1424 missingFields :: DataCon -> [FieldLabel] -> SDoc
1425 missingFields con fields
1426 = ptext (sLit "Fields of") <+> quotes (ppr con) <+> ptext (sLit "not initialised:")
1427 <+> pprWithCommas ppr fields
1429 -- callCtxt fun args = ptext (sLit "In the call") <+> parens (ppr (foldl mkHsApp fun args))
1432 polySpliceErr :: Id -> SDoc
1434 = ptext (sLit "Can't splice the polymorphic local variable") <+> quotes (ppr id)