TH: make `Lift` and `TExp` levity-polymorphic
[ghc.git] / compiler / typecheck / TcGenDeriv.hs
index 0a5fbb0..b02494b 100644 (file)
@@ -14,30 +14,35 @@ This is where we do all the grimy bindings' generation.
 
 {-# LANGUAGE CPP, ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module TcGenDeriv (
         BagDerivStuff, DerivStuff(..),
 
-        hasStockDeriving,
-        FFoldType(..), functorLikeTraverse,
-        deepSubtypesContaining, foldDataConArgs,
-        mkCoerceClassMethEqn,
+        gen_Eq_binds,
+        gen_Ord_binds,
+        gen_Enum_binds,
+        gen_Bounded_binds,
+        gen_Ix_binds,
+        gen_Show_binds,
+        gen_Read_binds,
+        gen_Data_binds,
+        gen_Lift_binds,
         gen_Newtype_binds,
+        mkCoerceClassMethEqn,
         genAuxBinds,
         ordOpTbl, boxConTbl, litConTbl,
-        mkRdrFunBind
+        mkRdrFunBind, mkRdrFunBindEC, mkRdrFunBindSE, error_Expr
     ) where
 
 #include "HsVersions.h"
 
+import GhcPrelude
 
-import LoadIface( loadInterfaceForName )
-import HscTypes( lookupFixity, mi_fix )
 import TcRnMonad
 import HsSyn
 import RdrName
 import BasicTypes
-import Module( getModule )
 import DataCon
 import Name
 import Fingerprint
@@ -45,24 +50,24 @@ import Encoding
 
 import DynFlags
 import PrelInfo
-import FamInstEnv( FamInst )
+import FamInst
+import FamInstEnv
 import PrelNames
 import THNames
-import Module ( moduleName, moduleNameString
-              , moduleUnitId, unitIdString )
 import MkId ( coerceId )
 import PrimOp
 import SrcLoc
 import TyCon
+import TcEnv
 import TcType
+import TcValidity ( checkValidCoAxBranch )
+import CoAxiom    ( coAxiomSingleBranch )
 import TysPrim
 import TysWiredIn
 import Type
 import Class
-import TyCoRep
 import VarSet
 import VarEnv
-import State
 import Util
 import Var
 import Outputable
@@ -70,11 +75,8 @@ import Lexeme
 import FastString
 import Pair
 import Bag
-import StaticFlags( opt_PprStyle_Debug )
 
-import ListSetOps ( assocMaybe )
-import Data.List  ( partition, intersperse )
-import Data.Maybe ( catMaybes, isJust )
+import Data.List  ( find, partition, intersperse )
 
 type BagDerivStuff = Bag DerivStuff
 
@@ -93,73 +95,7 @@ data DerivStuff     -- Please add this auxiliary stuff
   | DerivFamInst FamInst               -- New type family instances
 
   -- New top-level auxiliary bindings
-  | DerivHsBind (LHsBind RdrName, LSig RdrName) -- Also used for SYB
-
-{-
-************************************************************************
-*                                                                      *
-                Class deriving diagnostics
-*                                                                      *
-************************************************************************
-
-Only certain blessed classes can be used in a deriving clause (without the
-assistance of GeneralizedNewtypeDeriving or DeriveAnyClass). These classes
-are listed below in the definition of hasStockDeriving (with the exception
-of Generic and Generic1, which are handled separately in TcGenGenerics).
-
-A class might be able to be used in a deriving clause if -XDeriveAnyClass
-is willing to support it. The canDeriveAnyClass function in TcDeriv checks
-if this is the case.
--}
-
--- NB: The classes listed below should be in sync with the ones listed in
--- the definition of sideConditions in TcDeriv (except for Generic(1), as
--- noted above). If you add a new class to hasStockDeriving, make sure to
--- update sideConditions as well!
-hasStockDeriving :: Class
-                   -> Maybe (SrcSpan
-                             -> TyCon
-                             -> TcM (LHsBinds RdrName, BagDerivStuff))
-hasStockDeriving clas
-  = assocMaybe gen_list (getUnique clas)
-  where
-    gen_list :: [(Unique, SrcSpan -> TyCon -> TcM (LHsBinds RdrName, BagDerivStuff))]
-    gen_list = [ (eqClassKey,          simple gen_Eq_binds)
-               , (ordClassKey,         simple gen_Ord_binds)
-               , (enumClassKey,        simple gen_Enum_binds)
-               , (boundedClassKey,     simple gen_Bounded_binds)
-               , (ixClassKey,          simple gen_Ix_binds)
-               , (showClassKey,        with_fix_env gen_Show_binds)
-               , (readClassKey,        with_fix_env gen_Read_binds)
-               , (dataClassKey,        gen_Data_binds)
-               , (functorClassKey,     simple gen_Functor_binds)
-               , (foldableClassKey,    simple gen_Foldable_binds)
-               , (traversableClassKey, simple gen_Traversable_binds)
-               , (liftClassKey,        simple gen_Lift_binds) ]
-
-    simple gen_fn loc tc
-      = return (gen_fn loc tc)
-
-    with_fix_env gen_fn loc tc
-      = do { fix_env <- getDataConFixityFun tc
-           ; return (gen_fn fix_env loc tc) }
-
-getDataConFixityFun :: TyCon -> TcM (Name -> Fixity)
--- If the TyCon is locally defined, we want the local fixity env;
--- but if it is imported (which happens for standalone deriving)
--- we need to get the fixity env from the interface file
--- c.f. RnEnv.lookupFixity, and Trac #9830
-getDataConFixityFun tc
-  = do { this_mod <- getModule
-       ; if nameIsLocalOrFrom this_mod name
-         then do { fix_env <- getFixityEnv
-                 ; return (lookupFixity fix_env) }
-         else do { iface <- loadInterfaceForName doc name
-                            -- Should already be loaded!
-                 ; return (mi_fix iface . nameOccName) } }
-  where
-    name = tyConName tc
-    doc = text "Data con fixities for" <+> ppr name
+  | DerivHsBind (LHsBind GhcPs, LSig GhcPs) -- Also used for SYB
 
 
 {-
@@ -189,7 +125,7 @@ possibly zero of them).  Here's an example, with both \tr{N}ullary and
        case (a1 `eqFloat#` a2) of r -> r
   for that particular test.
 
-* If there are a lot of (more than en) nullary constructors, we emit a
+* If there are a lot of (more than ten) nullary constructors, we emit a
   catch-all clause of the form:
 
       (==) a b  = case (con2tag_Foo a) of { a# ->
@@ -221,9 +157,10 @@ for the instance decl, which it probably wasn't, so the decls
 produced don't get through the typechecker.
 -}
 
-gen_Eq_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
-gen_Eq_binds loc tycon
-  = (method_binds, aux_binds)
+gen_Eq_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Eq_binds loc tycon = do
+    dflags <- getDynFlags
+    return (method_binds dflags, aux_binds)
   where
     all_cons = tyConDataCons tycon
     (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons
@@ -237,7 +174,7 @@ gen_Eq_binds loc tycon
 
     no_tag_match_cons = null tag_match_cons
 
-    fall_through_eqn
+    fall_through_eqn dflags
       | no_tag_match_cons   -- All constructors have arguments
       = case pat_match_cons of
           []  -> []   -- No constructors; no fall-though case
@@ -249,22 +186,22 @@ gen_Eq_binds loc tycon
       | otherwise -- One or more tag_match cons; add fall-through of
                   -- extract tags compare for equality
       = [([a_Pat, b_Pat],
-         untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
+         untag_Expr dflags tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
                     (genPrimOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))]
 
     aux_binds | no_tag_match_cons = emptyBag
               | otherwise         = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
 
-    method_binds = listToBag [eq_bind, ne_bind]
-    eq_bind = mk_FunBind loc eq_RDR (map pats_etc pat_match_cons ++ fall_through_eqn)
-    ne_bind = mk_easy_FunBind loc ne_RDR [a_Pat, b_Pat] (
-                        nlHsApp (nlHsVar not_RDR) (nlHsPar (nlHsVarApps eq_RDR [a_RDR, b_RDR])))
+    method_binds dflags = unitBag (eq_bind dflags)
+    eq_bind dflags = mkFunBindEC 2 loc eq_RDR (const true_Expr)
+                                 (map pats_etc pat_match_cons
+                                   ++ fall_through_eqn dflags)
 
     ------------------------------------------------------------------
     pats_etc data_con
       = let
-            con1_pat = nlConVarPat data_con_RDR as_needed
-            con2_pat = nlConVarPat data_con_RDR bs_needed
+            con1_pat = nlParPat $ nlConVarPat data_con_RDR as_needed
+            con2_pat = nlParPat $ nlConVarPat data_con_RDR bs_needed
 
             data_con_RDR = getRdrName data_con
             con_arity   = length tys_needed
@@ -276,9 +213,11 @@ gen_Eq_binds loc tycon
       where
         nested_eq_expr []  [] [] = true_Expr
         nested_eq_expr tys as bs
-          = foldl1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs)
+          = foldr1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs)
+          -- Using 'foldr1' here ensures that the derived code is correctly
+          -- associated. See #10859.
           where
