b8ab2bfea2c3515ec7a98f2e125f3749c18bf700
[ghc.git] / compiler / typecheck / ClsInst.hs
1 {-# LANGUAGE CPP #-}
2
3 module ClsInst (
4 matchGlobalInst,
5 ClsInstResult(..),
6 InstanceWhat(..), safeOverlap
7 ) where
8
9 #include "HsVersions.h"
10
11 import GhcPrelude
12
13 import TcEnv
14 import TcRnMonad
15 import TcType
16 import TcMType
17 import TcEvidence
18 import RnEnv( addUsedGRE )
19 import RdrName( lookupGRE_FieldLabel )
20 import InstEnv
21 import Inst( instDFunType )
22 import FamInst( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst )
23
24 import TysWiredIn
25 import TysPrim( eqPrimTyCon, eqReprPrimTyCon )
26 import PrelNames
27
28 import Id
29 import Type
30 import Kind( isConstraintKind )
31 import MkCore ( mkStringExprFS, mkNaturalExpr )
32
33 import Unique ( hasKey )
34 import Name ( Name )
35 import Var ( DFunId )
36 import DataCon
37 import TyCon
38 import Class
39 import DynFlags
40 import Outputable
41 import Util( splitAtList, fstOf3 )
42 import Data.Maybe
43
44 {- *******************************************************************
45 * *
46 Class lookup
47 * *
48 **********************************************************************-}
49
50 -- | Indicates if Instance met the Safe Haskell overlapping instances safety
51 -- check.
52 --
53 -- See Note [Safe Haskell Overlapping Instances] in TcSimplify
54 -- See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify
55 type SafeOverlapping = Bool
56
57 data ClsInstResult
58 = NoInstance -- Definitely no instance
59
60 | OneInst { cir_new_theta :: [TcPredType]
61 , cir_mk_ev :: [EvExpr] -> EvTerm
62 , cir_what :: InstanceWhat }
63
64 | NotSure -- Multiple matches and/or one or more unifiers
65
66 data InstanceWhat
67 = BuiltinInstance
68 | LocalInstance
69 | TopLevInstance { iw_dfun_id :: DFunId
70 , iw_safe_over :: SafeOverlapping }
71
72 instance Outputable ClsInstResult where
73 ppr NoInstance = text "NoInstance"
74 ppr NotSure = text "NotSure"
75 ppr (OneInst { cir_new_theta = ev
76 , cir_what = what })
77 = text "OneInst" <+> vcat [ppr ev, ppr what]
78
79 instance Outputable InstanceWhat where
80 ppr BuiltinInstance = text "built-in instance"
81 ppr LocalInstance = text "locally-quantified instance"
82 ppr (TopLevInstance { iw_safe_over = so })
83 = text "top-level instance" <+> (text $ if so then "[safe]" else "[unsafe]")
84
85 safeOverlap :: InstanceWhat -> Bool
86 safeOverlap (TopLevInstance { iw_safe_over = so }) = so
87 safeOverlap _ = True
88
89 matchGlobalInst :: DynFlags
90 -> Bool -- True <=> caller is the short-cut solver
91 -- See Note [Shortcut solving: overlap]
92 -> Class -> [Type] -> TcM ClsInstResult
93 matchGlobalInst dflags short_cut clas tys
94 | cls_name == knownNatClassName = matchKnownNat clas tys
95 | cls_name == knownSymbolClassName = matchKnownSymbol clas tys
96 | isCTupleClass clas = matchCTuple clas tys
97 | cls_name == typeableClassName = matchTypeable clas tys
98 | clas `hasKey` heqTyConKey = matchLiftedEquality tys
99 | clas `hasKey` coercibleTyConKey = matchLiftedCoercible tys
100 | cls_name == hasFieldClassName = matchHasField dflags short_cut clas tys
101 | otherwise = matchInstEnv dflags short_cut clas tys
102 where
103 cls_name = className clas
104
105
106 {- ********************************************************************
107 * *
108 Looking in the instance environment
109 * *
110 ***********************************************************************-}
111
112
113 matchInstEnv :: DynFlags -> Bool -> Class -> [Type] -> TcM ClsInstResult
114 matchInstEnv dflags short_cut_solver clas tys
115 = do { instEnvs <- tcGetInstEnvs
116 ; let safeOverlapCheck = safeHaskell dflags `elem` [Sf_Safe, Sf_Trustworthy]
117 (matches, unify, unsafeOverlaps) = lookupInstEnv True instEnvs clas tys
118 safeHaskFail = safeOverlapCheck && not (null unsafeOverlaps)
119 ; traceTc "matchInstEnv" $
120 vcat [ text "goal:" <+> ppr clas <+> ppr tys
121 , text "matches:" <+> ppr matches
122 , text "unify:" <+> ppr unify ]
123 ; case (matches, unify, safeHaskFail) of
124
125 -- Nothing matches
126 ([], [], _)
127 -> do { traceTc "matchClass not matching" (ppr pred)
128 ; return NoInstance }
129
130 -- A single match (& no safe haskell failure)
131 ([(ispec, inst_tys)], [], False)
132 | short_cut_solver -- Called from the short-cut solver
133 , isOverlappable ispec
134 -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT
135 -- then don't let the short-cut solver choose it, because a
136 -- later instance might overlap it. Trac #14434 is an example
137 -- See Note [Shortcut solving: overlap]
138 -> do { traceTc "matchClass: ignoring overlappable" (ppr pred)
139 ; return NotSure }
140
141 | otherwise
142 -> do { let dfun_id = instanceDFunId ispec
143 ; traceTc "matchClass success" $
144 vcat [text "dict" <+> ppr pred,
145 text "witness" <+> ppr dfun_id
146 <+> ppr (idType dfun_id) ]
147 -- Record that this dfun is needed
148 ; match_one (null unsafeOverlaps) dfun_id inst_tys }
149
150 -- More than one matches (or Safe Haskell fail!). Defer any
151 -- reactions of a multitude until we learn more about the reagent
152 _ -> do { traceTc "matchClass multiple matches, deferring choice" $
153 vcat [text "dict" <+> ppr pred,
154 text "matches" <+> ppr matches]
155 ; return NotSure } }
156 where
157 pred = mkClassPred clas tys
158
159 match_one :: SafeOverlapping -> DFunId -> [DFunInstType] -> TcM ClsInstResult
160 -- See Note [DFunInstType: instantiating types] in InstEnv
161 match_one so dfun_id mb_inst_tys
162 = do { traceTc "match_one" (ppr dfun_id $$ ppr mb_inst_tys)
163 ; (tys, theta) <- instDFunType dfun_id mb_inst_tys
164 ; traceTc "match_one 2" (ppr dfun_id $$ ppr tys $$ ppr theta)
165 ; return $ OneInst { cir_new_theta = theta
166 , cir_mk_ev = evDFunApp dfun_id tys
167 , cir_what = TopLevInstance { iw_dfun_id = dfun_id
168 , iw_safe_over = so } } }
169
170
171 {- ********************************************************************
172 * *
173 Class lookup for CTuples
174 * *
175 ***********************************************************************-}
176
177 matchCTuple :: Class -> [Type] -> TcM ClsInstResult
178 matchCTuple clas tys -- (isCTupleClass clas) holds
179 = return (OneInst { cir_new_theta = tys
180 , cir_mk_ev = tuple_ev
181 , cir_what = BuiltinInstance })
182 -- The dfun *is* the data constructor!
183 where
184 data_con = tyConSingleDataCon (classTyCon clas)
185 tuple_ev = evDFunApp (dataConWrapId data_con) tys
186
187 {- ********************************************************************
188 * *
189 Class lookup for Literals
190 * *
191 ***********************************************************************-}
192
193 {-
194 Note [KnownNat & KnownSymbol and EvLit]
195 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
196 A part of the type-level literals implementation are the classes
197 "KnownNat" and "KnownSymbol", which provide a "smart" constructor for
198 defining singleton values. Here is the key stuff from GHC.TypeLits
199
200 class KnownNat (n :: Nat) where
201 natSing :: SNat n
202
203 newtype SNat (n :: Nat) = SNat Integer
204
205 Conceptually, this class has infinitely many instances:
206
207 instance KnownNat 0 where natSing = SNat 0
208 instance KnownNat 1 where natSing = SNat 1
209 instance KnownNat 2 where natSing = SNat 2
210 ...
211
212 In practice, we solve `KnownNat` predicates in the type-checker
213 (see typecheck/TcInteract.hs) because we can't have infinitely many instances.
214 The evidence (aka "dictionary") for `KnownNat` is of the form `EvLit (EvNum n)`.
215
216 We make the following assumptions about dictionaries in GHC:
217 1. The "dictionary" for classes with a single method---like `KnownNat`---is
218 a newtype for the type of the method, so using a evidence amounts
219 to a coercion, and
220 2. Newtypes use the same representation as their definition types.
221
222 So, the evidence for `KnownNat` is just a value of the representation type,
223 wrapped in two newtype constructors: one to make it into a `SNat` value,
224 and another to make it into a `KnownNat` dictionary.
225
226 Also note that `natSing` and `SNat` are never actually exposed from the
227 library---they are just an implementation detail. Instead, users see
228 a more convenient function, defined in terms of `natSing`:
229
230 natVal :: KnownNat n => proxy n -> Integer
231
232 The reason we don't use this directly in the class is that it is simpler
233 and more efficient to pass around an integer rather than an entire function,
234 especially when the `KnowNat` evidence is packaged up in an existential.
235
236 The story for kind `Symbol` is analogous:
237 * class KnownSymbol
238 * newtype SSymbol
239 * Evidence: a Core literal (e.g. mkNaturalExpr)
240 -}
241
242 matchKnownNat :: Class -> [Type] -> TcM ClsInstResult
243 matchKnownNat clas [ty] -- clas = KnownNat
244 | Just n <- isNumLitTy ty = do
245 et <- mkNaturalExpr n
246 makeLitDict clas ty et
247 matchKnownNat _ _ = return NoInstance
248
249 matchKnownSymbol :: Class -> [Type] -> TcM ClsInstResult
250 matchKnownSymbol clas [ty] -- clas = KnownSymbol
251 | Just s <- isStrLitTy ty = do
252 et <- mkStringExprFS s
253 makeLitDict clas ty et
254 matchKnownSymbol _ _ = return NoInstance
255
256 makeLitDict :: Class -> Type -> EvExpr -> TcM ClsInstResult
257 -- makeLitDict adds a coercion that will convert the literal into a dictionary
258 -- of the appropriate type. See Note [KnownNat & KnownSymbol and EvLit]
259 -- in TcEvidence. The coercion happens in 2 steps:
260 --
261 -- Integer -> SNat n -- representation of literal to singleton
262 -- SNat n -> KnownNat n -- singleton to dictionary
263 --
264 -- The process is mirrored for Symbols:
265 -- String -> SSymbol n
266 -- SSymbol n -> KnownSymbol n
267 makeLitDict clas ty et
268 | Just (_, co_dict) <- tcInstNewTyCon_maybe (classTyCon clas) [ty]
269 -- co_dict :: KnownNat n ~ SNat n
270 , [ meth ] <- classMethods clas
271 , Just tcRep <- tyConAppTyCon_maybe -- SNat
272 $ funResultTy -- SNat n
273 $ dropForAlls -- KnownNat n => SNat n
274 $ idType meth -- forall n. KnownNat n => SNat n
275 , Just (_, co_rep) <- tcInstNewTyCon_maybe tcRep [ty]
276 -- SNat n ~ Integer
277 , let ev_tm = mkEvCast et (mkTcSymCo (mkTcTransCo co_dict co_rep))
278 = return $ OneInst { cir_new_theta = []
279 , cir_mk_ev = \_ -> ev_tm
280 , cir_what = BuiltinInstance }
281
282 | otherwise
283 = pprPanic "makeLitDict" $
284 text "Unexpected evidence for" <+> ppr (className clas)
285 $$ vcat (map (ppr . idType) (classMethods clas))
286
287 {- ********************************************************************
288 * *
289 Class lookup for Typeable
290 * *
291 ***********************************************************************-}
292
293 -- | Assumes that we've checked that this is the 'Typeable' class,
294 -- and it was applied to the correct argument.
295 matchTypeable :: Class -> [Type] -> TcM ClsInstResult
296 matchTypeable clas [k,t] -- clas = Typeable
297 -- For the first two cases, See Note [No Typeable for polytypes or qualified types]
298 | isForAllTy k = return NoInstance -- Polytype
299 | isJust (tcSplitPredFunTy_maybe t) = return NoInstance -- Qualified type
300
301 -- Now cases that do work
302 | k `eqType` typeNatKind = doTyLit knownNatClassName t
303 | k `eqType` typeSymbolKind = doTyLit knownSymbolClassName t
304 | isConstraintKind t = doTyConApp clas t constraintKindTyCon []
305 | Just (arg,ret) <- splitFunTy_maybe t = doFunTy clas t arg ret
306 | Just (tc, ks) <- splitTyConApp_maybe t -- See Note [Typeable (T a b c)]
307 , onlyNamedBndrsApplied tc ks = doTyConApp clas t tc ks
308 | Just (f,kt) <- splitAppTy_maybe t = doTyApp clas t f kt
309
310 matchTypeable _ _ = return NoInstance
311
312 -- | Representation for a type @ty@ of the form @arg -> ret@.
313 doFunTy :: Class -> Type -> Type -> Type -> TcM ClsInstResult
314 doFunTy clas ty arg_ty ret_ty
315 = return $ OneInst { cir_new_theta = preds
316 , cir_mk_ev = mk_ev
317 , cir_what = BuiltinInstance }
318 where
319 preds = map (mk_typeable_pred clas) [arg_ty, ret_ty]
320 mk_ev [arg_ev, ret_ev] = evTypeable ty $
321 EvTypeableTrFun (EvExpr arg_ev) (EvExpr ret_ev)
322 mk_ev _ = panic "TcInteract.doFunTy"
323
324
325 -- | Representation for type constructor applied to some kinds.
326 -- 'onlyNamedBndrsApplied' has ensured that this application results in a type
327 -- of monomorphic kind (e.g. all kind variables have been instantiated).
328 doTyConApp :: Class -> Type -> TyCon -> [Kind] -> TcM ClsInstResult
329 doTyConApp clas ty tc kind_args
330 | Just _ <- tyConRepName_maybe tc
331 = return $ OneInst { cir_new_theta = (map (mk_typeable_pred clas) kind_args)
332 , cir_mk_ev = mk_ev
333 , cir_what = BuiltinInstance }
334 | otherwise
335 = return NoInstance
336 where
337 mk_ev kinds = evTypeable ty $ EvTypeableTyCon tc (map EvExpr kinds)
338
339 -- | Representation for TyCon applications of a concrete kind. We just use the
340 -- kind itself, but first we must make sure that we've instantiated all kind-
341 -- polymorphism, but no more.
342 onlyNamedBndrsApplied :: TyCon -> [KindOrType] -> Bool
343 onlyNamedBndrsApplied tc ks
344 = all isNamedTyConBinder used_bndrs &&
345 not (any isNamedTyConBinder leftover_bndrs)
346 where
347 bndrs = tyConBinders tc
348 (used_bndrs, leftover_bndrs) = splitAtList ks bndrs
349
350 doTyApp :: Class -> Type -> Type -> KindOrType -> TcM ClsInstResult
351 -- Representation for an application of a type to a type-or-kind.
352 -- This may happen when the type expression starts with a type variable.
353 -- Example (ignoring kind parameter):
354 -- Typeable (f Int Char) -->
355 -- (Typeable (f Int), Typeable Char) -->
356 -- (Typeable f, Typeable Int, Typeable Char) --> (after some simp. steps)
357 -- Typeable f
358 doTyApp clas ty f tk
359 | isForAllTy (typeKind f)
360 = return NoInstance -- We can't solve until we know the ctr.
361 | otherwise
362 = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) [f, tk]
363 , cir_mk_ev = mk_ev
364 , cir_what = BuiltinInstance }
365 where
366 mk_ev [t1,t2] = evTypeable ty $ EvTypeableTyApp (EvExpr t1) (EvExpr t2)
367 mk_ev _ = panic "doTyApp"
368
369
370 -- Emit a `Typeable` constraint for the given type.
371 mk_typeable_pred :: Class -> Type -> PredType
372 mk_typeable_pred clas ty = mkClassPred clas [ typeKind ty, ty ]
373
374 -- Typeable is implied by KnownNat/KnownSymbol. In the case of a type literal
375 -- we generate a sub-goal for the appropriate class.
376 -- See Note [Typeable for Nat and Symbol]
377 doTyLit :: Name -> Type -> TcM ClsInstResult
378 doTyLit kc t = do { kc_clas <- tcLookupClass kc
379 ; let kc_pred = mkClassPred kc_clas [ t ]
380 mk_ev [ev] = evTypeable t $ EvTypeableTyLit (EvExpr ev)
381 mk_ev _ = panic "doTyLit"
382 ; return (OneInst { cir_new_theta = [kc_pred]
383 , cir_mk_ev = mk_ev
384 , cir_what = BuiltinInstance }) }
385
386 {- Note [Typeable (T a b c)]
387 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
388 For type applications we always decompose using binary application,
389 via doTyApp, until we get to a *kind* instantiation. Example
390 Proxy :: forall k. k -> *
391
392 To solve Typeable (Proxy (* -> *) Maybe) we
393 - First decompose with doTyApp,
394 to get (Typeable (Proxy (* -> *))) and Typeable Maybe
395 - Then solve (Typeable (Proxy (* -> *))) with doTyConApp
396
397 If we attempt to short-cut by solving it all at once, via
398 doTyConApp
399
400 (this note is sadly truncated FIXME)
401
402
403 Note [No Typeable for polytypes or qualified types]
404 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
405 We do not support impredicative typeable, such as
406 Typeable (forall a. a->a)
407 Typeable (Eq a => a -> a)
408 Typeable (() => Int)
409 Typeable (((),()) => Int)
410
411 See Trac #9858. For forall's the case is clear: we simply don't have
412 a TypeRep for them. For qualified but not polymorphic types, like
413 (Eq a => a -> a), things are murkier. But:
414
415 * We don't need a TypeRep for these things. TypeReps are for
416 monotypes only.
417
418 * Perhaps we could treat `=>` as another type constructor for `Typeable`
419 purposes, and thus support things like `Eq Int => Int`, however,
420 at the current state of affairs this would be an odd exception as
421 no other class works with impredicative types.
422 For now we leave it off, until we have a better story for impredicativity.
423
424
425 Note [Typeable for Nat and Symbol]
426 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
427 We have special Typeable instances for Nat and Symbol. Roughly we
428 have this instance, implemented here by doTyLit:
429 instance KnownNat n => Typeable (n :: Nat) where
430 typeRep = tyepNatTypeRep @n
431 where
432 Data.Typeable.Internals.typeNatTypeRep :: KnownNat a => TypeRep a
433
434 Ultimately typeNatTypeRep uses 'natSing' from KnownNat to get a
435 runtime value 'n'; it turns it into a string with 'show' and uses
436 that to whiz up a TypeRep TyCon for 'n', with mkTypeLitTyCon.
437 See #10348.
438
439 Because of this rule it's inadvisable (see #15322) to have a constraint
440 f :: (Typeable (n :: Nat)) => blah
441 in a function signature; it gives rise to overlap problems just as
442 if you'd written
443 f :: Eq [a] => blah
444 -}
445
446 {- ********************************************************************
447 * *
448 Class lookup for lifted equality
449 * *
450 ***********************************************************************-}
451
452 -- See also Note [The equality types story] in TysPrim
453 matchLiftedEquality :: [Type] -> TcM ClsInstResult
454 matchLiftedEquality args
455 = return (OneInst { cir_new_theta = [ mkTyConApp eqPrimTyCon args ]
456 , cir_mk_ev = evDFunApp (dataConWrapId heqDataCon) args
457 , cir_what = BuiltinInstance })
458
459 -- See also Note [The equality types story] in TysPrim
460 matchLiftedCoercible :: [Type] -> TcM ClsInstResult
461 matchLiftedCoercible args@[k, t1, t2]
462 = return (OneInst { cir_new_theta = [ mkTyConApp eqReprPrimTyCon args' ]
463 , cir_mk_ev = evDFunApp (dataConWrapId coercibleDataCon)
464 args
465 , cir_what = BuiltinInstance })
466 where
467 args' = [k, k, t1, t2]
468 matchLiftedCoercible args = pprPanic "matchLiftedCoercible" (ppr args)
469
470
471 {- ********************************************************************
472 * *
473 Class lookup for overloaded record fields
474 * *
475 ***********************************************************************-}
476
477 {-
478 Note [HasField instances]
479 ~~~~~~~~~~~~~~~~~~~~~~~~~
480 Suppose we have
481
482 data T y = MkT { foo :: [y] }
483
484 and `foo` is in scope. Then GHC will automatically solve a constraint like
485
486 HasField "foo" (T Int) b
487
488 by emitting a new wanted
489
490 T alpha -> [alpha] ~# T Int -> b
491
492 and building a HasField dictionary out of the selector function `foo`,
493 appropriately cast.
494
495 The HasField class is defined (in GHC.Records) thus:
496
497 class HasField (x :: k) r a | x r -> a where
498 getField :: r -> a
499
500 Since this is a one-method class, it is represented as a newtype.
501 Hence we can solve `HasField "foo" (T Int) b` by taking an expression
502 of type `T Int -> b` and casting it using the newtype coercion.
503 Note that
504
505 foo :: forall y . T y -> [y]
506
507 so the expression we construct is
508
509 foo @alpha |> co
510
511 where
512
513 co :: (T alpha -> [alpha]) ~# HasField "foo" (T Int) b
514
515 is built from
516
517 co1 :: (T alpha -> [alpha]) ~# (T Int -> b)
518
519 which is the new wanted, and
520
521 co2 :: (T Int -> b) ~# HasField "foo" (T Int) b
522
523 which can be derived from the newtype coercion.
524
525 If `foo` is not in scope, or has a higher-rank or existentially
526 quantified type, then the constraint is not solved automatically, but
527 may be solved by a user-supplied HasField instance. Similarly, if we
528 encounter a HasField constraint where the field is not a literal
529 string, or does not belong to the type, then we fall back on the
530 normal constraint solver behaviour.
531 -}
532
533 -- See Note [HasField instances]
534 matchHasField :: DynFlags -> Bool -> Class -> [Type] -> TcM ClsInstResult
535 matchHasField dflags short_cut clas tys
536 = do { fam_inst_envs <- tcGetFamInstEnvs
537 ; rdr_env <- getGlobalRdrEnv
538 ; case tys of
539 -- We are matching HasField {k} x r a...
540 [_k_ty, x_ty, r_ty, a_ty]
541 -- x should be a literal string
542 | Just x <- isStrLitTy x_ty
543 -- r should be an applied type constructor
544 , Just (tc, args) <- tcSplitTyConApp_maybe r_ty
545 -- use representation tycon (if data family); it has the fields
546 , let r_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs tc args)
547 -- x should be a field of r
548 , Just fl <- lookupTyConFieldLabel x r_tc
549 -- the field selector should be in scope
550 , Just gre <- lookupGRE_FieldLabel rdr_env fl
551
552 -> do { sel_id <- tcLookupId (flSelector fl)
553 ; (tv_prs, preds, sel_ty) <- tcInstType newMetaTyVars sel_id
554
555 -- The first new wanted constraint equates the actual
556 -- type of the selector with the type (r -> a) within
557 -- the HasField x r a dictionary. The preds will
558 -- typically be empty, but if the datatype has a
559 -- "stupid theta" then we have to include it here.
560 ; let theta = mkPrimEqPred sel_ty (mkFunTy r_ty a_ty) : preds
561
562 -- Use the equality proof to cast the selector Id to
563 -- type (r -> a), then use the newtype coercion to cast
564 -- it to a HasField dictionary.
565 mk_ev (ev1:evs) = evSelector sel_id tvs evs `evCast` co
566 where
567 co = mkTcSubCo (evTermCoercion (EvExpr ev1))
568 `mkTcTransCo` mkTcSymCo co2
569 mk_ev [] = panic "matchHasField.mk_ev"
570
571 Just (_, co2) = tcInstNewTyCon_maybe (classTyCon clas)
572 tys
573
574 tvs = mkTyVarTys (map snd tv_prs)
575
576 -- The selector must not be "naughty" (i.e. the field
577 -- cannot have an existentially quantified type), and
578 -- it must not be higher-rank.
579 ; if not (isNaughtyRecordSelector sel_id) && isTauTy sel_ty
580 then do { addUsedGRE True gre
581 ; return OneInst { cir_new_theta = theta
582 , cir_mk_ev = mk_ev
583 , cir_what = BuiltinInstance } }
584 else matchInstEnv dflags short_cut clas tys }
585
586 _ -> matchInstEnv dflags short_cut clas tys }