| ... |
... |
@@ -57,6 +57,7 @@ import Language.Haskell.Syntax.ImpExp |
|
57
|
57
|
import GHC.Types.UnresolvedImport
|
|
58
|
58
|
|
|
59
|
59
|
import GHC.Data.FastString
|
|
|
60
|
+import GHC.Data.ShortText ( ShortText )
|
|
60
|
61
|
import GHC.Data.Maybe ( expectJust )
|
|
61
|
62
|
import qualified GHC.Data.Maybe as M
|
|
62
|
63
|
import GHC.Data.OsPath ( OsPath, unsafeEncodeUtf )
|
| ... |
... |
@@ -95,7 +96,6 @@ import GHC.Unit.Module.Graph |
|
95
|
96
|
import GHC.Unit.Module.Deps
|
|
96
|
97
|
import qualified GHC.Unit.Home.Graph as HUG
|
|
97
|
98
|
import GHC.Unit.Module.Stage
|
|
98
|
|
-import GHC.Unit.External.Index (GlobalUnitKey, mkGlobalUnitKey)
|
|
99
|
99
|
|
|
100
|
100
|
import Data.Either ( partitionEithers, lefts )
|
|
101
|
101
|
import Data.Map (Map)
|
| ... |
... |
@@ -972,18 +972,19 @@ checkHomeUnitsClosed unit_env |
|
972
|
972
|
offenders :: [(UnitId, UnitId)]
|
|
973
|
973
|
offenders
|
|
974
|
974
|
= evalState (collect (map (homeUnitEnv_units . snd) home_unit_data))
|
|
975
|
|
- Set.empty
|
|
|
975
|
+ emptyUniqMap
|
|
976
|
976
|
where
|
|
977
|
977
|
|
|
978
|
978
|
-- | Collects offending dependencies.
|
|
979
|
979
|
collect :: [UnitState]
|
|
980
|
980
|
-- ^ The 'UnitState's of the home units from which to traverse
|
|
981
|
981
|
-- the dependency graph.
|
|
982
|
|
- -> State (Set GlobalUnitKey) [(UnitId, UnitId)]
|
|
|
982
|
+ -> State (UniqMap UnitId (Set ShortText)) [(UnitId, UnitId)]
|
|
983
|
983
|
-- ^ A stateful computation that collects offending dependencies
|
|
984
|
|
- -- that have not yet been found, using its state to keep track
|
|
985
|
|
- -- of which units have already been considered as sources of
|
|
986
|
|
- -- offending dependencies.
|
|
|
984
|
+ -- that have not yet been found. It uses its state, which is an
|
|
|
985
|
+ -- efficent representation of a set of 'GlobalUnitKey's, to
|
|
|
986
|
+ -- keep track of which units have already been considered as
|
|
|
987
|
+ -- sources of offending dependencies.
|
|
987
|
988
|
collect = concatMapM $ \ unit_state ->
|
|
988
|
989
|
collect_for_home_unit
|
|
989
|
990
|
(unitInfoMap unit_state)
|
| ... |
... |
@@ -998,10 +999,11 @@ checkHomeUnitsClosed unit_env |
|
998
|
999
|
-> [UnitId]
|
|
999
|
1000
|
-- ^ The 'UnitId's of the units from which to traverse the dependency
|
|
1000
|
1001
|
-- graph.
|
|
1001
|
|
- -> State (Set GlobalUnitKey) [(UnitId, UnitId)]
|
|
|
1002
|
+ -> State (UniqMap UnitId (Set ShortText)) [(UnitId, UnitId)]
|
|
1002
|
1003
|
-- ^ A stateful computation that collects offending dependencies that
|
|
1003
|
|
- -- have not yet been found, using its state to keep track of which
|
|
1004
|
|
- -- units have already been considered as sources of offending
|
|
|
1004
|
+ -- have not yet been found. It uses its state, which is an efficent
|
|
|
1005
|
+ -- representation of a set of 'GlobalUnitKey's, to keep track of
|
|
|
1006
|
+ -- which units have already been considered as sources of offending
|
|
1005
|
1007
|
-- dependencies.
|
|
1006
|
1008
|
collect_for_home_unit _ []
|
|
1007
|
1009
|
= return []
|
| ... |
... |
@@ -1019,15 +1021,19 @@ checkHomeUnitsClosed unit_env |
|
1019
|
1021
|
unit_not_found_msg :: String
|
|
1020
|
1022
|
unit_not_found_msg = "Unit not found during closure property check"
|
|
1021
|
1023
|
|
|
1022
|
|
- -- | A 'GlobalUnitKey' that identifies the current unit.
|
|
1023
|
|
- global_unit_key :: GlobalUnitKey
|
|
1024
|
|
- global_unit_key = mkGlobalUnitKey current_unit (unitAbiHash unit_info)
|
|
|
1024
|
+ -- | The ABI hash of the current unit.
|
|
|
1025
|
+ unit_abi_hash :: ShortText
|
|
|
1026
|
+ unit_abi_hash = unitAbiHash unit_info
|
|
1025
|
1027
|
|
|
1026
|
|
- has_been_processed <- gets (Set.member global_unit_key)
|
|
|
1028
|
+ has_been_processed <- gets $ maybe False (Set.member unit_abi_hash) .
|
|
|
1029
|
+ (`lookupUniqMap` current_unit)
|
|
1027
|
1030
|
if has_been_processed
|
|
1028
|
1031
|
then collect_for_home_unit unit_info_map remaining_units
|
|
1029
|
1032
|
else do
|
|
1030
|
|
- modify (Set.insert global_unit_key)
|
|
|
1033
|
+ modify $ \ processed -> addToUniqMap_C Set.union
|
|
|
1034
|
+ processed
|
|
|
1035
|
+ current_unit
|
|
|
1036
|
+ (Set.singleton unit_abi_hash)
|
|
1031
|
1037
|
let
|
|
1032
|
1038
|
|
|
1033
|
1039
|
-- | The 'UnitId's of the units that the current unit depends on.
|
| ... |
... |
@@ -1077,11 +1083,10 @@ units it directly depends on, and, starting from them, follows unit dependencies |
|
1077
|
1083
|
to search for offending dependencies. It does not follow dependencies that have
|
|
1078
|
1084
|
been followed before, possibly when processing another home unit. To achieve
|
|
1079
|
1085
|
this, the algorithm tracks, across home units, from which units it has already
|
|
1080
|
|
-followed dependencies. For this tracking, it identifies each unit by a
|
|
1081
|
|
-'GlobalUnitKey', which is a pair of a 'UnitId' and an ABI hash. Using only a
|
|
1082
|
|
-'UnitId' would not work, because 'UnitId's are not always globally unique. Also
|
|
1083
|
|
-using only an ABI hash is not an option, because an ABI hash is not necessarily
|
|
1084
|
|
-an ABI hash: it can also be the string @"inline"@.
|
|
|
1086
|
+followed dependencies. For this tracking, it identifies each unit by a 'UnitId'
|
|
|
1087
|
+and an ABI hash. Using only a 'UnitId' would not work, because 'UnitId's are not
|
|
|
1088
|
+always globally unique. Also using only an ABI hash is not an option, because an
|
|
|
1089
|
+ABI hash is not necessarily an ABI hash: it can also be the string @"inline"@.
|
|
1085
|
1090
|
|
|
1086
|
1091
|
The correctness of this algorithm rests on the, likely correct, assumption that,
|
|
1087
|
1092
|
among the units mentioned in the 'UnitState' of a particular home unit, any unit
|