-            nested_eq ty a b = nlHsPar (eq_Expr tycon ty (nlHsVar a) (nlHsVar b))
+            nested_eq ty a b = nlHsPar (eq_Expr ty (nlHsVar a) (nlHsVar b))
 
 {-
 ************************************************************************
@@ -337,7 +276,7 @@ Several special cases:
 Note [Game plan for deriving Ord]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 It's a bad idea to define only 'compare', and build the other binary
-comparisons on top of it; see Trac #2130, #4019.  Reason: we don't
+comparisons on top of it; see #2130, #4019.  Reason: we don't
 want to laboriously make a three-way comparison, only to extract a
 binary result, something like this:
      (>) (I# x) (I# y) = case <# x y of
@@ -371,7 +310,7 @@ ordMethRdr op
        OrdGT      -> gt_RDR
 
 ------------
-ltResult :: OrdOp -> LHsExpr RdrName
+ltResult :: OrdOp -> LHsExpr GhcPs
 -- Knowing a<b, what is the result for a `op` b?
 ltResult OrdCompare = ltTag_Expr
 ltResult OrdLT      = true_Expr
@@ -380,7 +319,7 @@ ltResult OrdGE      = false_Expr
 ltResult OrdGT      = false_Expr
 
 ------------
-eqResult :: OrdOp -> LHsExpr RdrName
+eqResult :: OrdOp -> LHsExpr GhcPs
 -- Knowing a=b, what is the result for a `op` b?
 eqResult OrdCompare = eqTag_Expr
 eqResult OrdLT      = false_Expr
@@ -389,7 +328,7 @@ eqResult OrdGE      = true_Expr
 eqResult OrdGT      = false_Expr
 
 ------------
-gtResult :: OrdOp -> LHsExpr RdrName
+gtResult :: OrdOp -> LHsExpr GhcPs
 -- Knowing a>b, what is the result for a `op` b?
 gtResult OrdCompare = gtTag_Expr
 gtResult OrdLT      = false_Expr
@@ -398,22 +337,25 @@ gtResult OrdGE      = true_Expr
 gtResult OrdGT      = true_Expr
 
 ------------
-gen_Ord_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
-gen_Ord_binds loc tycon
-  | null tycon_data_cons        -- No data-cons => invoke bale-out case
-  = (unitBag $ mk_FunBind loc compare_RDR [], emptyBag)
-  | otherwise
-  = (unitBag (mkOrdOp OrdCompare) `unionBags` other_ops, aux_binds)
+gen_Ord_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Ord_binds loc tycon = do
+    dflags <- getDynFlags
+    return $ if null tycon_data_cons -- No data-cons => invoke bale-out case
+      then ( unitBag $ mkFunBindEC 2 loc compare_RDR (const eqTag_Expr) []
+           , emptyBag)
+      else ( unitBag (mkOrdOp dflags OrdCompare) `unionBags` other_ops dflags
+           , aux_binds)
   where
     aux_binds | single_con_type = emptyBag
               | otherwise       = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
 
         -- Note [Game plan for deriving Ord]
-    other_ops | (last_tag - first_tag) <= 2     -- 1-3 constructors
-                || null non_nullary_cons        -- Or it's an enumeration
-              = listToBag [mkOrdOp OrdLT, lE, gT, gE]
-              | otherwise
-              = emptyBag
+    other_ops dflags
+      | (last_tag - first_tag) <= 2     -- 1-3 constructors
+        || null non_nullary_cons        -- Or it's an enumeration
+      = listToBag [mkOrdOp dflags OrdLT, lE, gT, gE]
+      | otherwise
+      = emptyBag
 
     negate_expr = nlHsApp (nlHsVar not_RDR)
     lE = mk_easy_FunBind loc le_RDR [a_Pat, b_Pat] $
@@ -437,37 +379,39 @@ gen_Ord_binds loc tycon
     (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon tycon_data_cons
 
 
-    mkOrdOp :: OrdOp -> LHsBind RdrName
+    mkOrdOp :: DynFlags -> OrdOp -> LHsBind GhcPs
     -- Returns a binding   op a b = ... compares a and b according to op ....
-    mkOrdOp op = mk_easy_FunBind loc (ordMethRdr op) [a_Pat, b_Pat] (mkOrdOpRhs op)
+    mkOrdOp dflags op = mk_easy_FunBind loc (ordMethRdr op) [a_Pat, b_Pat]
+                                        (mkOrdOpRhs dflags op)
 
-    mkOrdOpRhs :: OrdOp -> LHsExpr RdrName
-    mkOrdOpRhs op       -- RHS for comparing 'a' and 'b' according to op
-      | length nullary_cons <= 2  -- Two nullary or fewer, so use cases
+    mkOrdOpRhs :: DynFlags -> OrdOp -> LHsExpr GhcPs
+    mkOrdOpRhs dflags op       -- RHS for comparing 'a' and 'b' according to op
+      | nullary_cons `lengthAtMost` 2 -- Two nullary or fewer, so use cases
       = nlHsCase (nlHsVar a_RDR) $
-        map (mkOrdOpAlt op) tycon_data_cons
+        map (mkOrdOpAlt dflags op) tycon_data_cons
         -- i.e.  case a of { C1 x y -> case b of C1 x y -> ....compare x,y...
         --                   C2 x   -> case b of C2 x -> ....comopare x.... }
 
       | null non_nullary_cons    -- All nullary, so go straight to comparing tags
-      = mkTagCmp op
+      = mkTagCmp dflags op
 
       | otherwise                -- Mixed nullary and non-nullary
       = nlHsCase (nlHsVar a_RDR) $
-        (map (mkOrdOpAlt op) non_nullary_cons
-         ++ [mkHsCaseAlt nlWildPat (mkTagCmp op)])
+        (map (mkOrdOpAlt dflags op) non_nullary_cons
+         ++ [mkHsCaseAlt nlWildPat (mkTagCmp dflags op)])
 
 
-    mkOrdOpAlt :: OrdOp -> DataCon -> LMatch RdrName (LHsExpr RdrName)
+    mkOrdOpAlt :: DynFlags -> OrdOp -> DataCon
+                  -> LMatch GhcPs (LHsExpr GhcPs)
     -- Make the alternative  (Ki a1 a2 .. av ->
-    mkOrdOpAlt op data_con
+    mkOrdOpAlt dflags op data_con
       = mkHsCaseAlt (nlConVarPat data_con_RDR as_needed)
-                    (mkInnerRhs op data_con)
+                    (mkInnerRhs dflags op data_con)
       where
         as_needed    = take (dataConSourceArity data_con) as_RDRs
         data_con_RDR = getRdrName data_con
 
-    mkInnerRhs op data_con
+    mkInnerRhs dflags op data_con
       | single_con_type
       = nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con ]
 
@@ -490,47 +434,48 @@ gen_Ord_binds loc tycon
                                  , mkHsCaseAlt nlWildPat (gtResult op) ]
 
       | tag > last_tag `div` 2  -- lower range is larger
-      = untag_Expr tycon [(b_RDR, bh_RDR)] $
+      = untag_Expr dflags tycon [(b_RDR, bh_RDR)] $
         nlHsIf (genPrimOpApp (nlHsVar bh_RDR) ltInt_RDR tag_lit)
                (gtResult op) $  -- Definitely GT
         nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con
                                  , mkHsCaseAlt nlWildPat (ltResult op) ]
 
       | otherwise               -- upper range is larger
-      = untag_Expr tycon [(b_RDR, bh_RDR)] $
+      = untag_Expr dflags tycon [(b_RDR, bh_RDR)] $
         nlHsIf (genPrimOpApp (nlHsVar bh_RDR) gtInt_RDR tag_lit)
                (ltResult op) $  -- Definitely LT
         nlHsCase (nlHsVar b_RDR) [ mkInnerEqAlt op data_con
                                  , mkHsCaseAlt nlWildPat (gtResult op) ]
       where
         tag     = get_tag data_con
-        tag_lit = noLoc (HsLit (HsIntPrim "" (toInteger tag)))
+        tag_lit = noLoc (HsLit noExt (HsIntPrim NoSourceText (toInteger tag)))
 
-    mkInnerEqAlt :: OrdOp -> DataCon -> LMatch RdrName (LHsExpr RdrName)
+    mkInnerEqAlt :: OrdOp -> DataCon -> LMatch GhcPs (LHsExpr GhcPs)
     -- First argument 'a' known to be built with K
     -- Returns a case alternative  Ki b1 b2 ... bv -> compare (a1,a2,...) with (b1,b2,...)
     mkInnerEqAlt op data_con
       = mkHsCaseAlt (nlConVarPat data_con_RDR bs_needed) $
-        mkCompareFields tycon op (dataConOrigArgTys data_con)
+        mkCompareFields op (dataConOrigArgTys data_con)
       where
         data_con_RDR = getRdrName data_con
         bs_needed    = take (dataConSourceArity data_con) bs_RDRs
 
-    mkTagCmp :: OrdOp -> LHsExpr RdrName
+    mkTagCmp :: DynFlags -> OrdOp -> LHsExpr GhcPs
     -- Both constructors known to be nullary
-    -- genreates (case data2Tag a of a# -> case data2Tag b of b# -> a# `op` b#
-    mkTagCmp op = untag_Expr tycon [(a_RDR, ah_RDR),(b_RDR, bh_RDR)] $
-                  unliftedOrdOp tycon intPrimTy op ah_RDR bh_RDR
+    -- generates (case data2Tag a of a# -> case data2Tag b of b# -> a# `op` b#
+    mkTagCmp dflags op =
+      untag_Expr dflags tycon[(a_RDR, ah_RDR),(b_RDR, bh_RDR)] $
+        unliftedOrdOp intPrimTy op ah_RDR bh_RDR
 
-mkCompareFields :: TyCon -> OrdOp -> [Type] -> LHsExpr RdrName
+mkCompareFields :: OrdOp -> [Type] -> LHsExpr GhcPs
 -- Generates nested comparisons for (a1,a2...) against (b1,b2,...)
 -- where the ai,bi have the given types
-mkCompareFields tycon op tys
+mkCompareFields op tys
   = go tys as_RDRs bs_RDRs
   where
     go []   _      _          = eqResult op
     go [ty] (a:_)  (b:_)
-      | isUnliftedType ty     = unliftedOrdOp tycon ty op a b
+      | isUnliftedType ty     = unliftedOrdOp ty op a b
       | otherwise             = genOpApp (nlHsVar a) (ordMethRdr op) (nlHsVar b)
     go (ty:tys) (a:as) (b:bs) = mk_compare ty a b
                                   (ltResult op)
@@ -552,10 +497,10 @@ mkCompareFields tycon op tys
       where
         a_expr = nlHsVar a
         b_expr = nlHsVar b
-        (lt_op, _, eq_op, _, _) = primOrdOps "Ord" tycon ty
+        (lt_op, _, eq_op, _, _) = primOrdOps "Ord" ty
 
-unliftedOrdOp :: TyCon -> Type -> OrdOp -> RdrName -> RdrName -> LHsExpr RdrName
-unliftedOrdOp tycon ty op a b
+unliftedOrdOp :: Type -> OrdOp -> RdrName -> RdrName -> LHsExpr GhcPs
+unliftedOrdOp ty op a b
   = case op of
        OrdCompare -> unliftedCompare lt_op eq_op a_expr b_expr
                                      ltTag_Expr eqTag_Expr gtTag_Expr
@@ -564,15 +509,16 @@ unliftedOrdOp tycon ty op a b
        OrdGE      -> wrap ge_op
        OrdGT      -> wrap gt_op
   where
-   (lt_op, le_op, eq_op, ge_op, gt_op) = primOrdOps "Ord" tycon ty
+   (lt_op, le_op, eq_op, ge_op, gt_op) = primOrdOps "Ord" ty
    wrap prim_op = genPrimOpApp a_expr prim_op b_expr
    a_expr = nlHsVar a
    b_expr = nlHsVar b
 
 unliftedCompare :: RdrName -> RdrName
-                -> LHsExpr RdrName -> LHsExpr RdrName   -- What to cmpare
-                -> LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName  -- Three results
-                -> LHsExpr RdrName
+                -> LHsExpr GhcPs -> LHsExpr GhcPs   -- What to cmpare
+                -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
+                                                    -- Three results
+                -> LHsExpr GhcPs
 -- Return (if a < b then lt else if a == b then eq else gt)
 unliftedCompare lt_op eq_op a_expr b_expr lt eq gt
   = nlHsIf (ascribeBool $ genPrimOpApp a_expr lt_op b_expr) lt $
@@ -583,7 +529,7 @@ unliftedCompare lt_op eq_op a_expr b_expr lt eq gt
   where
     ascribeBool e = nlExprWithTySig e boolTy
 
-nlConWildPat :: DataCon -> LPat RdrName
+nlConWildPat :: DataCon -> LPat GhcPs
 -- The pattern (K {})
 nlConWildPat con = noLoc (ConPatIn (noLoc (getRdrName con))
                                    (RecCon (HsRecFields { rec_flds = []
@@ -632,76 +578,80 @@ instance ... Enum (Foo ...) where
 For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
 -}
 
-gen_Enum_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
-gen_Enum_binds loc tycon
-  = (method_binds, aux_binds)
+gen_Enum_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
+gen_Enum_binds loc tycon = do
+    dflags <- getDynFlags
+    return (method_binds dflags, aux_binds)
   where
-    method_binds = listToBag [
-                        succ_enum,
-                        pred_enum,
-                        to_enum,
-                        enum_from,
-                        enum_from_then,
-                        from_enum
-                    ]
+    method_binds dflags = listToBag
+      [ succ_enum      dflags
+      , pred_enum      dflags
+      , to_enum        dflags
+      , enum_from      dflags
+      , enum_from_then dflags
+      , from_enum      dflags
+      ]
     aux_binds = listToBag $ map DerivAuxBind
                   [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon]
 
     occ_nm = getOccString tycon
 
-    succ_enum
+    succ_enum dflags
       = mk_easy_FunBind loc succ_RDR [a_Pat] $
-        untag_Expr tycon [(a_RDR, ah_RDR)] $
-        nlHsIf (nlHsApps eq_RDR [nlHsVar (maxtag_RDR tycon),
+        untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
+        nlHsIf (nlHsApps eq_RDR [nlHsVar (maxtag_RDR dflags tycon),
                                nlHsVarApps intDataCon_RDR [ah_RDR]])
              (illegal_Expr "succ" occ_nm "tried to take `succ' of last tag in enumeration")
-             (nlHsApp (nlHsVar (tag2con_RDR tycon))
+             (nlHsApp (nlHsVar (tag2con_RDR dflags tycon))
                     (nlHsApps plus_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
                                         nlHsIntLit 1]))
 
-    pred_enum
+    pred_enum dflags
       = mk_easy_FunBind loc pred_RDR [a_Pat] $
-        untag_Expr tycon [(a_RDR, ah_RDR)] $
+        untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
         nlHsIf (nlHsApps eq_RDR [nlHsIntLit 0,
                                nlHsVarApps intDataCon_RDR [ah_RDR]])
              (illegal_Expr "pred" occ_nm "tried to take `pred' of first tag in enumeration")
-             (nlHsApp (nlHsVar (tag2con_RDR tycon))
-                           (nlHsApps plus_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
-                                               nlHsLit (HsInt "-1" (-1))]))
+             (nlHsApp (nlHsVar (tag2con_RDR dflags tycon))
+                      (nlHsApps plus_RDR
+                            [ nlHsVarApps intDataCon_RDR [ah_RDR]
+                            , nlHsLit (HsInt noExt
+                                                (mkIntegralLit (-1 :: Int)))]))
 
-    to_enum
+    to_enum dflags
       = mk_easy_FunBind loc toEnum_RDR [a_Pat] $
         nlHsIf (nlHsApps and_RDR
                 [nlHsApps ge_RDR [nlHsVar a_RDR, nlHsIntLit 0],
-                 nlHsApps le_RDR [nlHsVar a_RDR, nlHsVar (maxtag_RDR tycon)]])
-             (nlHsVarApps (tag2con_RDR tycon) [a_RDR])
-             (illegal_toEnum_tag occ_nm (maxtag_RDR tycon))
+                 nlHsApps le_RDR [ nlHsVar a_RDR
+                                 , nlHsVar (maxtag_RDR dflags tycon)]])
+             (nlHsVarApps (tag2con_RDR dflags tycon) [a_RDR])
+             (illegal_toEnum_tag occ_nm (maxtag_RDR dflags tycon))
 
-    enum_from
+    enum_from dflags
       = mk_easy_FunBind loc enumFrom_RDR [a_Pat] $
-          untag_Expr tycon [(a_RDR, ah_RDR)] $
+          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
           nlHsApps map_RDR
-                [nlHsVar (tag2con_RDR tycon),
+                [nlHsVar (tag2con_RDR dflags tycon),
                  nlHsPar (enum_from_to_Expr
                             (nlHsVarApps intDataCon_RDR [ah_RDR])
-                            (nlHsVar (maxtag_RDR tycon)))]
+                            (nlHsVar (maxtag_RDR dflags tycon)))]
 
-    enum_from_then
+    enum_from_then dflags
       = mk_easy_FunBind loc enumFromThen_RDR [a_Pat, b_Pat] $
-          untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
-          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR tycon]) $
+          untag_Expr dflags tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
+          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR dflags tycon]) $
             nlHsPar (enum_from_then_to_Expr
                     (nlHsVarApps intDataCon_RDR [ah_RDR])
                     (nlHsVarApps intDataCon_RDR [bh_RDR])
                     (nlHsIf  (nlHsApps gt_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
                                                nlHsVarApps intDataCon_RDR [bh_RDR]])
                            (nlHsIntLit 0)
-                           (nlHsVar (maxtag_RDR tycon))
+                           (nlHsVar (maxtag_RDR dflags tycon))
                            ))
 
-    from_enum
+    from_enum dflags
       = mk_easy_FunBind loc fromEnum_RDR [a_Pat] $
-          untag_Expr tycon [(a_RDR, ah_RDR)] $
+          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
           (nlHsVarApps intDataCon_RDR [ah_RDR])
 
 {-
@@ -712,7 +662,7 @@ gen_Enum_binds loc tycon
 ************************************************************************
 -}
 
-gen_Bounded_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
+gen_Bounded_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
 gen_Bounded_binds loc tycon
   | isEnumerationTyCon tycon
   = (listToBag [ min_bound_enum, max_bound_enum ], emptyBag)
@@ -735,9 +685,9 @@ gen_Bounded_binds loc tycon
     arity          = dataConSourceArity data_con_1
 
     min_bound_1con = mkHsVarBind loc minBound_RDR $
-                     nlHsVarApps data_con_1_RDR (nOfThem arity minBound_RDR)
+                     nlHsVarApps data_con_1_RDR (replicate arity minBound_RDR)
     max_bound_1con = mkHsVarBind loc maxBound_RDR $
-                     nlHsVarApps data_con_1_RDR (nOfThem arity maxBound_RDR)
+                     nlHsVarApps data_con_1_RDR (replicate arity maxBound_RDR)
 
 {-
 ************************************************************************
@@ -799,35 +749,38 @@ we follow the scheme given in Figure~19 of the Haskell~1.2 report
 (p.~147).
 -}
 
-gen_Ix_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
+gen_Ix_binds :: SrcSpan -> TyCon -> TcM (LHsBinds GhcPs, BagDerivStuff)
 
-gen_Ix_binds loc tycon
-  | isEnumerationTyCon tycon
-  = ( enum_ixes
-    , listToBag $ map DerivAuxBind
+gen_Ix_binds loc tycon = do
+    dflags <- getDynFlags
+    return $ if isEnumerationTyCon tycon
+      then (enum_ixes dflags, listToBag $ map DerivAuxBind
                    [DerivCon2Tag tycon, DerivTag2Con tycon, DerivMaxTag tycon])
-  | otherwise
-  = (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon)))
+      else (single_con_ixes, unitBag (DerivAuxBind (DerivCon2Tag tycon)))
   where
     --------------------------------------------------------------
-    enum_ixes = listToBag [ enum_range, enum_index, enum_inRange ]
+    enum_ixes dflags = listToBag
+      [ enum_range   dflags
+      , enum_index   dflags
+      , enum_inRange dflags
+      ]
 
-    enum_range
+    enum_range dflags
       = mk_easy_FunBind loc range_RDR [nlTuplePat [a_Pat, b_Pat] Boxed] $
-          untag_Expr tycon [(a_RDR, ah_RDR)] $
-          untag_Expr tycon [(b_RDR, bh_RDR)] $
-          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR tycon]) $
+          untag_Expr dflags tycon [(a_RDR, ah_RDR)] $
+          untag_Expr dflags tycon [(b_RDR, bh_RDR)] $
+          nlHsApp (nlHsVarApps map_RDR [tag2con_RDR dflags tycon]) $
               nlHsPar (enum_from_to_Expr
                         (nlHsVarApps intDataCon_RDR [ah_RDR])
                         (nlHsVarApps intDataCon_RDR [bh_RDR]))
 
-    enum_index
+    enum_index dflags
       = mk_easy_FunBind loc unsafeIndex_RDR
