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