[m-rev.] for post-commit review: switches on strings without gotos

Zoltan Somogyi zs at csse.unimelb.edu.au
Mon Aug 15 16:21:32 AEST 2011


I would like someone who uses the Java backend (wangp?) to tell me
whether this diff works for Java. I cannot test it myself, since the
compiler does not bootcheck in Java grade (at least not when using mmake).

Zoltan.

Allow the MLDS backend to generate indexing switches (switches implemented
more efficiently than just a if-then-else chain) for strings even if the target
language does not support gotos.

Previously, we use always used gotos to break out of search loops
after we found a match:

    do {
        if (we have a match) {
            ... handle the match ...
            goto end
        } else {
            ... handle nonmatches ...
        }
    } while (loop should continue);
    maybe some code to handle the failure of the search
end:

Now, if the "maybe some code" is empty, we prefer to use break statements
if the target language supports this:

    do {
        if (we have a match) {
            ... handle the match ...
            break;
        } else {
            ... handle nonmatches ...
        }
    } while (loop should continue)

If we cannot use either gotos or break statements, we instead use
a boolean variable named "stop_loop":

    stop_loop = 0;
    do {
        if (we have a match) {
            ... handle the match ...
            stop_loop = 1;
        } else {
            ... handle nonmatches ...
        }
    } while (stop_loop == 0 && loop should continue)
    if (stop_loop == 0) {
    	maybe some code to handle the failure of the search
    }

We omit the final if statement if the then-part would be empty.

The break method generates the smallest code, followed by the goto code.
I don't have information on speed, since we don't have a benchmark that
runs long enough, and the compiler itself does not spend any significant
amount of time on string switches. Probably the break method is also the
fastest, simply because it leaves the code looking most like normal C code.
(Some optimizations are harder to apply to code containing gotos, and some
optimizer writers do not bother.)

For C, we now normally prefer to generate code using the second method
(breaks), if we can, though normally "maybe some code" is not empty,
in which case we use the first method (goto).

However, if the value of the --experiment option is set to "use_stop_loop",
we always use the third method, and if it is set to "use_end_label", we always
use the first, even when we could use the second. This allow us to test all
three approaches using the C back end.

With backends that support neither gotos nor break, we always use the third
method (stop_loop).

With backends that don't support gotos but do support breaks, we also always
use the third method. This is because trying to use the second method would
require us to commit to not creating the stop_loop variable BEFORE we know
that the "maybe some code to handle the failure of the search" is empty,
and if it isn't empty, then we don't have the goto method to fall back on.

compiler/ml_string_switch.m:
	Make the change described above. Where possible, make the required
	change not to the original code, but to a version in which common
	parts have been factored out. (Previously, the duplicated code was
	small; now, it would be big.)

compiler/ml_target_util.m:
	A new module containing existing functions that test various properties
	of the target language. Keeping some of those functions in their
	original modules would have introduced a circular dependency.

compiler/ml_switch_gen.m:
	Enable the new functionality by removing the tests that previously
	prevented the compiler from using indexing switches on strings
	if the target language did not support gotos.

	Remove the code moved to ml_target_util.m.

compiler/ml_optimize.m:
compiler/ml_unify_gen.m:
	Remove the code moved to ml_target_util.m.

compiler/ml_backend.m:
compiler/notes/compiler_design.m:
	Add the new module.

compiler/ml_proc_gen.m:
	Delete a predicate that hasn't been used for a long time.

tools/makebatch:
	Fix an old pair of typos.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/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
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/ml_backend.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_backend.m,v
retrieving revision 1.18
diff -u -b -r1.18 ml_backend.m
--- compiler/ml_backend.m	16 Sep 2010 00:39:04 -0000	1.18
+++ compiler/ml_backend.m	14 Aug 2011 10:07:26 -0000
@@ -30,6 +30,7 @@
 %-----------------------------------------------------------------------------%
 
 :- include_module mlds.
+:- include_module ml_target_util.
 :- include_module ml_util.
 
 % Phase 4-ml: MLDS-specific HLDS to HLDS transformations and annotations.
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.72
diff -u -b -r1.72 ml_optimize.m
--- compiler/ml_optimize.m	1 Aug 2011 03:30:26 -0000	1.72
+++ compiler/ml_optimize.m	14 Aug 2011 10:26:27 -0000
@@ -47,6 +47,7 @@
 :- import_module libs.options.
 :- import_module mdbcomp.prim_data.
 :- import_module ml_backend.ml_code_util.
+:- import_module ml_backend.ml_target_util.
 :- import_module ml_backend.ml_util.
 
 :- import_module bool.
@@ -304,13 +305,17 @@
 :- func tailcall_loop_top(globals) = mlds_goto_target.
 
 tailcall_loop_top(Globals) = Target :-
