[m-rev.] for review: multi-cons-id switch arms for MLDS
Zoltan Somogyi
zs at csse.unimelb.edu.au
Wed Aug 19 18:59:08 AEST 2009
For review by anyone.
Zoltan.
Implement multi-arm switches for the MLDS backend. When possible, the code of a
switch arm that has more than one cons_id is included in the output only once,
though of course with a condition that causes it to be executed for any of its
matching cons_ids. However, in the case of a tag switch in which a switch arm
has cons_ids with different primary tags, at least one of which has a
secondary tag that requires a switch on *it*, we duplicate the MLDS code of the
switch arm (we generate one copy for each such primary tag).
The diff yields a speedup of 0.4% on speedtest and a 0.5% reduction in code
size, but the main reason for it is so that programmers don't have any
incentive anymore to prefer an if-then-else chain to a switch for code
that is logically a switch with a default case that applies to many cons_ids.
compiler/handle_options.m:
Keep disabling multi-arm switches for non-C MLDS backends, but stop
disabling it for the C MLDS backend.
compiler/hlds_goal.m:
Add a case number to the tagged_case type. This is to allow us to
create maps that effectively function as maps from pieces of code
(the code generated for the goal in the tagged case) to other things
(various forms of the switch conditions in which that code applies)
without making the code itself the key in the map; we can use the
code's associated case number as the key instead.
compiler/mlds.m:
Change the representation of the match conditions of a switch arm
from just a simple list of conditions to a first condition and a list
of other conditions. This enforces the invariant that the switch arm
must always apply in at least one condition.
compiler/ml_string_switch.m:
compiler/ml_switch_gen.m:
compiler/ml_tag_switch.m:
Implement the above.
In ml_switch_gen.m, change the structure of the predicate that decides
which code generation scheme to employ from an if-then-else chain
to being basically a switch. This structure, which is modelled on the
one used in the LLDS code generator, should be significantly clearer.
As part of this change of structure, sort the cases by the cost of the
tag tests only if the chosen code generation wants the cases sorted in
this way.
compiler/switch_util.m:
Add facilities for grouping together primary tags that both have
exactly the same code, so that we don't have to duplicate its code.
This is possible only when neither primary tag is shared by more
than one cons_id. This grouping benefits even the LLDS backend.
This involved separating out the types and predicates that are intended
for use in compilation schemes in which more than one switch value can
share the same piece of code (such as switches or if-then-else chains
in C) from those intended for use in compilation in which this is not
possible (such as lookup tables).
Replace several uses of pairs with named types and function symbols.
Delete a predicate that isn't needed anymore.
Add a predicate to support the fix to switch_gen.m.
compiler/switch_gen.m:
Fix an old oversight. When I added multi-arm switches for the LLDS
backend, I did not update the test for whether the switch is big enough
for each kind of nontrivial indexing to count cons_ids rather than
switch arms (the benefit of smart indexing is proportional to the
former). This diff fixes that.
compiler/ml_unify_gen.m:
Change the interface of some predicates to make them more useful
for generating code for switches.
compiler/tag_switch.m:
Conform to the changes in switch_util.m.
compiler/ml_simplify_switch.m:
Conform to the changes above.
Rename some predicates to better reflect their purpose.
compiler/dense_switch.m:
compiler/lookup_switch.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_tailcall.m:
compiler/ml_util.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
compiler/switch_case.m:
Conform to the changes above.
tests/hard_coded/multi_arm_switch_2.{m,exp}:
tests/hard_coded/string_switch.{m,exp}:
New test cases to exercise the new functionality.
tests/hard_coded/Mmakefile:
Enable the new tests.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/dense_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dense_switch.m,v
retrieving revision 1.71
diff -u -b -r1.71 dense_switch.m
--- compiler/dense_switch.m 6 Jan 2009 03:56:25 -0000 1.71
+++ compiler/dense_switch.m 15 Jul 2009 03:48:28 -0000
@@ -196,7 +196,7 @@
generate_dense_case(VarName, CodeModel, SwitchGoalInfo, EndLabel,
TaggedCase, Code, !IndexMap, !MaybeEnd, !CI) :-
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, Goal),
project_cons_name_and_tag(TaggedMainConsId, MainConsName, MainConsTag),
list.map2(project_cons_name_and_tag, TaggedOtherConsIds,
OtherConsNames, OtherConsTags),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.337
diff -u -b -r1.337 handle_options.m
--- compiler/handle_options.m 10 Jul 2009 01:30:36 -0000 1.337
+++ compiler/handle_options.m 17 Aug 2009 11:59:57 -0000
@@ -741,7 +741,6 @@
(
Target = target_x86_64,
globals.set_option(use_local_vars, bool(no), !Globals)
-
;
( Target = target_asm
; Target = target_c
@@ -913,7 +912,7 @@
bool(yes), !Globals),
option_implies(find_all_recompilation_reasons, verbose_recompilation,
bool(yes), !Globals),
- %
+
% Disable `--smart-recompilation' for compilation options which either
% do not produce a compiled output file or for which smart
% recompilation will not work.
@@ -1095,7 +1094,7 @@
% or with trailing; see the comments in runtime/mercury_grade.h.
globals.lookup_bool_option(!.Globals, use_trail, UseTrail),
- globals.lookup_bool_option(!.Globals, highlevel_code, HighLevel),
+ globals.lookup_bool_option(!.Globals, highlevel_code, HighLevelCode),
globals.lookup_bool_option(!.Globals, use_minimal_model_stack_copy,
UseMinimalModelStackCopy),
globals.lookup_bool_option(!.Globals, use_minimal_model_own_stacks,
@@ -1110,7 +1109,7 @@
"at once", !Errors)
;
UseMinimalModel = yes,
- HighLevel = yes
+ HighLevelCode = yes
->
add_error("minimal model tabling is incompatible "
++ "with high level code", !Errors)
@@ -1134,8 +1133,20 @@
option_implies(highlevel_code, mutable_always_boxed, bool(no),
!Globals),
- option_implies(highlevel_code, allow_multi_arm_switches, bool(no),
- !Globals),
+ % Currently, multi-arm switches % have been tested only for the LLDS
+ % backend (which always generates C) and for the MLDS backend when
+ % it is generating C code.
+ (
+ Target = target_c
+ ;
+ ( Target = target_x86_64
+ ; Target = target_asm
+ ; Target = target_il
+ ; Target = target_java
+ ; Target = target_erlang
+ ),
+ globals.set_option(allow_multi_arm_switches, bool(no), !Globals)
+ ),
option_implies(target_debug, strip, bool(no), !Globals),
@@ -1348,7 +1359,7 @@
(
ProfileDeep = yes,
(
- HighLevel = no,
+ HighLevelCode = no,
Target = target_c
->
true
@@ -1391,11 +1402,11 @@
globals.set_option(optimize_constructor_last_call, bool(no),
!Globals),
(
- HighLevel = yes,
+ HighLevelCode = yes,
add_error("term size profiling is incompatible "
++ "with high level code", !Errors)
;
- HighLevel = no
+ HighLevelCode = no
)
;
true
@@ -1403,7 +1414,7 @@
(
( given_trace_level_is_none(TraceLevel) = yes
- ; HighLevel = no, Target = target_c
+ ; HighLevelCode = no, Target = target_c
; Target = target_il
)
->
@@ -1526,7 +1537,7 @@
globals.lookup_bool_option(!.Globals, put_nondet_env_on_heap,
PutNondetEnvOnHeap),
(
- HighLevel = yes,
+ HighLevelCode = yes,
GC_Method = gc_accurate,
PutNondetEnvOnHeap = yes
->
@@ -1990,10 +2001,10 @@
% may be back end specific, since different back ends have
% different performance tradeoffs.
(
- HighLevel = no,
+ HighLevelCode = no,
globals.set_option(compare_specialization, int(13), !Globals)
;
- HighLevel = yes,
+ HighLevelCode = yes,
globals.set_option(compare_specialization, int(14), !Globals)
)
;
@@ -2028,10 +2039,10 @@
!IO),
(
- HighLevel = no,
+ HighLevelCode = no,
postprocess_options_lowlevel(!Globals)
;
- HighLevel = yes
+ HighLevelCode = yes
),
postprocess_options_libgrades(!Globals, !Errors),
globals.io_set_globals(!.Globals, !IO)
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.208
diff -u -b -r1.208 hlds_goal.m
--- compiler/hlds_goal.m 16 Jul 2009 07:27:12 -0000 1.208
+++ compiler/hlds_goal.m 16 Jul 2009 07:28:34 -0000
@@ -1001,6 +1001,9 @@
tagged_case_first_functor :: tagged_cons_id,
tagged_case_later_functors :: list(tagged_cons_id),
+ % An identifier of the switch arm.
+ tagged_case_id :: int,
+
% The code of the switch arm.
tagged_case_goal :: hlds_goal
).
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.82
diff -u -b -r1.82 lookup_switch.m
--- compiler/lookup_switch.m 6 Jan 2009 03:56:26 -0000 1.82
+++ compiler/lookup_switch.m 15 Jul 2009 03:48:41 -0000
@@ -300,7 +300,7 @@
filter_out_failing_cases([], !RevTaggedCases, !SwitchCanFail).
filter_out_failing_cases([Case | Cases], !RevTaggedCases, !SwitchCanFail) :-
- Case = tagged_case(_, _, Goal),
+ Case = tagged_case(_, _, _, Goal),
Goal = hlds_goal(GoalExpr, _),
( GoalExpr = disj([]) ->
!:SwitchCanFail = can_fail
@@ -322,7 +322,7 @@
generate_constants_for_lookup_switch([TaggedCase | TaggedCases], Vars,
StoreMap, MaybeLiveness, !IndexMap, !MaybeEnd, !ResumeVars,
!GoalsMayModifyTrail, !CI) :-
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, Goal),
Goal = hlds_goal(GoalExpr, GoalInfo),
% Goals with these features need special treatment in generate_goal.
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.138
diff -u -b -r1.138 ml_code_util.m
--- compiler/ml_code_util.m 11 Jun 2009 07:00:13 -0000 1.138
+++ compiler/ml_code_util.m 11 Jun 2009 07:07:38 -0000
@@ -2318,9 +2318,9 @@
fixup_newobj_info::in, fixup_newobj_info::out) is det.
fixup_newobj_in_case(Case0, Case, !Fixup) :-
- Case0 = mlds_switch_case(Conds, Statement0),
+ Case0 = mlds_switch_case(FirstCond, LaterConds, Statement0),
fixup_newobj_in_statement(Statement0, Statement, !Fixup),
- Case = mlds_switch_case(Conds, Statement).
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement).
:- pred fixup_newobj_in_maybe_statement(maybe(statement)::in,
maybe(statement)::out,
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.104
diff -u -b -r1.104 ml_elim_nested.m
--- compiler/ml_elim_nested.m 10 Jul 2009 05:07:25 -0000 1.104
+++ compiler/ml_elim_nested.m 14 Jul 2009 04:58:46 -0000
@@ -1522,10 +1522,11 @@
:- mode flatten_case(in(chain), in, out, in, out) is det.
flatten_case(Action, Case0, Case, !Info) :-
- Case0 = mlds_switch_case(Conds0, Statement0),
- fixup_case_conds(Action, !.Info, Conds0, Conds),
+ Case0 = mlds_switch_case(FirstCond0, LaterConds0, Statement0),
+ fixup_case_cond(Action, !.Info, FirstCond0, FirstCond),
+ fixup_case_conds(Action, !.Info, LaterConds0, LaterConds),
flatten_statement(Action, Statement0, Statement, !Info),
- Case = mlds_switch_case(Conds, Statement).
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement).
:- pred flatten_default(action, mlds_switch_default, mlds_switch_default,
elim_info, elim_info).
@@ -2348,7 +2349,7 @@
cases_contains_defn(Cases, Defn) :-
list.member(Case, Cases),
- Case = mlds_switch_case(_MatchConds, Statement),
+ Case = mlds_switch_case(_FirstMatchCond, _LaterMatchConds, Statement),
statement_contains_defn(Statement, Defn).
:- pred default_contains_defn(mlds_switch_default::in, mlds_defn::out)
@@ -2489,10 +2490,11 @@
:- mode add_unchain_stack_to_case(in(chain), in, out, in, out) is det.
add_unchain_stack_to_case(Action, Case0, Case, !Info) :-
- Case0 = mlds_switch_case(Conds0, Statement0),
- fixup_case_conds(Action, !.Info, Conds0, Conds),
+ Case0 = mlds_switch_case(FirstCond0, LaterConds0, Statement0),
+ fixup_case_cond(Action, !.Info, FirstCond0, FirstCond),
+ fixup_case_conds(Action, !.Info, LaterConds0, LaterConds),
add_unchain_stack_to_statement(Action, Statement0, Statement, !Info),
- Case = mlds_switch_case(Conds, Statement).
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement).
:- pred add_unchain_stack_to_default(action,
mlds_switch_default, mlds_switch_default, elim_info, elim_info).
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.57
diff -u -b -r1.57 ml_optimize.m
--- compiler/ml_optimize.m 10 Jun 2009 06:26:20 -0000 1.57
+++ compiler/ml_optimize.m 10 Jun 2009 06:28:41 -0000
@@ -204,9 +204,9 @@
mlds_switch_case::in, mlds_switch_case::out) is det.
optimize_in_case(OptInfo, Case0, Case) :-
- Case0 = mlds_switch_case(Conds, Statement0),
+ Case0 = mlds_switch_case(FirstCond, LaterConds, Statement0),
optimize_in_statement(OptInfo, Statement0, Statement),
- Case = mlds_switch_case(Conds, Statement).
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement).
:- pred optimize_in_default(opt_info::in,
mlds_switch_default::in, mlds_switch_default::out) is det.
@@ -1167,10 +1167,12 @@
var_elim_info::in, var_elim_info::out) is det.
eliminate_var_in_case(Case0, Case, !VarElimInfo) :-
- Case0 = mlds_switch_case(Conds0, Statement0),
- list.map_foldl(eliminate_var_in_case_cond, Conds0, Conds, !VarElimInfo),
+ Case0 = mlds_switch_case(FirstCond0, LaterConds0, Statement0),
+ eliminate_var_in_case_cond(FirstCond0, FirstCond, !VarElimInfo),
+ list.map_foldl(eliminate_var_in_case_cond, LaterConds0, LaterConds,
+ !VarElimInfo),
eliminate_var_in_statement(Statement0, Statement, !VarElimInfo),
- Case = mlds_switch_case(Conds, Statement).
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement).
:- pred eliminate_var_in_default(
mlds_switch_default::in, mlds_switch_default::out,
Index: compiler/ml_simplify_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_simplify_switch.m,v
retrieving revision 1.28
diff -u -b -r1.28 ml_simplify_switch.m
--- compiler/ml_simplify_switch.m 10 Jun 2009 06:26:20 -0000 1.28
+++ compiler/ml_simplify_switch.m 6 Jul 2009 09:26:07 -0000
@@ -109,7 +109,7 @@
Cases = [SingleCase],
Default = default_is_unreachable
->
- SingleCase = mlds_switch_case(_MatchCondition, CaseStatement),
+ SingleCase = mlds_switch_case(_FirstCond, _LaterConds, CaseStatement),
Statement = CaseStatement
;
Stmt = Stmt0,
@@ -182,7 +182,7 @@
NumCases > 2,
% The switch needs to be dense enough.
- find_first_and_last_case(Cases, FirstCaseVal, LastCaseVal),
+ find_min_and_max_in_cases(Cases, FirstCaseVal, LastCaseVal),
CasesRange = LastCaseVal - FirstCaseVal + 1,
Density = switch_density(NumCases, CasesRange),
Density > ReqDensity.
@@ -220,7 +220,7 @@
),
NeedRangeCheck = yes
),
- find_first_and_last_case(Cases, FirstCaseVal, LastCaseVal),
+ find_min_and_max_in_cases(Cases, FirstCaseVal, LastCaseVal),
FirstVal = FirstCaseVal,
LastVal = LastCaseVal
).
@@ -229,32 +229,34 @@
% Find the highest and lowest case values in a list of cases.
%
-:- pred find_first_and_last_case(list(mlds_switch_case)::in,
+:- pred find_min_and_max_in_cases(list(mlds_switch_case)::in,
int::out, int::out) is det.
-find_first_and_last_case(Cases, Min, Max) :-
- list.foldl2(find_first_and_last_case_2, Cases, 0, Min, 0, Max).
+find_min_and_max_in_cases(Cases, Min, Max) :-
+ list.foldl2(find_min_and_max_in_case, Cases,
+ int.max_int, Min, int.min_int, Max).
-:- pred find_first_and_last_case_2(mlds_switch_case::in,
+:- pred find_min_and_max_in_case(mlds_switch_case::in,
int::in, int::out, int::in, int::out) is det.
-find_first_and_last_case_2(Case, !Min, !Max) :-
- Case = mlds_switch_case(CaseConds, _CaseStatement),
- list.foldl2(find_first_and_last_case_3, CaseConds, !Min, !Max).
+find_min_and_max_in_case(Case, !Min, !Max) :-
+ Case = mlds_switch_case(FirstCond, LaterConds, _CaseStatement),
+ find_min_and_max_in_case_cond(FirstCond, !Min, !Max),
+ list.foldl2(find_min_and_max_in_case_cond, LaterConds, !Min, !Max).
-:- pred find_first_and_last_case_3(mlds_case_match_cond::in,
+:- pred find_min_and_max_in_case_cond(mlds_case_match_cond::in,
int::in, int::out, int::in, int::out) is det.
-find_first_and_last_case_3(match_value(Rval), !Min, !Max) :-
+find_min_and_max_in_case_cond(match_value(Rval), !Min, !Max) :-
(
Rval = ml_const(mlconst_int(Val))
->
int.min(Val, !Min),
int.max(Val, !Max)
;
- unexpected(this_file, "find_first_and_last_case_3: non-int case")
+ unexpected(this_file, "find_min_and_max_in_case_cond: non-int case")
).
-find_first_and_last_case_3(match_range(MinRval, MaxRval),
+find_min_and_max_in_case_cond(match_range(MinRval, MaxRval),
!Min, !Max) :-
(
MinRval = ml_const(mlconst_int(RvalMin)),
@@ -263,7 +265,7 @@
int.min(RvalMin, !Min),
int.max(RvalMax, !Max)
;
- unexpected(this_file, "find_first_and_last_case_3: non-int case")
+ unexpected(this_file, "find_min_and_max_in_case_cond: non-int case")
).
%-----------------------------------------------------------------------------%
@@ -365,12 +367,11 @@
list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-generate_case(Case, EndLabel, CaseLabelsMap0, CaseLabelsMap,
- Decls, Statements, !Info) :-
- Case = mlds_switch_case(MatchCondition, CaseStatement),
+generate_case(Case, EndLabel, !CaseLabelsMap, Decls, Statements, !Info) :-
+ Case = mlds_switch_case(FirstCond, LaterConds, CaseStatement),
ml_gen_new_label(ThisLabel, !Info),
- insert_cases_into_map(MatchCondition, ThisLabel,
- CaseLabelsMap0, CaseLabelsMap),
+ insert_case_into_map(ThisLabel, FirstCond, !CaseLabelsMap),
+ list.foldl(insert_case_into_map(ThisLabel), LaterConds, !CaseLabelsMap),
CaseStatement = statement(_, MLDS_Context),
LabelComment = statement(ml_stmt_atomic(comment("case of dense switch")),
MLDS_Context),
@@ -390,25 +391,19 @@
:- type case_labels_map == map(int, mlds_label).
-:- pred insert_cases_into_map(mlds_case_match_conds::in, mlds_label::in,
+:- pred insert_case_into_map(mlds_label::in, mlds_case_match_cond::in,
case_labels_map::in, case_labels_map::out) is det.
-insert_cases_into_map([], _ThisLabel, !CaseLabelsMap).
-insert_cases_into_map([Cond|Conds], ThisLabel, !CaseLabelsMap) :-
- insert_case_into_map(Cond, ThisLabel, !CaseLabelsMap),
- insert_cases_into_map(Conds, ThisLabel, !CaseLabelsMap).
-
-:- pred insert_case_into_map(mlds_case_match_cond::in, mlds_label::in,
- case_labels_map::in, case_labels_map::out) is det.
-
-insert_case_into_map(match_value(Rval), ThisLabel, !CaseLabelsMap) :-
+insert_case_into_map(ThisLabel, Cond, !CaseLabelsMap) :-
+ (
+ Cond = match_value(Rval),
( Rval = ml_const(mlconst_int(Val)) ->
map.det_insert(!.CaseLabelsMap, Val, ThisLabel, !:CaseLabelsMap)
;
unexpected(this_file, "insert_case_into_map: non-int case")
- ).
-insert_case_into_map(match_range(MinRval, MaxRval), ThisLabel,
- !CaseLabelsMap) :-
+ )
+ ;
+ Cond = match_range(MinRval, MaxRval),
(
MinRval = ml_const(mlconst_int(Min)),
MaxRval = ml_const(mlconst_int(Max))
@@ -416,6 +411,7 @@
insert_range_into_map(Min, Max, ThisLabel, !CaseLabelsMap)
;
unexpected(this_file, "insert_case_into_map: non-int case")
+ )
).
:- pred insert_range_into_map(int::in, int::in, mlds_label::in,
@@ -458,7 +454,7 @@
% Convert an int switch to a chain of if-then-elses that test each case
% in turn.
%
-:- func ml_switch_to_if_else_chain(mlds_switch_cases, mlds_switch_default,
+:- func ml_switch_to_if_else_chain(list(mlds_switch_case), mlds_switch_default,
mlds_rval, mlds_context) = statement.
ml_switch_to_if_else_chain([], Default, _Rval, MLDS_Context) = Statement :-
@@ -473,14 +469,15 @@
).
ml_switch_to_if_else_chain([Case | Cases], Default, SwitchRval, MLDS_Context) =
Statement :-
- Case = mlds_switch_case(MatchConditions, CaseStatement),
+ Case = mlds_switch_case(FirstMatchCond, LaterMatchConds, CaseStatement),
(
Cases = [],
Default = default_is_unreachable
->
Statement = CaseStatement
;
- CaseMatchedRval = ml_gen_case_match_conds(MatchConditions, SwitchRval),
+ AllMatchConds = [FirstMatchCond | LaterMatchConds],
+ CaseMatchedRval = ml_gen_case_match_conds(AllMatchConds, SwitchRval),
RestStatement = ml_switch_to_if_else_chain(Cases, Default, SwitchRval,
MLDS_Context),
IfStmt = ml_stmt_if_then_else(CaseMatchedRval, CaseStatement,
@@ -492,7 +489,8 @@
% case conditions matches the specified rval (which must have integral
% type).
%
-:- func ml_gen_case_match_conds(mlds_case_match_conds, mlds_rval) = mlds_rval.
+:- func ml_gen_case_match_conds(list(mlds_case_match_cond), mlds_rval)
+ = mlds_rval.
ml_gen_case_match_conds([], _) = ml_const(mlconst_false).
ml_gen_case_match_conds([Cond], SwitchRval) =
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.39
diff -u -b -r1.39 ml_string_switch.m
--- compiler/ml_string_switch.m 10 Jun 2009 06:26:20 -0000 1.39
+++ compiler/ml_string_switch.m 17 Aug 2009 10:10:47 -0000
@@ -45,12 +45,14 @@
:- import_module ml_backend.ml_code_gen.
:- import_module ml_backend.ml_simplify_switch.
+:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module string.
+:- import_module svmap.
:- import_module unit.
%-----------------------------------------------------------------------------%
@@ -96,7 +98,6 @@
% Determine how big to make the hash table. Currently we round the number
% of cases up to the nearest power of two, and then double it. This should
% hopefully ensure that we don't get too many hash collisions.
- %
list.length(Cases, NumCases),
int.log2(NumCases, LogNumCases),
int.pow(2, LogNumCases, RoundedNumCases),
@@ -104,16 +105,18 @@
HashMask = TableSize - 1,
% Compute the hash table.
- switch_util.string_hash_cases(Cases, HashMask,
- represent_tagged_case_by_itself, unit, _, unit, _, unit, _,
- HashValsMap),
+ string_hash_cases(Cases, HashMask,
+ gen_tagged_case_code_for_string_switch(CodeModel),
+ map.init, CodeMap, unit, _, !Info, HashValsMap),
map.to_assoc_list(HashValsMap, HashValsList),
- switch_util.calc_string_hash_slots(HashValsList, HashValsMap,
- HashSlotsMap),
+ calc_string_hash_slots(HashValsList, HashValsMap, HashSlotsMap),
% Generate the code for when the hash lookup fails.
(
CodeModel = model_det,
+ % This can happen if the initial inst of the switched-on variable
+ % shows that we know a finite set of strings that the variable can be
+ % bound to.
FailComment =
statement(ml_stmt_atomic(comment("switch cannot fail")),
MLDS_Context),
@@ -128,8 +131,11 @@
),
% Generate the code etc. for the hash table.
- ml_gen_string_hash_slots(0, TableSize, HashSlotsMap, CodeModel,
- Context, Strings, NextSlots, SlotsCases, !Info),
+ ml_gen_string_hash_slots(0, TableSize, HashSlotsMap,
+ Strings, NextSlots, map.init, RevMap),
+ map.to_assoc_list(RevMap, RevList),
+ generate_string_switch_arms(CodeMap, RevList, [], SlotsCases0),
+ list.sort(SlotsCases0, SlotsCases),
% Generate the following local constant declarations:
% static const int next_slots_table = { <NextSlots> };
@@ -237,63 +243,123 @@
%-----------------------------------------------------------------------------%
-:- pred ml_gen_string_hash_slots(int::in, int::in,
- map(int, string_hash_slot(tagged_case))::in, code_model::in,
- prog_context::in, list(mlds_initializer)::out, list(mlds_initializer)::out,
- list(mlds_switch_case)::out,
+:- pred gen_tagged_case_code_for_string_switch(code_model::in,
+ tagged_case::in, int::out,
+ map(int, statement)::in, map(int, statement)::out, unit::in, unit::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_string_hash_slots(Slot, TableSize, HashSlotMap, CodeModel, Context,
- Strings, NextSlots, MLDS_Cases, !Info) :-
+gen_tagged_case_code_for_string_switch(CodeModel, TaggedCase, CaseNum,
+ !CodeMap, !Unit, !Info) :-
+ TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds,
+ CaseNum, Goal),
+ ml_gen_goal_as_block(CodeModel, Goal, GoalStatement, !Info),
+ MainString = gen_string_switch_case_comment(MainTaggedConsId),
+ OtherStrings = list.map(gen_string_switch_case_comment,
+ OtherTaggedConsIds),
+ Strings = string.join_list(", ", [MainString | OtherStrings]),
+ % Note that the order of the strings in the comment will in general
+ % not match the order of the hash slots for which the case applies.
+ % In other words, if e.g. OtherTaggedConsIds has two elements and
+ % CaseStatement has the C code "case Slot1: case Slot2: case Slot3:"
+ % generated in front of it, Slot1 can be the slot of any of
+ % MainTaggedConsId and the two OtherTaggedConsIds; it will be the slot
+ % of MainTaggedConsId only by accident.
+ CommentString = "case " ++ Strings,
+ Goal = hlds_goal(_GoalExpr, GoalInfo),
+ Context = goal_info_get_context(GoalInfo),
+ MLDS_Context = mlds_make_context(Context),
+ Comment = statement(ml_stmt_atomic(comment(CommentString)),
+ MLDS_Context),
+ CaseStatement = statement(ml_stmt_block([], [Comment, GoalStatement]),
+ MLDS_Context),
+ svmap.det_insert(CaseNum, CaseStatement, !CodeMap).
+
+:- func gen_string_switch_case_comment(tagged_cons_id) = string.
+
+gen_string_switch_case_comment(TaggedConsId) = String :-
+ TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
+ ( ConsTag = string_tag(ConsString) ->
+ String = """" ++ ConsString ++ """"
+ ;
+ unexpected(this_file, "gen_string_switch_case_comment: non-string tag")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % A list of all the hash slots that all have the same code. The list is
+ % stored in reversed form.
+ %
+:- type hash_slots
+ ---> hash_slots(int, list(int)).
+
+ % Maps case numbers (each of which identifies the code of one switch arm)
+ % to the hash slots that share that code.
+ %
+:- type hash_slot_rev_map == map(int, hash_slots).
+
+:- pred ml_gen_string_hash_slots(int::in, int::in,
+ map(int, string_hash_slot(int))::in,
+ list(mlds_initializer)::out, list(mlds_initializer)::out,
+ hash_slot_rev_map::in, hash_slot_rev_map::out) is det.
+
+ml_gen_string_hash_slots(Slot, TableSize, HashSlotMap,
+ StringInits, NextSlotInits, !RevMap) :-
( Slot = TableSize ->
- Strings = [],
- NextSlots = [],
- MLDS_Cases = []
+ StringInits = [],
+ NextSlotInits = []
;
- MLDS_Context = mlds_make_context(Context),
- ml_gen_string_hash_slot(Slot, HashSlotMap, CodeModel, MLDS_Context,
- String, NextSlot, SlotCases, !Info),
- ml_gen_string_hash_slots(Slot + 1, TableSize, HashSlotMap, CodeModel,
- Context, Strings0, NextSlots0, MLDS_Cases0, !Info),
- Strings = [String | Strings0],
- NextSlots = [NextSlot | NextSlots0],
- MLDS_Cases = SlotCases ++ MLDS_Cases0
+ ml_gen_string_hash_slot(Slot, HashSlotMap,
+ StringInit, NextSlotInit, !RevMap),
+ ml_gen_string_hash_slots(Slot + 1, TableSize, HashSlotMap,
+ LaterStringInits, LaterNextSlotInits, !RevMap),
+ StringInits = [StringInit | LaterStringInits],
+ NextSlotInits = [NextSlotInit | LaterNextSlotInits]
).
:- pred ml_gen_string_hash_slot(int::in,
- map(int, string_hash_slot(tagged_case))::in, code_model::in,
- mlds_context::in, mlds_initializer::out, mlds_initializer::out,
- list(mlds_switch_case)::out, ml_gen_info::in, ml_gen_info::out) is det.
-
-ml_gen_string_hash_slot(Slot, HashSlotMap, CodeModel, MLDS_Context,
- init_obj(StringRval), init_obj(NextSlotRval), MLDS_Cases, !Info) :-
- ( map.search(HashSlotMap, Slot, string_hash_slot(Next, String, Case)) ->
+ map(int, string_hash_slot(int))::in,
+ mlds_initializer::out, mlds_initializer::out,
+ hash_slot_rev_map::in, hash_slot_rev_map::out) is det.
+
+ml_gen_string_hash_slot(Slot, HashSlotMap, StringInit, NextSlotInit,
+ !RevMap) :-
+ ( map.search(HashSlotMap, Slot, string_hash_slot(Next, String, CaseNum)) ->
+ StringRval = ml_const(mlconst_string(String)),
NextSlotRval = ml_const(mlconst_int(Next)),
- Case = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
- expect(unify(TaggedOtherConsIds, []), this_file,
- "ml_gen_string_hash_slot: other cons_ids"),
- TaggedMainConsId = tagged_cons_id(_ConsId, ConsTag),
- ( ConsTag = string_tag(StringPrime) ->
- expect(unify(String, StringPrime), this_file,
- "ml_gen_string_hash_slot: string mismatch")
+ ( map.search(!.RevMap, CaseNum, OldEntry) ->
+ OldEntry = hash_slots(OldFirstSlot, OldLaterSlots),
+ NewEntry = hash_slots(OldFirstSlot, [Slot | OldLaterSlots]),
+ svmap.det_update(CaseNum, NewEntry, !RevMap)
;
- unexpected(this_file, "ml_gen_string_hash_slot: string expected")
- ),
- StringRval = ml_const(mlconst_string(String)),
- ml_gen_goal_as_block(CodeModel, Goal, GoalStatement, !Info),
-
- CommentString = "case """ ++ String ++ """",
- Comment = statement(ml_stmt_atomic(comment(CommentString)),
- MLDS_Context),
- CaseStatement = statement(ml_stmt_block([], [Comment, GoalStatement]),
- MLDS_Context),
- MLDS_Cases = [mlds_switch_case(
- [match_value(ml_const(mlconst_int(Slot)))], CaseStatement)]
+ NewEntry = hash_slots(Slot, []),
+ svmap.det_insert(CaseNum, NewEntry, !RevMap)
+ )
;
StringRval = ml_const(mlconst_null(ml_string_type)),
- NextSlotRval = ml_const(mlconst_int(-2)),
- MLDS_Cases = []
- ).
+ NextSlotRval = ml_const(mlconst_int(-2))
+ ),
+ StringInit = init_obj(StringRval),
+ NextSlotInit = init_obj(NextSlotRval).
+
+:- pred generate_string_switch_arms(map(int, statement)::in,
+ assoc_list(int, hash_slots)::in,
+ list(mlds_switch_case)::in, list(mlds_switch_case)::out) is det.
+
+generate_string_switch_arms(_, [], !Cases).
+generate_string_switch_arms(CodeMap, [Entry | Entries], !Cases) :-
+ Entry = CaseNum - HashSlots,
+ HashSlots = hash_slots(FirstHashSlot, RevLaterHashSlots),
+ list.reverse(RevLaterHashSlots, LaterHashSlots),
+ FirstMatchCond = make_hash_match(FirstHashSlot),
+ LaterMatchConds = list.map(make_hash_match, LaterHashSlots),
+ map.lookup(CodeMap, CaseNum, CaseStatement),
+ Case = mlds_switch_case(FirstMatchCond, LaterMatchConds, CaseStatement),
+ !:Cases = [Case | !.Cases],
+ generate_string_switch_arms(CodeMap, Entries, !Cases).
+
+:- func make_hash_match(int) = mlds_case_match_cond.
+
+make_hash_match(Slot) = match_value(ml_const(mlconst_int(Slot))).
%-----------------------------------------------------------------------------%
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.40
diff -u -b -r1.40 ml_switch_gen.m
--- compiler/ml_switch_gen.m 11 Jun 2009 07:00:13 -0000 1.40
+++ compiler/ml_switch_gen.m 17 Aug 2009 15:10:32 -0000
@@ -101,6 +101,7 @@
:- implementation.
+:- import_module backend_libs.builtin_ops.
:- import_module backend_libs.foreign.
:- import_module backend_libs.switch_util.
:- import_module check_hlds.type_util.
@@ -125,66 +126,49 @@
%-----------------------------------------------------------------------------%
-ml_gen_switch(CaseVar, CanFail, Cases, CodeModel, Context, Decls, Statements,
+ml_gen_switch(SwitchVar, CanFail, Cases, CodeModel, Context, Decls, Statements,
!Info) :-
- % Lookup the representation of the constructors for the tag tests
- % and their corresponding priorities.
- ml_switch_lookup_tags(!.Info, Cases, CaseVar, CostTaggedCases),
-
- % Sort the cases according to the priority of their tag tests.
- list.sort_and_remove_dups(CostTaggedCases, SortedCostTaggedCases),
- assoc_list.values(SortedCostTaggedCases, SortedTaggedCases),
+ % Lookup the representation of the constructors for the tag tests.
+ % Note that you cannot have a switch on a variable whose type's main
+ % type constructor is not known.
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
+ ml_variable_type(!.Info, SwitchVar, SwitchVarType),
+ type_to_ctor_det(SwitchVarType, SwitchVarTypeCtor),
+ tag_cases(ModuleInfo, SwitchVarType, Cases, TaggedCases,
+ _MaybeIntSwitchInfo),
+ % We will need MaybeIntSwitchInfo when we implement lookup switches.
% Figure out what kind of switch this is.
- SwitchCategory = determine_category(!.Info, CaseVar),
+ type_util.classify_type(ModuleInfo, SwitchVarType) = TypeCtorCategory,
+ SwitchCategory = switch_util.type_ctor_cat_to_switch_cat(TypeCtorCategory),
ml_gen_info_get_globals(!.Info, Globals),
globals.lookup_bool_option(Globals, smart_indexing, Indexing),
(
+ (
+ Indexing = no
+ ;
% Check for a switch on a type whose representation uses
% reserved addresses.
- ml_variable_type(!.Info, CaseVar, CaseVarType),
- type_to_ctor_det(CaseVarType, CaseVarTypeCtor),
- ml_gen_info_get_module_info(!.Info, ModuleInfo),
- module_info_get_type_table(ModuleInfo, TypeTable),
% The search will fail for builtin types.
- map.search(TypeTable, CaseVarTypeCtor, CaseVarTypeDefn),
- hlds_data.get_type_defn_body(CaseVarTypeDefn, CaseVarTypeBody),
- CaseVarTypeBody ^ du_type_reserved_addr = uses_reserved_address
+ module_info_get_type_table(ModuleInfo, TypeTable),
+ map.search(TypeTable, SwitchVarTypeCtor, SwitchVarTypeDefn),
+ hlds_data.get_type_defn_body(SwitchVarTypeDefn, SwitchVarTypeBody),
+ SwitchVarTypeBody ^ du_type_reserved_addr = uses_reserved_address
+ )
->
- % XXX This may be inefficient in some cases.
- ml_switch_generate_if_then_else_chain(SortedTaggedCases, CaseVar,
+ % XXX In some cases, we could generate better code if we first checked
+ % for and handled the reserved addresses, and then used one of the
+ % smart indexing schemes for the other cases.
+ ml_switch_generate_if_then_else_chain(TaggedCases, SwitchVar,
CodeModel, CanFail, Context, Decls, Statements, !Info)
;
-% XXX Lookup switches are NYI
-% When we do get around to implementing them,
-% they should probably be handled in ml_simplify_switch rather than here.
-% Indexing = yes,
-% SwitchCategory = atomic_switch,
-% % Note that if/when the MLDS back-end supports execution
-% % tracing, we would also need to check that tracing is not
-% % enabled.
-% list.length(SortedTaggedCases, NumCases),
-% globals.lookup_int_option(Globals, lookup_switch_size,
-% LookupSize),
-% NumCases >= LookupSize,
-% globals.lookup_int_option(Globals, lookup_switch_req_density,
-% ReqDensity),
-% lookup_switch.is_lookup_switch(CaseVar, SortedTaggedCases, GoalInfo,
-% CanFail, ReqDensity,
-% CodeModel, FirstVal, LastVal, NeedRangeCheck,
-% NeedBitVecCheck, OutVars, CaseVals, !Info)
-% ->
-% MaybeEnd = MaybeEndPrime,
-% ml_generate_lookup_switch(CaseVar, OutVars, CaseVals,
-% FirstVal, LastVal, NeedRangeCheck, NeedBitVecCheck,
-% Decls, Statements, !Info)
-% ;
- % Try using a string hash switch.
- Indexing = yes,
+ (
SwitchCategory = string_switch,
- list.length(SortedTaggedCases, NumCases),
+ num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms),
globals.lookup_int_option(Globals, string_switch_size, StringSize),
- NumCases >= StringSize,
+ (
+ NumConsIds >= StringSize,
+ NumArms > 1,
% We can implement string hash switches using either
% computed gotos or int switches.
(
@@ -204,26 +188,41 @@
globals.lookup_bool_option(Globals, prefer_switch, yes)
)
->
- ml_generate_string_switch(SortedTaggedCases, CaseVar, CodeModel,
- CanFail, Context, Decls, Statements, !Info)
+ ml_generate_string_switch(TaggedCases, SwitchVar,
+ CodeModel, CanFail, Context, Decls, Statements, !Info)
+ ;
+ ml_switch_generate_if_then_else_chain(TaggedCases,
+ SwitchVar, CodeModel, CanFail, Context, Decls, Statements,
+ !Info)
+ )
;
- % Try using a tag switch.
- Indexing = yes,
SwitchCategory = tag_switch,
- list.length(SortedTaggedCases, NumCases),
+ num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms),
globals.lookup_int_option(Globals, tag_switch_size, TagSize),
- NumCases >= TagSize,
+ (
+ NumConsIds >= TagSize,
+ NumArms > 1,
target_supports_int_switch(Globals)
->
- ml_generate_tag_switch(SortedTaggedCases, CaseVar, CodeModel,
+ ml_generate_tag_switch(TaggedCases, SwitchVar, CodeModel,
CanFail, Context, Decls, Statements, !Info)
;
+ ml_switch_generate_if_then_else_chain(TaggedCases,
+ SwitchVar, CodeModel, CanFail, Context, Decls, Statements,
+ !Info)
+ )
+ ;
+ % For atomic switches that are suitable for lookup switches or
+ % sense switches, we could do better than the code we generate
+ % below.
+ ( SwitchCategory = atomic_switch
+ ; SwitchCategory = other_switch
+ ),
+ (
% Try using a "direct-mapped" switch. This also handles dense
% (computed goto) switches -- for those, we first generate a
- % direct-mapped switch, and then convert it into a computed goto switch
- % in ml_simplify_switch.
- %
- Indexing = yes,
+ % direct-mapped switch, and then convert it into a computed
+ % goto switch in ml_simplify_switch.
(
target_supports_switch(SwitchCategory, Globals)
;
@@ -231,13 +230,14 @@
target_supports_computed_goto(Globals)
)
->
- ml_switch_generate_mlds_switch(SortedTaggedCases, CaseVar, CodeModel,
- CanFail, Context, Decls, Statements, !Info)
- ;
- % The fallback method: if all else fails, generate an if-then-else
- % chain which tests each of the cases in turn.
- ml_switch_generate_if_then_else_chain(SortedTaggedCases, CaseVar,
+ ml_switch_generate_mlds_switch(TaggedCases, SwitchVar,
CodeModel, CanFail, Context, Decls, Statements, !Info)
+ ;
+ ml_switch_generate_if_then_else_chain(TaggedCases,
+ SwitchVar, CodeModel, CanFail, Context, Decls, Statements,
+ !Info)
+ )
+ )
).
%-----------------------------------------------------------------------------%
@@ -318,37 +318,26 @@
%-----------------------------------------------------------------------------%
- % We categorize switches according to whether the value being switched on
- % is an atomic type, a string, or something more complicated.
- %
-:- func determine_category(ml_gen_info, prog_var) = switch_category.
-
-determine_category(Info, CaseVar) = SwitchCategory :-
- ml_variable_type(Info, CaseVar, Type),
- ml_gen_info_get_module_info(Info, ModuleInfo),
- type_util.classify_type(ModuleInfo, Type) = TypeCtorCategory,
- SwitchCategory = switch_util.type_ctor_cat_to_switch_cat(TypeCtorCategory).
-
-%-----------------------------------------------------------------------------%
-
% 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(ml_gen_info::in, list(case)::in, prog_var::in,
- assoc_list(int, tagged_case)::out) is det.
+:- pred mark_tag_test_cost(tagged_case::in, pair(int, tagged_case)::out)
+ is det.
-ml_switch_lookup_tags(_Info, [], _, []).
-ml_switch_lookup_tags(Info, [Case | Cases], Var,
- [CostTaggedCase | CostTaggedCases]) :-
- Case = case(MainConsId, OtherConsIds, Goal),
- expect(unify(OtherConsIds, []), this_file,
- "ml_switch_lookup_tags: multi-cons-id switch arms NYI"),
- ml_cons_id_to_tag(Info, MainConsId, MainConsTag),
- Cost = estimate_switch_tag_test_cost(MainConsTag),
- TaggedMainConsId = tagged_cons_id(MainConsId, MainConsTag),
- TaggedCase = tagged_case(TaggedMainConsId, [], Goal),
- CostTaggedCase = Cost - TaggedCase,
- ml_switch_lookup_tags(Info, Cases, Var, CostTaggedCases).
+mark_tag_test_cost(TaggedCase, Cost - TaggedCase) :-
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds,
+ _CaseNum, _Goal),
+ estimate_cons_id_tag_test_cost(TaggedMainConsId, 0, MainCost),
+ list.foldl(estimate_cons_id_tag_test_cost, TaggedOtherConsIds,
+ MainCost, Cost).
+
+:- pred estimate_cons_id_tag_test_cost(tagged_cons_id::in,
+ int::in, int::out) is det.
+
+estimate_cons_id_tag_test_cost(TaggedConsId, !CaseCost) :-
+ TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
+ ConsIdCost = estimate_switch_tag_test_cost(ConsTag),
+ !:CaseCost = !.CaseCost + ConsIdCost.
%-----------------------------------------------------------------------------%
@@ -359,38 +348,111 @@
list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_switch_generate_if_then_else_chain([], _Var, CodeModel, CanFail, Context,
- [], Statements, !Info) :-
+ml_switch_generate_if_then_else_chain(TaggedCases0, Var,
+ CodeModel, CanFail, Context, Decls, Statements, !Info) :-
+ % Associate each tagged case with the estimated cost of its tag tests.
+ list.map(mark_tag_test_cost, TaggedCases0, CostTaggedCases0),
+
+ % Sort the cases according to the priority of their tag tests.
+ list.sort(CostTaggedCases0, CostTaggedCases),
+ assoc_list.values(CostTaggedCases, TaggedCases),
+
(
- CanFail = can_fail,
- ml_gen_failure(CodeModel, Context, Statements, !Info)
+ TaggedCases = [],
+ unexpected(this_file,
+ "ml_switch_generate_if_then_else_chain: empty switch")
;
- CanFail = cannot_fail,
- unexpected(this_file, "switch failure")
+ TaggedCases = [FirstTaggedCase | LaterTaggedCases],
+ ml_switch_generate_if_then_else_chain_ites(FirstTaggedCase,
+ LaterTaggedCases, Var, CodeModel, CanFail, Context, Statements,
+ !Info),
+ Decls = []
).
-ml_switch_generate_if_then_else_chain([TaggedCase | TaggedCases], Var,
- CodeModel, CanFail, Context, Decls, Statements, !Info) :-
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
- expect(unify(TaggedOtherConsIds, []), this_file,
- "ml_switch_generate_if_then_else_chain: OtherTaggedConsIds != []"),
- TaggedMainConsId = tagged_cons_id(ConsId, _Tag),
+
+:- pred ml_switch_generate_if_then_else_chain_ites(tagged_case::in,
+ list(tagged_case)::in, prog_var::in, code_model::in, can_fail::in,
+ prog_context::in, list(statement)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_switch_generate_if_then_else_chain_ites(TaggedCase, TaggedCases, Var,
+ CodeModel, CanFail, Context, [Statement], !Info) :-
+ TaggedCase = tagged_case(_, _, _, Goal),
(
TaggedCases = [],
- CanFail = cannot_fail
- ->
- ml_gen_goal(CodeModel, Goal, Decls, Statements, !Info)
+ (
+ CanFail = cannot_fail,
+ % We do not need to test whether we are in the first tagged case;
+ % previous tests have implied that we must be, by eliminating all
+ % other cons_ids that Var could be bound to.
+ ml_gen_goal_as_block(CodeModel, Goal, Statement, !Info)
+ ;
+ CanFail = can_fail,
+ % We handle this case as if we still had later cases, cases
+ % representing the cons_ids that the switch does not cover.
+
+ % Generate the test for checking whether we are in the first
+ % tagged case.
+ ml_switch_generate_if_then_else_cond(TaggedCase, Var, Cond, !Info),
+
+ % Generate code for the first tagged case.
+ ml_gen_goal_as_block(CodeModel, Goal, GoalBlock, !Info),
+
+ % Generate code for the non-covered tagged cases.
+ ml_gen_failure(CodeModel, Context, FailStatements, !Info),
+ FailBlock = ml_gen_block([], FailStatements, Context),
+
+ % Put the codes for the first and non-covered tagged cases
+ % together.
+ Stmt = ml_stmt_if_then_else(Cond, GoalBlock, yes(FailBlock)),
+ Statement = statement(Stmt, mlds_make_context(Context))
+ )
;
- ml_gen_tag_test(Var, ConsId, TagTestDecls, TagTestStatements,
- TagTestExpression, !Info),
- ml_gen_goal_as_block(CodeModel, Goal, GoalStatement, !Info),
- ml_switch_generate_if_then_else_chain(TaggedCases, Var, CodeModel,
- CanFail, Context, RestDecls, RestStatements, !Info),
- Rest = ml_gen_block(RestDecls, RestStatements, Context),
- IfStmt = ml_stmt_if_then_else(TagTestExpression, GoalStatement,
- yes(Rest)),
- IfStatement = statement(IfStmt, mlds_make_context(Context)),
- Decls = TagTestDecls,
- Statements = TagTestStatements ++ [IfStatement]
+ TaggedCases = [LaterTaggedCase | LaterTaggedCases],
+
+ % Generate the test for checking whether we are in the first
+ % tagged case.
+ ml_switch_generate_if_then_else_cond(TaggedCase, Var, Cond, !Info),
+
+ % Generate code for the first tagged case.
+ ml_gen_goal_as_block(CodeModel, Goal, GoalBlock, !Info),
+
+ % Generate code for the later tagged cases.
+ ml_switch_generate_if_then_else_chain_ites(LaterTaggedCase,
+ LaterTaggedCases, Var, CodeModel, CanFail, Context,
+ LaterStatements, !Info),
+ LaterBlock = ml_gen_block([], LaterStatements, Context),
+
+ % Put the codes for the first and later tagged cases together.
+ Stmt = ml_stmt_if_then_else(Cond, GoalBlock, yes(LaterBlock)),
+ Statement = statement(Stmt, mlds_make_context(Context))
+ ).
+
+:- pred ml_switch_generate_if_then_else_cond(tagged_case::in, prog_var::in,
+ mlds_rval::out, ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_switch_generate_if_then_else_cond(TaggedCase, Var, CondRval, !Info) :-
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, _),
+ ml_gen_known_tag_test(Var,
+ TaggedMainConsId, MainTagTestRval, !Info),
+ list.map_foldl(ml_gen_known_tag_test(Var),
+ TaggedOtherConsIds, OtherTagTestRval, !Info),
+ chain_ors(MainTagTestRval, OtherTagTestRval, CondRval).
+
+ % chain_ors(FirstExpr, LaterExprs, Expr):
+ %
+ % Expr is true iff any one of FirstExpr and LaterExprs is true.
+ %
+:- pred chain_ors(mlds_rval::in, list(mlds_rval)::in, mlds_rval::out)
+ is det.
+
+chain_ors(FirstExpr, LaterExprs, Expr) :-
+ (
+ LaterExprs = [],
+ Expr = FirstExpr
+ ;
+ LaterExprs = [SecondExpr | OtherExprs],
+ FirstSecondExpr = ml_binop(logical_or, FirstExpr, SecondExpr),
+ chain_ors(FirstSecondExpr, OtherExprs, Expr)
).
%-----------------------------------------------------------------------------%
@@ -446,14 +508,20 @@
ml_switch_generate_mlds_cases(TaggedCases, CodeModel, MLDS_Cases, !Info).
:- pred ml_switch_generate_mlds_case(tagged_case::in, code_model::in,
- mlds_switch_case::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+ mlds_switch_case::out, ml_gen_info::in, ml_gen_info::out) is det.
ml_switch_generate_mlds_case(TaggedCase, CodeModel, MLDS_Case, !Info) :-
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
- expect(unify(TaggedOtherConsIds, []), this_file,
- "ml_switch_generate_mlds_case: OtherTaggedConsIds != []"),
- TaggedMainConsId = tagged_cons_id(_ConsId, Tag),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, Goal),
+ ml_tagged_cons_id_to_match_cond(TaggedMainConsId, MainCond),
+ list.map(ml_tagged_cons_id_to_match_cond, TaggedOtherConsIds, OtherConds),
+ ml_gen_goal_as_block(CodeModel, Goal, Statement, !Info),
+ MLDS_Case = mlds_switch_case(MainCond, OtherConds, Statement).
+
+:- pred ml_tagged_cons_id_to_match_cond(tagged_cons_id::in,
+ mlds_case_match_cond::out) is det.
+
+ml_tagged_cons_id_to_match_cond(TaggedConsId, MatchCond) :-
+ TaggedConsId = tagged_cons_id(_ConsId, Tag),
(
Tag = int_tag(Int),
Rval = ml_const(mlconst_int(Int))
@@ -480,10 +548,10 @@
; Tag = reserved_address_tag(_)
; Tag = shared_with_reserved_addresses_tag(_, _)
),
- unexpected(this_file, "ml_switch_gen.m: invalid tag type")
+ unexpected(this_file,
+ "ml_tagged_cons_id_to_match_cond: invalid tag type")
),
- ml_gen_goal_as_block(CodeModel, Goal, Statement, !Info),
- MLDS_Case = mlds_switch_case([match_value(Rval)], Statement).
+ MatchCond = match_value(Rval).
% Generate an appropriate default for a switch.
%
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.29
diff -u -b -r1.29 ml_tag_switch.m
--- compiler/ml_tag_switch.m 10 Jun 2009 06:26:20 -0000 1.29
+++ compiler/ml_tag_switch.m 17 Aug 2009 17:40:13 -0000
@@ -53,6 +53,8 @@
:- import_module int.
:- import_module map.
:- import_module pair.
+:- import_module set.
+:- import_module svmap.
:- import_module unit.
%-----------------------------------------------------------------------------%
@@ -70,51 +72,100 @@
ml_gen_info_get_module_info(!.Info, ModuleInfo),
ml_variable_type(!.Info, Var, Type),
- switch_util.get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap),
- map.to_assoc_list(PtagCountMap, PtagCountList),
- map.init(PtagCaseMap0),
- switch_util.group_cases_by_ptag(TaggedCases,
- represent_tagged_case_by_itself, unit, _, unit, _, unit, _,
- PtagCaseMap0, PtagCaseMap),
- switch_util.order_ptags_by_count(PtagCountList, PtagCaseMap,
- PtagCaseList),
+ get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap),
+ group_cases_by_ptag(TaggedCases, gen_tagged_case_code(CodeModel),
+ map.init, CodeMap, unit, _, !Info, _CaseNumPtagsMap, PtagCaseMap),
+ order_ptags_by_count(PtagCountMap, PtagCaseMap, PtagCaseList),
+ % The code generation scheme that we use below can duplicate the code of a
+ % case if the representations of the cons_ids of that case use more than
+ % one primary tag. (We generate one copy of the code for each such primary
+ % tag.)
+ %
+ % If generating code for a target language that does not allow the code of
+ % a case to be duplicated, we could adopt a code generation scheme
+ % like the following pseudocode:
+ %
+ % index = primary_tag(Var) * max_secondary_tag_value
+ % if primary_tag(Var) indicates that Var has secondary_tag
+ % index += secondary_tag(Var)
+ % switch on index using the direct mapped scheme
+ %
+ % For such targets, you would want to employ this code generation scheme,
+ % which is not (yet) implemented, if any value in CaseNumPtagsMap is a set
+ % with more than one element.
% Generate the switch on the primary tag.
- gen_ptag_cases(PtagCaseList, Var, CanFail, CodeModel,
- PtagCountMap, Context, MLDS_Cases, !Info),
+ gen_ptag_cases(PtagCaseList, CodeMap, Var, CanFail, CodeModel,
+ PtagCountMap, Context, PtagCases0, !Info),
+ list.sort(PtagCases0, PtagCases),
ml_switch_generate_default(CanFail, CodeModel, Context, Default, !Info),
% Package up the results into a switch statement.
Range = mlds_switch_range(0, MaxPrimary),
SwitchStmt0 = ml_stmt_switch(mlds_native_int_type, PTagRval, Range,
- MLDS_Cases, Default),
+ PtagCases, Default),
MLDS_Context = mlds_make_context(Context),
ml_simplify_switch(SwitchStmt0, MLDS_Context, SwitchStatement, !Info),
Decls = [],
Statements = [SwitchStatement].
-:- pred gen_ptag_cases(ptag_case_list(tagged_case)::in, prog_var::in,
- can_fail::in, code_model::in, ptag_count_map::in,
+:- pred gen_tagged_case_code(code_model::in, tagged_case::in, int::out,
+ map(int, statement)::in, map(int, statement)::out, unit::in, unit::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+gen_tagged_case_code(CodeModel, TaggedCase, CaseNum, !CodeMap, !Unit, !Info) :-
+ TaggedCase = tagged_case(_MainTaggedConsId, _OtherTaggedConsIds,
+ CaseNum, Goal),
+ ml_gen_goal_as_block(CodeModel, Goal, Statement, !Info),
+ svmap.det_insert(CaseNum, Statement, !CodeMap).
+
+:- type is_a_case_split_between_ptags
+ ---> no_case_is_split_between_ptags
+ ; some_case_is_split_between_ptags.
+
+:- pred find_any_split_cases(case_num_ptags_map::in,
+ is_a_case_split_between_ptags::out) is det.
+
+find_any_split_cases(CaseNumPtagsMap, IsAnyCaseSplit) :-
+ map.foldl(find_any_split_cases_2, CaseNumPtagsMap,
+ no_case_is_split_between_ptags, IsAnyCaseSplit).
+
+:- pred find_any_split_cases_2(int::in, set(int)::in,
+ is_a_case_split_between_ptags::in, is_a_case_split_between_ptags::out)
+ is det.
+
+find_any_split_cases_2(_CaseNum, Ptags, !IsAnyCaseSplit) :-
+ ( set.singleton_set(Ptags, _OnlyPtag) ->
+ true
+ ;
+ !:IsAnyCaseSplit = some_case_is_split_between_ptags
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred gen_ptag_cases(ptag_case_group_list(int)::in, map(int, statement)::in,
+ prog_var::in, can_fail::in, code_model::in, ptag_count_map::in,
prog_context::in, list(mlds_switch_case)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-gen_ptag_cases([], _, _, _, _, _, [], !Info).
-gen_ptag_cases([Case | Cases], Var, CanFail, CodeModel,
+gen_ptag_cases([], _, _, _, _, _, _, [], !Info).
+gen_ptag_cases([Ptag | Ptags], CodeMap, Var, CanFail, CodeModel,
PtagCountMap, Context, [MLDS_Case | MLDS_Cases], !Info) :-
- gen_ptag_case(Case, Var, CanFail, CodeModel,
+ gen_ptag_case(Ptag, CodeMap, Var, CanFail, CodeModel,
PtagCountMap, Context, MLDS_Case, !Info),
- gen_ptag_cases(Cases, Var, CanFail, CodeModel,
+ gen_ptag_cases(Ptags, CodeMap, Var, CanFail, CodeModel,
PtagCountMap, Context, MLDS_Cases, !Info).
-:- pred gen_ptag_case(pair(tag_bits, ptag_case(tagged_case))::in,
+:- pred gen_ptag_case(ptag_case_group_entry(int)::in, map(int, statement)::in,
prog_var::in, can_fail::in, code_model::in, ptag_count_map::in,
prog_context::in, mlds_switch_case::out,
ml_gen_info::in, ml_gen_info::out) is det.
-gen_ptag_case(Case, Var, CanFail, CodeModel, PtagCountMap, Context, MLDS_Case,
- !Info) :-
- Case = PrimaryTag - ptag_case(SecTagLocn, GoalMap),
- map.lookup(PtagCountMap, PrimaryTag, CountInfo),
+gen_ptag_case(PtagCase, CodeMap, Var, CanFail, CodeModel, PtagCountMap,
+ Context, MLDS_Case, !Info) :-
+ PtagCase = ptag_case_group_entry(MainPtag, OtherPtags,
+ ptag_case(SecTagLocn, GoalMap)),
+ map.lookup(PtagCountMap, MainPtag, CountInfo),
CountInfo = SecTagLocn1 - MaxSecondary,
expect(unify(SecTagLocn, SecTagLocn1), this_file,
"ml_tag_switch.m: secondary tag locations differ"),
@@ -126,10 +177,8 @@
GoalList = [],
unexpected(this_file, "no goal for non-shared tag")
;
- GoalList = [_Stag - TaggedCase],
- TaggedCase = tagged_case(_MainTaggedConsId, _OtherTaggedConsIds,
- Goal),
- ml_gen_goal_as_block(CodeModel, Goal, Statement, !Info)
+ GoalList = [_Stag - CaseNum],
+ map.lookup(CodeMap, CaseNum, Statement)
;
GoalList = [_, _ | _],
unexpected(this_file, "more than one goal for non-shared tag")
@@ -138,6 +187,7 @@
( SecTagLocn = sectag_local
; SecTagLocn = sectag_remote
),
+ expect(unify(OtherPtags, []), this_file, ">1 ptag with secondary tag"),
(
CanFail = cannot_fail,
CaseCanFail = cannot_fail
@@ -153,30 +203,74 @@
CaseCanFail = can_fail
)
),
+ group_stag_cases(GoalList, GroupedGoalList),
(
- GoalList = [_Stag - TaggedCase],
+ GroupedGoalList = [CaseNum - _Stags],
CaseCanFail = cannot_fail
->
- TaggedCase = tagged_case(_MainTaggedConsId, _OtherTaggedConsIds,
- Goal),
- % There is only one possible matching goal,
- % so we don't need to switch on it.
- ml_gen_goal_as_block(CodeModel, Goal, Statement, !Info)
+ % There is only one possible matching goal, so we don't need
+ % to switch on it. This can happen if the other functor symbols
+ % that share this primary tag are ruled out by the initial inst
+ % of the switched-on variable.
+ map.lookup(CodeMap, CaseNum, Statement)
;
- gen_stag_switch(GoalList, PrimaryTag, SecTagLocn,
+ gen_stag_switch(GroupedGoalList, CodeMap, MainPtag, SecTagLocn,
Var, CodeModel, CaseCanFail, Context, Statement, !Info)
)
),
- PrimaryTagRval = ml_const(mlconst_int(PrimaryTag)),
- MLDS_Case = mlds_switch_case([match_value(PrimaryTagRval)], Statement).
+ MainPtagMatch = make_ptag_match(MainPtag),
+ OtherPtagMatches = list.map(make_ptag_match, OtherPtags),
+ MLDS_Case = mlds_switch_case(MainPtagMatch, OtherPtagMatches, Statement).
-:- pred gen_stag_switch(stag_goal_list(tagged_case)::in, int::in,
- sectag_locn::in, prog_var::in, code_model::in, can_fail::in,
- prog_context::in, statement::out, ml_gen_info::in, ml_gen_info::out)
- is det.
+:- func make_ptag_match(tag_bits) = mlds_case_match_cond.
+
+make_ptag_match(Ptag) = match_value(ml_const(mlconst_int(Ptag))).
+
+%-----------------------------------------------------------------------------%
+
+ % A list of secondary tag values that all have the same code.
+ % The list is stored in reversed form.
+ %
+:- type stags
+ ---> stags(int, list(int)).
+
+ % Maps case numbers (each of which identifies the code of one switch arm)
+ % to the secondary tags that share that code.
+ %
+:- type stag_rev_map == map(int, stags).
+
+:- pred group_stag_cases(stag_goal_list(int)::in,
+ assoc_list(int, stags)::out) is det.
+
+group_stag_cases(Goals, GroupedGoals) :-
+ build_stag_rev_map(Goals, map.init, RevMap),
+ map.to_assoc_list(RevMap, GroupedGoals).
+
+:- pred build_stag_rev_map(stag_goal_list(int)::in,
+ stag_rev_map::in, stag_rev_map::out) is det.
+
+build_stag_rev_map([], !RevMap).
+build_stag_rev_map([Entry | Entries], !RevMap) :-
+ Entry = Stag - CaseNum,
+ ( map.search(!.RevMap, CaseNum, OldEntry) ->
+ OldEntry = stags(OldFirstStag, OldLaterStags),
+ NewEntry = stags(OldFirstStag, [Stag | OldLaterStags]),
+ svmap.det_update(CaseNum, NewEntry, !RevMap)
+ ;
+ NewEntry = stags(Stag, []),
+ svmap.det_insert(CaseNum, NewEntry, !RevMap)
+ ),
+ build_stag_rev_map(Entries, !RevMap).
-gen_stag_switch(Cases, PrimaryTag, StagLocn, Var, CodeModel, CanFail, Context,
- Statement, !Info) :-
+%-----------------------------------------------------------------------------%
+
+:- pred gen_stag_switch(assoc_list(int, stags)::in,
+ map(int, statement)::in, int::in, sectag_locn::in, prog_var::in,
+ code_model::in, can_fail::in, prog_context::in, statement::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+gen_stag_switch(Cases, CodeMap, PrimaryTag, StagLocn, Var, CodeModel,
+ CanFail, Context, Statement, !Info) :-
% Generate the rval for the secondary tag.
ml_gen_info_get_module_info(!.Info, ModuleInfo),
ml_variable_type(!.Info, Var, VarType),
@@ -195,33 +289,42 @@
),
% Generate the switch on the secondary tag.
- gen_stag_cases(Cases, CodeModel, MLDS_Cases, !Info),
+ gen_stag_cases(Cases, CodeMap, StagCases0, !Info),
+ list.sort(StagCases0, StagCases),
ml_switch_generate_default(CanFail, CodeModel, Context, Default, !Info),
% Package up the results into a switch statement.
Range = mlds_switch_range_unknown, % XXX could do better
SwitchStmt = ml_stmt_switch(mlds_native_int_type, STagRval, Range,
- MLDS_Cases, Default),
+ StagCases, Default),
MLDS_Context = mlds_make_context(Context),
ml_simplify_switch(SwitchStmt, MLDS_Context, Statement, !Info).
-:- pred gen_stag_cases(stag_goal_list(tagged_case)::in, code_model::in,
+%-----------------------------------------------------------------------------%
+
+:- pred gen_stag_cases(assoc_list(int, stags)::in, map(int, statement)::in,
list(mlds_switch_case)::out, ml_gen_info::in, ml_gen_info::out) is det.
gen_stag_cases([], _, [], !Info).
-gen_stag_cases([Case | Cases], CodeModel, [MLDS_Case | MLDS_Cases], !Info) :-
- gen_stag_case(Case, CodeModel, MLDS_Case, !Info),
- gen_stag_cases(Cases, CodeModel, MLDS_Cases, !Info).
+gen_stag_cases([Group | Groups], CodeMap, [Case | Cases], !Info) :-
+ gen_stag_case(Group, CodeMap, Case, !Info),
+ gen_stag_cases(Groups, CodeMap, Cases, !Info).
+
+:- pred gen_stag_case(pair(int, stags)::in, map(int, statement)::in,
+ mlds_switch_case::out, ml_gen_info::in, ml_gen_info::out) is det.
+
+gen_stag_case(Group, CodeMap, MLDS_Case, !Info) :-
+ Group = CaseNum - Stags,
+ Stags = stags(FirstStag, RevLaterStags),
+ list.reverse(RevLaterStags, LaterStags),
+ FirstMatch = make_match_value(FirstStag),
+ LaterMatches = list.map(make_match_value, LaterStags),
+ map.lookup(CodeMap, CaseNum, Statement),
+ MLDS_Case = mlds_switch_case(FirstMatch, LaterMatches, Statement).
-:- pred gen_stag_case(pair(tag_bits, tagged_case)::in,
- code_model::in, mlds_switch_case::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+:- func make_match_value(int) = mlds_case_match_cond.
-gen_stag_case(Case, CodeModel, MLDS_Case, !Info) :-
- Case = Stag - tagged_case(_MainTaggedConsId, _OtherTaggedConsIds, Goal),
- StagRval = ml_const(mlconst_int(Stag)),
- ml_gen_goal_as_block(CodeModel, Goal, Statement, !Info),
- MLDS_Case = mlds_switch_case([match_value(StagRval)], Statement).
+make_match_value(Stag) = match_value(ml_const(mlconst_int(Stag))).
%-----------------------------------------------------------------------------%
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.50
diff -u -b -r1.50 ml_tailcall.m
--- compiler/ml_tailcall.m 10 Jun 2009 06:26:20 -0000 1.50
+++ compiler/ml_tailcall.m 10 Jun 2009 06:28:42 -0000
@@ -331,9 +331,9 @@
mlds_switch_case::in, mlds_switch_case::out) is det.
mark_tailcalls_in_case(AtTail, Locals, Case0, Case) :-
- Case0 = mlds_switch_case(Cond, Statement0),
+ Case0 = mlds_switch_case(FirstCond, LaterConds, Statement0),
mark_tailcalls_in_statement(AtTail, Locals, Statement0, Statement),
- Case = mlds_switch_case(Cond, Statement).
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement).
:- pred mark_tailcalls_in_default(at_tail::in, locals::in,
mlds_switch_default::in, mlds_switch_default::out) is det.
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.132
diff -u -b -r1.132 ml_unify_gen.m
--- compiler/ml_unify_gen.m 16 Jun 2009 07:48:56 -0000 1.132
+++ compiler/ml_unify_gen.m 19 Jun 2009 02:36:20 -0000
@@ -41,18 +41,23 @@
%
:- pred ml_cons_id_to_tag(ml_gen_info::in, cons_id::in, cons_tag::out) is det.
- % ml_gen_tag_test(Var, ConsId, Defns, Statements, Expression):
+ % ml_gen_tag_test(Var, ConsId, Expression, !Info):
%
% Generate code to perform a tag test.
%
% The test checks whether Var has the functor specified by ConsId.
- % The generated code may contain Defns, Statements and an Expression.
- % The Expression is a boolean rval. After execution of the Statements,
- % Expression will evaluate to true iff the Var has the functor specified
- % by ConsId.
+ % The generated code will not contain Defns or Statements; it will be
+ % only an Expression, which will be a boolean rval. Expression will
+ % evaluate to true iff the Var has the functor specified by ConsId.
%
-:- pred ml_gen_tag_test(prog_var::in, cons_id::in,
- list(mlds_defn)::out, list(statement)::out, mlds_rval::out,
+:- pred ml_gen_tag_test(prog_var::in, cons_id::in, mlds_rval::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ % ml_gen_known_tag_test(Var, TaggedConsId, Expression, !Info):
+ %
+ % Same as ml_gen_tag_test, but the tag of ConsId is already known.
+ %
+:- pred ml_gen_known_tag_test(prog_var::in, tagged_cons_id::in, mlds_rval::out,
ml_gen_info::in, ml_gen_info::out) is det.
% ml_gen_secondary_tag_rval(PrimaryTag, VarType, ModuleInfo, VarRval):
@@ -1819,10 +1824,8 @@
ml_gen_semi_deconstruct(Var, ConsId, Args, ArgModes, Context,
Decls, Statements, !Info) :-
- ml_gen_tag_test(Var, ConsId, TagTestDecls, TagTestStatements,
- TagTestExpression, !Info),
- ml_gen_set_success(!.Info, TagTestExpression, Context,
- SetTagTestResult),
+ ml_gen_tag_test(Var, ConsId, TagTestExpression, !Info),
+ ml_gen_set_success(!.Info, TagTestExpression, Context, SetTagTestResult),
ml_gen_test_success(!.Info, SucceededExpression),
ml_gen_det_deconstruct(Var, ConsId, Args, ArgModes, Context,
GetArgsDecls, GetArgsStatements, !Info),
@@ -1830,44 +1833,46 @@
is_empty(GetArgsDecls),
is_empty(GetArgsStatements)
->
- Decls = TagTestDecls,
- Statements = TagTestStatements ++ [SetTagTestResult]
+ Decls = [],
+ Statements = [SetTagTestResult]
;
GetArgs = ml_gen_block(GetArgsDecls, GetArgsStatements, Context),
IfStmt = ml_stmt_if_then_else(SucceededExpression, GetArgs, no),
IfStatement = statement(IfStmt, mlds_make_context(Context)),
- Decls = TagTestDecls,
- Statements = TagTestStatements ++ [SetTagTestResult, IfStatement]
+ Decls = [],
+ Statements = [SetTagTestResult, IfStatement]
).
- % ml_gen_tag_test(Var, ConsId, Defns, Statements, Expression):
- %
- % Generate code to perform a tag test.
- %
- % The test checks whether Var has the functor specified by ConsId.
- % The generated code may contain Defns, Statements and an Expression.
- % The Expression is a boolean rval. After execution of the Statements,
- % Expression will evaluate to true iff the Var has the functor
- % specified by ConsId.
- %
+ml_gen_tag_test(Var, ConsId, TagTestExpression, !Info) :-
+ % NOTE: Keep in sync with ml_gen_known_tag_test below.
+
% TODO: apply the reverse tag test optimization for types with two
% functors (see unify_gen.m).
- %
-ml_gen_tag_test(Var, ConsId, TagTestDecls, TagTestStatements,
- TagTestExpression, !Info) :-
+
ml_gen_var(!.Info, Var, VarLval),
ml_variable_type(!.Info, Var, Type),
ml_cons_id_to_tag(!.Info, ConsId, Tag),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
TagTestExpression = ml_gen_tag_test_rval(Tag, Type, ModuleInfo,
- ml_lval(VarLval)),
- TagTestDecls = [],
- TagTestStatements = [].
+ ml_lval(VarLval)).
+
+ml_gen_known_tag_test(Var, TaggedConsId, TagTestExpression, !Info) :-
+ % NOTE: Keep in sync with ml_gen_tag_test above.
+
+ % TODO: apply the reverse tag test optimization for types with two
+ % functors (see unify_gen.m).
+
+ ml_gen_var(!.Info, Var, VarLval),
+ ml_variable_type(!.Info, Var, Type),
+ TaggedConsId = tagged_cons_id(_ConsId, Tag),
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
+ TagTestExpression = ml_gen_tag_test_rval(Tag, Type, ModuleInfo,
+ ml_lval(VarLval)).
- % ml_gen_tag_test_rval(Tag, VarType, ModuleInfo, VarRval) = TestRval:
+ % ml_gen_tag_test_rval(Tag, Type, ModuleInfo, VarRval) = TestRval:
%
- % TestRval is a Rval of type bool which evaluates to true if VarRval has
- % the specified Tag and false otherwise. VarType is the type of VarRval.
+ % TestRval is an Rval of type bool which evaluates to true if VarRval has
+ % the specified Tag and false otherwise. Type is the type of VarRval.
%
:- func ml_gen_tag_test_rval(cons_tag, mer_type, module_info, mlds_rval)
= mlds_rval.
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.65
diff -u -b -r1.65 ml_util.m
--- compiler/ml_util.m 22 Jun 2009 00:57:58 -0000 1.65
+++ compiler/ml_util.m 23 Jun 2009 05:07:44 -0000
@@ -310,7 +310,7 @@
cases_contains_statement(Cases, SubStatement) :-
list.member(Case, Cases),
- Case = mlds_switch_case(_MatchCond, Statement),
+ Case = mlds_switch_case(_FirstCond, _LaterConds, Statement),
statement_contains_statement(Statement, SubStatement).
:- pred default_contains_statement(mlds_switch_default::in,
@@ -410,7 +410,7 @@
cases_contains_var(Cases, Name) :-
list.member(Case, Cases),
- Case = mlds_switch_case(_MatchConds, Statement),
+ Case = mlds_switch_case(_FirstCond, _LaterConds, Statement),
statement_contains_var(Statement, Name).
:- pred default_contains_var(mlds_switch_default::in, mlds_data::in)
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.171
diff -u -b -r1.171 mlds.m
--- compiler/mlds.m 17 Jun 2009 07:48:14 -0000 1.171
+++ compiler/mlds.m 19 Jun 2009 02:36:20 -0000
@@ -1006,7 +1006,7 @@
% want to achieve that effect, you need to use an explicit
% goto.
- % The value to switch on
+ % The value to switch on.
mlds_type,
mlds_rval,
@@ -1015,7 +1015,7 @@
mlds_switch_range,
% The different cases.
- mlds_switch_cases,
+ list(mlds_switch_case),
% What to do if none of the cases match.
mlds_switch_default
@@ -1127,13 +1127,15 @@
% and the statement to execute if the match succeeds.
% Unlike C, cases do NOT fall through; if you want to achieve that
% effect, you need to use an explicit goto.
-:- type mlds_switch_cases == list(mlds_switch_case).
:- type mlds_switch_case
- ---> mlds_switch_case(mlds_case_match_conds, statement).
+ ---> mlds_switch_case(
+ % Each switch case contains one or more conditions.
+ % If _any_ of the conditions match, this case will be selected.
+ mlds_case_match_cond,
+ list(mlds_case_match_cond),
- % Case_match_conds should be a _non-empty_ list of conditions;
- % if _any_ of the conditions match, this case will be selected.
-:- type mlds_case_match_conds == list(mlds_case_match_cond).
+ statement
+ ).
% A case_match_cond specifies when a switch case will be selected
:- type mlds_case_match_cond
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.237
diff -u -b -r1.237 mlds_to_c.m
--- compiler/mlds_to_c.m 19 Aug 2009 07:44:55 -0000 1.237
+++ compiler/mlds_to_c.m 19 Aug 2009 07:45:28 -0000
@@ -2996,8 +2996,9 @@
mlds_switch_case::in, io::di, io::uo) is det.
mlds_output_switch_case(Indent, FuncInfo, Context, Case, !IO) :-
- Case = mlds_switch_case(Conds, Statement),
- list.foldl(mlds_output_case_cond(Indent, Context), Conds, !IO),
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement),
+ mlds_output_case_cond(Indent, Context, FirstCond, !IO),
+ list.foldl(mlds_output_case_cond(Indent, Context), LaterConds, !IO),
mlds_output_statement(Indent + 1, FuncInfo, Statement, !IO),
mlds_indent(Context, Indent + 1, !IO),
io.write_string("break;\n", !IO).
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.143
diff -u -b -r1.143 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 10 Jun 2009 06:26:21 -0000 1.143
+++ compiler/mlds_to_gcc.m 10 Jun 2009 06:28:42 -0000
@@ -2935,15 +2935,17 @@
% Extra code for outputting switch statements
%
-:- pred gen_cases(defn_info::in, mlds_switch_cases::in,
+:- pred gen_cases(defn_info::in, list(mlds_switch_case)::in,
io__state::di, io__state::uo) is det.
+
gen_cases(DefnInfo, Cases) -->
list__foldl(gen_case(DefnInfo), Cases).
:- pred gen_case(defn_info::in, mlds_switch_case::in,
io__state::di, io__state::uo) is det.
-gen_case(DefnInfo, mlds_switch_case(MatchConds, Code)) -->
- list__foldl(gen_case_label(DefnInfo), MatchConds),
+gen_case(DefnInfo, mlds_switch_case(FirstCond, LaterConds, Code)) -->
+ gen_case_label(DefnInfo, FirstCond),
+ list__foldl(gen_case_label(DefnInfo), LaterConds),
gen_statement(DefnInfo, Code),
gcc__gen_break.
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.204
diff -u -b -r1.204 mlds_to_il.m
--- compiler/mlds_to_il.m 10 Jun 2009 06:26:21 -0000 1.204
+++ compiler/mlds_to_il.m 10 Jun 2009 06:28:42 -0000
@@ -517,10 +517,11 @@
:- func rename_switch_case(mlds_switch_case) = mlds_switch_case.
rename_switch_case(Case0) = Case :-
- Case0 = mlds_switch_case(Conds0, Stmt0),
- Conds = list.map(rename_cond, Conds0),
+ Case0 = mlds_switch_case(FirstCond0, LaterConds0, Stmt0),
+ FirstCond = rename_cond(FirstCond0),
+ LaterConds = list.map(rename_cond, LaterConds0),
Stmt = rename_statement(Stmt0),
- Case = mlds_switch_case(Conds, Stmt).
+ Case = mlds_switch_case(FirstCond, LaterConds, Stmt).
:- func rename_cond(mlds_case_match_cond) = mlds_case_match_cond.
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.134
diff -u -b -r1.134 mlds_to_java.m
--- compiler/mlds_to_java.m 14 Aug 2009 06:34:03 -0000 1.134
+++ compiler/mlds_to_java.m 17 Aug 2009 06:48:22 -0000
@@ -674,12 +674,12 @@
method_ptrs_in_switch_default(default_case(Statement), !CodeAddrs) :-
method_ptrs_in_statement(Statement, !CodeAddrs).
-:- pred method_ptrs_in_switch_cases(mlds_switch_cases::in,
+:- pred method_ptrs_in_switch_cases(list(mlds_switch_case)::in,
list(mlds_code_addr)::in, list(mlds_code_addr)::out) is det.
method_ptrs_in_switch_cases([], !CodeAddrs).
method_ptrs_in_switch_cases([Case | Cases], !CodeAddrs) :-
- Case = mlds_switch_case(_Conditions, Statement),
+ Case = mlds_switch_case(_FirstCond, _LaterConds, Statement),
method_ptrs_in_statement(Statement, !CodeAddrs),
method_ptrs_in_switch_cases(Cases, !CodeAddrs).
@@ -1330,10 +1330,10 @@
mlds_switch_case::in, mlds_switch_case::out) is det.
rename_class_names_switch_case(Renaming, !Case) :-
- !.Case = mlds_switch_case(MatchConds, Statement0),
+ !.Case = mlds_switch_case(FirstMatchCond, LaterMatchConds, Statement0),
% The rvals in the match conditions shouldn't need renaming.
rename_class_names_statement(Renaming, Statement0, Statement),
- !:Case = mlds_switch_case(MatchConds, Statement).
+ !:Case = mlds_switch_case(FirstMatchCond, LaterMatchConds, Statement).
:- pred rename_class_names_switch_default(class_name_renaming::in,
mlds_switch_default::in, mlds_switch_default::out) is det.
@@ -3512,10 +3512,11 @@
output_switch_case(Indent, ModuleInfo, FuncInfo, Context, Case, ExitMethods,
!IO) :-
- Case = mlds_switch_case(Conds, Statement),
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement),
ModuleName = FuncInfo ^ func_info_name ^ mod_name,
+ output_case_cond(Indent, ModuleInfo, ModuleName, Context, FirstCond, !IO),
list.foldl(output_case_cond(Indent, ModuleInfo, ModuleName, Context),
- Conds, !IO),
+ LaterConds, !IO),
output_statement(Indent + 1, ModuleInfo, FuncInfo, Statement,
StmtExitMethods, !IO),
( set.member(can_fall_through, StmtExitMethods) ->
Index: compiler/switch_case.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_case.m,v
retrieving revision 1.2
diff -u -b -r1.2 switch_case.m
--- compiler/switch_case.m 6 Jan 2009 03:56:27 -0000 1.2
+++ compiler/switch_case.m 15 Jul 2009 03:50:20 -0000
@@ -91,7 +91,7 @@
!MaybeEnd, !CI) :-
Params = represent_params(SwitchVarName, SwitchGoalInfo, CodeModel,
BranchStart, EndLabel),
- TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, Goal),
+ TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _, Goal),
project_cons_name_and_tag(MainTaggedConsId, MainConsName, _),
list.map2(project_cons_name_and_tag, OtherTaggedConsIds,
OtherConsNames, _),
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.110
diff -u -b -r1.110 switch_gen.m
--- compiler/switch_gen.m 11 Jun 2009 07:00:20 -0000 1.110
+++ compiler/switch_gen.m 17 Aug 2009 13:48:40 -0000
@@ -129,7 +129,7 @@
;
(
SwitchCategory = atomic_switch,
- list.length(TaggedCases, NumCases),
+ num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms),
(
MaybeIntSwitchInfo =
int_switch(LowerLimit, UpperLimit, NumValues),
@@ -137,7 +137,8 @@
MaybeTraceInfo = no,
globals.lookup_int_option(Globals, lookup_switch_size,
LookupSize),
- NumCases >= LookupSize,
+ NumConsIds >= LookupSize,
+ NumArms > 1,
globals.lookup_int_option(Globals, lookup_switch_req_density,
ReqDensity),
is_lookup_switch(VarType, TaggedCases, LowerLimit, UpperLimit,
@@ -152,7 +153,8 @@
int_switch(LowerLimit, UpperLimit, NumValues),
globals.lookup_int_option(Globals, dense_switch_size,
DenseSize),
- NumCases >= DenseSize,
+ NumConsIds >= DenseSize,
+ NumArms > 1,
globals.lookup_int_option(Globals, dense_switch_req_density,
ReqDensity),
tagged_case_list_is_dense_switch(!.CI, VarType, TaggedCases,
@@ -169,9 +171,9 @@
)
;
SwitchCategory = string_switch,
- list.length(TaggedCases, NumCases),
+ num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms),
globals.lookup_int_option(Globals, string_switch_size, StringSize),
- ( NumCases >= StringSize ->
+ ( NumConsIds >= StringSize, NumArms > 1 ->
generate_string_switch(TaggedCases, VarRval, VarName,
CodeModel, CanFail, GoalInfo, EndLabel,
no, MaybeEnd, SwitchCode, !CI)
@@ -182,9 +184,9 @@
)
;
SwitchCategory = tag_switch,
- list.length(TaggedCases, NumCases),
+ num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms),
globals.lookup_int_option(Globals, tag_switch_size, TagSize),
- ( NumCases >= TagSize ->
+ ( NumConsIds >= TagSize, NumArms > 1 ->
generate_tag_switch(TaggedCases, VarRval, VarType, VarName,
CodeModel, CanFail, GoalInfo, EndLabel, no, MaybeEnd,
SwitchCode, !CI)
@@ -331,7 +333,7 @@
ReservedAddrCases, NonReservedAddrCases) :-
separate_reserved_address_cases(TaggedCases,
ReservedAddrCasesTail, NonReservedAddrCasesTail),
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, _),
TaggedConsIds = [TaggedMainConsId | TaggedOtherConsIds],
ContainsReservedAddr = list_contains_reserved_addr_tag(TaggedConsIds),
(
@@ -410,7 +412,7 @@
CanSucceedCases, CannotSucceedCases) :-
separate_cannot_succeed_cases(Cases,
CanSucceedCases1, CannotSucceedCases1),
- Case = tagged_case(_, _, Goal),
+ Case = tagged_case(_, _, _, Goal),
Goal = hlds_goal(_, GoalInfo),
Detism = goal_info_get_determinism(GoalInfo),
determinism_components(Detism, _CanFail, SolnCount),
@@ -437,8 +439,8 @@
CodeModel = model_det,
CanFail = cannot_fail,
Cases0 = [Case1, Case2],
- Case1 = tagged_case(_, _, Goal1),
- Case2 = tagged_case(_, _, Goal2)
+ Case1 = tagged_case(_, _, _, Goal1),
+ Case2 = tagged_case(_, _, _, Goal2)
->
get_module_info(CI, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
@@ -518,7 +520,7 @@
:- func estimate_cost_of_case_test(tagged_case) = pair(int, tagged_case).
estimate_cost_of_case_test(TaggedCase) = Cost - TaggedCase :-
- TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _Goal),
+ TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _, _),
MainTag = project_tagged_cons_id_tag(MainTaggedConsId),
MainCost = estimate_switch_tag_test_cost(MainTag),
OtherTags = list.map(project_tagged_cons_id_tag, OtherTaggedConsIds),
@@ -538,7 +540,7 @@
!MaybeEnd, Code, !CI) :-
(
Cases = [HeadCase | TailCases],
- HeadCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, Goal),
+ HeadCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _, Goal),
remember_position(!.CI, BranchStart),
goal_info_get_store_map(SwitchGoalInfo, StoreMap),
(
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.42
diff -u -b -r1.42 switch_util.m
--- compiler/switch_util.m 11 Jun 2009 07:00:20 -0000 1.42
+++ compiler/switch_util.m 19 Aug 2009 08:51:11 -0000
@@ -30,7 +30,7 @@
:- import_module list.
:- import_module map.
:- import_module pair.
-:- import_module unit.
+:- import_module set.
%-----------------------------------------------------------------------------%
%
@@ -56,8 +56,12 @@
:- pred tag_cases(module_info::in, mer_type::in, list(case)::in,
list(tagged_case)::out, maybe_int_switch_info::out) is det.
-:- pred represent_tagged_case_by_itself(tagged_case::in, tagged_case::out,
- unit::in, unit::out, unit::in, unit::out, unit::in, unit::out) is det.
+ % num_cons_ids_in_tagged_cases(Cases, NumConsIds, NumArms):
+ %
+ % Count the number of cons_ids and the number of arms in Cases.
+ %
+:- pred num_cons_ids_in_tagged_cases(list(tagged_case)::in, int::out, int::out)
+ is det.
%-----------------------------------------------------------------------------%
%
@@ -152,32 +156,82 @@
% don't support labels. Instead, if need be we duplicate the HLDS goal, which
% means we will generate MLDS code for it more than once.
-:- type stag_goal_map(CaseRep) == map(int, CaseRep).
-:- type stag_goal_list(CaseRep) == assoc_list(int, CaseRep).
+ % Map primary tag values to the set of their switch arms.
+ %
+ % Given a key-value pair in this map, the key is duplicated
+ % in the tag_bits field of the value.
+ %
+:- type ptag_case_map(CaseRep) ==
+ map(tag_bits, ptag_case(CaseRep)).
-% Map primary tag values to the set of their switch arms.
+:- type ptag_case_entry(CaseRep)
+ ---> ptag_case_entry(
+ % If we are generating code of a shape that works with
+ % two possibly unrelated (e.g. non-consecutive) ptag values
+ % having the same code, use ptag_case_group_entry. This type
+ % is for code shapes that cannot exploit such sharing.
+
+ % The ptag value that has this code.
+ tag_bits,
+
+ % A representation of the code for this primary tag.
+ ptag_case(CaseRep)
+ ).
+
+:- type ptag_case_group_entry(CaseRep)
+ ---> ptag_case_group_entry(
+ % It is possible for two or more primary tag values
+ % to have exactly the same action, if those ptags represent
+ % cons_ids that share the same arm of the switch.
+ % The primary tag values
+
+ % The first and any later ptag values that have this code.
+ tag_bits,
+ list(tag_bits),
+
+ % A representation of the code for this primary tag.
+ ptag_case(CaseRep)
+ ).
:- type ptag_case(CaseRep)
- ---> ptag_case(sectag_locn, stag_goal_map(CaseRep)).
-:- type ptag_case_map(CaseRep) == map(tag_bits, ptag_case(CaseRep)).
-:- type ptag_case_list(CaseRep) == assoc_list(tag_bits, ptag_case(CaseRep)).
+ ---> ptag_case(
+ sectag_locn,
+ stag_goal_map(CaseRep)
+ ).
-% Map primary tag values to the number of constructors sharing them.
+ % Map each secondary tag value to the representation of the associated
+ % code.
+ %
+ % It is of course possible that there is more than one secondary tag value
+ % that maps to the same code. Exploiting such sharing is up to
+ % backend-specific code.
+ %
+:- type stag_goal_map(CaseRep) == map(int, CaseRep).
+:- type stag_goal_list(CaseRep) == assoc_list(int, CaseRep).
+
+:- type ptag_case_list(CaseRep) == list(ptag_case_entry(CaseRep)).
+:- type ptag_case_group_list(CaseRep) == list(ptag_case_group_entry(CaseRep)).
+ % 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)).
+
+ % Map case numbers to the set of primary tags used in the cons_ids
+ % of that case.
+ %
+:- type case_num_ptags_map == map(int, set(int)).
% Group together all the cases that depend on the given variable
% having the same primary tag value.
%
- % XXX
:- pred group_cases_by_ptag(list(tagged_case)::in,
pred(tagged_case, CaseRep, StateA, StateA, StateB, StateB, StateC, StateC)
::in(pred(in, out, in, out, in, out, in, out) is det),
StateA::in, StateA::out, StateB::in, StateB::out, StateC::in, StateC::out,
- ptag_case_map(CaseRep)::in, ptag_case_map(CaseRep)::out) is det.
+ case_num_ptags_map::out, ptag_case_map(CaseRep)::out) is det.
- % Order the primary tags based on the number of secondary tags associated
+ % Group together any primary tags with the same cases.
+ % Order the groups 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;
@@ -185,8 +239,8 @@
% 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(CaseRep)::in, ptag_case_list(CaseRep)::out) is det.
+:- pred order_ptags_by_count(ptag_count_map::in,
+ ptag_case_map(CaseRep)::in, ptag_case_group_list(CaseRep)::out) is det.
% order_ptags_by_value(FirstPtag, MaxPtag, !PtagCaseList):
%
@@ -243,8 +297,10 @@
OtherConsIds, TaggedOtherConsIds,
IntTag, LowerLimit1, IntTag, UpperLimit1,
1, NumValues1, is_int_switch, IsIntSwitch1),
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
- tag_cases_in_int_switch(ModuleInfo, SwitchVarType, Cases, TaggedCases,
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds,
+ 0, Goal),
+ tag_cases_in_int_switch(ModuleInfo, SwitchVarType, 1,
+ Cases, TaggedCases,
LowerLimit1, LowerLimit, UpperLimit1, UpperLimit,
NumValues1, NumValues, IsIntSwitch1, IsIntSwitch),
(
@@ -257,30 +313,33 @@
)
;
list.map(tag_cons_id(ModuleInfo), OtherConsIds, TaggedOtherConsIds),
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
- tag_cases_plain(ModuleInfo, SwitchVarType, Cases, TaggedCases),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds,
+ 0, Goal),
+ tag_cases_plain(ModuleInfo, SwitchVarType, 1, Cases, TaggedCases),
MaybeIntSwitchLimits = not_int_switch
).
-:- pred tag_cases_plain(module_info::in, mer_type::in, list(case)::in,
+:- pred tag_cases_plain(module_info::in, mer_type::in, int::in, list(case)::in,
list(tagged_case)::out) is det.
-tag_cases_plain(_, _, [], []).
-tag_cases_plain(ModuleInfo, SwitchVarType, [Case | Cases],
+tag_cases_plain(_, _, _, [], []).
+tag_cases_plain(ModuleInfo, SwitchVarType, CaseNum, [Case | Cases],
[TaggedCase | TaggedCases]) :-
Case = case(MainConsId, OtherConsIds, Goal),
tag_cons_id(ModuleInfo, MainConsId, TaggedMainConsId),
list.map(tag_cons_id(ModuleInfo), OtherConsIds, TaggedOtherConsIds),
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
- tag_cases_plain(ModuleInfo, SwitchVarType, Cases, TaggedCases).
-
-:- pred tag_cases_in_int_switch(module_info::in, mer_type::in, list(case)::in,
- list(tagged_case)::out, int::in, int::out, int::in, int::out,
- int::in, int::out, is_int_switch::in, is_int_switch::out) is det.
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds,
+ CaseNum, Goal),
+ tag_cases_plain(ModuleInfo, SwitchVarType, CaseNum + 1, Cases,
+ TaggedCases).
+
+:- pred tag_cases_in_int_switch(module_info::in, mer_type::in, int::in,
+ list(case)::in, list(tagged_case)::out, int::in, int::out, int::in,
+ int::out, int::in, int::out, is_int_switch::in, is_int_switch::out) is det.
-tag_cases_in_int_switch(_, _, [], [], !LowerLimit, !UpperLimit, !NumValues,
+tag_cases_in_int_switch(_, _, _, [], [], !LowerLimit, !UpperLimit, !NumValues,
!IsIntSwitch).
-tag_cases_in_int_switch(ModuleInfo, SwitchVarType, [Case | Cases],
+tag_cases_in_int_switch(ModuleInfo, SwitchVarType, CaseNum, [Case | Cases],
[TaggedCase | TaggedCases], !LowerLimit, !UpperLimit, !NumValues,
!IsIntSwitch) :-
Case = case(MainConsId, OtherConsIds, Goal),
@@ -289,9 +348,11 @@
list.map_foldl4(tag_cons_id_in_int_switch(ModuleInfo),
OtherConsIds, TaggedOtherConsIds, !LowerLimit, !UpperLimit,
!NumValues, !IsIntSwitch),
- TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
- tag_cases_in_int_switch(ModuleInfo, SwitchVarType, Cases, TaggedCases,
- !LowerLimit, !UpperLimit, !NumValues, !IsIntSwitch).
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds,
+ CaseNum, Goal),
+ tag_cases_in_int_switch(ModuleInfo, SwitchVarType, CaseNum + 1,
+ Cases, TaggedCases, !LowerLimit, !UpperLimit, !NumValues,
+ !IsIntSwitch).
:- pred tag_cons_id(module_info::in, cons_id::in, tagged_cons_id::out) is det.
@@ -316,8 +377,21 @@
!:IsIntSwitch = is_not_int_switch
).
-represent_tagged_case_by_itself(TaggedCase, TaggedCase,
- !StateA, !StateB, !StateC).
+%-----------------------------------------------------------------------------%
+
+num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms) :-
+ num_cons_ids_in_tagged_cases_2(TaggedCases, 0, NumConsIds, 0, NumArms).
+
+:- pred num_cons_ids_in_tagged_cases_2(list(tagged_case)::in,
+ int::in, int::out, int::in, int::out) is det.
+
+num_cons_ids_in_tagged_cases_2([], !NumConsIds, !NumArms).
+num_cons_ids_in_tagged_cases_2([TaggedCase | TaggedCases],
+ !NumConsIds, !NumArms) :-
+ TaggedCase = tagged_case(_MainConsId, OtherCondIds, _, _),
+ !:NumConsIds = !.NumConsIds + 1 + list.length(OtherCondIds),
+ !:NumArms = !.NumArms + 1,
+ num_cons_ids_in_tagged_cases_2(TaggedCases, !NumConsIds, !NumArms).
%-----------------------------------------------------------------------------%
%
@@ -460,9 +534,9 @@
string_hash_cases(TaggedCases, HashMask, RepresentCase,
!StateA, !StateB, !StateC, !:HashMap),
RepresentCase(TaggedCase, CaseRep, !StateA, !StateB, !StateC),
- TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _Goal),
- TaggedConsIds = [MainTaggedConsId | OtherTaggedConsIds],
- list.foldl(string_hash_cons_id(CaseRep, HashMask), TaggedConsIds,
+ TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _, _),
+ string_hash_cons_id(CaseRep, HashMask, MainTaggedConsId, !HashMap),
+ list.foldl(string_hash_cons_id(CaseRep, HashMask), OtherTaggedConsIds,
!HashMap).
:- pred string_hash_cons_id(CaseRep::in, int::in, tagged_cons_id::in,
@@ -658,20 +732,38 @@
%-----------------------------------------------------------------------------%
-group_cases_by_ptag([], _, !StateA, !StateB, !StateC, !PtagCaseMap).
-group_cases_by_ptag([TaggedCase | TaggedCases], RepresentCase,
- !StateA, !StateB, !StateC, !PtagCaseMap) :-
- TaggedCase = tagged_case(MainTaggedConsId, OtherConsIds, _Goal),
+group_cases_by_ptag(TaggedCases, RepresentCase, !StateA, !StateB, !StateC,
+ CaseNumPtagsMap, PtagCaseMap) :-
+ group_cases_by_ptag_2(TaggedCases, RepresentCase,
+ !StateA, !StateB, !StateC,
+ map.init, CaseNumPtagsMap, map.init, PtagCaseMap).
+
+:- pred group_cases_by_ptag_2(list(tagged_case)::in,
+ pred(tagged_case, CaseRep, StateA, StateA, StateB, StateB, StateC, StateC)
+ ::in(pred(in, out, in, out, in, out, in, out) is det),
+ StateA::in, StateA::out, StateB::in, StateB::out, StateC::in, StateC::out,
+ case_num_ptags_map::in, case_num_ptags_map::out,
+ ptag_case_map(CaseRep)::in, ptag_case_map(CaseRep)::out) is det.
+
+group_cases_by_ptag_2([], _,
+ !StateA, !StateB, !StateC, !CaseNumPtagsMap, !PtagCaseMap).
+group_cases_by_ptag_2([TaggedCase | TaggedCases], RepresentCase,
+ !StateA, !StateB, !StateC, !CaseNumPtagsMap, !PtagCaseMap) :-
+ TaggedCase = tagged_case(MainTaggedConsId, OtherConsIds, CaseNum, _Goal),
RepresentCase(TaggedCase, CaseRep, !StateA, !StateB, !StateC),
- group_case_by_ptag(CaseRep, MainTaggedConsId, !PtagCaseMap),
- list.foldl(group_case_by_ptag(CaseRep), OtherConsIds, !PtagCaseMap),
- group_cases_by_ptag(TaggedCases, RepresentCase, !StateA, !StateB, !StateC,
- !PtagCaseMap).
+ group_case_by_ptag(CaseNum, CaseRep, MainTaggedConsId,
+ !CaseNumPtagsMap, !PtagCaseMap),
+ list.foldl2(group_case_by_ptag(CaseNum, CaseRep), OtherConsIds,
+ !CaseNumPtagsMap, !PtagCaseMap),
+ group_cases_by_ptag_2(TaggedCases, RepresentCase,
+ !StateA, !StateB, !StateC, !CaseNumPtagsMap, !PtagCaseMap).
-:- pred group_case_by_ptag(CaseRep::in, tagged_cons_id::in,
+:- pred group_case_by_ptag(int::in, CaseRep::in, tagged_cons_id::in,
+ map(int, set(int))::in, map(int, set(int))::out,
ptag_case_map(CaseRep)::in, ptag_case_map(CaseRep)::out) is det.
-group_case_by_ptag(CaseRep, TaggedConsId, !PtagCaseMap) :-
+group_case_by_ptag(CaseNum, CaseRep, TaggedConsId,
+ !CaseNumPtagsMap, !PtagCaseMap) :-
TaggedConsId = tagged_cons_id(_ConsId, Tag),
(
( Tag = single_functor_tag, Primary = 0
@@ -731,50 +823,95 @@
; Tag = shared_with_reserved_addresses_tag(_, _)
),
unexpected(this_file, "non-du tag in group_case_by_ptag")
- ).
-
-%-----------------------------------------------------------------------------%
-
-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
- ).
+ ),
+ ( map.search(!.CaseNumPtagsMap, CaseNum, Ptags0) ->
+ set.insert(Ptags0, Primary, Ptags),
+ svmap.det_update(CaseNum, Ptags, !CaseNumPtagsMap)
+ ;
+ Ptags = set.make_singleton_set(Primary),
+ svmap.det_insert(CaseNum, Ptags, !CaseNumPtagsMap)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+order_ptags_by_count(PtagCountMap, PtagCaseMap, PtagGroupCaseList) :-
+ map.to_assoc_list(PtagCaseMap, PtagCaseList),
+ build_ptag_case_rev_map(PtagCaseList, PtagCountMap,
+ map.init, PtagCaseRevMap),
+ map.values(PtagCaseRevMap, PtagCaseRevList),
+ list.sort(PtagCaseRevList, PtagCaseRevSortedList),
+ % The sort puts the groups with the smallest counts first; we want the
+ % largest counts first.
+ list.reverse(PtagCaseRevSortedList, PtagCaseSortedList),
+ list.map(interpret_rev_map_entry, PtagCaseSortedList, PtagGroupCaseList).
+
+:- pred interpret_rev_map_entry(ptag_case_rev_map_entry(CaseRep)::in,
+ ptag_case_group_entry(CaseRep)::out) is det.
+
+interpret_rev_map_entry(RevEntry, GroupEntry) :-
+ RevEntry = ptag_case_rev_map_entry(_Count, MainPtag, OtherPtags, Case),
+ GroupEntry = ptag_case_group_entry(MainPtag, OtherPtags, Case).
+
+:- type ptag_case_rev_map_entry(CaseRep)
+ ---> ptag_case_rev_map_entry(
+ % The total number of function symbols sharing this case.
+ % This must be the first field for the sort to work as
+ % intended.
+ int,
+
+ % The primary tag bit values sharing this case.
+ tag_bits,
+ list(tag_bits),
+
+ % The case itself.
+ ptag_case(CaseRep)
+ ).
+
+:- type ptag_case_rev_map(CaseRep) ==
+ map(ptag_case(CaseRep), ptag_case_rev_map_entry(CaseRep)).
+
+:- pred build_ptag_case_rev_map(assoc_list(tag_bits, ptag_case(CaseRep))::in,
+ ptag_count_map::in,
+ ptag_case_rev_map(CaseRep)::in, ptag_case_rev_map(CaseRep)::out) is det.
+
+build_ptag_case_rev_map([], _PtagCountMap, !RevMap).
+build_ptag_case_rev_map([Entry | Entries], PtagCountMap, !RevMap) :-
+ Entry = Ptag - Case,
+ map.lookup(PtagCountMap, Ptag, CountSecTagLocn - Count),
+ (
+ CountSecTagLocn = sectag_none,
+ ( map.search(!.RevMap, Case, OldEntry) ->
+ OldEntry = ptag_case_rev_map_entry(OldCount,
+ OldFirstPtag, OldLaterPtags0, OldCase),
+ expect(unify(Case, OldCase), this_file,
+ "build_ptag_case_rev_map: Case != OldCase"),
+ NewEntry = ptag_case_rev_map_entry(OldCount + Count,
+ OldFirstPtag, OldLaterPtags0 ++ [Ptag], OldCase),
+ svmap.det_update(Case, NewEntry, !RevMap)
+ ;
+ NewEntry = ptag_case_rev_map_entry(Count, Ptag, [], Case),
+ svmap.det_insert(Case, NewEntry, !RevMap)
+ )
+ ;
+ ( CountSecTagLocn = sectag_local
+ ; CountSecTagLocn = sectag_remote
+ ),
+ % There will only ever be at most one primary tag value with
+ % a shared local tag, and there will only ever be at most one primary
+ % tag value with a shared remote tag, so we can never have
+ %
+ % - two ptags with CountSecTagLocn = sectag_local
+ % - two ptags with CountSecTagLocn = sectag_remote
+ %
+ % We can have two ptags, one with CountSecTagLocn = sectag_local and
+ % the other with CountSecTagLocn = sectag_remote, but even if their
+ % sectag_value to code maps were identical, their overall code couldn't
+ % be identical, since they would have to get the secondary tags from
+ % different places.
+ NewEntry = ptag_case_rev_map_entry(Count, Ptag, [], Case),
+ svmap.det_insert(Case, NewEntry, !RevMap)
+ ),
+ build_ptag_case_rev_map(Entries, PtagCountMap, !RevMap).
%-----------------------------------------------------------------------------%
@@ -785,7 +922,8 @@
map.delete(PtagCaseMap0, Ptag, PtagCaseMap1),
order_ptags_by_value(NextPtag, MaxPtag,
PtagCaseMap1, PtagCaseList1),
- PtagCaseList = [Ptag - PtagCase | PtagCaseList1]
+ PtagCaseEntry = ptag_case_entry(Ptag, PtagCase),
+ PtagCaseList = [PtagCaseEntry | PtagCaseList1]
;
order_ptags_by_value(NextPtag, MaxPtag, PtagCaseMap0, PtagCaseList)
)
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.82
diff -u -b -r1.82 tag_switch.m
--- compiler/tag_switch.m 6 Jan 2009 03:56:27 -0000 1.82
+++ compiler/tag_switch.m 16 Aug 2009 15:39:41 -0000
@@ -220,16 +220,11 @@
% constructors share each primary tag value.
get_module_info(!.CI, ModuleInfo),
get_ptag_counts(VarType, ModuleInfo, MaxPrimary, PtagCountMap),
- map.to_assoc_list(PtagCountMap, PtagCountList),
remember_position(!.CI, BranchStart),
Params = represent_params(VarName, SwitchGoalInfo, CodeModel, BranchStart,
EndLabel),
- map.init(CaseLabelMap0),
- map.init(PtagCaseMap0),
- group_cases_by_ptag(TaggedCases,
- represent_tagged_case_for_llds(Params),
- CaseLabelMap0, CaseLabelMap1, !MaybeEnd, !CI,
- PtagCaseMap0, PtagCaseMap),
+ group_cases_by_ptag(TaggedCases, represent_tagged_case_for_llds(Params),
+ map.init, CaseLabelMap0, !MaybeEnd, !CI, _, PtagCaseMap),
map.count(PtagCaseMap, PtagsUsed),
get_globals(!.CI, Globals),
@@ -298,13 +293,13 @@
order_ptags_by_value(0, MaxPrimary, PtagCaseMap, PtagCaseList),
generate_primary_binary_search(PtagCaseList, 0, MaxPrimary, PtagRval,
StagReg, VarRval, MaybeFailLabel, PtagCountMap, CasesCode,
- CaseLabelMap1, CaseLabelMap, !CI)
+ CaseLabelMap0, CaseLabelMap, !CI)
;
PrimaryMethod = jump_table,
order_ptags_by_value(0, MaxPrimary, PtagCaseMap, PtagCaseList),
generate_primary_jump_table(PtagCaseList, 0, MaxPrimary, StagReg,
VarRval, MaybeFailLabel, PtagCountMap, Targets, TableCode,
- CaseLabelMap1, CaseLabelMap, !CI),
+ CaseLabelMap0, CaseLabelMap, !CI),
SwitchCode = singleton(
llds_instr(computed_goto(PtagRval, Targets),
"switch on primary tag")
@@ -312,7 +307,7 @@
CasesCode = SwitchCode ++ TableCode
;
PrimaryMethod = try_chain,
- order_ptags_by_count(PtagCountList, PtagCaseMap, PtagCaseList0),
+ order_ptags_by_count(PtagCountMap, PtagCaseMap, PtagCaseList0),
(
CanFail = cannot_fail,
PtagCaseList0 = [MostFreqCase | OtherCases]
@@ -323,13 +318,13 @@
),
generate_primary_try_chain(PtagCaseList, PtagRval, StagReg, VarRval,
MaybeFailLabel, PtagCountMap, empty, empty, CasesCode,
- CaseLabelMap1, CaseLabelMap, !CI)
+ CaseLabelMap0, CaseLabelMap, !CI)
;
PrimaryMethod = try_me_else_chain,
- order_ptags_by_count(PtagCountList, PtagCaseMap, PtagCaseList),
+ order_ptags_by_count(PtagCountMap, PtagCaseMap, PtagCaseList),
generate_primary_try_me_else_chain(PtagCaseList, PtagRval, StagReg,
VarRval, MaybeFailLabel, PtagCountMap, CasesCode,
- CaseLabelMap1, CaseLabelMap, !CI)
+ CaseLabelMap0, CaseLabelMap, !CI)
),
map.foldl(add_remaining_case, CaseLabelMap, empty, RemainingCasesCode),
Code = PtagCode ++ CasesCode ++ RemainingCasesCode ++ FailCode ++ EndCode.
@@ -338,7 +333,7 @@
% Generate a switch on a primary tag value using a try-me-else chain.
%
-:- pred generate_primary_try_me_else_chain(ptag_case_list(label)::in,
+:- pred generate_primary_try_me_else_chain(ptag_case_group_list(label)::in,
rval::in, lval::in, rval::in, maybe(label)::in,
ptag_count_map::in, llds_code::out,
case_label_map::in, case_label_map::out,
@@ -349,17 +344,17 @@
unexpected(this_file, "generate_primary_try_me_else_chain: empty switch").
generate_primary_try_me_else_chain([PtagGroup | PtagGroups], PtagRval, StagReg,
VarRval, MaybeFailLabel, PtagCountMap, Code, !CaseLabelMap, !CI) :-
- PtagGroup = Primary - PtagCase,
+ PtagGroup = ptag_case_group_entry(MainPtag, OtherPtags, PtagCase),
PtagCase = ptag_case(StagLoc, StagGoalMap),
- map.lookup(PtagCountMap, Primary, CountInfo),
+ map.lookup(PtagCountMap, MainPtag, CountInfo),
CountInfo = StagLocPrime - MaxSecondary,
expect(unify(StagLoc, StagLocPrime), this_file,
"generate_primary_try_me_else_chain: secondary tag locations differ"),
(
PtagGroups = [_ | _],
- generate_primary_try_me_else_chain_case(PtagRval, StagReg, Primary,
- PtagCase, MaxSecondary, VarRval, MaybeFailLabel, ThisTagCode,
- !CaseLabelMap, !CI),
+ generate_primary_try_me_else_chain_case(PtagRval, StagReg,
+ MainPtag, OtherPtags, PtagCase, MaxSecondary, VarRval,
+ MaybeFailLabel, ThisTagCode, !CaseLabelMap, !CI),
generate_primary_try_me_else_chain(PtagGroups, PtagRval, StagReg,
VarRval, MaybeFailLabel, PtagCountMap, OtherTagsCode,
!CaseLabelMap, !CI),
@@ -368,9 +363,9 @@
PtagGroups = [],
(
MaybeFailLabel = yes(FailLabel),
- generate_primary_try_me_else_chain_case(PtagRval, StagReg, Primary,
- PtagCase, MaxSecondary, VarRval, MaybeFailLabel, ThisTagCode,
- !CaseLabelMap, !CI),
+ generate_primary_try_me_else_chain_case(PtagRval, StagReg,
+ MainPtag, OtherPtags, PtagCase, MaxSecondary, VarRval,
+ MaybeFailLabel, ThisTagCode, !CaseLabelMap, !CI),
% FailLabel ought to be the next label anyway, so this goto
% will be optimized away (unless the layout of the failcode
% in the caller changes).
@@ -381,29 +376,31 @@
Code = ThisTagCode ++ FailCode
;
MaybeFailLabel = no,
- generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
- StagReg, StagLoc, VarRval, MaybeFailLabel, Code,
+ generate_primary_tag_code(StagGoalMap, MainPtag, OtherPtags,
+ MaxSecondary, StagReg, StagLoc, VarRval, MaybeFailLabel, Code,
!CaseLabelMap, !CI)
)
).
-:- pred generate_primary_try_me_else_chain_case(rval::in, lval::in, int::in,
- ptag_case(label)::in, int::in, rval::in, maybe(label)::in,
- llds_code::out,
- case_label_map::in, case_label_map::out,
+:- pred generate_primary_try_me_else_chain_case(rval::in, lval::in,
+ tag_bits::in, list(tag_bits)::in, ptag_case(label)::in, int::in, rval::in,
+ maybe(label)::in, llds_code::out, case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_primary_try_me_else_chain_case(PtagRval, StagReg, Primary, PtagCase,
- MaxSecondary, VarRval, MaybeFailLabel, Code, !CaseLabelMap, !CI) :-
+generate_primary_try_me_else_chain_case(PtagRval, StagReg,
+ MainPtag, OtherPtags, PtagCase, MaxSecondary, VarRval, MaybeFailLabel,
+ Code, !CaseLabelMap, !CI) :-
get_next_label(ElseLabel, !CI),
- TestRval = binop(ne, PtagRval,
- unop(mktag, const(llconst_int(Primary)))),
+ TestRval0 = binop(ne, PtagRval,
+ unop(mktag, const(llconst_int(MainPtag)))),
+ generate_primary_try_me_else_chain_other_ptags(OtherPtags, PtagRval,
+ TestRval0, TestRval),
TestCode = singleton(
llds_instr(if_val(TestRval, code_label(ElseLabel)),
"test primary tag only")
),
PtagCase = ptag_case(StagLoc, StagGoalMap),
- generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
+ generate_primary_tag_code(StagGoalMap, MainPtag, OtherPtags, MaxSecondary,
StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
!CaseLabelMap, !CI),
ElseCode = singleton(
@@ -411,11 +408,23 @@
),
Code = TestCode ++ TagCode ++ ElseCode.
+:- pred generate_primary_try_me_else_chain_other_ptags(list(tag_bits)::in,
+ rval::in, rval::in, rval::out) is det.
+
+generate_primary_try_me_else_chain_other_ptags([], _, TestRval, TestRval).
+generate_primary_try_me_else_chain_other_ptags([OtherPtag | OtherPtags],
+ PtagRval, TestRval0, TestRval) :-
+ ThisTestRval = binop(ne, PtagRval,
+ unop(mktag, const(llconst_int(OtherPtag)))),
+ TestRval1 = binop(logical_and, TestRval0, ThisTestRval),
+ generate_primary_try_me_else_chain_other_ptags(OtherPtags,
+ PtagRval, TestRval1, TestRval).
+
%-----------------------------------------------------------------------------%
% Generate a switch on a primary tag value using a try chain.
%
-:- pred generate_primary_try_chain(ptag_case_list(label)::in,
+:- pred generate_primary_try_chain(ptag_case_group_list(label)::in,
rval::in, lval::in, rval::in, maybe(label)::in,
ptag_count_map::in, llds_code::in, llds_code::in, llds_code::out,
case_label_map::in, case_label_map::out,
@@ -426,16 +435,17 @@
generate_primary_try_chain([PtagGroup | PtagGroups], PtagRval, StagReg,
VarRval, MaybeFailLabel, PtagCountMap, PrevTestsCode0, PrevCasesCode0,
Code, !CaseLabelMap, !CI) :-
- PtagGroup = Primary - PtagCase,
+ PtagGroup = ptag_case_group_entry(MainPtag, OtherPtags, PtagCase),
PtagCase = ptag_case(StagLoc, StagGoalMap),
- map.lookup(PtagCountMap, Primary, CountInfo),
+ map.lookup(PtagCountMap, MainPtag, CountInfo),
CountInfo = StagLocPrime - MaxSecondary,
expect(unify(StagLoc, StagLocPrime), this_file,
"secondary tag locations differ in generate_primary_try_chain"),
(
PtagGroups = [_ | _],
- generate_primary_try_chain_case(PtagRval, StagReg, Primary,
- PtagCase, MaxSecondary, VarRval, MaybeFailLabel,
+ generate_primary_try_chain_case(PtagRval, StagReg,
+ MainPtag, OtherPtags, PtagCase, MaxSecondary, VarRval,
+ MaybeFailLabel,
PrevTestsCode0, PrevTestsCode1, PrevCasesCode0, PrevCasesCode1,
!CaseLabelMap, !CI),
generate_primary_try_chain(PtagGroups, PtagRval, StagReg, VarRval,
@@ -445,8 +455,9 @@
PtagGroups = [],
(
MaybeFailLabel = yes(FailLabel),
- generate_primary_try_chain_case(PtagRval, StagReg, Primary,
- PtagCase, MaxSecondary, VarRval, MaybeFailLabel,
+ generate_primary_try_chain_case(PtagRval, StagReg,
+ MainPtag, OtherPtags, PtagCase, MaxSecondary,
+ VarRval, MaybeFailLabel,
PrevTestsCode0, PrevTestsCode1, PrevCasesCode0, PrevCasesCode1,
!CaseLabelMap, !CI),
FailCode = singleton(
@@ -456,46 +467,61 @@
Code = PrevTestsCode1 ++ FailCode ++ PrevCasesCode1
;
MaybeFailLabel = no,
- Comment = "fallthrough to last primary tag value: " ++
- string.int_to_string(Primary),
+ make_ptag_comment("fallthrough to last primary tag value: ",
+ MainPtag, OtherPtags, Comment),
CommentCode = singleton(
llds_instr(comment(Comment), "")
),
- generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
- StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
- !CaseLabelMap, !CI),
+ generate_primary_tag_code(StagGoalMap, MainPtag, OtherPtags,
+ MaxSecondary, StagReg, StagLoc, VarRval, MaybeFailLabel,
+ TagCode, !CaseLabelMap, !CI),
Code = PrevTestsCode0 ++ CommentCode ++ TagCode ++ PrevCasesCode0
)
).
-:- pred generate_primary_try_chain_case(rval::in, lval::in, int::in,
+:- pred generate_primary_try_chain_case(rval::in, lval::in,
+ tag_bits::in, list(tag_bits)::in,
ptag_case(label)::in, int::in, rval::in, maybe(label)::in,
llds_code::in, llds_code::out, llds_code::in, llds_code::out,
case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_primary_try_chain_case(PtagRval, StagReg, Primary, PtagCase,
- MaxSecondary, VarRval, MaybeFailLabel,
+generate_primary_try_chain_case(PtagRval, StagReg, MainPtag, OtherPtags,
+ PtagCase, MaxSecondary, VarRval, MaybeFailLabel,
PrevTestsCode0, PrevTestsCode, PrevCasesCode0, PrevCasesCode,
!CaseLabelMap, !CI) :-
get_next_label(ThisPtagLabel, !CI),
- TestRval = binop(eq, PtagRval,
- unop(mktag, const(llconst_int(Primary)))),
+ TestRval0 = binop(eq, PtagRval,
+ unop(mktag, const(llconst_int(MainPtag)))),
+ generate_primary_try_chain_other_ptags(OtherPtags, PtagRval,
+ TestRval0, TestRval),
TestCode = singleton(
llds_instr(if_val(TestRval, code_label(ThisPtagLabel)),
"test primary tag only")
),
- Comment = "primary tag value: " ++ string.int_to_string(Primary),
+ make_ptag_comment("primary tag value: ", MainPtag, OtherPtags, Comment),
LabelCode = singleton(
llds_instr(label(ThisPtagLabel), Comment)
),
PtagCase = ptag_case(StagLoc, StagGoalMap),
- generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
+ generate_primary_tag_code(StagGoalMap, MainPtag, OtherPtags, MaxSecondary,
StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
!CaseLabelMap, !CI),
PrevTestsCode = PrevTestsCode0 ++ TestCode,
PrevCasesCode = LabelCode ++ TagCode ++ PrevCasesCode0.
+:- pred generate_primary_try_chain_other_ptags(list(tag_bits)::in,
+ rval::in, rval::in, rval::out) is det.
+
+generate_primary_try_chain_other_ptags([], _, TestRval, TestRval).
+generate_primary_try_chain_other_ptags([OtherPtag | OtherPtags],
+ PtagRval, TestRval0, TestRval) :-
+ ThisTestRval = binop(eq, PtagRval,
+ unop(mktag, const(llconst_int(OtherPtag)))),
+ TestRval1 = binop(logical_or, TestRval0, ThisTestRval),
+ generate_primary_try_chain_other_ptags(OtherPtags,
+ PtagRval, TestRval1, TestRval).
+
%-----------------------------------------------------------------------------%
% Generate the cases for a primary tag using a dense jump table
@@ -517,7 +543,10 @@
Code = empty
;
NextPrimary = CurPrimary + 1,
- ( PtagGroups = [CurPrimary - PrimaryInfo | PtagGroupsTail] ->
+ (
+ PtagGroups = [PtagCaseEntry | PtagGroupsTail],
+ PtagCaseEntry = ptag_case_entry(CurPrimary, PrimaryInfo)
+ ->
PrimaryInfo = ptag_case(StagLoc, StagGoalMap),
map.lookup(PtagCountMap, CurPrimary, CountInfo),
CountInfo = StagLocPrime - MaxSecondary,
@@ -525,13 +554,12 @@
"secondary tag locations differ " ++
"in generate_primary_jump_table"),
get_next_label(NewLabel, !CI),
- LabelCode = singleton(
- llds_instr(label(NewLabel),
- "start of a case in primary tag switch")
- ),
- generate_primary_tag_code(StagGoalMap, CurPrimary, MaxSecondary,
- StagReg, StagLoc, VarRval, MaybeFailLabel, ThisTagCode,
- !CaseLabelMap, !CI),
+ Comment = "start of a case in primary tag switch: ptag " ++
+ string.int_to_string(CurPrimary),
+ LabelCode = singleton(llds_instr(label(NewLabel), Comment)),
+ generate_primary_tag_code(StagGoalMap, CurPrimary, [],
+ MaxSecondary, StagReg, StagLoc, VarRval, MaybeFailLabel,
+ ThisTagCode, !CaseLabelMap, !CI),
generate_primary_jump_table(PtagGroupsTail, NextPrimary,
MaxPrimary, StagReg, VarRval, MaybeFailLabel, PtagCountMap,
TailTargets, TailCode, !CaseLabelMap, !CI),
@@ -579,7 +607,7 @@
Code = empty
)
;
- PtagGroups = [CurPrimaryPrime - PrimaryInfo],
+ PtagGroups = [ptag_case_entry(CurPrimaryPrime, PrimaryInfo)],
expect(unify(CurPrimary, CurPrimaryPrime), this_file,
"generate_primary_binary_search: cur_primary mismatch"),
PrimaryInfo = ptag_case(StagLoc, StagGoalMap),
@@ -587,8 +615,8 @@
CountInfo = StagLocPrime - MaxSecondary,
expect(unify(StagLoc, StagLocPrime), this_file,
"generate_primary_jump_table: secondary tag locations differ"),
- generate_primary_tag_code(StagGoalMap, CurPrimary, MaxSecondary,
- StagReg, StagLoc, VarRval, MaybeFailLabel, Code,
+ generate_primary_tag_code(StagGoalMap, CurPrimary, [],
+ MaxSecondary, StagReg, StagLoc, VarRval, MaybeFailLabel, Code,
!CaseLabelMap, !CI)
;
PtagGroups = [_, _ | _],
@@ -599,7 +627,7 @@
LowRangeEnd = (MinPtag + MaxPtag) // 2,
HighRangeStart = LowRangeEnd + 1,
InLowGroup = (pred(PtagGroup::in) is semidet :-
- PtagGroup = Ptag - _,
+ PtagGroup = ptag_case_entry(Ptag, _),
Ptag =< LowRangeEnd
),
list.filter(InLowGroup, PtagGroups, LowGroups, HighGroups),
@@ -636,13 +664,14 @@
% If this primary tag has secondary tags, decide whether we should
% use a jump table to implement the secondary switch.
%
-:- pred generate_primary_tag_code(stag_goal_map(label)::in, tag_bits::in,
- int::in, lval::in, sectag_locn::in, rval::in, maybe(label)::in,
- llds_code::out, case_label_map::in, case_label_map::out,
+:- pred generate_primary_tag_code(stag_goal_map(label)::in,
+ tag_bits::in, list(tag_bits)::in, int::in, lval::in, sectag_locn::in,
+ rval::in, maybe(label)::in, llds_code::out,
+ case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagReg, StagLoc,
- Rval, MaybeFailLabel, Code, !CaseLabelMap, !CI) :-
+generate_primary_tag_code(StagGoalMap, MainPtag, OtherPtags, MaxSecondary,
+ StagReg, StagLoc, Rval, MaybeFailLabel, Code, !CaseLabelMap, !CI) :-
map.to_assoc_list(StagGoalMap, StagGoalList),
(
StagLoc = sectag_none,
@@ -665,6 +694,7 @@
( StagLoc = sectag_local
; StagLoc = sectag_remote
),
+ expect(unify(OtherPtags, []), this_file, ">1 ptag with secondary tag"),
% There is a secondary tag, so figure out how to switch on it.
get_globals(!.CI, Globals),
@@ -685,7 +715,7 @@
(
StagLoc = sectag_remote,
- OrigStagRval = lval(field(yes(Primary), Rval,
+ OrigStagRval = lval(field(yes(MainPtag), Rval,
const(llconst_int(0)))),
Comment = "compute remote sec tag to switch on"
;
@@ -971,6 +1001,23 @@
%-----------------------------------------------------------------------------%
+:- pred make_ptag_comment(string::in, tag_bits::in, list(tag_bits)::in,
+ string::out) is det.
+
+make_ptag_comment(BaseStr, MainPtag, OtherPtags, Comment) :-
+ (
+ OtherPtags = [],
+ Comment = BaseStr ++ string.int_to_string(MainPtag)
+ ;
+ OtherPtags = [_ | _],
+ Comment = BaseStr ++ string.int_to_string(MainPtag)
+ ++ "(shared with " ++
+ string.join_list(", ", list.map(string.int_to_string, OtherPtags))
+ ++ ")"
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- func this_file = string.
this_file = "tag_switch.m".
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.377
diff -u -b -r1.377 Mmakefile
--- tests/hard_coded/Mmakefile 14 Aug 2009 20:37:53 -0000 1.377
+++ tests/hard_coded/Mmakefile 17 Aug 2009 10:04:27 -0000
@@ -152,6 +152,7 @@
mode_check_clauses \
mode_choice \
multi_arm_switch \
+ multi_arm_switch_2 \
multi_map_test \
multimode \
multimode_addr \
@@ -227,9 +228,10 @@
string_split_2 \
string_string \
string_strip \
- string_substring \
string_sub_string_search \
+ string_substring \
string_suffix_bug \
+ string_switch \
string_various \
sv_nested_closures \
sv_record_update \
Index: tests/hard_coded/multi_arm_switch_2.exp
===================================================================
RCS file: tests/hard_coded/multi_arm_switch_2.exp
diff -N tests/hard_coded/multi_arm_switch_2.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/multi_arm_switch_2.exp 16 Aug 2009 18:14:27 -0000
@@ -0,0 +1,13 @@
+f1 -> 1
+f2 -> 1
+f3 -> 2
+f4(104) -> 2
+f5(105) -> 2
+f6(106) -> 3
+f7(107) -> 3
+f8(108) -> 3
+f9(109) -> 3
+f10(110) -> 3
+f11(111) -> 3
+f12(112) -> 4
+f13(113) -> 4
Index: tests/hard_coded/multi_arm_switch_2.m
===================================================================
RCS file: tests/hard_coded/multi_arm_switch_2.m
diff -N tests/hard_coded/multi_arm_switch_2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/multi_arm_switch_2.m 16 Aug 2009 18:14:22 -0000
@@ -0,0 +1,99 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+
+:- module multi_arm_switch_2.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module maybe.
+:- import_module require.
+:- import_module solutions.
+
+:- type t
+ ---> f1
+ ; f2
+ ; f3
+ ; f4(int)
+ ; f5(int)
+ ; f6(int)
+ ; f7(int)
+ ; f8(int)
+ ; f9(int)
+ ; f10(int)
+ ; f11(int)
+ ; f12(int)
+ ; f13(int).
+
+main(!IO) :-
+ test(f1, !IO),
+ test(f2, !IO),
+ test(f3, !IO),
+ test(f4(104), !IO),
+ test(f5(105), !IO),
+ test(f6(106), !IO),
+ test(f7(107), !IO),
+ test(f8(108), !IO),
+ test(f9(109), !IO),
+ test(f10(110), !IO),
+ test(f11(111), !IO),
+ test(f12(112), !IO),
+ test(f13(113), !IO).
+
+:- pred test(t::in, io::di, io::uo) is det.
+
+test(X, !IO) :-
+ p(X, N),
+ io.write(X, !IO),
+ io.write_string(" -> ", !IO),
+ io.write_int(N, !IO),
+ io.nl(!IO).
+
+:- pred p(t::in, int::out) is det.
+
+p(X, N) :-
+ (
+ % This tests the sharing of code between functors with the same primary
+ % tag and different local secondary tags.
+ ( X = f1
+ ; X = f2
+ ),
+ N = 1
+ ;
+ % The presence of f3 here tests the proper handling of primary tags
+ % with local secondary tags, not all of which are in the first switch
+ % arm.
+ % The presence of f4 and f5 tests the sharing of code between functors
+ % with their own primary tags.
+ ( X = f3
+ ; X = f4(_)
+ ; X = f5(_)
+ ),
+ N = 2
+ ;
+ % The presence of f10 and f11 tests the sharing of code between
+ % functors with the same primary tag and different remote secondary
+ % tags. (On 64 bit machines, the other functors here will have their
+ % own primary tags.)
+ ( X = f6(_)
+ ; X = f7(_)
+ ; X = f8(_)
+ ; X = f9(_)
+ ; X = f10(_)
+ ; X = f11(_)
+ ),
+ N = 3
+ ;
+ % The presence of f12 and f13 here tests the proper handling of
+ % primary tags with remote secondary tags, not all of which are
+ % in the third switch arm.
+ ( X = f12(_)
+ ; X = f13(_)
+ ),
+ N = 4
+ ).
Index: tests/hard_coded/string_switch.exp
===================================================================
RCS file: tests/hard_coded/string_switch.exp
diff -N tests/hard_coded/string_switch.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_switch.exp 17 Aug 2009 10:03:24 -0000
@@ -0,0 +1,12 @@
+a -> 1
+b -> 2
+c failed
+aa -> 11
+ab -> 11
+ac failed
+ba -> 12
+bb -> 12
+bc failed
+ca -> 13
+cb failed
+cc failed
Index: tests/hard_coded/string_switch.m
===================================================================
RCS file: tests/hard_coded/string_switch.m
diff -N tests/hard_coded/string_switch.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_switch.m 17 Aug 2009 09:04:56 -0000
@@ -0,0 +1,80 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+
+:- module string_switch.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ test("a", !IO),
+ test("b", !IO),
+ test("c", !IO),
+ test("aa", !IO),
+ test("ab", !IO),
+ test("ac", !IO),
+ test("ba", !IO),
+ test("bb", !IO),
+ test("bc", !IO),
+ test("ca", !IO),
+ test("cb", !IO),
+ test("cc", !IO).
+
+:- pred test(string::in, io::di, io::uo) is det.
+
+test(S, !IO) :-
+ ( p(S, N) ->
+ io.format("%s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("%s failed\n", [s(S)], !IO)
+ ).
+
+:- pred p(string::in, int::out) is semidet.
+
+p(S, N) :-
+ (
+ S = "a",
+ N = 1
+ ;
+ S = "b",
+ N = 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ N = 11
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ N = 12
+ ;
+ ( S = "ca"
+ ; S = "cd"
+ ; S = "ce"
+ ),
+ N = 13
+ ;
+ S = "xxx",
+ N = 21
+ ;
+ S = "xxy",
+ N = 22
+ ;
+ S = "xxz",
+ N = 23
+ ;
+ S = "xyx",
+ N = 24
+ ).
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list