Simon Peyton Jones pushed to branch wip/spj-reinstallable-base2 at Glasgow Haskell Compiler / GHC Commits: 2239f43c by Simon Peyton Jones at 2026-04-15T12:03:41+01:00 Fix knot-vars problem ..I hope! - - - - - 8 changed files: - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs Changes: ===================================== compiler/GHC/Driver/Env.hs ===================================== @@ -178,16 +178,16 @@ configured via command-line flags (in `GHC.setTopSessionDynFlags`). -- Note [hsc_type_env_var hack] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- hsc_type_env_var is used to initialize tcg_type_env_var, and +-- hsc_type_env_var is used to initialize tcg_knot_vars, and -- eventually it is the mutable variable that is queried from -- if_rec_types to get a TypeEnv. So, clearly, it's something -- related to knot-tying (see Note [Tying the knot]). -- hsc_type_env_var is used in two places: initTcRn (where --- it initializes tcg_type_env_var) and initIfaceCheck +-- it initializes tcg_knot_vars) and initIfaceCheck -- (where it initializes if_rec_types). -- -- But why do we need a way to feed a mutable variable in? Why --- can't we just initialize tcg_type_env_var when we start +-- can't we just initialize tcg_knot_vars when we start -- typechecking? The problem is we need to knot-tie the -- EPS, and we may start adding things to the EPS before type -- checking starts. ===================================== compiler/GHC/Driver/Env/Types.hs ===================================== @@ -83,8 +83,8 @@ data HscEnv hsc_type_env_vars :: KnotVars (IORef TypeEnv) -- ^ Used for one-shot compilation only, to initialise - -- the 'IfGblEnv'. See 'GHC.Tc.Utils.tcg_type_env_var' for - -- 'GHC.Tc.Utils.TcGblEnv'. See also Note [hsc_type_env_var hack] + -- the 'IfGblEnv'. See 'tcg_knot_vars' in 'GHC.Tc.Utils.TcGblEnv'. + -- See also Note [hsc_type_env_var hack] , hsc_interp :: Maybe Interp -- ^ target code interpreter (if any) to use for TH and GHCi. ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -731,7 +731,7 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do mg <- downsweepThunk hsc_env mod_summary -- Need to set the knot-tying mutable variable for interface - -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var. + -- files. See GHC.Tc.Utils.TcGblEnv.tcg_knot_vars -- See also Note [hsc_type_env_var hack] type_env_var <- newIORef emptyNameEnv let hsc_env' = ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -332,13 +332,17 @@ tcRnModuleTcRnM hsc_env mod_sum ; whenM (goptM Opt_DoCoreLinting) $ lintGblEnv (hsc_logger hsc_env) (hsc_dflags hsc_env) tcg_env + -- Sync the knot-tied type environment before checking + -- the M.hi-boot interface, if any + ; syncTypeEnvKnotVars tcg_env + ; setGblEnv tcg_env $ do { -- Compare hi-boot iface (if any) with the real thing -- Must be done after processing the exports tcg_env <- checkHiBootIface tcg_env boot_info ; -- The new type env is already available to stuff - -- slurped from interface files, via - -- GHC.Tc.Utils.Env.setGlobalTypeEnv. It's important that this + -- slurped from interface files, via syncTypeEnvKnotVars, + -- itself called by tcRnSrcDecls. It's important that this -- includes the stuff in checkHiBootIface, -- because the latter might add new bindings for -- boot_dfuns, which may be mentioned in imported @@ -570,6 +574,11 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls ; ev_binds <- simplifyTop (lie `andWC` lie_main) ; return (tcg_env `addEvBinds` ev_binds) } + -- Update the knot-tied type environment to include everything + -- bound in this module. Do this now because when compiling GHC.Internal.Types, + -- mkTypeableBinds needs to "see" the definition of `Module` + ; syncTypeEnvKnotVars tcg_env + -- Emit Typeable bindings ; tcg_env <- setGblEnv tcg_env $ mkTypeableBinds @@ -643,15 +652,15 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls -- to the previous tcg_env ; tcg_env' = tcg_env - { tcg_binds = binds' ++ binds_mf + { tcg_type_env = final_type_env + , tcg_binds = binds' ++ binds_mf , tcg_ev_binds = ev_binds' `unionBags` ev_binds_mf , tcg_imp_specs = imp_specs' ++ imp_specs_mf , tcg_rules = rules' ++ rules_mf , tcg_fords = fords' ++ fords_mf , tcg_patsyns = pat_syns' ++ patsyns_mf } } ; - ; setGlobalTypeEnv tcg_env' final_type_env - } + ; return tcg_env' } zonkTcGblEnv :: TcGblEnv -> TcM (TypeEnv, Bag EvBind, LHsBinds GhcTc, @@ -834,10 +843,11 @@ tcRnHsBootDecls boot_or_sig decls ; let { type_env0 = tcg_type_env gbl_env ; type_env1 = extendTypeEnvWithIds type_env0 val_ids ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids - ; dfun_ids = map iDFunId inst_infos + ; dfun_ids = map iDFunId inst_infos + ; gbl_env' = gbl_env { tcg_type_env = type_env2 } } - ; setGlobalTypeEnv gbl_env type_env2 + ; return gbl_env' }}} ; traceTc "boot" (ppr lie); return gbl_env } @@ -875,20 +885,14 @@ checkHiBootIface tcg_env boot_info -- -- to (a) the type envt, and (b) the top-level bindings ; let boot_impedance_bds = map fst imp_prs - type_env' = extendTypeEnvWithIds local_type_env boot_impedance_bds + !type_env' = extendTypeEnvWithIds local_type_env boot_impedance_bds impedance_binds = [ mkVarBind boot_id (nlHsVar id) | (boot_id, id) <- imp_prs ] tcg_env_w_binds - = tcg_env { tcg_binds = binds ++ impedance_binds } + = tcg_env { tcg_type_env = type_env' + , tcg_binds = binds ++ impedance_binds } - ; type_env' `seq` - -- Why the seq? Without, we will put a TypeEnv thunk in - -- tcg_type_env_var. That thunk will eventually get - -- forced if we are typechecking interfaces, but that - -- is no good if we are trying to typecheck the very - -- DFun we were going to put in. - -- TODO: Maybe setGlobalTypeEnv should be strict. - setGlobalTypeEnv tcg_env_w_binds type_env' } + ; return tcg_env_w_binds } {- Note [DFun impedance matching] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -978,7 +982,7 @@ This most works well, but there is one problem: DFuns! We do not want to look at the mb_insts of the ModDetails in SelfBootInfo, because a dfun in one of those ClsInsts is gotten (in GHC.IfaceToCore.tcIfaceInst) by a (lazily evaluated) lookup in the if_rec_types. We could extend the -type env, do a setGloblaTypeEnv etc; but that all seems very indirect. +type env, do a syncTypeEnvKnotVars etc; but that all seems very indirect. It is much more directly simply to extract the DFunIds from the md_types of the SelfBootInfo. ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -487,7 +487,7 @@ data TcGblEnv -- NB: for what "things in this module" means, see -- Note [The interactive package] in "GHC.Runtime.Context" - tcg_type_env_var :: KnotVars (IORef TypeEnv), + tcg_knot_vars :: KnotVars (IORef TypeEnv), -- Used only to initialise the interface-file -- typechecker in initIfaceTcRn, so that it can see stuff -- bound in this module when dealing with hi-boot recursions ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -739,7 +739,7 @@ mergeSignatures , rdr_elt <- lookupGRE rdr_env (LookupOccName occ AllRelevantGREs) ] -- STEP 5: Typecheck the interfaces - let type_env_var = tcg_type_env_var tcg_env + let knot_type_env = tcg_knot_vars tcg_env -- typecheckIfacesForMerging does two things: -- 1. It merges the all of the ifaces together, and typechecks the @@ -748,7 +748,7 @@ mergeSignatures -- resolving to the merged type_env from (1). -- See typecheckIfacesForMerging for more details. (type_env, detailss) <- initIfaceTcRn $ - typecheckIfacesForMerging inner_mod ifaces type_env_var + typecheckIfacesForMerging inner_mod ifaces knot_type_env let infos = zip ifaces detailss -- Test for cycles @@ -764,7 +764,7 @@ mergeSignatures -- NB: Why do we set tcg_tcs/tcg_patsyns/tcg_type_env directly, -- rather than use tcExtendGlobalEnv (the normal method to add newly -- defined types to TcGblEnv?) tcExtendGlobalEnv adds these - -- TyThings to 'tcg_type_env_var', which is consulted when + -- TyThings to 'tcg_knot_vars', which is consulted when -- we read in interfaces to tie the knot. But *these TyThings themselves -- come from interface*, so that would result in deadlock. Don't -- update it! ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -16,7 +16,7 @@ module GHC.Tc.Utils.Env( -- Global environment tcExtendGlobalEnv, tcExtendTyConEnv, - tcExtendGlobalEnvImplicit, setGlobalTypeEnv, + tcExtendGlobalEnvImplicit, syncTypeEnvKnotVars, tcExtendGlobalValEnv, tcTyThBinders, tcLookupLocatedGlobal, tcLookupGlobal, tcLookupGlobalOnly, tcLookupTyCon, tcLookupClass, @@ -606,16 +606,21 @@ get_id do_the_lookup ************************************************************************ -} -setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv --- Use this to update the global type env --- It updates both * the normal tcg_type_env field --- * the tcg_type_env_var field seen by interface files -setGlobalTypeEnv tcg_env new_type_env - = do { -- Sync the type-envt variable seen by interface files - ; case lookupKnotVars (tcg_type_env_var tcg_env) (tcg_mod tcg_env) of - Just tcg_env_var -> writeMutVar tcg_env_var new_type_env - Nothing -> return () - ; return (tcg_env { tcg_type_env = new_type_env }) } +syncTypeEnvKnotVars :: TcGblEnv -> TcM () +-- Use this to sync the tcg_knot_vars with the current type env +-- so that interface-file and known-key/occ lookups will find the +-- current bindings +-- +-- Why the "!" before writing it into the variable? Without, we will put +-- a TypeEnv thunk into the knot-tied variable. That thunk will eventually get +-- forced if we are typechecking interfaces, but that is no good if we are +-- trying to typecheck the very DFun we were going to put in. +syncTypeEnvKnotVars tcg_env + = case lookupKnotVars (tcg_knot_vars tcg_env) (tcg_mod tcg_env) of + Just tcg_env_var -> do { let !type_env = tcg_type_env tcg_env + -- Why the "!"? See comment on the function + ; writeMutVar tcg_env_var type_env } + Nothing -> return () tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r @@ -623,8 +628,9 @@ tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r -- Do not extend tcg_tcs, tcg_patsyns etc tcExtendGlobalEnvImplicit things thing_inside = do { tcg_env <- getGblEnv - ; let ge' = extendTypeEnvList (tcg_type_env tcg_env) things - ; tcg_env' <- setGlobalTypeEnv tcg_env ge' + ; let !type_env' = extendTypeEnvList (tcg_type_env tcg_env) things + tcg_env' = tcg_env { tcg_type_env = type_env' } + ; syncTypeEnvKnotVars tcg_env' ; setGblEnv tcg_env' thing_inside } tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r @@ -677,8 +683,8 @@ tcExtendRecEnv gbl_stuff thing_inside = do { tcg_env <- getGblEnv ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff tcg_env' = tcg_env { tcg_type_env = ge' } - -- No need for setGlobalTypeEnv (which side-effects the - -- tcg_type_env_var); tcExtendRecEnv is used just + -- No need for syncTypeEnvKnotVars (which side-effects the + -- tcg_knot_vars); tcExtendRecEnv is used just -- when kind-check a group of type/class decls. It would -- in any case be wrong for an interface-file decl to end up -- with a TcTyCon in it! ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -353,7 +353,7 @@ initTcGblEnv hsc_env hsc_src keep_rn_syntax mod loc = , tcg_default = emptyDefaultEnv , tcg_default_exports = emptyDefaultEnv , tcg_type_env = emptyNameEnv - , tcg_type_env_var = hsc_type_env_vars hsc_env + , tcg_knot_vars = hsc_type_env_vars hsc_env , tcg_inst_env = emptyInstEnv , tcg_fam_inst_env = emptyFamInstEnv , tcg_ann_env = emptyAnnEnv @@ -2404,7 +2404,7 @@ initIfaceTcRn thing_inside ; hsc_env <- getTopEnv -- bangs to avoid leaking the envs (#19356) ; let !mhome_unit = hsc_home_unit_maybe hsc_env - !knot_vars = tcg_type_env_var tcg_env + !knot_vars = tcg_knot_vars tcg_env -- When we are instantiating a signature, -- we DEFINITELY do not want to knot tie. is_instantiate = fromMaybe False (isHomeUnitInstantiating <$> mhome_unit) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2239f43cbd96a03c9363010adbc81528... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2239f43cbd96a03c9363010adbc81528... You're receiving this email because of your account on gitlab.haskell.org.