[m-rev.] for post-commit review: binary search and lookup switches on strings
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Nov 1 14:06:53 AEDT 2010
Until now, the only indexing we did for switches on strings was using a hash
table containing jump targets (represented as indices into a list of labels).
This diff supplements this with
- binary searches of tables containing jump targets,
- binary searches of tables containing values (lookup tables), and
- hash searches of tables containing values (lookup tables).
For now, the new methods exist in the LLDS backend only.
NEWS:
Mention the new capability.
compiler/string_switch.m:
Add predicates that implement the new indexing methods on strings.
Factor out code from existing predicates as required for this.
compiler/switch_gen.m:
Invoke the new predicates in string_switch.m when relevant.
Avoid passing the constant "no" as the initial value of !MaybeEnd
to predicates where we know this will ALWAYS happen.
compiler/options.m:
doc/user_guide.texi:
Add an option to control when we use binary searches for switches
on strings.
compiler/lookup_switch.m:
This module previously handled lookup switches on integers.
Generalize it so that pieces of it are now also usable to help
implement lookup switches on strings. Rename the predicates specific
to switches on integers to make clear this specificity, and separate
them from the predicates that help implement lookup switches on
variables of all the supported types.
Export some types, predicates and functions for use in string_switch.m.
Fix the code so that it correctly handles det switches, which
can happen e.g. if we know the possible set of values of the
switched-on variable.
Use tail-recursive code to handle the list of switch arms, to allow us
to handle very large switches.
Remove an obsolete comment from the top about a previously implemented
optimization.
compiler/lookup_util.m:
Make set_liveness_and_end_branch update MaybeEnd, to account for the
reservation of stack slots for holding the current and last rows in
later solutions tables for model_non lookup switches.
compiler/switch_util.m:
Make the exported predicates of this module more general, making them
usable for switches on strings as well as ints. Also make them easier
to use. In one case this meant bundling two predicates that were always
used together into one predicate. In another, it meant splitting one
predicate into two, since some of its callers needed an intermediate
result. In the case of a type, it means reordering its fields
to make the order match the order of their use in the implementation.
Add some predicates specifically for switches on strings.
compiler/ml_lookup_switch.m:
compiler/ml_string_switch.m:
compiler/ml_switch_gen.m:
Conform to the changes to switch_util.m.
compiler/jumpopt.m:
If the comment associated with a label ends with "nofulljump", then
inhibit fulljump optimization of jumps to that label. That
optimization would replace the jumps with the code starting at that
label. This is avoids the overhead of jump instructions, and it is a
good idea in the usual case of forward jumps. However, for the few
backward jumps we generate, the block that replaces the jump
instruction can actually END with the same jump instruction (which may
be conditionally executed), which means that our usual repeated
invocation of jumpopt can replace the original jump instruction
with MANY copies of the block it jumps to. In some cases, such as those
in hash switches, you get more copies than can ever be executed in any
actual execution. Lookup switches therefore now mark the labels that
are targets of backward jumps with this marker.
compiler/llds.m:
Document the new behavior of jumpopt.
compiler/code_info.m:
Export a predicate for use in improving the code we generate for lookup
switches.
Make some other predicates simpler and/or more efficient.
compiler/builtin_ops.m:
Add a builtin op for doing string comparisons by calling strcmp.
This is to prevent the need for two traversals of the strings being
compared in each iteration of binary search.
compiler/bytecode.m:
compiler/c_util.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/llds.m:
compiler/llds_to_x86_64.m:
Conform to the change in builtin_ops.m.
compiler/disj_gen.m:
Conform to the change in lookup_util.m
compiler/frameopt.m:
compiler/proc_gen.m:
compiler/unify_gen.m:
Take advantage of the change in fulljump optimization.
compiler/opt_debug.m:
Improve the string representation of rvals by recording the types of
the operands of binary operations, and making the output a bit more
consistent looking.
compiler/dupproc.m:
compiler/var_locn.m:
Minor style fixes.
runtime/mercury_string.h:
Add a version of strcmp for use by our code generator. This version
casts the arguments before calling the real strcmp. We need it since we
usually specify the arguments as r1, r2 etc, which are declared as
MR_Word, not char *.
tests/hard_coded/lookup_disj.{m,exp}:
tests/hard_coded/string_switch.{m,exp}:
Make these existing tests significantly tougher by making them exercise
a wider range of use scenarios.
tests/hard_coded/string_switch{2,3}.{m,exp}:
tests/hard_coded/Mercury.options
While the string_switch test case tests the handling of jump switches,
these two new test cases test the handling of binary search tables and
hash tables respectively. Their code is identical to the code of
the string_switch test case, but Mercury.options causes them to be
compiled with different options.
tests/hard_coded/int_switch.{m,exp}:
A new test case, equivalent in structure to the string switch test
cases, to test the handling of lookup switches on atomic values.
Zoltan.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.538
diff -u -b -r1.538 NEWS
--- NEWS 14 Oct 2010 04:02:21 -0000 1.538
+++ NEWS 1 Nov 2010 02:45:35 -0000
@@ -44,6 +44,10 @@
in order to simplify building and linking against frameworks on Mac OS X.
(-F is supported as a synonym for --framework-directory.)
+* Switches on strings in which all output arguments in all switch arms are
+ bound to constants are now implemented using lookup tables on the LLDS
+ back end. This should make the generated code more compact as well as faster.
+
NEWS for Mercury 10.04.2
------------------------
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/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
Index: boehm_gc/libatomic_ops/tests/test_atomic_include.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/boehm_gc/libatomic_ops/tests/test_atomic_include.h,v
retrieving revision 1.1.1.1
diff -u -b -r1.1.1.1 test_atomic_include.h
--- boehm_gc/libatomic_ops/tests/test_atomic_include.h 23 Feb 2010 06:28:40 -0000 1.1.1.1
+++ boehm_gc/libatomic_ops/tests/test_atomic_include.h 22 Oct 2010 03:04:09 -0000
@@ -5,15 +5,6 @@
* see doc/COPYING for details.
*/
-void test_atomic(void);
-void test_atomic_release(void);
-void test_atomic_acquire(void);
-void test_atomic_read(void);
-void test_atomic_write(void);
-void test_atomic_full(void);
-void test_atomic_release_write(void);
-void test_atomic_acquire_read(void);
-
/* Some basic sanity tests. These do not test the barrier semantics. */
#undef TA_assert
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/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.31
diff -u -b -r1.31 builtin_ops.m
--- compiler/builtin_ops.m 21 Sep 2009 04:08:53 -0000 1.31
+++ compiler/builtin_ops.m 2 Oct 2010 16:19:15 -0000
@@ -63,6 +63,7 @@
; str_gt
; str_le
; str_ge
+ ; str_cmp % returns -ve, 0, or +ve
; int_lt % signed integer comparions
; int_gt
; int_le
Index: compiler/bytecode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode.m,v
retrieving revision 1.75
diff -u -b -r1.75 bytecode.m
--- compiler/bytecode.m 6 Jan 2009 03:56:24 -0000 1.75
+++ compiler/bytecode.m 2 Oct 2010 16:24:42 -0000
@@ -1069,6 +1069,7 @@
binop_code(unsigned_le, 36).
binop_code(compound_eq, 37).
binop_code(compound_lt, 38).
+binop_code(str_cmp, 39).
:- pred binop_debug(binary_op::in, string::out) is det.
@@ -1111,6 +1112,7 @@
binop_debug(unsigned_le, "unsigned_le").
binop_debug(compound_eq, "compound_eq").
binop_debug(compound_lt, "compound_lt").
+binop_debug(str_cmp, "strcmp").
:- pred unop_code(unary_op::in, int::out) is det.
Index: compiler/c_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/c_util.m,v
retrieving revision 1.46
diff -u -b -r1.46 c_util.m
--- compiler/c_util.m 16 Sep 2010 00:39:02 -0000 1.46
+++ compiler/c_util.m 2 Oct 2010 16:59:19 -0000
@@ -598,6 +598,7 @@
binop_category_string(int_le, int_or_bool_binary_infix_binop, "<=").
binop_category_string(int_ge, int_or_bool_binary_infix_binop, ">=").
+binop_category_string(str_cmp, macro_binop, "MR_strcmp").
binop_category_string(body, macro_binop, "MR_body").
%-----------------------------------------------------------------------------%
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.377
diff -u -b -r1.377 code_info.m
--- compiler/code_info.m 30 Oct 2009 03:33:11 -0000 1.377
+++ compiler/code_info.m 31 Oct 2010 23:38:52 -0000
@@ -1260,7 +1260,7 @@
EndCodeInfo1 = !.CI,
(
MaybeEnd0 = no,
- EndCodeInfo = EndCodeInfo1
+ MaybeEnd = yes(branch_end_info(EndCodeInfo1))
;
MaybeEnd0 = yes(branch_end_info(EndCodeInfo0)),
@@ -1306,9 +1306,10 @@
get_temps_in_use(EndCodeInfo0, TempsInUse0),
get_temps_in_use(EndCodeInfo1, TempsInUse1),
set.union(TempsInUse0, TempsInUse1, TempsInUse),
- set_temps_in_use(TempsInUse, EndCodeInfoA, EndCodeInfo)
- ),
- MaybeEnd = yes(branch_end_info(EndCodeInfo)).
+ set_temps_in_use(TempsInUse, EndCodeInfoA, EndCodeInfo),
+
+ MaybeEnd = yes(branch_end_info(EndCodeInfo))
+ ).
after_all_branches(StoreMap, MaybeEnd, !CI) :-
(
@@ -3209,6 +3210,9 @@
:- pred make_vars_forward_dead(set(prog_var)::in,
code_info::in, code_info::out) is det.
+:- pred maybe_make_vars_forward_dead(set(prog_var)::in, bool::in,
+ code_info::in, code_info::out) is det.
+
:- pred pickup_zombies(set(prog_var)::out,
code_info::in, code_info::out) is det.
@@ -3281,9 +3285,6 @@
make_vars_forward_dead(Vars, !CI) :-
maybe_make_vars_forward_dead(Vars, yes, !CI).
-:- pred maybe_make_vars_forward_dead(set(prog_var)::in, bool::in,
- code_info::in, code_info::out) is det.
-
maybe_make_vars_forward_dead(Vars0, FirstTime, !CI) :-
ResumeVars = current_resume_point_vars(!.CI),
set.intersect(Vars0, ResumeVars, FlushVars),
@@ -3292,17 +3293,18 @@
set_zombies(Zombies, !CI),
set.difference(Vars0, Zombies, Vars),
set.to_sorted_list(Vars, VarList),
- maybe_make_vars_forward_dead_2(VarList, FirstTime, !CI).
+ get_var_locn_info(!.CI, VarLocnInfo0),
+ maybe_make_vars_forward_dead_2(VarList, FirstTime,
+ VarLocnInfo0, VarLocnInfo),
+ set_var_locn_info(VarLocnInfo, !CI).
:- pred maybe_make_vars_forward_dead_2(list(prog_var)::in, bool::in,
- code_info::in, code_info::out) is det.
+ var_locn_info::in, var_locn_info::out) is det.
-maybe_make_vars_forward_dead_2([], _, !CI).
-maybe_make_vars_forward_dead_2([V | Vs], FirstTime, !CI) :-
- get_var_locn_info(!.CI, VarLocnInfo0),
- var_locn_var_becomes_dead(V, FirstTime, VarLocnInfo0, VarLocnInfo),
- set_var_locn_info(VarLocnInfo, !CI),
- maybe_make_vars_forward_dead_2(Vs, FirstTime, !CI).
+maybe_make_vars_forward_dead_2([], _, !VLI).
+maybe_make_vars_forward_dead_2([Var | Vars], FirstTime, !VLI) :-
+ var_locn_var_becomes_dead(Var, FirstTime, !VLI),
+ maybe_make_vars_forward_dead_2(Vars, FirstTime, !VLI).
pickup_zombies(Zombies, !CI) :-
get_zombies(!.CI, Zombies),
Index: compiler/disj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/disj_gen.m,v
retrieving revision 1.113
diff -u -b -r1.113 disj_gen.m
--- compiler/disj_gen.m 2 Oct 2009 03:55:27 -0000 1.113
+++ compiler/disj_gen.m 31 Oct 2010 23:39:32 -0000
@@ -199,7 +199,7 @@
llds_code::out, code_info::in, code_info::out) is det.
generate_lookup_disj(ResumeVars, LookupDisjInfo, Code, !CI) :-
- LookupDisjInfo = lookup_disj_info(OutVars, StoreMap, MaybeEnd, Liveness,
+ LookupDisjInfo = lookup_disj_info(OutVars, StoreMap, MaybeEnd0, Liveness,
CurSlot, ResumeMap, FlushCode, SaveTicketCode, MaybeTicketSlot,
SaveHpCode, MaybeHpSlot, HijackInfo, PrepareHijackCode,
Solns, LLDSTypes),
@@ -243,7 +243,7 @@
pickup_zombies(FirstZombies, !CI),
make_vars_forward_dead(FirstZombies, !CI),
- set_liveness_and_end_branch(StoreMap, MaybeEnd, Liveness,
+ set_liveness_and_end_branch(StoreMap, Liveness, MaybeEnd0, MaybeEnd1,
FirstBranchEndCode, !CI),
release_reg(BaseReg, !CI),
@@ -302,7 +302,7 @@
pickup_zombies(LaterZombies, !CI),
make_vars_forward_dead(LaterZombies, !CI),
- set_liveness_and_end_branch(StoreMap, MaybeEnd, Liveness,
+ set_liveness_and_end_branch(StoreMap, Liveness, MaybeEnd1, MaybeEnd,
LaterBranchEndCode, !CI),
after_all_branches(StoreMap, MaybeEnd, !CI),
Index: compiler/dupproc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dupproc.m,v
retrieving revision 1.25
diff -u -b -r1.25 dupproc.m
--- compiler/dupproc.m 21 Oct 2009 06:36:18 -0000 1.25
+++ compiler/dupproc.m 31 Oct 2010 13:38:38 -0000
@@ -118,11 +118,11 @@
:- pred maybe_redirect_proc(c_procedure::in, proc_label::in,
maybe(c_procedure)::out) is det.
-maybe_redirect_proc(Proc0, Target, MaybeProc) :-
+maybe_redirect_proc(Proc0, TargetProcLabel, MaybeProc) :-
Instrs0 = Proc0 ^ cproc_code,
get_prologue(Instrs0, LabelInstr, _Comments, LaterInstrs),
- Redirect = llds_instr(
- goto(code_label(entry_label(entry_label_local, Target))),
+ TargetLabel = entry_label(entry_label_local, TargetProcLabel),
+ Redirect = llds_instr(goto(code_label(TargetLabel)),
"Redirect to procedure with identical body"),
list.filter(disallowed_instr, LaterInstrs, DisallowedInstrs),
list.length(LaterInstrs, NumLaterInstrs),
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.118
diff -u -b -r1.118 frameopt.m
--- compiler/frameopt.m 30 Jul 2010 05:32:52 -0000 1.118
+++ compiler/frameopt.m 31 Oct 2010 13:36:29 -0000
@@ -295,7 +295,8 @@
->
list.condense([[LabelInstr], Comments0,
[llds_instr(mkframe(FrameInfo, no), MkframeComment),
- llds_instr(label(KeepFrameLabel), "tail recursion target"),
+ llds_instr(label(KeepFrameLabel),
+ "tail recursion target, nofulljump"),
llds_instr(assign(redoip_slot(lval(curfr)),
const(llconst_code_addr(Redoip))), "")],
Instrs2], Instrs),
@@ -1051,7 +1052,6 @@
:- pred compute_block_needs_frame(label::in, list(instruction)::in,
block_needs_frame::out) is det.
-% ZZZ
compute_block_needs_frame(_Label, Instrs, NeedsFrame) :-
opt_util.block_refers_to_stack(Instrs) = ReferStackVars,
(
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.113
diff -u -b -r1.113 jumpopt.m
--- compiler/jumpopt.m 3 Feb 2010 23:23:37 -0000 1.113
+++ compiler/jumpopt.m 31 Oct 2010 13:57:03 -0000
@@ -168,7 +168,7 @@
!LvalMap, !ProcMap, !SdprocMap, !SuccMap).
jump_opt_build_maps([Instr0 | Instrs0], Recjump, !InstrMap, !BlockMap,
!LvalMap, !ProcMap, !SdprocMap, !SuccMap) :-
- Instr0 = llds_instr(Uinstr0, _),
+ Instr0 = llds_instr(Uinstr0, Comment0),
( Uinstr0 = label(Label) ->
opt_util.skip_comments(Instrs0, Instrs1),
( Instrs1 = [Instr1 | _], Instr1 = llds_instr(livevals(_), _) ->
@@ -200,8 +200,15 @@
% Put the start of the procedure into Blockmap only after
% frameopt has had a shot at it.
(
- ( Label = internal_label(_, _)
- ; Recjump = yes
+ (
+ Label = internal_label(_, _),
+ % We put entry labels into !BlockMap only if the comment
+ % does NOT end with "nofulljump".
+ not string.suffix(Comment0, "nofulljump")
+ ;
+ Label = entry_label(_, _),
+ % We put entry labels into !BlockMap only if Recjump = yes.
+ Recjump = yes
)
->
opt_util.find_no_fallthrough(Instrs1, Block),
@@ -493,7 +500,8 @@
PrevInstr = livevals(Livevals)
->
opt_util.filter_out_livevals(Between0, Between1),
- NewInstrs = Between1 ++ [llds_instr(livevals(Livevals), ""),
+ NewInstrs = Between1 ++
+ [llds_instr(livevals(Livevals), ""),
llds_instr(goto(Proc), redirect_comment(Comment0))],
NewRemain = specified(NewInstrs, Instrs0)
;
@@ -503,7 +511,8 @@
map.search(ForkMap, RetLabel, Between),
PrevInstr = livevals(Livevals)
->
- NewInstrs = Between ++ [llds_instr(livevals(Livevals), ""),
+ NewInstrs = Between ++
+ [llds_instr(livevals(Livevals), ""),
llds_instr(goto(Proc), redirect_comment(Comment0))],
NewRemain = specified(NewInstrs, Instrs0)
;
@@ -533,8 +542,7 @@
!.CheckedNondetTailCallInfo = yes(ProcLabel - Counter0),
SuccMap = JumpOptInfo ^ joi_succ_map,
map.search(SuccMap, RetLabel, BetweenIncl),
- BetweenIncl = [llds_instr(livevals(_), _),
- llds_instr(goto(_), _)],
+ BetweenIncl = [llds_instr(livevals(_), _), llds_instr(goto(_), _)],
PrevInstr = livevals(Livevals)
->
counter.allocate(LabelNum, Counter0, Counter1),
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.366
diff -u -b -r1.366 llds.m
--- compiler/llds.m 3 Feb 2010 23:23:37 -0000 1.366
+++ compiler/llds.m 31 Oct 2010 13:39:04 -0000
@@ -329,13 +329,14 @@
; label(label)
% Defines a label that can be used as the target of calls, gotos,
- % etc.
+ % etc. If the comment associated with the instruction ends with
+ % "nofulljump", then gotos ending at this label will not be
+ % replaced by the code starting at this label.
; goto(code_addr)
- % goto(Target)
% Branch to the specified address. Note that jumps to do_fail,
- % do_redo, etc., can get optimized into the invocations of macros
- % fail(), redo(), etc..
+ % do_redo, etc can get optimized into invocations of the macros
+ % fail(), redo(), etc.
; computed_goto(rval, list(maybe(label)))
% Evaluate rval, which should be an integer, and jump to the
@@ -1593,6 +1594,7 @@
binop_return_type(str_gt, lt_bool).
binop_return_type(str_le, lt_bool).
binop_return_type(str_ge, lt_bool).
+binop_return_type(str_cmp, lt_integer).
binop_return_type(int_lt, lt_bool).
binop_return_type(int_gt, lt_bool).
binop_return_type(int_le, lt_bool).
Index: compiler/llds_to_x86_64.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_to_x86_64.m,v
retrieving revision 1.13
diff -u -b -r1.13 llds_to_x86_64.m
--- compiler/llds_to_x86_64.m 4 Nov 2009 03:44:48 -0000 1.13
+++ compiler/llds_to_x86_64.m 31 Oct 2010 13:39:39 -0000
@@ -868,6 +868,7 @@
binop_instr(str_gt, _, _, [x86_64_comment("<<str_gt>>")]).
binop_instr(str_le, _, _, [x86_64_comment("<<str_le>>")]).
binop_instr(str_ge, _, _, [x86_64_comment("<<str_ge>>")]).
+binop_instr(str_cmp, _, _, [x86_64_comment("<<str_cmp>>")]).
binop_instr(int_lt, Op1, Op2, [x86_64_instr(cmp(Op1, Op2))]).
binop_instr(int_gt, Op1, Op2, [x86_64_instr(cmp(Op1, Op2))]).
binop_instr(int_le, Op1, Op2, [x86_64_instr(cmp(Op1, Op2))]).
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.85
diff -u -b -r1.85 lookup_switch.m
--- compiler/lookup_switch.m 2 Oct 2009 03:55:27 -0000 1.85
+++ compiler/lookup_switch.m 1 Nov 2010 02:29:21 -0000
@@ -16,7 +16,7 @@
%
% For switches that can fail, the generated code does a range check on the
% index, and then does a lookup in a bit-vector to see if there is a value for
-% the appropriate case. If there is, then it does a lookup (using the field
+% the appropriate case. If there is, then it does a lookup (using the MR_field
% macro) in the array of results. The array is padded with "0"s for cases that
% are not covered. This is fine, since we do the lookup after we check the
% bit-vector for the appropriate case.
@@ -29,17 +29,13 @@
% then may throw it away if a subsequent case generates actual code, or non
% constant outputs.
%
-% A potential improvement would be to make a single array for each switch,
-% since putting the values produced for each tag value side-by-side in memory
-% will tend to lead to fewer cache misses.
-%
% The number of bits per word is taken from the bits_per_word option which
-% uses a flag in the mc script with a value from configuration. This is used
+% uses a flag in the mmc script with a value from configuration. This is used
% when generating bit-vectors.
%
% The implementation of lookup switches is further documented in the paper
% Dealing with large predicates: exo-compilation in the WAM and in Mercury,
-% by Bart Demoen Phuong-Lan Nguyen, Vi'tor Santos Costa, Zoltan Somogyi.
+% by Bart Demoen, Phuong-Lan Nguyen, Vi'tor Santos Costa and Zoltan Somogyi.
%
% The module ml_lookup_switch.m implements lookup switches for the MLDS
% backend. Any changes here may need to be reflected there as well.
@@ -50,30 +46,121 @@
:- interface.
:- import_module backend_libs.switch_util.
+:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_llds.
:- import_module ll_backend.code_info.
:- import_module ll_backend.llds.
+:- import_module parse_tree.prog_data.
:- import_module list.
+:- import_module map.
+:- import_module set.
%-----------------------------------------------------------------------------%
-:- type lookup_switch_info.
+:- type lookup_switch_info(Key)
+ ---> lookup_switch_info(
+ % The map from the switched-on value to the values of the
+ % variables in each solution.
+ lsi_cases :: case_consts(Key, rval),
+
+ % The output variables.
+ lsi_variables :: list(prog_var),
+
+ % The types of the fields in the C structure we generate
+ % for each case.
+ lsi_field_types :: list(llds_type),
+
+ lsi_liveness :: set(prog_var)
+ ).
+
+:- pred record_lookup_for_tagged_cons_id_int(soln_consts(rval)::in,
+ tagged_cons_id::in,
+ map(int, soln_consts(rval))::in, map(int, soln_consts(rval))::out) is det.
+
+:- pred record_lookup_for_tagged_cons_id_string(soln_consts(rval)::in,
+ tagged_cons_id::in,
+ map(string, soln_consts(rval))::in, map(string, soln_consts(rval))::out)
+ is det.
+
+:- type record_switch_lookup(Key) ==
+ pred(soln_consts(rval), tagged_cons_id,
+ map(Key, soln_consts(rval)), map(Key, soln_consts(rval))).
+:- inst record_switch_lookup ==
+ (pred(in, in, in, out) is det).
% Decide whether we can generate code for this switch using a lookup table.
%
-:- pred is_lookup_switch(list(tagged_case)::in, hlds_goal_info::in,
- abs_store_map::in, branch_end::in, branch_end::out,
- lookup_switch_info::out, code_info::in, code_info::out) is semidet.
+:- pred is_lookup_switch(record_switch_lookup(Key)::in(record_switch_lookup),
+ list(tagged_case)::in, hlds_goal_info::in, abs_store_map::in,
+ branch_end::in, branch_end::out, lookup_switch_info(Key)::out,
+ code_info::in, code_info::out) is semidet.
% Generate code for the switch that the lookup_switch_info came from.
%
-:- pred generate_lookup_switch(rval::in, abs_store_map::in, branch_end::in,
- lookup_switch_info::in, int::in, int::in,
- need_bit_vec_check::in, need_range_check::in, llds_code::out,
+:- pred generate_int_lookup_switch(rval::in, lookup_switch_info(int)::in,
+ label::in, abs_store_map::in, int::in, int::in,
+ need_bit_vec_check::in, need_range_check::in,
+ branch_end::in, branch_end::out, llds_code::out,
code_info::in, code_info::out) is det.
+:- type case_kind
+ ---> kind_zero_solns
+ ; kind_one_soln
+ ; kind_several_solns.
+
+ % generate_code_for_all_kinds(Kinds, NumPrevColumns, OutVars, ResumeVars,
+ % EndLabel, StoreMap, Liveness, AddTrailOps,
+ % BaseReg, LaterVectorAddrRval, Code, !CI):
+ %
+ % Generate code for the kinds of solution cardinalities listed in Kinds.
+ %
+ % - For kind_zero_solns, generate code that performs failure.
+ % - For kind_one_solution, generate code that looks up the main table
+ % at row BaseReg and then goes to EndLabel.
+ % - For kind_several_solns, generate code that looks up the main table
+ % at row BaseReg, sets up a resume point that stores ResumeVars,
+ % succeeds by going to EndLabel. On backtracking, the generated code
+ % will keep returning rows from the later solution table until there are
+ % no more later solutions associated with row BaseReg.
+ %
+ % The definition of EndLabel is up to the caller.
+ %
+ % For this predicate, the main table's columns form three groups.
+ %
+ % - The first group of NumPrevColumns columns are ignored by this
+ % predicate.
+ % - For int switches, there will be no previous columns.
+ % - For binary string switches, there is one containing the string.
+ % - For hash string switches, there are two, containing the string,
+ % and the number of the next slot in the open addressing sequence.
+ %
+ % - The second group contains two columns, which contain respectively
+ % the offsets of the first and last later solutions in the later
+ % solutions table. Each of these offsets is the offset of the first
+ % column of the selected row. An offset of zero indicates there is
+ % no later solution, which means that the first row of the later solution
+ % table can never be referred to, and must therefore be a dummy.
+ %
+ % - The third group consists of the values of OutVars.
+ %
+ % Therefore each row of the main table has NumPrevColumns + 2 + |OutVars|
+ % columns, while the later solutions table has |OutVars| columns.
+ %
+ % This predicate assumes that the caller has already set BaseReg to point
+ % to the start of the relevant row in the main solutions table.
+ % LaterVectorAddrRval should be the address of the start of the later
+ % solutions table.
+ %
+:- pred generate_code_for_all_kinds(list(case_kind)::in, int::in,
+ list(prog_var)::in, set(prog_var)::in, label::in, abs_store_map::in,
+ set(prog_var)::in, add_trail_ops::in, lval::in, rval::in,
+ branch_end::in, branch_end::out, llds_code::out,
+ code_info::in, code_info::out) is det.
+
+:- func default_value_for_type(llds_type) = rval.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -83,7 +170,6 @@
:- import_module check_hlds.type_util.
:- import_module hlds.code_model.
:- import_module hlds.goal_form.
-:- import_module hlds.hlds_data.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
@@ -91,43 +177,23 @@
:- import_module ll_backend.dense_switch.
:- import_module ll_backend.global_data.
:- import_module ll_backend.lookup_util.
-:- import_module parse_tree.prog_data.
:- import_module assoc_list.
:- import_module bool.
:- import_module cord.
:- import_module int.
-:- import_module map.
:- import_module maybe.
:- import_module pair.
-:- import_module set.
+:- import_module std_util.
:- import_module string.
:- import_module svmap.
%-----------------------------------------------------------------------------%
-:- type lookup_switch_info
- ---> lookup_switch_info(
- % The map from the switched-on value to the values of the
- % variables in each solution.
- lsi_cases :: case_consts(rval),
-
- % The output variables.
- lsi_variables :: list(prog_var),
-
- % The types of the fields in the C structure we generate
- % for each case.
- lsi_field_types :: list(llds_type),
-
- lsi_liveness :: set(prog_var)
- ).
-
-%-----------------------------------------------------------------------------%
-
+is_lookup_switch(RecordLookupForTaggedConsId, TaggedCases, GoalInfo, StoreMap,
+ !MaybeEnd, LookupSwitchInfo, !CI) :-
% Most of this predicate is taken from dense_switch.m.
- %
-is_lookup_switch(TaggedCases, GoalInfo, StoreMap, !MaybeEnd, LookupSwitchInfo,
- !CI) :-
+
% We need the code_info structure to generate code for the cases to
% get the constants (if they exist). We can't throw it away at the
% end because we may have allocated some new static ground terms.
@@ -135,45 +201,47 @@
figure_out_output_vars(!.CI, GoalInfo, OutVars),
set.list_to_set(OutVars, ArmNonLocals),
remember_position(!.CI, CurPos),
- generate_constants_for_lookup_switch(TaggedCases, OutVars, ArmNonLocals,
- StoreMap, Liveness, map.init, CaseSolnMap, !MaybeEnd,
- set.init, ResumeVars, no, GoalsMayModifyTrail, !CI),
+ generate_constants_for_lookup_switch(RecordLookupForTaggedConsId,
+ TaggedCases, OutVars, ArmNonLocals, StoreMap, Liveness,
+ map.init, CaseSolnMap, !MaybeEnd, set.init, ResumeVars,
+ no, GoalsMayModifyTrail, !CI),
map.to_assoc_list(CaseSolnMap, CaseSolns),
reset_to_position(CurPos, !CI),
VarTypes = get_var_types(!.CI),
list.map(map.lookup(VarTypes), OutVars, OutTypes),
- ( project_all_to_one_solution(CaseSolns, [], RevCaseValuePairs) ->
- list.reverse(RevCaseValuePairs, CaseValuePairs),
+ ( project_all_to_one_solution(CaseSolns, CaseValuePairs) ->
CaseConsts = all_one_soln(CaseValuePairs),
assoc_list.values(CaseValuePairs, CaseValues)
;
CaseConsts = some_several_solns(CaseSolns, ResumeVars,
GoalsMayModifyTrail),
% This generates CaseValues in reverse order of index, but given that
- % we only use CaseValues to find out the right LLDSTypes, this is OK.
+ % we only use CaseValues to find out the right OutLLDSTypes,
+ % this is OK.
project_solns_to_rval_lists(CaseSolns, [], CaseValues)
),
get_exprn_opts(!.CI, ExprnOpts),
UnboxFloats = get_unboxed_floats(ExprnOpts),
- find_general_llds_types(UnboxFloats, OutTypes, CaseValues, LLDSTypes),
- LookupSwitchInfo = lookup_switch_info(CaseConsts, OutVars, LLDSTypes,
+ find_general_llds_types(UnboxFloats, OutTypes, CaseValues, OutLLDSTypes),
+ LookupSwitchInfo = lookup_switch_info(CaseConsts, OutVars, OutLLDSTypes,
Liveness).
%---------------------------------------------------------------------------%
-:- pred generate_constants_for_lookup_switch(list(tagged_case)::in,
- list(prog_var)::in, set(prog_var)::in, abs_store_map::in,
- set(prog_var)::out,
- map(int, soln_consts(rval))::in, map(int, soln_consts(rval))::out,
+:- pred generate_constants_for_lookup_switch(
+ record_switch_lookup(Key)::in(record_switch_lookup),
+ list(tagged_case)::in, list(prog_var)::in, set(prog_var)::in,
+ abs_store_map::in, set(prog_var)::out,
+ map(Key, soln_consts(rval))::in, map(Key, soln_consts(rval))::out,
branch_end::in, branch_end::out, set(prog_var)::in, set(prog_var)::out,
bool::in, bool::out, code_info::in, code_info::out) is semidet.
-generate_constants_for_lookup_switch([], _Vars, _ArmNonLocals, _StoreMap,
- set.init, !IndexMap,
+generate_constants_for_lookup_switch(_RecordLookupForTaggedConsId,
+ [], _Vars, _ArmNonLocals, _StoreMap, set.init, !IndexMap,
!MaybeEnd, !ResumeVars, !GoalsMayModifyTrail, !CI).
-generate_constants_for_lookup_switch([TaggedCase | TaggedCases], Vars,
- ArmNonLocals, StoreMap, Liveness, !IndexMap, !MaybeEnd, !ResumeVars,
- !GoalsMayModifyTrail, !CI) :-
+generate_constants_for_lookup_switch(RecordLookupForTaggedConsId,
+ [TaggedCase | TaggedCases], Vars, ArmNonLocals, StoreMap, Liveness,
+ !IndexMap, !MaybeEnd, !ResumeVars, !GoalsMayModifyTrail, !CI) :-
TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _, Goal),
Goal = hlds_goal(GoalExpr, GoalInfo),
@@ -227,18 +295,27 @@
!MaybeEnd, Liveness, !CI),
SolnConsts = one_soln(Soln)
),
- record_lookup_for_tagged_cons_id(SolnConsts, TaggedMainConsId, !IndexMap),
- list.foldl(record_lookup_for_tagged_cons_id(SolnConsts),
+ RecordLookupForTaggedConsId(SolnConsts, TaggedMainConsId, !IndexMap),
+ record_lookup_for_tagged_cons_ids(RecordLookupForTaggedConsId, SolnConsts,
TaggedOtherConsIds, !IndexMap),
- generate_constants_for_lookup_switch(TaggedCases, Vars, ArmNonLocals,
- StoreMap, _LivenessRest, !IndexMap, !MaybeEnd, !ResumeVars,
- !GoalsMayModifyTrail, !CI).
+ generate_constants_for_lookup_switch(RecordLookupForTaggedConsId,
+ TaggedCases, Vars, ArmNonLocals, StoreMap, _LivenessRest,
+ !IndexMap, !MaybeEnd, !ResumeVars, !GoalsMayModifyTrail, !CI).
+
+:- pred record_lookup_for_tagged_cons_ids(
+ record_switch_lookup(Key)::in(record_switch_lookup),
+ soln_consts(rval)::in, list(tagged_cons_id)::in,
+ map(Key, soln_consts(rval))::in, map(Key, soln_consts(rval))::out) is det.
+
+record_lookup_for_tagged_cons_ids(_RecordLookupForTaggedConsId, _SolnConsts,
+ [], !IndexMap).
+record_lookup_for_tagged_cons_ids(RecordLookupForTaggedConsId, SolnConsts,
+ [TaggedConsId | TaggedConsIds], !IndexMap) :-
+ RecordLookupForTaggedConsId(SolnConsts, TaggedConsId, !IndexMap),
+ record_lookup_for_tagged_cons_ids(RecordLookupForTaggedConsId, SolnConsts,
+ TaggedConsIds, !IndexMap).
-:- pred record_lookup_for_tagged_cons_id(soln_consts(rval)::in,
- tagged_cons_id::in,
- map(int, soln_consts(rval))::in, map(int, soln_consts(rval))::out) is det.
-
-record_lookup_for_tagged_cons_id(SolnConsts, TaggedConsId, !IndexMap) :-
+record_lookup_for_tagged_cons_id_int(SolnConsts, TaggedConsId, !IndexMap) :-
TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
( ConsTag = int_tag(Index) ->
svmap.det_insert(Index, SolnConsts, !IndexMap)
@@ -246,11 +323,20 @@
unexpected(this_file, "record_lookup_for_tagged_cons_id: not int_tag")
).
+record_lookup_for_tagged_cons_id_string(SolnConsts, TaggedConsId, !IndexMap) :-
+ TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
+ ( ConsTag = string_tag(Index) ->
+ svmap.det_insert(Index, SolnConsts, !IndexMap)
+ ;
+ unexpected(this_file, "record_lookup_for_tagged_cons_id: not int_tag")
+ ).
+
%---------------------------------------------------------------------------%
-generate_lookup_switch(VarRval, StoreMap, MaybeEnd0, LookupSwitchInfo,
- StartVal, EndVal, NeedBitVecCheck, NeedRangeCheck, Code, !CI) :-
- LookupSwitchInfo = lookup_switch_info(CaseConsts, OutVars, LLDSTypes,
+generate_int_lookup_switch(VarRval, LookupSwitchInfo, EndLabel, StoreMap,
+ StartVal, EndVal, NeedBitVecCheck, NeedRangeCheck, !MaybeEnd,
+ Code, !CI) :-
+ LookupSwitchInfo = lookup_switch_info(CaseConsts, OutVars, OutTypes,
Liveness),
% If the case values start at some number other than 0,
@@ -279,15 +365,15 @@
Comment = singleton(
llds_instr(comment("simple lookup switch"), "")
),
- generate_simple_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
- StartVal, EndVal, CaseValues, OutVars, LLDSTypes,
+ generate_simple_int_lookup_switch(IndexRval, StoreMap,
+ StartVal, EndVal, CaseValues, OutVars, OutTypes,
NeedBitVecCheck, Liveness, RestCode, !CI)
;
CaseConsts = some_several_solns(CaseSolns, ResumeVars,
GoalsMayModifyTrail),
- get_emit_trail_ops(!.CI, EmitTrailOps),
(
GoalsMayModifyTrail = yes,
+ get_emit_trail_ops(!.CI, EmitTrailOps),
AddTrailOps = EmitTrailOps
;
GoalsMayModifyTrail = no,
@@ -296,20 +382,19 @@
Comment = singleton(
llds_instr(comment("several soln lookup switch"), "")
),
- generate_several_soln_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
+ generate_several_soln_int_lookup_switch(IndexRval, EndLabel, StoreMap,
StartVal, EndVal, CaseSolns, ResumeVars, AddTrailOps, OutVars,
- LLDSTypes, NeedBitVecCheck, Liveness, RestCode, !CI)
+ OutTypes, NeedBitVecCheck, Liveness, !MaybeEnd, RestCode, !CI)
),
Code = Comment ++ RangeCheckCode ++ RestCode.
-:- pred generate_simple_lookup_switch(rval::in, abs_store_map::in,
- branch_end::in, int::in, int::in, assoc_list(int, list(rval))::in,
+:- pred generate_simple_int_lookup_switch(rval::in, abs_store_map::in,
+ int::in, int::in, assoc_list(int, list(rval))::in,
list(prog_var)::in, list(llds_type)::in, need_bit_vec_check::in,
set(prog_var)::in, llds_code::out, code_info::in, code_info::out) is det.
-generate_simple_lookup_switch(IndexRval, StoreMap, MaybeEnd0, StartVal, EndVal,
- CaseValues, OutVars, LLDSTypes, NeedBitVecCheck, Liveness, Code,
- !CI) :-
+generate_simple_int_lookup_switch(IndexRval, StoreMap, StartVal, EndVal,
+ CaseValues, OutVars, OutTypes, NeedBitVecCheck, Liveness, Code, !CI) :-
(
NeedBitVecCheck = need_bit_vec_check,
generate_bitvec_test(IndexRval, CaseValues, StartVal, EndVal,
@@ -324,6 +409,7 @@
%
% Note that invoking generate_simple_terms when OutVars = [] would lead to
% a compiler abort, since we cannot create C structures with zero fields.
+ % This can happen for semidet switches.
(
OutVars = [],
BaseRegInitCode = empty,
@@ -335,15 +421,40 @@
% BaseReg.
acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
MaybeBaseReg = yes(BaseReg),
- generate_simple_terms(IndexRval, OutVars, LLDSTypes, CaseValues,
- StartVal, BaseReg, BaseRegInitCode, !CI)
+
+ % Generate the static lookup table for this switch.
+ list.length(OutVars, NumOutVars),
+ construct_simple_int_lookup_vector(CaseValues, StartVal, OutTypes,
+ [], RevVectorRvals),
+ list.reverse(RevVectorRvals, VectorRvals),
+ add_vector_static_cell(OutTypes, VectorRvals, VectorAddr, !CI),
+ VectorAddrRval = const(llconst_data_addr(VectorAddr, no)),
+
+ % Generate code to look up each of the variables in OutVars
+ % in its slot in the table row IndexRval (which will be row
+ % VarRval - StartVal). Most of the change is done by
+ % generate_offset_assigns associating each var with the relevant field
+ % in !CI.
+ ( NumOutVars = 1 ->
+ BaseRval = IndexRval
+ ;
+ BaseRval = binop(int_mul,
+ IndexRval, const(llconst_int(NumOutVars)))
+ ),
+ BaseRegInitCode = singleton(
+ llds_instr(
+ assign(BaseReg,
+ mem_addr(heap_ref(VectorAddrRval, 0, BaseRval))),
+ "Compute base address for this case")
+ ),
+ generate_offset_assigns(OutVars, 0, BaseReg, !CI)
),
% We keep track of what variables are supposed to be live at the end
% of cases. We have to do this explicitly because generating a `fail' slot
% last would yield the wrong liveness.
set_forward_live_vars(Liveness, !CI),
- generate_branch_end(StoreMap, MaybeEnd0, _MaybeEnd, BranchEndCode, !CI),
+ generate_branch_end(StoreMap, no, _MaybeEnd, BranchEndCode, !CI),
(
MaybeBaseReg = no
;
@@ -352,84 +463,61 @@
),
Code = CheckBitVecCode ++ BaseRegInitCode ++ BranchEndCode.
- % Add an expression to the expression cache in the code_info structure
- % for each of the output variables of the lookup switch. This is done by
- % creating a static term for the array, and generating an expression
- % for the variable to get the IndexRval'th field of that term.
- %
-:- pred generate_simple_terms(rval::in, list(prog_var)::in,
- list(llds_type)::in, assoc_list(int, list(rval))::in, int::in,
- lval::in, llds_code::out, code_info::in, code_info::out) is det.
-
-generate_simple_terms(IndexRval, OutVars, OutTypes, CaseVals, Start, BaseReg,
- Code, !CI) :-
- list.length(OutVars, NumOutVars),
- construct_simple_vector(Start, OutTypes, CaseVals, VectorRvals),
- add_vector_static_cell(OutTypes, VectorRvals, VectorAddr, !CI),
-
- VectorAddrRval = const(llconst_data_addr(VectorAddr, no)),
- % IndexRval has already had Start subtracted from it.
- ( NumOutVars = 1 ->
- BaseRval = IndexRval
- ;
- BaseRval = binop(int_mul, IndexRval, const(llconst_int(NumOutVars)))
- ),
- Code = singleton(
- llds_instr(
- assign(BaseReg, mem_addr(heap_ref(VectorAddrRval, 0, BaseRval))),
- "Compute base address for this case")
- ),
- generate_offset_assigns(OutVars, 0, BaseReg, !CI).
-
-:- pred construct_simple_vector(int::in, list(llds_type)::in,
- assoc_list(int, list(rval))::in, list(list(rval))::out) is det.
+%-----------------------------------------------------------------------------%
-construct_simple_vector(_, _, [], []).
-construct_simple_vector(CurIndex, LLDSTypes, [Index - Rvals | Rest],
- [Row | Rows]) :-
+:- pred construct_simple_int_lookup_vector(assoc_list(int, list(rval))::in,
+ int::in, list(llds_type)::in,
+ list(list(rval))::in, list(list(rval))::out) is det.
+
+construct_simple_int_lookup_vector([], _, _, !RevRows).
+construct_simple_int_lookup_vector([Index - Rvals | Rest], CurIndex, OutTypes,
+ !RevRows) :-
( CurIndex < Index ->
% If this argument (array element) is a place-holder and
% will never be referenced, just fill it in with a dummy entry.
- Row = list.map(default_value_for_type, LLDSTypes),
+ Row = list.map(default_value_for_type, OutTypes),
Remainder = [Index - Rvals | Rest]
;
Row = Rvals,
Remainder = Rest
),
- construct_simple_vector(CurIndex + 1, LLDSTypes, Remainder, Rows).
+ !:RevRows = [Row | !.RevRows],
+ construct_simple_int_lookup_vector( Remainder, CurIndex + 1, OutTypes,
+ !RevRows).
%-----------------------------------------------------------------------------%
-:- pred generate_several_soln_lookup_switch(rval::in, abs_store_map::in,
- branch_end::in, int::in, int::in, assoc_list(int, soln_consts(rval))::in,
- set(prog_var)::in, add_trail_ops::in, list(prog_var)::in,
- list(llds_type)::in, need_bit_vec_check::in, set(prog_var)::in,
- llds_code::out, code_info::in, code_info::out) is det.
+:- pred generate_several_soln_int_lookup_switch(rval::in, label::in,
+ abs_store_map::in, int::in, int::in,
+ assoc_list(int, soln_consts(rval))::in, set(prog_var)::in,
+ add_trail_ops::in, list(prog_var)::in, list(llds_type)::in,
+ need_bit_vec_check::in, set(prog_var)::in,
+ branch_end::in, branch_end::out, llds_code::out,
+ code_info::in, code_info::out) is det.
-generate_several_soln_lookup_switch(IndexRval, StoreMap, MaybeEnd0,
- StartVal, EndVal, CaseSolns, ResumeVars, AddTrailOps, OutVars,
- LLDSTypes, NeedBitVecCheck, Liveness, Code, !CI) :-
- (
- OutVars = [],
- % If there are no output variables, then how can the individual
- % solutions differ from each other?
- unexpected(this_file,
- "generate_several_soln_lookup_switch: no OutVars")
- ;
- OutVars = [_ | _]
- ),
+generate_several_soln_int_lookup_switch(IndexRval, EndLabel, StoreMap,
+ StartVal, EndVal, CaseSolns, ResumeVars, AddTrailOps,
+ OutVars, OutTypes, NeedBitVecCheck, Liveness, !MaybeEnd, Code, !CI) :-
+ % If there are no output variables, then how can the individual solutions
+ % differ from each other?
+ expect(negate(unify(OutVars, [])), this_file,
+ "generate_several_soln_int_lookup_switch: no OutVars"),
% Now generate the static cells into which we do the lookups of the values
% of the output variables, if there are any.
%
- % We put a dummy row at the start.
- list.length(LLDSTypes, NumLLDSTypes),
- InitRowNumber = 1,
- DummyLaterSolnRow = list.map(default_value_for_type, LLDSTypes),
- construct_several_soln_vector(StartVal, EndVal, InitRowNumber,
- LLDSTypes, NumLLDSTypes, CaseSolns, MainRows,
- [DummyLaterSolnRow], RevLaterSolnArray,
+ % We put a dummy row at the start of the later solns table, so that
+ % a zero in the "later solns start row" column of the main table can mean
+ % "no later solutions".
+ list.length(OutTypes, NumOutTypes),
+ InitLaterSolnRowNumber = 1,
+ DummyLaterSolnRow = list.map(default_value_for_type, OutTypes),
+ LaterSolnArrayCord0 = singleton(DummyLaterSolnRow),
+ construct_several_soln_int_lookup_vector(StartVal, EndVal,
+ OutTypes, NumOutTypes, CaseSolns, MainRows,
+ InitLaterSolnRowNumber, LaterSolnArrayCord0, LaterSolnArrayCord,
0, FailCaseCount, 0, OneSolnCaseCount, 0, SeveralSolnCaseCount),
+ LaterSolnArray = cord.list(LaterSolnArrayCord),
(
(
NeedBitVecCheck = need_bit_vec_check
@@ -440,64 +528,66 @@
true
;
unexpected(this_file,
- "generate_several_soln_lookup_switch: bad FailCaseCount")
+ "generate_several_soln_int_lookup_switch: bad FailCaseCount")
),
- list.reverse(RevLaterSolnArray, LaterSolnArray),
- MainRowTypes = [lt_integer, lt_integer | LLDSTypes],
- list.length(MainRowTypes, MainRowWidth),
+ MainRowTypes = [lt_integer, lt_integer | OutTypes],
+ list.length(MainRowTypes, MainNumColumns),
add_vector_static_cell(MainRowTypes, MainRows, MainVectorAddr, !CI),
MainVectorAddrRval = const(llconst_data_addr(MainVectorAddr, no)),
- add_vector_static_cell(LLDSTypes, LaterSolnArray, LaterVectorAddr, !CI),
+ add_vector_static_cell(OutTypes, LaterSolnArray, LaterVectorAddr, !CI),
LaterVectorAddrRval = const(llconst_data_addr(LaterVectorAddr, no)),
+ list.sort([FailCaseCount - kind_zero_solns,
+ OneSolnCaseCount - kind_one_soln,
+ SeveralSolnCaseCount - kind_several_solns], AscendingSortedCountKinds),
+ list.reverse(AscendingSortedCountKinds, DescendingSortedCountKinds),
+ assoc_list.values(DescendingSortedCountKinds, DescendingSortedKinds),
+
% Since we release BaseReg only after the calls to generate_branch_end,
% we must make sure that generate_branch_end won't want to overwrite
% BaseReg.
- %
- % We release BaseReg in each arm of generate_code_for_each_kind below.
- % We cannot release it at the bottom of this predicate, because in the
- % kind_several_solns arm of generate_code_for_each_kind the generation
- % of the resume point will clobber the set of acquired registers.
- %
- % We cannot release the stack slots anywhere, since they will be needed
- % after backtracking to later alternatives of any model_non switch arm.
acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
- acquire_temp_slot(slot_lookup_switch_cur,
- non_persistent_temp_slot, CurSlot, !CI),
- acquire_temp_slot(slot_lookup_switch_max,
- non_persistent_temp_slot, MaxSlot, !CI),
% IndexRval has already had Start subtracted from it.
- BaseRval = binop(int_mul, IndexRval, const(llconst_int(MainRowWidth))),
BaseRegInitCode = singleton(
llds_instr(
assign(BaseReg,
- mem_addr(heap_ref(MainVectorAddrRval, 0, BaseRval))),
+ mem_addr(heap_ref(MainVectorAddrRval, 0,
+ binop(int_mul,
+ IndexRval,
+ const(llconst_int(MainNumColumns)))))),
"Compute base address for this case")
),
- list.sort([FailCaseCount - kind_zero_solns,
- OneSolnCaseCount - kind_one_soln,
- SeveralSolnCaseCount - kind_several_solns], AscendingSortedKinds),
- list.reverse(AscendingSortedKinds, DescendingSortedKinds),
-
- get_next_label(EndLabel, !CI),
- remember_position(!.CI, BranchStart),
- generate_code_for_each_kind(DescendingSortedKinds, BaseReg,
- CurSlot, MaxSlot, LaterVectorAddrRval, EndLabel, BranchStart,
- ResumeVars, AddTrailOps, OutVars, StoreMap, MaybeEnd0, Liveness,
- KindsCode, !CI),
-
- set_resume_point_to_unknown(!CI),
+ generate_code_for_all_kinds(DescendingSortedKinds, 0, OutVars, ResumeVars,
+ EndLabel, StoreMap, Liveness, AddTrailOps,
+ BaseReg, LaterVectorAddrRval, !MaybeEnd, KindsCode, !CI),
EndLabelCode = singleton(
- llds_instr(label(EndLabel), "end of several_soln lookup switch")
+ llds_instr(label(EndLabel),
+ "end of int several soln lookup switch")
),
Code = BaseRegInitCode ++ KindsCode ++ EndLabelCode.
-:- type case_kind
- ---> kind_zero_solns
- ; kind_one_soln
- ; kind_several_solns.
+generate_code_for_all_kinds(Kinds, NumPrevColumns, OutVars, ResumeVars,
+ EndLabel, StoreMap, Liveness, AddTrailOps,
+ BaseReg, LaterVectorAddrRval, !MaybeEnd, Code, !CI) :-
+ % We release BaseReg in each arm of generate_code_for_each_kind below.
+ % We cannot release it at the bottom of this predicate, because in the
+ % kind_several_solns arm of generate_code_for_each_kind the generation
+ % of the resume point will clobber the set of acquired registers.
+ %
+ % We cannot release the stack slots anywhere, since they will be needed
+ % after backtracking to later alternatives of any model_non switch arm.
+ acquire_temp_slot(slot_lookup_switch_cur, non_persistent_temp_slot,
+ CurSlot, !CI),
+ acquire_temp_slot(slot_lookup_switch_max, non_persistent_temp_slot,
+ MaxSlot, !CI),
+
+ remember_position(!.CI, BranchStart),
+ generate_code_for_each_kind(Kinds, NumPrevColumns,OutVars, ResumeVars,
+ BranchStart, EndLabel, StoreMap, Liveness, AddTrailOps, BaseReg,
+ CurSlot, MaxSlot, LaterVectorAddrRval, !MaybeEnd, Code, !CI),
+ set_resume_point_to_unknown(!CI).
:- func case_kind_to_string(case_kind) = string.
@@ -505,17 +595,20 @@
case_kind_to_string(kind_one_soln) = "kind_one_soln".
case_kind_to_string(kind_several_solns) = "kind_several_solns".
-:- pred generate_code_for_each_kind(assoc_list(int, case_kind)::in,
- lval::in, lval::in, lval::in, rval::in, label::in, position_info::in,
- set(prog_var)::in, add_trail_ops::in, list(prog_var)::in,
- abs_store_map::in, branch_end::in, set(prog_var)::in, llds_code::out,
+:- pred generate_code_for_each_kind(list(case_kind)::in, int::in,
+ list(prog_var)::in, set(prog_var)::in, position_info::in,
+ label::in, abs_store_map::in, set(prog_var)::in, add_trail_ops::in,
+ lval::in, lval::in, lval::in, rval::in,
+ branch_end::in, branch_end::out, llds_code::out,
code_info::in, code_info::out) is det.
-generate_code_for_each_kind([], _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+generate_code_for_each_kind([], _, _, _, _, _, _, _, _, _, _, _, _,
+ !MaybeEnd, _, !CI) :-
unexpected(this_file, "generate_code_for_each_kind: no kinds").
-generate_code_for_each_kind([_ - Kind | Kinds], BaseReg, CurSlot, MaxSlot,
- LaterVectorAddrRval, EndLabel, BranchStart, ResumeVars, AddTrailOps,
- OutVars, StoreMap, MaybeEnd0, Liveness, Code, !CI) :-
+generate_code_for_each_kind([Kind | Kinds], NumPrevColumns,
+ OutVars, ResumeVars, BranchStart, EndLabel, StoreMap, Liveness,
+ AddTrailOps, BaseReg, CurSlot, MaxSlot, LaterVectorAddrRval,
+ !MaybeEnd, Code, !CI) :-
(
Kind = kind_zero_solns,
TestOp = int_ge,
@@ -526,8 +619,8 @@
Kind = kind_one_soln,
TestOp = ne,
reset_to_position(BranchStart, !CI),
- generate_offset_assigns(OutVars, 2, BaseReg, !CI),
- set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness,
+ generate_offset_assigns(OutVars, NumPrevColumns + 2, BaseReg, !CI),
+ set_liveness_and_end_branch(StoreMap, Liveness, !MaybeEnd,
BranchEndCode, !CI),
release_reg(BaseReg, !CI),
GotoEndCode = singleton(
@@ -545,16 +638,17 @@
% specialized for the situation here.
produce_vars(ResumeVars, ResumeMap, FlushCode, !CI),
+ MinOffsetColumnRval = const(llconst_int(NumPrevColumns)),
+ MaxOffsetColumnRval = const(llconst_int(NumPrevColumns + 1)),
SaveSlotsCode = from_list([
llds_instr(assign(CurSlot,
- lval(field(yes(0), lval(BaseReg), const(llconst_int(0))))),
+ lval(field(yes(0), lval(BaseReg), MinOffsetColumnRval))),
"Setup current slot in the later solution array"),
llds_instr(assign(MaxSlot,
- lval(field(yes(0), lval(BaseReg), const(llconst_int(1))))),
+ lval(field(yes(0), lval(BaseReg), MaxOffsetColumnRval))),
"Setup maximum slot in the later solution array")
]),
- maybe_save_ticket(AddTrailOps, SaveTicketCode,
- MaybeTicketSlot, !CI),
+ maybe_save_ticket(AddTrailOps, SaveTicketCode, MaybeTicketSlot, !CI),
globals.lookup_bool_option(Globals, reclaim_heap_on_nondet_failure,
ReclaimHeap),
maybe_save_hp(ReclaimHeap, SaveHpCode, MaybeHpSlot, !CI),
@@ -567,7 +661,7 @@
make_resume_point(ResumeVars, resume_locs_stack_only,
ResumeMap, ResumePoint, !CI),
effect_resume_point(ResumePoint, model_non, UpdateRedoipCode, !CI),
- generate_offset_assigns(OutVars, 2, BaseReg, !CI),
+ generate_offset_assigns(OutVars, NumPrevColumns + 2, BaseReg, !CI),
flush_resume_vars_to_stack(FirstFlushResumeVarsCode, !CI),
% Forget the variables that are needed only at the resumption point at
@@ -578,7 +672,7 @@
pickup_zombies(FirstZombies, !CI),
make_vars_forward_dead(FirstZombies, !CI),
- set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness,
+ set_liveness_and_end_branch(StoreMap, Liveness, !MaybeEnd,
FirstBranchEndCode, !CI),
release_reg(BaseReg, !CI),
@@ -640,7 +734,7 @@
pickup_zombies(LaterZombies, !CI),
make_vars_forward_dead(LaterZombies, !CI),
- set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness,
+ set_liveness_and_end_branch(StoreMap, Liveness, !MaybeEnd,
LaterBranchEndCode, !CI),
KindCode = FlushCode ++ SaveSlotsCode ++
@@ -655,10 +749,11 @@
Kinds = [],
Code = KindCode
;
- Kinds = [_ - NextKind | _],
+ Kinds = [NextKind | _],
get_next_label(NextKindLabel, !CI),
TestRval = binop(TestOp,
- lval(field(yes(0), lval(BaseReg), const(llconst_int(0)))),
+ lval(field(yes(0), lval(BaseReg),
+ const(llconst_int(NumPrevColumns)))),
const(llconst_int(0))),
TestCode = from_list([
llds_instr(if_val(TestRval, code_label(NextKindLabel)),
@@ -666,10 +761,6 @@
llds_instr(comment("This kind is " ++ case_kind_to_string(Kind)),
"")
]),
- generate_code_for_each_kind(Kinds, BaseReg, CurSlot, MaxSlot,
- LaterVectorAddrRval, EndLabel, BranchStart, ResumeVars,
- AddTrailOps, OutVars, StoreMap, MaybeEnd0, Liveness,
- LaterKindsCode, !CI),
NextKindLabelCode = from_list([
llds_instr(label(NextKindLabel),
"next kind in several_soln lookup switch"),
@@ -677,76 +768,81 @@
++ case_kind_to_string(NextKind)),
"")
]),
+ generate_code_for_each_kind(Kinds, NumPrevColumns, OutVars, ResumeVars,
+ BranchStart, EndLabel, StoreMap, Liveness, AddTrailOps,
+ BaseReg, CurSlot, MaxSlot, LaterVectorAddrRval,
+ !MaybeEnd, LaterKindsCode, !CI),
Code = TestCode ++ KindCode ++ NextKindLabelCode ++ LaterKindsCode
).
% Note that we specify --optimise-constructor-last-call for this module
% in order to make this predicate tail recursive.
%
-:- pred construct_several_soln_vector(int::in, int::in, int::in,
+:- pred construct_several_soln_int_lookup_vector(int::in, int::in,
list(llds_type)::in, int::in, assoc_list(int, soln_consts(rval))::in,
list(list(rval))::out,
- list(list(rval))::in, list(list(rval))::out,
+ int::in, cord(list(rval))::in, cord(list(rval))::out,
int::in, int::out, int::in, int::out, int::in, int::out) is det.
-construct_several_soln_vector(CurIndex, EndVal, !.LaterNextRow, LLDSTypes,
- NumLLDSTypes, [], MainRows, !RevLaterSolnArray,
+construct_several_soln_int_lookup_vector(CurIndex, EndVal,
+ OutTypes, NumOutTypes, [], MainRows,
+ !.LaterNextRow, !LaterSolnArray,
!FailCaseCount, !OneSolnCaseCount, !SeveralSolnCaseCount) :-
( CurIndex > EndVal ->
MainRows = []
;
- construct_fail_row(LLDSTypes, MainRow, !FailCaseCount),
- construct_several_soln_vector(CurIndex + 1, EndVal, !.LaterNextRow,
- LLDSTypes, NumLLDSTypes, [], MoreMainRows, !RevLaterSolnArray,
+ construct_fail_row(OutTypes, MainRow, !FailCaseCount),
+ construct_several_soln_int_lookup_vector(CurIndex + 1, EndVal,
+ OutTypes, NumOutTypes, [], MoreMainRows,
+ !.LaterNextRow, !LaterSolnArray,
!FailCaseCount, !OneSolnCaseCount, !SeveralSolnCaseCount),
MainRows = [MainRow | MoreMainRows]
).
-construct_several_soln_vector(CurIndex, EndVal, !.LaterNextRow, LLDSTypes,
- NumLLDSTypes, [Index - Soln | Rest], [MainRow | MainRows],
- !RevLaterSolnArray,
+construct_several_soln_int_lookup_vector(CurIndex, EndVal,
+ OutTypes, NumOutTypes, [Index - Soln | Rest], [MainRow | MainRows],
+ !.LaterNextRow, !LaterSolnArray,
!FailCaseCount, !OneSolnCaseCount, !SeveralSolnCaseCount) :-
( CurIndex < Index ->
- construct_fail_row(LLDSTypes, MainRow, !FailCaseCount),
+ construct_fail_row(OutTypes, MainRow, !FailCaseCount),
Remainder = [Index - Soln | Rest]
;
(
- Soln = one_soln(Rvals),
+ Soln = one_soln(OutRvals),
!:OneSolnCaseCount = !.OneSolnCaseCount + 1,
+ ZeroRval = const(llconst_int(0)),
% The first 0 means there is exactly one solution for this case;
% the second 0 is a dummy that won't be referenced.
- ControlRvals = [const(llconst_int(0)), const(llconst_int(0))],
- MainRow = ControlRvals ++ Rvals
+ MainRow = [ZeroRval, ZeroRval | OutRvals]
;
- Soln = several_solns(FirstSoln, LaterSolns),
+ Soln = several_solns(FirstSolnRvals, LaterSolns),
!:SeveralSolnCaseCount = !.SeveralSolnCaseCount + 1,
list.length(LaterSolns, NumLaterSolns),
- FirstRowOffset = !.LaterNextRow * NumLLDSTypes,
- LastRowOffset = (!.LaterNextRow + NumLaterSolns - 1)
- * NumLLDSTypes,
- ControlRvals = [const(llconst_int(FirstRowOffset)),
- const(llconst_int(LastRowOffset))],
- MainRow = ControlRvals ++ FirstSoln,
- list.reverse(LaterSolns, RevLaterSolns),
- !:RevLaterSolnArray = RevLaterSolns ++ !.RevLaterSolnArray,
- !:LaterNextRow = !.LaterNextRow + NumLaterSolns
+ FirstRowOffset = !.LaterNextRow * NumOutTypes,
+ LastRowOffset = (!.LaterNextRow + NumLaterSolns - 1) * NumOutTypes,
+ FirstRowRval = const(llconst_int(FirstRowOffset)),
+ LastRowRval = const(llconst_int(LastRowOffset)),
+ MainRow = [FirstRowRval, LastRowRval | FirstSolnRvals],
+ !:LaterNextRow = !.LaterNextRow + NumLaterSolns,
+ !:LaterSolnArray = !.LaterSolnArray ++ from_list(LaterSolns)
),
Remainder = Rest
),
- construct_several_soln_vector(CurIndex + 1, EndVal, !.LaterNextRow,
- LLDSTypes, NumLLDSTypes, Remainder, MainRows, !RevLaterSolnArray,
+ construct_several_soln_int_lookup_vector(CurIndex + 1, EndVal,
+ OutTypes, NumOutTypes, Remainder, MainRows,
+ !.LaterNextRow, !LaterSolnArray,
!FailCaseCount, !OneSolnCaseCount, !SeveralSolnCaseCount).
:- pred construct_fail_row(list(llds_type)::in, list(rval)::out,
int::in, int::out) is det.
-construct_fail_row(LLDSTypes, MainRow, !FailCaseCount) :-
+construct_fail_row(OutTypes, MainRow, !FailCaseCount) :-
% The -1 means no solutions for this case; the 0 is a dummy that
% won't be referenced.
ControlRvals = [const(llconst_int(-1)), const(llconst_int(0))],
% Since this argument (array element) is a place-holder and will never be
% referenced, just fill it in with a dummy entry.
- VarRvals = list.map(default_value_for_type, LLDSTypes),
+ VarRvals = list.map(default_value_for_type, OutTypes),
MainRow = ControlRvals ++ VarRvals,
!:FailCaseCount = !.FailCaseCount + 1.
@@ -841,8 +937,6 @@
%-----------------------------------------------------------------------------%
-:- func default_value_for_type(llds_type) = rval.
-
default_value_for_type(lt_bool) = const(llconst_int(0)).
default_value_for_type(lt_int_least8) = const(llconst_int(0)).
default_value_for_type(lt_uint_least8) = const(llconst_int(0)).
Index: compiler/lookup_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_util.m,v
retrieving revision 1.12
diff -u -b -r1.12 lookup_util.m
--- compiler/lookup_util.m 2 Oct 2009 03:55:28 -0000 1.12
+++ compiler/lookup_util.m 1 Nov 2010 02:37:19 -0000
@@ -61,8 +61,15 @@
list(prog_var)::in, abs_store_map::in, list(list(rval))::out,
branch_end::in, branch_end::out, code_info::in, code_info::out) is semidet.
-:- pred set_liveness_and_end_branch(abs_store_map::in, branch_end::in,
- set(prog_var)::in, llds_code::out, code_info::in, code_info::out) is det.
+ % set_liveness_and_end_branch(StoreMap, Liveness, !MaybeEnd, Code, !CI):
+ %
+ % Set the liveness to Liveness, move all the variables listed in StoreMap
+ % to their indicated locations, and end the current branch, updating
+ % !MaybeEnd in the process.
+ %
+:- pred set_liveness_and_end_branch(abs_store_map::in, set(prog_var)::in,
+ branch_end::in, branch_end::out, llds_code::out,
+ code_info::in, code_info::out) is det.
:- pred generate_offset_assigns(list(prog_var)::in, int::in, lval::in,
code_info::in, code_info::out) is det.
@@ -192,13 +199,18 @@
%---------------------------------------------------------------------------%
-set_liveness_and_end_branch(StoreMap, MaybeEnd0, Liveness, BranchEndCode,
+set_liveness_and_end_branch(StoreMap, Liveness, !MaybeEnd, BranchEndCode,
!CI) :-
% We keep track of what variables are supposed to be live at the end
% of cases. We have to do this explicitly because generating a `fail' slot
- % last would yield the wrong liveness.
+ % last would yield the wrong liveness. Also, by killing the variables
+ % that are not live anymore, we avoid generating code that moves their
+ % values aside.
+ get_forward_live_vars(!.CI, OldLiveness),
set_forward_live_vars(Liveness, !CI),
- generate_branch_end(StoreMap, MaybeEnd0, _MaybeEnd, BranchEndCode, !CI).
+ set.difference(OldLiveness, Liveness, DeadVars),
+ maybe_make_vars_forward_dead(DeadVars, no, !CI),
+ generate_branch_end(StoreMap, !MaybeEnd, BranchEndCode, !CI).
generate_offset_assigns([], _, _, !CI).
generate_offset_assigns([Var | Vars], Offset, BaseReg, !CI) :-
Index: compiler/ml_lookup_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_lookup_switch.m,v
retrieving revision 1.4
diff -u -b -r1.4 ml_lookup_switch.m
--- compiler/ml_lookup_switch.m 12 Oct 2009 01:34:13 -0000 1.4
+++ compiler/ml_lookup_switch.m 11 Oct 2010 02:10:53 -0000
@@ -89,8 +89,7 @@
),
map.to_assoc_list(CaseSolnMap, CaseSolns),
- ( project_all_to_one_solution(CaseSolns, [], RevCaseValuePairs) ->
- list.reverse(RevCaseValuePairs, CaseValuePairs),
+ ( project_all_to_one_solution(CaseSolns, CaseValuePairs) ->
ml_gen_simple_lookup_switch(IndexRval, OutVars, CaseValuePairs,
CodeModel, Context, StartVal, EndVal,
NeedBitVecCheck, NeedRangeCheck, Statement, !Info)
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.44
diff -u -b -r1.44 ml_string_switch.m
--- compiler/ml_string_switch.m 2 Oct 2009 03:55:28 -0000 1.44
+++ compiler/ml_string_switch.m 31 Oct 2010 12:23:13 -0000
@@ -105,11 +105,9 @@
HashMask = TableSize - 1,
% Compute the hash table.
- string_hash_cases(Cases, HashMask,
+ construct_string_hash_jump_cases(Cases, TableSize, HashMask,
gen_tagged_case_code_for_string_switch(CodeModel),
- map.init, CodeMap, unit, _, !Info, HashValsMap),
- map.to_assoc_list(HashValsMap, HashValsList),
- calc_string_hash_slots(HashValsList, HashValsMap, HashSlotsMap),
+ map.init, CodeMap, unit, _, !Info, HashSlotsMap),
% Generate the code for when the hash lookup fails.
(
@@ -326,7 +324,7 @@
ml_gen_string_hash_slot(Slot, StructType, HashSlotMap, RowInitializer,
!RevMap) :-
- ( map.search(HashSlotMap, Slot, string_hash_slot(Next, String, CaseNum)) ->
+ ( map.search(HashSlotMap, Slot, string_hash_slot(String, Next, CaseNum)) ->
StringRval = ml_const(mlconst_string(String)),
NextSlotRval = ml_const(mlconst_int(Next)),
( map.search(!.RevMap, CaseNum, OldEntry) ->
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.50
diff -u -b -r1.50 ml_switch_gen.m
--- compiler/ml_switch_gen.m 12 Oct 2010 05:04:27 -0000 1.50
+++ compiler/ml_switch_gen.m 13 Oct 2010 03:57:40 -0000
@@ -165,7 +165,8 @@
(
SwitchCategory = string_switch,
num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms),
- globals.lookup_int_option(Globals, string_switch_size, StringSize),
+ globals.lookup_int_option(Globals, string_hash_switch_size,
+ StringSize),
(
NumConsIds >= StringSize,
NumArms > 1,
@@ -231,10 +232,13 @@
NumArms > 1,
globals.lookup_int_option(Globals, lookup_switch_req_density,
ReqDensity),
- find_lookup_switch_params(ModuleInfo, SwitchVarType, CodeModel,
- CanFail, TaggedCases, FilteredTaggedCases,
- LowerLimit, UpperLimit, NumValues, ReqDensity,
- NeedBitVecCheck, NeedRangeCheck, FirstVal, LastVal),
+ filter_out_failing_cases_if_needed(CodeModel,
+ TaggedCases, FilteredTaggedCases,
+ CanFail, FilteredCanFail),
+ find_int_lookup_switch_params(ModuleInfo, SwitchVarType,
+ FilteredCanFail, LowerLimit, UpperLimit, NumValues,
+ ReqDensity, NeedBitVecCheck, NeedRangeCheck,
+ FirstVal, LastVal),
NonLocals = goal_info_get_nonlocals(GoalInfo),
ml_gen_lookup_switch(SwitchVar, FilteredTaggedCases,
NonLocals, CodeModel, Context, FirstVal, LastVal,
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.152
diff -u -b -r1.152 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 23 Sep 2010 05:31:57 -0000 1.152
+++ compiler/mlds_to_gcc.m 2 Oct 2010 16:28:09 -0000
@@ -3544,6 +3544,8 @@
convert_binary_op(str_gt, _, _) :- unexpected(this_file, "str_gt").
convert_binary_op(str_le, _, _) :- unexpected(this_file, "str_le").
convert_binary_op(str_ge, _, _) :- unexpected(this_file, "str_ge").
+convert_binary_op(str_cmp, _, _) :-
+ unexpected(this_file, "str_cmp").
convert_binary_op(int_lt, gcc.lt_expr, gcc.boolean_type_node).
convert_binary_op(int_gt, gcc.gt_expr, gcc.boolean_type_node).
convert_binary_op(int_le, gcc.le_expr, gcc.boolean_type_node).
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.216
diff -u -b -r1.216 mlds_to_il.m
--- compiler/mlds_to_il.m 23 Sep 2010 05:31:57 -0000 1.216
+++ compiler/mlds_to_il.m 2 Oct 2010 16:26:18 -0000
@@ -2762,6 +2762,8 @@
ldc(int32, i(-1)),
cgt(signed)
]), !Info).
+binaryop_to_il(str_cmp, _, !Info) :-
+ unexpected(this_file, "binop: str_cmp").
% Integer comparison
binaryop_to_il(int_lt, singleton(clt(signed)), !Info).
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.214
diff -u -b -r1.214 opt_debug.m
--- compiler/opt_debug.m 4 Nov 2009 03:44:49 -0000 1.214
+++ compiler/opt_debug.m 31 Oct 2010 13:41:00 -0000
@@ -337,11 +337,12 @@
; N2 = binop(_, _, _)
)
->
- "binop(" ++ dump_binop(O) ++ ", "
- ++ dump_rval(MaybeProcLabel, N1) ++ ", " ++
- dump_rval(MaybeProcLabel, N2) ++ ")"
+ "(" ++ dump_rval(MaybeProcLabel, N1) ++ ")" ++
+ " " ++ dump_binop(O) ++ " " ++
+ "(" ++ dump_rval(MaybeProcLabel, N2) ++ ")"
;
- dump_rval(MaybeProcLabel, N1) ++ " " ++ dump_binop(O) ++ " " ++
+ dump_rval(MaybeProcLabel, N1) ++
+ " " ++ dump_binop(O) ++ " " ++
dump_rval(MaybeProcLabel, N2)
).
dump_rval(MaybeProcLabel, mem_addr(M)) =
@@ -630,8 +631,46 @@
dump_unop(hash_string) = "hash_string".
dump_unop(bitwise_complement) = "bitwise_complement".
-dump_binop(Op) = OpStr :-
- c_util.binop_category_string(Op, _Category, OpStr).
+dump_binop(array_index(_)) = "array_index".
+dump_binop(compound_lt) = "compound<".
+dump_binop(compound_eq) = "compound=".
+dump_binop(str_eq) = "str==".
+dump_binop(str_ne) = "str!=".
+dump_binop(str_le) = "str<=".
+dump_binop(str_ge) = "str>=".
+dump_binop(str_lt) = "str<".
+dump_binop(str_gt) = "str>".
+dump_binop(unsigned_le) = "unsigned<=".
+dump_binop(float_plus) = "fl+".
+dump_binop(float_minus) = "fl-".
+dump_binop(float_times) = "fl*".
+dump_binop(float_divide) = "fl/".
+dump_binop(float_eq) = "fl==".
+dump_binop(float_ne) = "fl!=".
+dump_binop(float_le) = "fl<=".
+dump_binop(float_ge) = "fl>=".
+dump_binop(float_lt) = "fl<".
+dump_binop(float_gt) = "fl>".
+dump_binop(int_add) = "+".
+dump_binop(int_sub) = "-".
+dump_binop(int_mul) = "*".
+dump_binop(int_div) = "/".
+dump_binop(unchecked_left_shift) = "unchecked<<".
+dump_binop(unchecked_right_shift) = "unchecked>>".
+dump_binop(bitwise_and) = "&".
+dump_binop(bitwise_or) = "|".
+dump_binop(bitwise_xor) = "^".
+dump_binop(int_mod) = "%".
+dump_binop(eq) = "==".
+dump_binop(ne) = "!=".
+dump_binop(logical_and) = "&&".
+dump_binop(logical_or) = "||".
+dump_binop(int_lt) = "<".
+dump_binop(int_gt) = ">".
+dump_binop(int_le) = "<=".
+dump_binop(int_ge) = ">=".
+dump_binop(str_cmp) = "strcmp".
+dump_binop(body) = "body".
dump_maybe_rvals(_, [], _) = "".
dump_maybe_rvals(MaybeProcLabel, [MR | MRs], N) = Str :-
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.679
diff -u -b -r1.679 options.m
--- compiler/options.m 7 Oct 2010 23:38:43 -0000 1.679
+++ compiler/options.m 11 Oct 2010 01:04:36 -0000
@@ -720,7 +720,8 @@
; lookup_switch_req_density
; dense_switch_size
; lookup_switch_size
- ; string_switch_size
+ ; string_hash_switch_size
+ ; string_binary_switch_size
; tag_switch_size
; try_switch_size
; binary_switch_size
@@ -1560,7 +1561,8 @@
% a lookup switch.
dense_switch_size - int(4),
lookup_switch_size - int(4),
- string_switch_size - int(8),
+ string_hash_switch_size - int(8),
+ string_binary_switch_size - int(4),
tag_switch_size - int(3),
try_switch_size - int(3),
binary_switch_size - int(4),
@@ -2457,7 +2459,9 @@
long_option("lookup-switch-req-density",lookup_switch_req_density).
long_option("dense-switch-size", dense_switch_size).
long_option("lookup-switch-size", lookup_switch_size).
-long_option("string-switch-size", string_switch_size).
+long_option("string-switch-size", string_hash_switch_size).
+long_option("string-hash-switch-size", string_hash_switch_size).
+long_option("string-binary-switch-size", string_binary_switch_size).
long_option("tag-switch-size", tag_switch_size).
long_option("try-switch-size", try_switch_size).
long_option("binary-switch-size", binary_switch_size).
@@ -5020,9 +5024,12 @@
"--lookup-switch-size <n>",
"\tThe lookup table generated for an atomic switch",
"\tmust have at least this many entries (default: 4).",
- "--string-switch-size <n>",
+ "--string-hash-switch-size <n>",
"\tThe hash table generated for a string switch",
"\tmust have at least this many entries (default: 8).",
+ "--string-binary-switch-size <n>",
+ "\tThe binary search table generated for a string switch",
+ "\tmust have at least this many entries (default: 4).",
"--tag-switch-size <n>",
"\tThe number of alternatives in a tag switch",
"\tmust be at least this number (default: 3).",
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.38
diff -u -b -r1.38 proc_gen.m
--- compiler/proc_gen.m 10 Sep 2010 05:14:59 -0000 1.38
+++ compiler/proc_gen.m 1 Nov 2010 02:46:06 -0000
@@ -642,7 +642,8 @@
(
MaybeTailRecInfo = yes(_TailRecLval - TailRecLabel),
TailRecLabelCode = singleton(
- llds_instr(label(TailRecLabel), "tail recursion label")
+ llds_instr(label(TailRecLabel),
+ "tail recursion label, nofulljump")
)
;
MaybeTailRecInfo = no,
@@ -1198,7 +1199,6 @@
list(instruction)::out) is det.
bytecode_stub(ModuleInfo, PredId, ProcId, BytecodeInstructions) :-
-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
ModuleSymName = pred_info_module(PredInfo),
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.66
diff -u -b -r1.66 string_switch.m
--- compiler/string_switch.m 21 Sep 2009 04:08:59 -0000 1.66
+++ compiler/string_switch.m 31 Oct 2010 13:47:37 -0000
@@ -9,8 +9,28 @@
% File: string_switch.m.
% Author: fjh.
%
-% For switches on strings, we generate a hash table using open addressing
-% to resolve hash conflicts.
+% For switches on strings, we can generate either
+% - a hash table using open addressing to resolve hash conflicts, or
+% - a sorted table for binary search.
+%
+% The hash table has a higher startup cost, but should use fewer comparisons,
+% so it is preferred for bigger tables.
+%
+% When the switch arms are general code, what we put into the hash table
+% or binary search table for each case is the offset of the relevant arm
+% in a computed_goto. The generated code would be faster (due to better
+% locality) if we included the actual target address instead. Unfortunately,
+% that would require two extensions to the LLDS. The first and relatively
+% easy change would be a new LLDS instruction that represents a goto
+% to an arbitrary rval (in this case, the rval taken from the selected
+% table row). The second and substantially harder change would be making
+% the internal labels of the switch arms actually storable in static data.
+% We do not currently have any way to refer to internal labels from data,
+% and optimizations that manipulate labels (such as frameopt, which can
+% duplicate them, and dupelim, which can replace them with other labels)
+% would have to be taught to reflect any changes they make in the global
+% data. It is the last step that is the killer in the terms of difficulty
+% of implementation.
%
%-----------------------------------------------------------------------------%
@@ -19,14 +39,29 @@
:- import_module hlds.code_model.
:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_llds.
:- import_module ll_backend.code_info.
:- import_module ll_backend.llds.
+:- import_module ll_backend.lookup_switch.
:- import_module parse_tree.prog_data.
:- import_module list.
-:- pred generate_string_switch(list(tagged_case)::in, rval::in, string::in,
- code_model::in, can_fail::in, hlds_goal_info::in, label::in,
+:- pred generate_string_hash_switch(list(tagged_case)::in, rval::in,
+ string::in, code_model::in, can_fail::in, hlds_goal_info::in, label::in,
+ branch_end::out, llds_code::out, code_info::in, code_info::out) is det.
+
+:- pred generate_string_hash_lookup_switch(rval::in,
+ lookup_switch_info(string)::in, can_fail::in, label::in, abs_store_map::in,
+ branch_end::in, branch_end::out, llds_code::out,
+ code_info::in, code_info::out) is det.
+
+:- pred generate_string_binary_switch(list(tagged_case)::in, rval::in,
+ string::in, code_model::in, can_fail::in, hlds_goal_info::in, label::in,
+ branch_end::out, llds_code::out, code_info::in, code_info::out) is det.
+
+:- pred generate_string_binary_lookup_switch(rval::in,
+ lookup_switch_info(string)::in, can_fail::in, label::in, abs_store_map::in,
branch_end::in, branch_end::out, llds_code::out,
code_info::in, code_info::out) is det.
@@ -42,71 +77,74 @@
:- import_module hlds.hlds_llds.
:- import_module libs.compiler_util.
:- import_module ll_backend.code_gen.
+:- import_module ll_backend.lookup_util.
:- import_module ll_backend.switch_case.
:- import_module ll_backend.trace_gen.
+:- import_module assoc_list.
+:- import_module bool.
:- import_module cord.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module pair.
+:- import_module set.
+:- import_module std_util.
:- import_module string.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
-generate_string_switch(Cases, VarRval, VarName, CodeModel, _CanFail,
- SwitchGoalInfo, EndLabel, !MaybeEnd, Code, !CI) :-
- % We get the registers we use as working storage in the hash table lookup
- % code now, before we generate the code of the switch arms, since the set
- % of free registers will in general be different before and after that
- % action. However, it is safe to release them immediately, even though
- % we haven't yet generated all the code which uses them, because that
- % code will *only* be executed before the code for the cases, and because
- % that code is generated manually below. Releasing the registers early
- % allows the code of the cases to make use of them.
-
- acquire_reg(reg_r, SlotReg, !CI),
- acquire_reg(reg_r, RowReg, !CI),
- acquire_reg(reg_r, StringReg, !CI),
- release_reg(SlotReg, !CI),
- release_reg(RowReg, !CI),
- release_reg(StringReg, !CI),
-
- get_next_label(LoopLabel, !CI),
- get_next_label(FailLabel, !CI),
- get_next_label(JumpLabel, !CI),
+generate_string_hash_switch(Cases, VarRval, VarName, CodeModel, CanFail,
+ SwitchGoalInfo, EndLabel, MaybeEnd, Code, !CI) :-
+ init_string_hash_switch_info(CanFail, HashSwitchInfo, !CI),
+ BranchStart = HashSwitchInfo ^ shsi_branch_start,
+ Params = represent_params(VarName, SwitchGoalInfo, CodeModel, BranchStart,
+ EndLabel),
+ CommentCode = singleton(
+ llds_instr(comment("string hash jump switch"), "")
+ ),
% 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.
+ NumColumns = 2,
list.length(Cases, NumCases),
int.log2(NumCases, LogNumCases),
int.pow(2, LogNumCases, RoundedNumCases),
TableSize = 2 * RoundedNumCases,
HashMask = TableSize - 1,
- remember_position(!.CI, BranchStart),
- Params = represent_params(VarName, SwitchGoalInfo, CodeModel, BranchStart,
- EndLabel),
-
% Compute the hash table.
map.init(CaseLabelMap0),
- switch_util.string_hash_cases(Cases, HashMask,
+ construct_string_hash_jump_cases(Cases, TableSize, HashMask,
represent_tagged_case_for_llds(Params),
- CaseLabelMap0, CaseLabelMap, !MaybeEnd, !CI, HashValsMap),
- map.to_assoc_list(HashValsMap, HashValsList),
- switch_util.calc_string_hash_slots(HashValsList, HashValsMap,
- HashSlotsMap),
-
- % We must generate the failure code in the context in which none of the
- % switch arms have been executed yet.
- reset_to_position(BranchStart, !CI),
- generate_failure(FailCode, !CI),
+ CaseLabelMap0, CaseLabelMap, no, MaybeEnd, !CI, HashSlotsMap),
% Generate the data structures for the hash table.
- gen_string_hash_slots(0, TableSize, HashSlotsMap, FailLabel,
- TableRows, Targets),
+ FailLabel = HashSwitchInfo ^ shsi_fail_label,
+ construct_string_hash_jump_vectors(0, TableSize, HashSlotsMap, FailLabel,
+ [], RevTableRows, [], RevTargets),
+ list.reverse(RevTableRows, TableRows),
+ list.reverse(RevTargets, Targets),
+
+ % Generate the code for the hash table lookup.
+ RowElemTypes = [lt_string, lt_integer],
+ add_vector_static_cell(RowElemTypes, TableRows, TableAddr, !CI),
+ ArrayElemTypes = [scalar_elem_string, scalar_elem_int],
+ ArrayElemType = array_elem_struct(ArrayElemTypes),
+ TableAddrRval = const(llconst_data_addr(TableAddr, no)),
+
+ SlotReg = HashSwitchInfo ^ shsi_slot_reg,
+ MatchCode = from_list([
+ % See the comment at the top about why we use a computed_goto here.
+ llds_instr(computed_goto(lval(SlotReg), Targets),
+ "jump to the corresponding code")
+ ]),
+
+ generate_string_hash_switch_search(HashSwitchInfo, VarRval, TableAddrRval,
+ ArrayElemType, HashMask, NumColumns, MatchCode, HashLookupCode),
% Generate the code for the cases.
map.foldl(add_remaining_case, CaseLabelMap, empty, CasesCode),
@@ -114,108 +152,908 @@
llds_instr(label(EndLabel), "end of hashed string switch")
),
- % Generate the code for the hash table lookup.
- RowElemTypes = [lt_string, lt_integer],
- add_vector_static_cell(RowElemTypes, TableRows, TableAddr, !CI),
- ArrayElemTypes = [scalar_elem_string, scalar_elem_int],
+ Code = CommentCode ++ HashLookupCode ++ CasesCode ++ EndLabelCode.
+
+:- pred construct_string_hash_jump_vectors(int::in, int::in,
+ map(int, string_hash_slot(label))::in, label::in,
+ list(list(rval))::in, list(list(rval))::out,
+ list(maybe(label))::in, list(maybe(label))::out) is det.
+
+construct_string_hash_jump_vectors(Slot, TableSize, HashSlotMap, FailLabel,
+ !RevTableRows, !RevMaybeTargets) :-
+ ( Slot = TableSize ->
+ true
+ ;
+ ( map.search(HashSlotMap, Slot, SlotInfo) ->
+ SlotInfo = string_hash_slot(String, Next, CaseLabel),
+ NextSlotRval = const(llconst_int(Next)),
+ StringRval = const(llconst_string(String)),
+ Target = CaseLabel
+ ;
+ StringRval = const(llconst_int(0)),
+ NextSlotRval = const(llconst_int(-2)),
+ Target = FailLabel
+ ),
+ TableRow = [StringRval, NextSlotRval],
+ !:RevTableRows = [TableRow | !.RevTableRows],
+ !:RevMaybeTargets = [yes(Target) | !.RevMaybeTargets],
+ construct_string_hash_jump_vectors(Slot + 1, TableSize, HashSlotMap,
+ FailLabel, !RevTableRows, !RevMaybeTargets)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+generate_string_hash_lookup_switch(VarRval, LookupSwitchInfo,
+ CanFail, EndLabel, StoreMap, !MaybeEnd, Code, !CI) :-
+ LookupSwitchInfo = lookup_switch_info(CaseConsts, OutVars, OutTypes,
+ Liveness),
+ (
+ CaseConsts = all_one_soln(CaseValues),
+ generate_string_hash_simple_lookup_switch(VarRval, CaseValues,
+ OutVars, OutTypes, Liveness, CanFail, EndLabel, StoreMap,
+ !MaybeEnd, Code, !CI)
+ ;
+ CaseConsts = some_several_solns(CaseSolns, ResumeVars,
+ GoalsMayModifyTrail),
+ generate_string_hash_several_soln_lookup_switch(VarRval, CaseSolns,
+ ResumeVars, GoalsMayModifyTrail, OutVars, OutTypes, Liveness,
+ CanFail, EndLabel, StoreMap, !MaybeEnd, Code, !CI)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred generate_string_hash_simple_lookup_switch(rval::in,
+ assoc_list(string, list(rval))::in, list(prog_var)::in,
+ list(llds_type)::in, set(prog_var)::in,
+ can_fail::in, label::in, abs_store_map::in,
+ branch_end::in, branch_end::out, llds_code::out,
+ code_info::in, code_info::out) is det.
+
+generate_string_hash_simple_lookup_switch(VarRval, CaseValues,
+ OutVars, OutTypes, Liveness, CanFail, EndLabel, StoreMap,
+ !MaybeEnd, Code, !CI) :-
+ % This predicate, generate_string_hash_several_soln_lookup_switch,
+ % and generate_string_hash_lookup_switch do similar tasks using
+ % similar code, so if you need to update one, you probably need to
+ % update them all.
+
+ init_string_hash_switch_info(CanFail, HashSwitchInfo, !CI),
+ CommentCode = singleton(
+ llds_instr(comment("string hash simple lookup switch"), "")
+ ),
+
+ list.length(CaseValues, NumCases),
+ int.log2(NumCases, LogNumCases),
+ int.pow(2, LogNumCases, RoundedNumCases),
+ TableSize = 2 * RoundedNumCases,
+ HashMask = TableSize - 1,
+
+ list.length(OutVars, NumOutVars),
+ NumColumns = 2 + NumOutVars,
+ % For the LLDS backend, array indexing ops don't need the element
+ % types, so it is ok to lie here.
+ list.duplicate(NumOutVars, scalar_elem_generic, OutElemTypes),
+ ArrayElemTypes = [scalar_elem_string, scalar_elem_int | OutElemTypes],
ArrayElemType = array_elem_struct(ArrayElemTypes),
- TableAddrRval = const(llconst_data_addr(TableAddr, no)),
- HashLookupCode = from_list([
- llds_instr(comment("hashed string switch"), ""),
+
+ % Compute the hash table.
+ construct_string_hash_lookup_cases(CaseValues, TableSize, HashMask,
+ HashSlotsMap),
+
+ % Generate the static lookup table for this switch.
+ DummyOutRvals = list.map(default_value_for_type, OutTypes),
+ construct_string_hash_simple_lookup_vector(0, TableSize, HashSlotsMap,
+ DummyOutRvals, [], RevVectorRvals),
+ list.reverse(RevVectorRvals, VectorRvals),
+ RowElemTypes = [lt_string, lt_integer | OutTypes],
+ add_vector_static_cell(RowElemTypes, VectorRvals, VectorAddr, !CI),
+ VectorAddrRval = const(llconst_data_addr(VectorAddr, no)),
+
+ (
+ OutVars = [],
+ SetBaseRegCode = empty,
+ MaybeBaseReg = no
+ ;
+ OutVars = [_ | _],
+ % Since we release BaseReg only after the call to
+ % generate_branch_end, we must make sure that generate_branch_end
+ % won't want to overwrite BaseReg.
+ acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ MaybeBaseReg = yes(BaseReg),
+
+ % Generate code to look up each of the variables in OutVars
+ % in its slot in the table row RowStartReg. Most of the change is done
+ % by generate_offset_assigns associating each var with the relevant
+ % field in !CI.
+ RowStartReg = HashSwitchInfo ^ shsi_row_start_reg,
+ SetBaseRegCode = singleton(
+ llds_instr(assign(BaseReg,
+ mem_addr(heap_ref(VectorAddrRval, 0, lval(RowStartReg)))),
+ "set up base reg")
+ ),
+ generate_offset_assigns(OutVars, 2, BaseReg, !CI)
+ ),
+
+ % We keep track of what variables are supposed to be live at the end
+ % of cases. We have to do this explicitly because generating a `fail'
+ % slot last would yield the wrong liveness.
+ set_forward_live_vars(Liveness, !CI),
+ generate_branch_end(StoreMap, !MaybeEnd, BranchEndCode, !CI),
+ (
+ MaybeBaseReg = no
+ ;
+ MaybeBaseReg = yes(FinalBaseReg),
+ release_reg(FinalBaseReg, !CI)
+ ),
+
+ GotoEndLabelCode = singleton(
+ llds_instr(goto(code_label(EndLabel)),
+ "go to end of simple hash string lookup switch")
+ ),
+ MatchCode = SetBaseRegCode ++ BranchEndCode ++ GotoEndLabelCode,
+ generate_string_hash_switch_search(HashSwitchInfo,
+ VarRval, VectorAddrRval, ArrayElemType, HashMask, NumColumns,
+ MatchCode, HashSearchCode),
+
+ EndLabelCode = singleton(
+ llds_instr(label(EndLabel),
+ "end of simple hash string lookup switch")
+ ),
+
+ Code = CommentCode ++ HashSearchCode ++ EndLabelCode.
+
+:- pred construct_string_hash_simple_lookup_vector(int::in, int::in,
+ map(int, string_hash_slot(list(rval)))::in, list(rval)::in,
+ list(list(rval))::in, list(list(rval))::out) is det.
+
+construct_string_hash_simple_lookup_vector(Slot, TableSize, HashSlotMap,
+ DummyOutRvals, !RevRows) :-
+ ( Slot = TableSize ->
+ true
+ ;
+ ( map.search(HashSlotMap, Slot, SlotInfo) ->
+ SlotInfo = string_hash_slot(String, Next, OutVarRvals),
+ NextSlotRval = const(llconst_int(Next)),
+ StringRval = const(llconst_string(String))
+ ;
+ StringRval = const(llconst_int(0)),
+ NextSlotRval = const(llconst_int(-2)),
+ OutVarRvals = DummyOutRvals
+ ),
+ Row = [StringRval, NextSlotRval | OutVarRvals],
+ !:RevRows = [Row | !.RevRows],
+ construct_string_hash_simple_lookup_vector(Slot + 1, TableSize,
+ HashSlotMap, DummyOutRvals, !RevRows)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred generate_string_hash_several_soln_lookup_switch(rval::in,
+ assoc_list(string, soln_consts(rval))::in, set(prog_var)::in, bool::in,
+ list(prog_var)::in, list(llds_type)::in, set(prog_var)::in,
+ can_fail::in, label::in, abs_store_map::in,
+ branch_end::in, branch_end::out, llds_code::out,
+ code_info::in, code_info::out) is det.
+
+generate_string_hash_several_soln_lookup_switch(VarRval, CaseSolns,
+ ResumeVars, GoalsMayModifyTrail, OutVars, OutTypes, Liveness,
+ CanFail, EndLabel, StoreMap, !MaybeEnd, Code, !CI) :-
+ % This predicate, generate_string_hash_simple_lookup_switch,
+ % and generate_string_hash_lookup_switch do similar tasks using
+ % similar code, so if you need to update one, you probably need to
+ % update them all.
+
+ init_string_hash_switch_info(CanFail, HashSwitchInfo, !CI),
+ CommentCode = singleton(
+ llds_instr(comment("string hash several soln lookup switch"), "")
+ ),
+
+ list.length(CaseSolns, NumCases),
+ int.log2(NumCases, LogNumCases),
+ int.pow(2, LogNumCases, RoundedNumCases),
+ TableSize = 2 * RoundedNumCases,
+ HashMask = TableSize - 1,
+
+ list.length(OutVars, NumOutVars),
+ NumColumns = 4 + NumOutVars,
+ % For the LLDS backend, array indexing ops don't need the element
+ % types, so it is ok to lie here.
+ list.duplicate(NumOutVars, scalar_elem_generic, OutElemTypes),
+ ArrayElemTypes = [scalar_elem_string, scalar_elem_int,
+ scalar_elem_int, scalar_elem_int | OutElemTypes],
+ ArrayElemType = array_elem_struct(ArrayElemTypes),
+
+ % If there are no output variables, then how can the individual solutions
+ % differ from each other?
+ expect(negate(unify(OutVars, [])), this_file,
+ "generate_string_hash_several_soln_lookup_switch: no OutVars"),
+ (
+ GoalsMayModifyTrail = yes,
+ get_emit_trail_ops(!.CI, EmitTrailOps),
+ AddTrailOps = EmitTrailOps
+ ;
+ GoalsMayModifyTrail = no,
+ AddTrailOps = do_not_add_trail_ops
+ ),
+
+ % Compute the hash table.
+ construct_string_hash_lookup_cases(CaseSolns, TableSize, HashMask,
+ HashSlotsMap),
+
+ % Generate the static lookup table for this switch.
+ InitLaterSolnRowNumber = 1,
+ DummyOutRvals = list.map(default_value_for_type, OutTypes),
+ LaterSolnArrayCord0 = singleton(DummyOutRvals),
+ construct_string_hash_several_soln_lookup_vector(0, TableSize,
+ HashSlotsMap, DummyOutRvals, NumOutVars, [], RevMainRows,
+ InitLaterSolnRowNumber, LaterSolnArrayCord0, LaterSolnArrayCord,
+ 0, OneSolnCaseCount, 0, SeveralSolnsCaseCount),
+ list.reverse(RevMainRows, MainRows),
+ LaterSolnArray = cord.list(LaterSolnArrayCord),
+
+ list.sort([OneSolnCaseCount - kind_one_soln,
+ SeveralSolnsCaseCount - kind_several_solns],
+ AscendingSortedCountKinds),
+ list.reverse(AscendingSortedCountKinds, DescendingSortedCountKinds),
+ assoc_list.values(DescendingSortedCountKinds, DescendingSortedKinds),
+
+ MainRowTypes = [lt_string, lt_integer, lt_integer, lt_integer | OutTypes],
+ add_vector_static_cell(MainRowTypes, MainRows, MainVectorAddr, !CI),
+ MainVectorAddrRval = const(llconst_data_addr(MainVectorAddr, no)),
+ add_vector_static_cell(OutTypes, LaterSolnArray, LaterVectorAddr, !CI),
+ LaterVectorAddrRval = const(llconst_data_addr(LaterVectorAddr, no)),
+
+ % Since we release BaseReg only after the calls to generate_branch_end,
+ % we must make sure that generate_branch_end won't want to overwrite
+ % BaseReg.
+ acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+
+ % Generate code to look up each of the variables in OutVars
+ % in its slot in the table row RowStartReg. Most of the change is done
+ % by generate_offset_assigns associating each var with the relevant
+ % field in !CI.
+ RowStartReg = HashSwitchInfo ^ shsi_row_start_reg,
+ SetBaseRegCode = singleton(
+ llds_instr(assign(BaseReg,
+ mem_addr(heap_ref(MainVectorAddrRval, 0, lval(RowStartReg)))),
+ "set up base reg")
+ ),
+ generate_code_for_all_kinds(DescendingSortedKinds, 2, OutVars, ResumeVars,
+ EndLabel, StoreMap, Liveness, AddTrailOps,
+ BaseReg, LaterVectorAddrRval, !MaybeEnd, LookupResultsCode, !CI),
+ MatchCode = SetBaseRegCode ++ LookupResultsCode,
+
+ generate_string_hash_switch_search(HashSwitchInfo,
+ VarRval, MainVectorAddrRval, ArrayElemType, HashMask, NumColumns,
+ MatchCode, HashSearchCode),
+ EndLabelCode = singleton(
+ llds_instr(label(EndLabel),
+ "end of simple hash string lookup switch")
+ ),
+ Code = CommentCode ++ HashSearchCode ++ EndLabelCode.
+
+:- pred construct_string_hash_several_soln_lookup_vector(int::in, int::in,
+ map(int, string_hash_slot(soln_consts(rval)))::in, list(rval)::in, int::in,
+ list(list(rval))::in, list(list(rval))::out,
+ int::in, cord(list(rval))::in, cord(list(rval))::out,
+ int::in, int::out, int::in, int::out) is det.
+
+construct_string_hash_several_soln_lookup_vector(Slot, TableSize, HashSlotMap,
+ DummyOutRvals, NumOutVars,
+ !RevMainRows, !.LaterNextRow, !LaterSolnArray,
+ !OneSolnCaseCount, !SeveralSolnsCaseCount) :-
+ ( Slot = TableSize ->
+ true
+ ;
+ ( map.search(HashSlotMap, Slot, SlotInfo) ->
+ SlotInfo = string_hash_slot(String, Next, Soln),
+ StringRval = const(llconst_string(String)),
+ NextSlotRval = const(llconst_int(Next)),
+ (
+ Soln = one_soln(OutVarRvals),
+ !:OneSolnCaseCount = !.OneSolnCaseCount + 1,
+ ZeroRval = const(llconst_int(0)),
+ MainRow = [StringRval, NextSlotRval, ZeroRval, ZeroRval
+ | OutVarRvals]
+ ;
+ Soln = several_solns(FirstSolnRvals, LaterSolns),
+ !:SeveralSolnsCaseCount = !.SeveralSolnsCaseCount + 1,
+ list.length(LaterSolns, NumLaterSolns),
+ FirstRowOffset = !.LaterNextRow * NumOutVars,
+ LastRowOffset = (!.LaterNextRow + NumLaterSolns - 1)
+ * NumOutVars,
+ FirstRowRval = const(llconst_int(FirstRowOffset)),
+ LastRowRval = const(llconst_int(LastRowOffset)),
+ MainRow = [StringRval, NextSlotRval, FirstRowRval, LastRowRval
+ | FirstSolnRvals],
+ !:LaterNextRow = !.LaterNextRow + NumLaterSolns,
+ !:LaterSolnArray = !.LaterSolnArray ++ from_list(LaterSolns)
+ )
+ ;
+ StringRval = const(llconst_int(0)),
+ NextSlotRval = const(llconst_int(-2)),
+ ZeroRval = const(llconst_int(0)),
+ % The first ZeroRval means there is exactly one solution for
+ % this case; the second ZeroRval is a dummy that won't be
+ % referenced.
+ MainRow = [StringRval, NextSlotRval, ZeroRval, ZeroRval
+ | DummyOutRvals]
+ ),
+ !:RevMainRows = [MainRow | !.RevMainRows],
+ construct_string_hash_several_soln_lookup_vector(Slot + 1, TableSize,
+ HashSlotMap, DummyOutRvals, NumOutVars,
+ !RevMainRows, !.LaterNextRow, !LaterSolnArray,
+ !OneSolnCaseCount, !SeveralSolnsCaseCount)
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- type string_hash_switch_info
+ ---> string_hash_switch_info(
+ shsi_slot_reg :: lval,
+ shsi_row_start_reg :: lval,
+ shsi_string_reg :: lval,
+
+ shsi_loop_start_label :: label,
+ shsi_no_match_label :: label,
+ shsi_fail_label :: label,
+
+ shsi_branch_start :: position_info,
+ shsi_fail_code :: llds_code
+ ).
+
+:- pred init_string_hash_switch_info(can_fail::in,
+ string_hash_switch_info::out, code_info::in, code_info::out) is det.
+
+init_string_hash_switch_info(CanFail, Info, !CI) :-
+ % We get the registers we use as working storage in the hash table lookup
+ % code now, before we generate the code of the switch arms, since the set
+ % of free registers will in general be different before and after that
+ % action. However, it is safe to release them immediately, even though
+ % we haven't yet generated all the code which uses them, because that
+ % code will *only* be executed before the code for the cases, and because
+ % that code is generated manually below. Releasing the registers early
+ % allows the code of the cases to make use of them.
+
+ acquire_reg(reg_r, SlotReg, !CI),
+ acquire_reg(reg_r, RowStartReg, !CI),
+ acquire_reg(reg_r, StringReg, !CI),
+ release_reg(SlotReg, !CI),
+ release_reg(RowStartReg, !CI),
+ release_reg(StringReg, !CI),
+
+ get_next_label(LoopStartLabel, !CI),
+ get_next_label(FailLabel, !CI),
+ get_next_label(NoMatchLabel, !CI),
+
+ % We must generate the failure code in the context in which
+ % none of the switch arms have been executed yet.
+ remember_position(!.CI, BranchStart),
+ generate_string_switch_fail(CanFail, FailCode, !CI),
+ reset_to_position(BranchStart, !CI),
+
+ Info = string_hash_switch_info(SlotReg, RowStartReg, StringReg,
+ LoopStartLabel, NoMatchLabel, FailLabel, BranchStart, FailCode).
+
+:- pred generate_string_hash_switch_search(string_hash_switch_info::in,
+ rval::in, rval::in, array_elem_type::in, int::in, int::in,
+ llds_code::in, llds_code::out) is det.
+
+generate_string_hash_switch_search(Info, VarRval, TableAddrRval,
+ ArrayElemType, HashMask, NumColumns, MatchCode, Code) :-
+ SlotReg = Info ^ shsi_slot_reg,
+ RowStartReg = Info ^ shsi_row_start_reg,
+ StringReg = Info ^ shsi_string_reg,
+ LoopStartLabel = Info ^ shsi_loop_start_label,
+ NoMatchLabel = Info ^ shsi_no_match_label,
+ FailLabel = Info ^ shsi_fail_label,
+ FailCode = Info ^ shsi_fail_code,
+
+ Code = from_list([
llds_instr(assign(SlotReg,
binop(bitwise_and, unop(hash_string, VarRval),
const(llconst_int(HashMask)))),
"compute the hash value of the input string"),
- llds_instr(label(LoopLabel), "begin hash chain loop"),
- llds_instr(assign(RowReg,
- binop(int_mul, lval(SlotReg), const(llconst_int(2)))),
+ llds_instr(label(LoopStartLabel),
+ "begin hash chain loop, nofulljump"),
+ llds_instr(assign(RowStartReg,
+ binop(int_mul, lval(SlotReg), const(llconst_int(NumColumns)))),
"find the start of the row"),
llds_instr(assign(StringReg,
- binop(array_index(ArrayElemType),
- TableAddrRval, lval(RowReg))),
+ binop(array_index(ArrayElemType), TableAddrRval,
+ lval(RowStartReg))),
"lookup the string for this hash slot"),
- llds_instr(if_val(binop(logical_and, lval(StringReg),
- binop(str_eq, lval(StringReg), VarRval)),
- code_label(JumpLabel)),
- "did we find a match?"),
+ llds_instr(if_val(
+ binop(logical_or,
+ binop(eq, lval(StringReg), const(llconst_int(0))),
+ binop(str_ne, lval(StringReg), VarRval)),
+ code_label(NoMatchLabel)),
+ "did we find a match? nofulljump")
+ ]) ++ MatchCode ++ from_list([
+ llds_instr(label(NoMatchLabel),
+ "no match yet, nofulljump"),
llds_instr(assign(SlotReg,
- binop(array_index(ArrayElemType),
- TableAddrRval,
- binop(int_add, lval(RowReg), const(llconst_int(1))))),
- "not yet, so get next slot in hash chain"),
+ binop(array_index(ArrayElemType), TableAddrRval,
+ binop(int_add, lval(RowStartReg), const(llconst_int(1))))),
+ "get next slot in hash chain"),
llds_instr(
if_val(binop(int_ge, lval(SlotReg), const(llconst_int(0))),
- code_label(LoopLabel)),
- "keep searching until we reach the end of the chain"),
- llds_instr(label(FailLabel), "no match, so fail")
- ]),
+ code_label(LoopStartLabel)),
+ "if we have not yet reached the end of the chain, keep searching"),
+ llds_instr(label(FailLabel),
+ "handle the failure of the table search")
+ ]) ++ FailCode.
- % XXX The generated code would be faster (due to better locality)
- % if we included the target addresses in the main table. Unfortunately,
- % that would require two extensions to the LLDS. The first and relatively
- % easy change would be a new LLDS instruction that represents a goto
- % to an arbitrary rval (in this case, the rval taken from the selected
- % table row). The second and substantially harder change would be making
- % the internal labels of the switch arms actually storable in static data.
- % We do not currently have any way to refer to internal labels from data,
- % and optimizations that manipulate labels (such as frameopt, which can
- % duplicate them, and dupelim, which can replace them with other labels)
- % would have to be taught to reflect any changes they make in the global
- % data. It is the last step that is the killer in the terms of difficulty
- % of implementation.
- JumpCode = from_list([
- llds_instr(label(JumpLabel), "we found a match"),
- llds_instr(computed_goto(lval(SlotReg), Targets),
- "jump to the corresponding code")
- ]),
- Code = HashLookupCode ++ FailCode ++ JumpCode ++ CasesCode ++
- EndLabelCode.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
-:- pred gen_string_hash_slots(int::in, int::in,
- map(int, string_hash_slot(label))::in, label::in,
- list(list(rval))::out, list(maybe(label))::out) is det.
+generate_string_binary_switch(Cases, VarRval, VarName, CodeModel, CanFail,
+ SwitchGoalInfo, EndLabel, MaybeEnd, Code, !CI) :-
+ init_string_binary_switch_info(CanFail, BinarySwitchInfo, !CI),
+ BranchStart = BinarySwitchInfo ^ sbsi_branch_start,
+ Params = represent_params(VarName, SwitchGoalInfo, CodeModel, BranchStart,
+ EndLabel),
+ CommentCode = singleton(
+ llds_instr(comment("string binary jump switch"), "")
+ ),
-gen_string_hash_slots(Slot, TableSize, HashSlotMap, FailLabel,
- TableRows, MaybeTargets) :-
- ( Slot = TableSize ->
- TableRows = [],
- MaybeTargets = []
+ % Compute and generate the binary search table.
+ map.init(CaseLabelMap0),
+ switch_util.string_binary_cases(Cases,
+ represent_tagged_case_for_llds(Params),
+ CaseLabelMap0, CaseLabelMap, no, MaybeEnd, !CI, SortedTable),
+
+ gen_string_binary_jump_slots(SortedTable, [], RevTableRows, [], RevTargets,
+ 0, TableSize),
+ list.reverse(RevTableRows, TableRows),
+ list.reverse(RevTargets, Targets),
+ NumColumns = 2,
+ RowElemTypes = [lt_string, lt_integer],
+ add_vector_static_cell(RowElemTypes, TableRows, TableAddr, !CI),
+ ArrayElemTypes = [scalar_elem_string, scalar_elem_int],
+ ArrayElemType = array_elem_struct(ArrayElemTypes),
+ TableAddrRval = const(llconst_data_addr(TableAddr, no)),
+
+ generate_string_binary_switch_search(BinarySwitchInfo,
+ VarRval, TableAddrRval, ArrayElemType, TableSize, NumColumns,
+ BinarySearchCode),
+
+ MidReg = BinarySwitchInfo ^ sbsi_mid_reg,
+ % See the comment at the top about why we use a computed_goto here.
+ ComputedGotoCode = singleton(
+ llds_instr(computed_goto(
+ binop(array_index(ArrayElemType),
+ TableAddrRval,
+ binop(int_add,
+ binop(int_mul,
+ lval(MidReg),
+ const(llconst_int(NumColumns))),
+ const(llconst_int(1)))),
+ Targets),
+ "jump to the matching case")
+ ),
+
+ % Generate the code for the cases.
+ map.foldl(add_remaining_case, CaseLabelMap, empty, CasesCode),
+ EndLabelCode = singleton(
+ llds_instr(label(EndLabel), "end of binary string switch")
+ ),
+
+ Code = CommentCode ++ BinarySearchCode ++ ComputedGotoCode ++
+ CasesCode ++ EndLabelCode.
+
+:- pred gen_string_binary_jump_slots(assoc_list(string, label)::in,
+ list(list(rval))::in, list(list(rval))::out,
+ list(maybe(label))::in, list(maybe(label))::out,
+ int::in, int::out) is det.
+
+gen_string_binary_jump_slots([], !RevTableRows, !RevTargets, !CurIndex).
+gen_string_binary_jump_slots([Str - Label | StrLabels],
+ !RevTableRows, !RevTargets, !CurIndex) :-
+ Row = [const(llconst_string(Str)), const(llconst_int(!.CurIndex))],
+ !:RevTableRows = [Row | !.RevTableRows],
+ !:RevTargets = [yes(Label) | !.RevTargets],
+ !:CurIndex = !.CurIndex + 1,
+ gen_string_binary_jump_slots(StrLabels,
+ !RevTableRows, !RevTargets, !CurIndex).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+generate_string_binary_lookup_switch(VarRval, LookupSwitchInfo,
+ CanFail, EndLabel, StoreMap, !MaybeEnd, Code, !CI) :-
+ LookupSwitchInfo = lookup_switch_info(CaseConsts, OutVars, OutTypes,
+ Liveness),
+ (
+ CaseConsts = all_one_soln(CaseValues),
+ generate_string_binary_simple_lookup_switch(VarRval, CaseValues,
+ OutVars, OutTypes, Liveness, CanFail, EndLabel, StoreMap,
+ !MaybeEnd, Code, !CI)
;
- gen_string_hash_slot(Slot, HashSlotMap, FailLabel,
- StringRval, NextSlotRval, Target),
- gen_string_hash_slots(Slot + 1, TableSize, HashSlotMap, FailLabel,
- TailTableRows, TailMaybeTargets),
- HeadTableRow = [StringRval, NextSlotRval],
- TableRows = [HeadTableRow | TailTableRows],
- MaybeTargets = [yes(Target) | TailMaybeTargets]
+ CaseConsts = some_several_solns(CaseSolns, ResumeVars,
+ GoalsMayModifyTrail),
+ generate_string_binary_several_soln_lookup_switch(VarRval, CaseSolns,
+ ResumeVars, GoalsMayModifyTrail, OutVars, OutTypes, Liveness,
+ CanFail, EndLabel, StoreMap, !MaybeEnd, Code, !CI)
).
-:- pred gen_string_hash_slot(int::in, map(int, string_hash_slot(label))::in,
- label::in, rval::out, rval::out, label::out) is det.
+%-----------------------------------------------------------------------------%
-gen_string_hash_slot(Slot, HashSlotMap, FailLabel,
- StringRval, NextSlotRval, Target) :-
- ( map.search(HashSlotMap, Slot, SlotInfo) ->
- SlotInfo = string_hash_slot(Next, String, CaseLabel),
- NextSlotRval = const(llconst_int(Next)),
- StringRval = const(llconst_string(String)),
- Target = CaseLabel
+:- pred generate_string_binary_simple_lookup_switch(rval::in,
+ assoc_list(string, list(rval))::in, list(prog_var)::in,
+ list(llds_type)::in, set(prog_var)::in,
+ can_fail::in, label::in, abs_store_map::in,
+ branch_end::in, branch_end::out, llds_code::out,
+ code_info::in, code_info::out) is det.
+
+generate_string_binary_simple_lookup_switch(VarRval, CaseValues,
+ OutVars, OutTypes, Liveness, CanFail, EndLabel, StoreMap,
+ !MaybeEnd, Code, !CI) :-
+ % This predicate, generate_string_binary_several_soln_lookup_switch,
+ % and generate_string_binary_lookup_switch do similar tasks using
+ % similar code, so if you need to update one, you probably need to
+ % update them all.
+
+ init_string_binary_switch_info(CanFail, BinarySwitchInfo, !CI),
+ CommentCode = singleton(
+ llds_instr(comment("string binary simple lookup switch"), "")
+ ),
+
+ list.length(CaseValues, TableSize),
+ list.length(OutVars, NumOutVars),
+ NumColumns = 1 + NumOutVars,
+ % For the LLDS backend, array indexing ops don't need the element
+ % types, so it is ok to lie here.
+ list.duplicate(NumOutVars, scalar_elem_generic, OutElemTypes),
+ ArrayElemTypes = [scalar_elem_string | OutElemTypes],
+ ArrayElemType = array_elem_struct(ArrayElemTypes),
+
+ % Generate the static lookup table for this switch.
+ construct_string_binary_simple_lookup_vector(CaseValues,
+ [], RevVectorRvals),
+ list.reverse(RevVectorRvals, VectorRvals),
+ RowElemTypes = [lt_string | OutTypes],
+ add_vector_static_cell(RowElemTypes, VectorRvals, VectorAddr, !CI),
+ VectorAddrRval = const(llconst_data_addr(VectorAddr, no)),
+
+ (
+ OutVars = [],
+ SetBaseRegCode = empty,
+ MaybeBaseReg = no
;
- StringRval = const(llconst_int(0)),
- NextSlotRval = const(llconst_int(-2)),
- Target = FailLabel
+ OutVars = [_ | _],
+ % Since we release BaseReg only after the call to
+ % generate_branch_end, we must make sure that generate_branch_end
+ % won't want to overwrite BaseReg.
+ acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ MaybeBaseReg = yes(BaseReg),
+
+ % Generate code to look up each of the variables in OutVars
+ % in its slot in the table row MidReg. Most of the change is done
+ % by generate_offset_assigns associating each var with the relevant
+ % field in !CI.
+ MidReg = BinarySwitchInfo ^ sbsi_mid_reg,
+ SetBaseRegCode = singleton(
+ llds_instr(
+ assign(BaseReg,
+ mem_addr(
+ heap_ref(VectorAddrRval, 0,
+ binop(int_mul,
+ lval(MidReg),
+ const(llconst_int(NumColumns)))))),
+ "set up base reg")
+ ),
+ generate_offset_assigns(OutVars, 1, BaseReg, !CI)
+ ),
+
+ generate_string_binary_switch_search(BinarySwitchInfo,
+ VarRval, VectorAddrRval, ArrayElemType, TableSize, NumColumns,
+ BinarySearchCode),
+
+ % We keep track of what variables are supposed to be live at the end
+ % of cases. We have to do this explicitly because generating a `fail'
+ % slot last would yield the wrong liveness.
+ set_forward_live_vars(Liveness, !CI),
+ generate_branch_end(StoreMap, no, _MaybeEnd, BranchEndCode, !CI),
+ (
+ MaybeBaseReg = no
+ ;
+ MaybeBaseReg = yes(FinalBaseReg),
+ release_reg(FinalBaseReg, !CI)
+ ),
+
+ EndLabelCode = singleton(
+ llds_instr(label(EndLabel), "end of binary string switch")
+ ),
+
+ Code = CommentCode ++ BinarySearchCode ++ SetBaseRegCode ++
+ BranchEndCode ++ EndLabelCode.
+
+:- pred construct_string_binary_simple_lookup_vector(
+ assoc_list(string, list(rval))::in,
+ list(list(rval))::in, list(list(rval))::out) is det.
+
+construct_string_binary_simple_lookup_vector([], !RevRows).
+construct_string_binary_simple_lookup_vector([Str - OutRvals | Rest],
+ !RevRows) :-
+ RowRvals = [const(llconst_string(Str)) | OutRvals],
+ !:RevRows = [RowRvals | !.RevRows],
+ construct_string_binary_simple_lookup_vector(Rest, !RevRows).
+
+%-----------------------------------------------------------------------------%
+
+:- pred generate_string_binary_several_soln_lookup_switch(rval::in,
+ assoc_list(string, soln_consts(rval))::in, set(prog_var)::in, bool::in,
+ list(prog_var)::in, list(llds_type)::in, set(prog_var)::in,
+ can_fail::in, label::in, abs_store_map::in,
+ branch_end::in, branch_end::out, llds_code::out,
+ code_info::in, code_info::out) is det.
+
+generate_string_binary_several_soln_lookup_switch(VarRval, CaseSolns,
+ ResumeVars, GoalsMayModifyTrail, OutVars, OutTypes, Liveness,
+ CanFail, EndLabel, StoreMap, !MaybeEnd, Code, !CI) :-
+ % This predicate, generate_string_binary_simple_lookup_switch,
+ % and generate_string_binary_lookup_switch do similar tasks using
+ % similar code, so if you need to update one, you probably need to
+ % update them all.
+
+ init_string_binary_switch_info(CanFail, BinarySwitchInfo, !CI),
+ CommentCode = singleton(
+ llds_instr(comment("string binary several soln lookup switch"), "")
+ ),
+
+ list.length(CaseSolns, MainTableSize),
+ list.length(OutVars, NumOutVars),
+ % For the LLDS backend, array indexing ops don't need the element types,
+ % so it is ok to lie here.
+ list.duplicate(NumOutVars, scalar_elem_generic, OutElemTypes),
+ ArrayElemTypes = [scalar_elem_string, scalar_elem_int, scalar_elem_int
+ | OutElemTypes],
+ ArrayElemType = array_elem_struct(ArrayElemTypes),
+
+ % If there are no output variables, then how can the individual solutions
+ % differ from each other?
+ expect(negate(unify(OutVars, [])), this_file,
+ "generate_string_binary_several_soln_lookup_switch: no OutVars"),
+ (
+ GoalsMayModifyTrail = yes,
+ get_emit_trail_ops(!.CI, EmitTrailOps),
+ AddTrailOps = EmitTrailOps
+ ;
+ GoalsMayModifyTrail = no,
+ AddTrailOps = do_not_add_trail_ops
+ ),
+
+ % Now generate the static cells into which we do the lookups of the values
+ % of the output variables, if there are any.
+ %
+ % We put a dummy row at the start of the later solns table, so that
+ % a zero in the "later solns start row" column of the main table can mean
+ % "no later solutions".
+ InitLaterSolnRowNumber = 1,
+ DummyLaterSolnRow = list.map(default_value_for_type, OutTypes),
+ LaterSolnArrayCord0 = singleton(DummyLaterSolnRow),
+ construct_string_binary_several_soln_lookup_vector(CaseSolns,
+ NumOutVars, [], RevMainRows,
+ InitLaterSolnRowNumber, LaterSolnArrayCord0, LaterSolnArrayCord,
+ 0, OneSolnCaseCount, 0, SeveralSolnsCaseCount),
+ list.reverse(RevMainRows, MainRows),
+ LaterSolnArray = cord.list(LaterSolnArrayCord),
+
+ list.sort([OneSolnCaseCount - kind_one_soln,
+ SeveralSolnsCaseCount - kind_several_solns],
+ AscendingSortedCountKinds),
+ list.reverse(AscendingSortedCountKinds, DescendingSortedCountKinds),
+ assoc_list.values(DescendingSortedCountKinds, DescendingSortedKinds),
+
+ MainRowTypes = [lt_string, lt_integer, lt_integer | OutTypes],
+ list.length(MainRowTypes, MainNumColumns),
+ add_vector_static_cell(MainRowTypes, MainRows, MainVectorAddr, !CI),
+ MainVectorAddrRval = const(llconst_data_addr(MainVectorAddr, no)),
+ add_vector_static_cell(OutTypes, LaterSolnArray, LaterVectorAddr, !CI),
+ LaterVectorAddrRval = const(llconst_data_addr(LaterVectorAddr, no)),
+
+ % Since we release BaseReg only after the calls to generate_branch_end,
+ % we must make sure that generate_branch_end won't want to overwrite
+ % BaseReg.
+ acquire_reg_not_in_storemap(StoreMap, BaseReg, !CI),
+ MidReg = BinarySwitchInfo ^ sbsi_mid_reg,
+ SetBaseRegCode = singleton(
+ llds_instr(
+ assign(BaseReg,
+ mem_addr(
+ heap_ref(MainVectorAddrRval, 0,
+ binop(int_mul,
+ lval(MidReg),
+ const(llconst_int(MainNumColumns)))))),
+ "set up base reg")
+ ),
+ generate_string_binary_switch_search(BinarySwitchInfo,
+ VarRval, MainVectorAddrRval, ArrayElemType,
+ MainTableSize, MainNumColumns, BinarySearchCode),
+
+ generate_code_for_all_kinds(DescendingSortedKinds, 1, OutVars, ResumeVars,
+ EndLabel, StoreMap, Liveness, AddTrailOps,
+ BaseReg, LaterVectorAddrRval, !MaybeEnd, LookupResultsCode, !CI),
+ EndLabelCode = singleton(
+ llds_instr(label(EndLabel),
+ "end of string binary several solns switch")
+ ),
+ Code = CommentCode ++ BinarySearchCode ++ SetBaseRegCode ++
+ LookupResultsCode ++ EndLabelCode.
+
+:- pred construct_string_binary_several_soln_lookup_vector(
+ assoc_list(string, soln_consts(rval))::in, int::in,
+ list(list(rval))::in, list(list(rval))::out,
+ int::in, cord(list(rval))::in, cord(list(rval))::out,
+ int::in, int::out, int::in, int::out) is det.
+
+construct_string_binary_several_soln_lookup_vector([],
+ _NumOutVars, !RevMainRows, _LaterNextRow, !LaterSolnArray,
+ !OneSolnCaseCount, !SeveralSolnCaseCount).
+construct_string_binary_several_soln_lookup_vector([Str - Soln | StrSolns],
+ NumOutVars, !RevMainRows, !.LaterNextRow, !LaterSolnArray,
+ !OneSolnCaseCount, !SeveralSolnsCaseCount) :-
+ StrRval = const(llconst_string(Str)),
+ (
+ Soln = one_soln(OutRvals),
+ !:OneSolnCaseCount = !.OneSolnCaseCount + 1,
+ ZeroRval = const(llconst_int(0)),
+ % The first ZeroRval means there is exactly one solution for this case;
+ % the second ZeroRval is a dummy that won't be referenced.
+ MainRow = [StrRval, ZeroRval, ZeroRval | OutRvals]
+ ;
+ Soln = several_solns(FirstSolnRvals, LaterSolns),
+ !:SeveralSolnsCaseCount = !.SeveralSolnsCaseCount + 1,
+ list.length(LaterSolns, NumLaterSolns),
+ FirstRowOffset = !.LaterNextRow * NumOutVars,
+ LastRowOffset = (!.LaterNextRow + NumLaterSolns - 1) * NumOutVars,
+ FirstRowRval = const(llconst_int(FirstRowOffset)),
+ LastRowRval = const(llconst_int(LastRowOffset)),
+ MainRow = [StrRval, FirstRowRval, LastRowRval | FirstSolnRvals],
+ !:LaterNextRow = !.LaterNextRow + NumLaterSolns,
+ !:LaterSolnArray = !.LaterSolnArray ++ from_list(LaterSolns)
+ ),
+ !:RevMainRows = [MainRow | !.RevMainRows],
+ construct_string_binary_several_soln_lookup_vector(StrSolns, NumOutVars,
+ !RevMainRows, !.LaterNextRow, !LaterSolnArray,
+ !OneSolnCaseCount, !SeveralSolnsCaseCount).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- type string_binary_switch_info
+ ---> string_binary_switch_info(
+ sbsi_lo_reg :: lval,
+ sbsi_hi_reg :: lval,
+ sbsi_mid_reg :: lval,
+ sbsi_result_reg :: lval,
+
+ sbsi_loop_start_label :: label,
+ sbsi_gt_eq_label :: label,
+ sbsi_eq_label :: label,
+ sbsi_fail_label :: label,
+
+ sbsi_branch_start :: position_info,
+ sbsi_fail_code :: llds_code
).
-:- pred this_is_last_case(int::in, int::in,
- map(int, string_hash_slot(label))::in) is semidet.
+:- pred init_string_binary_switch_info(can_fail::in,
+ string_binary_switch_info::out, code_info::in, code_info::out) is det.
-this_is_last_case(Slot, TableSize, Table) :-
- Slot1 = Slot + 1,
- ( Slot1 >= TableSize ->
- true
+init_string_binary_switch_info(CanFail, Info, !CI) :-
+ % Much but not all of the code of this predicate is common
+ % We get the registers we use as working storage in the hash table lookup
+ % code now, before we generate the code of the switch arms, since the set
+ % of free registers will in general be different before and after that
+ % action. However, it is safe to release them immediately, even though
+ % we haven't yet generated all the code which uses them, because that
+ % code will *only* be executed before the code for the cases, and because
+ % that code is generated manually below. Releasing the registers early
+ % allows the code of the cases to make use of them.
+ acquire_reg(reg_r, LoReg, !CI),
+ acquire_reg(reg_r, HiReg, !CI),
+ acquire_reg(reg_r, MidReg, !CI),
+ acquire_reg(reg_r, ResultReg, !CI),
+ release_reg(LoReg, !CI),
+ release_reg(HiReg, !CI),
+ release_reg(MidReg, !CI),
+ release_reg(ResultReg, !CI),
+
+ get_next_label(LoopStartLabel, !CI),
+ get_next_label(GtEqLabel, !CI),
+ get_next_label(EqLabel, !CI),
+ get_next_label(FailLabel, !CI),
+
+ % We must generate the failure code in the context in which
+ % none of the switch arms have been executed yet.
+ remember_position(!.CI, BranchStart),
+ generate_string_switch_fail(CanFail, FailCode, !CI),
+ reset_to_position(BranchStart, !CI),
+
+ Info = string_binary_switch_info(LoReg, HiReg, MidReg, ResultReg,
+ LoopStartLabel, GtEqLabel, EqLabel, FailLabel, BranchStart, FailCode).
+
+ % Generate code for the binary search. This code will execute FailCode
+ % if the key is not in the table, and will fall through if it is, leaving
+ % the index of the matching row in the register specified by
+ % Info ^ sbsi_mid_reg.
+ %
+:- pred generate_string_binary_switch_search(string_binary_switch_info::in,
+ rval::in, rval::in, array_elem_type::in, int::in, int::in,
+ llds_code::out) is det.
+
+generate_string_binary_switch_search(Info, VarRval, TableAddrRval,
+ ArrayElemType, TableSize, NumColumns, Code) :-
+ Info = string_binary_switch_info(LoReg, HiReg, MidReg, ResultReg,
+ LoopStartLabel, GtEqLabel, EqLabel, FailLabel, _BranchStart, FailCode),
+
+ MaxIndex = TableSize - 1,
+ Code = from_list([
+ llds_instr(assign(LoReg, const(llconst_int(0))), ""),
+ llds_instr(assign(HiReg, const(llconst_int(MaxIndex))), ""),
+ llds_instr(label(LoopStartLabel),
+ "begin table search loop, nofulljump"),
+ llds_instr(if_val(binop(int_gt, lval(LoReg), lval(HiReg)),
+ code_label(FailLabel)),
+ "have we searched all of the table?"),
+ llds_instr(assign(MidReg,
+ binop(int_div,
+ binop(int_add, lval(LoReg), lval(HiReg)),
+ const(llconst_int(2)))), ""),
+ llds_instr(assign(ResultReg,
+ binop(str_cmp,
+ VarRval,
+ binop(array_index(ArrayElemType),
+ TableAddrRval,
+ binop(int_mul,
+ lval(MidReg),
+ const(llconst_int(NumColumns)))))),
+ "compare with the middle element"),
+
+ llds_instr(if_val(
+ binop(int_ge, lval(ResultReg), const(llconst_int(0))),
+ code_label(GtEqLabel)),
+ "branch away unless key is in lo half"),
+ llds_instr(assign(HiReg,
+ binop(int_sub, lval(MidReg), const(llconst_int(1)))), ""),
+ llds_instr(goto(code_label(LoopStartLabel)),
+ "go back to search the remaining lo half"),
+ llds_instr(label(GtEqLabel), "nofulljump"),
+
+ llds_instr(if_val(
+ binop(int_le, lval(ResultReg), const(llconst_int(0))),
+ code_label(EqLabel)),
+ "branch away unless key is in hi half"),
+ llds_instr(assign(LoReg,
+ binop(int_add, lval(MidReg), const(llconst_int(1)))), ""),
+ llds_instr(goto(code_label(LoopStartLabel)),
+ "go back to search the remaining hi half"),
+ llds_instr(label(FailLabel),
+ "handle the failure of the table search")
+ ]) ++
+ FailCode ++
+ singleton(
+ llds_instr(label(EqLabel), "we found the key")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred generate_string_switch_fail(can_fail::in, llds_code::out,
+ code_info::in, code_info::out) is det.
+
+generate_string_switch_fail(CanFail, FailCode, !CI) :-
+ (
+ CanFail = can_fail,
+ generate_failure(FailCode, !CI)
;
- \+ map.contains(Table, Slot1),
- this_is_last_case(Slot1, TableSize, Table)
+ CanFail = cannot_fail,
+ FailCode = singleton(
+ llds_instr(comment("unreachable"),
+ "fail code in cannot_fail switch")
+ )
).
%-----------------------------------------------------------------------------%
Index: compiler/switch_case.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_case.m,v
retrieving revision 1.4
diff -u -b -r1.4 switch_case.m
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.114
diff -u -b -r1.114 switch_gen.m
--- compiler/switch_gen.m 4 Nov 2009 03:44:51 -0000 1.114
+++ compiler/switch_gen.m 1 Nov 2010 02:49:10 -0000
@@ -11,21 +11,24 @@
%
% This module handles the generation of code for switches, which are
% disjunctions that do not require backtracking. Switches are detected
-% in switch_detection.m. This is the module that determines what
-% sort of indexing to use for each switch and then actually generates the
-% code.
+% in switch_detection.m. This module determines what sort of indexing to use
+% for each switch and then actually generates the code.
%
% Currently the following forms of indexing are used:
%
% For switches on atomic data types (int, char, enums), if the cases are not
% sparse, we use the value of the switch variable to index into a jump table.
%
-% If all the alternative goals for a switch on an atomic data type
-% contain only construction unifications of constants, then we generate
+% If all the alternative goals for a switch on an atomic data type or a string
+% contain only constructions of constant data structures, then we generate
% a dense lookup table (an array) for the output variables of the switch,
-% rather than a dense jump table, so that executing the switch becomes
-% a matter of doing an array index for each output variable - avoiding
-% the branch overhead of the jump-table.
+% rather than a jump table, so that executing the switch becomes
+% a matter of doing an array lookup for each output variable, avoiding
+% the branch overhead of the jump table.
+%
+% For switches on strings, we can use binary search in a table, or we can
+% look up the address to jump to in a hash table, using open addressing
+% to resolve hash collisions.
%
% For switches on discriminated union types, we generate code that does
% indexing first on the primary tag, and then on the secondary tag (if
@@ -34,9 +37,6 @@
% in the form of a try-me-else chain, a try chain, a dense jump table
% or a binary search.
%
-% For switches on strings, we look up the address to jump to in a hash table,
-% using open addressing to resolve hash collisions.
-%
% For all other cases (or if the --smart-indexing option was disabled),
% we just generate a chain of if-then-elses.
%
@@ -125,8 +125,7 @@
)
->
order_and_generate_cases(TaggedCases, VarRval, VarType, VarName,
- CodeModel, CanFail, GoalInfo, EndLabel, no, MaybeEnd, SwitchCode,
- !CI)
+ CodeModel, CanFail, GoalInfo, EndLabel, MaybeEnd, SwitchCode, !CI)
;
(
SwitchCategory = atomic_switch,
@@ -153,17 +152,23 @@
NumArms > 1,
globals.lookup_int_option(Globals, lookup_switch_req_density,
ReqDensity),
- find_lookup_switch_params(ModuleInfo, VarType, CodeModel,
- CanFail, TaggedCases, FilteredTaggedCases,
- LowerLimit, UpperLimit, NumValues, ReqDensity,
- NeedBitVecCheck, NeedRangeCheck, FirstVal, LastVal),
- is_lookup_switch(FilteredTaggedCases, GoalInfo, StoreMap,
- no, MaybeEndPrime, LookupSwitchInfo, !CI)
- ->
- MaybeEnd = MaybeEndPrime,
- generate_lookup_switch(VarRval, StoreMap, no, LookupSwitchInfo,
- FirstVal, LastVal, NeedBitVecCheck, NeedRangeCheck,
- SwitchCode, !CI)
+ filter_out_failing_cases_if_needed(CodeModel,
+ TaggedCases, FilteredTaggedCases,
+ CanFail, FilteredCanFail),
+ find_int_lookup_switch_params(ModuleInfo, VarType,
+ FilteredCanFail, LowerLimit, UpperLimit, NumValues,
+ ReqDensity, NeedBitVecCheck, NeedRangeCheck,
+ FirstVal, LastVal),
+ is_lookup_switch(record_lookup_for_tagged_cons_id_int,
+ FilteredTaggedCases, GoalInfo, StoreMap,
+ no, MaybeEnd1, LookupSwitchInfo, !CI)
+ ->
+ % We update MaybeEnd1 to MaybeEnd to account for the possible
+ % reservation of temp slots for nondet switches.
+ generate_int_lookup_switch(VarRval, LookupSwitchInfo,
+ EndLabel, StoreMap, FirstVal, LastVal,
+ NeedBitVecCheck, NeedRangeCheck,
+ MaybeEnd1, MaybeEnd, SwitchCode, !CI)
;
MaybeIntSwitchInfo =
int_switch(LowerLimit, UpperLimit, NumValues),
@@ -183,20 +188,54 @@
;
order_and_generate_cases(TaggedCases, VarRval, VarType,
VarName, CodeModel, CanFail, GoalInfo, EndLabel,
- no, MaybeEnd, SwitchCode, !CI)
+ MaybeEnd, SwitchCode, !CI)
)
;
SwitchCategory = string_switch,
- num_cons_ids_in_tagged_cases(TaggedCases, NumConsIds, NumArms),
- globals.lookup_int_option(Globals, string_switch_size, StringSize),
- ( NumConsIds >= StringSize, NumArms > 1 ->
- generate_string_switch(TaggedCases, VarRval, VarName,
- CodeModel, CanFail, GoalInfo, EndLabel,
- no, MaybeEnd, SwitchCode, !CI)
+ filter_out_failing_cases_if_needed(CodeModel,
+ TaggedCases, FilteredTaggedCases, CanFail, FilteredCanFail),
+ num_cons_ids_in_tagged_cases(FilteredTaggedCases,
+ NumConsIds, NumArms),
+ globals.lookup_int_option(Globals, string_hash_switch_size,
+ StringHashSwitchSize),
+ globals.lookup_int_option(Globals, string_binary_switch_size,
+ StringBinarySwitchSize),
+ ( NumConsIds >= StringHashSwitchSize, NumArms > 1 ->
+ (
+ is_lookup_switch(record_lookup_for_tagged_cons_id_string,
+ FilteredTaggedCases, GoalInfo, StoreMap,
+ no, MaybeEnd1, LookupSwitchInfo, !CI)
+ ->
+ % We update MaybeEnd1 to MaybeEnd to account for the
+ % possible reservation of temp slots for nondet switches.
+ generate_string_hash_lookup_switch(VarRval,
+ LookupSwitchInfo, FilteredCanFail, EndLabel, StoreMap,
+ MaybeEnd1, MaybeEnd, SwitchCode, !CI)
+ ;
+ generate_string_hash_switch(TaggedCases, VarRval,
+ VarName, CodeModel, CanFail, GoalInfo, EndLabel,
+ MaybeEnd, SwitchCode, !CI)
+ )
+ ; NumConsIds >= StringBinarySwitchSize, NumArms > 1 ->
+ (
+ is_lookup_switch(record_lookup_for_tagged_cons_id_string,
+ FilteredTaggedCases, GoalInfo, StoreMap,
+ no, MaybeEnd1, LookupSwitchInfo, !CI)
+ ->
+ % We update MaybeEnd1 to MaybeEnd to account for the
+ % possible reservation of temp slots for nondet switches.
+ generate_string_binary_lookup_switch(VarRval,
+ LookupSwitchInfo, FilteredCanFail, EndLabel, StoreMap,
+ MaybeEnd1, MaybeEnd, SwitchCode, !CI)
+ ;
+ generate_string_binary_switch(TaggedCases, VarRval,
+ VarName, CodeModel, CanFail, GoalInfo, EndLabel,
+ MaybeEnd, SwitchCode, !CI)
+ )
;
order_and_generate_cases(TaggedCases, VarRval, VarType,
VarName, CodeModel, CanFail, GoalInfo, EndLabel,
- no, MaybeEnd, SwitchCode, !CI)
+ MaybeEnd, SwitchCode, !CI)
)
;
SwitchCategory = tag_switch,
@@ -209,13 +248,13 @@
;
order_and_generate_cases(TaggedCases, VarRval, VarType,
VarName, CodeModel, CanFail, GoalInfo, EndLabel,
- no, MaybeEnd, SwitchCode, !CI)
+ MaybeEnd, SwitchCode, !CI)
)
;
SwitchCategory = other_switch,
order_and_generate_cases(TaggedCases, VarRval, VarType,
VarName, CodeModel, CanFail, GoalInfo, EndLabel,
- no, MaybeEnd, SwitchCode, !CI)
+ MaybeEnd, SwitchCode, !CI)
)
),
Code = VarCode ++ SwitchCode,
@@ -264,11 +303,10 @@
%
:- pred order_and_generate_cases(list(tagged_case)::in, rval::in, mer_type::in,
string::in, code_model::in, can_fail::in, hlds_goal_info::in, label::in,
- branch_end::in, branch_end::out, llds_code::out,
- code_info::in, code_info::out) is det.
+ branch_end::out, llds_code::out, code_info::in, code_info::out) is det.
order_and_generate_cases(TaggedCases, VarRval, VarType, VarName, CodeModel,
- CanFail, GoalInfo, EndLabel, !MaybeEnd, Code, !CI) :-
+ CanFail, GoalInfo, EndLabel, MaybeEnd, Code, !CI) :-
order_cases(TaggedCases, OrderedTaggedCases, VarType, CodeModel, CanFail,
!.CI),
type_to_ctor_det(VarType, TypeCtor),
@@ -282,7 +320,7 @@
),
generate_if_then_else_chain_cases(OrderedTaggedCases, VarRval, VarType,
VarName, CheaperTagTest, CodeModel, CanFail, GoalInfo, EndLabel,
- !MaybeEnd, Code, !CI).
+ no, MaybeEnd, Code, !CI).
:- pred order_cases(list(tagged_case)::in, list(tagged_case)::out,
mer_type::in, code_model::in, can_fail::in, code_info::in) is det.
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.46
diff -u -b -r1.46 switch_util.m
--- compiler/switch_util.m 2 Oct 2009 03:55:30 -0000 1.46
+++ compiler/switch_util.m 31 Oct 2010 12:34:41 -0000
@@ -113,12 +113,12 @@
% Stuff for lookup switches.
%
-:- type case_consts(Rval)
+:- type case_consts(Key, Rval)
---> all_one_soln(
- assoc_list(int, list(Rval))
+ assoc_list(Key, list(Rval))
)
; some_several_solns(
- assoc_list(int, soln_consts(Rval)),
+ assoc_list(Key, soln_consts(Rval)),
set(prog_var), % The resume vars.
bool % The Boolean "or" of the result
% of invoking goal_may_modify_trail
@@ -139,18 +139,19 @@
---> need_bit_vec_check
; dont_need_bit_vec_check.
-:- pred find_lookup_switch_params(module_info::in, mer_type::in,
- code_model::in, can_fail::in,
+:- pred filter_out_failing_cases_if_needed(code_model::in,
list(tagged_case)::in, list(tagged_case)::out,
- int::in, int::in, int::in, int::in,
+ can_fail::in, can_fail::out) is det.
+
+:- pred find_int_lookup_switch_params(module_info::in, mer_type::in,
+ can_fail::in, int::in, int::in, int::in, int::in,
need_bit_vec_check::out, need_range_check::out, int::out, int::out)
is semidet.
-:- pred project_all_to_one_solution(assoc_list(int, soln_consts(Rval))::in,
- assoc_list(int, list(Rval))::in, assoc_list(int, list(Rval))::out)
- is semidet.
+:- pred project_all_to_one_solution(assoc_list(T, soln_consts(Rval))::in,
+ assoc_list(T, list(Rval))::out) is semidet.
-:- pred project_solns_to_rval_lists(assoc_list(int, soln_consts(Rval))::in,
+:- pred project_solns_to_rval_lists(assoc_list(T, soln_consts(Rval))::in,
list(list(Rval))::in, list(list(Rval))::out) is det.
% get_word_bits(Globals, WordBits, Log2WordBits):
@@ -176,32 +177,38 @@
% Stuff for string hash switches.
%
- % For a string switch, compute the hash value for each case in the list
- % of cases, and store the cases in a map from hash values to cases.
+:- type string_hash_slot(CaseRep)
+ ---> string_hash_slot(string, int, CaseRep).
+
+ % For a string jump switch, compute the hash value for each case in the
+ % list of cases, and store the cases in a map from hash values to cases.
%
-:- pred string_hash_cases(list(tagged_case)::in, int::in,
+:- pred construct_string_hash_jump_cases(list(tagged_case)::in,
+ int::in, int::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,
- map(int, assoc_list(string, CaseRep))::out) is det.
-
-:- type string_hash_slot(CaseRep)
- ---> string_hash_slot(int, string, CaseRep).
+ map(int, string_hash_slot(CaseRep))::out) is det.
- % calc_string_hash_slots(AssocList, HashMap, Map):
+ % For a string lookup switch, compute the hash value for each string,
+ % and store the associated data in a map from the hash values.
%
- % For each (HashVal - Case) pair in AssocList, allocate a hash slot in Map
- % for the case. If the hash slot corresponding to HashVal is not already
- % used, then use that one. Otherwise, find the next spare slot (making sure
- % that we don't use slots which can be used for a direct match with the
- % hash value for one of the other cases), and use it instead.
- % Keep track of the hash chains as we do this.
+:- pred construct_string_hash_lookup_cases(assoc_list(string, CaseRep)::in,
+ int::in, int::in, map(int, string_hash_slot(CaseRep))::out) is det.
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff for string binary switches.
+%
+
+ % For a string switch, compute the hash value for each case in the list
+ % of cases, and store the cases in a map from hash values to cases.
%
- % XXX
-:- pred calc_string_hash_slots(
- assoc_list(int, assoc_list(string, CaseRep))::in,
- map(int, assoc_list(string, CaseRep))::in,
- map(int, string_hash_slot(CaseRep))::out) is det.
+:- pred string_binary_cases(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,
+ assoc_list(string, CaseRep)::out) is det.
%-----------------------------------------------------------------------------%
%
@@ -341,10 +348,12 @@
:- import_module char.
:- import_module cord.
:- import_module int.
+:- import_module io.
:- import_module string.
:- import_module svmap.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
%
% General stuff, for adding tags to cons_ids in switches and for representing
% switch arms.
@@ -463,6 +472,7 @@
num_cons_ids_in_tagged_cases_2(TaggedCases, !NumConsIds, !NumArms).
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
%
% Stuff for categorizing switches.
%
@@ -552,6 +562,7 @@
).
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
%
% Stuff for dense switches.
%
@@ -592,13 +603,12 @@
Density = (NumCases * 100) // Range.
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
%
% Stuff for lookup switches.
%
-find_lookup_switch_params(ModuleInfo, SwitchVarType, CodeModel,
- !.SwitchCanFail, !TaggedCases, LowerLimit, UpperLimit, NumValues,
- ReqDensity, NeedBitVecCheck, NeedRangeCheck, FirstVal, LastVal) :-
+filter_out_failing_cases_if_needed(CodeModel, !TaggedCases, !SwitchCanFail) :-
(
( CodeModel = model_non
; CodeModel = model_semi
@@ -606,8 +616,35 @@
filter_out_failing_cases(!TaggedCases, !SwitchCanFail)
;
CodeModel = model_det
+ ).
+
+:- pred filter_out_failing_cases(list(tagged_case)::in, list(tagged_case)::out,
+ can_fail::in, can_fail::out) is det.
+
+filter_out_failing_cases(TaggedCases0, TaggedCases, !SwitchCanFail) :-
+ filter_out_failing_cases_2(TaggedCases0, [], RevTaggedCases,
+ !SwitchCanFail),
+ list.reverse(RevTaggedCases, TaggedCases).
+
+:- pred filter_out_failing_cases_2(list(tagged_case)::in,
+ list(tagged_case)::in, list(tagged_case)::out,
+ can_fail::in, can_fail::out) is det.
+
+filter_out_failing_cases_2([], !RevTaggedCases, !SwitchCanFail).
+filter_out_failing_cases_2([TaggedCase | TaggedCases], !RevTaggedCases,
+ !SwitchCanFail) :-
+ TaggedCase = tagged_case(_, _, _, Goal),
+ Goal = hlds_goal(GoalExpr, _),
+ ( GoalExpr = disj([]) ->
+ !:SwitchCanFail = can_fail
+ ;
+ !:RevTaggedCases = [TaggedCase | !.RevTaggedCases]
),
+ filter_out_failing_cases_2(TaggedCases, !RevTaggedCases, !SwitchCanFail).
+find_int_lookup_switch_params(ModuleInfo, SwitchVarType, SwitchCanFail,
+ LowerLimit, UpperLimit, NumValues, ReqDensity,
+ NeedBitVecCheck, NeedRangeCheck, FirstVal, LastVal) :-
% We want to generate a lookup switch for any switch that is dense enough
% - we don't care how many cases it has. A memory lookup tends to be
% cheaper than a branch.
@@ -624,7 +661,7 @@
NeedBitVecCheck0 = need_bit_vec_check
),
(
- !.SwitchCanFail = can_fail,
+ SwitchCanFail = can_fail,
% For can_fail switches, we normally need to check that the variable
% is in range before we index into the jump table. However, if the
% range of the type is sufficiently small, we can make the jump table
@@ -648,42 +685,26 @@
LastVal = UpperLimit
)
;
- !.SwitchCanFail = cannot_fail,
+ SwitchCanFail = cannot_fail,
NeedRangeCheck = dont_need_range_check,
NeedBitVecCheck = NeedBitVecCheck0,
FirstVal = LowerLimit,
LastVal = UpperLimit
).
-:- pred filter_out_failing_cases(list(tagged_case)::in, list(tagged_case)::out,
- can_fail::in, can_fail::out) is det.
-
-filter_out_failing_cases(TaggedCases0, TaggedCases, !SwitchCanFail) :-
- filter_out_failing_cases_2(TaggedCases0, [], RevTaggedCases,
- !SwitchCanFail),
- list.reverse(RevTaggedCases, TaggedCases).
-
-:- pred filter_out_failing_cases_2(list(tagged_case)::in,
- list(tagged_case)::in, list(tagged_case)::out,
- can_fail::in, can_fail::out) is det.
-
-filter_out_failing_cases_2([], !RevTaggedCases, !SwitchCanFail).
-filter_out_failing_cases_2([TaggedCase | TaggedCases], !RevTaggedCases,
- !SwitchCanFail) :-
- TaggedCase = tagged_case(_, _, _, Goal),
- Goal = hlds_goal(GoalExpr, _),
- ( GoalExpr = disj([]) ->
- !:SwitchCanFail = can_fail
- ;
- !:RevTaggedCases = [TaggedCase | !.RevTaggedCases]
- ),
- filter_out_failing_cases_2(TaggedCases, !RevTaggedCases, !SwitchCanFail).
-
-project_all_to_one_solution([], !RevCaseValuePairs).
-project_all_to_one_solution([Case - Solns | CaseSolns], !RevCaseValuePairs) :-
+project_all_to_one_solution(CaseSolns, CaseValuePairs) :-
+ do_project_all_to_one_solution(CaseSolns, [], RevCaseValuePairs),
+ list.reverse(RevCaseValuePairs, CaseValuePairs).
+
+:- pred do_project_all_to_one_solution(assoc_list(T, soln_consts(Rval))::in,
+ assoc_list(T, list(Rval))::in, assoc_list(T, list(Rval))::out) is semidet.
+
+do_project_all_to_one_solution([], !RevCaseValuePairs).
+do_project_all_to_one_solution([Case - Solns | CaseSolns],
+ !RevCaseValuePairs) :-
Solns = one_soln(Values),
!:RevCaseValuePairs = [Case - Values | !.RevCaseValuePairs],
- project_all_to_one_solution(CaseSolns, !RevCaseValuePairs).
+ do_project_all_to_one_solution(CaseSolns, !RevCaseValuePairs).
project_solns_to_rval_lists([], !RvalsList).
project_solns_to_rval_lists([Case | Cases], !RvalsList) :-
@@ -711,21 +732,35 @@
int.log2(X + 1, Log + 1). % int.log2 rounds up
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
%
% Stuff for string hash switches.
%
-string_hash_cases([], _, _, !StateA, !StateB, !StateC, !:HashMap) :-
- map.init(!:HashMap).
-string_hash_cases([TaggedCase | TaggedCases], HashMask, RepresentCase,
- !StateA, !StateB, !StateC, !:HashMap) :-
- string_hash_cases(TaggedCases, HashMask, RepresentCase,
- !StateA, !StateB, !StateC, !:HashMap),
+construct_string_hash_jump_cases(TaggedCases, TableSize, HashMask,
+ RepresentCase, !StateA, !StateB, !StateC, HashSlotsMap) :-
+ string_hash_jump_cases(TaggedCases, HashMask, RepresentCase,
+ !StateA, !StateB, !StateC, map.init, HashValsMap),
+ map.to_assoc_list(HashValsMap, HashValsList),
+ calc_string_hash_slots(TableSize, HashValsList, HashValsMap, HashSlotsMap).
+
+:- pred string_hash_jump_cases(list(tagged_case)::in, int::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,
+ map(int, assoc_list(string, CaseRep))::in,
+ map(int, assoc_list(string, CaseRep))::out) is det.
+
+string_hash_jump_cases([], _, _, !StateA, !StateB, !StateC, !HashMap).
+string_hash_jump_cases([TaggedCase | TaggedCases], HashMask, RepresentCase,
+ !StateA, !StateB, !StateC, !HashMap) :-
RepresentCase(TaggedCase, CaseRep, !StateA, !StateB, !StateC),
TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _, _),
string_hash_cons_id(CaseRep, HashMask, MainTaggedConsId, !HashMap),
list.foldl(string_hash_cons_id(CaseRep, HashMask), OtherTaggedConsIds,
- !HashMap).
+ !HashMap),
+ string_hash_jump_cases(TaggedCases, HashMask, RepresentCase,
+ !StateA, !StateB, !StateC, !HashMap).
:- pred string_hash_cons_id(CaseRep::in, int::in, tagged_cons_id::in,
map(int, assoc_list(string, CaseRep))::in,
@@ -747,53 +782,109 @@
svmap.det_insert(HashVal, [String - CaseRep], !HashMap)
).
-calc_string_hash_slots(HashValList, HashMap, SlotMap) :-
- calc_string_hash_slots_1(HashValList, HashMap, map.init, SlotMap, 0, _).
+%-----------------------------------------------------------------------------%
+
+construct_string_hash_lookup_cases(StrsDatas, TableSize, HashMask,
+ HashSlotsMap) :-
+ string_hash_lookup_cases(StrsDatas, HashMask, map.init, HashValsMap),
+ map.to_assoc_list(HashValsMap, HashValsList),
+ calc_string_hash_slots(TableSize, HashValsList, HashValsMap, HashSlotsMap).
+
+:- pred string_hash_lookup_cases(assoc_list(string, CaseRep)::in, int::in,
+ map(int, assoc_list(string, CaseRep))::in,
+ map(int, assoc_list(string, CaseRep))::out) is det.
+
+string_hash_lookup_cases([], _, !HashMap).
+string_hash_lookup_cases([Str - Data | StrsDatas], HashMask, !HashMap) :-
+ string.hash(Str, StringHashVal),
+ HashVal = StringHashVal /\ HashMask,
+ ( map.search(!.HashMap, HashVal, OldStringDatas) ->
+ svmap.det_update(HashVal, [Str - Data | OldStringDatas], !HashMap)
+ ;
+ svmap.det_insert(HashVal, [Str - Data], !HashMap)
+ ),
+ string_hash_lookup_cases(StrsDatas, HashMask, !HashMap).
+
+%-----------------------------------------------------------------------------%
-:- pred calc_string_hash_slots_1(
+ % calc_string_hash_slots(AssocList, HashMap, Map):
+ %
+ % For each (HashVal - Case) pair in AssocList, allocate a hash slot in Map
+ % for the case. If the hash slot corresponding to HashVal is not already
+ % used, then use that one. Otherwise, find the next spare slot (making sure
+ % that we don't use slots which can be used for a direct match with the
+ % hash value for one of the other cases), and use it instead.
+ % Keep track of the hash chains as we do this.
+ %
+:- pred calc_string_hash_slots(int::in,
assoc_list(int, assoc_list(string, CaseRep))::in,
map(int, assoc_list(string, CaseRep))::in,
+ map(int, string_hash_slot(CaseRep))::out) is det.
+
+calc_string_hash_slots(TableSize, HashValList, HashMap, SlotMap) :-
+ trace [compile_time(flag("hash_slots")), io(!IO)] (
+ io.write_string("CALCULATING HASH SLOTS START\n", !IO)
+ ),
+ calc_string_hash_slots_loop_over_hashes(HashValList, TableSize, HashMap,
+ map.init, SlotMap, 0, _),
+ trace [compile_time(flag("hash_slots")), io(!IO)] (
+ io.write_string("CALCULATING HASH SLOTS END\n", !IO)
+ ).
+
+:- pred calc_string_hash_slots_loop_over_hashes(
+ assoc_list(int, assoc_list(string, CaseRep))::in, int::in,
+ map(int, assoc_list(string, CaseRep))::in,
map(int, string_hash_slot(CaseRep))::in,
map(int, string_hash_slot(CaseRep))::out,
int::in, int::out) is det.
-calc_string_hash_slots_1([], _, !SlotMap, !LastUsed).
-calc_string_hash_slots_1([HashVal - StringCaseReps | Rest], HashMap,
- !SlotMap, !LastUsed) :-
- calc_string_hash_slots_2(StringCaseReps, HashVal, HashMap,
- !SlotMap, !LastUsed),
- calc_string_hash_slots_1(Rest, HashMap, !SlotMap, !LastUsed).
+calc_string_hash_slots_loop_over_hashes([], _, _, !SlotMap, !LastUsed).
+calc_string_hash_slots_loop_over_hashes([HashVal - StringCaseReps | Rest],
+ TableSize, HashMap, !SlotMap, !LastUsed) :-
+ calc_string_hash_slots_loop_over_hash_strings(StringCaseReps, TableSize,
+ HashVal, HashMap, !SlotMap, !LastUsed),
+ calc_string_hash_slots_loop_over_hashes(Rest, TableSize,
+ HashMap, !SlotMap, !LastUsed).
-:- pred calc_string_hash_slots_2(assoc_list(string, CaseRep)::in, int::in,
+:- pred calc_string_hash_slots_loop_over_hash_strings(
+ assoc_list(string, CaseRep)::in, int::in, int::in,
map(int, assoc_list(string, CaseRep))::in,
map(int, string_hash_slot(CaseRep))::in,
map(int, string_hash_slot(CaseRep))::out,
int::in, int::out) is det.
-calc_string_hash_slots_2([], _HashVal, _HashMap, !SlotMap, !LastUsed).
-calc_string_hash_slots_2([StringCaseRep | StringCaseReps], HashVal, HashMap,
- !SlotMap, !LastUsed) :-
- calc_string_hash_slots_2(StringCaseReps, HashVal, HashMap,
- !SlotMap, !LastUsed),
+calc_string_hash_slots_loop_over_hash_strings([],
+ _TableSize, _HashVal, _HashMap, !SlotMap, !LastUsed).
+calc_string_hash_slots_loop_over_hash_strings([StringCaseRep | StringCaseReps],
+ TableSize, HashVal, HashMap, !SlotMap, !LastUsed) :-
+ calc_string_hash_slots_loop_over_hash_strings(StringCaseReps,
+ TableSize, HashVal, HashMap, !SlotMap, !LastUsed),
StringCaseRep = String - CaseRep,
- NewSlot = string_hash_slot(-1, String, CaseRep),
+ NewSlot = string_hash_slot(String, -1, CaseRep),
( map.contains(!.SlotMap, HashVal) ->
follow_hash_chain(!.SlotMap, HashVal, ChainEnd),
- next_free_hash_slot(!.SlotMap, HashMap, !LastUsed),
+ next_free_hash_slot(!.SlotMap, HashMap, TableSize, !LastUsed),
map.lookup(!.SlotMap, ChainEnd, ChainEndSlot0),
- ChainEndSlot0 = string_hash_slot(_, PrevString, PrevCaseRep),
- ChainEndSlot = string_hash_slot(!.LastUsed, PrevString, PrevCaseRep),
+ ChainEndSlot0 = string_hash_slot(PrevString, _, PrevCaseRep),
+ ChainEndSlot = string_hash_slot(PrevString, !.LastUsed, PrevCaseRep),
svmap.det_update(ChainEnd, ChainEndSlot, !SlotMap),
- svmap.det_insert(!.LastUsed, NewSlot, !SlotMap)
+ svmap.det_insert(!.LastUsed, NewSlot, !SlotMap),
+ trace [compile_time(flag("hash_slots")), io(!IO)] (
+ io.format("%s: home %d, remapped slot %d\n",
+ [s(String), i(HashVal), i(!.LastUsed)], !IO)
+ )
;
- svmap.det_insert(HashVal, NewSlot, !SlotMap)
+ svmap.det_insert(HashVal, NewSlot, !SlotMap),
+ trace [compile_time(flag("hash_slots")), io(!IO)] (
+ io.format("%s: native slot %d\n", [s(String), i(HashVal)], !IO)
+ )
).
:- pred follow_hash_chain(map(int, string_hash_slot(CaseRep))::in,
int::in, int::out) is det.
follow_hash_chain(Map, Slot, LastSlot) :-
- map.lookup(Map, Slot, string_hash_slot(NextSlot, _, _)),
+ map.lookup(Map, Slot, string_hash_slot(_, NextSlot, _)),
(
NextSlot >= 0,
map.contains(Map, NextSlot)
@@ -806,24 +897,68 @@
% next_free_hash_slot(M, H_M, LastUsed, FreeSlot):
%
% Find the next available slot FreeSlot in the hash table which is not
- % already used (contained in M) and which is not going to be used a
- % primary slot (contained in H_M), starting at the slot after LastUsed.
+ % already used (contained in Map) and which is not going to be used as a
+ % primary slot (contained in HomeMap), starting at the slot after LastUsed.
%
:- pred next_free_hash_slot(map(int, string_hash_slot(CaseRep))::in,
- map(int, assoc_list(string, CaseRep))::in, int::in, int::out) is det.
+ map(int, assoc_list(string, CaseRep))::in, int::in, int::in, int::out)
+ is det.
-next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
+next_free_hash_slot(Map, HomeMap, TableSize, LastUsed, FreeSlot) :-
NextSlot = LastUsed + 1,
+ expect(NextSlot < TableSize, this_file, "next_free_hash_slot: overflow"),
(
\+ map.contains(Map, NextSlot),
- \+ map.contains(H_Map, NextSlot)
+ \+ map.contains(HomeMap, NextSlot)
->
FreeSlot = NextSlot
;
- next_free_hash_slot(Map, H_Map, NextSlot, FreeSlot)
+ next_free_hash_slot(Map, HomeMap, TableSize, NextSlot, FreeSlot)
).
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% Stuff for string binary switches.
+%
+
+string_binary_cases(TaggedCases, RepresentCase,
+ !StateA, !StateB, !StateC, SortedTable) :-
+ string_binary_entries(TaggedCases, RepresentCase,
+ !StateA, !StateB, !StateC, [], UnsortedTable),
+ list.sort(UnsortedTable, SortedTable).
+
+:- pred string_binary_entries(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,
+ assoc_list(string, CaseRep)::in, assoc_list(string, CaseRep)::out) is det.
+
+string_binary_entries([], _, !StateA, !StateB, !StateC, !UnsortedTable).
+string_binary_entries([TaggedCase | TaggedCases], RepresentCase,
+ !StateA, !StateB, !StateC, !UnsortedTable) :-
+ string_binary_entries(TaggedCases, RepresentCase,
+ !StateA, !StateB, !StateC, !UnsortedTable),
+ RepresentCase(TaggedCase, CaseRep, !StateA, !StateB, !StateC),
+ TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _, _),
+ add_string_binary_entry(CaseRep, MainTaggedConsId, !UnsortedTable),
+ list.foldl(add_string_binary_entry(CaseRep), OtherTaggedConsIds,
+ !UnsortedTable).
+
+:- pred add_string_binary_entry(CaseRep::in, tagged_cons_id::in,
+ assoc_list(string, CaseRep)::in, assoc_list(string, CaseRep)::out) is det.
+
+add_string_binary_entry(CaseRep, TaggedConsId, !UnsortedTable) :-
+ TaggedConsId = tagged_cons_id(_ConsId, Tag),
+ ( Tag = string_tag(StringPrime) ->
+ String = StringPrime
+ ;
+ unexpected(this_file, "string_hash_cases: non-string case?")
+ ),
+ !:UnsortedTable = [String - CaseRep | !.UnsortedTable].
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
%
% Stuff for tag switches.
%
@@ -1125,9 +1260,11 @@
).
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "switch_util.m".
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.197
diff -u -b -r1.197 unify_gen.m
--- compiler/unify_gen.m 30 Jul 2010 05:16:19 -0000 1.197
+++ compiler/unify_gen.m 31 Oct 2010 13:50:09 -0000
@@ -720,7 +720,8 @@
% at all. This is why we jump to the loop condition test.
llds_instr(goto(code_label(LoopTest)),
"enter the copy loop at the conceptual top"),
- llds_instr(label(LoopStart), "start of loop"),
+ llds_instr(label(LoopStart),
+ "start of loop, nofulljump"),
llds_instr(
assign(field(yes(0), lval(NewClosure), lval(LoopCounter)),
lval(field(yes(0), OldClosure, lval(LoopCounter)))),
@@ -730,7 +731,7 @@
binop(int_add, lval(LoopCounter), One)),
"increment loop counter"),
llds_instr(label(LoopTest),
- "do we have more old arguments to copy?"),
+ "do we have more old arguments to copy? nofulljump"),
llds_instr(
if_val(binop(int_lt, lval(LoopCounter), lval(NumOldArgs)),
code_label(LoopStart)),
Index: compiler/var_locn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/var_locn.m,v
retrieving revision 1.68
diff -u -b -r1.68 var_locn.m
--- compiler/var_locn.m 2 Sep 2009 00:30:24 -0000 1.68
+++ compiler/var_locn.m 31 Oct 2010 12:34:41 -0000
@@ -1734,6 +1734,7 @@
%----------------------------------------------------------------------------%
+var_locn_var_becomes_dead(Var, FirstTime, !VLI) :-
% Var has become dead. If there are no expressions that depend on its
% value, delete the record of its state, thus freeing up the resources
% it has tied down: the locations it occupies, or the variables whose
@@ -1746,8 +1747,7 @@
% been called for Var, if FirstTime = yes, then as a consistency check
% we would like to insist on Var being alive (but don't (yet) due to bugs
% in liveness).
- %
-var_locn_var_becomes_dead(Var, FirstTime, !VLI) :-
+
var_locn_get_var_state_map(!.VLI, VarStateMap0),
( map.search(VarStateMap0, Var, State0) ->
State0 = var_state(Lvals, MaybeConstRval, MaybeExprRval, Using,
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.614
diff -u -b -r1.614 user_guide.texi
--- doc/user_guide.texi 7 Oct 2010 23:38:44 -0000 1.614
+++ doc/user_guide.texi 1 Nov 2010 02:43:31 -0000
@@ -8866,12 +8866,18 @@
must have at least this many entries (default: 4).
@sp 1
- at item --string-switch-size @var{size}
+ at item --string-hash-switch-size @var{size}
@findex --string-switch-size
The hash table generated for a string switch
must have at least this many entries (default: 8).
@sp 1
+ at item --string-binary-switch-size @var{size}
+ at findex --string-switch-size
+The binary search table generated for a string switch
+must have at least this many entries (default: 4).
+
+ at sp 1
@item --tag-switch-size @var{size}
@findex --tag-switch-size
The number of alternatives in a tag switch
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_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
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/monte
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
Index: runtime/mercury_string.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_string.h,v
retrieving revision 1.35
diff -u -b -r1.35 mercury_string.h
--- runtime/mercury_string.h 12 Sep 2007 06:21:16 -0000 1.35
+++ runtime/mercury_string.h 22 Oct 2010 04:37:53 -0000
@@ -240,6 +240,13 @@
return hash_string_result;
/*
+** A version of strcmp to which we can pass Mercury words
+** without having to cast the arguments first.
+*/
+
+#define MR_strcmp(s, t) strcmp((const char *)(s), (const char *)(t))
+
+/*
** Return an MR_String which has been created using the format string,
** fmt, passed to sprintf. If memory profiling is turned on, record the
** allocation as coming from proclabel. The MR_String returned has been
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/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
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/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.46
diff -u -b -r1.46 Mercury.options
--- tests/hard_coded/Mercury.options 10 Sep 2010 04:02:30 -0000 1.46
+++ tests/hard_coded/Mercury.options 22 Oct 2010 05:33:57 -0000
@@ -67,6 +67,19 @@
MCFLAGS-prince_frameopt_css = --intermodule-optimization -O5
MCFLAGS-prince_frameopt_css.style = --intermodule-optimization -O5
+# Compile string_switch with both binary and hash switches effectively
+# disabled, to test the basic indexing algorithm.
+# Compile string_switch2 with only hash switches effectively disabled,
+# to test the binary search algorithm.
+# Compile string_switch3 with only binary search switches effectively disabled,
+# to test the hash search algorithm.
+MCFLAGS-string_switch = \
+ --string-binary-switch-size=100 --string-hash-switch-size=100
+MCFLAGS-string_switch2 = \
+ --string-binary-switch-size=2 --string-hash-switch-size=100
+MCFLAGS-string_switch3 = \
+ --string-binary-switch-size=100 --string-hash-switch-size=2
+
# This bug only shows up at optimization levels -O2 and below.
#
MCFLAGS-profdeep_seg_fault = -O2
Index: tests/hard_coded/int_switch.exp
===================================================================
RCS file: tests/hard_coded/int_switch.exp
diff -N tests/hard_coded/int_switch.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/int_switch.exp 22 Oct 2010 07:25:24 -0000
@@ -0,0 +1,72 @@
+jump 1 -> 51
+jump 2 -> 52
+jump 3 failed
+jump 11 -> 11
+jump 12 -> 11
+jump 13 failed
+jump 21 -> 62
+jump 22 -> 62
+jump 23 failed
+jump 31 -> 13
+jump 32 failed
+jump 33 failed
+one 1 -> 1
+one 2 -> 2
+one 3 failed
+one 11 -> 11
+one 12 -> 11
+one 13 failed
+one 21 -> 12
+one 22 -> 12
+one 23 failed
+one 31 -> 13
+one 32 failed
+one 33 failed
+one known 1 failed
+one known 2 failed
+one known 3 failed
+one known 11 -> 11
+one known 12 failed
+one known 13 failed
+one known 21 failed
+one known 22 -> 12
+one known 23 failed
+one known 31 failed
+one known 32 failed
+one known 33 failed
+several 1 -> [1]
+several 2 -> [2]
+several 3 -> []
+several 11 -> [11, 12]
+several 12 -> [11, 12]
+several 13 -> []
+several 21 -> [13, 14, 15]
+several 22 -> [13, 14, 15]
+several 23 -> []
+several 31 -> [16]
+several 32 -> [16]
+several 33 -> []
+several known 1 -> []
+several known 2 -> []
+several known 3 -> []
+several known 11 -> [11, 12]
+several known 12 -> []
+several known 13 -> []
+several known 21 -> []
+several known 22 -> [13, 14, 15]
+several known 23 -> []
+several known 31 -> []
+several known 32 -> []
+several known 33 -> []
+several nested 1 -> [1001, 11001, 12001]
+several nested 2 -> [11002, 12002]
+several nested 3 -> []
+several nested 11 -> [11011, 11012, 12011, 12012]
+several nested 12 -> [11011, 11012, 12011, 12012]
+several nested 13 -> []
+several nested 21 -> [13013, 13014, 13015, 14013, 14014, 14015, 15013, 15014, 15015]
+several nested 22 -> [13013, 13014, 13015, 14013, 14014, 14015, 15013, 15014, 15015]
+several nested 23 -> []
+several nested 31 -> [16016]
+several nested 32 -> [16016]
+several nested 33 -> []
Index: tests/hard_coded/int_switch.m
===================================================================
RCS file: tests/hard_coded/int_switch.m
diff -N tests/hard_coded/int_switch.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/int_switch.m 22 Oct 2010 07:24:06 -0000
@@ -0,0 +1,353 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+
+:- module int_switch.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module solutions.
+:- import_module string.
+
+main(!IO) :-
+ Keys =
+ [1, 2, 3,
+ 11, 12, 13,
+ 21, 22, 23,
+ 31, 32, 33],
+
+ % Test jump tables.
+ list.foldl(test_jump, Keys, !IO),
+
+ % Test semidet and det lookup tables.
+ list.foldl(test_one, Keys, !IO),
+ list.foldl(test_one_known, Keys, !IO),
+
+ % Test nondet and multi lookup tables.
+ list.foldl(test_several, Keys, !IO),
+ list.foldl(test_several_known, Keys, !IO),
+ list.foldl(test_several_nested, Keys, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred test_jump(int::in, io::di, io::uo) is det.
+
+test_jump(S, !IO) :-
+ ( jump(S, 50, N) ->
+ io.format("jump %d -> %d\n", [i(S), i(N)], !IO)
+ ;
+ io.format("jump %d failed\n", [i(S)], !IO)
+ ).
+
+:- pred test_one(int::in, io::di, io::uo) is det.
+
+test_one(S, !IO) :-
+ ( one(S, N) ->
+ io.format("one %d -> %d\n", [i(S), i(N)], !IO)
+ ;
+ io.format("one %d failed\n", [i(S)], !IO)
+ ).
+
+:- pred test_one_known(int::in, io::di, io::uo) is det.
+
+test_one_known(S, !IO) :-
+ (
+ ( S = 11
+ ; S = 22
+ ),
+ one(S, N)
+ ->
+ io.format("one known %d -> %d\n", [i(S), i(N)], !IO)
+ ;
+ io.format("one known %d failed\n", [i(S)], !IO)
+ ).
+
+:- pred test_several(int::in, io::di, io::uo) is det.
+
+test_several(S, !IO) :-
+ solutions(several_unknown(S), Solns),
+ io.format("several %d -> ", [i(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test_several_known(int::in, io::di, io::uo) is det.
+
+test_several_known(S, !IO) :-
+ solutions(several_known(S), Solns),
+ io.format("several known %d -> ", [i(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test_several_nested(int::in, io::di, io::uo) is det.
+
+test_several_nested(S, !IO) :-
+ solutions(several_nested(S), Solns),
+ io.format("several nested %d -> ", [i(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred jump(int::in, int::in, int::out) is semidet.
+
+jump(S, N0, N) :-
+ (
+ S = 1,
+ N = N0 + 1
+ ;
+ S = 2,
+ N = N0 + 2
+ ;
+ ( S = 11
+ ; S = 12
+ ),
+ N = 11
+ ;
+ ( S = 21
+ ; S = 22
+ ),
+ N = N0 + 12
+ ;
+ ( S = 31
+ ; S = 34
+ ; S = 35
+ ),
+ N = 13
+ ;
+ S = 77,
+ N = 21
+ ;
+ S = 78,
+ N = 22
+ ;
+ S = 79,
+ N = 23
+ ;
+ S = 87,
+ N = 24
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- inst aa_bb
+ ---> 11 ; 22.
+
+:- pred one(int, int).
+:- mode one(in(aa_bb), out) is det.
+:- mode one(in, out) is semidet.
+
+one(S, N) :-
+ (
+ S = 1,
+ N = 1
+ ;
+ S = 2,
+ N = 2
+ ;
+ ( S = 11
+ ; S = 12
+ ),
+ N = 11
+ ;
+ ( S = 21
+ ; S = 22
+ ),
+ N = 12
+ ;
+ ( S = 31
+ ; S = 34
+ ; S = 35
+ ),
+ N = 13
+ ;
+ S = 77,
+ N = 21
+ ;
+ S = 78,
+ N = 22
+ ;
+ S = 79,
+ N = 23
+ ;
+ S = 87,
+ N = 24
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred several_unknown(int::in, int::out) is nondet.
+
+several_unknown(S, N) :-
+ several(S, N).
+
+:- pred several_known(int::in, int::out) is nondet.
+
+several_known(S, N) :-
+ ( S = 11
+ ; S = 22
+ ),
+ several(S, N).
+
+:- pred several(int, int).
+:- mode several(in(aa_bb), out) is multi.
+:- mode several(in, out) is nondet.
+
+several(S, N) :-
+ (
+ S = 1,
+ N = 1
+ ;
+ S = 2,
+ N = 2
+ ;
+ ( S = 11
+ ; S = 12
+ ),
+ ( N = 11
+ ; N = 12
+ )
+ ;
+ ( S = 21
+ ; S = 22
+ ),
+ ( N = 13
+ ; N = 14
+ ; N = 15
+ )
+ ;
+ ( S = 31
+ ; S = 32
+ ; S = 34
+ ; S = 35
+ ),
+ N = 16
+ ;
+ S = 77,
+ N = 21
+ ;
+ S = 78,
+ N = 22
+ ;
+ S = 79,
+ N = 23
+ ;
+ S = 87,
+ ( N = 24
+ ; N = 25
+ ; N = 26
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred several_nested(int::in, int::out) is nondet.
+
+several_nested(S0, R) :-
+ (
+ S = S0
+ ;
+ ( S0 < 10 ->
+ S = 10 + S0
+ ;
+ S = 100 + S0
+ )
+ ),
+ (
+ S = 1,
+ N = 1
+ ;
+ S = 3,
+ N = 2
+ ;
+ ( S = 11
+ ; S = 12
+ ),
+ ( N = 11
+ ; N = 12
+ )
+ ;
+ ( S = 21
+ ; S = 22
+ ),
+ ( N = 13
+ ; N = 14
+ ; N = 15
+ )
+ ;
+ ( S = 31
+ ; S = 32
+ ; S = 34
+ ; S = 35
+ ),
+ N = 16
+ ;
+ S = 77,
+ N = 21
+ ;
+ S = 78,
+ N = 22
+ ;
+ S = 79,
+ N = 23
+ ;
+ S = 87,
+ ( N = 24
+ ; N = 25
+ ; N = 26
+ )
+ ),
+ (
+ S0 = 1,
+ M = 1
+ ;
+ S0 = 2,
+ M = 2
+ ;
+ ( S0 = 11
+ ; S0 = 12
+ ),
+ ( M = 11
+ ; M = 12
+ )
+ ;
+ ( S0 = 21
+ ; S0 = 22
+ ),
+ ( M = 13
+ ; M = 14
+ ; M = 15
+ )
+ ;
+ ( S0 = 31
+ ; S0 = 32
+ ; S0 = 34
+ ; S0 = 35
+ ),
+ M = 16
+ ;
+ S0 = 77,
+ M = 21
+ ;
+ S0 = 78,
+ M = 22
+ ;
+ S0 = 79,
+ M = 23
+ ;
+ S0 = 87,
+ ( M = 24
+ ; M = 25
+ ; M = 26
+ )
+ ),
+ R = 1000 * N + M.
Index: tests/hard_coded/lookup_disj.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/lookup_disj.exp,v
retrieving revision 1.1
diff -u -b -r1.1 lookup_disj.exp
--- tests/hard_coded/lookup_disj.exp 11 Dec 2006 04:10:46 -0000 1.1
+++ tests/hard_coded/lookup_disj.exp 31 Oct 2010 06:50:32 -0000
@@ -1,10 +1,60 @@
-peek 1
-peek 2
-peek 3
-peek 4
-peek 5
-solution 1.10 - one, 11, a
-solution 2.20 - two, 12, b
-solution 3.30 - three, 13, c
-solution 4.40 - four, 14, f(a)
-solution 5.50 - five, 15, g(a)
+peek p 1
+peek p 2
+peek p 3
+peek p 4
+peek p 5
+p soln 1.10 - one, 11, a
+p soln 2.20 - two, 12, b
+p soln 3.30 - three, 13, c
+p soln 4.40 - four, 14, f(a)
+p soln 5.50 - five, 15, g(a)
+peek q 1 11
+peek q 1 22
+peek q 1 33
+peek q 1 44
+peek q 1 55
+peek q 2 11
+peek q 2 22
+peek q 2 33
+peek q 2 44
+peek q 2 55
+peek q 3 11
+peek q 3 22
+peek q 3 33
+peek q 3 44
+peek q 3 55
+peek q 4 11
+peek q 4 22
+peek q 4 33
+peek q 4 44
+peek q 4 55
+peek q 5 11
+peek q 5 22
+peek q 5 33
+peek q 5 44
+peek q 5 55
+q soln 1.10 - one, 11, a, 111, a
+q soln 1.10 - one, 11, a, 122, b
+q soln 1.10 - one, 11, a, 133, c
+q soln 1.10 - one, 11, a, 144, f(a)
+q soln 1.10 - one, 11, a, 155, g(a)
+q soln 2.20 - two, 12, b, 111, a
+q soln 2.20 - two, 12, b, 122, b
+q soln 2.20 - two, 12, b, 133, c
+q soln 2.20 - two, 12, b, 144, f(a)
+q soln 2.20 - two, 12, b, 155, g(a)
+q soln 3.30 - three, 13, c, 111, a
+q soln 3.30 - three, 13, c, 122, b
+q soln 3.30 - three, 13, c, 133, c
+q soln 3.30 - three, 13, c, 144, f(a)
+q soln 3.30 - three, 13, c, 155, g(a)
+q soln 4.40 - four, 14, f(a), 111, a
+q soln 4.40 - four, 14, f(a), 122, b
+q soln 4.40 - four, 14, f(a), 133, c
+q soln 4.40 - four, 14, f(a), 144, f(a)
+q soln 4.40 - four, 14, f(a), 155, g(a)
+q soln 5.50 - five, 15, g(a), 111, a
+q soln 5.50 - five, 15, g(a), 122, b
+q soln 5.50 - five, 15, g(a), 133, c
+q soln 5.50 - five, 15, g(a), 144, f(a)
+q soln 5.50 - five, 15, g(a), 155, g(a)
Index: tests/hard_coded/lookup_disj.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/lookup_disj.m,v
retrieving revision 1.3
diff -u -b -r1.3 lookup_disj.m
--- tests/hard_coded/lookup_disj.m 6 Aug 2010 06:26:29 -0000 1.3
+++ tests/hard_coded/lookup_disj.m 31 Oct 2010 06:49:37 -0000
@@ -17,8 +17,10 @@
:- import_module string.
main(!IO) :-
- solutions(p, Solns),
- list.foldl(write_solution, Solns, !IO).
+ solutions(test_p, PSolns),
+ list.foldl(write_p_solution, PSolns, !IO),
+ solutions(test_q, QSolns),
+ list.foldl(write_q_solution, QSolns, !IO).
:- type t
---> a
@@ -27,42 +29,94 @@
; f(t)
; g(t).
-:- type soln
- ---> soln(
+:- type p_soln
+ ---> p_soln(
pair(float, string),
int,
t
).
-:- pred p(soln::out) is multi.
+:- type q_soln
+ ---> q_soln(
+ pair(float, string),
+ int,
+ t,
+ int,
+ t
+ ).
+
+:- pred test_p(p_soln::out) is multi.
-p(Soln) :-
- q(Pair, Int0, T),
- peek_at_solution(Int0, Int),
- Soln = soln(Pair, Int, T).
+test_p(Soln) :-
+ p(Pair, Int0, T),
+ peek_at_p_solution(Int0, Int),
+ Soln = p_soln(Pair, Int, T).
+
+:- pred test_q(q_soln::out) is multi.
+
+test_q(Soln) :-
+ q(Pair, IntA0, TA, IntB0, TB),
+ peek_at_q_solution(IntA0, IntA, IntB0, IntB),
+ Soln = q_soln(Pair, IntA, TA, IntB, TB).
+
+:- pred p(pair(float, string)::out, int::out, t::out) is multi.
+
+p(A, B, C) :-
+ ( A = 1.1 - "one", B = 1, C = a
+ ; A = 2.2 - "two", B = 2, C = b
+ ; A = 3.3 - "three", B = 3, C = c
+ ; A = 4.4 - "four", B = 4, C = f(a)
+ ; A = 5.5 - "five", B = 5, C = g(a)
+ ).
-:- pred q(pair(float, string)::out, int::out, t::out) is multi.
+:- pred q(pair(float, string)::out, int::out, t::out, int::out, t::out)
+ is multi.
-q(1.1 - "one", 1, a).
-q(2.2 - "two", 2, b).
-q(3.3 - "three", 3, c).
-q(4.4 - "four", 4, f(a)).
-q(5.5 - "five", 5, g(a)).
+q(A, B, C, D, E) :-
+ ( A = 1.1 - "one", B = 1, C = a
+ ; A = 2.2 - "two", B = 2, C = b
+ ; A = 3.3 - "three", B = 3, C = c
+ ; A = 4.4 - "four", B = 4, C = f(a)
+ ; A = 5.5 - "five", B = 5, C = g(a)
+ ),
+ ( D = 11, E = a
+ ; D = 22, E = b
+ ; D = 33, E = c
+ ; D = 44, E = f(a)
+ ; D = 55, E = g(a)
+ ).
-:- pred peek_at_solution(int::in, int::out) is det.
+:- pred peek_at_p_solution(int::in, int::out) is det.
-peek_at_solution(Int0, Int) :-
+peek_at_p_solution(Int0, Int) :-
trace [io(!IO)] (
- io.write_string("peek ", !IO),
- io.write_int(Int0, !IO),
- io.nl(!IO)
+ io.format("peek p %d\n", [i(Int0)], !IO)
),
Int = Int0 + 10.
-:- pred write_solution(soln::in, io::di, io::uo) is det.
+:- pred peek_at_q_solution(int::in, int::out, int::in, int::out) is det.
+
+peek_at_q_solution(IntA0, IntA, IntB0, IntB) :-
+ trace [io(!IO)] (
+ io.format("peek q %d %d\n", [i(IntA0), i(IntB0)], !IO)
+ ),
+ IntA = IntA0 + 10,
+ IntB = IntB0 + 100.
+
+:- pred write_p_solution(p_soln::in, io::di, io::uo) is det.
-write_solution(Soln, !IO) :-
- Soln = soln(Float - Str, Int, T),
- io.format("solution %.2f - %5s, %d, ", [f(Float), s(Str), i(Int)], !IO),
+write_p_solution(Soln, !IO) :-
+ Soln = p_soln(Float - Str, Int, T),
+ io.format("p soln %.2f - %5s, %d, ", [f(Float), s(Str), i(Int)], !IO),
io.write(T, !IO),
io.nl(!IO).
+
+:- pred write_q_solution(q_soln::in, io::di, io::uo) is det.
+
+write_q_solution(Soln, !IO) :-
+ Soln = q_soln(Float - Str, IntA, TA, IntB, TB),
+ io.format("q soln %.2f - %5s, %d, ", [f(Float), s(Str), i(IntA)], !IO),
+ io.write(TA, !IO),
+ io.format(", %d, ", [i(IntB)], !IO),
+ io.write(TB, !IO),
+ io.nl(!IO).
Index: tests/hard_coded/string_switch.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/string_switch.exp,v
retrieving revision 1.1
diff -u -b -r1.1 string_switch.exp
--- tests/hard_coded/string_switch.exp 25 Aug 2009 23:47:00 -0000 1.1
+++ tests/hard_coded/string_switch.exp 22 Oct 2010 03:30:56 -0000
@@ -1,12 +1,72 @@
-a -> 1
-b -> 2
-c failed
-aa -> 11
-ab -> 11
-ac failed
-ba -> 12
-bb -> 12
-bc failed
-ca -> 13
-cb failed
-cc failed
+jump a -> 51
+jump b -> 52
+jump c failed
+jump aa -> 11
+jump ab -> 11
+jump ac failed
+jump ba -> 62
+jump bb -> 62
+jump bc failed
+jump ca -> 13
+jump cb failed
+jump cc failed
+one a -> 1
+one b -> 2
+one c failed
+one aa -> 11
+one ab -> 11
+one ac failed
+one ba -> 12
+one bb -> 12
+one bc failed
+one ca -> 13
+one cb failed
+one cc failed
+one known a failed
+one known b failed
+one known c failed
+one known aa -> 11
+one known ab failed
+one known ac failed
+one known ba failed
+one known bb -> 12
+one known bc failed
+one known ca failed
+one known cb failed
+one known cc failed
+several a -> [1]
+several b -> [2]
+several c -> []
+several aa -> [11, 12]
+several ab -> [11, 12]
+several ac -> []
+several ba -> [13, 14, 15]
+several bb -> [13, 14, 15]
+several bc -> []
+several ca -> [16]
+several cb -> [16]
+several cc -> []
+several known a -> []
+several known b -> []
+several known c -> []
+several known aa -> [11, 12]
+several known ab -> []
+several known ac -> []
+several known ba -> []
+several known bb -> [13, 14, 15]
+several known bc -> []
+several known ca -> []
+several known cb -> []
+several known cc -> []
+several nested a -> [1001, 11001, 12001]
+several nested b -> [2002, 11002, 12002]
+several nested c -> []
+several nested aa -> [11011, 11012, 12011, 12012]
+several nested ab -> [11011, 11012, 12011, 12012]
+several nested ac -> []
+several nested ba -> [13013, 13014, 13015, 14013, 14014, 14015, 15013, 15014, 15015]
+several nested bb -> [13013, 13014, 13015, 14013, 14014, 14015, 15013, 15014, 15015]
+several nested bc -> []
+several nested ca -> [16016]
+several nested cb -> [16016]
+several nested cc -> []
Index: tests/hard_coded/string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/string_switch.m,v
retrieving revision 1.1
diff -u -b -r1.1 string_switch.m
--- tests/hard_coded/string_switch.m 25 Aug 2009 23:47:00 -0000 1.1
+++ tests/hard_coded/string_switch.m 22 Oct 2010 03:26:28 -0000
@@ -1,6 +1,9 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
+%
+% The code of this test is identical to the code of string_switch2 and
+% string_switch3, but we compile them with different compilation options.
:- module string_switch.
@@ -14,35 +17,139 @@
:- implementation.
+:- import_module int.
:- import_module list.
+:- import_module solutions.
:- 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)
+ Keys =
+ ["a", "b", "c",
+ "aa", "ab", "ac",
+ "ba", "bb", "bc",
+ "ca", "cb", "cc"],
+
+ % Test jump tables.
+ list.foldl(test_jump, Keys, !IO),
+
+ % Test semidet and det lookup tables.
+ list.foldl(test_one, Keys, !IO),
+ list.foldl(test_one_known, Keys, !IO),
+
+ % Test nondet and multi lookup tables.
+ list.foldl(test_several, Keys, !IO),
+ list.foldl(test_several_known, Keys, !IO),
+ list.foldl(test_several_nested, Keys, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred test_jump(string::in, io::di, io::uo) is det.
+
+test_jump(S, !IO) :-
+ ( jump(S, 50, N) ->
+ io.format("jump %s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("jump %s failed\n", [s(S)], !IO)
+ ).
+
+:- pred test_one(string::in, io::di, io::uo) is det.
+
+test_one(S, !IO) :-
+ ( one(S, N) ->
+ io.format("one %s -> %d\n", [s(S), i(N)], !IO)
;
- io.format("%s failed\n", [s(S)], !IO)
+ io.format("one %s failed\n", [s(S)], !IO)
).
-:- pred p(string::in, int::out) is semidet.
+:- pred test_one_known(string::in, io::di, io::uo) is det.
+
+test_one_known(S, !IO) :-
+ (
+ ( S = "aa"
+ ; S = "bb"
+ ),
+ one(S, N)
+ ->
+ io.format("one known %s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("one known %s failed\n", [s(S)], !IO)
+ ).
+
+:- pred test_several(string::in, io::di, io::uo) is det.
+
+test_several(S, !IO) :-
+ solutions(several_unknown(S), Solns),
+ io.format("several %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test_several_known(string::in, io::di, io::uo) is det.
+
+test_several_known(S, !IO) :-
+ solutions(several_known(S), Solns),
+ io.format("several known %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test_several_nested(string::in, io::di, io::uo) is det.
+
+test_several_nested(S, !IO) :-
+ solutions(several_nested(S), Solns),
+ io.format("several nested %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred jump(string::in, int::in, int::out) is semidet.
-p(S, N) :-
+jump(S, N0, N) :-
+ (
+ S = "a",
+ N = N0 + 1
+ ;
+ S = "b",
+ N = N0 + 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ N = 11
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ N = N0 + 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
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- inst aa_bb
+ ---> "aa" ; "bb".
+
+:- pred one(string, int).
+:- mode one(in(aa_bb), out) is det.
+:- mode one(in, out) is semidet.
+
+one(S, N) :-
(
S = "a",
N = 1
@@ -78,3 +185,168 @@
S = "xyx",
N = 24
).
+
+%-----------------------------------------------------------------------------%
+
+:- pred several_unknown(string::in, int::out) is nondet.
+
+several_unknown(S, N) :-
+ several(S, N).
+
+:- pred several_known(string::in, int::out) is nondet.
+
+several_known(S, N) :-
+ ( S = "aa"
+ ; S = "bb"
+ ),
+ several(S, N).
+
+:- pred several(string, int).
+:- mode several(in(aa_bb), out) is multi.
+:- mode several(in, out) is nondet.
+
+several(S, N) :-
+ (
+ S = "a",
+ N = 1
+ ;
+ S = "b",
+ N = 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ ( N = 11
+ ; N = 12
+ )
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ ( N = 13
+ ; N = 14
+ ; N = 15
+ )
+ ;
+ ( S = "ca"
+ ; S = "cb"
+ ; S = "cd"
+ ; S = "ce"
+ ),
+ N = 16
+ ;
+ S = "xxx",
+ N = 21
+ ;
+ S = "xxy",
+ N = 22
+ ;
+ S = "xxz",
+ N = 23
+ ;
+ S = "xyx",
+ ( N = 24
+ ; N = 25
+ ; N = 26
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred several_nested(string::in, int::out) is nondet.
+
+several_nested(S0, R) :-
+ (
+ S = S0
+ ;
+ S = "a" ++ S0
+ ),
+ (
+ S = "a",
+ N = 1
+ ;
+ S = "b",
+ N = 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ ( N = 11
+ ; N = 12
+ )
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ ( N = 13
+ ; N = 14
+ ; N = 15
+ )
+ ;
+ ( S = "ca"
+ ; S = "cb"
+ ; S = "cd"
+ ; S = "ce"
+ ),
+ N = 16
+ ;
+ S = "xxx",
+ N = 21
+ ;
+ S = "xxy",
+ N = 22
+ ;
+ S = "xxz",
+ N = 23
+ ;
+ S = "xyx",
+ ( N = 24
+ ; N = 25
+ ; N = 26
+ )
+ ),
+ (
+ S0 = "a",
+ M = 1
+ ;
+ S0 = "b",
+ M = 2
+ ;
+ ( S0 = "aa"
+ ; S0 = "ab"
+ ),
+ ( M = 11
+ ; M = 12
+ )
+ ;
+ ( S0 = "ba"
+ ; S0 = "bb"
+ ),
+ ( M = 13
+ ; M = 14
+ ; M = 15
+ )
+ ;
+ ( S0 = "ca"
+ ; S0 = "cb"
+ ; S0 = "cd"
+ ; S0 = "ce"
+ ),
+ M = 16
+ ;
+ S0 = "xxx",
+ M = 21
+ ;
+ S0 = "xxy",
+ M = 22
+ ;
+ S0 = "xxz",
+ M = 23
+ ;
+ S0 = "xyx",
+ ( M = 24
+ ; M = 25
+ ; M = 26
+ )
+ ),
+ R = 1000 * N + M.
Index: tests/hard_coded/string_switch2.exp
===================================================================
RCS file: tests/hard_coded/string_switch2.exp
diff -N tests/hard_coded/string_switch2.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_switch2.exp 22 Oct 2010 04:35:31 -0000
@@ -0,0 +1,72 @@
+jump a -> 51
+jump b -> 52
+jump c failed
+jump aa -> 11
+jump ab -> 11
+jump ac failed
+jump ba -> 62
+jump bb -> 62
+jump bc failed
+jump ca -> 13
+jump cb failed
+jump cc failed
+one a -> 1
+one b -> 2
+one c failed
+one aa -> 11
+one ab -> 11
+one ac failed
+one ba -> 12
+one bb -> 12
+one bc failed
+one ca -> 13
+one cb failed
+one cc failed
+one known a failed
+one known b failed
+one known c failed
+one known aa -> 11
+one known ab failed
+one known ac failed
+one known ba failed
+one known bb -> 12
+one known bc failed
+one known ca failed
+one known cb failed
+one known cc failed
+several a -> [1]
+several b -> [2]
+several c -> []
+several aa -> [11, 12]
+several ab -> [11, 12]
+several ac -> []
+several ba -> [13, 14, 15]
+several bb -> [13, 14, 15]
+several bc -> []
+several ca -> [16]
+several cb -> [16]
+several cc -> []
+several known a -> []
+several known b -> []
+several known c -> []
+several known aa -> [11, 12]
+several known ab -> []
+several known ac -> []
+several known ba -> []
+several known bb -> [13, 14, 15]
+several known bc -> []
+several known ca -> []
+several known cb -> []
+several known cc -> []
+several nested a -> [1001, 11001, 12001]
+several nested b -> [2002, 11002, 12002]
+several nested c -> []
+several nested aa -> [11011, 11012, 12011, 12012]
+several nested ab -> [11011, 11012, 12011, 12012]
+several nested ac -> []
+several nested ba -> [13013, 13014, 13015, 14013, 14014, 14015, 15013, 15014, 15015]
+several nested bb -> [13013, 13014, 13015, 14013, 14014, 14015, 15013, 15014, 15015]
+several nested bc -> []
+several nested ca -> [16016]
+several nested cb -> [16016]
+several nested cc -> []
Index: tests/hard_coded/string_switch2.m
===================================================================
RCS file: tests/hard_coded/string_switch2.m
diff -N tests/hard_coded/string_switch2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_switch2.m 22 Oct 2010 04:38:27 -0000
@@ -0,0 +1,352 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+%
+% The code of this test is identical to the code of string_switch and
+% string_switch3, but we compile them with different compilation options.
+
+:- module string_switch2.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module solutions.
+:- import_module string.
+
+main(!IO) :-
+ Keys =
+ ["a", "b", "c",
+ "aa", "ab", "ac",
+ "ba", "bb", "bc",
+ "ca", "cb", "cc"],
+
+ % Test jump tables.
+ list.foldl(test_jump, Keys, !IO),
+
+ % Test semidet and det lookup tables.
+ list.foldl(test_one, Keys, !IO),
+ list.foldl(test_one_known, Keys, !IO),
+
+ % Test nondet and multi lookup tables.
+ list.foldl(test_several, Keys, !IO),
+ list.foldl(test_several_known, Keys, !IO),
+ list.foldl(test_several_nested, Keys, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred test_jump(string::in, io::di, io::uo) is det.
+
+test_jump(S, !IO) :-
+ ( jump(S, 50, N) ->
+ io.format("jump %s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("jump %s failed\n", [s(S)], !IO)
+ ).
+
+:- pred test_one(string::in, io::di, io::uo) is det.
+
+test_one(S, !IO) :-
+ ( one(S, N) ->
+ io.format("one %s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("one %s failed\n", [s(S)], !IO)
+ ).
+
+:- pred test_one_known(string::in, io::di, io::uo) is det.
+
+test_one_known(S, !IO) :-
+ (
+ ( S = "aa"
+ ; S = "bb"
+ ),
+ one(S, N)
+ ->
+ io.format("one known %s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("one known %s failed\n", [s(S)], !IO)
+ ).
+
+:- pred test_several(string::in, io::di, io::uo) is det.
+
+test_several(S, !IO) :-
+ solutions(several_unknown(S), Solns),
+ io.format("several %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test_several_known(string::in, io::di, io::uo) is det.
+
+test_several_known(S, !IO) :-
+ solutions(several_known(S), Solns),
+ io.format("several known %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test_several_nested(string::in, io::di, io::uo) is det.
+
+test_several_nested(S, !IO) :-
+ solutions(several_nested(S), Solns),
+ io.format("several nested %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred jump(string::in, int::in, int::out) is semidet.
+
+jump(S, N0, N) :-
+ (
+ S = "a",
+ N = N0 + 1
+ ;
+ S = "b",
+ N = N0 + 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ N = 11
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ N = N0 + 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
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- inst aa_bb
+ ---> "aa" ; "bb".
+
+:- pred one(string, int).
+:- mode one(in(aa_bb), out) is det.
+:- mode one(in, out) is semidet.
+
+one(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
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred several_unknown(string::in, int::out) is nondet.
+
+several_unknown(S, N) :-
+ several(S, N).
+
+:- pred several_known(string::in, int::out) is nondet.
+
+several_known(S, N) :-
+ ( S = "aa"
+ ; S = "bb"
+ ),
+ several(S, N).
+
+:- pred several(string, int).
+:- mode several(in(aa_bb), out) is multi.
+:- mode several(in, out) is nondet.
+
+several(S, N) :-
+ (
+ S = "a",
+ N = 1
+ ;
+ S = "b",
+ N = 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ ( N = 11
+ ; N = 12
+ )
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ ( N = 13
+ ; N = 14
+ ; N = 15
+ )
+ ;
+ ( S = "ca"
+ ; S = "cb"
+ ; S = "cd"
+ ; S = "ce"
+ ),
+ N = 16
+ ;
+ S = "xxx",
+ N = 21
+ ;
+ S = "xxy",
+ N = 22
+ ;
+ S = "xxz",
+ N = 23
+ ;
+ S = "xyx",
+ ( N = 24
+ ; N = 25
+ ; N = 26
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred several_nested(string::in, int::out) is nondet.
+
+several_nested(S0, R) :-
+ (
+ S = S0
+ ;
+ S = "a" ++ S0
+ ),
+ (
+ S = "a",
+ N = 1
+ ;
+ S = "b",
+ N = 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ ( N = 11
+ ; N = 12
+ )
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ ( N = 13
+ ; N = 14
+ ; N = 15
+ )
+ ;
+ ( S = "ca"
+ ; S = "cb"
+ ; S = "cd"
+ ; S = "ce"
+ ),
+ N = 16
+ ;
+ S = "xxx",
+ N = 21
+ ;
+ S = "xxy",
+ N = 22
+ ;
+ S = "xxz",
+ N = 23
+ ;
+ S = "xyx",
+ ( N = 24
+ ; N = 25
+ ; N = 26
+ )
+ ),
+ (
+ S0 = "a",
+ M = 1
+ ;
+ S0 = "b",
+ M = 2
+ ;
+ ( S0 = "aa"
+ ; S0 = "ab"
+ ),
+ ( M = 11
+ ; M = 12
+ )
+ ;
+ ( S0 = "ba"
+ ; S0 = "bb"
+ ),
+ ( M = 13
+ ; M = 14
+ ; M = 15
+ )
+ ;
+ ( S0 = "ca"
+ ; S0 = "cb"
+ ; S0 = "cd"
+ ; S0 = "ce"
+ ),
+ M = 16
+ ;
+ S0 = "xxx",
+ M = 21
+ ;
+ S0 = "xxy",
+ M = 22
+ ;
+ S0 = "xxz",
+ M = 23
+ ;
+ S0 = "xyx",
+ ( M = 24
+ ; M = 25
+ ; M = 26
+ )
+ ),
+ R = 1000 * N + M.
Index: tests/hard_coded/string_switch3.exp
===================================================================
RCS file: tests/hard_coded/string_switch3.exp
diff -N tests/hard_coded/string_switch3.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_switch3.exp 22 Oct 2010 04:35:33 -0000
@@ -0,0 +1,72 @@
+jump a -> 51
+jump b -> 52
+jump c failed
+jump aa -> 11
+jump ab -> 11
+jump ac failed
+jump ba -> 62
+jump bb -> 62
+jump bc failed
+jump ca -> 13
+jump cb failed
+jump cc failed
+one a -> 1
+one b -> 2
+one c failed
+one aa -> 11
+one ab -> 11
+one ac failed
+one ba -> 12
+one bb -> 12
+one bc failed
+one ca -> 13
+one cb failed
+one cc failed
+one known a failed
+one known b failed
+one known c failed
+one known aa -> 11
+one known ab failed
+one known ac failed
+one known ba failed
+one known bb -> 12
+one known bc failed
+one known ca failed
+one known cb failed
+one known cc failed
+several a -> [1]
+several b -> [2]
+several c -> []
+several aa -> [11, 12]
+several ab -> [11, 12]
+several ac -> []
+several ba -> [13, 14, 15]
+several bb -> [13, 14, 15]
+several bc -> []
+several ca -> [16]
+several cb -> [16]
+several cc -> []
+several known a -> []
+several known b -> []
+several known c -> []
+several known aa -> [11, 12]
+several known ab -> []
+several known ac -> []
+several known ba -> []
+several known bb -> [13, 14, 15]
+several known bc -> []
+several known ca -> []
+several known cb -> []
+several known cc -> []
+several nested a -> [1001, 11001, 12001]
+several nested b -> [2002, 11002, 12002]
+several nested c -> []
+several nested aa -> [11011, 11012, 12011, 12012]
+several nested ab -> [11011, 11012, 12011, 12012]
+several nested ac -> []
+several nested ba -> [13013, 13014, 13015, 14013, 14014, 14015, 15013, 15014, 15015]
+several nested bb -> [13013, 13014, 13015, 14013, 14014, 14015, 15013, 15014, 15015]
+several nested bc -> []
+several nested ca -> [16016]
+several nested cb -> [16016]
+several nested cc -> []
Index: tests/hard_coded/string_switch3.m
===================================================================
RCS file: tests/hard_coded/string_switch3.m
diff -N tests/hard_coded/string_switch3.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/string_switch3.m 22 Oct 2010 03:26:27 -0000
@@ -0,0 +1,352 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+%
+% The code of this test is identical to the code of string_switch and
+% string_switch2, but we compile them with different compilation options.
+
+:- module string_switch3.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module solutions.
+:- import_module string.
+
+main(!IO) :-
+ Keys =
+ ["a", "b", "c",
+ "aa", "ab", "ac",
+ "ba", "bb", "bc",
+ "ca", "cb", "cc"],
+
+ % Test jump tables.
+ list.foldl(test_jump, Keys, !IO),
+
+ % Test semidet and det lookup tables.
+ list.foldl(test_one, Keys, !IO),
+ list.foldl(test_one_known, Keys, !IO),
+
+ % Test nondet and multi lookup tables.
+ list.foldl(test_several, Keys, !IO),
+ list.foldl(test_several_known, Keys, !IO),
+ list.foldl(test_several_nested, Keys, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred test_jump(string::in, io::di, io::uo) is det.
+
+test_jump(S, !IO) :-
+ ( jump(S, 50, N) ->
+ io.format("jump %s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("jump %s failed\n", [s(S)], !IO)
+ ).
+
+:- pred test_one(string::in, io::di, io::uo) is det.
+
+test_one(S, !IO) :-
+ ( one(S, N) ->
+ io.format("one %s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("one %s failed\n", [s(S)], !IO)
+ ).
+
+:- pred test_one_known(string::in, io::di, io::uo) is det.
+
+test_one_known(S, !IO) :-
+ (
+ ( S = "aa"
+ ; S = "bb"
+ ),
+ one(S, N)
+ ->
+ io.format("one known %s -> %d\n", [s(S), i(N)], !IO)
+ ;
+ io.format("one known %s failed\n", [s(S)], !IO)
+ ).
+
+:- pred test_several(string::in, io::di, io::uo) is det.
+
+test_several(S, !IO) :-
+ solutions(several_unknown(S), Solns),
+ io.format("several %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test_several_known(string::in, io::di, io::uo) is det.
+
+test_several_known(S, !IO) :-
+ solutions(several_known(S), Solns),
+ io.format("several known %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test_several_nested(string::in, io::di, io::uo) is det.
+
+test_several_nested(S, !IO) :-
+ solutions(several_nested(S), Solns),
+ io.format("several nested %s -> ", [s(S)], !IO),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred jump(string::in, int::in, int::out) is semidet.
+
+jump(S, N0, N) :-
+ (
+ S = "a",
+ N = N0 + 1
+ ;
+ S = "b",
+ N = N0 + 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ N = 11
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ N = N0 + 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
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- inst aa_bb
+ ---> "aa" ; "bb".
+
+:- pred one(string, int).
+:- mode one(in(aa_bb), out) is det.
+:- mode one(in, out) is semidet.
+
+one(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
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred several_unknown(string::in, int::out) is nondet.
+
+several_unknown(S, N) :-
+ several(S, N).
+
+:- pred several_known(string::in, int::out) is nondet.
+
+several_known(S, N) :-
+ ( S = "aa"
+ ; S = "bb"
+ ),
+ several(S, N).
+
+:- pred several(string, int).
+:- mode several(in(aa_bb), out) is multi.
+:- mode several(in, out) is nondet.
+
+several(S, N) :-
+ (
+ S = "a",
+ N = 1
+ ;
+ S = "b",
+ N = 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ ( N = 11
+ ; N = 12
+ )
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ ( N = 13
+ ; N = 14
+ ; N = 15
+ )
+ ;
+ ( S = "ca"
+ ; S = "cb"
+ ; S = "cd"
+ ; S = "ce"
+ ),
+ N = 16
+ ;
+ S = "xxx",
+ N = 21
+ ;
+ S = "xxy",
+ N = 22
+ ;
+ S = "xxz",
+ N = 23
+ ;
+ S = "xyx",
+ ( N = 24
+ ; N = 25
+ ; N = 26
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred several_nested(string::in, int::out) is nondet.
+
+several_nested(S0, R) :-
+ (
+ S = S0
+ ;
+ S = "a" ++ S0
+ ),
+ (
+ S = "a",
+ N = 1
+ ;
+ S = "b",
+ N = 2
+ ;
+ ( S = "aa"
+ ; S = "ab"
+ ),
+ ( N = 11
+ ; N = 12
+ )
+ ;
+ ( S = "ba"
+ ; S = "bb"
+ ),
+ ( N = 13
+ ; N = 14
+ ; N = 15
+ )
+ ;
+ ( S = "ca"
+ ; S = "cb"
+ ; S = "cd"
+ ; S = "ce"
+ ),
+ N = 16
+ ;
+ S = "xxx",
+ N = 21
+ ;
+ S = "xxy",
+ N = 22
+ ;
+ S = "xxz",
+ N = 23
+ ;
+ S = "xyx",
+ ( N = 24
+ ; N = 25
+ ; N = 26
+ )
+ ),
+ (
+ S0 = "a",
+ M = 1
+ ;
+ S0 = "b",
+ M = 2
+ ;
+ ( S0 = "aa"
+ ; S0 = "ab"
+ ),
+ ( M = 11
+ ; M = 12
+ )
+ ;
+ ( S0 = "ba"
+ ; S0 = "bb"
+ ),
+ ( M = 13
+ ; M = 14
+ ; M = 15
+ )
+ ;
+ ( S0 = "ca"
+ ; S0 = "cb"
+ ; S0 = "cd"
+ ; S0 = "ce"
+ ),
+ M = 16
+ ;
+ S0 = "xxx",
+ M = 21
+ ;
+ S0 = "xxy",
+ M = 22
+ ;
+ S0 = "xxz",
+ M = 23
+ ;
+ S0 = "xyx",
+ ( M = 24
+ ; M = 25
+ ; M = 26
+ )
+ ),
+ R = 1000 * N + M.
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