| ... |
... |
@@ -35,8 +35,11 @@ module GHC ( |
|
35
|
35
|
parseDynamicFlags, parseTargetFiles,
|
|
36
|
36
|
getSessionDynFlags,
|
|
37
|
37
|
setTopSessionDynFlags,
|
|
|
38
|
+ ReloadPkgDb(..),
|
|
38
|
39
|
setSessionDynFlags,
|
|
|
40
|
+ setSessionDynFlagsWithPkgDb,
|
|
39
|
41
|
setUnitDynFlags,
|
|
|
42
|
+ setUnitDynFlagsWithPkgDb,
|
|
40
|
43
|
getProgramDynFlags, setProgramDynFlags,
|
|
41
|
44
|
setProgramHUG, setProgramHUG_,
|
|
42
|
45
|
getInteractiveDynFlags, setInteractiveDynFlags,
|
| ... |
... |
@@ -633,18 +636,35 @@ initGhcMonad mb_top_dir = setSession =<< liftIO ( do |
|
633
|
636
|
--
|
|
634
|
637
|
-- 'setSessionDynFlags' sets both @DynFlags@, and 'getSessionDynFlags'
|
|
635
|
638
|
-- retrieves the program @DynFlags@ (for backwards compatibility).
|
|
|
639
|
+--
|
|
|
640
|
+-- Neither of these functions
|
|
636
|
641
|
|
|
637
|
|
--- This is a compatibility function which sets dynflags for the top session
|
|
638
|
|
--- as well as the unit.
|
|
|
642
|
+-- | This is a compatibility function which sets dynflags for the top session
|
|
|
643
|
+-- as well as the unit. Only works if there is exactly one unit.
|
|
|
644
|
+--
|
|
|
645
|
+-- Note that this does not reload the package db if it is already loaded.
|
|
|
646
|
+-- This means that if you change package flags or the location of the package
|
|
|
647
|
+-- db before calling this function, these changes may not take effect.
|
|
|
648
|
+-- See 'setSessionDynFlagsWithPkgDb' to configure this behavior and force
|
|
|
649
|
+-- reloading of the package database.
|
|
639
|
650
|
setSessionDynFlags :: (HasCallStack, GhcMonad m) => DynFlags -> m ()
|
|
640
|
|
-setSessionDynFlags dflags0 = do
|
|
|
651
|
+setSessionDynFlags = setSessionDynFlagsWithPkgDb UseCachedPkgDb
|
|
|
652
|
+
|
|
|
653
|
+
|
|
|
654
|
+-- | This is a compatibility function which sets dynflags for the top session
|
|
|
655
|
+-- as well as the unit. Only works if there is exactly one unit.
|
|
|
656
|
+--
|
|
|
657
|
+-- The 'ReloadPkgDb' argument controls if the pacakge database is reload.
|
|
|
658
|
+-- Set it to 'ReloadPkgDb' if you change package flags, otherwise 'UseCachedPkgDb'.
|
|
|
659
|
+setSessionDynFlagsWithPkgDb :: (HasCallStack, GhcMonad m) => ReloadPkgDb -> DynFlags -> m ()
|
|
|
660
|
+setSessionDynFlagsWithPkgDb use_cache dflags0 = do
|
|
641
|
661
|
hsc_env <- getSession
|
|
642
|
662
|
logger <- getLogger
|
|
643
|
663
|
dflags <- checkNewDynFlags logger dflags0
|
|
644
|
664
|
let all_uids = hsc_all_home_unit_ids hsc_env
|
|
645
|
665
|
case S.toList all_uids of
|
|
646
|
666
|
[uid] -> do
|
|
647
|
|
- setUnitDynFlagsNoCheck uid dflags
|
|
|
667
|
+ setUnitDynFlagsNoCheck use_cache uid dflags
|
|
648
|
668
|
modifySession (hscUpdateLoggerFlags . hscSetActiveUnitId (homeUnitId_ dflags))
|
|
649
|
669
|
dflags' <- getDynFlags
|
|
650
|
670
|
setTopSessionDynFlags dflags'
|
| ... |
... |
@@ -652,19 +672,39 @@ setSessionDynFlags dflags0 = do |
|
652
|
672
|
_ -> panic "setSessionDynFlags can only be used with a single home unit"
|
|
653
|
673
|
|
|
654
|
674
|
|
|
|
675
|
+-- | Set the dynflags for a unit.
|
|
|
676
|
+--
|
|
|
677
|
+-- Note that this does not reload the package db if it is already loaded.
|
|
|
678
|
+-- This means that if you change package flags or the location of the package
|
|
|
679
|
+-- db before calling this function, these changes may not take effect.
|
|
|
680
|
+-- See 'setUnitDynFlagsWithPkgDb' to configure this behavior and force
|
|
|
681
|
+-- reloading of the package database.
|
|
655
|
682
|
setUnitDynFlags :: GhcMonad m => UnitId -> DynFlags -> m ()
|
|
656
|
|
-setUnitDynFlags uid dflags0 = do
|
|
|
683
|
+setUnitDynFlags = setUnitDynFlagsWithPkgDb UseCachedPkgDb
|
|
|
684
|
+
|
|
|
685
|
+-- | Set the dynflags for a unit.
|
|
|
686
|
+--
|
|
|
687
|
+-- The 'ReloadPkgDb' argument controls if the pacakge database is reload.
|
|
|
688
|
+-- Set it to 'UseCachedPkgDb' if you change package flags.
|
|
|
689
|
+setUnitDynFlagsWithPkgDb :: GhcMonad m => ReloadPkgDb -> UnitId -> DynFlags -> m ()
|
|
|
690
|
+setUnitDynFlagsWithPkgDb use_cache uid dflags0 = do
|
|
657
|
691
|
logger <- getLogger
|
|
658
|
692
|
dflags1 <- checkNewDynFlags logger dflags0
|
|
659
|
|
- setUnitDynFlagsNoCheck uid dflags1
|
|
|
693
|
+ setUnitDynFlagsNoCheck use_cache uid dflags1
|
|
|
694
|
+
|
|
|
695
|
+data ReloadPkgDb
|
|
|
696
|
+ = UseCachedPkgDb -- ^ Use the pkg db cached in the hsc env if it exists
|
|
|
697
|
+ | ReloadPkgDb -- ^ Reload the pkg db based on the dynflags
|
|
660
|
698
|
|
|
661
|
|
-setUnitDynFlagsNoCheck :: GhcMonad m => UnitId -> DynFlags -> m ()
|
|
662
|
|
-setUnitDynFlagsNoCheck uid dflags1 = do
|
|
|
699
|
+setUnitDynFlagsNoCheck :: GhcMonad m => ReloadPkgDb -> UnitId -> DynFlags -> m ()
|
|
|
700
|
+setUnitDynFlagsNoCheck use_cache uid dflags1 = do
|
|
663
|
701
|
logger <- getLogger
|
|
664
|
702
|
hsc_env <- getSession
|
|
665
|
703
|
|
|
666
|
704
|
let old_hue = ue_findHomeUnitEnv uid (hsc_unit_env hsc_env)
|
|
667
|
|
- let cached_unit_dbs = homeUnitEnv_unit_dbs old_hue
|
|
|
705
|
+ let cached_unit_dbs = case use_cache of
|
|
|
706
|
+ UseCachedPkgDb -> homeUnitEnv_unit_dbs old_hue
|
|
|
707
|
+ ReloadPkgDb -> Nothing
|
|
668
|
708
|
(dbs,unit_state,home_unit,mconstants) <- liftIO $ initUnits logger dflags1 cached_unit_dbs (hsc_all_home_unit_ids hsc_env)
|
|
669
|
709
|
updated_dflags <- liftIO $ updatePlatformConstants dflags1 mconstants
|
|
670
|
710
|
|