-- see Note [Target code interpreter]

   interp <- if

     -- Wasm dynamic linker

     | ArchWasm32 <- platformArch $ targetPlatform dflags

     -> do

         s <- liftIO $ newMVar InterpPending

         loader <- liftIO Loader.uninitializedLoader

         dyld <- liftIO $ makeAbsolute $ topDir dflags </> "dyld.mjs"

         libdir <- liftIO $ last <$> Loader.getGccSearchDirectory logger dflags "libraries"

         let profiled = ways dflags `hasWay` WayProf

             way_tag = if profiled then "_p" else ""

         let cfg =

                   wasmInterpUnitState = ue_homeUnitState $ hsc_unit_env hsc_env

                 }

         pure $ Just $ Interp (ExternalInterp $ ExtWasm $ ExtInterpState cfg s) loader lookup_cache

     -- JavaScript interpreter

     | ArchJavaScript <- platformArch (targetPlatform dflags)

   ( fsLit "PROF_HEADER_CREATE",     \[e] -> profHeaderCreate e ),

   ( fsLit "PUSH_UPD_FRAME",        \[sp,e] -> emitPushUpdateFrame sp e ),

   ( fsLit "SET_HDR",               \[ptr,info,ccs] ->

                                         emitSetDynHdr ptr info ccs ),

   ( fsLit "TICK_ALLOC_PRIM",       \[hdr,goods,slop] ->

 emitPushUpdateFrame sp e = do

   emitUpdateFrame sp mkUpdInfoLabel e

 pushStackFrame :: [CmmParse CmmExpr] -> CmmParse () -> CmmParse ()

 pushStackFrame fields body = do

   profile <- getProfile

 (ATF3) What about foralls?   For example, supppose we are unifying

            (forall a. F a) -> (forall a. F a)

    So to keep things simple, the entire family-substitution machinery is used

    `uSatFamApp`).  That's fine, because the apartness business is used only for

    reducing type-family applications, and class instances, and their arguments

    can't have foralls anyway.

           instance (Generic1 f, Ord (Rep1 f a))

                 => Ord (Generically1 f a) where ...

               -- The "..." gives rise to [W] Ord (Generically1 f a)

    We must use the instance decl (recursively) to simplify the [W] constraint;

    we do /not/ want to worry that the `[G] Ord (Rep1 f a)` might be an

    alternative path.  So `noMatchableGivenDicts` must return False;

    `DontBindMe`, the unifier must return `SurelyApart`, not `MaybeApart`.  See

    `go` in `uVarOrFam`

 (ATF6) When /matching/ can we ever have a type-family application on the LHS, in

    the template?  You might think not, because type-class-instance and

    type-family-instance heads can't include type families.  E.g.

    But you'd be wrong: even when matching, we can see type families in the LHS template:

    * In `checkValidClass`, in `check_dm` we check that the default method has the

       right type, using matching, both ways.  And that type may have type-family

    * In the specialiser: see the call to `tcMatchTy` in

      `GHC.Core.Opt.Specialise.beats_or_same`

          RULE forall a (d :: Eq (Maybe (F a))) .

                  f @(Maybe (F a)) d = ...

      See #25965.

     type variables/ that makes the match work.  So we simply want to recurse into

     the arguments of the type family.  E.g.

        Template:   forall a.  Maybe (F a)

     We want to succeed with substitution [a :-> Int].  See (ATF9).

     Conclusion: where we enter via `tcMatchTy`, `tcMatchTys`, `tc_match_tys`,

       type family G6 a = r | r -> a

       type instance G6 [a]  = [G a]

       type instance G6 Bool = Int

       [W] G6 alpha ~ [Int]

         Template: [G a]    Target: [Int]

    and we want to succeed with MaybeApart, so that we can generate the improvement

    constraint

 (ATF9) Decomposition.  Consider unifying

           F a  ~  F Int

           F Int ~ F Bool

 (ATF10) Injectivity.  Consider (AFT9) where F is known to be injective.  Then if we

   are unifying

 --           , text "fam_env" <+> ppr (um_fam_env substs) ]) $

        ; go NotSwapped substs ty1 ty2 kco }

   where

     -- `go` takes two bites at the cherry; if the first one fails

     -- it swaps the arguments and tries again; and then it fails.

     -- The SwapFlag argument tells `go` whether it is on the first

                         | otherwise

                         = False

         occurs_check = um_unif env && uOccursCheck substs foralld_tvs lhs rhs

           -- Occurs check, only when unifying

           -- see Note [Infinitary substitutions]

     -- LHS is a saturated type-family application

     -- Invariant: ty2 is not a TyVarTy

     go swapped substs lhs@(TyFamLHS tc1 tys1) ty2 kco

       -- Check if we have an existing substitution for the LHS; if so, recurse

       = if | um_unif env                          -> unify_ty env ty1' ty2 kco

            -- Below here we are matching

            -- The return () case deals with:

            | otherwise                            -> maybeApart MARTypeFamily

       -- Check for equality  F tys1 ~ F tys2

       | Just (tc2, tys2) <- isSatTyFamApp ty2

       , tc1 == tc2

       = go_fam_fam substs tc1 tys1 tys2 kco

       -- Now check if we can bind the (F tys) to the RHS

       -- This can happen even when matching: see (ATF7)

       | BindMe <- um_bind_fam_fun env tc1 tys1 rhs

       = if uOccursCheck substs emptyVarSet lhs rhs

       -- Maybe um_bind_fam_fun is False of (F a b) but true of (G c d e)

       -- NB: a type family can appear on the template when matching

       --     see (ATF6) in Note [Apartness and type families]

       | um_unif env

       , NotSwapped <- swapped

       , Just lhs2 <- canEqLHS_maybe ty2

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

     -- go_fam_fam: LHS and RHS are both saturated type-family applications,

     --             for the same type-family F

     go_fam_fam substs tc tys1 tys2 kco

        -- Decompose (F tys1 ~ F tys2): (ATF9)

        -- Use injectivity information of F: (ATF10)

       = do { bind_fam_if_poss                 -- (ATF11)

            ; unify_tys env inj_tys1 inj_tys2  -- (ATF10)

            ; unless (um_inj_tf env) $         -- (ATF12)

              unify_tys env noninj_tys1 noninj_tys2 }

      where

        inj = case tyConInjectivityInfo tc of

        bind_fam_if_poss

          | not (um_unif env)  -- Not when matching (ATF11-1)

          = return ()

          | BindMe <- um_bind_fam_fun env tc tys1 rhs1

          = unless (uOccursCheck substs emptyVarSet (TyFamLHS tc tys1) rhs1) $

            extendFamEnv tc tys1 rhs1

     , dumpIfaceStats

     , ioMsgMaybe

     , showModuleIndex

     , writeInterfaceOnlyMode

     , loadByteCode

     , genModDetails

     let src_span = srcLocSpan interactiveSrcLoc

     _ <- liftIO $ loadDecls interp hsc_env src_span linkable

     let tcs = filterOut isImplicitTyCon (mg_tcs simpl_mg)

         patsyns = mg_patsyns simpl_mg

                                                 fam_insts defaults fix_env

     return (new_tythings, new_ictxt)

 {-

   Note [Fixity declarations in GHCi]

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

 import GHC.Runtime.Interpreter

 import qualified GHC.Linker.Loader as Linker

 import GHC.Driver.Config.Diagnostic

 import GHC.Driver.Pipeline

 import GHC.Driver.Downsweep

 import GHC.Driver.MakeAction

 import GHC.Iface.Load      ( cannotFindModule, readIface )

 import GHC.IfaceToCore     ( typecheckIface )

 import GHC.Iface.Recomp    ( RecompileRequired(..), CompileReason(..) )

 upsweep_mod hsc_env mHscMessage old_hmi summary mod_index nmods =  do

   hmi <- compileOne' mHscMessage hsc_env summary

           mod_index nmods (hm_iface <$> old_hmi) (maybe emptyHomeModInfoLinkable hm_linkable old_hmi)

   hscInsertHPT hmi hsc_env

   return hmi

 -- Note [When source is considered modified]

 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

   -- only supports dynamic code

  | LinkInMemory <- ghcLink dflags

  , sTargetRTSLinkerOnlySupportsSharedLibs $ settings dflags

  , not (ways dflags `hasWay` WayDyn && gopt Opt_ExternalInterpreter dflags)

     = flip loopNoWarn "Forcing dynamic way because target RTS linker only supports dynamic code" $

         setGeneralFlag' Opt_ExternalInterpreter $

         addWay' WayDyn dflags

  | LinkInMemory <- ghcLink dflags

 * If we are compiling for the byte-code interpreter, we instead explicitly add

   the SPT entries (recorded in CgGuts' cg_spt_entries field) to the interpreter

   process' SPT table using the addSptEntry interpreter message. This happens

 -}

 import GHC.Prelude

           let ce2  = extendClosureEnv (closure_env le2) nms_fhvs

               !pls2 = pls { linker_env = le2 { closure_env = ce2 }

                           , linked_breaks = lb2 }

           return (pls2, (nms_fhvs, links_needed, units_needed))

   where

     cbcs = linkableBCOs linkable

         -- Wrap finalizers on the ones we want to keep

         new_binds <- makeForeignNamedHValueRefs interp to_add

         let ce2 = extendClosureEnv (closure_env le2) new_binds

         return $! pls1 { linker_env = le2 { closure_env = ce2 }

                        , linked_breaks = lb2 }

 -- Link a bunch of BCOs and return references to their values

 linkSomeBCOs :: Interp

              -> PkgsLoaded

 -- which dominate a large percentage of startup time on Windows.

 getGccSearchDirectory :: Logger -> DynFlags -> String -> IO [FilePath]

 getGccSearchDirectory logger dflags key = do

     cache <- readIORef gccSearchDirCache

     case lookup key cache of

       Just x  -> return x

                               x:_ -> case break (=='=') x of

                                      (_ , [])    -> []

                                      (_, (_:xs)) -> xs

 -- | Get a list of system search directories, this to alleviate pressure on

 -- the findSysDll function.

 data WasmInterpConfig = WasmInterpConfig

   { wasmInterpDyLD           :: !FilePath  -- ^ Location of dyld.mjs script

   , wasmInterpOpts           :: ![String]  -- ^ Additional command line arguments for iserv

   -- wasm ghci browser mode

 -- | The arguments in a Haskell98-style data constructor.

 type HsConDeclH98Details pass

    = HsConDetails (HsConDeclField pass) (XRec pass [LHsConDeclRecField pass])

 -- | The arguments in a GADT constructor. Unlike Haskell98-style constructors,

 -- GADT constructors cannot be declared with infix syntax. As a result, we do

 AC_SUBST([CmmCPPArgs])

 AC_SUBST([CmmCPPSupportsG0])

 dnl ** Do we have a compatible emsdk version?

 dnl --------------------------------------------------------------

 EMSDK_VERSION("3.1.20", "", "")

 AC_SUBST([CmmCPPArgs])

 AC_SUBST([CmmCPPSupportsG0])

 dnl ** Which ld to use?

 dnl --------------------------------------------------------------

 FIND_LD([$target],[GccUseLdOpt])

             ]

           , builder (Cabal Flags) ? mconcat

             , orM [ notM cross, haveCurses ]  `cabalFlag` "terminfo"

             , arg "-build-tool-depends"

             , flag UseLibzstd `cabalFlag` "with-libzstd"

   js_lookupSymbol :: JSString -> IO (Ptr a)

 lookupSymbolInDLL :: Ptr LoadedDLL -> String -> IO (Maybe (Ptr a))

 resolveObjs :: IO Bool

 resolveObjs = pure True

   AC_MSG_RESULT([no])

 fi

 $2="$CMM_CPP_CMD"

 $3="$$3 $CMM_CPP_ARGS"

 unset CMM_CPP_ARGS

 ])

   /* ensure there is at least AP_STACK_SPLIM words of headroom available

    * after unpacking the AP_STACK. See bug #1466 */

   Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);

   TICK_ENT_AP();

 #include "RaiseAsync.h"

 #include "Trace.h"

 #include "Threads.h"

 #include "sm/NonMovingMark.h"

 #include <string.h> // for memmove()

                 continue;

             }

 #if defined(THREADED_RTS)

 #if defined(PROF_SPIN)

 #endif

 #endif

                 }

             frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);

             if (prev_was_update_frame) {

   extra_hc_opts('-L. -lT26430B')]

 , compile_and_run, ['']

 )

 test('T26358', expect_broken(26358), compile, [''])

 test('T26345', normal, compile, [''])

 test('T26376', normal, compile, [''])

     , compileC

     , compileAsm

     , addPlatformDepCcFlags

     ) where

 import Control.Monad

     cc1 <- ignoreUnusedArgs cc0

     cc2 <- ccSupportsTarget archOs llvmTarget cc1

     checking "whether Cc works" $ checkCcWorks cc2

 checkCcWorks :: Cc -> M ()

 checkCcWorks cc = withTempDir $ \dir -> do

     checking "whether Cc supports --target" $

     supportsTarget archOs _ccProgram checkCcWorks target cc

 checkCcSupportsExtraViaCFlags :: Cc -> M ()

 checkCcSupportsExtraViaCFlags cc = checking "whether cc supports extra via-c flags" $ withTempDir $ \dir -> do

   let test_o = dir </> "test.o"

 import GHC.Toolchain.Program

 import GHC.Toolchain.Tools.Cc

 newtype Cpp = Cpp { cppProgram :: Program

                     }

 findCmmCpp :: ProgOpt -> Cc -> M CmmCpp

 findCmmCpp progOpt cc = checking "for a Cmm preprocessor" $ do

   -- Use the specified CPP or try to use the c compiler

   cmmCppSupportsG0 <- withTempDir $ \dir -> do

     let conftest = dir </> "conftest.c"

     writeFile conftest "int main(void) {}"

 findCpp :: ProgOpt -> Cc -> M Cpp

 findCpp progOpt cc = checking "for C preprocessor" $ do

   -- Use the specified CPP or try to use the c compiler

   -- Always add the -E flag to the CPP, regardless of the user options

   return Cpp{cppProgram}

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