-                [noLoc (AsPat (noLoc c_RDR)
+                [noLoc (AsPat noExt (noLoc c_RDR)
                            (nlTuplePat [a_Pat, nlWildPat] Boxed)),
                                 d_Pat] (
-           untag_Expr tycon [(a_RDR, ah_RDR)] (
-           untag_Expr tycon [(d_RDR, dh_RDR)] (
+           untag_Expr dflags tycon [(a_RDR, ah_RDR)] (
+           untag_Expr dflags tycon [(d_RDR, dh_RDR)] (
            let
                 rhs = nlHsVarApps intDataCon_RDR [c_RDR]
            in
@@ -838,11 +791,11 @@ gen_Ix_binds loc tycon
         )
 
     -- This produces something like `(ch >= ah) && (ch <= bh)`
-    enum_inRange
+    enum_inRange dflags
       = mk_easy_FunBind loc inRange_RDR [nlTuplePat [a_Pat, b_Pat] Boxed, c_Pat] $
-          untag_Expr tycon [(a_RDR, ah_RDR)] (
-          untag_Expr tycon [(b_RDR, bh_RDR)] (
-          untag_Expr tycon [(c_RDR, ch_RDR)] (
+          untag_Expr dflags tycon [(a_RDR, ah_RDR)] (
+          untag_Expr dflags tycon [(b_RDR, bh_RDR)] (
+          untag_Expr dflags tycon [(c_RDR, ch_RDR)] (
           -- This used to use `if`, which interacts badly with RebindableSyntax.
           -- See #11396.
           nlHsApps and_RDR
@@ -915,7 +868,7 @@ gen_Ix_binds loc tycon
                  con_pat cs_needed] $
           if con_arity == 0
              -- If the product type has no fields, inRange is trivially true
-             -- (see Trac #12853).
+             -- (see #12853).
              then true_Expr
              else foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range
                     as_needed bs_needed cs_needed)
@@ -950,9 +903,7 @@ instance Read T where
         -- Record construction binds even more tightly than application
         do expectP (Ident "T1")
            expectP (Punc '{')
-           expectP (Ident "f1")
-           expectP (Punc '=')
-           x          <- ReadP.reset Read.readPrec
+           x          <- Read.readField "f1" (ReadP.reset readPrec)
            expectP (Punc '}')
            return (T1 { f1 = x }))
       +++
@@ -974,12 +925,12 @@ rather than
    Ident "T1" <- lexP
 The latter desugares to inline code for matching the Ident and the
 string, and this can be very voluminous. The former is much more
-compact.  Cf Trac #7258, although that also concerned non-linearity in
+compact.  Cf #7258, although that also concerned non-linearity in
 the occurrence analyser, a separate issue.
 
 Note [Read for empty data types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-What should we get for this?  (Trac #7931)
+What should we get for this?  (#7931)
    data Emp deriving( Read )   -- No data constructors
 
 Here we want
@@ -996,7 +947,8 @@ These instances are also useful for Read (Either Int Emp), where
 we want to be able to parse (Left 3) just fine.
 -}
 
-gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
+gen_Read_binds :: (Name -> Fixity) -> SrcSpan -> TyCon
+               -> (LHsBinds GhcPs, BagDerivStuff)
 
 gen_Read_binds get_fixity loc tycon
   = (listToBag [read_prec, default_readlist, default_readlistprec], emptyBag)
@@ -1012,11 +964,15 @@ gen_Read_binds get_fixity loc tycon
     data_cons = tyConDataCons tycon
     (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon data_cons
 
-    read_prec = mkHsVarBind loc readPrec_RDR
-                              (nlHsApp (nlHsVar parens_RDR) read_cons)
+    read_prec = mkHsVarBind loc readPrec_RDR rhs
+      where
+        rhs | null data_cons -- See Note [Read for empty data types]
+            = nlHsVar pfail_RDR
+            | otherwise
+            = nlHsApp (nlHsVar parens_RDR)
+                      (foldr1 mk_alt (read_nullary_cons ++
+                                      read_non_nullary_cons))
 
-    read_cons | null data_cons = nlHsVar pfail_RDR  -- See Note [Read for empty data types]
-              | otherwise      = foldr1 mk_alt (read_nullary_cons ++ read_non_nullary_cons)
     read_non_nullary_cons = map read_non_nullary_con non_nullary_cons
 
     read_nullary_cons
@@ -1081,7 +1037,7 @@ gen_Read_binds get_fixity loc tycon
         labels       = map flLabel $ dataConFieldLabels data_con
         dc_nm        = getName data_con
         is_infix     = dataConIsInfix data_con
-        is_record    = length labels > 0
+        is_record    = labels `lengthExceeds` 0
         as_needed    = take con_arity as_RDRs
         read_args    = zipWithEqual "gen_Read_binds" read_arg as_needed (dataConOrigArgTys data_con)
         (read_a1:read_a2:_) = read_args
@@ -1102,7 +1058,7 @@ gen_Read_binds get_fixity loc tycon
 
     -- For constructors and field labels ending in '#', we hackily
     -- let the lexer generate two tokens, and look for both in sequence
-    -- Thus [Ident "I"; Symbol "#"].  See Trac #5041
+    -- Thus [Ident "I"; Symbol "#"].  See #5041
     ident_h_pat s | Just (ss, '#') <- snocView s = [ ident_pat ss, symbol_pat "#" ]
                   | otherwise                    = [ ident_pat s ]
 
@@ -1117,21 +1073,32 @@ gen_Read_binds get_fixity loc tycon
     read_arg a ty = ASSERT( not (isUnliftedType ty) )
                     noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps step_RDR [readPrec_RDR]))
 
-    read_field lbl a = read_lbl lbl ++
-                       [read_punc "=",
-                        noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps reset_RDR [readPrec_RDR]))]
-
-        -- When reading field labels we might encounter
-        --      a  = 3
-        --      _a = 3
-        -- or   (#) = 4
-        -- Note the parens!
-    read_lbl lbl | isSym lbl_str
-                 = [read_punc "(", symbol_pat lbl_str, read_punc ")"]
-                 | otherwise
-                 = ident_h_pat lbl_str
-                 where
-                   lbl_str = unpackFS lbl
+    -- When reading field labels we might encounter
+    --      a  = 3
+    --      _a = 3
+    -- or   (#) = 4
+    -- Note the parens!
+    read_field lbl a =
+        [noLoc
+          (mkBindStmt
+            (nlVarPat a)
+            (nlHsApp
+              read_field
+              (nlHsVarApps reset_RDR [readPrec_RDR])
+            )
+          )
+        ]
+        where
+          lbl_str = unpackFS lbl
+          mk_read_field read_field_rdr lbl
+              = nlHsApps read_field_rdr [nlHsLit (mkHsString lbl)]
+          read_field
+              | isSym lbl_str
+              = mk_read_field readSymField_RDR lbl_str
+              | Just (ss, '#') <- snocView lbl_str -- #14918
+              = mk_read_field readFieldHash_RDR ss
+              | otherwise
+              = mk_read_field readField_RDR lbl_str
 
 {-
 ************************************************************************
@@ -1164,17 +1131,15 @@ Example
                     -- the most tightly-binding operator
 -}
 
-gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
+gen_Show_binds :: (Name -> Fixity) -> SrcSpan -> TyCon
+               -> (LHsBinds GhcPs, BagDerivStuff)
 
 gen_Show_binds get_fixity loc tycon
-  = (listToBag [shows_prec, show_list], emptyBag)
+  = (unitBag shows_prec, emptyBag)
   where
-    -----------------------------------------------------------------------
-    show_list = mkHsVarBind loc showList_RDR
-                  (nlHsApp (nlHsVar showList___RDR) (nlHsPar (nlHsApp (nlHsVar showsPrec_RDR) (nlHsIntLit 0))))
-    -----------------------------------------------------------------------
     data_cons = tyConDataCons tycon
-    shows_prec = mk_FunBind loc showsPrec_RDR (map pats_etc data_cons)
+    shows_prec = mkFunBindEC 2 loc showsPrec_RDR id (map pats_etc data_cons)
+    comma_space = nlHsVar showCommaSpace_RDR
 
     pats_etc data_con
       | nullary_con =  -- skip the showParen junk...
@@ -1182,8 +1147,8 @@ gen_Show_binds get_fixity loc tycon
          ([nlWildPat, con_pat], mk_showString_app op_con_str)
       | otherwise   =
          ([a_Pat, con_pat],
-          showParen_Expr (genOpApp a_Expr ge_RDR
-                              (nlHsLit (HsInt "" con_prec_plus_one)))
+          showParen_Expr (genOpApp a_Expr ge_RDR (nlHsLit
+                         (HsInt noExt (mkIntegralLit con_prec_plus_one))))
                          (nlHsPar (nested_compose_Expr show_thingies)))
         where
              data_con_RDR  = getRdrName data_con
@@ -1224,23 +1189,32 @@ gen_Show_binds get_fixity loc tycon
                 -- Assumption for record syntax: no of fields == no of
                 -- labelled fields (and in same order)
              show_record_args = concat $
-                                intersperse [mk_showString_app ", "] $
+                                intersperse [comma_space] $
                                 [ [show_label lbl, arg]
                                 | (lbl,arg) <- zipEqual "gen_Show_binds"
                                                         labels show_args ]
 
-             show_arg :: RdrName -> Type -> LHsExpr RdrName
+             show_arg :: RdrName -> Type -> LHsExpr GhcPs
              show_arg b arg_ty
-               | isUnliftedType arg_ty
-               -- See Note [Deriving and unboxed types] in TcDeriv
-               = nlHsApps compose_RDR [mk_shows_app boxed_arg,
-                                       mk_showString_app postfixMod]
-               | otherwise
-               = mk_showsPrec_app arg_prec arg
-                 where
-                   arg        = nlHsVar b
-                   boxed_arg  = box "Show" tycon arg arg_ty
-                   postfixMod = assoc_ty_id "Show" tycon postfixModTbl arg_ty
+                 | isUnliftedType arg_ty
+                 -- See Note [Deriving and unboxed types] in TcDerivInfer
+                 = with_conv $
+                    nlHsApps compose_RDR
+                        [mk_shows_app boxed_arg, mk_showString_app postfixMod]
+                 | otherwise
+                 = mk_showsPrec_app arg_prec arg
+               where
+                 arg        = nlHsVar b
+                 boxed_arg  = box "Show" arg arg_ty
+                 postfixMod = assoc_ty_id "Show" postfixModTbl arg_ty
+                 with_conv expr
+                    | (Just conv) <- assoc_ty_id_maybe primConvTbl arg_ty =
+                        nested_compose_Expr
+                            [ mk_showString_app ("(" ++ conv ++ " ")
+                            , expr
+                            , mk_showString_app ")"
+                            ]
+                    | otherwise = expr
 
                 -- Fixity stuff
              is_infix = dataConIsInfix data_con
@@ -1261,15 +1235,16 @@ isSym ""      = False
 isSym (c : _) = startsVarSym c || startsConSym c
 
 -- | showString :: String -> ShowS
-mk_showString_app :: String -> LHsExpr RdrName
+mk_showString_app :: String -> LHsExpr GhcPs
 mk_showString_app str = nlHsApp (nlHsVar showString_RDR) (nlHsLit (mkHsString str))
 
 -- | showsPrec :: Show a => Int -> a -> ShowS
-mk_showsPrec_app :: Integer -> LHsExpr RdrName -> LHsExpr RdrName
-mk_showsPrec_app p x = nlHsApps showsPrec_RDR [nlHsLit (HsInt "" p), x]
+mk_showsPrec_app :: Integer -> LHsExpr GhcPs -> LHsExpr GhcPs
+mk_showsPrec_app p x
+  = nlHsApps showsPrec_RDR [nlHsLit (HsInt noExt (mkIntegralLit p)), x]
 
 -- | shows :: Show a => a -> ShowS
-mk_shows_app :: LHsExpr RdrName -> LHsExpr RdrName
+mk_shows_app :: LHsExpr GhcPs -> LHsExpr GhcPs
 mk_shows_app x = nlHsApp (nlHsVar shows_RDR) x
 
 getPrec :: Bool -> (Name -> Fixity) -> Name -> Integer
@@ -1329,14 +1304,14 @@ we generate
 gen_Data_binds :: SrcSpan
                -> TyCon                 -- For data families, this is the
                                         --  *representation* TyCon
-               -> TcM (LHsBinds RdrName,    -- The method bindings
-                       BagDerivStuff)       -- Auxiliary bindings
+               -> TcM (LHsBinds GhcPs,  -- The method bindings
+                       BagDerivStuff)   -- Auxiliary bindings
 gen_Data_binds loc rep_tc
   = do { dflags  <- getDynFlags
 
        -- Make unique names for the data type and constructor
        -- auxiliary bindings.  Start with the name of the TyCon/DataCon
-       -- but that might not be unique: see Trac #12245.
+       -- but that might not be unique: see #12245.
        ; dt_occ  <- chooseUniqueOccTc (mkDataTOcc (getOccName rep_tc))
        ; dc_occs <- mapM (chooseUniqueOccTc . mkDataCOcc . getOccName)
                          (tyConDataCons rep_tc)
@@ -1348,7 +1323,7 @@ gen_Data_binds loc rep_tc
 
 gen_data :: DynFlags -> RdrName -> [RdrName]
          -> SrcSpan -> TyCon
-         -> (LHsBinds RdrName,    -- The method bindings
+         -> (LHsBinds GhcPs,      -- The method bindings
              BagDerivStuff)       -- Auxiliary bindings
 gen_data dflags data_type_name constr_names loc rep_tc
   = (listToBag [gfoldl_bind, gunfold_bind, toCon_bind, dataTypeOf_bind]
@@ -1363,7 +1338,7 @@ gen_data dflags data_type_name constr_names loc rep_tc
     genDataTyCon :: DerivStuff
     genDataTyCon        --  $dT
       = DerivHsBind (mkHsVarBind loc data_type_name rhs,
-                     L loc (TypeSig [L loc data_type_name] sig_ty))
+                     L loc (TypeSig noExt [L loc data_type_name] sig_ty))
 
     sig_ty = mkLHsSigWcType (nlHsTyVar dataType_RDR)
     rhs    = nlHsVar mkDataType_RDR
@@ -1373,7 +1348,7 @@ gen_data dflags data_type_name constr_names loc rep_tc
     genDataDataCon :: DataCon -> RdrName -> DerivStuff
     genDataDataCon dc constr_name       --  $cT1 etc
       = DerivHsBind (mkHsVarBind loc constr_name rhs,
-                     L loc (TypeSig [L loc constr_name] sig_ty))
+                     L loc (TypeSig noExt [L loc constr_name] sig_ty))
       where
         sig_ty   = mkLHsSigWcType (nlHsTyVar constr_RDR)
         rhs      = nlHsApps mkConstr_RDR constr_args
@@ -1393,11 +1368,11 @@ gen_data dflags data_type_name constr_names loc rep_tc
                | otherwise = prefix_RDR
 
         ------------ gfoldl
-    gfoldl_bind = mk_HRFunBind 2 loc gfoldl_RDR (map gfoldl_eqn data_cons)
+    gfoldl_bind = mkFunBindEC 3 loc gfoldl_RDR id (map gfoldl_eqn data_cons)
 
     gfoldl_eqn con
-      = ([nlVarPat k_RDR, nlVarPat z_RDR, nlConVarPat con_name as_needed],
-                       foldl mk_k_app (nlHsVar z_RDR `nlHsApp` nlHsVar con_name) as_needed)
+      = ([nlVarPat k_RDR, z_Pat, nlConVarPat con_name as_needed],
+                   foldl' mk_k_app (z_Expr `nlHsApp` nlHsVar con_name) as_needed)
                    where
                      con_name ::  RdrName
                      con_name = getRdrName con
@@ -1405,10 +1380,10 @@ gen_data dflags data_type_name constr_names loc rep_tc
                      mk_k_app e v = nlHsPar (nlHsOpApp e k_RDR (nlHsVar v))
 
         ------------ gunfold
-    gunfold_bind = mk_HRFunBind 2 loc
+    gunfold_bind = mk_easy_FunBind loc
                      gunfold_RDR
-                     [([k_Pat, z_Pat, if one_constr then nlWildPat else c_Pat],
-                       gunfold_rhs)]
+                     [k_Pat, z_Pat, if one_constr then nlWildPat else c_Pat]
+                     gunfold_rhs
 
     gunfold_rhs
         | one_constr = mk_unfold_rhs (head data_cons)   -- No need for case
@@ -1417,19 +1392,20 @@ gen_data dflags data_type_name constr_names loc rep_tc
 
     gunfold_alt dc = mkHsCaseAlt (mk_unfold_pat dc) (mk_unfold_rhs dc)
     mk_unfold_rhs dc = foldr nlHsApp
-                           (nlHsVar z_RDR `nlHsApp` nlHsVar (getRdrName dc))
+                           (z_Expr `nlHsApp` nlHsVar (getRdrName dc))
                            (replicate (dataConSourceArity dc) (nlHsVar k_RDR))
 
     mk_unfold_pat dc    -- Last one is a wild-pat, to avoid
                         -- redundant test, and annoying warning
       | tag-fIRST_TAG == n_cons-1 = nlWildPat   -- Last constructor
       | otherwise = nlConPat intDataCon_RDR
-                             [nlLitPat (HsIntPrim "" (toInteger tag))]
+                             [nlLitPat (HsIntPrim NoSourceText (toInteger tag))]
       where
         tag = dataConTag dc
 
         ------------ toConstr
-    toCon_bind = mk_FunBind loc toConstr_RDR (zipWith to_con_eqn data_cons constr_names)
+    toCon_bind = mkFunBindEC 1 loc toConstr_RDR id
+                     (zipWith to_con_eqn data_cons constr_names)
     to_con_eqn dc con_name = ([nlWildConPat dc], nlHsVar con_name)
 
         ------------ dataTypeOf
@@ -1452,7 +1428,7 @@ gen_data dflags data_type_name constr_names loc rep_tc
         -- because D :: * -> *
         -- even though rep_tc has kind * -> * -> * -> *
         -- Hence looking for the kind of fam_tc not rep_tc
-        -- See Trac #4896
+        -- See #4896
     tycon_kind = case tyConFamInst_maybe rep_tc of
                     Just (fam_tc, _) -> tyConKind fam_tc
                     Nothing          -> tyConKind rep_tc
@@ -1465,8 +1441,8 @@ gen_data dflags data_type_name constr_names loc rep_tc
 
 
 kind1, kind2 :: Kind
-kind1 = liftedTypeKind `mkFunTy` liftedTypeKind
-kind2 = liftedTypeKind `mkFunTy` kind1
+kind1 = liftedTypeKind `mkVisFunTy` liftedTypeKind
+kind2 = liftedTypeKind `mkVisFunTy` kind1
 
 gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstr_RDR,
     mkDataType_RDR, conIndex_RDR, prefix_RDR, infix_RDR,
@@ -1474,10 +1450,16 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstr_RDR,
     constr_RDR, dataType_RDR,
     eqChar_RDR  , ltChar_RDR  , geChar_RDR  , gtChar_RDR  , leChar_RDR  ,
     eqInt_RDR   , ltInt_RDR   , geInt_RDR   , gtInt_RDR   , leInt_RDR   ,
+    eqInt8_RDR  , ltInt8_RDR  , geInt8_RDR  , gtInt8_RDR  , leInt8_RDR  ,
+    eqInt16_RDR , ltInt16_RDR , geInt16_RDR , gtInt16_RDR , leInt16_RDR ,
     eqWord_RDR  , ltWord_RDR  , geWord_RDR  , gtWord_RDR  , leWord_RDR  ,
+    eqWord8_RDR , ltWord8_RDR , geWord8_RDR , gtWord8_RDR , leWord8_RDR ,
+    eqWord16_RDR, ltWord16_RDR, geWord16_RDR, gtWord16_RDR, leWord16_RDR,
     eqAddr_RDR  , ltAddr_RDR  , geAddr_RDR  , gtAddr_RDR  , leAddr_RDR  ,
     eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR ,
-    eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR :: RdrName
+    eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,
+    extendWord8_RDR, extendInt8_RDR,
+    extendWord16_RDR, extendInt16_RDR :: RdrName
 gfoldl_RDR     = varQual_RDR  gENERICS (fsLit "gfoldl")
 gunfold_RDR    = varQual_RDR  gENERICS (fsLit "gunfold")
 toConstr_RDR   = varQual_RDR  gENERICS (fsLit "toConstr")
@@ -1506,12 +1488,36 @@ leInt_RDR      = varQual_RDR  gHC_PRIM (fsLit "<=#")
 gtInt_RDR      = varQual_RDR  gHC_PRIM (fsLit ">#" )
 geInt_RDR      = varQual_RDR  gHC_PRIM (fsLit ">=#")
 
+eqInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit "eqInt8#")
+ltInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit "ltInt8#" )
+leInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit "leInt8#")
+gtInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit "gtInt8#" )
+geInt8_RDR     = varQual_RDR  gHC_PRIM (fsLit "geInt8#")
+
+eqInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit "eqInt16#")
+ltInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit "ltInt16#" )
+leInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit "leInt16#")
+gtInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit "gtInt16#" )
+geInt16_RDR    = varQual_RDR  gHC_PRIM (fsLit "geInt16#")
+
 eqWord_RDR     = varQual_RDR  gHC_PRIM (fsLit "eqWord#")
 ltWord_RDR     = varQual_RDR  gHC_PRIM (fsLit "ltWord#")
 leWord_RDR     = varQual_RDR  gHC_PRIM (fsLit "leWord#")
 gtWord_RDR     = varQual_RDR  gHC_PRIM (fsLit "gtWord#")
 geWord_RDR     = varQual_RDR  gHC_PRIM (fsLit "geWord#")
 
+eqWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit "eqWord8#")
+ltWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit "ltWord8#" )
+leWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit "leWord8#")
+gtWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit "gtWord8#" )
+geWord8_RDR    = varQual_RDR  gHC_PRIM (fsLit "geWord8#")
+
+eqWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit "eqWord16#")
+ltWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit "ltWord16#" )
+leWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit "leWord16#")
+gtWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit "gtWord16#" )
+geWord16_RDR   = varQual_RDR  gHC_PRIM (fsLit "geWord16#")
+
 eqAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit "eqAddr#")
 ltAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit "ltAddr#")
 leAddr_RDR     = varQual_RDR  gHC_PRIM (fsLit "leAddr#")
@@ -1530,781 +1536,363 @@ leDouble_RDR   = varQual_RDR  gHC_PRIM (fsLit "<=##")
 gtDouble_RDR   = varQual_RDR  gHC_PRIM (fsLit ">##" )
 geDouble_RDR   = varQual_RDR  gHC_PRIM (fsLit ">=##")
 
