[m-dev.] diff: move code into switch_util.m
Fergus Henderson
fjh at cs.mu.OZ.AU
Thu Nov 16 18:49:12 AEDT 2000
Estimated hours taken: 2
Reorganize the code for handling switches in the MLDS and
LLDS back-ends to reduce code duplication.
compiler/switch_util.m:
New file. Contains stuff for switches that is shared
between the MLDS and LLDS back-ends.
compiler/ml_switch_gen.m:
compiler/ml_string_switch.m:
compiler/ml_tag_switch.m:
compiler/switch_gen.m:
compiler/string_switch.m:
compiler/tag_switch.m:
Move code that was duplicated in the LLDS and MLDS back-ends
into string_util.m. Change some names and import_module
declarations to match the new organization.
compiler/notes/compiler_design.html:
Document the new module switch_util.m.
Also mention ml_tag_switch.m.
Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.1
diff -u -d -r1.1 ml_string_switch.m
--- compiler/ml_string_switch.m 2000/11/09 04:08:27 1.1
+++ compiler/ml_string_switch.m 2000/11/16 07:21:15
@@ -20,11 +20,11 @@
:- interface.
:- import_module prog_data.
-:- import_module hlds_data.
-:- import_module mlds, ml_code_util, ml_switch_gen.
+:- import_module hlds_data, switch_util.
+:- import_module mlds, ml_code_util.
:- import_module llds. % XXX for code_model.
-:- pred ml_string_switch__generate(ml_cases_list::in, prog_var::in,
+:- pred ml_string_switch__generate(cases_list::in, prog_var::in,
code_model::in, can_fail::in, prog_context::in,
mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -33,7 +33,7 @@
:- implementation.
-:- import_module ml_code_gen, builtin_ops, type_util.
+:- import_module ml_code_gen, ml_switch_gen, builtin_ops, type_util.
:- import_module globals, options.
:- import_module bool, int, string, list, map, std_util, assoc_list, require.
@@ -87,9 +87,9 @@
% Compute the hash table
%
- ml_string_switch__hash_cases(Cases, HashMask, HashValsMap),
+ switch_util__string_hash_cases(Cases, HashMask, HashValsMap),
map__to_assoc_list(HashValsMap, HashValsList),
- ml_string_switch__calc_hash_slots(HashValsList, HashValsMap,
+ switch_util__calc_hash_slots(HashValsList, HashValsMap,
HashSlotsMap)
},
@@ -278,123 +278,8 @@
[FailComment | FailStatements] ++
[EndLabelStatement, EndComment]
}.
-
-:- pred ml_string_switch__hash_cases(ml_cases_list, int,
- map(int, ml_cases_list)).
-:- mode ml_string_switch__hash_cases(in, in, out) is det.
-
-ml_string_switch__hash_cases([], _, Map) :-
- map__init(Map).
-ml_string_switch__hash_cases([Case | Cases], HashMask, Map) :-
- ml_string_switch__hash_cases(Cases, HashMask, Map0),
- ( Case = case(_, string_constant(String0), _, _) ->
- String = String0
- ;
- error("ml_string_switch__hash_cases: non-string case?")
- ),
- string__hash(String, HashVal0),
- HashVal is HashVal0 /\ HashMask,
- ( map__search(Map0, HashVal, CaseList0) ->
- map__det_update(Map0, HashVal, [Case | CaseList0], Map)
- ;
- map__det_insert(Map0, HashVal, [Case], Map)
- ).
-:- type hash_slot ---> hash_slot(ml_extended_case, int).
-
-:- pred ml_string_switch__calc_hash_slots(assoc_list(int, ml_cases_list),
- map(int, ml_cases_list), map(int, hash_slot)).
-:- mode ml_string_switch__calc_hash_slots(in, in, out) is det.
-
- % ml_string_switch__calc_hash_slots(AssocList, HashMap, Map) :-
- % For each (HashVal - Case) pair in AssocList,
- % allocate a hash slot in Map for the case, as follows.
- % 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.
-
-ml_string_switch__calc_hash_slots(HashValList, HashMap, Map) :-
- map__init(Map0),
- ml_string_switch__calc_hash_slots_1(HashValList, HashMap, Map0, 0,
- Map, _).
-
-:- pred ml_string_switch__calc_hash_slots_1(assoc_list(int, ml_cases_list),
- map(int, ml_cases_list), map(int, hash_slot), int,
- map(int, hash_slot), int).
-:- mode ml_string_switch__calc_hash_slots_1(in, in, in, in, out, out) is det.
-
-ml_string_switch__calc_hash_slots_1([], _, Map, LastUsed, Map, LastUsed).
-ml_string_switch__calc_hash_slots_1([HashVal-Cases | Rest], HashMap, Map0,
- LastUsed0, Map, LastUsed) :-
- ml_string_switch__calc_hash_slots_2(Cases, HashVal, HashMap, Map0,
- LastUsed0, Map1, LastUsed1),
- ml_string_switch__calc_hash_slots_1(Rest, HashMap, Map1,
- LastUsed1, Map, LastUsed).
-
-:- pred ml_string_switch__calc_hash_slots_2(ml_cases_list, int,
- map(int, ml_cases_list), map(int, hash_slot), int,
- map(int, hash_slot), int).
-:- mode ml_string_switch__calc_hash_slots_2(in, in, in, in, in, out, out) is det.
-
-ml_string_switch__calc_hash_slots_2([], _HashVal, _HashMap, Map, LastUsed,
- Map, LastUsed).
-ml_string_switch__calc_hash_slots_2([Case | Cases], HashVal, HashMap, Map0,
- LastUsed0, Map, LastUsed) :-
- ml_string_switch__calc_hash_slots_2(Cases, HashVal, HashMap, Map0,
- LastUsed0, Map1, LastUsed1),
- ( map__contains(Map1, HashVal) ->
- ml_string_switch__follow_hash_chain(Map1, HashVal, ChainEnd),
- ml_string_switch__next_free_hash_slot(Map1, HashMap, LastUsed1,
- Next),
- map__lookup(Map1, ChainEnd, hash_slot(PrevCase, _)),
- map__det_update(Map1, ChainEnd, hash_slot(PrevCase, Next),
- Map2),
- map__det_insert(Map2, Next, hash_slot(Case, -1), Map),
- LastUsed = Next
- ;
- map__det_insert(Map1, HashVal, hash_slot(Case, -1), Map),
- LastUsed = LastUsed1
- ).
-
-:- pred ml_string_switch__follow_hash_chain(map(int, hash_slot), int, int).
-:- mode ml_string_switch__follow_hash_chain(in, in, out) is det.
-
-ml_string_switch__follow_hash_chain(Map, Slot, LastSlot) :-
- map__lookup(Map, Slot, hash_slot(_, NextSlot)),
- (
- NextSlot >= 0,
- map__contains(Map, NextSlot)
- ->
- ml_string_switch__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 ml_string_switch__next_free_hash_slot(map(int, hash_slot),
- map(int, ml_cases_list), int, int).
-:- mode ml_string_switch__next_free_hash_slot(in, in, in, out) is det.
-
-ml_string_switch__next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
- NextSlot is LastUsed + 1,
- (
- \+ map__contains(Map, NextSlot),
- \+ map__contains(H_Map, NextSlot)
- ->
- FreeSlot = NextSlot
- ;
- ml_string_switch__next_free_hash_slot(Map, H_Map, NextSlot,
- FreeSlot)
- ).
+%-----------------------------------------------------------------------------%
:- pred ml_string_switch__gen_hash_slots(int::in, int::in,
map(int, hash_slot)::in, code_model::in, prog_context::in,
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.3
diff -u -d -r1.3 ml_switch_gen.m
--- compiler/ml_switch_gen.m 2000/11/15 04:44:58 1.3
+++ compiler/ml_switch_gen.m 2000/11/16 07:22:52
@@ -84,12 +84,6 @@
prog_context::in, switch_default::out,
ml_gen_info::in, ml_gen_info::out) is det.
-% An ml_extended_case is an HLDS case annotated with some additional info.
-% XXX this is duplicated from switch_gen.m and should be moved to a new
-% module switch_util.m
-:- type ml_extended_case ---> case(int, cons_tag, cons_id, hlds_goal).
-:- type ml_cases_list == list(ml_extended_case).
-
% Succeed iff the target supports the specified construct.
:- pred target_supports_int_switch(globals::in) is semidet.
:- pred target_supports_string_switch(globals::in) is semidet.
@@ -103,19 +97,12 @@
% These ones are not yet implemented yet:
% :- import_module ml_lookup_switch.
:- import_module ml_tag_switch, ml_dense_switch, ml_string_switch.
-:- import_module ml_code_gen, ml_unify_gen, ml_code_util, type_util.
+:- import_module ml_code_gen, ml_unify_gen, ml_code_util.
+:- import_module switch_util, type_util.
:- import_module options.
:- import_module bool, int, string, map, tree, std_util, require.
-% XXX this is duplicated from switch_gen.m and should be moved to a new
-% module switch_util.m
-:- type ml_switch_category
- ---> atomic_switch % a switch on int/char/enum
- ; string_switch
- ; tag_switch
- ; other_switch.
-
%-----------------------------------------------------------------------------%
% Choose which method to use to generate the switch.
@@ -228,8 +215,8 @@
{ NumCases >= TagSize },
{ target_supports_int_switch(Globals) }
->
- ml_tag_switch__generate(TaggedCases, CaseVar, CodeModel, CanFail,
- Context, MLDS_Decls, MLDS_Statements)
+ ml_tag_switch__generate(TaggedCases, CaseVar, CodeModel,
+ CanFail, Context, MLDS_Decls, MLDS_Statements)
;
%
% Try using a "direct-mapped" switch
@@ -252,7 +239,7 @@
%-----------------------------------------------------------------------------%
-:- pred target_supports_switch(ml_switch_category::in, globals::in)
+:- pred target_supports_switch(switch_category::in, globals::in)
is semidet.
target_supports_switch(SwitchCategory, Globals) :-
(
@@ -310,7 +297,7 @@
% being switched on is an atomic type, a string, or
% something more complicated.
-:- pred ml_switch_gen__determine_category(prog_var, ml_switch_category,
+:- pred ml_switch_gen__determine_category(prog_var, switch_category,
ml_gen_info, ml_gen_info).
:- mode ml_switch_gen__determine_category(in, out, in, out) is det.
@@ -319,30 +306,14 @@
=(MLGenInfo),
{ ml_gen_info_get_module_info(MLGenInfo, ModuleInfo) },
{ type_util__classify_type(Type, ModuleInfo, TypeCategory) },
- { ml_switch_gen__type_cat_to_switch_cat(TypeCategory, SwitchCategory) }.
-
-:- pred ml_switch_gen__type_cat_to_switch_cat(builtin_type, ml_switch_category).
-:- mode ml_switch_gen__type_cat_to_switch_cat(in, out) is det.
-
-% XXX this is duplicated from switch_gen.m and should be moved to a new
-% module switch_util.m
-
-ml_switch_gen__type_cat_to_switch_cat(enum_type, atomic_switch).
-ml_switch_gen__type_cat_to_switch_cat(int_type, atomic_switch).
-ml_switch_gen__type_cat_to_switch_cat(char_type, atomic_switch).
-ml_switch_gen__type_cat_to_switch_cat(float_type, other_switch).
-ml_switch_gen__type_cat_to_switch_cat(str_type, string_switch).
-ml_switch_gen__type_cat_to_switch_cat(pred_type, other_switch).
-ml_switch_gen__type_cat_to_switch_cat(user_type, tag_switch).
-ml_switch_gen__type_cat_to_switch_cat(polymorphic_type, other_switch).
-ml_switch_gen__type_cat_to_switch_cat(tuple_type, other_switch).
+ { switch_util__type_cat_to_switch_cat(TypeCategory, SwitchCategory) }.
%-----------------------------------------------------------------------------%
% Look up the representation (tag) for the cons_id in each case.
% Also look up the priority of each tag test.
%
-:- pred ml_switch_lookup_tags(list(case), prog_var, ml_cases_list,
+:- pred ml_switch_lookup_tags(list(case), prog_var, cases_list,
ml_gen_info, ml_gen_info).
:- mode ml_switch_lookup_tags(in, in, out, in, out) is det.
@@ -351,40 +322,15 @@
{ Case = case(ConsId, Goal) },
ml_variable_type(Var, Type),
ml_cons_id_to_tag(ConsId, Type, Tag),
- { ml_switch_priority(Tag, Priority) },
+ { switch_util__switch_priority(Tag, Priority) },
{ TaggedCase = case(Priority, Tag, ConsId, Goal) },
ml_switch_lookup_tags(Cases, Var, TaggedCases).
- % Return the priority of a tag test.
- % A low number here indicates a high priority.
- % We prioritize the tag tests so that the cheapest
- % (most efficient) ones come first.
- %
-:- pred ml_switch_priority(cons_tag, int).
-:- mode ml_switch_priority(in, out) is det.
-
-% XXX this is duplicated from switch_gen.m and should be moved to a new
-% module switch_util.m
-
-ml_switch_priority(no_tag, 0). % should never occur
-ml_switch_priority(int_constant(_), 1).
-ml_switch_priority(shared_local_tag(_, _), 1).
-ml_switch_priority(unshared_tag(_), 2).
-ml_switch_priority(float_constant(_), 3).
-ml_switch_priority(shared_remote_tag(_, _), 4).
-ml_switch_priority(string_constant(_), 5).
- % The following tags should all never occur in switches.
-ml_switch_priority(pred_closure_tag(_, _, _), 6).
-ml_switch_priority(code_addr_constant(_, _), 6).
-ml_switch_priority(type_ctor_info_constant(_, _, _), 6).
-ml_switch_priority(base_typeclass_info_constant(_, _, _), 6).
-ml_switch_priority(tabling_pointer_constant(_, _), 6).
-
%-----------------------------------------------------------------------------%
% Generate a chain of if-then-elses to test each case in turn.
%
-:- pred ml_switch_generate_if_else_chain(list(ml_extended_case), prog_var,
+:- pred ml_switch_generate_if_else_chain(list(extended_case), prog_var,
code_model, can_fail, prog_context, mlds__defns, mlds__statements,
ml_gen_info, ml_gen_info).
:- mode ml_switch_generate_if_else_chain(in, in, in, in, in, out, out,
@@ -426,7 +372,7 @@
% This is used for "direct-mapped" switches, where we map a
% Mercury switch directly to a switch in the target language.
%
-:- pred ml_switch_generate_mlds_switch(list(ml_extended_case), prog_var,
+:- pred ml_switch_generate_mlds_switch(list(extended_case), prog_var,
code_model, can_fail, prog_context, mlds__defns, mlds__statements,
ml_gen_info, ml_gen_info).
:- mode ml_switch_generate_mlds_switch(in, in, in, in, in, out, out,
@@ -446,7 +392,7 @@
{ MLDS_Decls = [] },
{ MLDS_Statements = [SwitchStatement] }.
-:- pred ml_switch_generate_mlds_cases(list(ml_extended_case),
+:- pred ml_switch_generate_mlds_cases(list(extended_case),
code_model, list(mlds__switch_case), ml_gen_info, ml_gen_info).
:- mode ml_switch_generate_mlds_cases(in, in, out, in, out) is det.
@@ -456,7 +402,7 @@
ml_switch_generate_mlds_case(Case, CodeModel, MLDS_Case),
ml_switch_generate_mlds_cases(Cases, CodeModel, MLDS_Cases).
-:- pred ml_switch_generate_mlds_case(ml_extended_case, code_model,
+:- pred ml_switch_generate_mlds_case(extended_case, code_model,
mlds__switch_case, ml_gen_info, ml_gen_info).
:- mode ml_switch_generate_mlds_case(in, in, out, in, out) is det.
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.1
diff -u -d -r1.1 ml_tag_switch.m
--- compiler/ml_tag_switch.m 2000/11/15 04:44:58 1.1
+++ compiler/ml_tag_switch.m 2000/11/16 07:24:14
@@ -15,13 +15,16 @@
:- interface.
-:- import_module prog_data, hlds_data, mlds, ml_switch_gen, ml_code_util.
+:- import_module prog_data.
+:- import_module hlds_data, switch_util.
+:- import_module mlds, ml_code_util.
:- import_module llds. % XXX for code_model
+
:- import_module list.
% Generate efficient indexing code for tag based switches.
-:- pred ml_tag_switch__generate(list(ml_extended_case)::in, prog_var::in,
+:- pred ml_tag_switch__generate(list(extended_case)::in, prog_var::in,
code_model::in, can_fail::in, prog_context::in,
mlds__defns::out, mlds__statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -29,34 +32,13 @@
:- implementation.
:- import_module hlds_goal, hlds_module.
-:- import_module ml_code_gen, ml_unify_gen.
+:- import_module ml_code_gen, ml_switch_gen, ml_unify_gen.
:- import_module builtin_ops, type_util.
:- import_module assoc_list, map, int, string, require, std_util.
%-----------------------------------------------------------------------------%
-% XXX the stuff below here is duplicated from switch_gen.m;
-% it should go in a new module switch_util.m.
-
-% where is the secondary tag (if any) for this primary tag value
-:- type stag_loc ---> none ; local ; remote.
-
-% map secondary tag values (-1 stands for none) to their goal
-:- type stag_goal_map == map(int, hlds_goal).
-:- type stag_goal_list == assoc_list(int, hlds_goal).
-
-% map primary tag values to the set of their goals
-:- type ptag_case_map == map(tag_bits, pair(stag_loc, stag_goal_map)).
-:- type ptag_case_list == assoc_list(tag_bits,
- pair(stag_loc, stag_goal_map)).
-
-% map primary tag values to the number of constructors sharing them
-:- type ptag_count_map == map(tag_bits, pair(stag_loc, int)).
-:- type ptag_count_list == assoc_list(tag_bits, pair(stag_loc, int)).
-
-%-----------------------------------------------------------------------------%
-
ml_tag_switch__generate(Cases, Var, CodeModel, CanFail, Context,
MLDS_Decls, MLDS_Statements) -->
% generate the rval for the primary tag
@@ -73,13 +55,13 @@
=(Info),
{ ml_gen_info_get_module_info(Info, ModuleInfo) },
ml_variable_type(Var, Type),
- { ml_tag_switch__get_ptag_counts(Type, ModuleInfo,
+ { switch_util__get_ptag_counts(Type, ModuleInfo,
_MaxPrimary, PtagCountMap) },
{ map__to_assoc_list(PtagCountMap, PtagCountList) },
{ map__init(PtagCaseMap0) },
- { ml_tag_switch__group_cases_by_ptag(Cases, PtagCaseMap0,
+ { switch_util__group_cases_by_ptag(Cases, PtagCaseMap0,
PtagCaseMap) },
- { ml_tag_switch__order_ptags_by_count(PtagCountList, PtagCaseMap,
+ { switch_util__order_ptags_by_count(PtagCountList, PtagCaseMap,
PtagCaseList) },
% generate the switch on the primary tag
@@ -223,256 +205,5 @@
{ StagRval = const(int_const(Stag)) },
ml_gen_goal(CodeModel, Goal, MLDS_Statement),
{ MLDS_Case = [match_value(StagRval)] - MLDS_Statement }.
-
-%-----------------------------------------------------------------------------%
-
-% XXX everything from here to the end is duplicated from switch_gen.m;
-% it should go in a new module switch_util.m.
-
-%-----------------------------------------------------------------------------%
-
- % Find out how many secondary tags share each primary tag
- % of the given variable.
-
-:- pred ml_tag_switch__get_ptag_counts(prog_type, module_info, int, ptag_count_map).
-:- mode ml_tag_switch__get_ptag_counts(in, in, out, out) is det.
-
-ml_tag_switch__get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap) :-
- ( type_to_type_id(Type, TypeIdPrime, _) ->
- TypeId = TypeIdPrime
- ;
- error("unknown type in ml_tag_switch__get_ptag_counts")
- ),
- module_info_types(ModuleInfo, TypeTable),
- map__lookup(TypeTable, TypeId, TypeDefn),
- hlds_data__get_type_defn_body(TypeDefn, Body),
- ( Body = du_type(_, ConsTable, _, _) ->
- map__to_assoc_list(ConsTable, ConsList),
- ml_tag_switch__cons_list_to_tag_list(ConsList, TagList)
- ;
- error("non-du type in ml_tag_switch__get_ptag_counts")
- ),
- map__init(PtagCountMap0),
- ml_tag_switch__get_ptag_counts_2(TagList, -1, MaxPrimary,
- PtagCountMap0, PtagCountMap).
-
-:- pred ml_tag_switch__get_ptag_counts_2(list(cons_tag), int, int,
- ptag_count_map, ptag_count_map).
-:- mode ml_tag_switch__get_ptag_counts_2(in, in, out, in, out) is det.
-
-ml_tag_switch__get_ptag_counts_2([], Max, Max, PtagCountMap, PtagCountMap).
-ml_tag_switch__get_ptag_counts_2([ConsTag | TagList], MaxPrimary0, MaxPrimary,
- PtagCountMap0, PtagCountMap) :-
- ( ConsTag = unshared_tag(Primary) ->
- int__max(MaxPrimary0, Primary, MaxPrimary1),
- ( map__search(PtagCountMap0, Primary, _) ->
- error("unshared tag is shared")
- ;
- map__det_insert(PtagCountMap0, Primary, none - (-1),
- PtagCountMap1)
- )
- ; ConsTag = shared_remote_tag(Primary, Secondary) ->
- int__max(MaxPrimary0, Primary, MaxPrimary1),
- ( map__search(PtagCountMap0, Primary, Target) ->
- Target = TagType - MaxSoFar,
- ( TagType = remote ->
- true
- ;
- error("remote tag is shared with non-remote")
- ),
- int__max(Secondary, MaxSoFar, Max),
- map__det_update(PtagCountMap0, Primary, remote - Max,
- PtagCountMap1)
- ;
- map__det_insert(PtagCountMap0, Primary,
- remote - Secondary, PtagCountMap1)
- )
- ; ConsTag = shared_local_tag(Primary, Secondary) ->
- int__max(MaxPrimary0, Primary, MaxPrimary1),
- ( map__search(PtagCountMap0, Primary, Target) ->
- Target = TagType - MaxSoFar,
- ( TagType = local ->
- true
- ;
- error("local tag is shared with non-local")
- ),
- int__max(Secondary, MaxSoFar, Max),
- map__det_update(PtagCountMap0, Primary, local - Max,
- PtagCountMap1)
- ;
- map__det_insert(PtagCountMap0, Primary,
- local - Secondary, PtagCountMap1)
- )
- ;
- error("non-du tag in ml_tag_switch__get_ptag_counts_2")
- ),
- ml_tag_switch__get_ptag_counts_2(TagList, MaxPrimary1, MaxPrimary,
- PtagCountMap1, PtagCountMap).
-
-%-----------------------------------------------------------------------------%
-
- % Group together all the cases that depend on the given variable
- % having the same primary tag value.
-
-:- pred ml_tag_switch__group_cases_by_ptag(ml_cases_list,
- ptag_case_map, ptag_case_map).
-:- mode ml_tag_switch__group_cases_by_ptag(in, in, out) is det.
-
-ml_tag_switch__group_cases_by_ptag([], PtagCaseMap, PtagCaseMap).
-ml_tag_switch__group_cases_by_ptag([Case0 | Cases0], PtagCaseMap0, PtagCaseMap) :-
- Case0 = case(_Priority, Tag, _ConsId, Goal),
- ( Tag = unshared_tag(Primary) ->
- ( map__search(PtagCaseMap0, Primary, _Group) ->
- error("unshared tag is shared")
- ;
- map__init(StagGoalMap0),
- map__det_insert(StagGoalMap0, -1, Goal, StagGoalMap),
- map__det_insert(PtagCaseMap0, Primary,
- none - StagGoalMap, PtagCaseMap1)
- )
- ; Tag = shared_remote_tag(Primary, Secondary) ->
- ( map__search(PtagCaseMap0, Primary, Group) ->
- Group = StagLoc - StagGoalMap0,
- ( StagLoc = remote ->
- true
- ;
- error("remote tag is shared with non-remote")
- ),
- map__det_insert(StagGoalMap0, Secondary, Goal,
- StagGoalMap),
- map__det_update(PtagCaseMap0, Primary,
- remote - StagGoalMap, PtagCaseMap1)
- ;
- map__init(StagGoalMap0),
- map__det_insert(StagGoalMap0, Secondary, Goal,
- StagGoalMap),
- map__det_insert(PtagCaseMap0, Primary,
- remote - StagGoalMap, PtagCaseMap1)
- )
- ; Tag = shared_local_tag(Primary, Secondary) ->
- ( map__search(PtagCaseMap0, Primary, Group) ->
- Group = StagLoc - StagGoalMap0,
- ( StagLoc = local ->
- true
- ;
- error("local tag is shared with non-local")
- ),
- map__det_insert(StagGoalMap0, Secondary, Goal,
- StagGoalMap),
- map__det_update(PtagCaseMap0, Primary,
- local - StagGoalMap, PtagCaseMap1)
- ;
- map__init(StagGoalMap0),
- map__det_insert(StagGoalMap0, Secondary, Goal,
- StagGoalMap),
- map__det_insert(PtagCaseMap0, Primary,
- local - StagGoalMap, PtagCaseMap1)
- )
- ;
- error("non-du tag in ml_tag_switch__group_cases_by_ptag")
- ),
- ml_tag_switch__group_cases_by_ptag(Cases0, PtagCaseMap1, PtagCaseMap).
-
-%-----------------------------------------------------------------------------%
-
- % Order the primary tags based on the number of secondary tags
- % associated with them, putting the ones with the most secondary tags
- % first. We use selection sort.
- % Note that it is not an error for a primary tag to have no case list;
- % this can happen in semideterministic switches, or in det switches
- % where the initial inst of the switch variable is a bound(...) inst
- % representing a subtype.
-
-:- pred ml_tag_switch__order_ptags_by_count(ptag_count_list, ptag_case_map,
- ptag_case_list).
-:- mode ml_tag_switch__order_ptags_by_count(in, in, out) is det.
-
-ml_tag_switch__order_ptags_by_count(PtagCountList0, PtagCaseMap0, PtagCaseList) :-
- (
- ml_tag_switch__select_frequent_ptag(PtagCountList0,
- Primary, _, PtagCountList1)
- ->
- ( map__search(PtagCaseMap0, Primary, PtagCase) ->
- map__delete(PtagCaseMap0, Primary, PtagCaseMap1),
- ml_tag_switch__order_ptags_by_count(PtagCountList1,
- PtagCaseMap1, PtagCaseList1),
- PtagCaseList = [Primary - PtagCase | PtagCaseList1]
- ;
- ml_tag_switch__order_ptags_by_count(PtagCountList1,
- PtagCaseMap0, PtagCaseList)
- )
- ;
- ( map__is_empty(PtagCaseMap0) ->
- PtagCaseList = []
- ;
- error("PtagCaseMap0 is not empty in ml_tag_switch__order_ptags_by_count")
- )
- ).
-
- % Select the most frequently used primary tag based on the number of
- % secondary tags associated with it.
-
-:- pred ml_tag_switch__select_frequent_ptag(ptag_count_list, tag_bits, int,
- ptag_count_list).
-:- mode ml_tag_switch__select_frequent_ptag(in, out, out, out) is semidet.
-
-ml_tag_switch__select_frequent_ptag([PtagCount0 | PtagCountList1], Primary, Count,
- PtagCountList) :-
- PtagCount0 = Primary0 - (_ - Count0),
- (
- ml_tag_switch__select_frequent_ptag(PtagCountList1,
- Primary1, Count1, PtagCountList2),
- Count1 > Count0
- ->
- Primary = Primary1,
- Count = Count1,
- PtagCountList = [PtagCount0 | PtagCountList2]
- ;
- Primary = Primary0,
- Count = Count0,
- PtagCountList = PtagCountList1
- ).
-
-%-----------------------------------------------------------------------------%
-
- % 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 semideterministic switches.
-
-:- pred ml_tag_switch__order_ptags_by_value(int, int,
- ptag_case_map, ptag_case_list).
-:- mode ml_tag_switch__order_ptags_by_value(in, in, in, out) is det.
-
-ml_tag_switch__order_ptags_by_value(Ptag, MaxPtag, PtagCaseMap0, PtagCaseList) :-
- ( MaxPtag >= Ptag ->
- NextPtag is Ptag + 1,
- ( map__search(PtagCaseMap0, Ptag, PtagCase) ->
- map__delete(PtagCaseMap0, Ptag, PtagCaseMap1),
- ml_tag_switch__order_ptags_by_value(NextPtag, MaxPtag,
- PtagCaseMap1, PtagCaseList1),
- PtagCaseList = [Ptag - PtagCase | PtagCaseList1]
- ;
- ml_tag_switch__order_ptags_by_value(NextPtag, MaxPtag,
- PtagCaseMap0, PtagCaseList)
- )
- ;
- ( map__is_empty(PtagCaseMap0) ->
- PtagCaseList = []
- ;
- error("PtagCaseMap0 is not empty in order_ptags_by_value")
- )
- ).
-
-%-----------------------------------------------------------------------------%
-
-:- pred ml_tag_switch__cons_list_to_tag_list(assoc_list(cons_id, cons_tag),
- list(cons_tag)).
-:- mode ml_tag_switch__cons_list_to_tag_list(in, out) is det.
-
-ml_tag_switch__cons_list_to_tag_list([], []).
-ml_tag_switch__cons_list_to_tag_list([_ConsId - ConsTag | ConsList],
- [ConsTag | Tagslist]) :-
- ml_tag_switch__cons_list_to_tag_list(ConsList, Tagslist).
%-----------------------------------------------------------------------------%
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.34
diff -u -d -r1.34 string_switch.m
--- compiler/string_switch.m 2000/01/14 01:10:45 1.34
+++ compiler/string_switch.m 2000/11/16 07:36:46
@@ -17,7 +17,9 @@
:- interface.
-:- import_module hlds_data, hlds_goal, llds, switch_gen, code_info, prog_data.
+:- import_module prog_data, hlds_data, hlds_goal.
+:- import_module switch_util.
+:- import_module llds, code_info.
:- pred string_switch__generate(cases_list, prog_var, code_model,
can_fail, store_map, label, branch_end, branch_end, code_tree,
@@ -56,9 +58,9 @@
% Compute the hash table
%
- string_switch__hash_cases(Cases, HashMask, HashValsMap),
+ switch_util__string_hash_cases(Cases, HashMask, HashValsMap),
map__to_assoc_list(HashValsMap, HashValsList),
- string_switch__calc_hash_slots(HashValsList, HashValsMap,
+ switch_util__calc_hash_slots(HashValsList, HashValsMap,
HashSlotsMap)
},
% Note that it is safe to release the registers now,
@@ -134,119 +136,6 @@
SlotsCode))))
}.
-:- pred string_switch__hash_cases(cases_list, int, map(int, cases_list)).
-:- mode string_switch__hash_cases(in, in, out) is det.
-
-string_switch__hash_cases([], _, Map) :-
- map__init(Map).
-string_switch__hash_cases([Case | Cases], HashMask, Map) :-
- string_switch__hash_cases(Cases, HashMask, Map0),
- ( Case = case(_, string_constant(String0), _, _) ->
- String = String0
- ;
- error("string_switch__hash_cases: non-string case?")
- ),
- string__hash(String, HashVal0),
- HashVal is HashVal0 /\ HashMask,
- ( map__search(Map0, HashVal, CaseList0) ->
- map__det_update(Map0, HashVal, [Case | CaseList0], Map)
- ;
- map__det_insert(Map0, HashVal, [Case], Map)
- ).
-
-:- type hash_slot ---> hash_slot(extended_case, int).
-
-:- pred string_switch__calc_hash_slots(assoc_list(int, cases_list),
- map(int, cases_list), map(int, hash_slot)).
-:- mode string_switch__calc_hash_slots(in, in, out) is det.
-
- % string_switch__calc_hash_slots(AssocList, HashMap, Map) :-
- % For each (HashVal - Case) pair in AssocList,
- % allocate a hash slot in Map for the case, as follows.
- % 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.
-
-string_switch__calc_hash_slots(HashValList, HashMap, Map) :-
- map__init(Map0),
- string_switch__calc_hash_slots_1(HashValList, HashMap, Map0, 0, Map, _).
-
-:- pred string_switch__calc_hash_slots_1(assoc_list(int, cases_list),
- map(int, cases_list), map(int, hash_slot), int,
- map(int, hash_slot), int).
-:- mode string_switch__calc_hash_slots_1(in, in, in, in, out, out) is det.
-
-string_switch__calc_hash_slots_1([], _, Map, LastUsed, Map, LastUsed).
-string_switch__calc_hash_slots_1([HashVal-Cases | Rest], HashMap, Map0,
- LastUsed0, Map, LastUsed) :-
- string_switch__calc_hash_slots_2(Cases, HashVal, HashMap, Map0,
- LastUsed0, Map1, LastUsed1),
- string_switch__calc_hash_slots_1(Rest, HashMap, Map1,
- LastUsed1, Map, LastUsed).
-
-:- pred string_switch__calc_hash_slots_2(cases_list, int, map(int, cases_list),
- map(int, hash_slot), int, map(int, hash_slot), int).
-:- mode string_switch__calc_hash_slots_2(in, in, in, in, in, out, out) is det.
-
-string_switch__calc_hash_slots_2([], _HashVal, _HashMap, Map, LastUsed,
- Map, LastUsed).
-string_switch__calc_hash_slots_2([Case | Cases], HashVal, HashMap, Map0,
- LastUsed0, Map, LastUsed) :-
- string_switch__calc_hash_slots_2(Cases, HashVal, HashMap, Map0,
- LastUsed0, Map1, LastUsed1),
- ( map__contains(Map1, HashVal) ->
- string_switch__follow_hash_chain(Map1, HashVal, ChainEnd),
- string_switch__next_free_hash_slot(Map1, HashMap, LastUsed1,
- Next),
- map__lookup(Map1, ChainEnd, hash_slot(PrevCase, _)),
- map__det_update(Map1, ChainEnd, hash_slot(PrevCase, Next),
- Map2),
- map__det_insert(Map2, Next, hash_slot(Case, -1), Map),
- LastUsed = Next
- ;
- map__det_insert(Map1, HashVal, hash_slot(Case, -1), Map),
- LastUsed = LastUsed1
- ).
-
-:- pred string_switch__follow_hash_chain(map(int, hash_slot), int, int).
-:- mode string_switch__follow_hash_chain(in, in, out) is det.
-
-string_switch__follow_hash_chain(Map, Slot, LastSlot) :-
- map__lookup(Map, Slot, hash_slot(_, NextSlot)),
- (
- NextSlot >= 0,
- map__contains(Map, NextSlot)
- ->
- string_switch__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 string_switch__next_free_hash_slot(map(int, hash_slot),
- map(int, cases_list), int, int).
-:- mode string_switch__next_free_hash_slot(in, in, in, out) is det.
-
-string_switch__next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
- NextSlot is LastUsed + 1,
- (
- \+ map__contains(Map, NextSlot),
- \+ map__contains(H_Map, NextSlot)
- ->
- FreeSlot = NextSlot
- ;
- string_switch__next_free_hash_slot(Map, H_Map, NextSlot, FreeSlot)
- ).
-
:- pred string_switch__gen_hash_slots(int, int, map(int, hash_slot),
code_model, store_map, label, label, branch_end, branch_end,
list(maybe(rval)), list(label), list(maybe(rval)), code_tree,
@@ -354,3 +243,4 @@
string_switch__this_is_last_case(Slot1, TableSize, Table)
).
+%-----------------------------------------------------------------------------%
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.73
diff -u -d -r1.73 switch_gen.m
--- compiler/switch_gen.m 2000/09/18 11:51:45 1.73
+++ compiler/switch_gen.m 2000/11/16 07:37:33
@@ -53,26 +53,16 @@
:- mode switch_gen__generate_switch(in, in, in, in, in, in, out, in, out)
is det.
-% The following types are exported to the modules that implement
-% specialized kinds of switches.
-
-:- type extended_case ---> case(int, cons_tag, cons_id, hlds_goal).
-:- type cases_list == list(extended_case).
-
%---------------------------------------------------------------------------%
:- implementation.
:- import_module dense_switch, string_switch, tag_switch, lookup_switch.
-:- import_module code_gen, unify_gen, code_aux, type_util, code_util.
+:- import_module code_gen, unify_gen, code_aux, code_util.
+:- import_module switch_util, type_util.
:- import_module trace, globals, options.
-:- import_module bool, int, string, map, tree, std_util, require.
-:- type switch_category
- ---> atomic_switch
- ; string_switch
- ; tag_switch
- ; other_switch.
+:- import_module bool, int, string, map, tree, std_util, require.
%---------------------------------------------------------------------------%
@@ -168,20 +158,7 @@
code_info__variable_type(CaseVar, Type),
code_info__get_module_info(ModuleInfo),
{ classify_type(Type, ModuleInfo, TypeCategory) },
- { switch_gen__type_cat_to_switch_cat(TypeCategory, SwitchCategory) }.
-
-:- pred switch_gen__type_cat_to_switch_cat(builtin_type, switch_category).
-:- mode switch_gen__type_cat_to_switch_cat(in, out) is det.
-
-switch_gen__type_cat_to_switch_cat(enum_type, atomic_switch).
-switch_gen__type_cat_to_switch_cat(int_type, atomic_switch).
-switch_gen__type_cat_to_switch_cat(char_type, atomic_switch).
-switch_gen__type_cat_to_switch_cat(float_type, other_switch).
-switch_gen__type_cat_to_switch_cat(str_type, string_switch).
-switch_gen__type_cat_to_switch_cat(pred_type, other_switch).
-switch_gen__type_cat_to_switch_cat(user_type, tag_switch).
-switch_gen__type_cat_to_switch_cat(polymorphic_type, other_switch).
-switch_gen__type_cat_to_switch_cat(tuple_type, other_switch).
+ { switch_util__type_cat_to_switch_cat(TypeCategory, SwitchCategory) }.
%---------------------------------------------------------------------------%
@@ -193,29 +170,9 @@
switch_gen__lookup_tags([Case | Cases], Var, [TaggedCase | TaggedCases]) -->
{ Case = case(ConsId, Goal) },
code_info__cons_id_to_tag(Var, ConsId, Tag),
- { switch_gen__priority(Tag, Priority) },
+ { switch_util__switch_priority(Tag, Priority) },
{ TaggedCase = case(Priority, Tag, ConsId, Goal) },
switch_gen__lookup_tags(Cases, Var, TaggedCases).
-
-%---------------------------------------------------------------------------%
-
-:- pred switch_gen__priority(cons_tag, int).
-:- mode switch_gen__priority(in, out) is det.
-
- % prioritize tag tests - the most efficient ones first.
-
-switch_gen__priority(no_tag, 0). % should never occur
-switch_gen__priority(int_constant(_), 1).
-switch_gen__priority(shared_local_tag(_, _), 1).
-switch_gen__priority(unshared_tag(_), 2).
-switch_gen__priority(float_constant(_), 3).
-switch_gen__priority(shared_remote_tag(_, _), 4).
-switch_gen__priority(string_constant(_), 5).
-switch_gen__priority(pred_closure_tag(_, _, _), 6). % should never occur
-switch_gen__priority(code_addr_constant(_, _), 6). % should never occur
-switch_gen__priority(type_ctor_info_constant(_, _, _), 6).% should never occur
-switch_gen__priority(base_typeclass_info_constant(_, _, _), 6).% shouldn't occur
-switch_gen__priority(tabling_pointer_constant(_, _), 6). % shouldn't occur
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: compiler/switch_util.m
===================================================================
RCS file: switch_util.m
diff -N switch_util.m
--- /dev/null Thu Mar 30 14:06:13 2000
+++ switch_util.m Thu Nov 16 18:19:05 2000
@@ -0,0 +1,515 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000 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 switch_util.
+:- interface.
+:- import_module prog_data, hlds_goal, hlds_data, hlds_module, type_util.
+:- import_module list, assoc_list, map, std_util.
+
+%-----------------------------------------------------------------------------%
+%
+% 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 ---> 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.
+
+:- pred switch_util__type_cat_to_switch_cat(builtin_type, switch_category).
+:- mode switch_util__type_cat_to_switch_cat(in, out) is det.
+
+ % 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.
+ %
+:- pred switch_util__switch_priority(cons_tag, int).
+:- mode switch_util__switch_priority(in, out) is det.
+
+%-----------------------------------------------------------------------------%
+%
+% 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 switch_util__string_hash_cases(cases_list, int,
+ map(int, cases_list)).
+:- mode switch_util__string_hash_cases(in, in, out) is det.
+
+ % switch_util__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.
+
+:- type hash_slot ---> hash_slot(extended_case, int).
+
+:- pred switch_util__calc_hash_slots(assoc_list(int, cases_list),
+ map(int, cases_list), map(int, hash_slot)).
+:- mode switch_util__calc_hash_slots(in, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff for tag switches
+%
+
+% where is the secondary tag (if any) for this primary tag value
+:- type stag_loc ---> none ; local ; remote.
+
+% map secondary tag values (-1 stands for none) to their goal
+:- type stag_goal_map == map(int, hlds_goal).
+:- type stag_goal_list == assoc_list(int, hlds_goal).
+
+% map primary tag values to the set of their goals
+:- type ptag_case_map == map(tag_bits, pair(stag_loc, stag_goal_map)).
+:- type ptag_case_list == assoc_list(tag_bits,
+ pair(stag_loc, stag_goal_map)).
+
+% map primary tag values to the number of constructors sharing them
+:- type ptag_count_map == map(tag_bits, pair(stag_loc, int)).
+:- type ptag_count_list == assoc_list(tag_bits, pair(stag_loc, int)).
+
+ % Group together all the cases that depend on the given variable
+ % having the same primary tag value.
+
+:- pred switch_util__group_cases_by_ptag(cases_list,
+ ptag_case_map, ptag_case_map).
+:- mode switch_util__group_cases_by_ptag(in, in, 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. We use selection sort.
+ % 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 switch_util__order_ptags_by_count(ptag_count_list, ptag_case_map,
+ ptag_case_list).
+:- mode switch_util__order_ptags_by_count(in, in, out) is det.
+
+ % switch_util__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 switch_util__order_ptags_by_value(int, int, ptag_case_map,
+ ptag_case_list).
+:- mode switch_util__order_ptags_by_value(in, in, in, out) is det.
+
+ % Find out how many secondary tags share each primary tag
+ % of the given variable.
+
+:- pred switch_util__get_ptag_counts(type, module_info, int,
+ ptag_count_map).
+:- mode switch_util__get_ptag_counts(in, in, out, out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module int, string, require.
+
+%-----------------------------------------------------------------------------%
+
+switch_util__string_hash_cases([], _, Map) :-
+ map__init(Map).
+switch_util__string_hash_cases([Case | Cases], HashMask, Map) :-
+ switch_util__string_hash_cases(Cases, HashMask, Map0),
+ ( Case = case(_, string_constant(String0), _, _) ->
+ String = String0
+ ;
+ error("switch_util__string_hash_cases: non-string case?")
+ ),
+ string__hash(String, HashVal0),
+ HashVal is HashVal0 /\ HashMask,
+ ( map__search(Map0, HashVal, CaseList0) ->
+ map__det_update(Map0, HashVal, [Case | CaseList0], Map)
+ ;
+ map__det_insert(Map0, HashVal, [Case], Map)
+ ).
+
+ % switch_util__calc_hash_slots(AssocList, HashMap, Map) :-
+ % For each (HashVal - Case) pair in AssocList,
+ % allocate a hash slot in Map for the case, as follows.
+ % 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.
+
+switch_util__calc_hash_slots(HashValList, HashMap, Map) :-
+ map__init(Map0),
+ switch_util__calc_hash_slots_1(HashValList, HashMap, Map0, 0,
+ Map, _).
+
+:- pred switch_util__calc_hash_slots_1(assoc_list(int, cases_list),
+ map(int, cases_list), map(int, hash_slot), int,
+ map(int, hash_slot), int).
+:- mode switch_util__calc_hash_slots_1(in, in, in, in, out, out) is det.
+
+switch_util__calc_hash_slots_1([], _, Map, LastUsed, Map, LastUsed).
+switch_util__calc_hash_slots_1([HashVal-Cases | Rest], HashMap, Map0,
+ LastUsed0, Map, LastUsed) :-
+ switch_util__calc_hash_slots_2(Cases, HashVal, HashMap, Map0,
+ LastUsed0, Map1, LastUsed1),
+ switch_util__calc_hash_slots_1(Rest, HashMap, Map1,
+ LastUsed1, Map, LastUsed).
+
+:- pred switch_util__calc_hash_slots_2(cases_list, int,
+ map(int, cases_list), map(int, hash_slot), int,
+ map(int, hash_slot), int).
+:- mode switch_util__calc_hash_slots_2(in, in, in, in, in, out, out) is det.
+
+switch_util__calc_hash_slots_2([], _HashVal, _HashMap, Map, LastUsed,
+ Map, LastUsed).
+switch_util__calc_hash_slots_2([Case | Cases], HashVal, HashMap, Map0,
+ LastUsed0, Map, LastUsed) :-
+ switch_util__calc_hash_slots_2(Cases, HashVal, HashMap, Map0,
+ LastUsed0, Map1, LastUsed1),
+ ( map__contains(Map1, HashVal) ->
+ switch_util__follow_hash_chain(Map1, HashVal, ChainEnd),
+ switch_util__next_free_hash_slot(Map1, HashMap, LastUsed1,
+ Next),
+ map__lookup(Map1, ChainEnd, hash_slot(PrevCase, _)),
+ map__det_update(Map1, ChainEnd, hash_slot(PrevCase, Next),
+ Map2),
+ map__det_insert(Map2, Next, hash_slot(Case, -1), Map),
+ LastUsed = Next
+ ;
+ map__det_insert(Map1, HashVal, hash_slot(Case, -1), Map),
+ LastUsed = LastUsed1
+ ).
+
+:- pred switch_util__follow_hash_chain(map(int, hash_slot), int, int).
+:- mode switch_util__follow_hash_chain(in, in, out) is det.
+
+switch_util__follow_hash_chain(Map, Slot, LastSlot) :-
+ map__lookup(Map, Slot, hash_slot(_, NextSlot)),
+ (
+ NextSlot >= 0,
+ map__contains(Map, NextSlot)
+ ->
+ switch_util__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 switch_util__next_free_hash_slot(map(int, hash_slot),
+ map(int, cases_list), int, int).
+:- mode switch_util__next_free_hash_slot(in, in, in, out) is det.
+
+switch_util__next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
+ NextSlot is LastUsed + 1,
+ (
+ \+ map__contains(Map, NextSlot),
+ \+ map__contains(H_Map, NextSlot)
+ ->
+ FreeSlot = NextSlot
+ ;
+ switch_util__next_free_hash_slot(Map, H_Map, NextSlot,
+ FreeSlot)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff for categorizing switches
+%
+
+switch_util__type_cat_to_switch_cat(enum_type, atomic_switch).
+switch_util__type_cat_to_switch_cat(int_type, atomic_switch).
+switch_util__type_cat_to_switch_cat(char_type, atomic_switch).
+switch_util__type_cat_to_switch_cat(float_type, other_switch).
+switch_util__type_cat_to_switch_cat(str_type, string_switch).
+switch_util__type_cat_to_switch_cat(pred_type, other_switch).
+switch_util__type_cat_to_switch_cat(user_type, tag_switch).
+switch_util__type_cat_to_switch_cat(polymorphic_type, other_switch).
+switch_util__type_cat_to_switch_cat(tuple_type, other_switch).
+
+ % 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.
+ %
+switch_util__switch_priority(no_tag, 0). % should never occur
+switch_util__switch_priority(int_constant(_), 1).
+switch_util__switch_priority(shared_local_tag(_, _), 1).
+switch_util__switch_priority(unshared_tag(_), 2).
+switch_util__switch_priority(float_constant(_), 3).
+switch_util__switch_priority(shared_remote_tag(_, _), 4).
+switch_util__switch_priority(string_constant(_), 5).
+ % The following tags should all never occur in switches.
+switch_util__switch_priority(pred_closure_tag(_, _, _), 6).
+switch_util__switch_priority(code_addr_constant(_, _), 6).
+switch_util__switch_priority(type_ctor_info_constant(_, _, _), 6).
+switch_util__switch_priority(base_typeclass_info_constant(_, _, _), 6).
+switch_util__switch_priority(tabling_pointer_constant(_, _), 6).
+
+%-----------------------------------------------------------------------------%
+
+ % Find out how many secondary tags share each primary tag
+ % of the given variable.
+
+switch_util__get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap) :-
+ ( type_to_type_id(Type, TypeIdPrime, _) ->
+ TypeId = TypeIdPrime
+ ;
+ error("unknown type in switch_util__get_ptag_counts")
+ ),
+ module_info_types(ModuleInfo, TypeTable),
+ map__lookup(TypeTable, TypeId, TypeDefn),
+ hlds_data__get_type_defn_body(TypeDefn, Body),
+ ( Body = du_type(_, ConsTable, _, _) ->
+ map__to_assoc_list(ConsTable, ConsList),
+ switch_util__cons_list_to_tag_list(ConsList, TagList)
+ ;
+ error("non-du type in switch_util__get_ptag_counts")
+ ),
+ map__init(PtagCountMap0),
+ switch_util__get_ptag_counts_2(TagList, -1, MaxPrimary,
+ PtagCountMap0, PtagCountMap).
+
+:- pred switch_util__get_ptag_counts_2(list(cons_tag), int, int,
+ ptag_count_map, ptag_count_map).
+:- mode switch_util__get_ptag_counts_2(in, in, out, in, out) is det.
+
+switch_util__get_ptag_counts_2([], Max, Max, PtagCountMap, PtagCountMap).
+switch_util__get_ptag_counts_2([ConsTag | TagList], MaxPrimary0, MaxPrimary,
+ PtagCountMap0, PtagCountMap) :-
+ ( ConsTag = unshared_tag(Primary) ->
+ int__max(MaxPrimary0, Primary, MaxPrimary1),
+ ( map__search(PtagCountMap0, Primary, _) ->
+ error("unshared tag is shared")
+ ;
+ map__det_insert(PtagCountMap0, Primary, none - (-1),
+ PtagCountMap1)
+ )
+ ; ConsTag = shared_remote_tag(Primary, Secondary) ->
+ int__max(MaxPrimary0, Primary, MaxPrimary1),
+ ( map__search(PtagCountMap0, Primary, Target) ->
+ Target = TagType - MaxSoFar,
+ ( TagType = remote ->
+ true
+ ;
+ error("remote tag is shared with non-remote")
+ ),
+ int__max(Secondary, MaxSoFar, Max),
+ map__det_update(PtagCountMap0, Primary, remote - Max,
+ PtagCountMap1)
+ ;
+ map__det_insert(PtagCountMap0, Primary,
+ remote - Secondary, PtagCountMap1)
+ )
+ ; ConsTag = shared_local_tag(Primary, Secondary) ->
+ int__max(MaxPrimary0, Primary, MaxPrimary1),
+ ( map__search(PtagCountMap0, Primary, Target) ->
+ Target = TagType - MaxSoFar,
+ ( TagType = local ->
+ true
+ ;
+ error("local tag is shared with non-local")
+ ),
+ int__max(Secondary, MaxSoFar, Max),
+ map__det_update(PtagCountMap0, Primary, local - Max,
+ PtagCountMap1)
+ ;
+ map__det_insert(PtagCountMap0, Primary,
+ local - Secondary, PtagCountMap1)
+ )
+ ;
+ error("non-du tag in switch_util__get_ptag_counts_2")
+ ),
+ switch_util__get_ptag_counts_2(TagList, MaxPrimary1, MaxPrimary,
+ PtagCountMap1, PtagCountMap).
+
+%-----------------------------------------------------------------------------%
+
+ % Group together all the cases that depend on the given variable
+ % having the same primary tag value.
+
+switch_util__group_cases_by_ptag([], PtagCaseMap, PtagCaseMap).
+switch_util__group_cases_by_ptag([Case0 | Cases0], PtagCaseMap0, PtagCaseMap) :-
+ Case0 = case(_Priority, Tag, _ConsId, Goal),
+ ( Tag = unshared_tag(Primary) ->
+ ( map__search(PtagCaseMap0, Primary, _Group) ->
+ error("unshared tag is shared")
+ ;
+ map__init(StagGoalMap0),
+ map__det_insert(StagGoalMap0, -1, Goal, StagGoalMap),
+ map__det_insert(PtagCaseMap0, Primary,
+ none - StagGoalMap, PtagCaseMap1)
+ )
+ ; Tag = shared_remote_tag(Primary, Secondary) ->
+ ( map__search(PtagCaseMap0, Primary, Group) ->
+ Group = StagLoc - StagGoalMap0,
+ ( StagLoc = remote ->
+ true
+ ;
+ error("remote tag is shared with non-remote")
+ ),
+ map__det_insert(StagGoalMap0, Secondary, Goal,
+ StagGoalMap),
+ map__det_update(PtagCaseMap0, Primary,
+ remote - StagGoalMap, PtagCaseMap1)
+ ;
+ map__init(StagGoalMap0),
+ map__det_insert(StagGoalMap0, Secondary, Goal,
+ StagGoalMap),
+ map__det_insert(PtagCaseMap0, Primary,
+ remote - StagGoalMap, PtagCaseMap1)
+ )
+ ; Tag = shared_local_tag(Primary, Secondary) ->
+ ( map__search(PtagCaseMap0, Primary, Group) ->
+ Group = StagLoc - StagGoalMap0,
+ ( StagLoc = local ->
+ true
+ ;
+ error("local tag is shared with non-local")
+ ),
+ map__det_insert(StagGoalMap0, Secondary, Goal,
+ StagGoalMap),
+ map__det_update(PtagCaseMap0, Primary,
+ local - StagGoalMap, PtagCaseMap1)
+ ;
+ map__init(StagGoalMap0),
+ map__det_insert(StagGoalMap0, Secondary, Goal,
+ StagGoalMap),
+ map__det_insert(PtagCaseMap0, Primary,
+ local - StagGoalMap, PtagCaseMap1)
+ )
+ ;
+ error("non-du tag in switch_util__group_cases_by_ptag")
+ ),
+ switch_util__group_cases_by_ptag(Cases0, PtagCaseMap1, PtagCaseMap).
+
+%-----------------------------------------------------------------------------%
+
+ % 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.
+ %
+ % We use selection sort.
+
+switch_util__order_ptags_by_count(PtagCountList0, PtagCaseMap0, PtagCaseList) :-
+ (
+ switch_util__select_frequent_ptag(PtagCountList0,
+ Primary, _, PtagCountList1)
+ ->
+ ( map__search(PtagCaseMap0, Primary, PtagCase) ->
+ map__delete(PtagCaseMap0, Primary, PtagCaseMap1),
+ switch_util__order_ptags_by_count(PtagCountList1,
+ PtagCaseMap1, PtagCaseList1),
+ PtagCaseList = [Primary - PtagCase | PtagCaseList1]
+ ;
+ switch_util__order_ptags_by_count(PtagCountList1,
+ PtagCaseMap0, PtagCaseList)
+ )
+ ;
+ ( map__is_empty(PtagCaseMap0) ->
+ PtagCaseList = []
+ ;
+ error("PtagCaseMap0 is not empty in switch_util__order_ptags_by_count")
+ )
+ ).
+
+ % Select the most frequently used primary tag based on the number of
+ % secondary tags associated with it.
+
+:- pred switch_util__select_frequent_ptag(ptag_count_list, tag_bits, int,
+ ptag_count_list).
+:- mode switch_util__select_frequent_ptag(in, out, out, out) is semidet.
+
+switch_util__select_frequent_ptag([PtagCount0 | PtagCountList1], Primary, Count,
+ PtagCountList) :-
+ PtagCount0 = Primary0 - (_ - Count0),
+ (
+ switch_util__select_frequent_ptag(PtagCountList1,
+ Primary1, Count1, PtagCountList2),
+ Count1 > Count0
+ ->
+ Primary = Primary1,
+ Count = Count1,
+ PtagCountList = [PtagCount0 | PtagCountList2]
+ ;
+ Primary = Primary0,
+ Count = Count0,
+ PtagCountList = PtagCountList1
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % 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.
+
+switch_util__order_ptags_by_value(Ptag, MaxPtag, PtagCaseMap0, PtagCaseList) :-
+ ( MaxPtag >= Ptag ->
+ NextPtag is Ptag + 1,
+ ( map__search(PtagCaseMap0, Ptag, PtagCase) ->
+ map__delete(PtagCaseMap0, Ptag, PtagCaseMap1),
+ switch_util__order_ptags_by_value(NextPtag, MaxPtag,
+ PtagCaseMap1, PtagCaseList1),
+ PtagCaseList = [Ptag - PtagCase | PtagCaseList1]
+ ;
+ switch_util__order_ptags_by_value(NextPtag, MaxPtag,
+ PtagCaseMap0, PtagCaseList)
+ )
+ ;
+ ( map__is_empty(PtagCaseMap0) ->
+ PtagCaseList = []
+ ;
+ error("PtagCaseMap0 is not empty in order_ptags_by_value")
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred switch_util__cons_list_to_tag_list(assoc_list(cons_id, cons_tag),
+ list(cons_tag)).
+:- mode switch_util__cons_list_to_tag_list(in, out) is det.
+
+switch_util__cons_list_to_tag_list([], []).
+switch_util__cons_list_to_tag_list([_ConsId - ConsTag | ConsList],
+ [ConsTag | Tagslist]) :-
+ switch_util__cons_list_to_tag_list(ConsList, Tagslist).
+
+%-----------------------------------------------------------------------------%
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.49
diff -u -d -r1.49 tag_switch.m
--- compiler/tag_switch.m 2000/09/04 22:33:52 1.49
+++ compiler/tag_switch.m 2000/11/16 07:36:07
@@ -14,7 +14,10 @@
:- interface.
-:- import_module hlds_goal, hlds_data, prog_data, llds, switch_gen, code_info.
+:- import_module prog_data, hlds_goal, hlds_data.
+:- import_module switch_util.
+:- import_module llds, code_info.
+
:- import_module list.
% Generate intelligent indexing code for tag based switches.
@@ -33,22 +36,6 @@
:- import_module assoc_list, map, tree, bool, int, string.
:- import_module require, std_util.
-% where is the secondary tag (if any) for this primary tag value
-:- type stag_loc ---> none ; local ; remote.
-
-% map secondary tag values (-1 stands for none) to their goal
-:- type stag_goal_map == map(int, hlds_goal).
-:- type stag_goal_list == assoc_list(int, hlds_goal).
-
-% map primary tag values to the set of their goals
-:- type ptag_case_map == map(tag_bits, pair(stag_loc, stag_goal_map)).
-:- type ptag_case_list == assoc_list(tag_bits,
- pair(stag_loc, stag_goal_map)).
-
-% map primary tag values to the number of constructors sharing them
-:- type ptag_count_map == map(tag_bits, pair(stag_loc, int)).
-:- type ptag_count_list == assoc_list(tag_bits, pair(stag_loc, int)).
-
%-----------------------------------------------------------------------------%
% The idea is to generate two-level switches, first on the primary
@@ -189,11 +176,11 @@
code_info__get_proc_info(ProcInfo),
{ proc_info_vartypes(ProcInfo, VarTypes) },
{ map__lookup(VarTypes, Var, Type) },
- { tag_switch__get_ptag_counts(Type, ModuleInfo,
+ { switch_util__get_ptag_counts(Type, ModuleInfo,
MaxPrimary, PtagCountMap) },
{ map__to_assoc_list(PtagCountMap, PtagCountList) },
{ map__init(PtagCaseMap0) },
- { tag_switch__group_cases_by_ptag(Cases, PtagCaseMap0, PtagCaseMap) },
+ { switch_util__group_cases_by_ptag(Cases, PtagCaseMap0, PtagCaseMap) },
{ map__count(PtagCaseMap, PtagsUsed) },
code_info__get_globals(Globals),
@@ -274,7 +261,7 @@
(
{ PrimaryMethod = binary_search },
- { tag_switch__order_ptags_by_value(0, MaxPrimary, PtagCaseMap,
+ { switch_util__order_ptags_by_value(0, MaxPrimary, PtagCaseMap,
PtagCaseList) },
tag_switch__generate_primary_binary_search(PtagCaseList,
0, MaxPrimary, PtagRval, VarRval, CodeModel, CanFail,
@@ -282,7 +269,7 @@
no, MaybeEnd, CasesCode)
;
{ PrimaryMethod = jump_table },
- { tag_switch__order_ptags_by_value(0, MaxPrimary, PtagCaseMap,
+ { switch_util__order_ptags_by_value(0, MaxPrimary, PtagCaseMap,
PtagCaseList) },
tag_switch__generate_primary_jump_table(PtagCaseList,
0, MaxPrimary, VarRval, CodeModel, StoreMap,
@@ -295,7 +282,7 @@
{ CasesCode = tree(SwitchCode, TableCode) }
;
{ PrimaryMethod = try_chain },
- { tag_switch__order_ptags_by_count(PtagCountList, PtagCaseMap,
+ { switch_util__order_ptags_by_count(PtagCountList, PtagCaseMap,
PtagCaseList0) },
{
CanFail = cannot_fail,
@@ -311,7 +298,7 @@
MaybeEnd0, MaybeEnd, CasesCode)
;
{ PrimaryMethod = try_me_else_chain },
- { tag_switch__order_ptags_by_count(PtagCountList, PtagCaseMap,
+ { switch_util__order_ptags_by_count(PtagCountList, PtagCaseMap,
PtagCaseList) },
tag_switch__generate_primary_try_me_else_chain(PtagCaseList,
PtagRval, VarRval, CodeModel, CanFail, StoreMap,
@@ -1111,247 +1098,3 @@
).
%-----------------------------------------------------------------------------%
-
- % Find out how many secondary tags share each primary tag
- % of the given variable.
-
-:- pred tag_switch__get_ptag_counts(type, module_info, int, ptag_count_map).
-:- mode tag_switch__get_ptag_counts(in, in, out, out) is det.
-
-tag_switch__get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap) :-
- ( type_to_type_id(Type, TypeIdPrime, _) ->
- TypeId = TypeIdPrime
- ;
- error("unknown type in tag_switch__get_ptag_counts")
- ),
- module_info_types(ModuleInfo, TypeTable),
- map__lookup(TypeTable, TypeId, TypeDefn),
- hlds_data__get_type_defn_body(TypeDefn, Body),
- ( Body = du_type(_, ConsTable, _, _) ->
- map__to_assoc_list(ConsTable, ConsList),
- tag_switch__cons_list_to_tag_list(ConsList, TagList)
- ;
- error("non-du type in tag_switch__get_ptag_counts")
- ),
- map__init(PtagCountMap0),
- tag_switch__get_ptag_counts_2(TagList, -1, MaxPrimary,
- PtagCountMap0, PtagCountMap).
-
-:- pred tag_switch__get_ptag_counts_2(list(cons_tag), int, int,
- ptag_count_map, ptag_count_map).
-:- mode tag_switch__get_ptag_counts_2(in, in, out, in, out) is det.
-
-tag_switch__get_ptag_counts_2([], Max, Max, PtagCountMap, PtagCountMap).
-tag_switch__get_ptag_counts_2([ConsTag | TagList], MaxPrimary0, MaxPrimary,
- PtagCountMap0, PtagCountMap) :-
- ( ConsTag = unshared_tag(Primary) ->
- int__max(MaxPrimary0, Primary, MaxPrimary1),
- ( map__search(PtagCountMap0, Primary, _) ->
- error("unshared tag is shared")
- ;
- map__det_insert(PtagCountMap0, Primary, none - (-1),
- PtagCountMap1)
- )
- ; ConsTag = shared_remote_tag(Primary, Secondary) ->
- int__max(MaxPrimary0, Primary, MaxPrimary1),
- ( map__search(PtagCountMap0, Primary, Target) ->
- Target = TagType - MaxSoFar,
- ( TagType = remote ->
- true
- ;
- error("remote tag is shared with non-remote")
- ),
- int__max(Secondary, MaxSoFar, Max),
- map__det_update(PtagCountMap0, Primary, remote - Max,
- PtagCountMap1)
- ;
- map__det_insert(PtagCountMap0, Primary,
- remote - Secondary, PtagCountMap1)
- )
- ; ConsTag = shared_local_tag(Primary, Secondary) ->
- int__max(MaxPrimary0, Primary, MaxPrimary1),
- ( map__search(PtagCountMap0, Primary, Target) ->
- Target = TagType - MaxSoFar,
- ( TagType = local ->
- true
- ;
- error("local tag is shared with non-local")
- ),
- int__max(Secondary, MaxSoFar, Max),
- map__det_update(PtagCountMap0, Primary, local - Max,
- PtagCountMap1)
- ;
- map__det_insert(PtagCountMap0, Primary,
- local - Secondary, PtagCountMap1)
- )
- ;
- error("non-du tag in tag_switch__get_ptag_counts_2")
- ),
- tag_switch__get_ptag_counts_2(TagList, MaxPrimary1, MaxPrimary,
- PtagCountMap1, PtagCountMap).
-
-%-----------------------------------------------------------------------------%
-
- % Group together all the cases that depend on the given variable
- % having the same primary tag value.
-
-:- pred tag_switch__group_cases_by_ptag(cases_list,
- ptag_case_map, ptag_case_map).
-:- mode tag_switch__group_cases_by_ptag(in, in, out) is det.
-
-tag_switch__group_cases_by_ptag([], PtagCaseMap, PtagCaseMap).
-tag_switch__group_cases_by_ptag([Case0 | Cases0], PtagCaseMap0, PtagCaseMap) :-
- Case0 = case(_Priority, Tag, _ConsId, Goal),
- ( Tag = unshared_tag(Primary) ->
- ( map__search(PtagCaseMap0, Primary, _Group) ->
- error("unshared tag is shared")
- ;
- map__init(StagGoalMap0),
- map__det_insert(StagGoalMap0, -1, Goal, StagGoalMap),
- map__det_insert(PtagCaseMap0, Primary,
- none - StagGoalMap, PtagCaseMap1)
- )
- ; Tag = shared_remote_tag(Primary, Secondary) ->
- ( map__search(PtagCaseMap0, Primary, Group) ->
- Group = StagLoc - StagGoalMap0,
- ( StagLoc = remote ->
- true
- ;
- error("remote tag is shared with non-remote")
- ),
- map__det_insert(StagGoalMap0, Secondary, Goal,
- StagGoalMap),
- map__det_update(PtagCaseMap0, Primary,
- remote - StagGoalMap, PtagCaseMap1)
- ;
- map__init(StagGoalMap0),
- map__det_insert(StagGoalMap0, Secondary, Goal,
- StagGoalMap),
- map__det_insert(PtagCaseMap0, Primary,
- remote - StagGoalMap, PtagCaseMap1)
- )
- ; Tag = shared_local_tag(Primary, Secondary) ->
- ( map__search(PtagCaseMap0, Primary, Group) ->
- Group = StagLoc - StagGoalMap0,
- ( StagLoc = local ->
- true
- ;
- error("local tag is shared with non-local")
- ),
- map__det_insert(StagGoalMap0, Secondary, Goal,
- StagGoalMap),
- map__det_update(PtagCaseMap0, Primary,
- local - StagGoalMap, PtagCaseMap1)
- ;
- map__init(StagGoalMap0),
- map__det_insert(StagGoalMap0, Secondary, Goal,
- StagGoalMap),
- map__det_insert(PtagCaseMap0, Primary,
- local - StagGoalMap, PtagCaseMap1)
- )
- ;
- error("non-du tag in tag_switch__group_cases_by_ptag")
- ),
- tag_switch__group_cases_by_ptag(Cases0, PtagCaseMap1, PtagCaseMap).
-
-%-----------------------------------------------------------------------------%
-
- % Order the primary tags based on the number of secondary tags
- % associated with them, putting the ones with the most secondary tags
- % first. We use selection sort.
- % Note that it is not an error for a primary tag to have no case list;
- % this can happen in semideterministic switches, or in det switches
- % where the initial inst of the switch variable is a bound(...) inst
- % representing a subtype.
-
-:- pred tag_switch__order_ptags_by_count(ptag_count_list, ptag_case_map,
- ptag_case_list).
-:- mode tag_switch__order_ptags_by_count(in, in, out) is det.
-
-tag_switch__order_ptags_by_count(PtagCountList0, PtagCaseMap0, PtagCaseList) :-
- (
- tag_switch__select_frequent_ptag(PtagCountList0,
- Primary, _, PtagCountList1)
- ->
- ( map__search(PtagCaseMap0, Primary, PtagCase) ->
- map__delete(PtagCaseMap0, Primary, PtagCaseMap1),
- tag_switch__order_ptags_by_count(PtagCountList1,
- PtagCaseMap1, PtagCaseList1),
- PtagCaseList = [Primary - PtagCase | PtagCaseList1]
- ;
- tag_switch__order_ptags_by_count(PtagCountList1,
- PtagCaseMap0, PtagCaseList)
- )
- ;
- ( map__is_empty(PtagCaseMap0) ->
- PtagCaseList = []
- ;
- error("PtagCaseMap0 is not empty in tag_switch__order_ptags_by_count")
- )
- ).
-
- % Select the most frequently used primary tag based on the number of
- % secondary tags associated with it.
-
-:- pred tag_switch__select_frequent_ptag(ptag_count_list, tag_bits, int,
- ptag_count_list).
-:- mode tag_switch__select_frequent_ptag(in, out, out, out) is semidet.
-
-tag_switch__select_frequent_ptag([PtagCount0 | PtagCountList1], Primary, Count,
- PtagCountList) :-
- PtagCount0 = Primary0 - (_ - Count0),
- (
- tag_switch__select_frequent_ptag(PtagCountList1,
- Primary1, Count1, PtagCountList2),
- Count1 > Count0
- ->
- Primary = Primary1,
- Count = Count1,
- PtagCountList = [PtagCount0 | PtagCountList2]
- ;
- Primary = Primary0,
- Count = Count0,
- PtagCountList = PtagCountList1
- ).
-
-%-----------------------------------------------------------------------------%
-
- % 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 semideterministic switches.
-
-:- pred tag_switch__order_ptags_by_value(int, int,
- ptag_case_map, ptag_case_list).
-:- mode tag_switch__order_ptags_by_value(in, in, in, out) is det.
-
-tag_switch__order_ptags_by_value(Ptag, MaxPtag, PtagCaseMap0, PtagCaseList) :-
- ( MaxPtag >= Ptag ->
- NextPtag is Ptag + 1,
- ( map__search(PtagCaseMap0, Ptag, PtagCase) ->
- map__delete(PtagCaseMap0, Ptag, PtagCaseMap1),
- tag_switch__order_ptags_by_value(NextPtag, MaxPtag,
- PtagCaseMap1, PtagCaseList1),
- PtagCaseList = [Ptag - PtagCase | PtagCaseList1]
- ;
- tag_switch__order_ptags_by_value(NextPtag, MaxPtag,
- PtagCaseMap0, PtagCaseList)
- )
- ;
- ( map__is_empty(PtagCaseMap0) ->
- PtagCaseList = []
- ;
- error("PtagCaseMap0 is not empty in order_ptags_by_value")
- )
- ).
-
-%-----------------------------------------------------------------------------%
-
-:- pred tag_switch__cons_list_to_tag_list(assoc_list(cons_id, cons_tag),
- list(cons_tag)).
-:- mode tag_switch__cons_list_to_tag_list(in, out) is det.
-
-tag_switch__cons_list_to_tag_list([], []).
-tag_switch__cons_list_to_tag_list([_ConsId - ConsTag | ConsList],
- [ConsTag | Tagslist]) :-
- tag_switch__cons_list_to_tag_list(ConsList, Tagslist).
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.52
diff -u -d -r1.52 compiler_design.html
--- compiler/notes/compiler_design.html 2000/11/09 04:08:31 1.52
+++ compiler/notes/compiler_design.html 2000/11/16 07:40:49
@@ -686,6 +686,7 @@
<li> lookup_switch.m
<li> string_switch.m
<li> tag_switch.m
+ <li> switch_util.m (also used by MLDS back-end)
</ul>
<li> commit_gen.m (commits)
<li> pragma_c_gen.m (embedded C code)
@@ -924,9 +925,13 @@
<dl>
<dt> ml_unify_gen.m
<dt> ml_call_gen.m
- <dt> ml_switch_gen.m
- <dt> ml_string_switch.m
- <dt> ml_dense_switch.m
+ <dt> ml_switch_gen.m, which in turn has sub-modules
+ <ul>
+ <li> ml_dense_switch.m
+ <li> ml_string_switch.m
+ <li> ml_tag_switch.m
+ <li> switch_util.m (also used by MLDS back-end)
+ </ul>
<dl>
The module ml_code_util.m provides utility routines for
MLDS code generation. The module ml_util.m provides some
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
| of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list