# which versions of GHC to allow bootstrap with

 .bootstrap_matrix : &bootstrap_matrix

   matrix:

     - GHC_VERSION: 9.10.1

       DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb12-ghc9_10:$DOCKER_REV"

     - GHC_VERSION: 9.12.2

     mapDynFlagsCoreM, dropSimplCount,

     -- ** Reading from the monad

     initRuleEnv, getExternalRuleBase,

     getDynFlags, getPackageFamInstEnv,

     getInteractiveContext,

 ************************************************************************

 -}

 getHomeRuleBase :: CoreM RuleBase

 getHomeRuleBase = read cr_rule_base

 module GHC.Driver.Env

    ( Hsc(..)

    , HscEnv (..)

    , hsc_mod_graph

    , setModuleGraph

    , hscUpdateFlags

 import GHC.Driver.Errors.Types ( GhcMessage )

 import GHC.Driver.Config.Logger (initLogFlags)

 import GHC.Driver.Config.Diagnostic (initDiagOpts, initPrintConfig)

 import GHC.Runtime.Context

 import GHC.Runtime.Interpreter.Types (Interp)

 module GHC.Driver.Env.Types

   ( Hsc(..)

   , HscEnv(..)

   ) where

 import GHC.Driver.Errors.Types ( GhcMessage )

     deriving (Functor, Applicative, Monad, MonadIO)

       via ReaderT HscEnv (StateT (Messages GhcMessage) IO)

 instance HasDynFlags Hsc where

     getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w)

                 -- ^ LLVM configuration cache.

  }

 logDiagnostics :: Messages GhcMessage -> Hsc ()

 logDiagnostics w = Hsc $ \_ w0 -> return ((), w0 `unionMessages` w)

 handleWarnings :: Hsc ()

 handleWarnings = do

     diag_opts <- initDiagOpts <$> getDynFlags

 import GHC.Iface.Env    ( lookupNameCache )

 import GHC.Prelude

 import GHC.ThToHs       ( thRdrNameGuesses )

 import GHC.Tc.Utils.Env ( lookupGlobal )

 import GHC.Types.Name.Cache ( NameCache )

 -- exactly. Qualified or unqualified TH names will be dynamically bound

 -- to names in the module being compiled, if possible. Exact TH names

 -- will be bound to the name they represent, exactly.

 thNameToGhcName th_name = do

   hsc_env <- getHscEnv

   liftIO $ thNameToGhcNameIO (hsc_NC hsc_env) th_name

 instance HasDynFlags BcM where

     getDynFlags = hsc_dflags <$> getHscEnv

 getProfile :: BcM Profile

 getProfile = targetProfile <$> getDynFlags

 module GHC.Tc.Gen.App

        ( tcApp

        , tcExprPrag ) where

 import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr )

 -}

 {- *********************************************************************

 *                                                                      *

               Typechecking n-ary applications

 A "head" has three special cases (for which we can infer a polytype

 using tcInferAppHead_maybe); otherwise is just any old expression (for

 There is no special treatment for HsHole (HsVar ...), HsOverLit, etc, because

 we can't get a polytype from them.

        -- Step 2: Infer the type of `fun`, the head of the application

        ; (tc_fun, fun_sigma) <- tcInferAppHead fun

        ; let tc_head = (tc_fun, fun_ctxt)

        -- Step 3: Instantiate the function type (taking a quick look at args)

        ; do_ql <- wantQuickLook rn_fun

        ; (inst_args, app_res_rho)

               <- setQLInstLevel do_ql $  -- See (TCAPP1) and (TCAPP2) in

                                          -- Note [tcApp: typechecking applications]

        ; case do_ql of

             NoQL -> do { traceTc "tcApp:NoQL" (ppr rn_fun $$ ppr app_res_rho)

                                                    app_res_rho exp_res_ty

                          -- Step 4.2: typecheck the  arguments

                        ; tc_args <- tcValArgs NoQL inst_args

                          -- Step 4.3: wrap up

                        ; finishApp tc_head tc_args app_res_rho res_wrap }

                          -- Step 5.1: Take a quick look at the result type

                        ; quickLookResultType app_res_rho exp_res_ty

                          -- Step 5.2: typecheck the arguments, and monomorphise

                          --           any un-unified instantiation variables

                        ; tc_args <- tcValArgs DoQL inst_args

                          -- Step 5.3: zonk to expose the polymorphism hidden under

                          --           QuickLook instantiation variables in `app_res_rho`

                        ; app_res_rho <- liftZonkM $ zonkTcType app_res_rho

                          -- Step 5.4: subsumption check against the expected type

                        ; res_wrap <- checkResultTy rn_expr tc_head inst_args

                          -- Step 5.5: wrap up

                        ; finishApp tc_head tc_args app_res_rho res_wrap } }

               -> (HsExpr GhcTc, AppCtxt)  -- Head

               -> [HsExprArg p]            -- Arguments, just error messages

               -> TcRhoType  -- Inferred type of the application; zonked to

               -> ExpRhoType -- Expected type; this is deeply skolemised

               -> TcM HsWrapper

 checkResultTy rn_expr _fun _inst_args app_res_rho (Infer inf_res)

 checkResultTy rn_expr (tc_fun, fun_ctxt) inst_args app_res_rho (Check res_ty)

 -- Unify with expected type from the context

 ********************************************************************* -}

 tcInstFun :: QLFlag

                     --           so may return a sigma-type

                     --    |-inst returns a rho-type

           -> (HsExpr GhcTc, AppCtxt)

           -> TcSigmaType -> [HsExprArg 'TcpRn]

           -> TcM ( [HsExprArg 'TcpInst]

 -- This crucial function implements the |-inst judgement in Fig 4, plus the

 -- modification in Fig 5, of the QL paper:

 -- "A quick look at impredicativity" (ICFP'20).

           _               -> False

     inst_fun :: [HsExprArg 'TcpRn] -> ForAllTyFlag -> Bool

     inst_fun [] | inst_final  = isInvisibleForAllTyFlag

                 | otherwise   = const False

     inst_fun (EValArg {} : _) = isInvisibleForAllTyFlag

     inst_fun _                = isInferredForAllTyFlag

     do  { mult <- newMultiplicityVar

         ; ((co_fn, matches'), rhs_ty')

                  -- a fixed runtime rep. See #23176

                tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $

                  -- We extend the error context even for a non-recursive

   = addErrCtxt (PatMonoBindsCtxt pat grhss) $

     do { mult <- tcMultAnnOnPatBind mult_ann

                           -- a fixed runtime rep. See #23176

                              tcGRHSsPat mult grhss exp_ty

             -- See Note [Typechecking pattern bindings]

         ; ((pat', nosig_mbis), pat_ty)

             <- addErrCtxt (PatMonoBindsCtxt pat grhss) $

                tcLetPat inst_sig_fun no_gen pat (Scaled mult exp_ty) $

                  -- The above inferred type get an unrestricted multiplicity. It may be

                  -- worth it to try and find a finer-grained multiplicity here

        ( tcCheckPolyExpr, tcCheckPolyExprNC,

          tcCheckMonoExpr, tcCheckMonoExprNC,

          tcMonoExpr, tcMonoExprNC,

          tcPolyLExpr, tcPolyExpr, tcExpr, tcPolyLExprSig,

          tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,

          tcCheckId,

 *                                                                      *

 ********************************************************************* -}

 tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)

 -- Infer a *rho*-type. The return type is always instantiated.

     addExprCtxt expr $  -- Note [Error contexts in generated code]

        ; return (L loc expr', rho) }

        ; return (L loc expr', rho) }

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

          ; return (Missing (Scaled mult arg_ty), arg_ty) }

   tc_infer_tup_arg i (Present x lexpr@(L l expr))

     = do { (expr', arg_ty) <- case boxity of

              Boxed   -> do { arg_ty <- newFlexiTyVarTy liftedTypeKind

                            ; L _ expr' <- tcCheckPolyExpr lexpr arg_ty

                            ; return (expr', arg_ty) }

 module GHC.Tc.Gen.Expr where

 import GHC.Hs              ( HsExpr, LHsExpr, SyntaxExprRn

                            , SyntaxExprTc )

                            , ExpType, ExpRhoType, ExpSigmaType )

 import GHC.Tc.Types        ( TcM )

 import GHC.Tc.Types.BasicTypes( TcCompleteSig )

 tcInferRho, tcInferRhoNC ::

           LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)

 tcSyntaxOp :: CtOrigin

            -> SyntaxExprRn

            -> [SyntaxOpType]           -- ^ shape of syntax operator arguments

     do { mb_tc_fun <- tcInferAppHead_maybe fun

        ; case mb_tc_fun of

             Just (fun', fun_sigma) -> return (fun', fun_sigma)

 tcInferAppHead_maybe :: HsExpr GhcRn

                      -> TcM (Maybe (HsExpr GhcTc, TcSigmaType))

 -- | Infer the kind of a type and desugar. This is the "up" type-checker,

 -- as described in Note [Bidirectional type checking]

 tc_infer_hs_type :: TcTyMode -> HsType GhcRn -> TcM (TcType, TcKind)

 tc_infer_hs_type mode rn_ty

 {-

 Note [Typechecking HsCoreTys]

 checkExpKind _rn_ty ty ki (Infer cell) = do

   -- NB: do not instantiate.

   -- See Note [Do not always instantiate eagerly in types]

   pure (ty `mkCastTy` co)

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

         ; tcExtendIdEnv tup_ids $ do

         { ((stmts', (ret_op', tup_rets)), stmts_ty)

                    tcStmtsAndThen ctxt tcDoStmt stmts exp_ty $ \ inner_res_ty ->

                    do { tup_rets <- zipWithM tcCheckId tup_names

                                       (map mkCheckExpType tup_elt_tys)

                       ; return (ret_op', tup_rets) }

         ; ((_, mfix_op'), mfix_res_ty)

                tcSyntaxOp DoOrigin mfix_op

                           [synKnownType (mkVisFunTyMany tup_ty stmts_ty)] exp_ty $

                \ _ _ -> return ()

 tcApplicativeStmts ctxt pairs rhs_ty thing_inside

  = do { body_ty <- newFlexiTyVarTy liftedTypeKind

       ; let arity = length pairs

       ; exp_tys <- replicateM arity $ newFlexiTyVarTy liftedTypeKind

       ; pat_tys <- replicateM arity $ newFlexiTyVarTy liftedTypeKind

       ; let fun_ty = mkVisFunTysMany pat_tys body_ty

 import GHC.Prelude

 import GHC.Hs

 import GHC.Hs.Syn.Type

            -> TcM a

            -> TcM ((LPat GhcTc, a), TcSigmaTypeFRR)

 tcInferPat frr_orig ctxt pat thing_inside

     tc_lpat (unrestricted exp_ty) penv pat thing_inside

  where

     penv = PE { pe_lazy = False, pe_ctxt = LamPat ctxt, pe_orig = PatOrigin }

          -- restriction need to be put in place, if any, for linear view

          -- patterns to desugar to type-correct Core.

          -- Expression must be a function

         ; let herald = ExpectedFunTyViewPat $ unLoc expr

         ; (expr_wrap1, Scaled _mult inf_arg_ty, inf_res_sigma)

                -- See Note [View patterns and polymorphism]

          -- Check that overall pattern is more polymorphic than arg type

         ; expr_wrap2 <- tc_sub_type penv (scaledThing pat_ty) inf_arg_ty

         ; pat_ty <- readExpType h_pat_ty

         ; let expr_wrap2' = mkWpFun expr_wrap2 idHsWrapper

                               (Scaled w pat_ty) inf_res_sigma

               expr_wrap = expr_wrap2' <.> expr_wrap1

         ; return $ (ViewPat pat_ty (mkLHsWrap expr_wrap expr') pat', res) }

 {- Note [View patterns and polymorphism]

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

    pair :: forall a. Bool -> a -> forall b. b -> (a,b)

    f :: Int -> blah

 The expression (pair True) should have type

     pair True :: Int -> forall b. b -> (Int,b)

 so that it is ready to consume the incoming Int. It should be an

 Then, when taking that arrow apart we want to get a *sigma* type

 (forall b. b->(Int,b)), because that's what we want to bind 'x' to.

 Fortunately that's what matchActualFunTy returns anyway.

 -}

 -- Type signatures in patterns

                                      penv pats thing_inside

         ; pat_ty <- readExpType (scaledThing pat_ty)

         ; return (mkHsWrapPat coi

   TuplePat _ pats boxity -> do

         { let arity = length pats

 import GHC.Tc.Utils.Unify( checkConstraints, tcSubTypeSigma )

 import GHC.Tc.Zonk.Type

 import GHC.Tc.Gen.Expr

 import GHC.Tc.Utils.Monad

 import GHC.Tc.Gen.Export

 import GHC.Tc.Types.Evidence

     failIfErrsM ;

     -- Typecheck the expression

           <- captureTopConstraints $

              pushTcLevelM          $

     -- Generalise

     uniq <- newUnique ;

   -- Expected types

   ExpType(..), ExpSigmaType, ExpRhoType,

   mkCheckExpType, newInferExpType, newInferExpTypeFRR,

   readExpType, readExpType_maybe, readScaledExpType,

   expTypeToType, scaledExpTypeToType,

   checkingExpType_maybe, checkingExpType,

 -- actual data definition is in GHC.Tc.Utils.TcType

   = do { th_lvl <- getThLevel

   = do { u <- newUnique

        ; tclvl <- getTcLevel

        ; traceTc "newInferExpType" (ppr u <+> ppr tclvl)

        ; ref <- newMutVar Nothing

        ; return (Infer (IR { ir_uniq = u, ir_lvl = tclvl

 -- | Extract a type out of an ExpType, if one exists. But one should always

 -- exist. Unless you're quite sure you know what you're doing.

   where

     -- See Note [TcLevel of ExpType]

     new_meta = case mb_frr of

                       ; newMetaTyVarTyAtLevel tc_lvl (mkTYPEapp rr) }

 {- Note [inferResultToType]

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

 -- | Infer a type using a fresh ExpType

 -- See also Note [ExpType] in "GHC.Tc.Utils.TcMType"

 --

 -- runtime representation.

 -- has a syntactically fixed RuntimeRep as per Note [Fixed RuntimeRep] in

 -- GHC.Tc.Utils.Concrete.

        ; result <- tc_check res_ty

        ; res_ty <- readExpType res_ty

        ; return (result, res_ty) }

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

   -- Types

   TcType, TcSigmaType, TcTypeFRR, TcSigmaTypeFRR,

   TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,

   TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcInvisTVBinder, TcReqTVBinder,

   TcTyCon, MonoTcTyCon, PolyTcTyCon, TcTyConBinder, KnotTied,

   ExpTypeFRR, ExpSigmaType, ExpSigmaTypeFRR,

   mkCheckExpType,

   checkingExpType_maybe, checkingExpType,

 -- See Note [Return arguments with a fixed RuntimeRep.

 type TcSigmaTypeFRR = TcSigmaType

     -- TODO: consider making this a newtype.

 type TcRhoType      = TcType  -- Note [TcRhoType]

 type TcTauType      = TcType

        , ir_lvl  :: TcLevel

          -- ^ See Note [TcLevel of ExpType] in GHC.Tc.Utils.TcMType

          -- ^ See Note [FixedRuntimeRep context in ExpType] in GHC.Tc.Utils.TcMType

        , ir_ref  :: IORef (Maybe TcType) }

          -- ^ The type that fills in this hole should be a @Type@,

          -- that is, its kind should be @TYPE rr@ for some @rr :: RuntimeRep@.

          -- @rr@ must be concrete, in the sense of Note [Concrete types]

          -- in GHC.Tc.Utils.Concrete.

 -- | An 'ExpType' which has a fixed RuntimeRep.

 --

 -- For a 'Check' 'ExpType', the stored 'TcType' must have

 -- a fixed RuntimeRep. For an 'Infer' 'ExpType', the 'ir_frr'

 -- | Like 'TcSigmaTypeFRR', but for an expected type.

 --

 -- See 'ExpTypeFRR'.

 type ExpSigmaTypeFRR = ExpTypeFRR

   -- TODO: consider making this a newtype.

 -- | Like 'ExpType', but on kind level

 type ExpKind = ExpType