+extendWord8_RDR = varQual_RDR  gHC_PRIM (fsLit "extendWord8#")
+extendInt8_RDR  = varQual_RDR  gHC_PRIM (fsLit "extendInt8#")
+
+extendWord16_RDR = varQual_RDR  gHC_PRIM (fsLit "extendWord16#")
+extendInt16_RDR  = varQual_RDR  gHC_PRIM (fsLit "extendInt16#")
+
+
 {-
 ************************************************************************
 *                                                                      *
-                        Functor instances
-
- see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html
-
+                        Lift instances
 *                                                                      *
 ************************************************************************
 
-For the data type:
-
-  data T a = T1 Int a | T2 (T a)
-
-We generate the instance:
-
-  instance Functor T where
-      fmap f (T1 b1 a) = T1 b1 (f a)
-      fmap f (T2 ta)   = T2 (fmap f ta)
-
-Notice that we don't simply apply 'fmap' to the constructor arguments.
-Rather
-  - Do nothing to an argument whose type doesn't mention 'a'
-  - Apply 'f' to an argument of type 'a'
-  - Apply 'fmap f' to other arguments
-That's why we have to recurse deeply into the constructor argument types,
-rather than just one level, as we typically do.
-
-What about types with more than one type parameter?  In general, we only
-derive Functor for the last position:
-
-  data S a b = S1 [b] | S2 (a, T a b)
-  instance Functor (S a) where
-    fmap f (S1 bs)    = S1 (fmap f bs)
-    fmap f (S2 (p,q)) = S2 (a, fmap f q)
-
-However, we have special cases for
-         - tuples
-         - functions
-
-More formally, we write the derivation of fmap code over type variable
-'a for type 'b as ($fmap 'a 'b).  In this general notation the derived
-instance for T is:
-
-  instance Functor T where
-      fmap f (T1 x1 x2) = T1 ($(fmap 'a 'b1) x1) ($(fmap 'a 'a) x2)
-      fmap f (T2 x1)    = T2 ($(fmap 'a '(T a)) x1)
-
-  $(fmap 'a 'b)          =  \x -> x     -- when b does not contain a
-  $(fmap 'a 'a)          =  f
-  $(fmap 'a '(b1,b2))    =  \x -> case x of (x1,x2) -> ($(fmap 'a 'b1) x1, $(fmap 'a 'b2) x2)
-  $(fmap 'a '(T b1 b2))  =  fmap $(fmap 'a 'b2)   -- when a only occurs in the last parameter, b2
-  $(fmap 'a '(b -> c))   =  \x b -> $(fmap 'a' 'c) (x ($(cofmap 'a 'b) b))
-
-For functions, the type parameter 'a can occur in a contravariant position,
-which means we need to derive a function like:
-
-  cofmap :: (a -> b) -> (f b -> f a)
-
-This is pretty much the same as $fmap, only without the $(cofmap 'a 'a) case:
-
-  $(cofmap 'a 'b)          =  \x -> x     -- when b does not contain a
-  $(cofmap 'a 'a)          =  error "type variable in contravariant position"
-  $(cofmap 'a '(b1,b2))    =  \x -> case x of (x1,x2) -> ($(cofmap 'a 'b1) x1, $(cofmap 'a 'b2) x2)
-  $(cofmap 'a '[b])        =  map $(cofmap 'a 'b)
-  $(cofmap 'a '(T b1 b2))  =  fmap $(cofmap 'a 'b2)   -- when a only occurs in the last parameter, b2
-  $(cofmap 'a '(b -> c))   =  \x b -> $(cofmap 'a' 'c) (x ($(fmap 'a 'c) b))
+Example:
 
-Note that the code produced by $(fmap _ _) is always a higher order function,
-with type `(a -> b) -> (g a -> g b)` for some g. When we need to do pattern
-matching on the type, this means create a lambda function (see the (,) case above).
-The resulting code for fmap can look a bit weird, for example:
+    data Foo a = Foo a | a :^: a deriving Lift
 
-  data X a = X (a,Int)
-  -- generated instance
-  instance Functor X where
-      fmap f (X x) = (\y -> case y of (x1,x2) -> X (f x1, (\z -> z) x2)) x
+    ==>
 
-The optimizer should be able to simplify this code by simple inlining.
+    instance (Lift a) => Lift (Foo a) where
+        lift (Foo a) = [| Foo a |]
+        lift ((:^:) u v) = [| (:^:) u v |]
 
-An older version of the deriving code tried to avoid these applied
-lambda functions by producing a meta level function. But the function to
-be mapped, `f`, is a function on the code level, not on the meta level,
-so it was eta expanded to `\x -> [| f $x |]`. This resulted in too much eta expansion.
-It is better to produce too many lambdas than to eta expand, see ticket #7436.
+        liftTyped (Foo a) = [|| Foo a ||]
+        liftTyped ((:^:) u v) = [|| (:^:) u v ||]
 -}
 
-gen_Functor_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
-gen_Functor_binds loc tycon
-  = (unitBag fmap_bind, emptyBag)
-  where
-    data_cons = tyConDataCons tycon
-    fun_name = L loc fmap_RDR
-    fmap_bind = mkRdrFunBind fun_name eqns
-
-    fmap_eqn con = evalState (match_for_con [f_Pat] con =<< parts) bs_RDRs
-      where
-        parts = sequence $ foldDataConArgs ft_fmap con
-
-    eqns | null data_cons = [mkSimpleMatch (FunRhs fun_name Prefix)
-                                           [nlWildPat, nlWildPat]
-                                           (error_Expr "Void fmap")]
-         | otherwise      = map fmap_eqn data_cons
-
-    ft_fmap :: FFoldType (State [RdrName] (LHsExpr RdrName))
-    ft_fmap = FT { ft_triv = mkSimpleLam $ \x -> return x
-                   -- fmap f = \x -> x
-                 , ft_var  = return f_Expr
-                   -- fmap f = f
-                 , ft_fun  = \g h -> do
-                     gg <- g
-                     hh <- h
-                     mkSimpleLam2 $ \x b -> return $
-                       nlHsApp hh (nlHsApp x (nlHsApp gg b))
-                   -- fmap f = \x b -> h (x (g b))
-                 , ft_tup = \t gs -> do
-                     gg <- sequence gs
-                     mkSimpleLam $ mkSimpleTupleCase match_for_con t gg
-                   -- fmap f = \x -> case x of (a1,a2,..) -> (g1 a1,g2 a2,..)
-                 , ft_ty_app = \_ g -> nlHsApp fmap_Expr <$> g
-                   -- fmap f = fmap g
-                 , ft_forall = \_ g -> g
-                 , ft_bad_app = panic "in other argument"
-                 , ft_co_var = panic "contravariant" }
-
-    -- Con a1 a2 ... -> Con (f1 a1) (f2 a2) ...
-    match_for_con :: [LPat RdrName] -> DataCon -> [LHsExpr RdrName]
-                  -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
-    match_for_con = mkSimpleConMatch CaseAlt $
-        \con_name xs -> return $ nlHsApps con_name xs  -- Con x1 x2 ..
 
-{-
-Utility functions related to Functor deriving.
+gen_Lift_binds :: SrcSpan -> TyCon -> (LHsBinds GhcPs, BagDerivStuff)
+gen_Lift_binds loc tycon = (listToBag [lift_bind, liftTyped_bind], emptyBag)
+  where
+    lift_bind      = mkFunBindEC 1 loc lift_RDR (nlHsApp pure_Expr)
+                                 (map (pats_etc mk_exp) data_cons)
+    liftTyped_bind = mkFunBindEC 1 loc liftTyped_RDR (nlHsApp pure_Expr)
+                                 (map (pats_etc mk_texp) data_cons)
 
-Since several things use the same pattern of traversal, this is abstracted into functorLikeTraverse.
-This function works like a fold: it makes a value of type 'a' in a bottom up way.
--}
+    mk_exp = ExpBr NoExt
+    mk_texp = TExpBr NoExt
+    data_cons = tyConDataCons tycon
 
--- Generic traversal for Functor deriving
--- See Note [FFoldType and functorLikeTraverse]
-data FFoldType a      -- Describes how to fold over a Type in a functor like way
-   = FT { ft_triv    :: a
-          -- ^ Does not contain variable
-        , ft_var     :: a
-          -- ^ The variable itself
-        , ft_co_var  :: a
-          -- ^ The variable itself, contravariantly
-        , ft_fun     :: a -> a -> a
-          -- ^ Function type
-        , ft_tup     :: TyCon -> [a] -> a
-          -- ^ Tuple type
-        , ft_ty_app  :: Type -> a -> a
-          -- ^ Type app, variable only in last argument
-        , ft_bad_app :: a
-          -- ^ Type app, variable other than in last argument
-        , ft_forall  :: TcTyVar -> a -> a
-          -- ^ Forall type
-     }
-
-functorLikeTraverse :: forall a.
-                       TyVar         -- ^ Variable to look for
-                    -> FFoldType a   -- ^ How to fold
-                    -> Type          -- ^ Type to process
-                    -> a
-functorLikeTraverse var (FT { ft_triv = caseTrivial,     ft_var = caseVar
-                            , ft_co_var = caseCoVar,     ft_fun = caseFun
-                            , ft_tup = caseTuple,        ft_ty_app = caseTyApp
-                            , ft_bad_app = caseWrongArg, ft_forall = caseForAll })
-                    ty
-  = fst (go False ty)
-  where
-    go :: Bool        -- Covariant or contravariant context
-       -> Type
-       -> (a, Bool)   -- (result of type a, does type contain var)
-
-    go co ty | Just ty' <- coreView ty = go co ty'
-    go co (TyVarTy    v) | v == var = (if co then caseCoVar else caseVar,True)
-    go co (FunTy x y)  | isPredTy x = go co y
-                       | xc || yc   = (caseFun xr yr,True)
-        where (xr,xc) = go (not co) x
-              (yr,yc) = go co       y
-    go co (AppTy    x y) | xc = (caseWrongArg,   True)
-                         | yc = (caseTyApp x yr, True)
-        where (_, xc) = go co x
-              (yr,yc) = go co y
-    go co ty@(TyConApp con args)
-       | not (or xcs)     = (caseTrivial, False)   -- Variable does not occur
-       -- At this point we know that xrs, xcs is not empty,
-       -- and at least one xr is True
-       | isTupleTyCon con = (caseTuple con xrs, True)
-       | or (init xcs)    = (caseWrongArg, True)         -- T (..var..)    ty
-       | Just (fun_ty, _) <- splitAppTy_maybe ty         -- T (..no var..) ty
-                          = (caseTyApp fun_ty (last xrs), True)
-       | otherwise        = (caseWrongArg, True)   -- Non-decomposable (eg type function)
+    pats_etc mk_bracket data_con
+      = ([con_pat], lift_Expr)
        where
-         -- When folding over an unboxed tuple, we must explicitly drop the
-         -- runtime rep arguments, or else GHC will generate twice as many
-         -- variables in a unboxed tuple pattern match and expression as it
-         -- actually needs. See Trac #12399
-         (xrs,xcs) = unzip (map (go co) (dropRuntimeRepArgs args))
-    go co (ForAllTy (TvBndr v vis) x)
-       | isVisibleArgFlag vis = panic "unexpected visible binder"
-       | v /= var && xc       = (caseForAll v xr,True)
-       where (xr,xc) = go co x
-
-    go _ _ = (caseTrivial,False)
-
--- Return all syntactic subterms of ty that contain var somewhere
--- These are the things that should appear in instance constraints
-deepSubtypesContaining :: TyVar -> Type -> [TcType]
-deepSubtypesContaining tv
-  = functorLikeTraverse tv
-        (FT { ft_triv = []
-            , ft_var = []
-            , ft_fun = (++)
-            , ft_tup = \_ xs -> concat xs
-            , ft_ty_app = (:)
-            , ft_bad_app = panic "in other argument"
-            , ft_co_var = panic "contravariant"
-            , ft_forall = \v xs -> filterOut ((v `elemVarSet`) . tyCoVarsOfType) xs })
-
-
-foldDataConArgs :: FFoldType a -> DataCon -> [a]
--- Fold over the arguments of the datacon
-foldDataConArgs ft con
-  = map foldArg (dataConOrigArgTys con)
-  where
-    foldArg
-      = case getTyVar_maybe (last (tyConAppArgs (dataConOrigResTy con))) of
-             Just tv -> functorLikeTraverse tv ft
-             Nothing -> const (ft_triv ft)
-    -- If we are deriving Foldable for a GADT, there is a chance that the last
-    -- type variable in the data type isn't actually a type variable at all.
-    -- (for example, this can happen if the last type variable is refined to
-    -- be a concrete type such as Int). If the last type variable is refined
-    -- to be a specific type, then getTyVar_maybe will return Nothing.
-    -- See Note [DeriveFoldable with ExistentialQuantification]
-    --
-    -- The kind checks have ensured the last type parameter is of kind *.
-
--- Make a HsLam using a fresh variable from a State monad
-mkSimpleLam :: (LHsExpr RdrName -> State [RdrName] (LHsExpr RdrName))
-            -> State [RdrName] (LHsExpr RdrName)
--- (mkSimpleLam fn) returns (\x. fn(x))
-mkSimpleLam lam = do
-    (n:names) <- get
-    put names
-    body <- lam (nlHsVar n)
-    return (mkHsLam [nlVarPat n] body)
-
-mkSimpleLam2 :: (LHsExpr RdrName -> LHsExpr RdrName
-             -> State [RdrName] (LHsExpr RdrName))
-             -> State [RdrName] (LHsExpr RdrName)
-mkSimpleLam2 lam = do
-    (n1:n2:names) <- get
-    put names
-    body <- lam (nlHsVar n1) (nlHsVar n2)
-    return (mkHsLam [nlVarPat n1,nlVarPat n2] body)
-
--- "Con a1 a2 a3 -> fold [x1 a1, x2 a2, x3 a3]"
---
--- @mkSimpleConMatch fold extra_pats con insides@ produces a match clause in
--- which the LHS pattern-matches on @extra_pats@, followed by a match on the
--- constructor @con@ and its arguments. The RHS folds (with @fold@) over @con@
--- and its arguments, applying an expression (from @insides@) to each of the
--- respective arguments of @con@.
-mkSimpleConMatch :: Monad m => HsMatchContext RdrName
-                 -> (RdrName -> [LHsExpr RdrName] -> m (LHsExpr RdrName))
-                 -> [LPat RdrName]
-                 -> DataCon
-                 -> [LHsExpr RdrName]
-                 -> m (LMatch RdrName (LHsExpr RdrName))
-mkSimpleConMatch ctxt fold extra_pats con insides = do
-    let con_name = getRdrName con
-    let vars_needed = takeList insides as_RDRs
-    let pat = nlConVarPat con_name vars_needed
-    rhs <- fold con_name (zipWith nlHsApp insides (map nlHsVar vars_needed))
-    return $ mkMatch ctxt (extra_pats ++ [pat]) rhs
-                     (noLoc emptyLocalBinds)
-
--- "Con a1 a2 a3 -> fmap (\b2 -> Con a1 b2 a3) (traverse f a2)"
---
--- @mkSimpleConMatch2 fold extra_pats con insides@ behaves very similarly to
--- 'mkSimpleConMatch', with two key differences:
---
--- 1. @insides@ is a @[Maybe (LHsExpr RdrName)]@ instead of a
---    @[LHsExpr RdrName]@. This is because it filters out the expressions
---    corresponding to arguments whose types do not mention the last type
---    variable in a derived 'Foldable' or 'Traversable' instance (i.e., the
---    'Nothing' elements of @insides@).
---
--- 2. @fold@ takes an expression as its first argument instead of a
---    constructor name. This is because it uses a specialized
---    constructor function expression that only takes as many parameters as
---    there are argument types that mention the last type variable.
---
--- See Note [Generated code for DeriveFoldable and DeriveTraversable]
-mkSimpleConMatch2 :: Monad m
-                  => HsMatchContext RdrName
-                  -> (LHsExpr RdrName -> [LHsExpr RdrName]
-                                      -> m (LHsExpr RdrName))
-                  -> [LPat RdrName]
-                  -> DataCon
-                  -> [Maybe (LHsExpr RdrName)]
-                  -> m (LMatch RdrName (LHsExpr RdrName))
-mkSimpleConMatch2 ctxt fold extra_pats con insides = do
-    let con_name = getRdrName con
-        vars_needed = takeList insides as_RDRs
-        pat = nlConVarPat con_name vars_needed
-        -- Make sure to zip BEFORE invoking catMaybes. We want the variable
-        -- indicies in each expression to match up with the argument indices
-        -- in con_expr (defined below).
-        exps = catMaybes $ zipWith (\i v -> (`nlHsApp` v) <$> i)
-                                   insides (map nlHsVar vars_needed)
-        -- An element of argTysTyVarInfo is True if the constructor argument
-        -- with the same index has a type which mentions the last type
-        -- variable.
-        argTysTyVarInfo = map isJust insides
-        (asWithTyVar, asWithoutTyVar) = partitionByList argTysTyVarInfo as_RDRs
-
-        con_expr
-          | null asWithTyVar = nlHsApps con_name $ map nlHsVar asWithoutTyVar
-          | otherwise =
-              let bs   = filterByList  argTysTyVarInfo bs_RDRs
-                  vars = filterByLists argTysTyVarInfo
-                                       (map nlHsVar bs_RDRs)
-                                       (map nlHsVar as_RDRs)
-              in mkHsLam (map nlVarPat bs) (nlHsApps con_name vars)
-
-    rhs <- fold con_expr exps
-    return $ mkMatch ctxt (extra_pats ++ [pat]) rhs
-                     (noLoc emptyLocalBinds)
-
--- "case x of (a1,a2,a3) -> fold [x1 a1, x2 a2, x3 a3]"
-mkSimpleTupleCase :: Monad m => ([LPat RdrName] -> DataCon -> [a]
-                                 -> m (LMatch RdrName (LHsExpr RdrName)))
-                  -> TyCon -> [a] -> LHsExpr RdrName -> m (LHsExpr RdrName)
-mkSimpleTupleCase match_for_con tc insides x
-  = do { let data_con = tyConSingleDataCon tc
-       ; match <- match_for_con [] data_con insides
-       ; return $ nlHsCase x [match] }
+            con_pat      = nlConVarPat data_con_RDR as_needed
+            data_con_RDR = getRdrName data_con
+            con_arity    = dataConSourceArity data_con
+            as_needed    = take con_arity as_RDRs
+            lift_Expr    = noLoc (HsBracket NoExt (mk_bracket br_body))
+            br_body      = nlHsApps (Exact (dataConName data_con))
+                                    (map nlHsVar as_needed)
 
 {-
 ************************************************************************
 *                                                                      *
-                        Foldable instances
-
- see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html
-
+                     Newtype-deriving instances
 *                                                                      *
 ************************************************************************
 
-Deriving Foldable instances works the same way as Functor instances,
-only Foldable instances are not possible for function types at all.
-Given (data T a = T a a (T a) deriving Foldable), we get:
-
-  instance Foldable T where
-      foldr f z (T x1 x2 x3) =
-        $(foldr 'a 'a) x1 ( $(foldr 'a 'a) x2 ( $(foldr 'a '(T a)) x3 z ) )
-
--XDeriveFoldable is different from -XDeriveFunctor in that it filters out
-arguments to the constructor that would produce useless code in a Foldable
-instance. For example, the following datatype:
-
-  data Foo a = Foo Int a Int deriving Foldable
-
-would have the following generated Foldable instance:
+Note [Newtype-deriving instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We take every method in the original instance and `coerce` it to fit
+into the derived instance. We need type applications on the argument
+to `coerce` to make it obvious what instantiation of the method we're
+coercing from.  So from, say,
 
-  instance Foldable Foo where
-    foldr f z (Foo x1 x2 x3) = $(foldr 'a 'a) x2
+  class C a b where
+    op :: forall c. a -> [b] -> c -> Int
 
-since neither of the two Int arguments are folded over.
+  newtype T x = MkT <rep-ty>
 
-The cases are:
+  instance C a <rep-ty> => C a (T x) where
+    op = coerce @ (a -> [<rep-ty>] -> c -> Int)
+                @ (a -> [T x]      -> c -> Int)
+                op :: forall c. a -> [T x] -> c -> Int
 
-  $(foldr 'a 'a)         =  f
-  $(foldr 'a '(b1,b2))   =  \x z -> case x of (x1,x2) -> $(foldr 'a 'b1) x1 ( $(foldr 'a 'b2) x2 z )
-  $(foldr 'a '(T b1 b2)) =  \x z -> foldr $(foldr 'a 'b2) z x  -- when a only occurs in the last parameter, b2
+In addition to the type applications, we also have an explicit
+type signature on the entire RHS. This brings the method-bound variable
+`c` into scope over the two type applications.
+See Note [GND and QuantifiedConstraints] for more information on why this
+is important.
 
-Note that the arguments to the real foldr function are the wrong way around,
-since (f :: a -> b -> b), while (foldr f :: b -> t a -> b).
+Giving 'coerce' two explicitly-visible type arguments grants us finer control
+over how it should be instantiated. Recall
 
-One can envision a case for types that don't contain the last type variable:
+  coerce :: Coercible a b => a -> b
 
-  $(foldr 'a 'b)         =  \x z -> z     -- when b does not contain a
+By giving it explicit type arguments we deal with the case where
+'op' has a higher rank type, and so we must instantiate 'coerce' with
+a polytype.  E.g.
 
-But this case will never materialize, since the aforementioned filtering
-removes all such types from consideration.
-See Note [Generated code for DeriveFoldable and DeriveTraversable].
+   class C a where op :: a -> forall b. b -> b
+   newtype T x = MkT <rep-ty>
+   instance C <rep-ty> => C (T x) where
+     op = coerce @ (<rep-ty> -> forall b. b -> b)
+                 @ (T x      -> forall b. b -> b)
+                op :: T x -> forall b. b -> b
 
-Foldable instances differ from Functor and Traversable instances in that
-Foldable instances can be derived for data types in which the last type
-variable is existentially quantified. In particular, if the last type variable
-is refined to a more specific type in a GADT:
+The use of type applications is crucial here. If we had tried using only
+explicit type signatures, like so:
 
-  data GADT a where
-      G :: a ~ Int => a -> G Int
+   instance C <rep-ty> => C (T x) where
+     op = coerce (op :: <rep-ty> -> forall b. b -> b)
+                     :: T x      -> forall b. b -> b
 
-then the deriving machinery does not attempt to check that the type a contains
-Int, since it is not syntactically equal to a type variable. That is, the
-derived Foldable instance for GADT is:
+Then GHC will attempt to deeply skolemize the two type signatures, which will
+wreak havoc with the Coercible solver. Therefore, we instead use type
+applications, which do not deeply skolemize and thus avoid this issue.
+The downside is that we currently require -XImpredicativeTypes to permit this
+polymorphic type instantiation, so we have to switch that flag on locally in
+TcDeriv.genInst. See #8503 for more discussion.
 
-  instance Foldable GADT where
-      foldr _ z (GADT _) = z
+Note [Newtype-deriving trickiness]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider (#12768):
+  class C a where { op :: D a => a -> a }
 
-See Note [DeriveFoldable with ExistentialQuantification].
+  instance C a  => C [a] where { op = opList }
 
--}
+  opList :: (C a, D [a]) => [a] -> [a]
+  opList = ...
 
-gen_Foldable_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
-gen_Foldable_binds loc tycon
-  = (listToBag [foldr_bind, foldMap_bind], emptyBag)
-  where
-    data_cons = tyConDataCons tycon
+Now suppose we try GND on this:
+  newtype N a = MkN [a] deriving( C )
 
-    foldr_bind = mkRdrFunBind (L loc foldable_foldr_RDR) eqns
-    eqns = map foldr_eqn data_cons
-    foldr_eqn con
-      = evalState (match_foldr z_Expr [f_Pat,z_Pat] con =<< parts) bs_RDRs
-      where
-        parts = sequence $ foldDataConArgs ft_foldr con
+The GND is expecting to get an implementation of op for N by
+coercing opList, thus:
 
-    foldMap_bind = mkRdrFunBind (L loc foldMap_RDR) (map foldMap_eqn data_cons)
-    foldMap_eqn con
-      = evalState (match_foldMap [f_Pat] con =<< parts) bs_RDRs
-      where
-        parts = sequence $ foldDataConArgs ft_foldMap con
-
-    -- Yields 'Just' an expression if we're folding over a type that mentions
-    -- the last type parameter of the datatype. Otherwise, yields 'Nothing'.
-    -- See Note [FFoldType and functorLikeTraverse]
-    ft_foldr :: FFoldType (State [RdrName] (Maybe (LHsExpr RdrName)))
-    ft_foldr
-      = FT { ft_triv    = return Nothing
-             -- foldr f = \x z -> z
-           , ft_var     = return $ Just f_Expr
-             -- foldr f = f
-           , ft_tup     = \t g -> do
-               gg  <- sequence g
-               lam <- mkSimpleLam2 $ \x z ->
-                 mkSimpleTupleCase (match_foldr z) t gg x
-               return (Just lam)
-             -- foldr f = (\x z -> case x of ...)
-           , ft_ty_app  = \_ g -> do
-               gg <- g
-               mapM (\gg' -> mkSimpleLam2 $ \x z -> return $
-                 nlHsApps foldable_foldr_RDR [gg',z,x]) gg
-             -- foldr f = (\x z -> foldr g z x)
-           , ft_forall  = \_ g -> g
-           , ft_co_var  = panic "contravariant"
-           , ft_fun     = panic "function"
-           , ft_bad_app = panic "in other argument" }
-
-    match_foldr :: LHsExpr RdrName
-                -> [LPat RdrName]
-                -> DataCon
-                -> [Maybe (LHsExpr RdrName)]
-                -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
-    match_foldr z = mkSimpleConMatch2 LambdaExpr $ \_ xs -> return (mkFoldr xs)
-      where
-        -- g1 v1 (g2 v2 (.. z))
-        mkFoldr :: [LHsExpr RdrName] -> LHsExpr RdrName
-        mkFoldr = foldr nlHsApp z
-
-    -- See Note [FFoldType and functorLikeTraverse]
-    ft_foldMap :: FFoldType (State [RdrName] (Maybe (LHsExpr RdrName)))
-    ft_foldMap
-      = FT { ft_triv = return Nothing
-             -- foldMap f = \x -> mempty
-           , ft_var  = return (Just f_Expr)
-             -- foldMap f = f
-           , ft_tup  = \t g -> do
-               gg  <- sequence g
-               lam <- mkSimpleLam $ mkSimpleTupleCase match_foldMap t gg
-               return (Just lam)
-             -- foldMap f = \x -> case x of (..,)
-           , ft_ty_app = \_ g -> fmap (nlHsApp foldMap_Expr) <$> g
-             -- foldMap f = foldMap g
-           , ft_forall = \_ g -> g
-           , ft_co_var = panic "contravariant"
-           , ft_fun = panic "function"
-           , ft_bad_app = panic "in other argument" }
-
-    match_foldMap :: [LPat RdrName]
-                  -> DataCon
-                  -> [Maybe (LHsExpr RdrName)]
-                  -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
-    match_foldMap = mkSimpleConMatch2 CaseAlt $ \_ xs -> return (mkFoldMap xs)
-      where
-        -- mappend v1 (mappend v2 ..)
-        mkFoldMap :: [LHsExpr RdrName] -> LHsExpr RdrName
-        mkFoldMap [] = mempty_Expr
-        mkFoldMap xs = foldr1 (\x y -> nlHsApps mappend_RDR [x,y]) xs
+  instance C a => C (N a) where { op = opN }
 
-{-
-************************************************************************
-*                                                                      *
-                        Traversable instances
+  opN :: (C a, D (N a)) => N a -> N a
+  opN = coerce @([a]   -> [a])
+               @([N a] -> [N a]
+               opList :: D (N a) => [N a] -> [N a]
 
- see http://www.mail-archive.com/haskell-prime@haskell.org/msg02116.html
-*                                                                      *
-************************************************************************
+But there is no reason to suppose that (D [a]) and (D (N a))
+are inter-coercible; these instances might completely different.
+So GHC rightly rejects this code.
 
-Again, Traversable is much like Functor and Foldable.
+Note [GND and QuantifiedConstraints]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider the following example from #15290:
 
-The cases are:
+  class C m where
+    join :: m (m a) -> m a
 
-  $(traverse 'a 'a)          =  f
-  $(traverse 'a '(b1,b2))    =  \x -> case x of (x1,x2) -> (,) <$> $(traverse 'a 'b1) x1 <*> $(traverse 'a 'b2) x2
-  $(traverse 'a '(T b1 b2))  =  traverse $(traverse 'a 'b2)  -- when a only occurs in the last parameter, b2
+  newtype T m a = MkT (m a)
 
-Like -XDeriveFoldable, -XDeriveTraversable filters out arguments whose types
-do not mention the last type parameter. Therefore, the following datatype:
+  deriving instance
+    (C m, forall p q. Coercible p q => Coercible (m p) (m q)) =>
+    C (T m)
 
-  data Foo a = Foo Int a Int
+The code that GHC used to generate for this was:
 
-would have the following derived Traversable instance:
+  instance (C m, forall p q. Coercible p q => Coercible (m p) (m q)) =>
+      C (T m) where
+    join = coerce @(forall a.   m   (m a) ->   m a)
+                  @(forall a. T m (T m a) -> T m a)
+                  join
 
-  instance Traversable Foo where
-    traverse f (Foo x1 x2 x3) =
-      fmap (\b2 -> Foo x1 b2 x3) ( $(traverse 'a 'a) x2 )
+This instantiates `coerce` at a polymorphic type, a form of impredicative
+polymorphism, so we're already on thin ice. And in fact the ice breaks,
+as we'll explain:
 
-since the two Int arguments do not produce any effects in a traversal.
+The call to `coerce` gives rise to:
 
-One can envision a case for types that do not mention the last type parameter:
+  Coercible (forall a.   m   (m a) ->   m a)
+            (forall a. T m (T m a) -> T m a)
 
-  $(traverse 'a 'b)          =  pure     -- when b does not contain a
+And that simplified to the following implication constraint:
 
-But this case will never materialize, since the aforementioned filtering
-removes all such types from consideration.
-See Note [Generated code for DeriveFoldable and DeriveTraversable].
--}
+  forall a <no-ev>. m (T m a) ~R# m (m a)
 
-gen_Traversable_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
-gen_Traversable_binds loc tycon
-  = (unitBag traverse_bind, emptyBag)
-  where
-    data_cons = tyConDataCons tycon
+But because this constraint is under a `forall`, inside a type, we have to
+prove it *without computing any term evidence* (hence the <no-ev>). Alas, we
+*must* generate a term-level evidence binding in order to instantiate the
+quantified constraint! In response, GHC currently chooses not to use such
+a quantified constraint.
+See Note [Instances in no-evidence implications] in TcInteract.
 
-    traverse_bind = mkRdrFunBind (L loc traverse_RDR) eqns
-    eqns = map traverse_eqn data_cons
-    traverse_eqn con
-      = evalState (match_for_con [f_Pat] con =<< parts) bs_RDRs
-      where
-        parts = sequence $ foldDataConArgs ft_trav con
-
-    -- Yields 'Just' an expression if we're folding over a type that mentions
-    -- the last type parameter of the datatype. Otherwise, yields 'Nothing'.
-    -- See Note [FFoldType and functorLikeTraverse]
-    ft_trav :: FFoldType (State [RdrName] (Maybe (LHsExpr RdrName)))
-    ft_trav
-      = FT { ft_triv    = return Nothing
-             -- traverse f = pure x
-           , ft_var     = return (Just f_Expr)
-             -- traverse f = f x
-           , ft_tup     = \t gs -> do
-               gg  <- sequence gs
-               lam <- mkSimpleLam $ mkSimpleTupleCase match_for_con t gg
-               return (Just lam)
-             -- traverse f = \x -> case x of (a1,a2,..) ->
-             --                           (,,) <$> g1 a1 <*> g2 a2 <*> ..
-           , ft_ty_app  = \_ g -> fmap (nlHsApp traverse_Expr) <$> g
-             -- traverse f = traverse g
-           , ft_forall  = \_ g -> g
-           , ft_co_var  = panic "contravariant"
-           , ft_fun     = panic "function"
-           , ft_bad_app = panic "in other argument" }
-
-    -- Con a1 a2 ... -> fmap (\b1 b2 ... -> Con b1 b2 ...) (g1 a1)
-    --                    <*> g2 a2 <*> ...
-    match_for_con :: [LPat RdrName]
-                  -> DataCon
-                  -> [Maybe (LHsExpr RdrName)]
-                  -> State [RdrName] (LMatch RdrName (LHsExpr RdrName))
-    match_for_con = mkSimpleConMatch2 CaseAlt $
-                                             \con xs -> return (mkApCon con xs)
-      where
-        -- fmap (\b1 b2 ... -> Con b1 b2 ...) x1 <*> x2 <*> ..
-        mkApCon :: LHsExpr RdrName -> [LHsExpr RdrName] -> LHsExpr RdrName
-        mkApCon con [] = nlHsApps pure_RDR [con]
-        mkApCon con (x:xs) = foldl appAp (nlHsApps fmap_RDR [con,x]) xs
-          where appAp x y = nlHsApps ap_RDR [x,y]
+But this isn't the death knell for combining QuantifiedConstraints with GND.
+On the contrary, if we generate GND bindings in a slightly different way, then
+we can avoid this situation altogether. Instead of applying `coerce` to two
+polymorphic types, we instead let an explicit type signature do the polymorphic
+instantiation, and omit the `forall`s in the type applications.
+More concretely, we generate the following code instead:
 
-{-
-************************************************************************
-*                                                                      *
-                        Lift instances
-*                                                                      *
-************************************************************************
+  instance (C m, forall p q. Coercible p q => Coercible (m p) (m q)) =>
+      C (T m) where
+    join = coerce @(  m   (m a) ->   m a)
+                  @(T m (T m a) -> T m a)
+                  join :: forall a. T m (T m a) -> T m a
 
-Example:
+Now the visible type arguments are both monotypes, so we need do any of this
+funny quantified constraint instantiation business.
 
-    data Foo a = Foo a | a :^: a deriving Lift
+You might think that that second @(T m (T m a) -> T m a) argument is redundant
+in the presence of the explicit `:: forall a. T m (T m a) -> T m a` type
+signature, but in fact leaving it off will break this example (from the
+T15290d test case):
 
-    ==>
+  class C a where
+    c :: Int -> forall b. b -> a
 
-    instance (Lift a) => Lift (Foo a) where
-        lift (Foo a)
-          = appE
-              (conE
-                (mkNameG_d "package-name" "ModuleName" "Foo"))
-              (lift a)
-        lift (u :^: v)
-          = infixApp
-              (lift u)
-              (conE
-                (mkNameG_d "package-name" "ModuleName" ":^:"))
-              (lift v)
-
-Note that (mkNameG_d "package-name" "ModuleName" "Foo") is equivalent to what
-'Foo would be when using the -XTemplateHaskell extension. To make sure that
--XDeriveLift can be used on stage-1 compilers, however, we expliticly invoke
-makeG_d.
--}
+  instance C Int
 
-gen_Lift_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
-gen_Lift_binds loc tycon
-  | null data_cons = (unitBag (L loc $ mkFunBind (L loc lift_RDR)
-                       [mkMatch (FunRhs (L loc lift_RDR) Prefix)
-                                        [nlWildPat] errorMsg_Expr
-                                        (noLoc emptyLocalBinds)])
-                     , emptyBag)
-  | otherwise = (unitBag lift_bind, emptyBag)
-  where
-    errorMsg_Expr = nlHsVar error_RDR `nlHsApp` nlHsLit
-        (mkHsString $ "Can't lift value of empty datatype " ++ tycon_str)
+  instance C Age where
+    c = coerce @(Int -> forall b. b -> Int)
+               c :: Int -> forall b. b -> Age
 
-    lift_bind = mk_FunBind loc lift_RDR (map pats_etc data_cons)
-    data_cons = tyConDataCons tycon
-    tycon_str = occNameString . nameOccName . tyConName $ tycon
+That is because the explicit type signature deeply skolemizes the forall-bound
+`b`, which wreaks havoc with the `Coercible` solver. An additional visible type
+argument of @(Int -> forall b. b -> Age) is enough to prevent this.
 
-    pats_etc data_con
-      = ([con_pat], lift_Expr)
-       where
-            con_pat      = nlConVarPat data_con_RDR as_needed
-            data_con_RDR = getRdrName data_con
-            con_arity    = dataConSourceArity data_con
-            as_needed    = take con_arity as_RDRs
-            lifted_as    = zipWithEqual "mk_lift_app" mk_lift_app
-                             tys_needed as_needed
-            tycon_name   = tyConName tycon
-            is_infix     = dataConIsInfix data_con
-            tys_needed   = dataConOrigArgTys data_con
-
-            mk_lift_app ty a
-              | not (isUnliftedType ty) = nlHsApp (nlHsVar lift_RDR)
-                                                  (nlHsVar a)
-              | otherwise = nlHsApp (nlHsVar litE_RDR)
-                              (primLitOp (mkBoxExp (nlHsVar a)))
-              where (primLitOp, mkBoxExp) = primLitOps "Lift" tycon ty
-
-            pkg_name = unitIdString . moduleUnitId
-                     . nameModule $ tycon_name
-            mod_name = moduleNameString . moduleName . nameModule $ tycon_name
-            con_name = occNameString . nameOccName . dataConName $ data_con
-
-            conE_Expr = nlHsApp (nlHsVar conE_RDR)
-                                (nlHsApps mkNameG_dRDR
-                                  (map (nlHsLit . mkHsString)
-                                    [pkg_name, mod_name, con_name]))
-
-            lift_Expr
-              | is_infix  = nlHsApps infixApp_RDR [a1, conE_Expr, a2]
-              | otherwise = foldl mk_appE_app conE_Expr lifted_as
-            (a1:a2:_) = lifted_as
-
-mk_appE_app :: LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName
-mk_appE_app a b = nlHsApps appE_RDR [a, b]
+Be aware that the use of an explicit type signature doesn't /solve/ this
+problem; it just makes it less likely to occur. For example, if a class has
+a truly higher-rank type like so:
 
-{-
-************************************************************************
-*                                                                      *
-                     Newtype-deriving instances
-*                                                                      *
-************************************************************************
+  class CProblem m where
+    op :: (forall b. ... (m b) ...) -> Int
 
-Note [Newtype-deriving instances]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We take every method in the original instance and `coerce` it to fit
-into the derived instance. We need a type annotation on the argument
-to `coerce` to make it obvious what instantiation of the method we're
-coercing from.  So from, say,
-  class C a b where
-    op :: a -> [b] -> Int
+Then the same situation will arise again. But at least it won't arise for the
+common case of methods with ordinary, prenex-quantified types.
 
-  newtype T x = MkT <rep-ty>
+Note [GND and ambiguity]
+~~~~~~~~~~~~~~~~~~~~~~~~
+We make an effort to make the code generated through GND be robust w.r.t.
+ambiguous type variables. As one example, consider the following example
+(from #15637):
 
-  instance C a <rep-ty> => C a (T x) where
-    op = coerce @ (a -> [<rep-ty>] -> Int)
-                @ (a -> [T x]      -> Int)
-                op
+  class C a where f :: String
+  instance C () where f = "foo"
+  newtype T = T () deriving C
 
-Notice that we give the 'coerce' two explicitly-visible type arguments
-to say how it should be instantiated.  Recall
+A naïve attempt and generating a C T instance would be:
 
-  coerce :: Coeercible a b => a -> b
+  instance C T where
+    f = coerce @String @String f
+          :: String
 
-By giving it explicit type arguments we deal with the case where
-'op' has a higher rank type, and so we must instantiae 'coerce' with
-a polytype.  E.g.
-   class C a where op :: forall b. a -> b -> b
-   newtype T x = MkT <rep-ty>
-   instance C <rep-ty> => C (T x) where
-     op = coerce @ (forall b. <rep-ty> -> b -> b)
-                 @ (forall b. T x -> b -> b)
-                op
+This isn't going to typecheck, however, since GHC doesn't know what to
+instantiate the type variable `a` with in the call to `f` in the method body.
+(Note that `f :: forall a. String`!) To compensate for the possibility of
+ambiguity here, we explicitly instantiate `a` like so:
 
-The type checker checks this code, and it currently requires
--XImpredicativeTypes to permit that polymorphic type instantiation,
-so ew have to switch that flag on locally in TcDeriv.genInst.
+  instance C T where
+    f = coerce @String @String (f @())
+          :: String
 
-See #8503 for more discussion.
+All better now.
 -}
 
 gen_Newtype_binds :: SrcSpan
                   -> Class   -- the class being derived
-                  -> [TyVar] -- the tvs in the instance head
+                  -> [TyVar] -- the tvs in the instance head (this includes
+                             -- the tvs from both the class types and the
+                             -- newtype itself)
                   -> [Type]  -- instance head parameters (incl. newtype)
-                  -> Type    -- the representation type (already eta-reduced)
-                  -> LHsBinds RdrName
+                  -> Type    -- the representation type
+                  -> TcM (LHsBinds GhcPs, BagDerivStuff)
 -- See Note [Newtype-deriving instances]
-gen_Newtype_binds loc cls inst_tvs cls_tys rhs_ty
-  = listToBag $ map mk_bind (classMethods cls)
+gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty
+  = do let ats = classATs cls
+       atf_insts <- ASSERT( all (not . isDataFamilyTyCon) ats )
+                    mapM mk_atf_inst ats
+       return ( listToBag $ map mk_bind (classMethods cls)
+              , listToBag $ map DerivFamInst atf_insts )
   where
-    coerce_RDR = getRdrName coerceId
-
-    mk_bind :: Id -> LHsBind RdrName
+    mk_bind :: Id -> LHsBind GhcPs
     mk_bind meth_id
       = mkRdrFunBind (L loc meth_RDR) [mkSimpleMatch
-                                         (FunRhs (L loc meth_RDR) Prefix)
-                                         [] rhs_expr]
+                                          (mkPrefixFunRhs (L loc meth_RDR))
+                                          [] rhs_expr]
       where
-        Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty meth_id
+        Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty meth_id
+        (_, _, from_tau) = tcSplitSigmaTy from_ty
+        (_, _, to_tau)   = tcSplitSigmaTy to_ty
 
         meth_RDR = getRdrName meth_id
 
-        rhs_expr = nlHsVar coerce_RDR `nlHsAppType` from_ty
-                                      `nlHsAppType` to_ty
-                                      `nlHsApp`     nlHsVar meth_RDR
-
-nlHsAppType :: LHsExpr RdrName -> Type -> LHsExpr RdrName
-nlHsAppType e s = noLoc (e `HsAppType` hs_ty)
+        rhs_expr = nlHsVar (getRdrName coerceId)
+                                      `nlHsAppType`     from_tau
+                                      `nlHsAppType`     to_tau
+                                      `nlHsApp`         meth_app
+                                      `nlExprWithTySig` to_ty
+
+        -- The class method, applied to all of the class instance types
+        -- (including the representation type) to avoid potential ambiguity.
+        -- See Note [GND and ambiguity]
+        meth_app = foldl' nlHsAppType (nlHsVar meth_RDR) $
+                   filterOutInferredTypes (classTyCon cls) underlying_inst_tys
+                     -- Filter out any inferred arguments, since they can't be
+                     -- applied with visible type application.
+
+    mk_atf_inst :: TyCon -> TcM FamInst
+    mk_atf_inst fam_tc = do
+        rep_tc_name <- newFamInstTyConName (L loc (tyConName fam_tc))
+                                           rep_lhs_tys
+        let axiom = mkSingleCoAxiom Nominal rep_tc_name rep_tvs' [] rep_cvs'
+                                    fam_tc rep_lhs_tys rep_rhs_ty
+        -- Check (c) from Note [GND and associated type families] in TcDeriv
+        checkValidCoAxBranch fam_tc (coAxiomSingleBranch axiom)
+        newFamInst SynFamilyInst axiom
+      where
+        cls_tvs     = classTyVars cls
+        in_scope    = mkInScopeSet $ mkVarSet inst_tvs
+        lhs_env     = zipTyEnv cls_tvs inst_tys
+        lhs_subst   = mkTvSubst in_scope lhs_env
+        rhs_env     = zipTyEnv cls_tvs underlying_inst_tys
+        rhs_subst   = mkTvSubst in_scope rhs_env
+        fam_tvs     = tyConTyVars fam_tc
+        rep_lhs_tys = substTyVars lhs_subst fam_tvs
+        rep_rhs_tys = substTyVars rhs_subst fam_tvs
+        rep_rhs_ty  = mkTyConApp fam_tc rep_rhs_tys
+        rep_tcvs    = tyCoVarsOfTypesList rep_lhs_tys
+        (rep_tvs, rep_cvs) = partition isTyVar rep_tcvs
+        rep_tvs'    = scopedSort rep_tvs
+        rep_cvs'    = scopedSort rep_cvs
+
+    -- Same as inst_tys, but with the last argument type replaced by the
+    -- representation type.
+    underlying_inst_tys :: [Type]
+    underlying_inst_tys = changeLast inst_tys rhs_ty
+
+nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
+nlHsAppType e s = noLoc (HsAppType noExt e hs_ty)
   where
-    hs_ty = mkHsWildCardBndrs (typeToLHsType s)
+    hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec (typeToLHsType s)
 
-nlExprWithTySig :: LHsExpr RdrName -> Type -> LHsExpr RdrName
-nlExprWithTySig e s = noLoc (e `ExprWithTySig` hs_ty)
+nlExprWithTySig :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
+nlExprWithTySig e s = noLoc $ ExprWithTySig noExt (parenthesizeHsExpr sigPrec e) hs_ty
   where
     hs_ty = mkLHsSigWcType (typeToLHsType s)
 
 mkCoerceClassMethEqn :: Class   -- the class being derived
-                     -> [TyVar] -- the tvs in the instance head
+                     -> [TyVar] -- the tvs in the instance head (this includes
+                                -- the tvs from both the class types and the
+                                -- newtype itself)
                      -> [Type]  -- instance head parameters (incl. newtype)
-                     -> Type    -- the representation type (already eta-reduced)
+                     -> Type    -- the representation type
                      -> Id      -- the method to look at
                      -> Pair Type
 -- See Note [Newtype-deriving instances]
+-- See also Note [Newtype-deriving trickiness]
 -- The pair is the (from_type, to_type), where to_type is
--- the type of the method we are tyrying to get
-mkCoerceClassMethEqn cls inst_tvs cls_tys rhs_ty id
+-- the type of the method we are trying to get
+mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty id
   = Pair (substTy rhs_subst user_meth_ty)
          (substTy lhs_subst user_meth_ty)
   where
     cls_tvs = classTyVars cls
     in_scope = mkInScopeSet $ mkVarSet inst_tvs
-    lhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs cls_tys)
-    rhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs (changeLast cls_tys rhs_ty))
+    lhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs inst_tys)
+    rhs_subst = mkTvSubst in_scope (zipTyEnv cls_tvs (changeLast inst_tys rhs_ty))
     (_class_tvs, _class_constraint, user_meth_ty)
       = tcSplitMethodTy (varType id)
 
-    changeLast :: [a] -> a -> [a]
-    changeLast []     _  = panic "changeLast"
-    changeLast [_]    x  = [x]
-    changeLast (x:xs) x' = x : changeLast xs x'
-
 {-
 ************************************************************************
 *                                                                      *
@@ -2324,16 +1912,17 @@ The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
 fiddling around.
 -}
 
-genAuxBindSpec :: SrcSpan -> AuxBindSpec -> (LHsBind RdrName, LSig RdrName)
-genAuxBindSpec loc (DerivCon2Tag tycon)
-  = (mk_FunBind loc rdr_name eqns,
-     L loc (TypeSig [L loc rdr_name] sig_ty))
+genAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec
+                  -> (LHsBind GhcPs, LSig GhcPs)
+genAuxBindSpec dflags loc (DerivCon2Tag tycon)
+  = (mkFunBindSE 0 loc rdr_name eqns,
+     L loc (TypeSig noExt [L loc rdr_name] sig_ty))
   where
-    rdr_name = con2tag_RDR tycon
+    rdr_name = con2tag_RDR dflags tycon
 
-    sig_ty = mkLHsSigWcType $ L loc $ HsCoreTy $
+    sig_ty = mkLHsSigWcType $ L loc $ XHsType $ NHsCoreTy $
              mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $
-             mkParentType tycon `mkFunTy` intPrimTy
+             mkParentType tycon `mkVisFunTy` intPrimTy
 
     lots_of_constructors = tyConFamilySize tycon > 8
                         -- was: mAX_FAMILY_SIZE_FOR_VEC_RETURNS
@@ -2344,41 +1933,42 @@ genAuxBindSpec loc (DerivCon2Tag tycon)
 
     get_tag_eqn = ([nlVarPat a_RDR], nlHsApp (nlHsVar getTag_RDR) a_Expr)
 
-    mk_eqn :: DataCon -> ([LPat RdrName], LHsExpr RdrName)
+    mk_eqn :: DataCon -> ([LPat GhcPs], LHsExpr GhcPs)
     mk_eqn con = ([nlWildConPat con],
-                  nlHsLit (HsIntPrim ""
+                  nlHsLit (HsIntPrim NoSourceText
                                     (toInteger ((dataConTag con) - fIRST_TAG))))
 
-genAuxBindSpec loc (DerivTag2Con tycon)
-  = (mk_FunBind loc rdr_name
+genAuxBindSpec dflags loc (DerivTag2Con tycon)
+  = (mkFunBindSE 0 loc rdr_name
         [([nlConVarPat intDataCon_RDR [a_RDR]],
            nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)],
-     L loc (TypeSig [L loc rdr_name] sig_ty))
+     L loc (TypeSig noExt [L loc rdr_name] sig_ty))
   where
     sig_ty = mkLHsSigWcType $ L loc $
-             HsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $
-             intTy `mkFunTy` mkParentType tycon
+             XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $
+             intTy `mkVisFunTy` mkParentType tycon
 
-    rdr_name = tag2con_RDR tycon
+    rdr_name = tag2con_RDR dflags tycon
 
-genAuxBindSpec loc (DerivMaxTag tycon)
+genAuxBindSpec dflags loc (DerivMaxTag tycon)
   = (mkHsVarBind loc rdr_name rhs,
-     L loc (TypeSig [L loc rdr_name] sig_ty))
+     L loc (TypeSig noExt [L loc rdr_name] sig_ty))
   where
-    rdr_name = maxtag_RDR tycon
-    sig_ty = mkLHsSigWcType (L loc (HsCoreTy intTy))
-    rhs = nlHsApp (nlHsVar intDataCon_RDR) (nlHsLit (HsIntPrim "" max_tag))
+    rdr_name = maxtag_RDR dflags tycon
+    sig_ty = mkLHsSigWcType (L loc (XHsType (NHsCoreTy intTy)))
+    rhs = nlHsApp (nlHsVar intDataCon_RDR)
+                  (nlHsLit (HsIntPrim NoSourceText max_tag))
     max_tag =  case (tyConDataCons tycon) of
                  data_cons -> toInteger ((length data_cons) - fIRST_TAG)
 
 type SeparateBagsDerivStuff =
   -- AuxBinds and SYB bindings
-  ( Bag (LHsBind RdrName, LSig RdrName)
+  ( Bag (LHsBind GhcPs, LSig GhcPs)
   -- Extra family instances (used by Generic and DeriveAnyClass)
   , Bag (FamInst) )
 
-genAuxBinds :: SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff
-genAuxBinds loc b = genAuxBinds' b2 where
+genAuxBinds :: DynFlags -> SrcSpan -> BagDerivStuff -> SeparateBagsDerivStuff
+genAuxBinds dflags loc b = genAuxBinds' b2 where
   (b1,b2) = partitionBagWith splitDerivAuxBind b
   splitDerivAuxBind (DerivAuxBind x) = Left x
   splitDerivAuxBind  x               = Right x
@@ -2387,7 +1977,7 @@ genAuxBinds loc b = genAuxBinds' b2 where
   dup_check a b = if anyBag (== a) b then b else consBag a b
 
   genAuxBinds' :: BagDerivStuff -> SeparateBagsDerivStuff
-  genAuxBinds' = foldrBag f ( mapBag (genAuxBindSpec loc) (rm_dups b1)
+  genAuxBinds' = foldrBag f ( mapBag (genAuxBindSpec dflags loc) (rm_dups b1)
                             , emptyBag )
   f :: DerivStuff -> SeparateBagsDerivStuff -> SeparateBagsDerivStuff
   f (DerivAuxBind _) = panic "genAuxBinds'" -- We have removed these before
@@ -2413,94 +2003,151 @@ mkParentType tc
 ************************************************************************
 -}
 
-mk_FunBind :: SrcSpan -> RdrName
-           -> [([LPat RdrName], LHsExpr RdrName)]
-           -> LHsBind RdrName
-mk_FunBind = mk_HRFunBind 0   -- by using mk_FunBind and not mk_HRFunBind,
-                              -- the caller says that the Void case needs no
-                              -- patterns
-
--- | This variant of 'mk_FunBind' puts an 'Arity' number of wildcards before
--- the "=" in the empty-data-decl case. This is necessary if the function
--- has a higher-rank type, like foldl. (See deriving/should_compile/T4302)
-mk_HRFunBind :: Arity -> SrcSpan -> RdrName
-             -> [([LPat RdrName], LHsExpr RdrName)]
-             -> LHsBind RdrName
-mk_HRFunBind arity loc fun pats_and_exprs
-  = mkHRRdrFunBind arity (L loc fun) matches
+-- | Make a function binding. If no equations are given, produce a function
+-- with the given arity that produces a stock error.
+mkFunBindSE :: Arity -> SrcSpan -> RdrName
+             -> [([LPat GhcPs], LHsExpr GhcPs)]
+             -> LHsBind GhcPs
+mkFunBindSE arity loc fun pats_and_exprs
+  = mkRdrFunBindSE arity (L loc fun) matches
   where
-    matches = [mkMatch (FunRhs (L loc fun) Prefix) p e
+    matches = [mkMatch (mkPrefixFunRhs (L loc fun))
+                               (map (parenthesizePat appPrec) p) e
                                (noLoc emptyLocalBinds)
               | (p,e) <-pats_and_exprs]
 
-mkRdrFunBind :: Located RdrName -> [LMatch RdrName (LHsExpr RdrName)] -> LHsBind RdrName
-mkRdrFunBind = mkHRRdrFunBind 0
+mkRdrFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
+             -> LHsBind GhcPs
+mkRdrFunBind fun@(L loc _fun_rdr) matches
+  = L loc (mkFunBind fun matches)
+
+-- | Make a function binding. If no equations are given, produce a function
+-- with the given arity that uses an empty case expression for the last
+-- argument that is passes to the given function to produce the right-hand
+-- side.
+mkFunBindEC :: Arity -> SrcSpan -> RdrName
+            -> (LHsExpr GhcPs -> LHsExpr GhcPs)
+            -> [([LPat GhcPs], LHsExpr GhcPs)]
+            -> LHsBind GhcPs
+mkFunBindEC arity loc fun catch_all pats_and_exprs
+  = mkRdrFunBindEC arity catch_all (L loc fun) matches
+  where
+    matches = [ mkMatch (mkPrefixFunRhs (L loc fun))
+                                (map (parenthesizePat appPrec) p) e
+                                (noLoc emptyLocalBinds)
+              | (p,e) <- pats_and_exprs ]
+
+-- | Produces a function binding. When no equations are given, it generates
+-- a binding of the given arity and an empty case expression
+-- for the last argument that it passes to the given function to produce
+-- the right-hand side.
+mkRdrFunBindEC :: Arity
+               -> (LHsExpr GhcPs -> LHsExpr GhcPs)
+               -> Located RdrName
+               -> [LMatch GhcPs (LHsExpr GhcPs)]
+               -> LHsBind GhcPs
+mkRdrFunBindEC arity catch_all
+                 fun@(L loc _fun_rdr) matches = L loc (mkFunBind fun matches')
+ where
+   -- Catch-all eqn looks like
+   --     fmap _ z = case z of {}
+   -- or
+   --     traverse _ z = pure (case z of)
+   -- or
+   --     foldMap _ z = mempty
+   -- It's needed if there no data cons at all,
+   -- which can happen with -XEmptyDataDecls
+   -- See #4302
+   matches' = if null matches
+              then [mkMatch (mkPrefixFunRhs fun)
+                            (replicate (arity - 1) nlWildPat ++ [z_Pat])
+                            (catch_all $ nlHsCase z_Expr [])
+                            (noLoc emptyLocalBinds)]
+              else matches
 
-mkHRRdrFunBind :: Arity -> Located RdrName -> [LMatch RdrName (LHsExpr RdrName)] -> LHsBind RdrName
-mkHRRdrFunBind arity fun@(L loc fun_rdr) matches = L loc (mkFunBind fun matches')
+-- | Produces a function binding. When there are no equations, it generates
+-- a binding with the given arity that produces an error based on the name of
+-- the type of the last argument.
+mkRdrFunBindSE :: Arity -> Located RdrName ->
+                    [LMatch GhcPs (LHsExpr GhcPs)] -> LHsBind GhcPs
+mkRdrFunBindSE arity
+                 fun@(L loc fun_rdr) matches = L loc (mkFunBind fun matches')
  where
    -- Catch-all eqn looks like
-   --     fmap = error "Void fmap"
+   --     compare _ _ = error "Void compare"
    -- It's needed if there no data cons at all,
    -- which can happen with -XEmptyDataDecls
-   -- See Trac #4302
+   -- See #4302
    matches' = if null matches
-              then [mkMatch (FunRhs fun Prefix)
+              then [mkMatch (mkPrefixFunRhs fun)
                             (replicate arity nlWildPat)
                             (error_Expr str) (noLoc emptyLocalBinds)]
               else matches
    str = "Void " ++ occNameString (rdrNameOcc fun_rdr)
 
+
 box ::         String           -- The class involved
-            -> TyCon            -- The tycon involved
-            -> LHsExpr RdrName  -- The argument
+            -> LHsExpr GhcPs    -- The argument
             -> Type             -- The argument type
-            -> LHsExpr RdrName  -- Boxed version of the arg
--- See Note [Deriving and unboxed types] in TcDeriv
-box cls_str tycon arg arg_ty = nlHsApp (nlHsVar box_con) arg
-  where
-    box_con = assoc_ty_id cls_str tycon boxConTbl arg_ty
+            -> LHsExpr GhcPs    -- Boxed version of the arg
+-- See Note [Deriving and unboxed types] in TcDerivInfer
+box cls_str arg arg_ty = assoc_ty_id cls_str boxConTbl arg_ty arg
 
 ---------------------
 primOrdOps :: String    -- The class involved
-           -> TyCon     -- The tycon involved
            -> Type      -- The type
            -> (RdrName, RdrName, RdrName, RdrName, RdrName)  -- (lt,le,eq,ge,gt)
--- See Note [Deriving and unboxed types] in TcDeriv
-primOrdOps str tycon ty = assoc_ty_id str tycon ordOpTbl ty
-
-primLitOps :: String -- The class involved
-           -> TyCon  -- The tycon involved
-           -> Type   -- The type
-           -> ( LHsExpr RdrName -> LHsExpr RdrName -- Constructs a Q Exp value
-              , LHsExpr RdrName -> LHsExpr RdrName -- Constructs a boxed value
-              )
-primLitOps str tycon ty = ( assoc_ty_id str tycon litConTbl ty
-                          , \v -> nlHsVar boxRDR `nlHsApp` v
-                          )
-  where
-    boxRDR
-      | ty `eqType` addrPrimTy = unpackCString_RDR
-      | otherwise = assoc_ty_id str tycon boxConTbl ty
+-- See Note [Deriving and unboxed types] in TcDerivInfer
+primOrdOps str ty = assoc_ty_id str ordOpTbl ty
 
 ordOpTbl :: [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
 ordOpTbl
- =  [(charPrimTy  , (ltChar_RDR  , leChar_RDR  , eqChar_RDR  , geChar_RDR  , gtChar_RDR  ))
-    ,(intPrimTy   , (ltInt_RDR   , leInt_RDR   , eqInt_RDR   , geInt_RDR   , gtInt_RDR   ))
-    ,(wordPrimTy  , (ltWord_RDR  , leWord_RDR  , eqWord_RDR  , geWord_RDR  , gtWord_RDR  ))
-    ,(addrPrimTy  , (ltAddr_RDR  , leAddr_RDR  , eqAddr_RDR  , geAddr_RDR  , gtAddr_RDR  ))
-    ,(floatPrimTy , (ltFloat_RDR , leFloat_RDR , eqFloat_RDR , geFloat_RDR , gtFloat_RDR ))
-    ,(doublePrimTy, (ltDouble_RDR, leDouble_RDR, eqDouble_RDR, geDouble_RDR, gtDouble_RDR)) ]
-
-boxConTbl :: [(Type, RdrName)]
-boxConTbl
-  = [(charPrimTy  , getRdrName charDataCon  )
-    ,(intPrimTy   , getRdrName intDataCon   )
-    ,(wordPrimTy  , getRdrName wordDataCon  )
-    ,(floatPrimTy , getRdrName floatDataCon )
-    ,(doublePrimTy, getRdrName doubleDataCon)
+ =  [(charPrimTy  , (ltChar_RDR  , leChar_RDR
+     , eqChar_RDR  , geChar_RDR  , gtChar_RDR  ))
+    ,(intPrimTy   , (ltInt_RDR   , leInt_RDR
+     , eqInt_RDR   , geInt_RDR   , gtInt_RDR   ))
+    ,(int8PrimTy  , (ltInt8_RDR  , leInt8_RDR
+     , eqInt8_RDR  , geInt8_RDR  , gtInt8_RDR   ))
+    ,(int16PrimTy , (ltInt16_RDR , leInt16_RDR
+     , eqInt16_RDR , geInt16_RDR , gtInt16_RDR   ))
+    ,(wordPrimTy  , (ltWord_RDR  , leWord_RDR
+     , eqWord_RDR  , geWord_RDR  , gtWord_RDR  ))
+    ,(word8PrimTy , (ltWord8_RDR , leWord8_RDR
+     , eqWord8_RDR , geWord8_RDR , gtWord8_RDR   ))
+    ,(word16PrimTy, (ltWord16_RDR, leWord16_RDR
+     , eqWord16_RDR, geWord16_RDR, gtWord16_RDR  ))
+    ,(addrPrimTy  , (ltAddr_RDR  , leAddr_RDR
+     , eqAddr_RDR  , geAddr_RDR  , gtAddr_RDR  ))
+    ,(floatPrimTy , (ltFloat_RDR , leFloat_RDR
+     , eqFloat_RDR , geFloat_RDR , gtFloat_RDR ))
+    ,(doublePrimTy, (ltDouble_RDR, leDouble_RDR
+     , eqDouble_RDR, geDouble_RDR, gtDouble_RDR)) ]
+
+-- A mapping from a primitive type to a function that constructs its boxed
+-- version.
+-- NOTE: Int8#/Word8# will become Int/Word.
+boxConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]
+boxConTbl =
+    [ (charPrimTy  , nlHsApp (nlHsVar $ getRdrName charDataCon))
+    , (intPrimTy   , nlHsApp (nlHsVar $ getRdrName intDataCon))
+    , (wordPrimTy  , nlHsApp (nlHsVar $ getRdrName wordDataCon ))
+    , (floatPrimTy , nlHsApp (nlHsVar $ getRdrName floatDataCon ))
+    , (doublePrimTy, nlHsApp (nlHsVar $ getRdrName doubleDataCon))
+    , (int8PrimTy,
+        nlHsApp (nlHsVar $ getRdrName intDataCon)
+        . nlHsApp (nlHsVar extendInt8_RDR))
+    , (word8PrimTy,
+        nlHsApp (nlHsVar $ getRdrName wordDataCon)
+        .  nlHsApp (nlHsVar extendWord8_RDR))
+    , (int16PrimTy,
+        nlHsApp (nlHsVar $ getRdrName intDataCon)
+        . nlHsApp (nlHsVar extendInt16_RDR))
+    , (word16PrimTy,
+        nlHsApp (nlHsVar $ getRdrName wordDataCon)
+        .  nlHsApp (nlHsVar extendWord16_RDR))
     ]
 
+
 -- | A table of postfix modifiers for unboxed values.
 postfixModTbl :: [(Type, String)]
 postfixModTbl
@@ -2509,9 +2156,21 @@ postfixModTbl
     ,(wordPrimTy  , "##")
     ,(floatPrimTy , "#" )
     ,(doublePrimTy, "##")
+    ,(int8PrimTy, "#")
+    ,(word8PrimTy, "##")
+    ,(int16PrimTy, "#")
+    ,(word16PrimTy, "##")
     ]
 
-litConTbl :: [(Type, LHsExpr RdrName -> LHsExpr RdrName)]
+primConvTbl :: [(Type, String)]
+primConvTbl =
+    [ (int8PrimTy, "narrowInt8#")
+    , (word8PrimTy, "narrowWord8#")
+    , (int16PrimTy, "narrowInt16#")
+    , (word16PrimTy, "narrowWord16#")
+    ]
+
+litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]
 litConTbl
   = [(charPrimTy  , nlHsApp (nlHsVar charPrimL_RDR))
     ,(intPrimTy   , nlHsApp (nlHsVar intPrimL_RDR)
@@ -2532,55 +2191,60 @@ litConTbl
     ]
 
 -- | Lookup `Type` in an association list.
-assoc_ty_id :: String           -- The class involved
-            -> TyCon            -- The tycon involved
+assoc_ty_id :: HasCallStack => String           -- The class involved
             -> [(Type,a)]       -- The table
             -> Type             -- The type
             -> a                -- The result of the lookup
-assoc_ty_id cls_str _ tbl ty
-  | null res = pprPanic "Error in deriving:" (text "Can't derive" <+> text cls_str <+>
-                                              text "for primitive type" <+> ppr ty)
-  | otherwise = head res
-  where
-    res = [id | (ty',id) <- tbl, ty `eqType` ty']
+assoc_ty_id cls_str tbl ty
+  | Just a <- assoc_ty_id_maybe tbl ty = a
+  | otherwise =
+      pprPanic "Error in deriving:"
+          (text "Can't derive" <+> text cls_str <+>
+           text "for primitive type" <+> ppr ty)
+
+-- | Lookup `Type` in an association list.
+assoc_ty_id_maybe :: [(Type, a)] -> Type -> Maybe a
+assoc_ty_id_maybe tbl ty = snd <$> find (\(t, _) -> t `eqType` ty) tbl
 
 -----------------------------------------------------------------------
 
-and_Expr :: LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName
+and_Expr :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
 and_Expr a b = genOpApp a and_RDR    b
 
 -----------------------------------------------------------------------
 
-eq_Expr :: TyCon -> Type -> LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName
-eq_Expr tycon ty a b
+eq_Expr :: Type -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
+eq_Expr ty a b
     | not (isUnliftedType ty) = genOpApp a eq_RDR b
     | otherwise               = genPrimOpApp a prim_eq b
  where
-   (_, _, prim_eq, _, _) = primOrdOps "Eq" tycon ty
+   (_, _, prim_eq, _, _) = primOrdOps "Eq" ty
 
-untag_Expr :: TyCon -> [( RdrName,  RdrName)] -> LHsExpr RdrName -> LHsExpr RdrName
-untag_Expr _ [] expr = expr
-untag_Expr tycon ((untag_this, put_tag_here) : more) expr
-  = nlHsCase (nlHsPar (nlHsVarApps (con2tag_RDR tycon) [untag_this])) {-of-}
-      [mkHsCaseAlt (nlVarPat put_tag_here) (untag_Expr tycon more expr)]
+untag_Expr :: DynFlags -> TyCon -> [( RdrName,  RdrName)]
+              -> LHsExpr GhcPs -> LHsExpr GhcPs
+untag_Expr _ _ [] expr = expr
+untag_Expr dflags tycon ((untag_this, put_tag_here) : more) expr
+  = nlHsCase (nlHsPar (nlHsVarApps (con2tag_RDR dflags tycon)
+                                   [untag_this])) {-of-}
+      [mkHsCaseAlt (nlVarPat put_tag_here) (untag_Expr dflags tycon more expr)]
 
 enum_from_to_Expr
-        :: LHsExpr RdrName -> LHsExpr RdrName
-        -> LHsExpr RdrName
+        :: LHsExpr GhcPs -> LHsExpr GhcPs
+        -> LHsExpr GhcPs
 enum_from_then_to_Expr
-        :: LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName
-        -> LHsExpr RdrName
+        :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
+        -> LHsExpr GhcPs
 
 enum_from_to_Expr      f   t2 = nlHsApp (nlHsApp (nlHsVar enumFromTo_RDR) f) t2
 enum_from_then_to_Expr f t t2 = nlHsApp (nlHsApp (nlHsApp (nlHsVar enumFromThenTo_RDR) f) t) t2
 
 showParen_Expr
-        :: LHsExpr RdrName -> LHsExpr RdrName
-        -> LHsExpr RdrName
+        :: LHsExpr GhcPs -> LHsExpr GhcPs
+        -> LHsExpr GhcPs
 
 showParen_Expr e1 e2 = nlHsApp (nlHsApp (nlHsVar showParen_RDR) e1) e2
 
-nested_compose_Expr :: [LHsExpr RdrName] -> LHsExpr RdrName
+nested_compose_Expr :: [LHsExpr GhcPs] -> LHsExpr GhcPs
 
 nested_compose_Expr []  = panic "nested_compose_expr"   -- Arg is always non-empty
 nested_compose_Expr [e] = parenify e
@@ -2589,18 +2253,18 @@ nested_compose_Expr (e:es)
 
 -- impossible_Expr is used in case RHSs that should never happen.
 -- We generate these to keep the desugarer from complaining that they *might* happen!
-error_Expr :: String -> LHsExpr RdrName
+error_Expr :: String -> LHsExpr GhcPs
 error_Expr string = nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsString string))
 
 -- illegal_Expr is used when signalling error conditions in the RHS of a derived
 -- method. It is currently only used by Enum.{succ,pred}
-illegal_Expr :: String -> String -> String -> LHsExpr RdrName
+illegal_Expr :: String -> String -> String -> LHsExpr GhcPs
 illegal_Expr meth tp msg =
    nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsString (meth ++ '{':tp ++ "}: " ++ msg)))
 
 -- illegal_toEnum_tag is an extended version of illegal_Expr, which also allows you
 -- to include the value of a_RDR in the error string.
-illegal_toEnum_tag :: String -> RdrName -> LHsExpr RdrName
+illegal_toEnum_tag :: String -> RdrName -> LHsExpr GhcPs
 illegal_toEnum_tag tp maxtag =
    nlHsApp (nlHsVar error_RDR)
            (nlHsApp (nlHsApp (nlHsVar append_RDR)
@@ -2618,16 +2282,16 @@ illegal_toEnum_tag tp maxtag =
                                         (nlHsVar maxtag))
                                         (nlHsLit (mkHsString ")"))))))
 
-parenify :: LHsExpr RdrName -> LHsExpr RdrName
-parenify e@(L _ (HsVar _)) = e
-parenify e                 = mkHsPar e
+parenify :: LHsExpr GhcPs -> LHsExpr GhcPs
+parenify e@(L _ (HsVar _ _)) = e
+parenify e                   = mkHsPar e
 
 -- genOpApp wraps brackets round the operator application, so that the
 -- renamer won't subsequently try to re-associate it.
-genOpApp :: LHsExpr RdrName -> RdrName -> LHsExpr RdrName -> LHsExpr RdrName
+genOpApp :: LHsExpr GhcPs -> RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs
 genOpApp e1 op e2 = nlHsPar (nlHsOpApp e1 op e2)
 
-genPrimOpApp :: LHsExpr RdrName -> RdrName -> LHsExpr RdrName -> LHsExpr RdrName
+genPrimOpApp :: LHsExpr GhcPs -> RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs
 genPrimOpApp e1 op e2 = nlHsPar (nlHsApp (nlHsVar tagToEnum_RDR) (nlHsOpApp e1 op e2))
 
 a_RDR, b_RDR, c_RDR, d_RDR, f_RDR, k_RDR, z_RDR, ah_RDR, bh_RDR, ch_RDR, dh_RDR
@@ -2649,31 +2313,24 @@ as_RDRs         = [ mkVarUnqual (mkFastString ("a"++show i)) | i <- [(1::Int) ..
 bs_RDRs         = [ mkVarUnqual (mkFastString ("b"++show i)) | i <- [(1::Int) .. ] ]
 cs_RDRs         = [ mkVarUnqual (mkFastString ("c"++show i)) | i <- [(1::Int) .. ] ]
 
-a_Expr, b_Expr, c_Expr, f_Expr, z_Expr, ltTag_Expr, eqTag_Expr, gtTag_Expr,
-    false_Expr, true_Expr, fmap_Expr,
-    mempty_Expr, foldMap_Expr, traverse_Expr :: LHsExpr RdrName
+a_Expr, b_Expr, c_Expr, z_Expr, ltTag_Expr, eqTag_Expr, gtTag_Expr, false_Expr,
+    true_Expr, pure_Expr :: LHsExpr GhcPs
 a_Expr          = nlHsVar a_RDR
 b_Expr          = nlHsVar b_RDR
 c_Expr          = nlHsVar c_RDR
-f_Expr          = nlHsVar f_RDR
 z_Expr          = nlHsVar z_RDR
 ltTag_Expr      = nlHsVar ltTag_RDR
 eqTag_Expr      = nlHsVar eqTag_RDR
 gtTag_Expr      = nlHsVar gtTag_RDR
 false_Expr      = nlHsVar false_RDR
 true_Expr       = nlHsVar true_RDR
-fmap_Expr       = nlHsVar fmap_RDR
--- pure_Expr       = nlHsVar pure_RDR
-mempty_Expr     = nlHsVar mempty_RDR
-foldMap_Expr    = nlHsVar foldMap_RDR
-traverse_Expr   = nlHsVar traverse_RDR
+pure_Expr       = nlHsVar pure_RDR
 
-a_Pat, b_Pat, c_Pat, d_Pat, f_Pat, k_Pat, z_Pat :: LPat RdrName
+a_Pat, b_Pat, c_Pat, d_Pat, k_Pat, z_Pat :: LPat GhcPs
 a_Pat           = nlVarPat a_RDR
 b_Pat           = nlVarPat b_RDR
 c_Pat           = nlVarPat c_RDR
 d_Pat           = nlVarPat d_RDR
-f_Pat           = nlVarPat f_RDR
 k_Pat           = nlVarPat k_RDR
 z_Pat           = nlVarPat z_RDR
 
@@ -2681,30 +2338,31 @@ minusInt_RDR, tagToEnum_RDR :: RdrName
 minusInt_RDR  = getRdrName (primOpId IntSubOp   )
 tagToEnum_RDR = getRdrName (primOpId TagToEnumOp)
 
-con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
+con2tag_RDR, tag2con_RDR, maxtag_RDR :: DynFlags -> TyCon -> RdrName
 -- Generates Orig s RdrName, for the binding positions
-con2tag_RDR tycon = mk_tc_deriv_name tycon mkCon2TagOcc
-tag2con_RDR tycon = mk_tc_deriv_name tycon mkTag2ConOcc
-maxtag_RDR  tycon = mk_tc_deriv_name tycon mkMaxTagOcc
+con2tag_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkCon2TagOcc
+tag2con_RDR dflags tycon = mk_tc_deriv_name dflags tycon mkTag2ConOcc
+maxtag_RDR  dflags tycon = mk_tc_deriv_name dflags tycon mkMaxTagOcc
 
-mk_tc_deriv_name :: TyCon -> (OccName -> OccName) -> RdrName
-mk_tc_deriv_name tycon occ_fun = mkAuxBinderName (tyConName tycon) occ_fun
+mk_tc_deriv_name :: DynFlags -> TyCon -> (OccName -> OccName) -> RdrName
+mk_tc_deriv_name dflags tycon occ_fun =
+   mkAuxBinderName dflags (tyConName tycon) occ_fun
 
-mkAuxBinderName :: Name -> (OccName -> OccName) -> RdrName
+mkAuxBinderName :: DynFlags -> Name -> (OccName -> OccName) -> RdrName
 -- ^ Make a top-level binder name for an auxiliary binding for a parent name
 -- See Note [Auxiliary binders]
-mkAuxBinderName parent occ_fun
+mkAuxBinderName dflags parent occ_fun
   = mkRdrUnqual (occ_fun stable_parent_occ)
   where
     stable_parent_occ = mkOccName (occNameSpace parent_occ) stable_string
     stable_string
-      | opt_PprStyle_Debug = parent_stable
-      | otherwise = parent_stable_hash
+      | hasPprDebug dflags = parent_stable
+      | otherwise          = parent_stable_hash
     parent_stable = nameStableString parent
     parent_stable_hash =
       let Fingerprint high low = fingerprintString parent_stable
       in toBase62 high ++ toBase62Padded low
-      -- See Note [Base 62 encoding 128-bit integers]
+      -- See Note [Base 62 encoding 128-bit integers] in Encoding
     parent_occ  = nameOccName parent
 
 
@@ -2722,7 +2380,7 @@ We often want to make a top-level auxiliary binding.  E.g. for comparison we hae
 Of course these top-level bindings should all have distinct name, and we are
 generating RdrNames here.  We can't just use the TyCon or DataCon to distinguish
 because with standalone deriving two imported TyCons might both be called T!
-(See Trac #7947.)
+(See #7947.)
 
 So we use package name, module name and the name of the parent
 (T in this example) as part of the OccName we generate for the new binding.
@@ -2730,235 +2388,4 @@ To make the symbol names short we take a base62 hash of the full name.
 
 In the past we used the *unique* from the parent, but that's not stable across
 recompilations as uniques are nondeterministic.
-
-Note [DeriveFoldable with ExistentialQuantification]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Functor and Traversable instances can only be derived for data types whose
-last type parameter is truly universally polymorphic. For example:
-
-  data T a b where
-    T1 ::                 b   -> T a b   -- YES, b is unconstrained
-    T2 :: Ord b   =>      b   -> T a b   -- NO, b is constrained by (Ord b)
-    T3 :: b ~ Int =>      b   -> T a b   -- NO, b is constrained by (b ~ Int)
-    T4 ::                 Int -> T a Int -- NO, this is just like T3
-    T5 :: Ord a   => a -> b   -> T a b   -- YES, b is unconstrained, even
-                                         -- though a is existential
-    T6 ::                 Int -> T Int b -- YES, b is unconstrained
-
-For Foldable instances, however, we can completely lift the constraint that
-the last type parameter be truly universally polymorphic. This means that T
-(as defined above) can have a derived Foldable instance:
-
-  instance Foldable (T a) where
-    foldr f z (T1 b)   = f b z
-    foldr f z (T2 b)   = f b z
-    foldr f z (T3 b)   = f b z
-    foldr f z (T4 b)   = z
-    foldr f z (T5 a b) = f b z
-    foldr f z (T6 a)   = z
-
-    foldMap f (T1 b)   = f b
-    foldMap f (T2 b)   = f b
-    foldMap f (T3 b)   = f b
-    foldMap f (T4 b)   = mempty
-    foldMap f (T5 a b) = f b
-    foldMap f (T6 a)   = mempty
-
-In a Foldable instance, it is safe to fold over an occurrence of the last type
-parameter that is not truly universally polymorphic. However, there is a bit
-of subtlety in determining what is actually an occurrence of a type parameter.
-T3 and T4, as defined above, provide one example:
-
-  data T a b where
-    ...
-    T3 :: b ~ Int => b   -> T a b
-    T4 ::            Int -> T a Int
-    ...
-
-  instance Foldable (T a) where
-    ...
-    foldr f z (T3 b) = f b z
-    foldr f z (T4 b) = z
-    ...
-    foldMap f (T3 b) = f b
-    foldMap f (T4 b) = mempty
-    ...
-
-Notice that the argument of T3 is folded over, whereas the argument of T4 is
-not. This is because we only fold over constructor arguments that
-syntactically mention the universally quantified type parameter of that
-particular data constructor. See foldDataConArgs for how this is implemented.
-
-As another example, consider the following data type. The argument of each
-constructor has the same type as the last type parameter:
-
-  data E a where
-    E1 :: (a ~ Int) => a   -> E a
-    E2 ::              Int -> E Int
-    E3 :: (a ~ Int) => a   -> E Int
-    E4 :: (a ~ Int) => Int -> E a
-
-Only E1's argument is an occurrence of a universally quantified type variable
-that is syntactically equivalent to the last type parameter, so only E1's
-argument will be be folded over in a derived Foldable instance.
-
-See Trac #10447 for the original discussion on this feature. Also see
-https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/DeriveFunctor
-for a more in-depth explanation.
-
-Note [FFoldType and functorLikeTraverse]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Deriving Functor, Foldable, and Traversable all require generating expressions
-which perform an operation on each argument of a data constructor depending
-on the argument's type. In particular, a generated operation can be different
-depending on whether the type mentions the last type variable of the datatype
-(e.g., if you have data T a = MkT a Int, then a generated foldr expresion would
-fold over the first argument of MkT, but not the second).
-
-This pattern is abstracted with the FFoldType datatype, which provides hooks
-for the user to specify how a constructor argument should be folded when it
-has a type with a particular "shape". The shapes are as follows (assume that
-a is the last type variable in a given datatype):
-
-* ft_triv:    The type does not mention the last type variable at all.
-              Examples: Int, b
-
-* ft_var:     The type is syntactically equal to the last type variable.
-              Moreover, the type appears in a covariant position (see
-              the Deriving Functor instances section of the users' guide
-              for an in-depth explanation of covariance vs. contravariance).
-              Example: a (covariantly)
-
-* ft_co_var:  The type is syntactically equal to the last type variable.
-              Moreover, the type appears in a contravariant position.
-              Example: a (contravariantly)
-
-* ft_fun:     A function type which mentions the last type variable in
-              the argument position, result position or both.
-              Examples: a -> Int, Int -> a, Maybe a -> [a]
-
-* ft_tup:     A tuple type which mentions the last type variable in at least
-              one of its fields. The TyCon argument of ft_tup represents the
-              particular tuple's type constructor.
-              Examples: (a, Int), (Maybe a, [a], Either a Int), (# Int, a #)
-
-* ft_ty_app:  A type is being applied to the last type parameter, where the
-              applied type does not mention the last type parameter (if it
-              did, it would fall under ft_bad_app). The Type argument to
-              ft_ty_app represents the applied type.
-
-              Note that functions, tuples, and foralls are distinct cases
-              and take precedence of ft_ty_app. (For example, (Int -> a) would
-              fall under (ft_fun Int a), not (ft_ty_app ((->) Int) a).
-              Examples: Maybe a, Either b a
-
-* ft_bad_app: A type application uses the last type parameter in a position
-              other than the last argument. This case is singled out because
-              Functor, Foldable, and Traversable instances cannot be derived
-              for datatypes containing arguments with such types.
-              Examples: Either a Int, Const a b
-
-* ft_forall:  A forall'd type mentions the last type parameter on its right-
-              hand side (and is not quantified on the left-hand side). This
-              case is present mostly for plumbing purposes.
-              Example: forall b. Either b a
-
-If FFoldType describes a strategy for folding subcomponents of a Type, then
-functorLikeTraverse is the function that applies that strategy to the entirety
-of a Type, returning the final folded-up result.
-
-foldDataConArgs applies functorLikeTraverse to every argument type of a
-constructor, returning a list of the fold results. This makes foldDataConArgs
-a natural way to generate the subexpressions in a generated fmap, foldr,
-foldMap, or traverse definition (the subexpressions must then be combined in
-a method-specific fashion to form the final generated expression).
-
-Deriving Generic1 also does validity checking by looking for the last type
-variable in certain positions of a constructor's argument types, so it also
-uses foldDataConArgs. See Note [degenerate use of FFoldType] in TcGenGenerics.
-
-Note [Generated code for DeriveFoldable and DeriveTraversable]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We adapt the algorithms for -XDeriveFoldable and -XDeriveTraversable based on
-that of -XDeriveFunctor. However, there an important difference between deriving
-the former two typeclasses and the latter one, which is best illustrated by the
-following scenario:
-
-  data WithInt a = WithInt a Int# deriving (Functor, Foldable, Traversable)
-
-The generated code for the Functor instance is straightforward:
-
-  instance Functor WithInt where
-    fmap f (WithInt a i) = WithInt (f a) i
-
-But if we use too similar of a strategy for deriving the Foldable and
-Traversable instances, we end up with this code:
-
-  instance Foldable WithInt where
-    foldMap f (WithInt a i) = f a <> mempty
-
-  instance Traversable WithInt where
-    traverse f (WithInt a i) = fmap WithInt (f a) <*> pure i
-
-This is unsatisfying for two reasons:
-
-1. The Traversable instance doesn't typecheck! Int# is of kind #, but pure
-   expects an argument whose type is of kind *. This effectively prevents
-   Traversable from being derived for any datatype with an unlifted argument
-   type (Trac #11174).
-
-2. The generated code contains superfluous expressions. By the Monoid laws,
-   we can reduce (f a <> mempty) to (f a), and by the Applicative laws, we can
-   reduce (fmap WithInt (f a) <*> pure i) to (fmap (\b -> WithInt b i) (f a)).
-
-We can fix both of these issues by incorporating a slight twist to the usual
-algorithm that we use for -XDeriveFunctor. The differences can be summarized
-as follows:
-
-1. In the generated expression, we only fold over arguments whose types
-   mention the last type parameter. Any other argument types will simply
-   produce useless 'mempty's or 'pure's, so they can be safely ignored.
-
-2. In the case of -XDeriveTraversable, instead of applying ConName,
-   we apply (\b_i ... b_k -> ConName a_1 ... a_n), where
-
-   * ConName has n arguments
-   * {b_i, ..., b_k} is a subset of {a_1, ..., a_n} whose indices correspond
-     to the arguments whose types mention the last type parameter. As a
-     consequence, taking the difference of {a_1, ..., a_n} and
-     {b_i, ..., b_k} yields the all the argument values of ConName whose types
-     do not mention the last type parameter. Note that [i, ..., k] is a
-     strictly increasing—but not necessarily consecutive—integer sequence.
-
-     For example, the datatype
-
-       data Foo a = Foo Int a Int a
-
-     would generate the following Traversable instance:
-
-       instance Traversable Foo where
-         traverse f (Foo a1 a2 a3 a4) =
-           fmap (\b2 b4 -> Foo a1 b2 a3 b4) (f a2) <*> f a4
-
-Technically, this approach would also work for -XDeriveFunctor as well, but we
-decide not to do so because:
-
-1. There's not much benefit to generating, e.g., ((\b -> WithInt b i) (f a))
-   instead of (WithInt (f a) i).
-
-2. There would be certain datatypes for which the above strategy would
-   generate Functor code that would fail to typecheck. For example:
-
-     data Bar f a = Bar (forall f. Functor f => f a) deriving Functor
-
-   With the conventional algorithm, it would generate something like:
-
-     fmap f (Bar a) = Bar (fmap f a)
-
-   which typechecks. But with the strategy mentioned above, it would generate:
-
-     fmap f (Bar a) = (\b -> Bar b) (fmap f a)
-
-   which does not typecheck, since GHC cannot unify the rank-2 type variables
-   in the types of b and (fmap f a).
 -}