-import GHC.Exts

-coercionIsSmall :: Coercion -> Bool

--- This function should return False quickly on a big coercion

--- It should /not/ traverse the big coercion!

-coercionIsSmall co

-  = not (isTrue# ((go co 100#) <# 0#))

-  where

-    go :: Coercion -> Int# -> Int#

-    go _co n | isTrue# (n <# 0#)   = n

-    go (Refl {})                 n = dec n

-    go (GRefl _ _ mco)           n = go_mco mco (dec n)

-    go (TyConAppCo _ _ cos)      n = go_cos cos (dec n)

-    go (AxiomCo _ cos)           n = go_cos cos (dec n)

-    go (UnivCo _ _ _ _ cos)      n = go_cos cos (dec n)

-    go (AppCo co1 co2)           n = go co1 (go co2 (dec n))

-    go (CoVarCo {})              n = dec n

-    go (HoleCo {})               n = dec n

-    go (SymCo co)                n = go co (dec n)

-    go (KindCo co)               n = go co (dec n)

-    go (SubCo co)                n = go co (dec n)

-    go (TransCo co1 co2)         n = go co1 (go co2 (dec n))

-    go (SelCo _  co)             n = go co (dec n)

-    go (LRCo _  co)              n = go co (dec n)

-    go (InstCo co1 co2)          n = go co1 (go co2 (dec n))

-    go (ForAllCo _ _ _ kco co)   n = go co (go_mco kco (dec n))

-    go (FunCo _ _ _ mco aco rco) n = go mco (go aco (go rco (dec n)))

-

-    go_cos []       n = n

-    go_cos (co:cos) n = go_cos cos (go co n)

-

-    go_mco MRefl    n = dec n

-    go_mco (MCo co) n = go co n

-

-    dec n = n -# 1#

-

-        idFVs,

-        idRuleVars, stableUnfoldingVars,

-stableUnfoldingFVs :: Unfolding -> Maybe FV

-  = case unf of

-      CoreUnfolding { uf_tmpl = rhs, uf_src = src }

-         | isStableSource src

-         -> Just (exprLocalFVs rhs)

-      DFunUnfolding { df_bndrs = bndrs, df_args = args }

-         -> Just (filterFV isLocalVar $ FV.delFVs (mkVarSet bndrs) $ exprsFVs args)

-            -- DFuns are top level, so no fvs from types of bndrs

-      _other -> Nothing

-

-import GHC.Builtin.Types.Prim

-       ; checkL ( isJoinId binder

-               || mightBeLiftedType binder_ty

-               || (isNonRec rec_flag && exprOkForSpeculation rhs)

-               || isDataConWorkId binder || isDataConWrapId binder -- until #17521 is fixed

-               || exprIsTickedString rhs)

-           (badBndrTyMsg binder (text "unlifted"))

-

-        -- Check that if the binder is at the top level and has type Addr#,

-        -- that it is a string literal.

-       ; checkL (not (isTopLevel top_lvl && binder_ty `eqType` addrPrimTy)

-                 || exprIsTickedString rhs)

-           (mkTopNonLitStrMsg binder)

-        ; lintTyCoBndr tv              $ \ tv' ->

-  | isTyCoVar var = lintTyCoBndr var linterF

-  | otherwise     = lintIdBndr NotTopLevel site var linterF

-lintTyCoBndr :: HasDebugCallStack => TyCoVar -> (OutTyCoVar -> LintM a) -> LintM a

-lintTyCoBndr tcv thing_inside

-         -- See (FORALL1) and (FORALL2) in GHC.Core.Type

-       ; if (isTyVar tcv)

-         then -- Check that in (forall (a:ki). blah) we have ki:Type

-              lintL (isLiftedTypeKind tcv_kind') $

-         else -- Check that in (forall (cv::ty). blah),

-              -- then ty looks like (t1 ~# t2)

-              lintL (isCoVarType tcv_type') $

-              text "CoVar with non-coercion type:" <+> pprTyVar tcv

-       -- Check that the Id does not have type (t1 ~# t2) or (t1 ~R# t2);

-       -- if so, it should be a CoVar, and checked by lintCoVarBndr

-       ; lintL (not (isCoVarType id_ty))

-               (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr id_ty)

-                (text "Lambda binder with value or OtherCon unfolding.")

-       ; addInScopeId id out_ty thing_inside }

-              | otherwise   = unitLetFloat (Rec (flattenBinds (fromOL bs)))

-              | otherwise   = unitJoinFloat (Rec (flattenBinds (fromOL jbs)))

-                       ; pprTrace "prepareRhs" (ppr rhs0 $$ text "new" <+> ppr rhs) $

-                         return (flts, rhs) }

-    -- We can't use exprIsExpandable because the WHOLE POINT is that

-    -- we want to treat (K <big>) as expandable, because we are just

-    -- about "anfise" the <big> expression.  exprIsExpandable would

-    -- just say no!

-         go (Var fun) n_val_args       = pprTrace "is_exp" (ppr fun <+> ppr n_val_args $$ ppr (isExpandableApp fun n_val_args)) $

-                                         isExpandableApp fun n_val_args

-  = assert (notNull body_floats) $

-    do  { let sccs = concatMap to_sccs body_floats

-        typeSize, typesSize, coercionSize,

-import Data.Coerce

-        exprIsTopLevelBindable,

-                      (\ r co -> pprTrace "exprIsTrivial" (ppr (coercionIsSmall co) $$ ppr co) $

-                                 r && coercionIsSmall co)  -- Casts

-                                panic panic panic panic e

-                    fia_is_triv=is_triv, fia_is_string=is_string,

-      -- the top-level

-    check_linearity = gopt Opt_DoLinearCoreLinting dflags || (

-                        case pass of

-                          _ -> False)

-import Control.Monad

-bndrFvsInOrder show_unfold id

-  = run (dffvLetBndr show_unfold id)

-

-run :: DFFV () -> [Id]

-run (DFFV m) = case m emptyVarSet (emptyVarSet, []) of

-                 ((_,ids),_) -> ids

-

-newtype DFFV a

-  = DFFV (VarSet              -- Envt: non-top-level things that are in scope

-                              -- we don't want to record these as free vars

-      -> (VarSet, [Var])      -- Input State: (set, list) of free vars so far

-      -> ((VarSet,[Var]),a))  -- Output state

-    deriving (Functor)

-

-instance Applicative DFFV where

-    pure a = DFFV $ \_ st -> (st, a)

-    (<*>) = ap

-

-instance Monad DFFV where

-  (DFFV m) >>= k = DFFV $ \env st ->

-    case m env st of

-       (st',a) -> case k a of

-                     DFFV f -> f env st'

-

-extendScope :: Var -> DFFV a -> DFFV a

-extendScope v (DFFV f) = DFFV (\env st -> f (extendVarSet env v) st)

-

-extendScopeList :: [Var] -> DFFV a -> DFFV a

-extendScopeList vs (DFFV f) = DFFV (\env st -> f (extendVarSetList env vs) st)

-

-insert :: Var -> DFFV ()

-insert v = DFFV $ \ env (set, ids) ->

-           let keep_me = isLocalId v &&

-                         not (v `elemVarSet` env) &&

-                           not (v `elemVarSet` set)

-           in if keep_me

-              then ((extendVarSet set v, v:ids), ())

-              else ((set,                ids),   ())

-

-

-dffvExpr :: CoreExpr -> DFFV ()

-dffvExpr (Var v)              = insert v

-dffvExpr (App e1 e2)          = dffvExpr e1 >> dffvExpr e2

-dffvExpr (Lam v e)            = extendScope v (dffvExpr e)

-dffvExpr (Tick (Breakpoint _ _ ids) e) = mapM_ insert ids >> dffvExpr e

-dffvExpr (Tick _other e)    = dffvExpr e

-dffvExpr (Cast e _)           = dffvExpr e

-dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e)

-dffvExpr (Let (Rec prs) e)    = extendScopeList (map fst prs) $

-                                (mapM_ dffvBind prs >> dffvExpr e)

-dffvExpr (Case e b _ as)      = dffvExpr e >> extendScope b (mapM_ dffvAlt as)

-dffvExpr _other               = return ()

-

-dffvAlt :: CoreAlt -> DFFV ()

-dffvAlt (Alt _ xs r) = extendScopeList xs (dffvExpr r)

-

-dffvBind :: (Id, CoreExpr) -> DFFV ()

-dffvBind(x,r)

-  | not (isId x) = dffvExpr r

-  | otherwise    = dffvLetBndr False x >> dffvExpr r

-                -- Pass False because we are doing the RHS right here

-                -- If you say True you'll get *exponential* behaviour!

-

-dffvLetBndr :: Bool -> Id -> DFFV ()

--- Gather the free vars of the RULES and unfolding of a binder

-dffvLetBndr vanilla_unfold id

-  = do { go_unf (realUnfoldingInfo idinfo)

-       ; mapM_ go_rule (ruleInfoRules (ruleInfo idinfo)) }

-    go_unf (CoreUnfolding { uf_tmpl = rhs, uf_src = src })

-       | isStableSource src = dffvExpr rhs

-       | vanilla_unfold     = dffvExpr rhs

-       | otherwise          = return ()

-

-    go_unf (DFunUnfolding { df_bndrs = bndrs, df_args = args })

-             = extendScopeList bndrs $ mapM_ dffvExpr args

-    go_unf _ = return ()

-    go_rule (BuiltinRule {}) = return ()

-    go_rule (Rule { ru_bndrs = bndrs, ru_rhs = rhs })

-      = extendScopeList bndrs (dffvExpr rhs)