PUBLIC
Hi,
Is there a migration guide for GHC API clients for the new “multiple home units” feature?
In particular, I have the following two functions in my code that used to interact with related features of GHC:
addUnit :: UnitInfo -> HscEnv -> HscEnv
addUnit
unitInfo@GenericUnitInfo{..} = modifyUnitState $ \us -> us
{ packageNameMap = addToUFM (packageNameMap us) unitPackageName unitId
, unitInfoMap = M.insert unitId unitInfo $ unitInfoMap us
}
registerModule :: (GhcMonad m) => ModDetails -> ModIface -> m ()
registerModule details iface = modifySession $ extendHpt . addModule
where
hmi = HomeModInfo iface details Nothing
mod = mi_module iface
modOrig = ModOrigin (Just True) [] [] True
addModule = modifyUnitState $ \us -> us
{ moduleNameProvidersMap = M.insert (moduleName mod) (M.singleton mod modOrig) $ moduleNameProvidersMap us
}
extendHpt env = env
{ hsc_unit_env = let ue = hsc_unit_env env in ue
{ ue_hpt = addHomeModInfoToHpt hmi (hsc_HPT env)
}
}
I implemented these using the following utility function:
modifyUnitState :: (UnitState -> UnitState) -> HscEnv -> HscEnv
modifyUnitState f env = env
{ hsc_unit_env = let ue = hsc_unit_env env in ue
{ ue_units = f (ue_units ue)
}
}
With the recent changes to GHC, `modifyUnitState` doesn’t work anymore because there is no single `UnitEnv` in the `HscEnv`. I tried updating the `HomeUnitEnv` of the current
unit:
modifyUnitState :: (UnitState -> UnitState) -> HscEnv -> HscEnv
modifyUnitState f env = env
{ hsc_unit_env = let ue = hsc_unit_env env in
ue_updateHomeUnitEnv f' (ue_currentUnit ue) ue
}
where
f' hue = let units = homeUnitEnv_units hue in hue
{ homeUnitEnv_units = f units
}
but this leads to a panic:
GHC version 9.5.20220613:
Unit unknown to the internal unit environment
unit (cortex-prim)
pprInternalUnitMap
main (flags: main, Just main) ->
Call stack:
CallStack (from HasCallStack):
callStackDoc, called at compiler/GHC/Utils/Panic.hs:182:37 in ghc-lib-0.20220613-HQTH0nHhxeOCnJy5jYkZiX:GHC.Utils.Panic
pprPanic, called at compiler/GHC/Unit/Env.hs:450:14 in ghc-lib-0.20220613-HQTH0nHhxeOCnJy5jYkZiX:GHC.Unit.Env
ue_findHomeUnitEnv, called at compiler/GHC/Unit/Env.hs:394:48 in ghc-lib-0.20220613-HQTH0nHhxeOCnJy5jYkZiX:GHC.Unit.Env
ue_unitFlags, called at compiler/GHC/Driver/Env.hs:421:18 in ghc-lib-0.20220613-HQTH0nHhxeOCnJy5jYkZiX:GHC.Driver.Env
hscSetActiveUnitId, called at compiler/GHC/Driver/Env.hs:416:34 in ghc-lib-0.20220613-HQTH0nHhxeOCnJy5jYkZiX:GHC.Driver.Env
hscSetActiveHomeUnit, called at compiler/GHC/Driver/Make.hs:1853:15 in ghc-lib-0.20220613-HQTH0nHhxeOCnJy5jYkZiX:GHC.Driver.Make
What is the new way of registering a new unit or new module with GHC?
Thanks,
Gergo