do { let all_call_args | is_dfun   = saturating_call_args -- See Note [Specialising DFuns]

                                | otherwise = call_args

                  saturating_call_args = call_args ++ map mk_extra_dfun_arg (dropList call_args rhs_bndrs)

            ; (useful, rule_bndrs, rule_lhs_args, spec_bndrs1, spec_args) <- specHeader env all_call_args

 --           ; pprTrace "spec_call" (vcat

 --                [ text "fun:       "  <+> ppr fn

 --                , text "call info: "  <+> ppr _ci

 --                , text "rule_bndrs:"  <+> ppr rule_bndrs

 --                , text "lhs_args:  "  <+> ppr rule_lhs_args

 --                , text "spec_bndrs1:" <+> ppr spec_bndrs1

 --                , text "spec_args: "  <+> ppr spec_args

 --                , text "dx_binds:  "  <+> ppr dx_binds

 --                , text "rhs_bndrs"     <+> ppr rhs_bndrs

            ; (rhs_body', rhs_uds) <- specRhs env rhs_bndrs rhs_body spec_args

                 -- Add the { d1' = dx1; d2' = dx2 } usage stuff

                 -- to the rhs_uds; see Note [Specialising Calls]

                              wrapDictBindsE dumped_dbs rhs_body'

                  spec_fn_ty1 = exprType spec_rhs1

                  -- Maybe add a void arg to the specialised function,

                  -- The wrap_unf_body applies the original unfolding to the specialised

                  -- arguments, not forgetting to wrap the dx_binds around the outside (#22358)

                  simpl_opts = initSimpleOpts dflags

                  spec_unf = specUnfolding simpl_opts spec_bndrs wrap_unf_body

                                           rule_lhs_args fn_unf

   where

     in_scope = substInScopeSet (se_subst env)

 -- Convenience function for invoking lookupRule from Specialise

 -- The SpecEnv's InScopeSet should include all the Vars in the [CoreExpr]

 specLookupRule :: SpecEnv -> Id -> [CoreExpr]

     SpecType Type

     -- | Type arguments that should remain polymorphic.

     -- | Dictionaries that should be specialised. mkCallUDs ensures

     -- that only "interesting" dictionary arguments get a SpecDict;

   | SpecDict DictExpr

     -- | Value arguments that should not be specialised.

 instance Outputable SpecArg where

 specArgFreeIds :: SpecArg -> IdSet

 specArgFreeVars :: SpecArg -> VarSet

 isSpecDict :: SpecArg -> Bool

 isSpecDict (SpecDict {}) = True

 -- We want to specialise on type 'T1', and so we must construct a substitution

 -- 'a->T1', as well as a LHS argument for the resulting RULE and unfolding

 -- details.

   = do { -- Find qvars, the type variables to add to the binders for the rule

          -- Namely those free in `ty` that aren't in scope

          -- See (MP2) in Note [Specialising polymorphic dictionaries]

              qvars    = scopedSort $

                         filterOut (`elemInScopeSet` in_scope) $

                         tyCoVarsOfTypeList ty

        ; pure ( useful

               , qvars ++ rule_bs

               , Type ty : rule_args

 -- a substitution on it (in case the type refers to 'a'). Additionally, we need

 -- to produce a binder, LHS argument and RHS argument for the resulting rule,

 -- /and/ a binder for the specialised body.

        ; pure ( useful

               , bndr' : rule_bs

               , varToCoreExpr bndr' : rule_es

               , varToCoreExpr bndr' : spec_args

               )

        }

 -- Next we want to specialise the 'Eq a' dict away. We need to construct

 -- a wildcard binder to match the dictionary (See Note [Specialising Calls] for

 -- the nitty-gritty), as a LHS rule and unfolding details.

   | not (isDeadBinder bndr)

   , allVarSet (`elemInScopeSet` in_scope) (exprFreeVars d)

     -- See Note [Weird special case for SpecDict]

        ; pure ( True      -- Ha!  A useful specialisation!

               )

        }

 -- Finally, we don't want to specialise on this argument 'i':

 --   - It's an UnSpecArg, or

 -- why 'i' doesn't appear in our RULE above. But we have no guarantee that

 -- there aren't 'UnspecArg's which come /before/ all of the dictionaries, so

 -- this case must be here.

     -- The "_" can be UnSpecArg, or SpecDict where the bndr is dead

   = do { -- see Note [Zap occ info in rule binders]

        ; let bndr_ty = idType bndr'

              -- See Note [Drop dead args from specialisations]

                 = (Just bndr', varToCoreExpr bndr')

        ; pure ( useful

               , bndr' : rule_bs

               , varToCoreExpr bndr' : rule_es

               , case mb_spec_bndr of

               , spec_arg : spec_args

               )

        }

     (env', bndrs') = substBndrs env bndrs

 -- | Binds a dictionary argument to a fresh name, to preserve sharing

 bindAuxiliaryDict

   :: SpecEnv

                                 -- Ensure the new unfolding is in the in-scope set

     in -- pprTrace "bindAuxiliaryDict:non-trivial" (ppr orig_dict_id <+> ppr fresh_dict_id') $

        (env', Just dict_bind, Var fresh_dict_id')

 addDictUnfolding :: Id -> CoreExpr -> Id

 -- Add unfolding for freshly-bound Ids: see Note [Make the new dictionaries interesting]

 -- and Note [Specialisation modulo dictionary selectors]

                      unitBag (CI { ci_key  = args

                                  , ci_fvs  = call_fvs }) }

   where

     free_var_fn =

       if gopt Opt_PolymorphicSpecialisation (se_dflags spec_env)

         then specArgFreeIds

         else specArgFreeVars

         -- specArgFreeIds: we specifically look for free Ids, not TyVars

         --    see (MP1) in Note [Specialising polymorphic dictionaries]

         --

              -- Establish (CI-KEY): drop trailing args until we get to a SpecDict

     mk_spec_arg :: OutExpr -> PiTyBinder -> SpecArg

       |  binderVar bndr `elemVarSet` constrained_tyvars

     -- For "invisibleFunArg", which are the type-class dictionaries,

     -- we decide on a case by case basis if we want to specialise

               -- See Note [Interesting dictionary arguments]

       = SpecDict arg

 {-

 Note [Ticks on applications]

   = uds { ud_binds = FDB { fdb_binds = binds `appOL`        (toOL dbs)

                          , fdb_bndrs = bs    `extendVarSetList` bindersOfDictBinds dbs } }

 wrapDictBinds :: FloatedDictBinds -> [CoreBind] -> [CoreBind]

 wrapDictBinds (FDB { fdb_binds = dbs }) binds

     go  _ _ = False

     go_arg (SpecType ty1) (SpecType ty2) = isJust (tcMatchTy ty1 ty2)

 ----------------------

 splitDictBinds :: FloatedDictBinds -> IdSet -> (FloatedDictBinds, OrdList DictBind, IdSet)

        ; let env' = env { se_subst = subst' }

        ; return (env', bndrs') }

 newSpecIdSM :: Name -> Type -> IdDetails -> IdInfo -> SpecM Id

     -- Give the new Id a similar occurrence name to the old one

 newSpecIdSM old_name new_ty details info

         ; return (assert (not (isCoVarType new_ty)) $

                   mkLocalVar details new_name ManyTy new_ty info) }

 {-

                 Old (but interesting) stuff about unboxed bindings

                 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

                            in h:t

 Could convert let to case:

         map_*_Int# f (x:xs) = case f x of h# ->

                               let t = map f xs

                               in h#:t