@@ -817,71 +817,66 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis = do
817817 home_unit_id <- uids
818818 home_unit_env <- maybeToList $ unitEnv_lookup_maybe home_unit_id $ hsc_HUG hscEnv'
819819 map (home_unit_id,) (map (Compat. toUnitId . fst ) $ explicitUnits $ homeUnitEnv_units home_unit_env)
820-
821- case closure_errs of
822- errs@ (_: _) -> do
823- let rendered_err = map (ideErrorWithSource (Just " cradle" ) (Just DiagnosticSeverity_Error ) _cfp . T. pack . Compat. printWithoutUniques) errs
824- res = (rendered_err,Nothing )
825- dep_info = foldMap componentDependencyInfo (filter isBad $ Map. elems cis)
826- bad_units = OS. fromList $ concat $ do
827- x <- bagToList $ mapBag errMsgDiagnostic $ unionManyBags $ map Compat. getMessages errs
828- DriverHomePackagesNotClosed us <- pure x
829- pure us
830- isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units
831- return [([TargetDetails (TargetFile _cfp) res dep_info [_cfp]],(res,dep_info))]
832- [] -> do
820+ multi_errs = map (ideErrorWithSource (Just " cradle" ) (Just DiagnosticSeverity_Warning ) _cfp . T. pack . Compat. printWithoutUniques) closure_errs
821+ dep_info = foldMap componentDependencyInfo (filter isBad $ Map. elems cis)
822+ bad_units = OS. fromList $ concat $ do
823+ x <- bagToList $ mapBag errMsgDiagnostic $ unionManyBags $ map Compat. getMessages closure_errs
824+ DriverHomePackagesNotClosed us <- pure x
825+ pure us
826+ isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units
833827#else
834- do
828+ let isBad = const False
829+ multi_errs = []
835830#endif
836- -- Whenever we spin up a session on Linux, dynamically load libm.so.6
837- -- in. We need this in case the binary is statically linked, in which
838- -- case the interactive session will fail when trying to load
839- -- ghc-prim, which happens whenever Template Haskell is being
840- -- evaluated or haskell-language-server's eval plugin tries to run
841- -- some code. If the binary is dynamically linked, then this will have
842- -- no effect.
843- -- See https://github.com/haskell/haskell-language-server/issues/221
844- -- We need to do this after the call to setSessionDynFlags initialises
845- -- the loader
846- when (os == " linux" ) $ do
847- initObjLinker hscEnv'
848- res <- loadDLL hscEnv' " libm.so.6"
849- case res of
850- Nothing -> pure ()
851- Just err -> logWith recorder Error $ LogDLLLoadError err
852-
853- forM (Map. elems cis) $ \ ci -> do
854- let df = componentDynFlags ci
855- let createHscEnvEq = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
856- thisEnv <- do
831+ -- Whenever we spin up a session on Linux, dynamically load libm.so.6
832+ -- in. We need this in case the binary is statically linked, in which
833+ -- case the interactive session will fail when trying to load
834+ -- ghc-prim, which happens whenever Template Haskell is being
835+ -- evaluated or haskell-language-server's eval plugin tries to run
836+ -- some code. If the binary is dynamically linked, then this will have
837+ -- no effect.
838+ -- See https://github.com/haskell/haskell-language-server/issues/221
839+ -- We need to do this after the call to setSessionDynFlags initialises
840+ -- the loader
841+ when (os == " linux" ) $ do
842+ initObjLinker hscEnv'
843+ res <- loadDLL hscEnv' " libm.so.6"
844+ case res of
845+ Nothing -> pure ()
846+ Just err -> logWith recorder Error $ LogDLLLoadError err
847+
848+ forM (Map. elems cis) $ \ ci -> do
849+ let df = componentDynFlags ci
850+ let createHscEnvEq = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
851+ thisEnv <- do
857852#if MIN_VERSION_ghc(9,3,0)
858- -- In GHC 9.4 we have multi component support, and we have initialised all the units
859- -- above.
860- -- We just need to set the current unit here
861- pure $ hscSetActiveUnitId (homeUnitId_ df) hscEnv'
853+ -- In GHC 9.4 we have multi component support, and we have initialised all the units
854+ -- above.
855+ -- We just need to set the current unit here
856+ pure $ hscSetActiveUnitId (homeUnitId_ df) hscEnv'
862857#else
863- -- This initializes the units for GHC 9.2
864- -- Add the options for the current component to the HscEnv
865- -- We want to call `setSessionDynFlags` instead of `hscSetFlags`
866- -- because `setSessionDynFlags` also initializes the package database,
867- -- which we need for any changes to the package flags in the dynflags
868- -- to be visible.
869- -- See #2693
870- evalGhcEnv hscEnv' $ do
871- _ <- setSessionDynFlags df
872- getSession
858+ -- This initializes the units for GHC 9.2
859+ -- Add the options for the current component to the HscEnv
860+ -- We want to call `setSessionDynFlags` instead of `hscSetFlags`
861+ -- because `setSessionDynFlags` also initializes the package database,
862+ -- which we need for any changes to the package flags in the dynflags
863+ -- to be visible.
864+ -- See #2693
865+ evalGhcEnv hscEnv' $ do
866+ _ <- setSessionDynFlags df
867+ getSession
873868#endif
874- henv <- createHscEnvEq thisEnv (zip uids dfs)
875- let targetEnv = ([] , Just henv)
876- targetDepends = componentDependencyInfo ci
877- res = ( targetEnv, targetDepends)
878- logWith recorder Debug $ LogNewComponentCache res
879- evaluate $ liftRnf rwhnf $ componentTargets ci
869+ henv <- createHscEnvEq thisEnv (zip uids dfs)
870+ let targetEnv = (if isBad ci then multi_errs else [] , Just henv)
871+ targetDepends = componentDependencyInfo ci
872+ res = ( targetEnv, targetDepends)
873+ logWith recorder Debug $ LogNewComponentCache res
874+ evaluate $ liftRnf rwhnf $ componentTargets ci
880875
881- let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends
882- ctargets <- concatMapM mk (componentTargets ci)
876+ let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends
877+ ctargets <- concatMapM mk (componentTargets ci)
883878
884- return (L. nubOrdOn targetTarget ctargets, res)
879+ return (L. nubOrdOn targetTarget ctargets, res)
885880
886881{- Note [Avoiding bad interface files]
887882~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
0 commit comments