mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-14 05:12:33 +00:00
e21193c283
Estimated hours taken: 6 Branches: main browser/*.m: compiler/*.m: Rename a bunch of predicates and function symbols to eliminate ambiguities. The only real change is factoring out some common code in the mlds and llds code generators, replacing them with single definitions in switch_util.m.
544 lines
20 KiB
Mathematica
544 lines
20 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2000-2006 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: switch_util.m.
|
|
% Author: fjh.
|
|
%
|
|
% This module defines stuff for generating switches that is shared
|
|
% between the MLDS and LLDS back-ends.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module backend_libs.switch_util.
|
|
:- interface.
|
|
|
|
:- import_module backend_libs.rtti. % for sectag_locn
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module pair.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff for categorizing switches
|
|
%
|
|
|
|
% An extended_case is an HLDS case annotated with some additional info.
|
|
% The first (int) field is the priority, as computed by switch_priority/2.
|
|
|
|
:- type extended_case
|
|
---> extended_case(int, cons_tag, cons_id, hlds_goal).
|
|
:- type cases_list == list(extended_case).
|
|
|
|
:- type switch_category
|
|
---> atomic_switch % a switch on int/char/enum
|
|
; string_switch
|
|
; tag_switch
|
|
; other_switch.
|
|
|
|
% Convert a type category to a switch category.
|
|
%
|
|
:- func type_cat_to_switch_cat(type_category) = switch_category.
|
|
|
|
% Return the priority of a constructor test.
|
|
% A low number here indicates a high priority.
|
|
% We prioritize the tag tests so that the cheapest
|
|
% (most efficient) ones come first.
|
|
%
|
|
:- func switch_priority(cons_tag) = int.
|
|
|
|
% type_range(TypeCategory, Type, ModuleInfo, Min, Max):
|
|
%
|
|
% Determine the range [Min..Max] of an atomic type.
|
|
% Fail if the type isn't the sort of type that has a range
|
|
% or if the type's range is too big to switch on (e.g. int).
|
|
%
|
|
:- pred type_range(type_category::in, mer_type::in, module_info::in,
|
|
int::out, int::out) is semidet.
|
|
|
|
% Calculate the percentage density given the range and the number of cases.
|
|
%
|
|
:- func switch_density(int, int) = int.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff for string hash switches
|
|
%
|
|
|
|
% For a string switch, compute the hash value for each case in the list
|
|
% of cases, and store the cases in a map from hash values to cases.
|
|
%
|
|
:- pred string_hash_cases(cases_list::in, int::in, map(int, cases_list)::out)
|
|
is det.
|
|
|
|
:- type hash_slot
|
|
---> hash_slot(extended_case, int).
|
|
|
|
% calc_hash_slots(AssocList, HashMap, Map):
|
|
%
|
|
% For each (HashVal - Case) pair in AssocList, allocate a hash slot in Map
|
|
% for the case. If the hash slot corresponding to HashVal is not already
|
|
% used, then use that one. Otherwise, find the next spare slot (making sure
|
|
% that we don't use slots which can be used for a direct match with the
|
|
% hash value for one of the other cases), and use it instead.
|
|
% Keep track of the hash chains as we do this.
|
|
%
|
|
:- pred calc_hash_slots(assoc_list(int, cases_list)::in,
|
|
map(int, cases_list)::in, map(int, hash_slot)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff for tag switches
|
|
%
|
|
|
|
% Map secondary tag values (-1 stands for none) to their goal.
|
|
:- type stag_goal ---> stag_goal(cons_id, hlds_goal).
|
|
:- type stag_goal_map == map(int, stag_goal).
|
|
:- type stag_goal_list == assoc_list(int, stag_goal).
|
|
|
|
% Map primary tag values to the set of their goals.
|
|
:- type ptag_case ---> ptag_case(sectag_locn, stag_goal_map).
|
|
:- type ptag_case_map == map(tag_bits, ptag_case).
|
|
:- type ptag_case_list == assoc_list(tag_bits, ptag_case).
|
|
|
|
% Map primary tag values to the number of constructors sharing them.
|
|
:- type ptag_count_map == map(tag_bits, pair(sectag_locn, int)).
|
|
:- type ptag_count_list == assoc_list(tag_bits, pair(sectag_locn, int)).
|
|
|
|
% Group together all the cases that depend on the given variable
|
|
% having the same primary tag value.
|
|
%
|
|
:- pred group_cases_by_ptag(cases_list::in, ptag_case_map::in,
|
|
ptag_case_map::out) is det.
|
|
|
|
% Order the primary tags based on the number of secondary tags
|
|
% associated with them, putting the ones with the most secondary tags
|
|
% first.
|
|
%
|
|
% Note that it is not an error for a primary tag to have no case list;
|
|
% this can happen in semidet switches, or in det switches where the
|
|
% initial inst of the switch variable is a bound(...) inst representing
|
|
% a subtype.
|
|
%
|
|
:- pred order_ptags_by_count(ptag_count_list::in, ptag_case_map::in,
|
|
ptag_case_list::out) is det.
|
|
|
|
% order_ptags_by_value(FirstPtag, MaxPtag, PtagCaseMap0, PtagCaseList):
|
|
%
|
|
% Order the primary tags based on their value, lowest value first.
|
|
% We scan through the primary tags values from zero to maximum.
|
|
% Note that it is not an error for a primary tag to have no case list,
|
|
% since this can happen in semidet switches.
|
|
%
|
|
:- pred order_ptags_by_value(int::in, int::in, ptag_case_map::in,
|
|
ptag_case_list::out) is det.
|
|
|
|
% Find out how many secondary tags share each primary tag
|
|
% of the given variable.
|
|
%
|
|
:- pred get_ptag_counts(mer_type::in, module_info::in,
|
|
int::out, ptag_count_map::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module libs.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module parse_tree.prog_type.
|
|
|
|
:- import_module char.
|
|
:- import_module int.
|
|
:- import_module string.
|
|
:- import_module svmap.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
string_hash_cases([], _, Map) :-
|
|
map.init(Map).
|
|
string_hash_cases([Case | Cases], HashMask, Map) :-
|
|
string_hash_cases(Cases, HashMask, Map0),
|
|
( Case = extended_case(_, string_tag(String0), _, _) ->
|
|
String = String0
|
|
;
|
|
unexpected(this_file, "string_hash_cases: non-string case?")
|
|
),
|
|
string.hash(String, HashVal0),
|
|
HashVal = HashVal0 /\ HashMask,
|
|
( map.search(Map0, HashVal, CaseList0) ->
|
|
map.det_update(Map0, HashVal, [Case | CaseList0], Map)
|
|
;
|
|
map.det_insert(Map0, HashVal, [Case], Map)
|
|
).
|
|
|
|
calc_hash_slots(HashValList, HashMap, Map) :-
|
|
calc_hash_slots_1(HashValList, HashMap, map.init, Map, 0, _).
|
|
|
|
:- pred calc_hash_slots_1(assoc_list(int, cases_list)::in,
|
|
map(int, cases_list)::in, map(int, hash_slot)::in,
|
|
map(int, hash_slot)::out, int::in, int::out) is det.
|
|
|
|
calc_hash_slots_1([], _, !Map, !LastUsed).
|
|
calc_hash_slots_1([HashVal - Cases | Rest], HashMap, !Map, !LastUsed) :-
|
|
calc_hash_slots_2(Cases, HashVal, HashMap, !Map, !LastUsed),
|
|
calc_hash_slots_1(Rest, HashMap, !Map, !LastUsed).
|
|
|
|
:- pred calc_hash_slots_2(cases_list::in, int::in, map(int, cases_list)::in,
|
|
map(int, hash_slot)::in, map(int, hash_slot)::out, int::in, int::out)
|
|
is det.
|
|
|
|
calc_hash_slots_2([], _HashVal, _HashMap, !Map, !LastUsed).
|
|
calc_hash_slots_2([Case | Cases], HashVal, HashMap, !Map, !LastUsed) :-
|
|
calc_hash_slots_2(Cases, HashVal, HashMap, !Map, !LastUsed),
|
|
( map.contains(!.Map, HashVal) ->
|
|
follow_hash_chain(!.Map, HashVal, ChainEnd),
|
|
next_free_hash_slot(!.Map, HashMap, !LastUsed),
|
|
map.lookup(!.Map, ChainEnd, hash_slot(PrevCase, _)),
|
|
svmap.det_update(ChainEnd, hash_slot(PrevCase, !.LastUsed), !Map),
|
|
svmap.det_insert(!.LastUsed, hash_slot(Case, -1), !Map)
|
|
;
|
|
svmap.det_insert(HashVal, hash_slot(Case, -1), !Map)
|
|
).
|
|
|
|
:- pred follow_hash_chain(map(int, hash_slot)::in, int::in, int::out) is det.
|
|
|
|
follow_hash_chain(Map, Slot, LastSlot) :-
|
|
map.lookup(Map, Slot, hash_slot(_, NextSlot)),
|
|
(
|
|
NextSlot >= 0,
|
|
map.contains(Map, NextSlot)
|
|
->
|
|
follow_hash_chain(Map, NextSlot, LastSlot)
|
|
;
|
|
LastSlot = Slot
|
|
).
|
|
|
|
% next_free_hash_slot(M, H_M, LastUsed, FreeSlot):
|
|
%
|
|
% Find the next available slot FreeSlot in the hash table which is not
|
|
% already used (contained in M) and which is not going to be used a
|
|
% primary slot (contained in H_M), starting at the slot after LastUsed.
|
|
%
|
|
:- pred next_free_hash_slot(map(int, hash_slot)::in,
|
|
map(int, cases_list)::in, int::in, int::out) is det.
|
|
|
|
next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
|
|
NextSlot = LastUsed + 1,
|
|
(
|
|
\+ map.contains(Map, NextSlot),
|
|
\+ map.contains(H_Map, NextSlot)
|
|
->
|
|
FreeSlot = NextSlot
|
|
;
|
|
next_free_hash_slot(Map, H_Map, NextSlot, FreeSlot)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Stuff for categorizing switches
|
|
%
|
|
|
|
type_cat_to_switch_cat(type_cat_enum) = atomic_switch.
|
|
type_cat_to_switch_cat(type_cat_dummy) = _ :-
|
|
% You can't have a switch without at least two arms.
|
|
unexpected(this_file, "type_cat_to_switch_cat: dummy").
|
|
type_cat_to_switch_cat(type_cat_int) = atomic_switch.
|
|
type_cat_to_switch_cat(type_cat_char) = atomic_switch.
|
|
type_cat_to_switch_cat(type_cat_float) = other_switch.
|
|
type_cat_to_switch_cat(type_cat_string) = string_switch.
|
|
type_cat_to_switch_cat(type_cat_higher_order) = other_switch.
|
|
type_cat_to_switch_cat(type_cat_user_ctor) = tag_switch.
|
|
type_cat_to_switch_cat(type_cat_variable) = other_switch.
|
|
type_cat_to_switch_cat(type_cat_tuple) = other_switch.
|
|
type_cat_to_switch_cat(type_cat_void) = _ :-
|
|
unexpected(this_file, "type_cat_to_switch_cat: void").
|
|
type_cat_to_switch_cat(type_cat_type_info) = _ :-
|
|
unexpected(this_file, "type_cat_to_switch_cat: type_info").
|
|
type_cat_to_switch_cat(type_cat_type_ctor_info) = _ :-
|
|
unexpected(this_file, "type_cat_to_switch_cat: type_ctor_info").
|
|
type_cat_to_switch_cat(type_cat_typeclass_info) = _ :-
|
|
unexpected(this_file, "type_cat_to_switch_cat: typeclass_info").
|
|
type_cat_to_switch_cat(type_cat_base_typeclass_info) = _ :-
|
|
unexpected(this_file, "type_cat_to_switch_cat: base_typeclass_info").
|
|
|
|
switch_priority(no_tag) = 0. % should never occur
|
|
switch_priority(int_tag(_)) = 1.
|
|
switch_priority(reserved_address_tag(_)) = 1.
|
|
switch_priority(shared_local_tag(_, _)) = 1.
|
|
switch_priority(single_functor_tag) = 2.
|
|
switch_priority(unshared_tag(_)) = 2.
|
|
switch_priority(float_tag(_)) = 3.
|
|
switch_priority(shared_remote_tag(_, _)) = 4.
|
|
switch_priority(string_tag(_)) = 5.
|
|
switch_priority(shared_with_reserved_addresses_tag(RAs, Tag)) =
|
|
switch_priority(Tag) + list.length(RAs).
|
|
% The following tags should all never occur in switches.
|
|
switch_priority(pred_closure_tag(_, _, _)) = 6.
|
|
switch_priority(type_ctor_info_tag(_, _, _)) = 6.
|
|
switch_priority(base_typeclass_info_tag(_, _, _)) = 6.
|
|
switch_priority(tabling_info_tag(_, _)) = 6.
|
|
switch_priority(deep_profiling_proc_layout_tag(_, _)) = 6.
|
|
switch_priority(table_io_decl_tag(_, _)) = 6.
|
|
|
|
type_range(type_cat_char, _, _, MinChar, MaxChar) :-
|
|
% XXX the following code uses the host's character size,
|
|
% not the target's, so it won't work if cross-compiling
|
|
% to a machine with a different character size.
|
|
% Note also that the code in dense_switch.m and the code
|
|
% in lookup_switch.m assume that char.min_char_value is 0.
|
|
char.min_char_value(MinChar),
|
|
char.max_char_value(MaxChar).
|
|
type_range(type_cat_enum, Type, ModuleInfo, 0, MaxEnum) :-
|
|
( type_to_ctor_and_args(Type, TypeCtorPrime, _) ->
|
|
TypeCtor = TypeCtorPrime
|
|
;
|
|
unexpected(this_file, "dense_switch.type_range: invalid enum type?")
|
|
),
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
map.lookup(TypeTable, TypeCtor, TypeDefn),
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
( ConsTable = TypeBody ^ du_type_cons_tag_values ->
|
|
map.count(ConsTable, TypeRange),
|
|
MaxEnum = TypeRange - 1
|
|
;
|
|
unexpected(this_file, "type_range: enum type is not d.u. type?")
|
|
).
|
|
|
|
switch_density(NumCases, Range) = Density :-
|
|
Density = (NumCases * 100) // Range.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap) :-
|
|
( type_to_ctor_and_args(Type, TypeCtorPrime, _) ->
|
|
TypeCtor = TypeCtorPrime
|
|
;
|
|
unexpected(this_file, "unknown type in get_ptag_counts")
|
|
),
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
map.lookup(TypeTable, TypeCtor, TypeDefn),
|
|
hlds_data.get_type_defn_body(TypeDefn, Body),
|
|
( ConsTable = Body ^ du_type_cons_tag_values ->
|
|
map.to_assoc_list(ConsTable, ConsList),
|
|
assoc_list.values(ConsList, TagList)
|
|
;
|
|
unexpected(this_file, "non-du type in get_ptag_counts")
|
|
),
|
|
map.init(PtagCountMap0),
|
|
get_ptag_counts_2(TagList, -1, MaxPrimary, PtagCountMap0, PtagCountMap).
|
|
|
|
:- pred get_ptag_counts_2(list(cons_tag)::in, int::in, int::out,
|
|
ptag_count_map::in, ptag_count_map::out) is det.
|
|
|
|
get_ptag_counts_2([], !MaxPrimary, !PtagCountMap).
|
|
get_ptag_counts_2([Tag | Tags], !MaxPrimary, !PtagCountMap) :-
|
|
(
|
|
( Tag = single_functor_tag, Primary = 0
|
|
; Tag = unshared_tag(Primary)
|
|
),
|
|
int.max(Primary, !MaxPrimary),
|
|
( map.search(!.PtagCountMap, Primary, _) ->
|
|
unexpected(this_file, "unshared tag is shared")
|
|
;
|
|
svmap.det_insert(Primary, sectag_none - (-1), !PtagCountMap)
|
|
)
|
|
;
|
|
Tag = shared_remote_tag(Primary, Secondary),
|
|
int.max(Primary, !MaxPrimary),
|
|
( map.search(!.PtagCountMap, Primary, Target) ->
|
|
Target = TagType - MaxSoFar,
|
|
( TagType = sectag_remote ->
|
|
true
|
|
;
|
|
unexpected(this_file, "remote tag is shared with non-remote")
|
|
),
|
|
int.max(Secondary, MaxSoFar, Max),
|
|
svmap.det_update(Primary, sectag_remote - Max, !PtagCountMap)
|
|
;
|
|
svmap.det_insert(Primary, sectag_remote - Secondary, !PtagCountMap)
|
|
)
|
|
;
|
|
Tag = shared_local_tag(Primary, Secondary),
|
|
int.max(Primary, !MaxPrimary),
|
|
( map.search(!.PtagCountMap, Primary, Target) ->
|
|
Target = TagType - MaxSoFar,
|
|
( TagType = sectag_local ->
|
|
true
|
|
;
|
|
unexpected(this_file, "local tag is shared with non-local")
|
|
),
|
|
int.max(Secondary, MaxSoFar, Max),
|
|
svmap.det_update(Primary, sectag_local - Max, !PtagCountMap)
|
|
;
|
|
svmap.det_insert(Primary, sectag_local - Secondary, !PtagCountMap)
|
|
)
|
|
;
|
|
( Tag = no_tag
|
|
; Tag = string_tag(_)
|
|
; Tag = float_tag(_)
|
|
; Tag = int_tag(_)
|
|
; Tag = pred_closure_tag(_, _, _)
|
|
; Tag = type_ctor_info_tag(_, _, _)
|
|
; Tag = base_typeclass_info_tag(_, _, _)
|
|
; Tag = tabling_info_tag(_, _)
|
|
; Tag = deep_profiling_proc_layout_tag(_, _)
|
|
; Tag = table_io_decl_tag(_, _)
|
|
; Tag = reserved_address_tag(_)
|
|
; Tag = shared_with_reserved_addresses_tag(_, _)
|
|
),
|
|
unexpected(this_file, "non-du tag in get_ptag_counts_2")
|
|
),
|
|
get_ptag_counts_2(Tags, !MaxPrimary, !PtagCountMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
group_cases_by_ptag([], !PtagCaseMap).
|
|
group_cases_by_ptag([Case0 | Cases0], !PtagCaseMap) :-
|
|
Case0 = extended_case(_Priority, Tag, ConsId, Goal),
|
|
ConsIdGoal = stag_goal(ConsId, Goal),
|
|
(
|
|
( Tag = single_functor_tag, Primary = 0
|
|
; Tag = unshared_tag(Primary)
|
|
),
|
|
( map.search(!.PtagCaseMap, Primary, _Group) ->
|
|
unexpected(this_file, "unshared tag is shared")
|
|
;
|
|
map.init(StagGoalMap0),
|
|
map.det_insert(StagGoalMap0, -1, ConsIdGoal, StagGoalMap),
|
|
svmap.det_insert(Primary, ptag_case(sectag_none, StagGoalMap),
|
|
!PtagCaseMap)
|
|
)
|
|
;
|
|
Tag = shared_remote_tag(Primary, Secondary),
|
|
( map.search(!.PtagCaseMap, Primary, Group) ->
|
|
Group = ptag_case(StagLoc, StagGoalMap0),
|
|
expect(unify(StagLoc, sectag_remote), this_file,
|
|
"remote tag is shared with non-remote"),
|
|
map.det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
|
|
svmap.det_update(Primary, ptag_case(sectag_remote, StagGoalMap),
|
|
!PtagCaseMap)
|
|
;
|
|
map.init(StagGoalMap0),
|
|
map.det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
|
|
svmap.det_insert(Primary, ptag_case(sectag_remote, StagGoalMap),
|
|
!PtagCaseMap)
|
|
)
|
|
;
|
|
Tag = shared_local_tag(Primary, Secondary),
|
|
( map.search(!.PtagCaseMap, Primary, Group) ->
|
|
Group = ptag_case(StagLoc, StagGoalMap0),
|
|
expect(unify(StagLoc, sectag_local), this_file,
|
|
"local tag is shared with non-local"),
|
|
map.det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
|
|
svmap.det_update(Primary, ptag_case(sectag_local, StagGoalMap),
|
|
!PtagCaseMap)
|
|
;
|
|
map.init(StagGoalMap0),
|
|
map.det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
|
|
svmap.det_insert(Primary, ptag_case(sectag_local, StagGoalMap),
|
|
!PtagCaseMap)
|
|
)
|
|
;
|
|
( Tag = no_tag
|
|
; Tag = string_tag(_)
|
|
; Tag = float_tag(_)
|
|
; Tag = int_tag(_)
|
|
; Tag = pred_closure_tag(_, _, _)
|
|
; Tag = type_ctor_info_tag(_, _, _)
|
|
; Tag = base_typeclass_info_tag(_, _, _)
|
|
; Tag = tabling_info_tag(_, _)
|
|
; Tag = deep_profiling_proc_layout_tag(_, _)
|
|
; Tag = table_io_decl_tag(_, _)
|
|
; Tag = reserved_address_tag(_)
|
|
; Tag = shared_with_reserved_addresses_tag(_, _)
|
|
),
|
|
unexpected(this_file, "non-du tag in group_cases_by_ptag")
|
|
),
|
|
group_cases_by_ptag(Cases0, !PtagCaseMap).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
order_ptags_by_count(PtagCountList0, PtagCaseMap0, PtagCaseList) :-
|
|
% We use selection sort.
|
|
( select_frequent_ptag(PtagCountList0, Primary, _, PtagCountList1) ->
|
|
( map.search(PtagCaseMap0, Primary, PtagCase) ->
|
|
map.delete(PtagCaseMap0, Primary, PtagCaseMap1),
|
|
order_ptags_by_count(PtagCountList1, PtagCaseMap1, PtagCaseList1),
|
|
PtagCaseList = [Primary - PtagCase | PtagCaseList1]
|
|
;
|
|
order_ptags_by_count(PtagCountList1, PtagCaseMap0, PtagCaseList)
|
|
)
|
|
;
|
|
( map.is_empty(PtagCaseMap0) ->
|
|
PtagCaseList = []
|
|
;
|
|
unexpected(this_file,
|
|
"PtagCaseMap0 is not empty in order_ptags_by_count")
|
|
)
|
|
).
|
|
|
|
% Select the most frequently used primary tag based on the number of
|
|
% secondary tags associated with it.
|
|
%
|
|
:- pred select_frequent_ptag(ptag_count_list::in, tag_bits::out,
|
|
int::out, ptag_count_list::out) is semidet.
|
|
|
|
select_frequent_ptag([PtagCount0 | PtagCountList1], Primary,
|
|
Count, PtagCountList) :-
|
|
PtagCount0 = Primary0 - (_ - Count0),
|
|
(
|
|
select_frequent_ptag(PtagCountList1, Primary1, Count1, PtagCountList2),
|
|
Count1 > Count0
|
|
->
|
|
Primary = Primary1,
|
|
Count = Count1,
|
|
PtagCountList = [PtagCount0 | PtagCountList2]
|
|
;
|
|
Primary = Primary0,
|
|
Count = Count0,
|
|
PtagCountList = PtagCountList1
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
order_ptags_by_value(Ptag, MaxPtag, PtagCaseMap0, PtagCaseList) :-
|
|
( MaxPtag >= Ptag ->
|
|
NextPtag = Ptag + 1,
|
|
( map.search(PtagCaseMap0, Ptag, PtagCase) ->
|
|
map.delete(PtagCaseMap0, Ptag, PtagCaseMap1),
|
|
order_ptags_by_value(NextPtag, MaxPtag,
|
|
PtagCaseMap1, PtagCaseList1),
|
|
PtagCaseList = [Ptag - PtagCase | PtagCaseList1]
|
|
;
|
|
order_ptags_by_value(NextPtag, MaxPtag, PtagCaseMap0, PtagCaseList)
|
|
)
|
|
;
|
|
( map.is_empty(PtagCaseMap0) ->
|
|
PtagCaseList = []
|
|
;
|
|
unexpected(this_file,
|
|
"PtagCaseMap0 is not empty in order_ptags_by_value")
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "switch_util.m".
|
|
|
|
%-----------------------------------------------------------------------------%
|