-    ( target_supports_break_and_continue(Globals) ->
+    SupportsBreakContinue =
+        globals_target_supports_break_and_continue(Globals),
+    (
+        SupportsBreakContinue = yes,
         % The function body has been wrapped inside
         % `while (true) { ... break; }', and so to branch to the top of the
         % function, we just do a `continue' which will continue the next
         % iteration of the loop.
         Target = goto_continue
     ;
+        SupportsBreakContinue = no,
         % A label has been inserted at the start of the function, and so to
         % branch to the top of the function, we just branch to that label.
         Target = goto_label(tailcall_loop_label_name)
@@ -438,7 +443,10 @@
         % or using a label and goto.  We prefer to use the former, if possible,
         % since it is a higher-level construct that may help the back-end
         % compiler's optimizer.
-        ( target_supports_break_and_continue(Globals) ->
+        SupportsBreakContinue =
+            globals_target_supports_break_and_continue(Globals),
+        (
+            SupportsBreakContinue = yes,
             % Wrap a while loop around the function body:
             %   while (true) {
             %       /* tailcall optimized into a loop */
@@ -454,6 +462,7 @@
                     statement(ml_stmt_goto(goto_break), Context)]),
                 Context))
         ;
+            SupportsBreakContinue = no,
             % Add a loop_top label at the start of the function
             % body:
             %   {
@@ -473,26 +482,6 @@
     ),
     Statement = statement(Stmt, Context).
 
-:- pred target_supports_break_and_continue(globals::in) is semidet.
-
-target_supports_break_and_continue(Globals) :-
-    globals.get_target(Globals, Target),
-    target_supports_break_and_continue_2(Target) = yes.
-
-:- func target_supports_break_and_continue_2(compilation_target) = bool.
-
-target_supports_break_and_continue_2(target_c) = yes.
-target_supports_break_and_continue_2(target_asm) = no.
-    % asm means via gnu back-end
-target_supports_break_and_continue_2(target_il) = no.
-target_supports_break_and_continue_2(target_csharp) = yes.
-target_supports_break_and_continue_2(target_java) = yes.
-% target_supports_break_and_continue_2(target_c_sharp) = yes.
-target_supports_break_and_continue_2(target_x86_64) = _ :-
-    unexpected($module, $pred, "target x86_64 with --high-level-code").
-target_supports_break_and_continue_2(target_erlang) = _ :-
-    unexpected($module, $pred, "target erlang").
-
 %-----------------------------------------------------------------------------%
 
     % If the list of statements contains a block with no local variables,
Index: compiler/ml_proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_proc_gen.m,v
retrieving revision 1.15
diff -u -b -r1.15 ml_proc_gen.m
--- compiler/ml_proc_gen.m	11 Aug 2011 23:18:59 -0000	1.15
+++ compiler/ml_proc_gen.m	14 Aug 2011 09:59:17 -0000
@@ -569,29 +569,6 @@
     ml_initial_cont(!.Info, OutputVarLvals, OutputVarTypes, InitialCont),
     ml_gen_info_push_success_cont(InitialCont, !Info).
 
-    % Generate MLDS definitions for all the local variables in a function.
-    %
-    % Note that this function generates all the local variables at the
-    % top of the function. It might be a better idea to instead generate
-    % local declarations for all the variables used in each sub-goal.
-    %
-:- pred ml_gen_all_local_var_decls(hlds_goal::in, prog_varset::in,
-    vartypes::in, list(prog_var)::in, list(mlds_defn)::out,
-    ml_gen_info::in, ml_gen_info::out) is det.
-
-ml_gen_all_local_var_decls(Goal, VarSet, VarTypes, HeadVars, MLDS_LocalVars,
-        !Info) :-
-    Goal = hlds_goal(_, GoalInfo),
-    Context = goal_info_get_context(GoalInfo),
-    goal_util.goal_vars(Goal, AllVarsSet),
-    set_of_var.delete_list(HeadVars, AllVarsSet, LocalVarsSet),
-    set_of_var.to_sorted_list(LocalVarsSet, LocalVars),
-    ml_gen_local_var_decls(VarSet, VarTypes, Context, LocalVars,
-        MLDS_LocalVars0, !Info),
-    MLDS_Context = mlds_make_context(Context),
-    MLDS_SucceededVar = ml_gen_succeeded_var_decl(MLDS_Context),
-    MLDS_LocalVars = [MLDS_SucceededVar | MLDS_LocalVars0].
-
     % Generate the code for a procedure body.
     %
 :- pred ml_gen_proc_body(code_model::in, list(prog_var)::in,
Index: compiler/ml_simplify_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_simplify_switch.m,v
retrieving revision 1.35
diff -u -b -r1.35 ml_simplify_switch.m
--- compiler/ml_simplify_switch.m	26 Jul 2011 00:25:22 -0000	1.35
+++ compiler/ml_simplify_switch.m	14 Aug 2011 10:27:55 -0000
@@ -42,6 +42,7 @@
 :- import_module libs.options.
 :- import_module ml_backend.ml_code_util.
 :- import_module ml_backend.ml_switch_gen.
+:- import_module ml_backend.ml_target_util.
 :- import_module parse_tree.prog_type.
 
 :- import_module bool.
@@ -65,9 +66,9 @@
 
         % Does the target want us to convert dense int switches
         % into computed gotos?
-        target_supports_computed_goto(Globals),
+        globals_target_supports_computed_goto(Globals) = yes,
         \+ (
-            target_supports_int_switch(Globals),
+            globals_target_supports_int_switch(Globals) = yes,
             globals.lookup_bool_option(Globals, prefer_switch, yes)
         ),
 
@@ -95,7 +96,7 @@
         Stmt0 = ml_stmt_switch(Type, Rval, _Range, Cases, Default),
         is_integral_type(Type) = yes,
         \+ (
-            target_supports_int_switch(Globals),
+            globals_target_supports_int_switch(Globals) = yes,
             globals.lookup_bool_option(Globals, prefer_switch, yes)
         )
     ->
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.55
diff -u -b -r1.55 ml_string_switch.m
--- compiler/ml_string_switch.m	9 Aug 2011 05:34:34 -0000	1.55
+++ compiler/ml_string_switch.m	15 Aug 2011 03:02:49 -0000
@@ -65,14 +65,17 @@
 :- import_module hlds.hlds_data.
 :- import_module hlds.hlds_module.
 :- import_module libs.globals.
+:- import_module libs.options.
 :- import_module ml_backend.ml_code_gen.
 :- import_module ml_backend.ml_code_util.
 :- import_module ml_backend.ml_global_data.
 :- import_module ml_backend.ml_simplify_switch.
+:- import_module ml_backend.ml_target_util.
 :- import_module ml_backend.ml_util.
 :- import_module parse_tree.builtin_lib_types.
 
 :- import_module assoc_list.
+:- import_module bool.
 :- import_module cord.
 :- import_module int.
 :- import_module map.
@@ -87,14 +90,7 @@
 
 ml_generate_string_hash_jump_switch(Cases, Var, CodeModel, CanFail, Context,
         Defns, Statements, !Info) :-
-    ml_gen_string_hash_switch_search_vars(Context, Var, HashSearchInfo, !Info),
-    HashSearchInfo = ml_hash_search_info(MLDS_Context, _VarRval,
-        SlotVarLval, _StringVarLval, Defns),
-
-    ml_gen_new_label(EndLabel, !Info),
-    GotoEndStatement =
-        statement(ml_stmt_goto(goto_label(EndLabel)), MLDS_Context),
-
+    MLDS_Context = mlds_make_context(Context),
     gen_tagged_case_codes_for_string_switch(CodeModel, Cases, StrsCaseNums,
         map.init, CodeMap, !Info),
 
@@ -103,10 +99,6 @@
         TableSize, HashSlotMap, HashOp, NumCollisions),
     HashMask = TableSize - 1,
 
-    % Generate the code for when the hash lookup fails.
-    ml_gen_maybe_switch_failure(CodeModel, CanFail, Context, MLDS_Context,
-        FailStatements, !Info),
-
     ml_gen_info_get_module_info(!.Info, ModuleInfo),
     module_info_get_name(ModuleInfo, ModuleName),
     MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
@@ -116,11 +108,19 @@
     MLDS_IntType = mlds_native_int_type,
 
     ( NumCollisions = 0 ->
-        MLDS_ArgTypes = [MLDS_StringType]
+        MLDS_ArgTypes = [MLDS_StringType],
+        LoopPresent = no
     ;
-        MLDS_ArgTypes = [MLDS_StringType, MLDS_IntType]
+        MLDS_ArgTypes = [MLDS_StringType, MLDS_IntType],
+        LoopPresent = yes
     ),
 
+    ml_gen_string_hash_switch_search_vars(CodeModel, CanFail, LoopPresent,
+        Context, MLDS_Context, Var, HashSearchInfo, !Info),
+    HashSearchInfo = ml_hash_search_info(_CodeModel, _LoopPresent,
+        _Context, _VarRval, SlotVarLval, _StringVarLval,
+        _MaybeStopLoopLval, _FailStatements, Defns),
+
     ml_gen_info_get_global_data(!.Info, GlobalData0),
     ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target,
         MLDS_ArgTypes, StructTypeNum, StructType, FieldIds,
@@ -161,28 +161,16 @@
     ml_simplify_switch(SwitchStmt0, MLDS_Context, SwitchStatement, !Info),
 
     FoundMatchComment = "we found a match; dispatch to the corresponding code",
-    FoundMatchStatement = statement(
-        ml_stmt_block([], [
-            statement(ml_stmt_atomic(comment(FoundMatchComment)),
-                MLDS_Context),
-            SwitchStatement,
-            GotoEndStatement
-        ]),
-        MLDS_Context),
+    FoundMatchStatements = [
+        statement(ml_stmt_atomic(comment(FoundMatchComment)), MLDS_Context),
+        SwitchStatement
+    ],
 
     InitialComment = "hashed string jump switch",
-    ml_gen_string_hash_switch_search(InitialComment, HashSearchInfo, HashOp,
-        VectorCommon, StructType, StringFieldId, MaybeNextSlotFieldId,
-        HashMask, FoundMatchStatement, HashLookupStatements),
-
-    EndLabelStatement = statement(ml_stmt_label(EndLabel), MLDS_Context),
-    EndComment =
-        statement(ml_stmt_atomic(comment("end of hashed string switch")),
-            MLDS_Context),
-
-    % Collect all the generated code fragments together.
-    Statements = HashLookupStatements ++ FailStatements ++
-        [EndLabelStatement, EndComment].
+    ml_gen_string_hash_switch_search(MLDS_Context, InitialComment,
+        HashSearchInfo, HashOp, VectorCommon, StructType,
+        StringFieldId, MaybeNextSlotFieldId, HashMask,
+        [], FoundMatchStatements, Statements, !Info).
 
 %-----------------------------------------------------------------------------%
 
@@ -354,51 +342,36 @@
 
 ml_generate_string_hash_lookup_switch(Var, LookupSwitchInfo, CodeModel,
         CanFail, Context, Defns, Statements, !Info) :-
-    ml_gen_string_hash_switch_search_vars(Context, Var, HashSearchInfo, !Info),
-    Defns = HashSearchInfo ^ mhsi_defns,
-    MLDS_Context = HashSearchInfo ^ mhsi_mlds_context,
-
-    % Generate the code for when the lookup fails.
-    ml_gen_maybe_switch_failure(CodeModel, CanFail, Context, MLDS_Context,
-        FailStatements, !Info),
-
     LookupSwitchInfo = ml_lookup_switch_info(CaseConsts, OutVars, OutTypes),
     (
-        CaseConsts = all_one_soln(CaseValuePairs),
-        ml_generate_string_hash_simple_lookup_switch(CodeModel, CaseValuePairs,
-            OutVars, OutTypes, Context, HashSearchInfo,
-            FailStatements, Statements, !Info)
+        CaseConsts = all_one_soln(CaseValues),
+        ml_generate_string_hash_simple_lookup_switch(Var,
+            CodeModel, CanFail, CaseValues, OutVars, OutTypes, Context,
+            Defns, Statements, !Info)
     ;
         CaseConsts = some_several_solns(CaseSolns, _Unit),
         expect(unify(CodeModel, model_non), $module, $pred,
             "CodeModel != model_non"),
-        ml_generate_string_hash_several_soln_lookup_switch(CaseSolns,
-            OutVars, OutTypes, Context, HashSearchInfo,
-            FailStatements, Statements, !Info)
+        ml_generate_string_hash_several_soln_lookup_switch(Var,
+            CodeModel, CanFail, CaseSolns, OutVars, OutTypes, Context,
+            Defns, Statements, !Info)
     ).
 
 %-----------------------------------------------------------------------------%
 
-:- pred ml_generate_string_hash_simple_lookup_switch(code_model::in,
+:- pred ml_generate_string_hash_simple_lookup_switch(prog_var::in,
+    code_model::in, can_fail::in,
     assoc_list(string, list(mlds_rval))::in,
-    list(prog_var)::in, list(mlds_type)::in,
-    prog_context::in, ml_hash_search_info::in,
-    list(statement)::in, list(statement)::out,
+    list(prog_var)::in, list(mlds_type)::in, prog_context::in,
+    list(mlds_defn)::out, list(statement)::out,
     ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_generate_string_hash_simple_lookup_switch(CodeModel, CaseValuePairs,
-        OutVars, OutTypes, Context, HashSearchInfo,
-        FailStatements, Statements, !Info) :-
-    HashSearchInfo = ml_hash_search_info(MLDS_Context, _VarRval,
-        SlotVarLval, _StringVarLval, _Defns),
-    SlotVarRval = ml_lval(SlotVarLval),
-
-    ml_gen_new_label(EndLabel, !Info),
-    GotoEndStatement =
-        statement(ml_stmt_goto(goto_label(EndLabel)), MLDS_Context),
+ml_generate_string_hash_simple_lookup_switch(Var, CodeModel, CanFail,
+        CaseValues, OutVars, OutTypes, Context, Defns, Statements, !Info) :-
+    MLDS_Context = mlds_make_context(Context),
 
     % Compute the hash table.
-    construct_string_hash_cases(CaseValuePairs, allow_doubling,
+    construct_string_hash_cases(CaseValues, allow_doubling,
         TableSize, HashSlotMap, HashOp, NumCollisions),
     HashMask = TableSize - 1,
 
@@ -411,11 +384,20 @@
     MLDS_IntType = mlds_native_int_type,
 
     ( NumCollisions = 0 ->
-        MLDS_ArgTypes = [MLDS_StringType | OutTypes]
+        MLDS_ArgTypes = [MLDS_StringType | OutTypes],
+        LoopPresent = no
     ;
-        MLDS_ArgTypes = [MLDS_StringType, MLDS_IntType | OutTypes]
+        MLDS_ArgTypes = [MLDS_StringType, MLDS_IntType | OutTypes],
+        LoopPresent = yes
     ),
 
+    ml_gen_string_hash_switch_search_vars(CodeModel, CanFail, LoopPresent,
+        Context, MLDS_Context, Var, HashSearchInfo, !Info),
+    HashSearchInfo = ml_hash_search_info(_CodeModel, _LoopPresent,
+        _Context, _VarRval, SlotVarLval, _StringVarLval, _MaybeStopLoopLval,
+        _FailStatements, Defns),
+    SlotVarRval = ml_lval(SlotVarLval),
+
     ml_gen_info_get_global_data(!.Info, GlobalData0),
     ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target,
         MLDS_ArgTypes, StructTypeNum, StructType, FieldIds,
@@ -461,40 +443,23 @@
 
     (
         CodeModel = model_det,
-        FoundMatchStatement = statement(
-            ml_stmt_block([],
-                [FoundMatchCommentStatement | LookupStatements] ++
-                [GotoEndStatement]
-            ),
-            MLDS_Context)
+        MatchStatements = [FoundMatchCommentStatement | LookupStatements]
     ;
         CodeModel = model_semi,
         ml_gen_set_success(!.Info, ml_const(mlconst_true), Context,
             SetSuccessTrueStatement),
-        FoundMatchStatement = statement(
-            ml_stmt_block([],
-                [FoundMatchCommentStatement | LookupStatements] ++
-                [SetSuccessTrueStatement, GotoEndStatement]
-            ),
-            MLDS_Context)
+        MatchStatements = [FoundMatchCommentStatement | LookupStatements] ++
+            [SetSuccessTrueStatement]
     ;
         CodeModel = model_non,
         unexpected($module, $pred, "model_non")
     ),
 
     InitialComment = "hashed string simple lookup switch",
-    ml_gen_string_hash_switch_search(InitialComment, HashSearchInfo, HashOp,
-        VectorCommon, StructType, StringFieldId, MaybeNextSlotFieldId,
-        HashMask, FoundMatchStatement, HashLookupStatements),
-
-    EndLabelStatement = statement(ml_stmt_label(EndLabel), MLDS_Context),
-    EndComment =
-        statement(ml_stmt_atomic(comment("end of hashed string switch")),
-            MLDS_Context),
-
-    % Collect all the generated code fragments together.
-    Statements = HashLookupStatements ++ FailStatements ++
-        [EndLabelStatement, EndComment].
+    ml_gen_string_hash_switch_search(MLDS_Context, InitialComment,
+        HashSearchInfo, HashOp, VectorCommon, StructType,
+        StringFieldId, MaybeNextSlotFieldId, HashMask,
+        [], MatchStatements, Statements, !Info).
 
 :- pred ml_gen_string_hash_simple_lookup_slots(int::in, int::in, mlds_type::in,
     map(int, string_hash_slot(list(mlds_rval)))::in, maybe(mlds_field_id)::in,
@@ -544,24 +509,20 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred ml_generate_string_hash_several_soln_lookup_switch(
+:- pred ml_generate_string_hash_several_soln_lookup_switch(prog_var::in,
+    code_model::in, can_fail::in,
     assoc_list(string, soln_consts(mlds_rval))::in,
-    list(prog_var)::in, list(mlds_type)::in,
-    prog_context::in, ml_hash_search_info::in,
-    list(statement)::in, list(statement)::out,
+    list(prog_var)::in, list(mlds_type)::in, prog_context::in,
+    list(mlds_defn)::out, list(statement)::out,
     ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_generate_string_hash_several_soln_lookup_switch(CaseSolns,
-        OutVars, OutTypes, Context, HashSearchInfo,
-        FailStatements, Statements, !Info) :-
-    HashSearchInfo = ml_hash_search_info(MLDS_Context, _VarRval,
-        SlotVarLval, _StringVarLval, _Defns),
-    SlotVarRval = ml_lval(SlotVarLval),
-
+ml_generate_string_hash_several_soln_lookup_switch(Var, CodeModel, CanFail,
+        CaseSolns, OutVars, OutTypes, Context, Defns, Statements, !Info) :-
+    MLDS_Context = mlds_make_context(Context),
     make_several_soln_lookup_vars(MLDS_Context, SeveralSolnLookupVars, !Info),
     SeveralSolnLookupVars = ml_several_soln_lookup_vars(NumLaterSolnsVarLval,
         LaterSlotVarLval, LimitVarLval,
-        LimitAssignStatement, IncrLaterSlotVarStatement, Defns),
+        LimitAssignStatement, IncrLaterSlotVarStatement, MatchDefns),
     LaterSlotVarRval = ml_lval(LaterSlotVarLval),
     LimitVarRval = ml_lval(LimitVarLval),
 
@@ -580,12 +541,21 @@
 
     ( NumCollisions = 0 ->
         FirstSolnFieldTypes = [MLDS_StringType,
-            MLDS_IntType, MLDS_IntType | OutTypes]
+            MLDS_IntType, MLDS_IntType | OutTypes],
+        LoopPresent = no
     ;
         FirstSolnFieldTypes = [MLDS_StringType, MLDS_IntType,
-            MLDS_IntType, MLDS_IntType | OutTypes]
+            MLDS_IntType, MLDS_IntType | OutTypes],
+        LoopPresent = yes
     ),
 
+    ml_gen_string_hash_switch_search_vars(CodeModel, CanFail, LoopPresent,
+        Context, MLDS_Context, Var, HashSearchInfo, !Info),
+    HashSearchInfo = ml_hash_search_info(_CodeModel, _LoopPresent,
+        _Context, _VarRval, SlotVarLval, _StringVarLval, _MaybeStopLoopLval,
+        _FailStatements, Defns),
+    SlotVarRval = ml_lval(SlotVarLval),
+
     ml_gen_info_get_global_data(!.Info, GlobalData0),
     ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target,
         FirstSolnFieldTypes, FirstSolnStructTypeNum, FirstSolnStructType,
@@ -673,23 +643,15 @@
         LaterLookupSucceedStatement),
     MoreSolnsLoopStatement = statement(MoreSolnsLoopStmt, MLDS_Context),
 
-    ml_gen_new_label(FailLabel, !Info),
-    GotoFailStatement =
-        statement(ml_stmt_goto(goto_label(FailLabel)), MLDS_Context),
-    SuccessStmt = ml_stmt_block(Defns, [
-        NumLaterSolnsAssignStatement, FirstLookupSucceedStatement,
-        LaterSlotVarAssignStatement, LimitAssignStatement,
-        MoreSolnsLoopStatement, GotoFailStatement
-    ]),
-    SuccessStatement = statement(SuccessStmt, MLDS_Context),
+    SuccessStatements = [NumLaterSolnsAssignStatement,
+        FirstLookupSucceedStatement, LaterSlotVarAssignStatement,
+        LimitAssignStatement, MoreSolnsLoopStatement],
 
     InitialComment = "hashed string several_soln lookup switch",
-    ml_gen_string_hash_switch_search(InitialComment, HashSearchInfo, HashOp,
-        FirstSolnVectorCommon, FirstSolnStructType, StringFieldId,
-        MaybeNextSlotFieldId, HashMask,
-        SuccessStatement, LookupStatements),
-    FailLabelStatement = statement(ml_stmt_label(FailLabel), MLDS_Context),
-    Statements = LookupStatements ++ [FailLabelStatement | FailStatements].
+    ml_gen_string_hash_switch_search(MLDS_Context, InitialComment,
+        HashSearchInfo, HashOp, FirstSolnVectorCommon,
+        FirstSolnStructType, StringFieldId, MaybeNextSlotFieldId, HashMask,
+        MatchDefns, SuccessStatements, Statements, !Info).
 
 :- pred ml_gen_string_hash_several_soln_lookup_slots(int::in, int::in,
     map(int, string_hash_slot(soln_consts(mlds_rval)))::in,
@@ -781,18 +743,24 @@
 
 :- type ml_hash_search_info
     --->    ml_hash_search_info(
-                mhsi_mlds_context               :: mlds_context,
+                mhsi_code_model                 :: code_model,
+                mhsi_loop_present               :: bool,
+                mhsi_context                    :: prog_context,
                 mhsi_switch_var                 :: mlds_rval,
                 mhsi_slot_var                   :: mlds_lval,
                 mhsi_string_var                 :: mlds_lval,
+                mhsi_stop_loop_var              :: maybe(mlds_lval),
+                mhsi_fail_statements            :: list(statement),
                 mhsi_defns                      :: list(mlds_defn)
             ).
 
-:- pred ml_gen_string_hash_switch_search_vars(prog_context::in, prog_var::in,
-    ml_hash_search_info::out, ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_string_hash_switch_search_vars(code_model::in, can_fail::in,
+    bool::in, prog_context::in, mlds_context::in, prog_var::in,
+    ml_hash_search_info::out,
+    ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_gen_string_hash_switch_search_vars(Context, Var, HashSearchInfo, !Info) :-
-    MLDS_Context = mlds_make_context(Context),
+ml_gen_string_hash_switch_search_vars(CodeModel, CanFail, LoopPresent,
+        Context, MLDS_Context, Var, HashSearchInfo, !Info) :-
     ml_gen_var(!.Info, Var, VarLval),
     VarRval = ml_lval(VarLval),
 
@@ -816,27 +784,46 @@
         StringVarType, gc_no_stmt, MLDS_Context),
     ml_gen_var_lval(!.Info, StringVar, StringVarType, StringVarLval),
 
-    Defns = [SlotVarDefn, StringVarDefn],
-    HashSearchInfo = ml_hash_search_info(MLDS_Context, VarRval,
-        SlotVarLval, StringVarLval, Defns).
+    AlwaysDefns = [SlotVarDefn, StringVarDefn],
+    ml_should_use_stop_loop(MLDS_Context, LoopPresent,
+        MaybeStopLoopLval, StopLoopVarDefns, !Info),
+    Defns = AlwaysDefns ++ StopLoopVarDefns,
 
-:- pred ml_gen_string_hash_switch_search(string::in, ml_hash_search_info::in,
-    unary_op::in, mlds_vector_common::in, mlds_type::in,
+    % Generate the code for when the lookup fails.
+    ml_gen_maybe_switch_failure(CodeModel, CanFail, Context, FailStatements,
+        !Info),
+
+    HashSearchInfo = ml_hash_search_info(CodeModel, LoopPresent, Context,
+        VarRval, SlotVarLval, StringVarLval, MaybeStopLoopLval,
+        FailStatements, Defns).
+
+:- pred ml_gen_string_hash_switch_search(mlds_context::in, string::in,
+    ml_hash_search_info::in, unary_op::in,
+    mlds_vector_common::in, mlds_type::in,
     mlds_field_id::in, maybe(mlds_field_id)::in, int::in,
-    statement::in, list(statement)::out) is det.
+    list(mlds_defn)::in, list(statement)::in, list(statement)::out,
+    ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_gen_string_hash_switch_search(InitialComment, HashSearchInfo, HashOp,
-        VectorCommon, StructType, StringFieldId, MaybeNextSlotFieldId,
-        HashMask, FoundMatchStatement, HashLookupStatements) :-
-    HashSearchInfo = ml_hash_search_info(MLDS_Context, VarRval,
-        SlotVarLval, StringVarLval, _Defns),
+ml_gen_string_hash_switch_search(MLDS_Context, InitialComment,
+        HashSearchInfo, HashOp, VectorCommon, StructType,
+        StringFieldId, MaybeNextSlotFieldId, HashMask,
+        MatchDefns, MatchStatements, Statements, !Info) :-
+    HashSearchInfo = ml_hash_search_info(CodeModel, LoopPresent,
+        Context, VarRval, SlotVarLval, StringVarLval,
+        MaybeStopLoopVarLval, FailStatements, _Defns),
     SlotVarRval = ml_lval(SlotVarLval),
     StringVarRval = ml_lval(StringVarLval),
     SlotVarType = mlds_native_int_type,
     StringVarType = ml_string_type,
 
-    PrepareForMatchStatements = [
+    ml_wrap_loop_break(CodeModel, LoopPresent,
+        MLDS_Context, MaybeStopLoopVarLval,
+        MatchDefns, MatchStatements, FailStatements,
+        SetupForFailStatements, SuccessStatement, AfterStatements, !Info),
+
+    InitialCommentStatement =
         statement(ml_stmt_atomic(comment(InitialComment)), MLDS_Context),
+    PrepareForMatchStatements = [
         statement(ml_stmt_atomic(comment(
             "compute the hash value of the input string")), MLDS_Context),
         statement(
@@ -848,11 +835,10 @@
         ],
     FoundMatchCond =
         ml_binop(logical_and,
-            ml_binop(ne, StringVarRval,
-                ml_const(mlconst_null(StringVarType))),
+            ml_binop(ne, StringVarRval, ml_const(mlconst_null(StringVarType))),
             ml_binop(str_eq, StringVarRval, VarRval)
         ),
-    LookForMatchStatements = [
+    LookForMatchPrepareStatements = [
         statement(ml_stmt_atomic(comment(
             "lookup the string for this hash slot")), MLDS_Context),
         statement(
@@ -862,14 +848,45 @@
                     StringFieldId, StringVarType, StructType)))),
             MLDS_Context),
         statement(ml_stmt_atomic(comment("did we find a match?")),
-            MLDS_Context),
-        statement(ml_stmt_if_then_else(FoundMatchCond,
-            FoundMatchStatement, no),
             MLDS_Context)
     ],
+    SlotTest = ml_binop(int_ge, SlotVarRval, ml_const(mlconst_int(0))),
+    (
+        MaybeStopLoopVarLval = no,
+        InitStopLoopVarStatements = [],
+        InitSuccessStatements = [],
+        LoopTest = SlotTest
+    ;
+        MaybeStopLoopVarLval = yes(StopLoopVarLval),
+        InitStopLoopVarStatement = statement(ml_stmt_atomic(
+            assign(StopLoopVarLval, ml_const(mlconst_int(0)))),
+            MLDS_Context),
+        InitStopLoopVarStatements = [InitStopLoopVarStatement],
+        (
+            CodeModel = model_det,
+            % If the switch is model_det, the value of `succeeded'
+            % is irrelevant, as it will not be consulted.
+            InitSuccessStatements = []
+        ;
+            CodeModel = model_semi,
+            ml_gen_set_success(!.Info, ml_const(mlconst_false), Context,
+                InitSuccessStatement),
+            InitSuccessStatements = [InitSuccessStatement]
+        ;
+            CodeModel = model_non,
+            % If the switch is model_non, we get to the end of search code
+            % (which may or my not be a loop) for both matches and non-matches,
+            % though in the case of matches we get there only after invoking
+            % the success continuation for each solution.
+            InitSuccessStatements = []
+        ),
+        StopLoopTest = ml_binop(eq,
+            ml_lval(StopLoopVarLval), ml_const(mlconst_int(0))),
+        LoopTest = ml_binop(logical_and, StopLoopTest, SlotTest)
+    ),
     (
         MaybeNextSlotFieldId = yes(NextSlotFieldId),
-        NoMatchStatements = [
+        NoMatchStatement = statement(ml_stmt_block([], [
             statement(ml_stmt_atomic(comment(
                 "no match yet, so get next slot in hash chain")),
                 MLDS_Context),
@@ -879,33 +896,38 @@
                         ml_vector_common_row(VectorCommon, SlotVarRval),
                         NextSlotFieldId, SlotVarType, StructType)))),
                 MLDS_Context)
-        ],
-
+            ]), MLDS_Context),
+        LookForMatchStatement = statement(
+            ml_stmt_if_then_else(FoundMatchCond, SuccessStatement,
+                yes(NoMatchStatement)),
+            MLDS_Context),
         LoopBody = statement(ml_stmt_block([],
-            LookForMatchStatements ++ NoMatchStatements), MLDS_Context),
-
+            LookForMatchPrepareStatements ++ [LookForMatchStatement]),
+            MLDS_Context),
         LoopStatements = [
             statement(ml_stmt_atomic(comment("hash chain loop")),
                 MLDS_Context),
-            statement(
-                ml_stmt_while(loop_at_least_once,
-                    ml_binop(int_ge, SlotVarRval, ml_const(mlconst_int(0))),
-                    LoopBody),
+            statement(ml_stmt_while(loop_at_least_once, LoopTest, LoopBody),
                 MLDS_Context)
             ],
-
-        HashLookupStatements =
-            PrepareForMatchStatements ++ LoopStatements
+        SearchStatements = PrepareForMatchStatements ++
+            InitStopLoopVarStatements ++ InitSuccessStatements ++
+            LoopStatements,
+        Statements = [InitialCommentStatement | SetupForFailStatements] ++
+            SearchStatements ++ AfterStatements
     ;
         MaybeNextSlotFieldId = no,
-        NoLoopStatements = [
-            statement(ml_stmt_atomic(
-                comment("no collisions; no hash chain loop")), MLDS_Context)
-            ],
-
-        HashLookupStatements =
-            PrepareForMatchStatements ++ LookForMatchStatements ++
-            NoLoopStatements
+        NoLoopCommentStatement = statement(ml_stmt_atomic(
+            comment("no collisions; no hash chain loop")), MLDS_Context),
+        LookForMatchStatement = statement(
+            ml_stmt_if_then_else(FoundMatchCond, SuccessStatement, no),
+            MLDS_Context),
+        SearchStatements = PrepareForMatchStatements ++
+            InitSuccessStatements ++
+            [NoLoopCommentStatement | LookForMatchPrepareStatements] ++
+            [LookForMatchStatement],
+        Statements = [InitialCommentStatement | SearchStatements] ++
+            AfterStatements
     ).
 
 %-----------------------------------------------------------------------------%
@@ -913,14 +935,12 @@
 
 ml_generate_string_binary_jump_switch(Cases, Var, CodeModel, CanFail, Context,
         Defns, Statements, !Info) :-
-    ml_gen_string_binary_switch_search_vars(Context, Var, BinarySearchInfo,
-        !Info),
-    BinarySearchInfo = ml_binary_search_info(MLDS_Context, _VarRval,
-        _LoVarLval, _HiVarLval, MidVarLval, _ResultVarLval, Defns),
-
-    % Generate the code for when the lookup fails.
-    ml_gen_maybe_switch_failure(CodeModel, CanFail, Context, MLDS_Context,
-        FailStatements, !Info),
+    MLDS_Context = mlds_make_context(Context),
+    ml_gen_string_binary_switch_search_vars(CodeModel, CanFail,
+        Context, MLDS_Context, Var, BinarySearchInfo, !Info),
+    BinarySearchInfo = ml_binary_search_info(_CodeModel,
+        _VarRval, _LoVarLval, _HiVarLval, MidVarLval, _ResultVarLval,
+        _MaybeStopLoopVarLval, _FailStatements, Defns),
 
     ml_gen_info_get_module_info(!.Info, ModuleInfo),
     module_info_get_name(ModuleInfo, ModuleName),
@@ -972,23 +992,11 @@
         default_is_unreachable),
     ml_simplify_switch(SwitchStmt0, MLDS_Context, SwitchStatement, !Info),
 
-    ml_gen_new_label(EndLabel, !Info),
-    GotoEndStatement =
-        statement(ml_stmt_goto(goto_label(EndLabel)), MLDS_Context),
-    SuccessStatement =
-        statement(ml_stmt_block([], [SwitchStatement, GotoEndStatement]),
-            MLDS_Context),
-
     % Generate the code that searches the table.
-    ml_gen_string_binary_switch_search(BinarySearchInfo, VectorCommon,
-        TableSize, StructType, StringFieldId,
-        SuccessStatement, LookupStatements, !.Info),
     InitialComment = "binary string jump switch",
-    CommentStatement = statement(ml_stmt_atomic(comment(InitialComment)),
-        MLDS_Context),
-    EndLabelStatement = statement(ml_stmt_label(EndLabel), MLDS_Context),
-    Statements = [CommentStatement | LookupStatements] ++
-        FailStatements ++ [EndLabelStatement].
+    ml_gen_string_binary_switch_search(MLDS_Context, InitialComment,
+        BinarySearchInfo, VectorCommon, TableSize, StructType, StringFieldId,
+        [], [SwitchStatement], Statements, !Info).
 
 :- pred ml_gen_string_binary_jump_initializers(assoc_list(string, int)::in,
     mlds_type::in,
@@ -1025,53 +1033,45 @@
 
 ml_generate_string_binary_lookup_switch(Var, LookupSwitchInfo, CodeModel,
         CanFail, Context, Defns, Statements, !Info) :-
-    ml_gen_string_binary_switch_search_vars(Context, Var, BinarySearchInfo,
-        !Info),
-    Defns = BinarySearchInfo ^ mbsi_defns,
-    MLDS_Context = BinarySearchInfo ^ mbsi_mlds_context,
-
-    % Generate the code for when the lookup fails.
-    ml_gen_maybe_switch_failure(CodeModel, CanFail, Context, MLDS_Context,
-        FailStatements, !Info),
-
+    MLDS_Context = mlds_make_context(Context),
     LookupSwitchInfo = ml_lookup_switch_info(CaseConsts, OutVars, OutTypes),
     (
-        CaseConsts = all_one_soln(CaseValuePairs),
-        ml_generate_string_binary_simple_lookup_switch(CodeModel,
-            CaseValuePairs, OutVars, OutTypes, Context,
-            BinarySearchInfo, FailStatements, Statements, !Info)
+        CaseConsts = all_one_soln(CaseValues),
+        ml_generate_string_binary_simple_lookup_switch(Var,
+            CodeModel, CanFail, CaseValues, OutVars, OutTypes,
+            Context, MLDS_Context, Defns, Statements, !Info)
     ;
         CaseConsts = some_several_solns(CaseSolns, _Unit),
         expect(unify(CodeModel, model_non), $module, $pred,
             "CodeModel != model_non"),
-        ml_generate_string_binary_several_soln_lookup_switch(CaseSolns,
-            OutVars, OutTypes, Context, BinarySearchInfo,
-            FailStatements, Statements, !Info)
+        ml_generate_string_binary_several_soln_lookup_switch(Var,
+            CodeModel, CanFail, CaseSolns, OutVars, OutTypes,
+            Context, MLDS_Context, Defns, Statements, !Info)
     ).
 
 %-----------------------------------------------------------------------------%
 
-:- pred ml_generate_string_binary_simple_lookup_switch(code_model::in,
+:- pred ml_generate_string_binary_simple_lookup_switch(prog_var::in,
+    code_model::in, can_fail::in,
     assoc_list(string, list(mlds_rval))::in,
     list(prog_var)::in, list(mlds_type)::in,
-    prog_context::in, ml_binary_search_info::in,
-    list(statement)::in, list(statement)::out,
+    prog_context::in, mlds_context::in,
+    list(mlds_defn)::out, list(statement)::out,
     ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_generate_string_binary_simple_lookup_switch(CodeModel, CaseValuePairs0,
-        OutVars, OutTypes, Context, BinarySearchInfo,
-        FailStatements, Statements, !Info) :-
+ml_generate_string_binary_simple_lookup_switch(Var, CodeModel, CanFail,
+        CaseValues0, OutVars, OutTypes, Context, MLDS_Context,
+        Defns, Statements, !Info) :-
     ml_gen_info_get_module_info(!.Info, ModuleInfo),
     module_info_get_name(ModuleInfo, ModuleName),
     MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
     ml_gen_info_get_target(!.Info, Target),
-    MLDS_Context = BinarySearchInfo ^ mbsi_mlds_context,
 
     MLDS_StringType = mercury_type_to_mlds_type(ModuleInfo, string_type),
     MLDS_ArgTypes = [MLDS_StringType | OutTypes],
 
     % Generate the binary search table.
-    list.sort(CaseValuePairs0, CaseValuePairs),
+    list.sort(CaseValues0, CaseValues),
     ml_gen_info_get_global_data(!.Info, GlobalData0),
     ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target,
         MLDS_ArgTypes, StructTypeNum, StructType, FieldIds,
@@ -1082,50 +1082,41 @@
     ;
         unexpected($module, $pred, "bad FieldIds")
     ),
-    ml_gen_string_binary_simple_lookup_initializers(CaseValuePairs, StructType,
+    ml_gen_string_binary_simple_lookup_initializers(CaseValues, StructType,
         [], RevRowInitializers, 0, TableSize),
     list.reverse(RevRowInitializers, RowInitializers),
     ml_gen_static_vector_defn(MLDS_ModuleName, StructTypeNum, RowInitializers,
         VectorCommon, GlobalData1, GlobalData),
     ml_gen_info_set_global_data(GlobalData, !Info),
 
-    MidVarLval = BinarySearchInfo ^ mbsi_mid_var,
+    ml_gen_string_binary_switch_search_vars(CodeModel, CanFail,
+        Context, MLDS_Context, Var, BinarySearchInfo, !Info),
+    BinarySearchInfo = ml_binary_search_info(_CodeModel, _VarRval,
+        _LoVarLval, _HiVarLval, MidVarLval, _ResultVarLval, _MaybeStopLoopLval,
+        _FailStatements, Defns),
+    MidVarRval = ml_lval(MidVarLval),
+
     ml_generate_field_assigns(OutVars, OutTypes, OutFieldIds,
-        VectorCommon, StructType, ml_lval(MidVarLval), MLDS_Context,
+        VectorCommon, StructType, MidVarRval, MLDS_Context,
         GetArgStatements, !Info),
-
-    ml_gen_new_label(EndLabel, !Info),
-    GotoEndStatement =
-        statement(ml_stmt_goto(goto_label(EndLabel)), MLDS_Context),
     (
         CodeModel = model_det,
-        SuccessStatement = statement(
-            ml_stmt_block([], GetArgStatements ++ [GotoEndStatement]),
-            MLDS_Context)
+        MatchStatements = GetArgStatements
     ;
         CodeModel = model_semi,
         ml_gen_set_success(!.Info, ml_const(mlconst_true), Context,
             SetSuccessTrueStatement),
-        SuccessStatement = statement(
-            ml_stmt_block([],
-                GetArgStatements ++
-                [SetSuccessTrueStatement, GotoEndStatement]),
-            MLDS_Context)
+        MatchStatements = GetArgStatements ++ [SetSuccessTrueStatement]
     ;
         CodeModel = model_non,
         unexpected($module, $pred, "model_non")
     ),
 
     % Generate the code that searches the table.
-    ml_gen_string_binary_switch_search(BinarySearchInfo, VectorCommon,
-        TableSize, StructType, StringFieldId,
-        SuccessStatement, LookupStatements, !.Info),
     InitialComment = "binary string simple lookup switch",
-    CommentStatement = statement(ml_stmt_atomic(comment(InitialComment)),
-        MLDS_Context),
-    EndLabelStatement = statement(ml_stmt_label(EndLabel), MLDS_Context),
-    Statements = [CommentStatement | LookupStatements] ++
-        FailStatements ++ [EndLabelStatement].
+    ml_gen_string_binary_switch_search(MLDS_Context, InitialComment,
+        BinarySearchInfo, VectorCommon, TableSize, StructType, StringFieldId,
+        [], MatchStatements, Statements, !Info).
 
 :- pred ml_gen_string_binary_simple_lookup_initializers(
     assoc_list(string, list(mlds_rval))::in, mlds_type::in,
@@ -1146,26 +1137,26 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pred ml_generate_string_binary_several_soln_lookup_switch(
+:- pred ml_generate_string_binary_several_soln_lookup_switch(prog_var::in,
+    code_model::in, can_fail::in,
     assoc_list(string, soln_consts(mlds_rval))::in,
     list(prog_var)::in, list(mlds_type)::in,
-    prog_context::in, ml_binary_search_info::in,
-    list(statement)::in, list(statement)::out,
+    prog_context::in, mlds_context::in,
+    list(mlds_defn)::out, list(statement)::out,
     ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_generate_string_binary_several_soln_lookup_switch(CaseSolns0,
-        OutVars, OutTypes, Context, BinarySearchInfo,
-        FailStatements, Statements, !Info) :-
+ml_generate_string_binary_several_soln_lookup_switch(Var, CodeModel, CanFail,
+        CaseSolns0, OutVars, OutTypes, Context, MLDS_Context,
+        Defns, Statements, !Info) :-
     ml_gen_info_get_module_info(!.Info, ModuleInfo),
     module_info_get_name(ModuleInfo, ModuleName),
     MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
     ml_gen_info_get_target(!.Info, Target),
-    MLDS_Context = BinarySearchInfo ^ mbsi_mlds_context,
 
     make_several_soln_lookup_vars(MLDS_Context, SeveralSolnLookupVars, !Info),
     SeveralSolnLookupVars = ml_several_soln_lookup_vars(NumLaterSolnsVarLval,
         LaterSlotVarLval, LimitVarLval,
-        LimitAssignStatement, IncrLaterSlotVarStatement, Defns),
+        LimitAssignStatement, IncrLaterSlotVarStatement, MatchDefns),
     LaterSlotVarRval = ml_lval(LaterSlotVarLval),
     LimitVarRval = ml_lval(LimitVarLval),
 
@@ -1210,8 +1201,13 @@
         GlobalData3, GlobalData),
     ml_gen_info_set_global_data(GlobalData, !Info),
 
-    MidVarLval = BinarySearchInfo ^ mbsi_mid_var,
+    ml_gen_string_binary_switch_search_vars(CodeModel, CanFail,
+        Context, MLDS_Context, Var, BinarySearchInfo, !Info),
+    BinarySearchInfo = ml_binary_search_info(_CodeModel, _VarRval,
+        _LoVarLval, _HiVarLval, MidVarLval, _ResultVarLval, _MaybeStopLoopLval,
+        _FailStatements, Defns),
     MidVarRval = ml_lval(MidVarLval),
+
     ml_generate_field_assign(NumLaterSolnsVarLval, MLDS_IntType,
         NumLaterSolnsFieldId,
         FirstSolnVectorCommon, FirstSolnStructType, MidVarRval,
@@ -1244,26 +1240,18 @@
         LaterLookupSucceedStatement),
     MoreSolnsLoopStatement = statement(MoreSolnsLoopStmt, MLDS_Context),
 
-    ml_gen_new_label(FailLabel, !Info),
-    GotoFailStatement =
-        statement(ml_stmt_goto(goto_label(FailLabel)), MLDS_Context),
-    SuccessStmt = ml_stmt_block(Defns, [
+    MatchStatements = [
         NumLaterSolnsAssignStatement, FirstLookupSucceedStatement,
         LaterSlotVarAssignStatement, LimitAssignStatement,
-        MoreSolnsLoopStatement, GotoFailStatement
-    ]),
-    SuccessStatement = statement(SuccessStmt, MLDS_Context),
+        MoreSolnsLoopStatement
+    ],
 
     % Generate the code that searches the table.
-    ml_gen_string_binary_switch_search(BinarySearchInfo, FirstSolnVectorCommon,
-        FirstSolnTableSize, FirstSolnStructType, StringFieldId,
-        SuccessStatement, LookupStatements, !.Info),
     InitialComment = "binary string several soln lookup switch",
-    CommentStatement = statement(ml_stmt_atomic(comment(InitialComment)),
-        MLDS_Context),
-    FailLabelStatement = statement(ml_stmt_label(FailLabel), MLDS_Context),
-    Statements = [CommentStatement | LookupStatements] ++
-        [FailLabelStatement | FailStatements].
+    ml_gen_string_binary_switch_search(MLDS_Context, InitialComment,
+        BinarySearchInfo, FirstSolnVectorCommon,FirstSolnTableSize,
+        FirstSolnStructType, StringFieldId,
+        MatchDefns, MatchStatements, Statements, !Info).
 
 :- pred ml_gen_string_binary_several_lookup_initializers(
     assoc_list(string, soln_consts(mlds_rval))::in,
@@ -1321,21 +1309,23 @@
 
 :- type ml_binary_search_info
     --->    ml_binary_search_info(
-                mbsi_mlds_context           :: mlds_context,
+                mbsi_code_model             :: code_model,
                 mbsi_switch_var             :: mlds_rval,
                 mbsi_lo_var                 :: mlds_lval,
                 mbsi_hi_var                 :: mlds_lval,
                 mbsi_mid_var                :: mlds_lval,
                 mbsi_result_var             :: mlds_lval,
+                mbsi_stop_loop_var          :: maybe(mlds_lval),
+                mbsi_fail_statements        :: list(statement),
                 mbsi_defns                  :: list(mlds_defn)
             ).
 
-:- pred ml_gen_string_binary_switch_search_vars(prog_context::in, prog_var::in,
+:- pred ml_gen_string_binary_switch_search_vars(code_model::in, can_fail::in,
+    prog_context::in, mlds_context::in, prog_var::in,
     ml_binary_search_info::out, ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_gen_string_binary_switch_search_vars(Context, Var, BinarySearchInfo,
-        !Info) :-
-    MLDS_Context = mlds_make_context(Context),
+ml_gen_string_binary_switch_search_vars(CodeModel, CanFail,
+        Context, MLDS_Context, Var, BinarySearchInfo, !Info) :-
     ml_gen_var(!.Info, Var, VarLval),
     VarRval = ml_lval(VarLval),
 
@@ -1371,78 +1361,127 @@
         ResultGCStatement, MLDS_Context),
     ml_gen_var_lval(!.Info, ResultVar, ResultType, ResultVarLval),
 
-    Defns = [LoVarDefn, HiVarDefn, MidVarDefn, ResultVarDefn],
-    BinarySearchInfo = ml_binary_search_info(MLDS_Context, VarRval,
-        LoVarLval, HiVarLval, MidVarLval, ResultVarLval, Defns).
-
-:- pred ml_gen_string_binary_switch_search(ml_binary_search_info::in,
-    mlds_vector_common::in, int::in, mlds_type::in, mlds_field_id::in,
-    statement::in, list(statement)::out, ml_gen_info::in) is det.
-
-ml_gen_string_binary_switch_search(BinarySearchInfo,
-        VectorCommon, TableSize, StructType, StringFieldId,
-        SuccessStatement, Statements, Info) :-
-    BinarySearchInfo = ml_binary_search_info(MLDS_Context, VarRval,
-        LoVarLval, HiVarLval, MidVarLval, ResultVarLval, _Defns),
-    ml_gen_info_get_module_info(Info, ModuleInfo),
+    AlwaysDefns = [LoVarDefn, HiVarDefn, MidVarDefn, ResultVarDefn],
+    ml_should_use_stop_loop(MLDS_Context, yes,
+        MaybeStopLoopLval, StopLoopVarDefns, !Info),
+    Defns = AlwaysDefns ++ StopLoopVarDefns,
+
+    % Generate the code for when the lookup fails.
+    ml_gen_maybe_switch_failure(CodeModel, CanFail, Context, FailStatements,
+        !Info),
+
+    BinarySearchInfo = ml_binary_search_info(CodeModel, VarRval,
+        LoVarLval, HiVarLval, MidVarLval, ResultVarLval, MaybeStopLoopLval,
+        FailStatements, Defns).
+
+:- pred ml_gen_string_binary_switch_search(mlds_context::in, string::in,
+    ml_binary_search_info::in, mlds_vector_common::in, int::in, mlds_type::in,
+    mlds_field_id::in, list(mlds_defn)::in, list(statement)::in,
+    list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_string_binary_switch_search(MLDS_Context, InitialComment,
+        BinarySearchInfo, VectorCommon, TableSize, StructType, StringFieldId,
+        MatchDefns, MatchStatement, Statements, !Info) :-
+    BinarySearchInfo = ml_binary_search_info(CodeModel, VarRval,
+        LoVarLval, HiVarLval, MidVarLval, ResultVarLval, MaybeStopLoopVarLval,
+        FailStatements, _Defns),
+    LoVarRval = ml_lval(LoVarLval),
+    HiVarRval = ml_lval(HiVarLval),
+    MidVarRval = ml_lval(MidVarLval),
+    ResultVarRval = ml_lval(ResultVarLval),
+
+    ml_wrap_loop_break(CodeModel, yes, MLDS_Context, MaybeStopLoopVarLval,
+        MatchDefns, MatchStatement, FailStatements,
+        SetupForFailStatements, SuccessStatement, AfterStatements, !Info),
+
+    ml_gen_info_get_module_info(!.Info, ModuleInfo),
     MLDS_StringType = mercury_type_to_mlds_type(ModuleInfo, string_type),
 
-    LoopBodyStatements = [
-        statement(ml_stmt_atomic(
+    InitLoVarStatement = statement(ml_stmt_atomic(
+        assign(LoVarLval, ml_const(mlconst_int(0)))),
+        MLDS_Context),
+    InitHiVarStatement = statement(ml_stmt_atomic(
+        assign(HiVarLval, ml_const(mlconst_int(TableSize - 1)))),
+        MLDS_Context),
+    CrossingTest = ml_binop(int_le, LoVarRval, HiVarRval),
+
+    AssignMidVarStatement = statement(ml_stmt_atomic(
             assign(MidVarLval,
                 ml_binop(int_div,
-                    ml_binop(int_add, ml_lval(LoVarLval), ml_lval(HiVarLval)),
+                ml_binop(int_add, LoVarRval, HiVarRval),
                     ml_const(mlconst_int(2))))),
             MLDS_Context),
-        statement(ml_stmt_atomic(
+    AssignResultVarStatement = statement(ml_stmt_atomic(
             assign(ResultVarLval,
                 ml_binop(str_cmp,
                     VarRval,
                     ml_lval(ml_field(yes(0),
-                        ml_vector_common_row(VectorCommon,
-                            ml_lval(MidVarLval)),
+                    ml_vector_common_row(VectorCommon, MidVarRval),
                     StringFieldId, MLDS_StringType, StructType))))),
             MLDS_Context),
-        statement(ml_stmt_if_then_else(
-            ml_binop(eq,
-                ml_lval(ResultVarLval),
-                ml_const(mlconst_int(0))),
-            SuccessStatement,
-            yes(statement(
+    ResultTest = ml_binop(eq, ResultVarRval, ml_const(mlconst_int(0))),
+    UpdateLoOrHiVarStatement = statement(
                 ml_stmt_if_then_else(
-                    ml_binop(int_lt,
-                        ml_lval(ResultVarLval),
-                        ml_const(mlconst_int(0))),
+            ml_binop(int_lt, ResultVarRval, ml_const(mlconst_int(0))),
                     statement(ml_stmt_atomic(
                         assign(HiVarLval,
-                            ml_binop(int_sub,
-                                ml_lval(MidVarLval),
-                                ml_const(mlconst_int(1))))),
+                    ml_binop(int_sub, MidVarRval, ml_const(mlconst_int(1))))),
                         MLDS_Context),
                     yes(statement(ml_stmt_atomic(
                         assign(LoVarLval,
-                            ml_binop(int_add,
-                                ml_lval(MidVarLval),
-                                ml_const(mlconst_int(1))))),
-                        MLDS_Context))),
+                    ml_binop(int_add, MidVarRval, ml_const(mlconst_int(1))))),
                 MLDS_Context))),
+        MLDS_Context),
+
+    (
+        MaybeStopLoopVarLval = no,
+        LoopBodyStatements = [
+            AssignMidVarStatement,
+            AssignResultVarStatement,
+            statement(ml_stmt_if_then_else(ResultTest,
+                SuccessStatement, yes(UpdateLoOrHiVarStatement)),
             MLDS_Context)
     ],
-    Statements = [
-        statement(ml_stmt_atomic(
-            assign(LoVarLval, ml_const(mlconst_int(0)))),
-            MLDS_Context),
-        statement(ml_stmt_atomic(
-            assign(HiVarLval, ml_const(mlconst_int(TableSize - 1)))),
+        SearchStatements = [
+            InitLoVarStatement,
+            InitHiVarStatement,
+            statement(ml_stmt_while(loop_at_least_once,
+                CrossingTest,
+                statement(ml_stmt_block([], LoopBodyStatements),
+                    MLDS_Context)),
+                MLDS_Context)
+        ]
+    ;
+        MaybeStopLoopVarLval = yes(StopLoopVarLval),
+        InitStopLoopVarStatement = statement(ml_stmt_atomic(
+            assign(StopLoopVarLval, ml_const(mlconst_int(0)))),
             MLDS_Context),
-        statement(ml_stmt_while(may_loop_zero_times,
-            ml_binop(int_le,
-                ml_lval(LoVarLval),
-                ml_lval(HiVarLval)),
+        StopLoopTest = ml_binop(eq,
+            ml_lval(StopLoopVarLval), ml_const(mlconst_int(0))),
+        LoopBodyStatements = [
+            AssignMidVarStatement,
+            AssignResultVarStatement,
+            % SuccessStatement should set StopLoopVarLval to 1.
+            statement(ml_stmt_if_then_else(ResultTest,
+                SuccessStatement, yes(UpdateLoOrHiVarStatement)),
+                MLDS_Context)
+        ],
+        SearchStatements = [
+            InitLoVarStatement,
+            InitHiVarStatement,
+            InitStopLoopVarStatement,
+            statement(ml_stmt_while(loop_at_least_once,
+                ml_binop(logical_and, StopLoopTest, CrossingTest),
             statement(ml_stmt_block([], LoopBodyStatements),
                 MLDS_Context)),
             MLDS_Context)
-        ].
+        ]
+    ),
+
+    InitialCommentStatement =
+        statement(ml_stmt_atomic(comment(InitialComment)), MLDS_Context),
+    Statements = [InitialCommentStatement | SetupForFailStatements] ++
+        SearchStatements ++ AfterStatements.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -1450,27 +1489,222 @@
 % Code useful for all kinds of string switches.
 %
 
+:- pred ml_should_use_stop_loop(mlds_context::in, bool::in,
+    maybe(mlds_lval)::out, list(mlds_defn)::out,
+    ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_should_use_stop_loop(MLDS_Context, LoopPresent,
+        MaybeStopLoopLval, StopLoopLvalDefns, !Info) :-
+    (
+        LoopPresent = no,
+        UseStopLoop = no
+    ;
+        LoopPresent = yes,
+        ml_gen_info_get_module_info(!.Info, ModuleInfo),
+        module_info_get_globals(ModuleInfo, Globals),
+        SupportsGoto = globals_target_supports_goto(Globals),
+        globals.lookup_string_option(Globals, experiment, Experiment),
+        (
+            SupportsGoto = yes,
+            ( Experiment = "use_stop_loop" ->
+                UseStopLoop = yes
+            ;
+                UseStopLoop = no
+            )
+        ;
+            SupportsGoto = no,
+            UseStopLoop = yes
+        )
+    ),
+    (
+        UseStopLoop = no,
+        MaybeStopLoopLval = no,
+        StopLoopLvalDefns = []
+    ;
+        UseStopLoop = yes,
+        % On targets that do not support gotos or break, after we have
+        % handled a match, we set the stop loop flag, which will cause the
+        % next test of the loop condition to fail.
+
+        StopLoopType = mlds_native_int_type,
+        % We never need to trace ints.
+        StopLoopGCStatement = gc_no_stmt,
+
+        ml_gen_info_new_aux_var_name("stop_loop", StopLoopVar, !Info),
+        StopLoopVarDefn = ml_gen_mlds_var_decl(mlds_data_var(StopLoopVar),
+            StopLoopType, StopLoopGCStatement, MLDS_Context),
+        ml_gen_var_lval(!.Info, StopLoopVar, StopLoopType, StopLoopVarLval),
+        MaybeStopLoopLval = yes(StopLoopVarLval),
+        StopLoopLvalDefns = [StopLoopVarDefn]
+    ).
+
 :- pred ml_gen_maybe_switch_failure(code_model::in, can_fail::in,
-    prog_context::in, mlds_context::in, list(statement)::out,
+    prog_context::in, list(statement)::out,
     ml_gen_info::in, ml_gen_info::out) is det.
 
-ml_gen_maybe_switch_failure(CodeModel, CanFail, Context, MLDS_Context,
-        FailStatements, !Info) :-
+ml_gen_maybe_switch_failure(CodeModel, CanFail, Context, FailStatements,
+        !Info) :-
+    % We used to include comments in FailStatements. However, that would
+    % complicate the task of ml_wrap_loop_break, which needs to decide
+    % whether FailStatements actually contains executable code.
     (
         CanFail = cannot_fail,
         % This can happen if the initial inst of the switched-on variable
         % shows that we know a finite set of strings that the variable can be
         % bound to.
-        FailComment =
-            statement(ml_stmt_atomic(comment("switch cannot fail")),
-                MLDS_Context),
-        FailStatements = [FailComment]
+        FailStatements = []
     ;
         CanFail = can_fail,
-        FailComment = statement(ml_stmt_atomic(comment("no match, so fail")),
+        ml_gen_failure(CodeModel, Context, FailStatements, !Info)
+    ).
+
+    % ml_wrap_loop_break(CodeModel, LoopPresent,
+    %   MLDS_Context, MaybeStopLoopVarLval, MatchDefns, MatchStatements,
+    %   SetupForFailStatements, BodyStatement, AfterStatements, !Info)
+    %
+    % MatchStatements should be the statements that we execute once we find
+    % a match, and OnlyFailAfterStatements should be the statements that we
+    % want to execute after the search loop if the loop did NOT find a match.
+    %
+    % This predicate wraps up MatchStatements with both MatchDefns and with
+    % other following code that causes execution to exit the loop
+    % after a match, and returns the resulting code as BodyStatement.
+    %
+    % We also return SetupForFailStatements and AfterStatements.
+    % SetupForFailStatements will be code to put before the loop, to set up
+    % for possible failure to find a match.
+
+    % AfterStatements will be code to put after the loop. It will contain
+    % OnlyFailAfterStatements, wrapped up in a test if necessary, as well as
+    % any code needed to enable BodyStatement to break out of the loop
+    % on a match.
+    %
+:- pred ml_wrap_loop_break(code_model::in, bool::in, mlds_context::in,
+    maybe(mlds_lval)::in, list(mlds_defn)::in, list(statement)::in,
+    list(statement)::in,
+    list(statement)::out, statement::out, list(statement)::out,
+    ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_wrap_loop_break(CodeModel, LoopPresent, MLDS_Context, MaybeStopLoopVarLval,
+        MatchDefns, MatchStatements, FailStatements,
+        SetupForFailStatements, BodyStatement, AfterStatements, !Info) :-
+    (
+        CodeModel = model_det,
+        SetupForFailStatements = [],
+        expect(unify(FailStatements, []), $module, $pred,
+            "model_det, but FailStatements is not empty"),
+        OnlyFailAfterStatements = []
+    ;
+        CodeModel = model_semi,
+        (
+            MaybeStopLoopVarLval = no,
+            SetupForFailStatements = [],
+            OnlyFailAfterStatements = FailStatements
+        ;
+            MaybeStopLoopVarLval = yes(_),
+            % It is more efficient to set up the default value of the succeeded
+            % variable (FALSE) with an unconditional assignment than it is
+            % to set up its actual value with a conditional assignment.
+            SetupForFailStatements = FailStatements,
+            OnlyFailAfterStatements = []
+        )
+    ;
+        CodeModel = model_non,
+        SetupForFailStatements = [],
+        expect(unify(FailStatements, []), $module, $pred,
+            "model_non, but FailStatements is not empty"),
+        OnlyFailAfterStatements = []
+    ),
+    (
+        MaybeStopLoopVarLval = no,
+        (
+            LoopPresent = no,
+            OnlyFailAfterStatements = []
+        ->
+            BodyStatement =
+                statement(ml_stmt_block(MatchDefns, MatchStatements),
+                    MLDS_Context),
+            AfterStatements = []
+        ;
+            ml_gen_info_get_module_info(!.Info, ModuleInfo),
+            module_info_get_globals(ModuleInfo, Globals),
+            SupportsBreakContinue =
+                globals_target_supports_break_and_continue(Globals),
+            globals.lookup_string_option(Globals, experiment, Experiment),
+            (
+                SupportsBreakContinue = yes,
+                OnlyFailAfterStatements = [],
+                Experiment \= "use_end_label"
+            ->
+                BreakCommentStatement = statement(ml_stmt_atomic(
+                    comment("break out of search loop")), MLDS_Context),
+                BreakStatement =
+                    statement(ml_stmt_goto(goto_break), MLDS_Context),
+                BodyStatement =
+                    statement(ml_stmt_block(MatchDefns,
+                        MatchStatements ++
+                            [BreakCommentStatement, BreakStatement]),
             MLDS_Context),
-        ml_gen_failure(CodeModel, Context, FailStatements0, !Info),
-        FailStatements = [FailComment | FailStatements0]
+                AfterStatements = []
+            ;
+                ml_gen_new_label(EndLabel, !Info),
+                GotoCommentStatement = statement(ml_stmt_atomic(
+                    comment("jump out of search loop")), MLDS_Context),
+                GotoEndStatement =
+                    statement(ml_stmt_goto(goto_label(EndLabel)),
+                        MLDS_Context),
+                BodyStatement =
+                    statement(ml_stmt_block(MatchDefns,
+                        MatchStatements ++
+                            [GotoCommentStatement, GotoEndStatement]),
+                        MLDS_Context),
+                EndLabelStatement =
+                    statement(ml_stmt_label(EndLabel), MLDS_Context),
+                AfterStatements =
+                    OnlyFailAfterStatements ++ [EndLabelStatement]
+            )
+        )
+    ;
+        MaybeStopLoopVarLval = yes(StopLoopVarLval),
+        (
+            LoopPresent = no,
+            OnlyFailAfterStatements = []
+        ->
+            BodyStatement =
+                statement(ml_stmt_block(MatchDefns, MatchStatements),
+                    MLDS_Context)
+        ;
+            SetStopLoopStatement =
+                statement(ml_stmt_atomic(
+                    assign(StopLoopVarLval, ml_const(mlconst_int(1)))),
+                    MLDS_Context),
+            BodyStatement =
+                statement(ml_stmt_block(MatchDefns,
+                    MatchStatements ++ [SetStopLoopStatement]),
+                    MLDS_Context)
+        ),
+        (
+            OnlyFailAfterStatements = [],
+            AfterStatements = []
+        ;
+            (
+                OnlyFailAfterStatements = [OnlyFailAfterStatement]
+            ;
+                OnlyFailAfterStatements = [_, _ | _],
+                OnlyFailAfterStatement = statement(
+                    ml_stmt_block([], OnlyFailAfterStatements),
+                    MLDS_Context)
+            ),
+            SuccessTest = ml_binop(eq,
+                ml_lval(StopLoopVarLval),
+                ml_const(mlconst_int(0))),
+            AfterStatement =
+                statement(
+                    ml_stmt_if_then_else(SuccessTest,
+                        OnlyFailAfterStatement, no),
+                    MLDS_Context),
+            AfterStatements = [AfterStatement]
+        )
     ).
 
 %-----------------------------------------------------------------------------%
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.59
diff -u -b -r1.59 ml_switch_gen.m
--- compiler/ml_switch_gen.m	9 Aug 2011 05:34:34 -0000	1.59
+++ compiler/ml_switch_gen.m	14 Aug 2011 10:31:30 -0000
@@ -101,7 +101,6 @@
 
 :- import_module hlds.code_model.
 :- import_module hlds.hlds_goal.
-:- import_module libs.globals.
 :- import_module ml_backend.ml_gen_info.
 :- import_module ml_backend.mlds.
 :- import_module parse_tree.prog_data.
@@ -123,13 +122,6 @@
     prog_context::in, mlds_switch_default::out,
     ml_gen_info::in, ml_gen_info::out) is det.
 
-    % Succeed iff the target supports the specified construct.
-    %
-:- pred target_supports_int_switch(globals::in) is semidet.
-:- pred target_supports_string_switch(globals::in) is semidet.
-:- pred target_supports_goto(globals::in) is semidet.
-:- pred target_supports_computed_goto(globals::in) is semidet.
-
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -141,6 +133,7 @@
 :- import_module check_hlds.type_util.
 :- import_module hlds.hlds_data.
 :- import_module hlds.hlds_module.
+:- import_module libs.globals.
 :- import_module libs.options.
 :- import_module ml_backend.ml_code_gen.
 :- import_module ml_backend.ml_code_util.
@@ -148,6 +141,7 @@
 :- import_module ml_backend.ml_simplify_switch.
 :- import_module ml_backend.ml_string_switch.
 :- import_module ml_backend.ml_tag_switch.
+:- import_module ml_backend.ml_target_util.
 :- import_module ml_backend.ml_unify_gen.
 :- import_module parse_tree.prog_type.
 
@@ -228,7 +222,7 @@
                     NeedBitVecCheck, NeedRangeCheck, LookupStatement, !Info),
                 Statements = [LookupStatement]
             ;
-                target_supports_int_switch(Globals)
+                globals_target_supports_int_switch(Globals) = yes
             ->
                 ml_switch_generate_mlds_switch(TaggedCases, SwitchVar,
                     CodeModel, CanFail, Context, Statements, !Info)
@@ -251,7 +245,7 @@
                 globals.lookup_bool_option(Globals, prefer_switch,
                     PreferSwitch),
                 (
-                    target_supports_string_switch(Globals),
+                    globals_target_supports_string_switch(Globals) = yes,
                     % Even if we could use a hash or binary switch,
                     % we may prefer to do a direct-mapped string switch.
                     PreferSwitch = yes
@@ -265,15 +259,10 @@
                     % We can implement string hash switches using either
                     % computed gotos or int switches.
                     (
-                        target_supports_computed_goto(Globals)
+                        globals_target_supports_computed_goto(Globals) = yes
                     ;
-                        target_supports_int_switch(Globals)
-                    ),
-                    % XXX Currently string hash switches always use gotos
-                    % (to break out of the hash chain loop).
-                    % We should change that, so that we can use string hash
-                    % switches for the Java back-end too.
-                    target_supports_goto(Globals)
+                        globals_target_supports_int_switch(Globals) = yes
+                    )
                 ->
                     (
                         ml_gen_info_get_high_level_data(!.Info, no),
@@ -297,14 +286,10 @@
                     % We can implement string binary switches using either
                     % computed gotos or int switches.
                     (
-                        target_supports_computed_goto(Globals)
+                        globals_target_supports_computed_goto(Globals) = yes
                     ;
-                        target_supports_int_switch(Globals)
-                    ),
-                    % XXX Currently string binary switches always use gotos.
-                    % We should change that, so that we can use string binary
-                    % switches for the Java back-end too.
-                    target_supports_goto(Globals)
+                        globals_target_supports_int_switch(Globals) = yes
+                    )
                 ->
                     (
                         ml_gen_info_get_high_level_data(!.Info, no),
@@ -342,7 +327,7 @@
             (
                 NumConsIds >= TagSize,
                 NumArms > 1,
-                target_supports_int_switch(Globals)
+                globals_target_supports_int_switch(Globals) = yes
             ->
                 ml_generate_tag_switch(TaggedCases, SwitchVar, CodeModel,
                     CanFail, Context, Statements, !Info)
@@ -361,73 +346,6 @@
 
 %-----------------------------------------------------------------------------%
 
-target_supports_int_switch(Globals) :-
-    globals.get_target(Globals, Target),
-    target_supports_int_switch_2(Target) = yes.
-
-target_supports_string_switch(Globals) :-
-    globals.get_target(Globals, Target),
-    target_supports_string_switch_2(Target) = yes.
-
-target_supports_goto(Globals) :-
-    globals.get_target(Globals, Target),
-    target_supports_goto_2(Target) = yes.
-
-target_supports_computed_goto(Globals) :-
-    globals.get_target(Globals, Target),
-    target_supports_computed_goto_2(Target) = yes.
-
-:- func target_supports_int_switch_2(compilation_target) = bool.
-:- func target_supports_string_switch_2(compilation_target) = bool.
-:- func target_supports_goto_2(compilation_target) = bool.
-:- func target_supports_computed_goto_2(compilation_target) = bool.
-
-target_supports_int_switch_2(target_c) = yes.
-target_supports_int_switch_2(target_asm) = yes.
-target_supports_int_switch_2(target_il) = no.
-target_supports_int_switch_2(target_csharp) = yes.
-target_supports_int_switch_2(target_java) = yes.
-target_supports_int_switch_2(target_x86_64) =
-    unexpected($module, $pred, "target x86_64 with --high-level code").
-target_supports_int_switch_2(target_erlang) =
-    unexpected($module, $pred, "target erlang").
-
-target_supports_string_switch_2(target_c) = no.
-target_supports_string_switch_2(target_asm) = no.
-target_supports_string_switch_2(target_il) = no.
-target_supports_string_switch_2(target_csharp) = yes.
-target_supports_string_switch_2(target_java) = no.
-    % String switches were added in Java 7.
-target_supports_string_switch_2(target_x86_64) =
-    unexpected($module, $pred, "target x86_64 with --high-level code").
-target_supports_string_switch_2(target_erlang) =
-    unexpected($module, $pred, "target erlang").
-
-target_supports_computed_goto_2(target_c) = yes.
-target_supports_computed_goto_2(target_asm) = no.
-    % XXX for asm, it should be `yes', but currently
-    % computed gotos are not yet implemented in gcc.m.
-target_supports_computed_goto_2(target_il) = yes.
-target_supports_computed_goto_2(target_csharp) = yes.
-target_supports_computed_goto_2(target_java) = no.
-% target_supports_computed_goto_2(c_sharp) = no.
-target_supports_computed_goto_2(target_x86_64) =
-    unexpected($module, $pred, "target x86_64 with --high-level code").
-target_supports_computed_goto_2(target_erlang) =
-    unexpected($module, $pred, "target erlang").
-
-target_supports_goto_2(target_c) = yes.
-target_supports_goto_2(target_asm) = yes.
-target_supports_goto_2(target_il) = yes.
-target_supports_goto_2(target_csharp) = yes.
-target_supports_goto_2(target_java) = no.
-target_supports_goto_2(target_x86_64) =
-    unexpected($module, $pred, "target x86_64 with --high-level code").
-target_supports_goto_2(target_erlang) =
-    unexpected($module, $pred, "target erlang").
-
-%-----------------------------------------------------------------------------%
-
     % Look up the representation (tag) for the cons_id in each case.
     % Also look up the priority of each tag test.
     %
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.159
diff -u -b -r1.159 ml_unify_gen.m
--- compiler/ml_unify_gen.m	5 Jul 2011 03:34:32 -0000	1.159
+++ compiler/ml_unify_gen.m	14 Aug 2011 10:19:18 -0000
@@ -136,6 +136,7 @@
 :- import_module ml_backend.ml_code_gen.
 :- import_module ml_backend.ml_code_util.
 :- import_module ml_backend.ml_global_data.
+:- import_module ml_backend.ml_target_util.
 :- import_module ml_backend.ml_type_gen.
 :- import_module ml_backend.ml_util.
 :- import_module parse_tree.builtin_lib_types.
@@ -552,20 +553,6 @@
         )
     ).
 
-    % This should return `yes' iff downcasts are not needed.
-    %
-:- func target_supports_inheritence(compilation_target) = bool.
-
-target_supports_inheritence(target_c) = no.
-target_supports_inheritence(target_il) = yes.
-target_supports_inheritence(target_csharp) = yes.
-target_supports_inheritence(target_java) = yes.
-target_supports_inheritence(target_asm) = no.
-target_supports_inheritence(target_x86_64) =
-    unexpected($module, $pred, "target_x86_64 and --high-level-code").
-target_supports_inheritence(target_erlang) =
-    unexpected($module, $pred, "target erlang").
-
 %-----------------------------------------------------------------------------%
 
     % Convert a cons_id for a given type to a cons_tag.
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.152
diff -u -b -r1.152 compiler_design.html
--- compiler/notes/compiler_design.html	13 Jul 2011 01:45:26 -0000	1.152
+++ compiler/notes/compiler_design.html	14 Aug 2011 10:23:15 -0000
@@ -1609,8 +1609,8 @@
      in ml_gen_info.m, while global data structures (those created at
      module scope) are handled in ml_global_data.m.
      The module ml_accurate_gc.m handles provisions for accurate garbage
-     collection, while the modules ml_code_util.m and ml_util.m provide
-     some general utility routines.
+     collection, while the modules ml_code_util.m, ml_target_util.m and
+     ml_util.m provide some general utility routines.
 <li> ml_type_gen.m converts HLDS types to MLDS.
 <li> type_ctor_info.m and base_typeclass_info.m generate
      the RTTI data structures defined in rtti.m and pseudo_type_info.m
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/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
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
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/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
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
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
Index: tools/makebatch
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/makebatch,v
retrieving revision 1.37
diff -u -b -r1.37 makebatch
--- tools/makebatch	8 Jun 2006 02:51:54 -0000	1.37
+++ tools/makebatch	14 Aug 2011 09:37:13 -0000
@@ -40,7 +40,7 @@
 save_stage2_on_no_compiler="false"
 errfiles="false"
 compile_times=""
-testparams=""
+test_params=""
 stop_after_stage_2=""
 failed="continue"
 
@@ -231,7 +231,7 @@
     succeeded=false
     created_compiler=false
     if tools/bootcheck $gradeopt --copy-runtime $jfactor $runtests \
-        $objects $compile_times $stop_after_stage_2 $testparams \
+        $objects $compile_times $stop_after_stage_2 $test_params \
         > batch/$batch.out.$visn 2>&1
     then
         succeeded=true
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