| ... |
... |
@@ -949,19 +949,33 @@ checkHomeUnitsClosed unit_env |
|
949
|
949
|
]
|
|
950
|
950
|
where
|
|
951
|
951
|
|
|
|
952
|
+ -- | The 'UnitId' and 'HomeUnitEnv' of each home unit.
|
|
952
|
953
|
home_unit_data :: [(UnitId, HomeUnitEnv)]
|
|
953
|
954
|
home_unit_data = HUG.unitEnv_assocs (ue_home_unit_graph unit_env)
|
|
954
|
955
|
|
|
|
956
|
+ -- | The 'UnitId's of all home units.
|
|
955
|
957
|
home_units :: UniqSet UnitId
|
|
956
|
958
|
home_units = mkUniqSet (map fst home_unit_data)
|
|
957
|
959
|
|
|
|
960
|
+ -- | All offending dependencies. A dependency of a unit _u_ on a unit _v_ is
|
|
|
961
|
+ -- offending exactly if _u_ is an external unit reachable from a home unit
|
|
|
962
|
+ -- and _v_ is a home unit. Each such dependency is represented in this list
|
|
|
963
|
+ -- by the pair of the 'UnitId' of _u_ and the 'UnitId' of _v_.
|
|
958
|
964
|
offenders :: [(UnitId, UnitId)]
|
|
959
|
965
|
offenders
|
|
960
|
966
|
= evalState (collect (map (homeUnitEnv_units . snd) home_unit_data)) $
|
|
961
|
967
|
Set.empty
|
|
962
|
968
|
where
|
|
963
|
969
|
|
|
964
|
|
- collect :: [UnitState] -> State (Set GlobalUnitKey) [(UnitId, UnitId)]
|
|
|
970
|
+ -- | Collects offending dependencies.
|
|
|
971
|
+ collect :: [UnitState]
|
|
|
972
|
+ -- ^ The 'UnitState's of the home units from which to traverse
|
|
|
973
|
+ -- the dependency graph.
|
|
|
974
|
+ -> State (Set GlobalUnitKey) [(UnitId, UnitId)]
|
|
|
975
|
+ -- ^ A stateful computation that collects the offending
|
|
|
976
|
+ -- dependencies, using its state to keep track of which units
|
|
|
977
|
+ -- have already been considered as sources of offending
|
|
|
978
|
+ -- dependencies.
|
|
965
|
979
|
collect []
|
|
966
|
980
|
= pure []
|
|
967
|
981
|
collect (current_unit_state : remaining_unit_states)
|
| ... |
... |
@@ -971,23 +985,35 @@ checkHomeUnitsClosed unit_env |
|
971
|
985
|
<*> collect remaining_unit_states
|
|
972
|
986
|
where
|
|
973
|
987
|
|
|
974
|
|
- collect_for_home_unit :: UnitInfoMap
|
|
975
|
|
- -> [UnitId]
|
|
976
|
|
- -> State (Set GlobalUnitKey) [(UnitId, UnitId)]
|
|
|
988
|
+ -- | Collects offending dependencies that are reachable from a single home
|
|
|
989
|
+ -- unit.
|
|
|
990
|
+ collect_for_home_unit
|
|
|
991
|
+ :: UnitInfoMap
|
|
|
992
|
+ -- ^ The 'UnitInfoMap' of the home unit.
|
|
|
993
|
+ -> [UnitId]
|
|
|
994
|
+ -- ^ The 'UnitId's of the units from which to traverse the dependency
|
|
|
995
|
+ -- graph.
|
|
|
996
|
+ -> State (Set GlobalUnitKey) [(UnitId, UnitId)]
|
|
|
997
|
+ -- ^ A stateful computation that collects the offending dependencies,
|
|
|
998
|
+ -- using its state to keep track of which units have already been
|
|
|
999
|
+ -- considered as sources of offending dependencies.
|
|
977
|
1000
|
collect_for_home_unit _ []
|
|
978
|
1001
|
= return []
|
|
979
|
1002
|
collect_for_home_unit unit_info_map (current_unit : remaining_units) = do
|
|
980
|
1003
|
let
|
|
981
|
1004
|
|
|
|
1005
|
+ -- | The 'UnitInfo' of the current unit.
|
|
982
|
1006
|
unit_info :: UnitInfo
|
|
983
|
1007
|
unit_info
|
|
984
|
1008
|
= fromMaybe (pprPanic unit_not_found_msg (ppr current_unit)) $
|
|
985
|
1009
|
lookupUniqMap unit_info_map current_unit
|
|
986
|
1010
|
where
|
|
987
|
1011
|
|
|
|
1012
|
+ -- | The message that says that a unit was not found.
|
|
988
|
1013
|
unit_not_found_msg :: String
|
|
989
|
1014
|
unit_not_found_msg = "Unit not found during closure property check"
|
|
990
|
1015
|
|
|
|
1016
|
+ -- | A 'GlobalUnitKey' that identifies the current unit.
|
|
991
|
1017
|
global_unit_key :: GlobalUnitKey
|
|
992
|
1018
|
global_unit_key = mkGlobalUnitKey current_unit (unitAbiHash unit_info)
|
|
993
|
1019
|
|
| ... |
... |
@@ -998,9 +1024,11 @@ checkHomeUnitsClosed unit_env |
|
998
|
1024
|
modify (Set.insert global_unit_key)
|
|
999
|
1025
|
let
|
|
1000
|
1026
|
|
|
|
1027
|
+ -- | The 'UnitId's of the units that the current unit depends on.
|
|
1001
|
1028
|
needed_units :: [UnitId]
|
|
1002
|
1029
|
needed_units = unitDepends unit_info
|
|
1003
|
1030
|
|
|
|
1031
|
+ -- | The offending dependencies of the current unit.
|
|
1004
|
1032
|
current_offenders :: [(UnitId, UnitId)]
|
|
1005
|
1033
|
current_offenders
|
|
1006
|
1034
|
| current_unit `elementOfUniqSet` home_units
|
| ... |
... |
@@ -1014,6 +1042,7 @@ checkHomeUnitsClosed unit_env |
|
1014
|
1042
|
needed_units ++ remaining_units
|
|
1015
|
1043
|
return $ current_offenders ++ remaining_offenders
|
|
1016
|
1044
|
|
|
|
1045
|
+ -- | A fake source span used for reporting violations of the closure property.
|
|
1017
|
1046
|
error_source_span :: SrcSpan
|
|
1018
|
1047
|
error_source_span = mkGeneralSrcSpan (fsLit "<command line>")
|
|
1019
|
1048
|
|