never executed always true always false
1
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE ScopedTypeVariables #-}
4 {-# LANGUAGE TypeFamilies #-}
5
6 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
7
8 {-
9 (c) The University of Glasgow 2011
10
11 -}
12
13 -- | The deriving code for the Generic class
14 module GHC.Tc.Deriv.Generics
15 (canDoGenerics
16 , canDoGenerics1
17 , GenericKind(..)
18 , gen_Generic_binds
19 , get_gen1_constrained_tys
20 )
21 where
22
23 import GHC.Prelude
24
25 import GHC.Hs
26 import GHC.Core.Type
27 import GHC.Tc.Utils.TcType
28 import GHC.Tc.Deriv.Generate
29 import GHC.Tc.Deriv.Functor
30 import GHC.Tc.Errors.Types
31 import GHC.Core.DataCon
32 import GHC.Core.TyCon
33 import GHC.Core.FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom )
34 import GHC.Core.Multiplicity
35 import GHC.Tc.Instance.Family
36 import GHC.Unit.Module ( moduleName, moduleNameFS
37 , moduleUnit, unitFS, getModule )
38 import GHC.Iface.Env ( newGlobalBinder )
39 import GHC.Types.Name hiding ( varName )
40 import GHC.Types.Name.Reader
41 import GHC.Types.Fixity.Env
42 import GHC.Types.SourceText
43 import GHC.Types.Fixity
44 import GHC.Types.Basic
45 import GHC.Builtin.Types.Prim
46 import GHC.Builtin.Types
47 import GHC.Builtin.Names
48 import GHC.Tc.Utils.Env
49 import GHC.Tc.Utils.Monad
50 import GHC.Driver.Session
51 import GHC.Utils.Error( Validity'(..), andValid )
52 import GHC.Types.SrcLoc
53 import GHC.Data.Bag
54 import GHC.Types.Var.Env
55 import GHC.Types.Var.Set (elemVarSet)
56 import GHC.Utils.Outputable
57 import GHC.Utils.Panic
58 import GHC.Utils.Panic.Plain
59 import GHC.Data.FastString
60 import GHC.Utils.Misc
61
62 import Control.Monad (mplus)
63 import Data.List (zip4, partition)
64 import Data.Maybe (isJust)
65
66 {-
67 ************************************************************************
68 * *
69 \subsection{Bindings for the new generic deriving mechanism}
70 * *
71 ************************************************************************
72
73 For the generic representation we need to generate:
74 \begin{itemize}
75 \item A Generic instance
76 \item A Rep type instance
77 \item Many auxiliary datatypes and instances for them (for the meta-information)
78 \end{itemize}
79 -}
80
81 gen_Generic_binds :: GenericKind -> TyCon -> [Type]
82 -> TcM (LHsBinds GhcPs, [LSig GhcPs], FamInst)
83 gen_Generic_binds gk tc inst_tys = do
84 dflags <- getDynFlags
85 repTyInsts <- tc_mkRepFamInsts gk tc inst_tys
86 let (binds, sigs) = mkBindsRep dflags gk tc
87 return (binds, sigs, repTyInsts)
88
89 {-
90 ************************************************************************
91 * *
92 \subsection{Generating representation types}
93 * *
94 ************************************************************************
95 -}
96
97 get_gen1_constrained_tys :: TyVar -> Type -> [Type]
98 -- called by GHC.Tc.Deriv.Infer.inferConstraints; generates a list of
99 -- types, each of which must be a Functor in order for the Generic1 instance to
100 -- work.
101 get_gen1_constrained_tys argVar
102 = argTyFold argVar $ ArgTyAlg { ata_rec0 = const []
103 , ata_par1 = [], ata_rec1 = const []
104 , ata_comp = (:) }
105
106 {-
107
108 Note [Requirements for deriving Generic and Rep]
109 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
110
111 In the following, T, Tfun, and Targ are "meta-variables" ranging over type
112 expressions.
113
114 (Generic T) and (Rep T) are derivable for some type expression T if the
115 following constraints are satisfied.
116
117 (a) D is a type constructor *value*. In other words, D is either a type
118 constructor or it is equivalent to the head of a data family instance (up to
119 alpha-renaming).
120
121 (b) D cannot have a "stupid context".
122
123 (c) The right-hand side of D cannot include existential types, universally
124 quantified types, or "exotic" unlifted types. An exotic unlifted type
125 is one which is not listed in the definition of allowedUnliftedTy
126 (i.e., one for which we have no representation type).
127 See Note [Generics and unlifted types]
128
129 (d) T :: *.
130
131 (Generic1 T) and (Rep1 T) are derivable for some type expression T if the
132 following constraints are satisfied.
133
134 (a),(b),(c) As above.
135
136 (d) T must expect arguments, and its last parameter must have kind *.
137
138 We use `a' to denote the parameter of D that corresponds to the last
139 parameter of T.
140
141 (e) For any type-level application (Tfun Targ) in the right-hand side of D
142 where the head of Tfun is not a tuple constructor:
143
144 (b1) `a' must not occur in Tfun.
145
146 (b2) If `a' occurs in Targ, then Tfun :: * -> *.
147
148 -}
149
150 canDoGenerics :: TyCon -> Validity' [DeriveGenericsErrReason]
151 -- canDoGenerics determines if Generic/Rep can be derived.
152 --
153 -- Check (a) from Note [Requirements for deriving Generic and Rep] is taken
154 -- care of because canDoGenerics is applied to rep tycons.
155 --
156 -- It returns IsValid if deriving is possible. It returns (NotValid reason)
157 -- if not.
158 canDoGenerics tc
159 = mergeErrors (
160 -- Check (b) from Note [Requirements for deriving Generic and Rep].
161 (if (not (null (tyConStupidTheta tc)))
162 then (NotValid $ DerivErrGenericsMustNotHaveDatatypeContext tc_name)
163 else IsValid)
164 -- See comment below
165 : (map bad_con (tyConDataCons tc)))
166 where
167 -- The tc can be a representation tycon. When we want to display it to the
168 -- user (in an error message) we should print its parent
169 tc_name = case tyConFamInst_maybe tc of
170 Just (ptc, _) -> ptc
171 _ -> tc
172
173 -- Check (c) from Note [Requirements for deriving Generic and Rep].
174 --
175 -- If any of the constructors has an exotic unlifted type as argument,
176 -- then we can't build the embedding-projection pair, because
177 -- it relies on instantiating *polymorphic* sum and product types
178 -- at the argument types of the constructors
179 bad_con :: DataCon -> Validity' DeriveGenericsErrReason
180 bad_con dc = if any bad_arg_type (map scaledThing $ dataConOrigArgTys dc)
181 then NotValid $ DerivErrGenericsMustNotHaveExoticArgs dc
182 else if not (isVanillaDataCon dc)
183 then NotValid $ DerivErrGenericsMustBeVanillaDataCon dc
184 else IsValid
185
186 -- Nor can we do the job if it's an existential data constructor,
187 -- Nor if the args are polymorphic types (I don't think)
188 bad_arg_type ty = (isUnliftedType ty && not (allowedUnliftedTy ty))
189 || not (isTauTy ty)
190
191 -- Returns True the Type argument is an unlifted type which has a
192 -- corresponding generic representation type. For example,
193 -- (allowedUnliftedTy Int#) would return True since there is the UInt
194 -- representation type.
195 allowedUnliftedTy :: Type -> Bool
196 allowedUnliftedTy = isJust . unboxedRepRDRs
197
198 mergeErrors :: [Validity' a] -> Validity' [a]
199 mergeErrors [] = IsValid
200 mergeErrors (NotValid s:t) = case mergeErrors t of
201 IsValid -> NotValid [s]
202 NotValid s' -> NotValid (s : s')
203 mergeErrors (IsValid : t) = mergeErrors t
204 -- NotValid s' -> NotValid (s <> text ", and" $$ s')
205
206 -- A datatype used only inside of canDoGenerics1. It's the result of analysing
207 -- a type term.
208 data Check_for_CanDoGenerics1 = CCDG1
209 { _ccdg1_hasParam :: Bool -- does the parameter of interest occurs in
210 -- this type?
211 , _ccdg1_errors :: Validity' DeriveGenericsErrReason -- errors generated by this type
212 }
213
214 {-
215
216 Note [degenerate use of FFoldType]
217 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
218
219 We use foldDataConArgs here only for its ability to treat tuples
220 specially. foldDataConArgs also tracks covariance (though it assumes all
221 higher-order type parameters are covariant) and has hooks for special handling
222 of functions and polytypes, but we do *not* use those.
223
224 The key issue is that Generic1 deriving currently offers no sophisticated
225 support for functions. For example, we cannot handle
226
227 data F a = F ((a -> Int) -> Int)
228
229 even though a is occurring covariantly.
230
231 In fact, our rule is harsh: a is simply not allowed to occur within the first
232 argument of (->). We treat (->) the same as any other non-tuple tycon.
233
234 Unfortunately, this means we have to track "the parameter occurs in this type"
235 explicitly, even though foldDataConArgs is also doing this internally.
236
237 -}
238
239 -- canDoGenerics1 determines if a Generic1/Rep1 can be derived.
240 --
241 -- Checks (a) through (c) from Note [Requirements for deriving Generic and Rep]
242 -- are taken care of by the call to canDoGenerics.
243 --
244 -- It returns IsValid if deriving is possible. It returns (NotValid reason)
245 -- if not.
246 canDoGenerics1 :: TyCon -> Validity' [DeriveGenericsErrReason]
247 canDoGenerics1 rep_tc =
248 canDoGenerics rep_tc `andValid` additionalChecks
249 where
250 additionalChecks
251 -- check (d) from Note [Requirements for deriving Generic and Rep]
252 | null (tyConTyVars rep_tc) = NotValid [
253 DerivErrGenericsMustHaveSomeTypeParams rep_tc]
254
255 | otherwise = mergeErrors $ concatMap check_con data_cons
256
257 data_cons = tyConDataCons rep_tc
258 check_con con = case check_vanilla con of
259 j@(NotValid {}) -> [j]
260 IsValid -> _ccdg1_errors `map` foldDataConArgs (ft_check con) con
261
262 check_vanilla :: DataCon -> Validity' DeriveGenericsErrReason
263 check_vanilla con | isVanillaDataCon con = IsValid
264 | otherwise = NotValid $ DerivErrGenericsMustNotHaveExistentials con
265
266 bmzero = CCDG1 False IsValid
267 bmbad con = CCDG1 True $ NotValid (DerivErrGenericsWrongArgKind con)
268 bmplus (CCDG1 b1 m1) (CCDG1 b2 m2) = CCDG1 (b1 || b2) (m1 `andValid` m2)
269
270 -- check (e) from Note [Requirements for deriving Generic and Rep]
271 -- See also Note [degenerate use of FFoldType]
272 ft_check :: DataCon -> FFoldType Check_for_CanDoGenerics1
273 ft_check con = FT
274 { ft_triv = bmzero
275
276 , ft_var = caseVar, ft_co_var = caseVar
277
278 -- (component_0,component_1,...,component_n)
279 , ft_tup = \_ components -> if any _ccdg1_hasParam (init components)
280 then bmbad con
281 else foldr bmplus bmzero components
282
283 -- (dom -> rng), where the head of ty is not a tuple tycon
284 , ft_fun = \dom rng -> -- cf #8516
285 if _ccdg1_hasParam dom
286 then bmbad con
287 else bmplus dom rng
288
289 -- (ty arg), where head of ty is neither (->) nor a tuple constructor and
290 -- the parameter of interest does not occur in ty
291 , ft_ty_app = \_ _ arg -> arg
292
293 , ft_bad_app = bmbad con
294 , ft_forall = \_ body -> body -- polytypes are handled elsewhere
295 }
296 where
297 caseVar = CCDG1 True IsValid
298
299 {-
300 ************************************************************************
301 * *
302 \subsection{Generating the RHS of a generic default method}
303 * *
304 ************************************************************************
305 -}
306
307 type US = Int -- Local unique supply, just a plain Int
308 type Alt = (LPat GhcPs, LHsExpr GhcPs)
309
310 -- GenericKind serves to mark if a datatype derives Generic (Gen0) or
311 -- Generic1 (Gen1).
312 data GenericKind = Gen0 | Gen1
313
314 -- as above, but with a payload of the TyCon's name for "the" parameter
315 data GenericKind_ = Gen0_ | Gen1_ TyVar
316
317 -- as above, but using a single datacon's name for "the" parameter
318 data GenericKind_DC = Gen0_DC | Gen1_DC TyVar
319
320 forgetArgVar :: GenericKind_DC -> GenericKind
321 forgetArgVar Gen0_DC = Gen0
322 forgetArgVar Gen1_DC{} = Gen1
323
324 -- When working only within a single datacon, "the" parameter's name should
325 -- match that datacon's name for it.
326 gk2gkDC :: GenericKind_ -> DataCon -> GenericKind_DC
327 gk2gkDC Gen0_ _ = Gen0_DC
328 gk2gkDC Gen1_{} d = Gen1_DC $ last $ dataConUnivTyVars d
329
330
331 -- Bindings for the Generic instance
332 mkBindsRep :: DynFlags -> GenericKind -> TyCon -> (LHsBinds GhcPs, [LSig GhcPs])
333 mkBindsRep dflags gk tycon = (binds, sigs)
334 where
335 binds = unitBag (mkRdrFunBind (L loc' from01_RDR) [from_eqn])
336 `unionBags`
337 unitBag (mkRdrFunBind (L loc' to01_RDR) [to_eqn])
338
339 -- See Note [Generics performance tricks]
340 sigs = if gopt Opt_InlineGenericsAggressively dflags
341 || (gopt Opt_InlineGenerics dflags && inlining_useful)
342 then [inline1 from01_RDR, inline1 to01_RDR]
343 else []
344 where
345 inlining_useful
346 | cons <= 1 = True
347 | cons <= 4 = max_fields <= 5
348 | cons <= 8 = max_fields <= 2
349 | cons <= 16 = max_fields <= 1
350 | cons <= 24 = max_fields == 0
351 | otherwise = False
352 where
353 cons = length datacons
354 max_fields = maximum $ map dataConSourceArity datacons
355
356 inline1 f = L loc'' . InlineSig noAnn (L loc' f)
357 $ alwaysInlinePragma { inl_act = ActiveAfter NoSourceText 1 }
358
359 -- The topmost M1 (the datatype metadata) has the exact same type
360 -- across all cases of a from/to definition, and can be factored out
361 -- to save some allocations during typechecking.
362 -- See Note [Generics compilation speed tricks]
363 from_eqn = mkHsCaseAlt x_Pat $ mkM1_E
364 $ nlHsPar $ nlHsCase x_Expr from_matches
365 to_eqn = mkHsCaseAlt (mkM1_P x_Pat) $ nlHsCase x_Expr to_matches
366
367 from_matches = [mkHsCaseAlt pat rhs | (pat,rhs) <- from_alts]
368 to_matches = [mkHsCaseAlt pat rhs | (pat,rhs) <- to_alts ]
369 loc = srcLocSpan (getSrcLoc tycon)
370 loc' = noAnnSrcSpan loc
371 loc'' = noAnnSrcSpan loc
372 datacons = tyConDataCons tycon
373
374 (from01_RDR, to01_RDR) = case gk of
375 Gen0 -> (from_RDR, to_RDR)
376 Gen1 -> (from1_RDR, to1_RDR)
377
378 -- Recurse over the sum first
379 from_alts, to_alts :: [Alt]
380 (from_alts, to_alts) = mkSum gk_ (1 :: US) datacons
381 where gk_ = case gk of
382 Gen0 -> Gen0_
383 Gen1 -> assert (tyvars `lengthAtLeast` 1) $
384 Gen1_ (last tyvars)
385 where tyvars = tyConTyVars tycon
386
387 --------------------------------------------------------------------------------
388 -- The type synonym instance and synonym
389 -- type instance Rep (D a b) = Rep_D a b
390 -- type Rep_D a b = ...representation type for D ...
391 --------------------------------------------------------------------------------
392
393 tc_mkRepFamInsts :: GenericKind -- Gen0 or Gen1
394 -> TyCon -- The type to generate representation for
395 -> [Type] -- The type(s) to which Generic(1) is applied
396 -- in the generated instance
397 -> TcM FamInst -- Generated representation0 coercion
398 tc_mkRepFamInsts gk tycon inst_tys =
399 -- Consider the example input tycon `D`, where data D a b = D_ a
400 -- Also consider `R:DInt`, where { data family D x y :: * -> *
401 -- ; data instance D Int a b = D_ a }
402 do { -- `rep` = GHC.Generics.Rep or GHC.Generics.Rep1 (type family)
403 fam_tc <- case gk of
404 Gen0 -> tcLookupTyCon repTyConName
405 Gen1 -> tcLookupTyCon rep1TyConName
406
407 ; fam_envs <- tcGetFamInstEnvs
408
409 ; let -- If the derived instance is
410 -- instance Generic (Foo x)
411 -- then:
412 -- `arg_ki` = *, `inst_ty` = Foo x :: *
413 --
414 -- If the derived instance is
415 -- instance Generic1 (Bar x :: k -> *)
416 -- then:
417 -- `arg_k` = k, `inst_ty` = Bar x :: k -> *
418 (arg_ki, inst_ty) = case (gk, inst_tys) of
419 (Gen0, [inst_t]) -> (liftedTypeKind, inst_t)
420 (Gen1, [arg_k, inst_t]) -> (arg_k, inst_t)
421 _ -> pprPanic "tc_mkRepFamInsts" (ppr inst_tys)
422
423 ; let mbFamInst = tyConFamInst_maybe tycon
424 -- If we're examining a data family instance, we grab the parent
425 -- TyCon (ptc) and use it to determine the type arguments
426 -- (inst_args) for the data family *instance*'s type variables.
427 ptc = maybe tycon fst mbFamInst
428 (_, inst_args, _) = tcLookupDataFamInst fam_envs ptc $ snd
429 $ tcSplitTyConApp inst_ty
430
431 ; let -- `tyvars` = [a,b]
432 (tyvars, gk_) = case gk of
433 Gen0 -> (all_tyvars, Gen0_)
434 Gen1 -> assert (not $ null all_tyvars)
435 (init all_tyvars, Gen1_ $ last all_tyvars)
436 where all_tyvars = tyConTyVars tycon
437
438 -- `repTy` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> *
439 ; repTy <- tc_mkRepTy gk_ tycon arg_ki
440
441 -- `rep_name` is a name we generate for the synonym
442 ; mod <- getModule
443 ; loc <- getSrcSpanM
444 ; let tc_occ = nameOccName (tyConName tycon)
445 rep_occ = case gk of Gen0 -> mkGenR tc_occ; Gen1 -> mkGen1R tc_occ
446 ; rep_name <- newGlobalBinder mod rep_occ loc
447
448 -- We make sure to substitute the tyvars with their user-supplied
449 -- type arguments before generating the Rep/Rep1 instance, since some
450 -- of the tyvars might have been instantiated when deriving.
451 -- See Note [Generating a correctly typed Rep instance].
452 ; let (env_tyvars, env_inst_args)
453 = case gk_ of
454 Gen0_ -> (tyvars, inst_args)
455 Gen1_ last_tv
456 -- See the "wrinkle" in
457 -- Note [Generating a correctly typed Rep instance]
458 -> ( last_tv : tyvars
459 , anyTypeOfKind (tyVarKind last_tv) : inst_args )
460 env = zipTyEnv env_tyvars env_inst_args
461 in_scope = mkInScopeSet (tyCoVarsOfTypes inst_tys)
462 subst = mkTvSubst in_scope env
463 repTy' = substTyUnchecked subst repTy
464 tcv' = tyCoVarsOfTypeList inst_ty
465 (tv', cv') = partition isTyVar tcv'
466 tvs' = scopedSort tv'
467 cvs' = scopedSort cv'
468 axiom = mkSingleCoAxiom Nominal rep_name tvs' [] cvs'
469 fam_tc inst_tys repTy'
470
471 ; newFamInst SynFamilyInst axiom }
472
473 --------------------------------------------------------------------------------
474 -- Type representation
475 --------------------------------------------------------------------------------
476
477 -- | See documentation of 'argTyFold'; that function uses the fields of this
478 -- type to interpret the structure of a type when that type is considered as an
479 -- argument to a constructor that is being represented with 'Rep1'.
480 data ArgTyAlg a = ArgTyAlg
481 { ata_rec0 :: (Type -> a)
482 , ata_par1 :: a, ata_rec1 :: (Type -> a)
483 , ata_comp :: (Type -> a -> a)
484 }
485
486 -- | @argTyFold@ implements a generalised and safer variant of the @arg@
487 -- function from Figure 3 in <http://dreixel.net/research/pdf/gdmh.pdf>. @arg@
488 -- is conceptually equivalent to:
489 --
490 -- > arg t = case t of
491 -- > _ | isTyVar t -> if (t == argVar) then Par1 else Par0 t
492 -- > App f [t'] |
493 -- > representable1 f &&
494 -- > t' == argVar -> Rec1 f
495 -- > App f [t'] |
496 -- > representable1 f &&
497 -- > t' has tyvars -> f :.: (arg t')
498 -- > _ -> Rec0 t
499 --
500 -- where @argVar@ is the last type variable in the data type declaration we are
501 -- finding the representation for.
502 --
503 -- @argTyFold@ is more general than @arg@ because it uses 'ArgTyAlg' to
504 -- abstract out the concrete invocations of @Par0@, @Rec0@, @Par1@, @Rec1@, and
505 -- @:.:@.
506 --
507 -- @argTyFold@ is safer than @arg@ because @arg@ would lead to a GHC panic for
508 -- some data types. The problematic case is when @t@ is an application of a
509 -- non-representable type @f@ to @argVar@: @App f [argVar]@ is caught by the
510 -- @_@ pattern, and ends up represented as @Rec0 t@. This type occurs /free/ in
511 -- the RHS of the eventual @Rep1@ instance, which is therefore ill-formed. Some
512 -- representable1 checks have been relaxed, and others were moved to
513 -- @canDoGenerics1@.
514 argTyFold :: forall a. TyVar -> ArgTyAlg a -> Type -> a
515 argTyFold argVar (ArgTyAlg {ata_rec0 = mkRec0,
516 ata_par1 = mkPar1, ata_rec1 = mkRec1,
517 ata_comp = mkComp}) =
518 -- mkRec0 is the default; use it if there is no interesting structure
519 -- (e.g. occurrences of parameters or recursive occurrences)
520 \t -> maybe (mkRec0 t) id $ go t where
521 go :: Type -> -- type to fold through
522 Maybe a -- the result (e.g. representation type), unless it's trivial
523 go t = isParam `mplus` isApp where
524
525 isParam = do -- handles parameters
526 t' <- getTyVar_maybe t
527 Just $ if t' == argVar then mkPar1 -- moreover, it is "the" parameter
528 else mkRec0 t -- NB mkRec0 instead of the conventional mkPar0
529
530 isApp = do -- handles applications
531 (phi, beta) <- tcSplitAppTy_maybe t
532
533 let interesting = argVar `elemVarSet` exactTyCoVarsOfType beta
534
535 -- Does it have no interesting structure to represent?
536 if not interesting then Nothing
537 else -- Is the argument the parameter? Special case for mkRec1.
538 if Just argVar == getTyVar_maybe beta then Just $ mkRec1 phi
539 else mkComp phi `fmap` go beta -- It must be a composition.
540
541
542 tc_mkRepTy :: -- Gen0_ or Gen1_, for Rep or Rep1
543 GenericKind_
544 -- The type to generate representation for
545 -> TyCon
546 -- The kind of the representation type's argument
547 -- See Note [Handling kinds in a Rep instance]
548 -> Kind
549 -- Generated representation0 type
550 -> TcM Type
551 tc_mkRepTy gk_ tycon k =
552 do
553 d1 <- tcLookupTyCon d1TyConName
554 c1 <- tcLookupTyCon c1TyConName
555 s1 <- tcLookupTyCon s1TyConName
556 rec0 <- tcLookupTyCon rec0TyConName
557 rec1 <- tcLookupTyCon rec1TyConName
558 par1 <- tcLookupTyCon par1TyConName
559 u1 <- tcLookupTyCon u1TyConName
560 v1 <- tcLookupTyCon v1TyConName
561 plus <- tcLookupTyCon sumTyConName
562 times <- tcLookupTyCon prodTyConName
563 comp <- tcLookupTyCon compTyConName
564 uAddr <- tcLookupTyCon uAddrTyConName
565 uChar <- tcLookupTyCon uCharTyConName
566 uDouble <- tcLookupTyCon uDoubleTyConName
567 uFloat <- tcLookupTyCon uFloatTyConName
568 uInt <- tcLookupTyCon uIntTyConName
569 uWord <- tcLookupTyCon uWordTyConName
570
571 let tcLookupPromDataCon = fmap promoteDataCon . tcLookupDataCon
572
573 md <- tcLookupPromDataCon metaDataDataConName
574 mc <- tcLookupPromDataCon metaConsDataConName
575 ms <- tcLookupPromDataCon metaSelDataConName
576 pPrefix <- tcLookupPromDataCon prefixIDataConName
577 pInfix <- tcLookupPromDataCon infixIDataConName
578 pLA <- tcLookupPromDataCon leftAssociativeDataConName
579 pRA <- tcLookupPromDataCon rightAssociativeDataConName
580 pNA <- tcLookupPromDataCon notAssociativeDataConName
581 pSUpk <- tcLookupPromDataCon sourceUnpackDataConName
582 pSNUpk <- tcLookupPromDataCon sourceNoUnpackDataConName
583 pNSUpkness <- tcLookupPromDataCon noSourceUnpackednessDataConName
584 pSLzy <- tcLookupPromDataCon sourceLazyDataConName
585 pSStr <- tcLookupPromDataCon sourceStrictDataConName
586 pNSStrness <- tcLookupPromDataCon noSourceStrictnessDataConName
587 pDLzy <- tcLookupPromDataCon decidedLazyDataConName
588 pDStr <- tcLookupPromDataCon decidedStrictDataConName
589 pDUpk <- tcLookupPromDataCon decidedUnpackDataConName
590
591 fix_env <- getFixityEnv
592
593 let mkSum' a b = mkTyConApp plus [k,a,b]
594 mkProd a b = mkTyConApp times [k,a,b]
595 mkRec0 a = mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 k a
596 mkRec1 a = mkTyConApp rec1 [k,a]
597 mkPar1 = mkTyConTy par1
598 mkD a = mkTyConApp d1 [ k, metaDataTy, sumP (tyConDataCons a) ]
599 mkC a = mkTyConApp c1 [ k
600 , metaConsTy a
601 , prod (map scaledThing . dataConInstOrigArgTys a
602 . mkTyVarTys . tyConTyVars $ tycon)
603 (dataConSrcBangs a)
604 (dataConImplBangs a)
605 (dataConFieldLabels a)]
606 mkS mlbl su ss ib a = mkTyConApp s1 [k, metaSelTy mlbl su ss ib, a]
607
608 -- Sums and products are done in the same way for both Rep and Rep1
609 sumP l = foldBal mkSum' (mkTyConApp v1 [k]) . map mkC $ l
610 -- The Bool is True if this constructor has labelled fields
611 prod :: [Type] -> [HsSrcBang] -> [HsImplBang] -> [FieldLabel] -> Type
612 prod l sb ib fl = foldBal mkProd (mkTyConApp u1 [k])
613 [ assert (null fl || lengthExceeds fl j) $
614 arg t sb' ib' (if null fl
615 then Nothing
616 else Just (fl !! j))
617 | (t,sb',ib',j) <- zip4 l sb ib [0..] ]
618
619 arg :: Type -> HsSrcBang -> HsImplBang -> Maybe FieldLabel -> Type
620 arg t (HsSrcBang _ su ss) ib fl = mkS fl su ss ib $ case gk_ of
621 -- Here we previously used Par0 if t was a type variable, but we
622 -- realized that we can't always guarantee that we are wrapping-up
623 -- all type variables in Par0. So we decided to stop using Par0
624 -- altogether, and use Rec0 all the time.
625 Gen0_ -> mkRec0 t
626 Gen1_ argVar -> argPar argVar t
627 where
628 -- Builds argument representation for Rep1 (more complicated due to
629 -- the presence of composition).
630 argPar argVar = argTyFold argVar $ ArgTyAlg
631 {ata_rec0 = mkRec0, ata_par1 = mkPar1,
632 ata_rec1 = mkRec1, ata_comp = mkComp comp k}
633
634 tyConName_user = case tyConFamInst_maybe tycon of
635 Just (ptycon, _) -> tyConName ptycon
636 Nothing -> tyConName tycon
637
638 dtName = mkStrLitTy . occNameFS . nameOccName $ tyConName_user
639 mdName = mkStrLitTy . moduleNameFS . moduleName
640 . nameModule . tyConName $ tycon
641 pkgName = mkStrLitTy . unitFS . moduleUnit
642 . nameModule . tyConName $ tycon
643 isNT = mkTyConTy $ if isNewTyCon tycon
644 then promotedTrueDataCon
645 else promotedFalseDataCon
646
647 ctName = mkStrLitTy . occNameFS . nameOccName . dataConName
648 ctFix c
649 | dataConIsInfix c
650 = case lookupFixity fix_env (dataConName c) of
651 Fixity _ n InfixL -> buildFix n pLA
652 Fixity _ n InfixR -> buildFix n pRA
653 Fixity _ n InfixN -> buildFix n pNA
654 | otherwise = mkTyConTy pPrefix
655 buildFix n assoc = mkTyConApp pInfix [ mkTyConTy assoc
656 , mkNumLitTy (fromIntegral n)]
657
658 isRec c = mkTyConTy $ if dataConFieldLabels c `lengthExceeds` 0
659 then promotedTrueDataCon
660 else promotedFalseDataCon
661
662 selName = mkStrLitTy . flLabel
663
664 mbSel Nothing = mkTyConApp promotedNothingDataCon [typeSymbolKind]
665 mbSel (Just s) = mkTyConApp promotedJustDataCon
666 [typeSymbolKind, selName s]
667
668 metaDataTy = mkTyConApp md [dtName, mdName, pkgName, isNT]
669 metaConsTy c = mkTyConApp mc [ctName c, ctFix c, isRec c]
670 metaSelTy mlbl su ss ib =
671 mkTyConApp ms [mbSel mlbl, pSUpkness, pSStrness, pDStrness]
672 where
673 pSUpkness = mkTyConTy $ case su of
674 SrcUnpack -> pSUpk
675 SrcNoUnpack -> pSNUpk
676 NoSrcUnpack -> pNSUpkness
677
678 pSStrness = mkTyConTy $ case ss of
679 SrcLazy -> pSLzy
680 SrcStrict -> pSStr
681 NoSrcStrict -> pNSStrness
682
683 pDStrness = mkTyConTy $ case ib of
684 HsLazy -> pDLzy
685 HsStrict -> pDStr
686 HsUnpack{} -> pDUpk
687
688 return (mkD tycon)
689
690 mkComp :: TyCon -> Kind -> Type -> Type -> Type
691 mkComp comp k f g
692 | k1_first = mkTyConApp comp [k,liftedTypeKind,f,g]
693 | otherwise = mkTyConApp comp [liftedTypeKind,k,f,g]
694 where
695 -- Which of these is the case?
696 -- newtype (:.:) {k1} {k2} (f :: k2->*) (g :: k1->k2) (p :: k1) = ...
697 -- or newtype (:.:) {k2} {k1} (f :: k2->*) (g :: k1->k2) (p :: k1) = ...
698 -- We want to instantiate with k1=k, and k2=*
699 -- Reason for k2=*: see Note [Handling kinds in a Rep instance]
700 -- But we need to know which way round!
701 k1_first = k_first == p_kind_var
702 [k_first,_,_,_,p] = tyConTyVars comp
703 Just p_kind_var = getTyVar_maybe (tyVarKind p)
704
705 -- Given the TyCons for each URec-related type synonym, check to see if the
706 -- given type is an unlifted type that generics understands. If so, return
707 -- its representation type. Otherwise, return Rec0.
708 -- See Note [Generics and unlifted types]
709 mkBoxTy :: TyCon -- UAddr
710 -> TyCon -- UChar
711 -> TyCon -- UDouble
712 -> TyCon -- UFloat
713 -> TyCon -- UInt
714 -> TyCon -- UWord
715 -> TyCon -- Rec0
716 -> Kind -- What to instantiate Rec0's kind variable with
717 -> Type
718 -> Type
719 mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 k ty
720 | ty `eqType` addrPrimTy = mkTyConApp uAddr [k]
721 | ty `eqType` charPrimTy = mkTyConApp uChar [k]
722 | ty `eqType` doublePrimTy = mkTyConApp uDouble [k]
723 | ty `eqType` floatPrimTy = mkTyConApp uFloat [k]
724 | ty `eqType` intPrimTy = mkTyConApp uInt [k]
725 | ty `eqType` wordPrimTy = mkTyConApp uWord [k]
726 | otherwise = mkTyConApp rec0 [k,ty]
727
728 --------------------------------------------------------------------------------
729 -- Dealing with sums
730 --------------------------------------------------------------------------------
731
732 mkSum :: GenericKind_ -- Generic or Generic1?
733 -> US -- Base for generating unique names
734 -> [DataCon] -- The data constructors
735 -> ([Alt], -- Alternatives for the T->Trep "from" function
736 [Alt]) -- Alternatives for the Trep->T "to" function
737
738 -- Datatype without any constructors
739 mkSum _ _ [] = ([from_alt], [to_alt])
740 where
741 from_alt = (x_Pat, nlHsCase x_Expr [])
742 to_alt = (x_Pat, nlHsCase x_Expr [])
743 -- These M1s are meta-information for the datatype
744
745 -- Datatype with at least one constructor
746 mkSum gk_ us datacons =
747 -- switch the payload of gk_ to be datacon-centric instead of tycon-centric
748 unzip [ mk1Sum (gk2gkDC gk_ d) us i (length datacons) d
749 | (d,i) <- zip datacons [1..] ]
750
751 -- Build the sum for a particular constructor
752 mk1Sum :: GenericKind_DC -- Generic or Generic1?
753 -> US -- Base for generating unique names
754 -> Int -- The index of this constructor
755 -> Int -- Total number of constructors
756 -> DataCon -- The data constructor
757 -> (Alt, -- Alternative for the T->Trep "from" function
758 Alt) -- Alternative for the Trep->T "to" function
759 mk1Sum gk_ us i n datacon = (from_alt, to_alt)
760 where
761 gk = forgetArgVar gk_
762
763 -- Existentials already excluded
764 argTys = dataConOrigArgTys datacon
765 n_args = dataConSourceArity datacon
766
767 datacon_varTys = zip (map mkGenericLocal [us .. us+n_args-1]) (map scaledThing argTys)
768 datacon_vars = map fst datacon_varTys
769
770 datacon_rdr = getRdrName datacon
771
772 from_alt = (nlConVarPat datacon_rdr datacon_vars, from_alt_rhs)
773 from_alt_rhs = genLR_E i n (mkProd_E gk_ datacon_varTys)
774
775 to_alt = ( genLR_P i n (mkProd_P gk datacon_varTys)
776 , to_alt_rhs
777 ) -- These M1s are meta-information for the datatype
778 to_alt_rhs = case gk_ of
779 Gen0_DC -> nlHsVarApps datacon_rdr datacon_vars
780 Gen1_DC argVar -> nlHsApps datacon_rdr $ map argTo datacon_varTys
781 where
782 argTo (var, ty) = converter ty `nlHsApp` nlHsVar var where
783 converter = argTyFold argVar $ ArgTyAlg
784 {ata_rec0 = nlHsVar . unboxRepRDR,
785 ata_par1 = nlHsVar unPar1_RDR,
786 ata_rec1 = const $ nlHsVar unRec1_RDR,
787 ata_comp = \_ cnv -> (nlHsVar fmap_RDR `nlHsApp` cnv)
788 `nlHsCompose` nlHsVar unComp1_RDR}
789
790
791 -- Generates the L1/R1 sum pattern
792 genLR_P :: Int -> Int -> LPat GhcPs -> LPat GhcPs
793 genLR_P i n p
794 | n == 0 = error "impossible"
795 | n == 1 = p
796 | i <= div n 2 = nlParPat $ nlConPat l1DataCon_RDR [genLR_P i (div n 2) p]
797 | otherwise = nlParPat $ nlConPat r1DataCon_RDR [genLR_P (i-m) (n-m) p]
798 where m = div n 2
799
800 -- Generates the L1/R1 sum expression
801 genLR_E :: Int -> Int -> LHsExpr GhcPs -> LHsExpr GhcPs
802 genLR_E i n e
803 | n == 0 = error "impossible"
804 | n == 1 = e
805 | i <= div n 2 = nlHsVar l1DataCon_RDR `nlHsApp`
806 nlHsPar (genLR_E i (div n 2) e)
807 | otherwise = nlHsVar r1DataCon_RDR `nlHsApp`
808 nlHsPar (genLR_E (i-m) (n-m) e)
809 where m = div n 2
810
811 --------------------------------------------------------------------------------
812 -- Dealing with products
813 --------------------------------------------------------------------------------
814
815 -- Build a product expression
816 mkProd_E :: GenericKind_DC -- Generic or Generic1?
817 -> [(RdrName, Type)]
818 -- List of variables matched on the lhs and their types
819 -> LHsExpr GhcPs -- Resulting product expression
820 mkProd_E gk_ varTys = mkM1_E (foldBal prod (nlHsVar u1DataCon_RDR) appVars)
821 -- These M1s are meta-information for the constructor
822 where
823 appVars = map (wrapArg_E gk_) varTys
824 prod a b = prodDataCon_RDR `nlHsApps` [a,b]
825
826 wrapArg_E :: GenericKind_DC -> (RdrName, Type) -> LHsExpr GhcPs
827 wrapArg_E Gen0_DC (var, ty) = mkM1_E $
828 boxRepRDR ty `nlHsVarApps` [var]
829 -- This M1 is meta-information for the selector
830 wrapArg_E (Gen1_DC argVar) (var, ty) = mkM1_E $
831 converter ty `nlHsApp` nlHsVar var
832 -- This M1 is meta-information for the selector
833 where converter = argTyFold argVar $ ArgTyAlg
834 {ata_rec0 = nlHsVar . boxRepRDR,
835 ata_par1 = nlHsVar par1DataCon_RDR,
836 ata_rec1 = const $ nlHsVar rec1DataCon_RDR,
837 ata_comp = \_ cnv -> nlHsVar comp1DataCon_RDR `nlHsCompose`
838 (nlHsVar fmap_RDR `nlHsApp` cnv)}
839
840 boxRepRDR :: Type -> RdrName
841 boxRepRDR = maybe k1DataCon_RDR fst . unboxedRepRDRs
842
843 unboxRepRDR :: Type -> RdrName
844 unboxRepRDR = maybe unK1_RDR snd . unboxedRepRDRs
845
846 -- Retrieve the RDRs associated with each URec data family instance
847 -- constructor. See Note [Generics and unlifted types]
848 unboxedRepRDRs :: Type -> Maybe (RdrName, RdrName)
849 unboxedRepRDRs ty
850 | ty `eqType` addrPrimTy = Just (uAddrDataCon_RDR, uAddrHash_RDR)
851 | ty `eqType` charPrimTy = Just (uCharDataCon_RDR, uCharHash_RDR)
852 | ty `eqType` doublePrimTy = Just (uDoubleDataCon_RDR, uDoubleHash_RDR)
853 | ty `eqType` floatPrimTy = Just (uFloatDataCon_RDR, uFloatHash_RDR)
854 | ty `eqType` intPrimTy = Just (uIntDataCon_RDR, uIntHash_RDR)
855 | ty `eqType` wordPrimTy = Just (uWordDataCon_RDR, uWordHash_RDR)
856 | otherwise = Nothing
857
858 -- Build a product pattern
859 mkProd_P :: GenericKind -- Gen0 or Gen1
860 -> [(RdrName, Type)] -- List of variables to match,
861 -- along with their types
862 -> LPat GhcPs -- Resulting product pattern
863 mkProd_P gk varTys = mkM1_P (foldBal prod (nlNullaryConPat u1DataCon_RDR) appVars)
864 -- These M1s are meta-information for the constructor
865 where
866 appVars = unzipWith (wrapArg_P gk) varTys
867 prod a b = nlParPat $ prodDataCon_RDR `nlConPat` [a,b]
868
869 wrapArg_P :: GenericKind -> RdrName -> Type -> LPat GhcPs
870 wrapArg_P Gen0 v ty = mkM1_P (nlParPat $ boxRepRDR ty `nlConVarPat` [v])
871 -- This M1 is meta-information for the selector
872 wrapArg_P Gen1 v _ = nlParPat $ m1DataCon_RDR `nlConVarPat` [v]
873
874 mkGenericLocal :: US -> RdrName
875 mkGenericLocal u = mkVarUnqual (mkFastString ("g" ++ show u))
876
877 x_RDR :: RdrName
878 x_RDR = mkVarUnqual (fsLit "x")
879
880 x_Expr :: LHsExpr GhcPs
881 x_Expr = nlHsVar x_RDR
882
883 x_Pat :: LPat GhcPs
884 x_Pat = nlVarPat x_RDR
885
886 mkM1_E :: LHsExpr GhcPs -> LHsExpr GhcPs
887 mkM1_E e = nlHsVar m1DataCon_RDR `nlHsApp` e
888
889 mkM1_P :: LPat GhcPs -> LPat GhcPs
890 mkM1_P p = nlParPat $ m1DataCon_RDR `nlConPat` [p]
891
892 nlHsCompose :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
893 nlHsCompose x y = compose_RDR `nlHsApps` [x, y]
894
895 -- | Variant of foldr for producing balanced lists
896 foldBal :: (a -> a -> a) -> a -> [a] -> a
897 {-# INLINE foldBal #-} -- inlined to produce specialised code for each op
898 foldBal op0 x0 xs0 = fold_bal op0 x0 (length xs0) xs0
899 where
900 fold_bal op x !n xs = case xs of
901 [] -> x
902 [a] -> a
903 _ -> let !nl = n `div` 2
904 !nr = n - nl
905 (l,r) = splitAt nl xs
906 in fold_bal op x nl l
907 `op` fold_bal op x nr r
908
909 {-
910 Note [Generics and unlifted types]
911 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
912 Normally, all constants are marked with K1/Rec0. The exception to this rule is
913 when a data constructor has an unlifted argument (e.g., Int#, Char#, etc.). In
914 that case, we must use a data family instance of URec (from GHC.Generics) to
915 mark it. As a result, before we can generate K1 or unK1, we must first check
916 to see if the type is actually one of the unlifted types for which URec has a
917 data family instance; if so, we generate that instead.
918
919 See wiki:commentary/compiler/generic-deriving#handling-unlifted-types for more
920 details on why URec is implemented the way it is.
921
922 Note [Generating a correctly typed Rep instance]
923 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
924 tc_mkRepTy derives the RHS of the Rep(1) type family instance when deriving
925 Generic(1). That is, it derives the ellipsis in the following:
926
927 instance Generic Foo where
928 type Rep Foo = ...
929
930 However, tc_mkRepTy only has knowledge of the *TyCon* of the type for which
931 a Generic(1) instance is being derived, not the fully instantiated type. As a
932 result, tc_mkRepTy builds the most generalized Rep(1) instance possible using
933 the type variables it learns from the TyCon (i.e., it uses tyConTyVars). This
934 can cause problems when the instance has instantiated type variables
935 (see #11732). As an example:
936
937 data T a = MkT a
938 deriving instance Generic (T Int)
939 ==>
940 instance Generic (T Int) where
941 type Rep (T Int) = (... (Rec0 a)) -- wrong!
942
943 -XStandaloneDeriving is one way for the type variables to become instantiated.
944 Another way is when Generic1 is being derived for a datatype with a visible
945 kind binder, e.g.,
946
947 data P k (a :: k) = MkP k deriving Generic1
948 ==>
949 instance Generic1 (P *) where
950 type Rep1 (P *) = (... (Rec0 k)) -- wrong!
951
952 See Note [Unify kinds in deriving] in GHC.Tc.Deriv.
953
954 In any such scenario, we must prevent a discrepancy between the LHS and RHS of
955 a Rep(1) instance. To do so, we create a type variable substitution that maps
956 the tyConTyVars of the TyCon to their counterparts in the fully instantiated
957 type. (For example, using T above as example, you'd map a :-> Int.) We then
958 apply the substitution to the RHS before generating the instance.
959
960 A wrinkle in all of this: when forming the type variable substitution for
961 Generic1 instances, we map the last type variable of the tycon to Any. Why?
962 It's because of wily data types like this one (#15012):
963
964 data T a = MkT (FakeOut a)
965 type FakeOut a = Int
966
967 If we ignore a, then we'll produce the following Rep1 instance:
968
969 instance Generic1 T where
970 type Rep1 T = ... (Rec0 (FakeOut a))
971 ...
972
973 Oh no! Now we have `a` on the RHS, but it's completely unbound. Instead, we
974 ensure that `a` is mapped to Any:
975
976 instance Generic1 T where
977 type Rep1 T = ... (Rec0 (FakeOut Any))
978 ...
979
980 And now all is good.
981
982 Alternatively, we could have avoided this problem by expanding all type
983 synonyms on the RHSes of Rep1 instances. But we might blow up the size of
984 these types even further by doing this, so we choose not to do so.
985
986 Note [Handling kinds in a Rep instance]
987 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
988 Because Generic1 is poly-kinded, the representation types were generalized to
989 be kind-polymorphic as well. As a result, tc_mkRepTy must explicitly apply
990 the kind of the instance being derived to all the representation type
991 constructors. For instance, if you have
992
993 data Empty (a :: k) = Empty deriving Generic1
994
995 Then the generated code is now approximately (with -fprint-explicit-kinds
996 syntax):
997
998 instance Generic1 k (Empty k) where
999 type Rep1 k (Empty k) = U1 k
1000
1001 Most representation types have only one kind variable, making them easy to deal
1002 with. The only non-trivial case is (:.:), which is only used in Generic1
1003 instances:
1004
1005 newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =
1006 Comp1 { unComp1 :: f (g p) }
1007
1008 Here, we do something a bit counter-intuitive: we make k1 be the kind of the
1009 instance being derived, and we always make k2 be *. Why *? It's because
1010 the code that GHC generates using (:.:) is always of the form x :.: Rec1 y
1011 for some types x and y. In other words, the second type to which (:.:) is
1012 applied always has kind k -> *, for some kind k, so k2 cannot possibly be
1013 anything other than * in a generated Generic1 instance.
1014
1015 Note [Generics compilation speed tricks]
1016 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1017 Deriving Generic(1) is known to have a large constant factor during
1018 compilation, which contributes to noticeable compilation slowdowns when
1019 deriving Generic(1) for large datatypes (see #5642).
1020
1021 To ease the pain, there is a trick one can play when generating definitions for
1022 to(1) and from(1). If you have a datatype like:
1023
1024 data Letter = A | B | C | D
1025
1026 then a naïve Generic instance for Letter would be:
1027
1028 instance Generic Letter where
1029 type Rep Letter = D1 ('MetaData ...) ...
1030
1031 to (M1 (L1 (L1 (M1 U1)))) = A
1032 to (M1 (L1 (R1 (M1 U1)))) = B
1033 to (M1 (R1 (L1 (M1 U1)))) = C
1034 to (M1 (R1 (R1 (M1 U1)))) = D
1035
1036 from A = M1 (L1 (L1 (M1 U1)))
1037 from B = M1 (L1 (R1 (M1 U1)))
1038 from C = M1 (R1 (L1 (M1 U1)))
1039 from D = M1 (R1 (R1 (M1 U1)))
1040
1041 Notice that in every LHS pattern-match of the 'to' definition, and in every RHS
1042 expression in the 'from' definition, the topmost constructor is M1. This
1043 corresponds to the datatype-specific metadata (the D1 in the Rep Letter
1044 instance). But this is wasteful from a typechecking perspective, since this
1045 definition requires GHC to typecheck an application of M1 in every single case,
1046 leading to an O(n) increase in the number of coercions the typechecker has to
1047 solve, which in turn increases allocations and degrades compilation speed.
1048
1049 Luckily, since the topmost M1 has the exact same type across every case, we can
1050 factor it out reduce the typechecker's burden:
1051
1052 instance Generic Letter where
1053 type Rep Letter = D1 ('MetaData ...) ...
1054
1055 to (M1 x) = case x of
1056 L1 (L1 (M1 U1)) -> A
1057 L1 (R1 (M1 U1)) -> B
1058 R1 (L1 (M1 U1)) -> C
1059 R1 (R1 (M1 U1)) -> D
1060
1061 from x = M1 (case x of
1062 A -> L1 (L1 (M1 U1))
1063 B -> L1 (R1 (M1 U1))
1064 C -> R1 (L1 (M1 U1))
1065 D -> R1 (R1 (M1 U1)))
1066
1067 A simple change, but one that pays off, since it goes turns an O(n) amount of
1068 coercions to an O(1) amount.
1069
1070 Note [Generics performance tricks]
1071 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1072 Generics-based algorithms tend to rely on GHC optimizing away the intermediate
1073 representation for optimal performance. However, the default unfolding threshold
1074 is usually too small for GHC to do that.
1075
1076 The recommended approach thus far was to increase unfolding threshold, but this
1077 makes GHC inline more aggressively in general, whereas it should only be more
1078 aggresive with generics-based code.
1079
1080 The solution is to use a heuristic that'll annotate Generic class methods with
1081 INLINE[1] pragmas (the explicit phase is used to give users phase control as
1082 they can annotate their functions with INLINE[2] or INLINE[0] if appropriate).
1083
1084 The current heuristic was chosen by looking at how annotating Generic methods
1085 INLINE[1] helps with optimal code generation for several types of generic
1086 algorithms:
1087
1088 * Round trip through the generic representation.
1089
1090 * Generation of NFData instances.
1091
1092 * Generation of field lenses.
1093
1094 The experimentation was done by picking data types having N constructors with M
1095 fields each and using their derived Generic instances to generate code with the
1096 above algorithms.
1097
1098 The results are threshold values for N and M (contained in
1099 `mkBindsRep.inlining_useful`) for which inlining is beneficial, i.e. it usually
1100 leads to performance improvements at both compile time (the simplifier has to do
1101 more work, but then there's much less code left for subsequent phases to work
1102 with) and run time (the generic representation of a data type is optimized
1103 away).
1104
1105 The T11068 test case, which includes the algorithms mentioned above, tests that
1106 the generic representations of several data types optimize away using the
1107 threshold values in `mkBindsRep.inlining_useful`.
1108
1109 If one uses threshold values higher what is found in
1110 `mkBindsRep.inlining_useful`, then annotating Generic class methods with INLINE
1111 pragmas tends to be at best useless and at worst lead to code size blowup
1112 without runtime performance improvements.
1113 -}