[m-rev.] for review: switch arms for more than one cons_id
Zoltan Somogyi
zs at csse.unimelb.edu.au
Fri Dec 14 18:59:29 AEDT 2007
For review by anyone. I have tested this in several grades, but not yet at
several optimization levels (except for the test that lead to the filing
of Mantis bug 32). I intend to do those tests over the weekend.
Zoltan.
-------------------------------------------------------------
Implement true multi-cons_id arm switches, i.e. switches in which we associate
more than one cons_id with a switch arm. Previously, for switches like this:
(
X = a,
goal1
;
( X = b
; X = c
),
goal2
)
we duplicated goal2. With this diff, goal2 won't be duplicated. We still
duplicate goals when that is necessary, i.e. in cases which the inner
disjunction contains code other than a functor test on the switched-on var,
like this:
(
X = a,
goal1
;
(
X = b,
goalb
;
X = c
goalc
),
goal2
)
For now, true multi-cons_id arm switches are supported only by the LLDS
backend. Supporting them on the MLDS backend is trickier, because some MLDS
target languages (e.g. Java) don't support the concept at all. So when
compiling to MLDS, we still duplicate the goal in switch detection (although
we could delay the duplication to just before code generation, if we wanted.)
compiler/options.m:
Add an internal option that tells switch detection whether to look for
multi-cons_id switch arms.
compiler/handle_options.m:
Set this option based on the back end.
compiler/hlds_goal.m:
Extend the representation of switch cases to allow more than one
cons_id for a switch arm.
Add a type for representing switches that also includes tag information
(for use by the backends).
compiler/hlds_data.m:
For du types, record whether it is possible to speed up tests for one
cons_id (e.g. cons) by testing for the other (nil) and negating the
result. Recording this information once is faster than having
unify_gen.m trying to compute it from scratch for every single
tag test.
Add a type for representing a cons_id together with its tag.
compiler/hlds_out.m:
Print out the cheaper_tag_test information for types, and possibly
several cons_ids for each switch arm.
Add some utility predicates for describing switch arms in terms of
which cons_ids they are for.
Replace some booleans with purpose-specific types.
compiler/add_type.m:
Fill in the information about cheaper tag tests when adding a du type.
compiler/switch_detection.m:
Extend the switch detection algorithm to detect multi-cons_id switch
arms.
When entering a switch arm, update the instmap to reflect that the
switched-on variable can now be bound only to the cons_ids that this
switch arm is for. We now need to do this, because if the arm contains
another switch on the same variable, computing the can_fail field of
that switch correctly requires us to know this information.
(Obviously, an arm for a single cons_id is unlikely to have switch on
the same variable, and for arms for several cons_ids, we previously
duplicated the arm and left the unification with the cons_id in each
copy, and this unification allowed the correct handling of any later
switches. However, the code of a multi-cons_id switch arm obviously
cannot have a unification with each cons_id in it, which is why
we now need to get the binding information from the switch itself.)
Replace some booleans with purpose-specific types, and give some
predicates better names.
compiler/instmap.m:
Provide predicates for recording that a switched-on variable has
one of several given cons_ids, for use at the starts of switch arms.
Give some predicates better names.
compiler/modes.m:
Provide predicates for updating the mode_info at the start of a
multi-cons_id switch arm.
compiler/det_report.m:
Handle multi-cons_id switch arms.
Update the instmap when entering each switch arm, since this is needed
to provide good (i.e. non-misleading) error messages when one switch on
a variable exists inside another switch on the same variable.
Since updating the instmap requires updating the module_info (since
the new inst may require a new entry in an inst table), thread the
det_info through as updateable state.
Replace some multi-clause predicate definitions with single clauses,
to make it easier to print the arguments in mdb.
Fix some misleading variable names.
compiler/det_analysis.m:
Update the instmap when entering each switch arm and thread the
det_info through as updateable state, since the predicates we call
in det_report.m require this.
compiler/det_util.m:
Handle multi-cons_id switch arms.
Rationalize the argument order of some access predicates.
compiler/switch_util.m:
Change the parts of this module that deal with string and tag switches
to optionally convert each arm to an arbitrary representation of the
arm. In the LLDS backend, the conversion process generated code for
the arm, and the arm's representation is the label at the start of
this code. This way, we can duplicate the label without duplicating
the code.
Add a new part of this module that associates each cons_id with its
tag, and (during the same pass) checks whether all the cons_ids are
integers, and if so what are min and max of these integers (needed
for dense switches). This scan is needed because the old way of making
this test had single-cons_id switch arms as one of its basic
assumptions, and doing it while adding tags to each case reduces
the number of traversals required.
Give better names to some predicates.
compiler/switch_case.m:
New module to handle the tasks associated with managing multi-cons_id
switch arms, including representing them for switch_util.m.
compiler/ll_backend.m:
Include the new module.
compiler/notes/compiler_design.html:
Note the new module.
compiler/llds.m:
Change the computed goto instruction to take a list of maybe labels
instead of a list of labels, with any missing labels meaning "not
reached".
compiler/string_switch.m:
compiler/tag_switch.m:
Reorganize the way these modules work. We can't generate the code of
each arm in place anymore, since it is now possible for more than one
cons_id to call for the execution of the same code. Instead, in
string_switch.m, we generate the codes of all the arms all at once,
and construct the hash index afterwards. (This approach simplifies
the code significantly.)
In tag switches (unlike string switches), we can get locality benefits
if the code testing for a cons_id is close to the code for that
cons_id, so we still try to put them next to each other when such
a locality benefit is available.
In both modules, the new approach uses a utility predicate in
switch_case.m to actually generate the code of each switch arm,
eliminating several copies the same code in the old versions of these
modules.
In tag_switch.m, don't create a local label that simply jumps to the
code address do_not_reached. Previously, we had to do this for
positions in jump tables that corresponded to cons_ids that the switch
variable could not be bound to. With the change to llds.m, we now
simply generate a "no" instead.
compiler/lookup_switch.m:
Get the info about int switch limits from our caller; don't compute it
here.
Give some variables better names.
compiler/dense_switch.m:
Generate the codes of the cases all at once, then assemble the table,
duplicate the labels as needed. This separation of concerns allows
significant simplifications.
Pack up all the information shared between the predicate that detects
whether a dense switch is appropriate and the predicate that actually
generates the dense switch.
Move some utility predicates to switch_util.
compiler/switch_gen.m:
Delete the code for tagging cons_ids, since that functionality is now
in switch_util.m.
The old version of this module could call the code generator to produce
(i.e. materialize) the switched-on variable repeatedly. We now produce
the variable once, and do the switch on the resulting rval.
compiler/unify_gen.m:
Use the information about cheaper tag tests in the type constructor's
entry in the HLDS type table, instead of trying to recompute it
every time.
Provide the predicates switch_gen.m now needs to perform tag tests
on rvals, as opposed to variables, and against possible more than one
cons_id.
Allow the caller to provide the tag corresponding to the cons_id(s)
in tag tests, since when we are generating code for switches, the
required computations have already been done.
Factor out some code to make all this possible.
Give better names to some predicates.
compiler/code_info.m:
Provide some utility predicates for the new code in other modules.
Give better names to some existing predicates.
compiler/hlds_code_util.m:
Rationalize the argument order of some predicates.
Replace some multi-clause predicate definitions with single clauses,
to make it easier to print the arguments in mdb.
compiler/accumulator.m:
compiler/add_heap_ops.m:
compiler/add_pragma.m:
compiler/add_trail_ops.m:
compiler/assertion.m:
compiler/build_mode_constraints.m:
compiler/check_typeclass.m:
compiler/closure_analysis.m:
compiler/code_util.m:
compiler/constraint.m:
compiler/cse_detection.m:
compiler/dead_proc_elim.m:
compiler/deep_profiling.m:
compiler/deforest.m:
compiler/delay_construct.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/distance_granularity.m:
compiler/equiv_type_hlds.m:
compiler/erl_code_gen.m:
compiler/exception_analysis.m:
compiler/export.m:
compiler/follow_code.m:
compiler/follow_vars.m:
compiler/foreign.m:
compiler/format_call.m:
compiler/goal_form.m:
compiler/goal_path.m:
compiler/goal_util.m:
compiler/granularity.m:
compiler/higher_order.m:
compiler/implicit_parallelism.m:
compiler/inlining.m:
compiler/inst_check.m:
compiler/intermod.m:
compiler/interval.m:
compiler/lambda.m:
compiler/lco.m:
compiler/live_vars.m:
compiler/liveness.m:
compiler/loop_inv.m:
compiler/make_hlds_warn.m:
compiler/mark_static_terms.m:
compiler/middle_rec.m:
compiler/ml_tag_switch.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/mode_constraints.m:
compiler/mode_errors.m:
compiler/mode_util.m:
compiler/pd_cost.m:
compiler/pd_into.m:
compiler/pd_util.m:
compiler/lambda.m:
compiler/polymorphism.m:
compiler/post_term_analysis.m:
compiler/post_typecheck.m:
compiler/purity.m:
compiler/quantification.m:
compiler/rbmm.actual_region_arguments.m:
compiler/rbmm.add_rbmm_goal_infos.m:
compiler/rbmm.condition_renaming.m:
compiler/rbmm.execution_paths.m:
compiler/rbmm.points_to_analysis.m:
compiler/rbmm.region_transformation.m:
compiler/recompilation.usage.m:
compiler/saved_vars.m:
compiler/simplify.m:
compiler/size_prof.m:
compiler/ssdebug.m:
compiler/store_alloc.m:
compiler/stratify.m:
compiler/structure_reuse.direct.choose_reuse.m:
compiler/structure_reuse.indirect.m:
compiler/structure_reuse.lbu.m:
compiler/structure_reuse.lfu.m:
compiler/structure_reuse.versions.m:
compiler/structure_sharing.analysis.m:
compiler/table_gen.m:
compiler/tabling_analysis.m:
compiler/term_constr_build.m:
compiler/term_norm.m:
compiler/term_pass1.m:
compiler/term_traversal.m:
compiler/trailing_analysis.m:
compiler/tupling.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
compiler/unify_proc.m:
compiler/unique_modes.m:
compiler/unneeded_code.m:
compiler/untupling.m:
compiler/unused_args.m:
compiler/unused_imports.m:
compiler/lambda.m:
compiler/xml_documentation.m:
Make the changes necessary to conform to the changes above, principally
to handle multi-arm switches.
compiler/ml_string_switch.m:
Make the changes necessary to conform to the changes above, principally
to handle multi-arm switches.
Give some predicates better names.
compiler/dependency_graph.m:
Make the changes necessary to conform to the changes above, principally
to handle multi-arm switches. Change the order of arguments of some
predicates to make this easier.
compiler/bytecode.m:
compiler/bytecode_data.m:
compiler/bytecode_gen.m:
Make the changes necessary to conform to the changes above, principally
to handle multi-arm switches. (The bytecode interpreter has not been
updated.)
compiler/prog_rep.m:
mdbcomp/program_representation.m:
Change the byte sequence representation of goals to allow switch arms
with more than one cons_id. compiler/prog_rep.m now writes out the
updated representation, while mdbcomp/program_representation.m reads in
the updated representation.
deep_profiler/mdbprof_procrep.m:
Conform to the updated program representation.
tools/binary:
Fix a bug: if the -D option was given, the stage 2 directory wasn't
being initialized.
Abort if users try to give that option more than once.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/Mercury.options,v
retrieving revision 1.32
diff -u -b -r1.32 Mercury.options
--- compiler/Mercury.options 14 Aug 2007 01:52:27 -0000 1.32
+++ compiler/Mercury.options 14 Dec 2007 07:44:38 -0000
@@ -51,6 +51,9 @@
# Bug workarounds
+# This works around bug 32 in Mantis.
+MCFLAGS-check_hlds.check_typeclass = --no-loop-invariants
+
# This is the same bug as tests/valid/ho_and_type_spec_bug2.
MCFLAGS-mode_robdd.tfeirn = -O3
MCFLAGS-mode_robdd.implications = -O0
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.71
diff -u -b -r1.71 accumulator.m
--- compiler/accumulator.m 23 Nov 2007 07:34:52 -0000 1.71
+++ compiler/accumulator.m 23 Nov 2007 14:57:39 -0000
@@ -450,7 +450,7 @@
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = switch(_Var, _CanFail, Cases),
- Cases = [case(_IdA, GoalA), case(_IdB, GoalB)],
+ Cases = [case(_IdA, [], GoalA), case(_IdB, [], GoalB)],
goal_to_conj_list(GoalA, GoalAList),
goal_to_conj_list(GoalB, GoalBList)
->
@@ -1686,12 +1686,12 @@
NewBaseGoal, NewRecGoal, OrigGoal, NewGoal) :-
(
Goal = hlds_goal(switch(Var, CanFail, Cases0), GoalInfo),
- Cases0 = [case(IdA, _), case(IdB, _)]
+ Cases0 = [case(IdA, [], _), case(IdB, [], _)]
->
- OrigCases = [case(IdA, OrigBaseGoal), case(IdB, OrigRecGoal)],
+ OrigCases = [case(IdA, [], OrigBaseGoal), case(IdB, [], OrigRecGoal)],
OrigGoal = hlds_goal(switch(Var, CanFail, OrigCases), GoalInfo),
- NewCases = [case(IdA, NewBaseGoal), case(IdB, NewRecGoal)],
+ NewCases = [case(IdA, [], NewBaseGoal), case(IdB, [], NewRecGoal)],
NewGoal = hlds_goal(switch(Var, CanFail, NewCases), GoalInfo)
;
unexpected(this_file, "top_level: not the correct top level")
@@ -1700,12 +1700,12 @@
NewBaseGoal, NewRecGoal, OrigGoal, NewGoal) :-
(
Goal = hlds_goal(switch(Var, CanFail, Cases0), GoalInfo),
- Cases0 = [case(IdA, _), case(IdB, _)]
+ Cases0 = [case(IdA, [], _), case(IdB, [], _)]
->
- OrigCases = [case(IdA, OrigRecGoal), case(IdB, OrigBaseGoal)],
+ OrigCases = [case(IdA, [], OrigRecGoal), case(IdB, [], OrigBaseGoal)],
OrigGoal = hlds_goal(switch(Var, CanFail, OrigCases), GoalInfo),
- NewCases = [case(IdA, NewRecGoal), case(IdB, NewBaseGoal)],
+ NewCases = [case(IdA, [], NewRecGoal), case(IdB, [], NewBaseGoal)],
NewGoal = hlds_goal(switch(Var, CanFail, NewCases), GoalInfo)
;
unexpected(this_file, "top_level: not the correct top level")
Index: compiler/add_heap_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_heap_ops.m,v
retrieving revision 1.36
diff -u -b -r1.36 add_heap_ops.m
--- compiler/add_heap_ops.m 23 Nov 2007 07:34:53 -0000 1.36
+++ compiler/add_heap_ops.m 23 Nov 2007 09:38:35 -0000
@@ -301,9 +301,9 @@
cases_add_heap_ops([], [], !Info).
cases_add_heap_ops([Case0 | Cases0], [Case | Cases], !Info) :-
- Case0 = case(ConsId, Goal0),
- Case = case(ConsId, Goal),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
goal_add_heap_ops(Goal0, Goal, !Info),
+ Case = case(MainConsId, OtherConsIds, Goal),
cases_add_heap_ops(Cases0, Cases, !Info).
%-----------------------------------------------------------------------------%
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.74
diff -u -b -r1.74 add_pragma.m
--- compiler/add_pragma.m 5 Dec 2007 05:07:31 -0000 1.74
+++ compiler/add_pragma.m 7 Dec 2007 01:48:17 -0000
@@ -548,12 +548,13 @@
]
;
(
- TypeBody0 = hlds_du_type(Body, _CtorTags0, _IsEnum0,
- MaybeUserEqComp, ReservedTag0, _ReservedAddr, IsForeign),
+ TypeBody0 = hlds_du_type(Body, _CtorTags0, _CheaperTagTest,
+ _IsEnum0, MaybeUserEqComp, ReservedTag0, _ReservedAddr,
+ IsForeign),
(
ReservedTag0 = uses_reserved_tag,
% Make doubly sure that we don't get any spurious warnings
- % with intermodule optimization...
+ % with intermodule optimization ...
TypeStatus \= status_opt_imported
->
MaybeSeverity = yes(severity_warning),
@@ -573,8 +574,9 @@
module_info_get_globals(!.ModuleInfo, Globals),
assign_constructor_tags(Body, MaybeUserEqComp, TypeCtor,
ReservedTag, Globals, CtorTags, ReservedAddr, EnumDummy),
- TypeBody = hlds_du_type(Body, CtorTags, EnumDummy,
- MaybeUserEqComp, ReservedTag, ReservedAddr, IsForeign),
+ TypeBody = hlds_du_type(Body, CtorTags, no_cheaper_tag_test,
+ EnumDummy, MaybeUserEqComp, ReservedTag, ReservedAddr,
+ IsForeign),
hlds_data.set_type_defn_body(TypeBody, TypeDefn0, TypeDefn),
map.set(Types0, TypeCtor, TypeDefn, Types),
module_info_set_type_table(Types, !ModuleInfo)
@@ -659,8 +661,9 @@
]
;
% XXX How should we handle IsForeignType here?
- TypeBody = hlds_du_type(Ctors, _TagValues, IsEnumOrDummy,
- _MaybeUserEq, _ReservedTag, _ReservedAddr, _IsForeignType),
+ TypeBody = hlds_du_type(Ctors, _TagValues, _CheaperTagTest,
+ IsEnumOrDummy, _MaybeUserEq, _ReservedTag, _ReservedAddr,
+ _IsForeignType),
(
( IsEnumOrDummy = is_mercury_enum
; IsEnumOrDummy = is_foreign_enum(_)
@@ -1006,8 +1009,9 @@
suffix(".")
]
;
- TypeBody0 = hlds_du_type(Ctors, OldTagValues, IsEnumOrDummy0,
- MaybeUserEq, ReservedTag, ReservedAddr, IsForeignType),
+ TypeBody0 = hlds_du_type(Ctors, OldTagValues, CheaperTagTest,
+ IsEnumOrDummy0, MaybeUserEq, ReservedTag, ReservedAddr,
+ IsForeignType),
%
% Work out what language's foreign_enum pragma we should be
% looking at for the the current compilation target language.
@@ -1052,8 +1056,8 @@
(
UnmappedCtors = [],
TypeBody = hlds_du_type(Ctors, TagValues,
- IsEnumOrDummy, MaybeUserEq, ReservedTag,
- ReservedAddr, IsForeignType),
+ CheaperTagTest, IsEnumOrDummy, MaybeUserEq,
+ ReservedTag, ReservedAddr, IsForeignType),
set_type_defn_body(TypeBody, TypeDefn0, TypeDefn),
svmap.set(TypeCtor, TypeDefn, TypeTable0,
TypeTable),
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.48
diff -u -b -r1.48 add_trail_ops.m
--- compiler/add_trail_ops.m 23 Nov 2007 07:34:53 -0000 1.48
+++ compiler/add_trail_ops.m 23 Nov 2007 09:38:21 -0000
@@ -388,11 +388,10 @@
)
),
goal_add_trail_ops(Goal0, Goal1, !Info),
- %
+
% For model_semi and model_det disjunctions, once we reach the end of
% the disjunct goal, we're committing to this disjunct, so we need to
% prune the trail ticket.
- %
(
CodeModel = model_non,
PruneList = []
@@ -405,14 +404,12 @@
gen_prune_ticket(Context, PruneTicketGoal, !.Info),
PruneList = [ResetTicketCommitGoal, PruneTicketGoal]
),
- %
+
% Package up the stuff we built earlier.
- %
Goal1 = hlds_goal(_, GoalInfo1),
conj_list_to_goal(UndoList ++ [Goal1] ++ PruneList, GoalInfo1, Goal),
- %
+
% Recursively handle the remaining disjuncts.
- %
disj_add_trail_ops(Goals0, no, CodeModel, TicketVar, Goals, !Info).
:- pred cases_add_trail_ops(list(case)::in, list(case)::out,
@@ -420,9 +417,9 @@
cases_add_trail_ops([], [], !Info).
cases_add_trail_ops([Case0 | Cases0], [Case | Cases], !Info) :-
- Case0 = case(ConsId, Goal0),
- Case = case(ConsId, Goal),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
goal_add_trail_ops(Goal0, Goal, !Info),
+ Case = case(MainConsId, OtherConsIds, Goal),
cases_add_trail_ops(Cases0, Cases, !Info).
%-----------------------------------------------------------------------------%
Index: compiler/add_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_type.m,v
retrieving revision 1.30
diff -u -b -r1.30 add_type.m
--- compiler/add_type.m 23 Nov 2007 07:34:54 -0000 1.30
+++ compiler/add_type.m 12 Dec 2007 01:52:05 -0000
@@ -72,6 +72,7 @@
:- import_module int.
:- import_module map.
:- import_module multi_map.
+:- import_module pair.
:- import_module string.
:- import_module svmap.
:- import_module svmulti_map.
@@ -90,7 +91,7 @@
(
Body0 = hlds_abstract_type(_)
;
- Body0 = hlds_du_type(_, _, _, _, _, _, _),
+ Body0 = hlds_du_type(_, _, _, _, _, _, _, _),
string.suffix(term.context_file(Context), ".int2")
% If the type definition comes from a .int2 file then
% we need to treat it as abstract. The constructors
@@ -365,7 +366,7 @@
get_type_defn_need_qualifier(TypeDefn, NeedQual),
module_info_get_globals(!.ModuleInfo, Globals),
(
- Body = hlds_du_type(ConsList, _, _, UserEqCmp, ReservedTag, _, _),
+ Body = hlds_du_type(ConsList, _, _, _, UserEqCmp, ReservedTag, _, _),
module_info_get_cons_table(!.ModuleInfo, Ctors0),
module_info_get_partial_qualifier_info(!.ModuleInfo, PQInfo),
module_info_get_ctor_field_table(!.ModuleInfo, CtorFields0),
@@ -495,7 +496,7 @@
Body = Body1 ^ du_type_is_foreign_type := yes(ForeignTypeBody)
).
merge_foreign_type_bodies(Target, MakeOptInterface,
- Body0 @ hlds_du_type(_, _, _, _, _, _, _),
+ Body0 @ hlds_du_type(_, _, _, _, _, _, _, _),
Body1 @ hlds_foreign_type(_), Body) :-
merge_foreign_type_bodies(Target, MakeOptInterface, Body1, Body0, Body).
merge_foreign_type_bodies(_, _, hlds_foreign_type(Body0),
@@ -613,10 +614,35 @@
% with ReservedTagPragma = uses_reserved_tag, when processing the pragma.)
ReservedTagPragma = does_not_use_reserved_tag,
assign_constructor_tags(Body, MaybeUserEqComp, TypeCtor, ReservedTagPragma,
- Globals, CtorTags, ReservedAddr, IsEnum),
+ Globals, CtorTagMap, ReservedAddr, IsEnum),
IsForeign = no,
- HLDSBody = hlds_du_type(Body, CtorTags, IsEnum, MaybeUserEqComp,
- ReservedTagPragma, ReservedAddr, IsForeign).
+ (
+ ReservedAddr = does_not_use_reserved_address,
+ map.to_assoc_list(CtorTagMap, CtorTagList),
+ CtorTagList = [ConsIdA - ConsTagA, ConsIdB - ConsTagB],
+ ConsIdA = cons(_, ArityA),
+ ConsIdB = cons(_, ArityB)
+ ->
+ (
+ ArityB = 0,
+ ArityA > 0
+ ->
+ CheaperTagTest = cheaper_tag_test(ConsIdA, ConsTagA,
+ ConsIdB, ConsTagB)
+ ;
+ ArityA = 0,
+ ArityB > 0
+ ->
+ CheaperTagTest = cheaper_tag_test(ConsIdB, ConsTagB,
+ ConsIdA, ConsTagA)
+ ;
+ CheaperTagTest = no_cheaper_tag_test
+ )
+ ;
+ CheaperTagTest = no_cheaper_tag_test
+ ),
+ HLDSBody = hlds_du_type(Body, CtorTagMap, CheaperTagTest, IsEnum,
+ MaybeUserEqComp, ReservedTagPragma, ReservedAddr, IsForeign).
convert_type_defn(parse_tree_eqv_type(Body), _, _, hlds_eqv_type(Body)).
convert_type_defn(parse_tree_solver_type(SolverTypeDetails, MaybeUserEqComp),
_, _, hlds_solver_type(SolverTypeDetails, MaybeUserEqComp)).
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.58
diff -u -b -r1.58 assertion.m
--- compiler/assertion.m 7 Aug 2007 07:09:46 -0000 1.58
+++ compiler/assertion.m 23 Nov 2007 15:19:42 -0000
@@ -619,8 +619,10 @@
equal_goals_cases([], [], !Subst).
equal_goals_cases([CaseA | CaseAs], [CaseB | CaseBs], !Subst) :-
- CaseA = case(ConsId, GoalA),
- CaseB = case(ConsId, GoalB),
+ CaseA = case(MainConsIdA, OtherConsIdsA, GoalA),
+ CaseB = case(MainConsIdB, OtherConsIdsB, GoalB),
+ list.sort([MainConsIdA | OtherConsIdsA], SortedConsIds),
+ list.sort([MainConsIdB | OtherConsIdsB], SortedConsIds),
equal_goals(GoalA, GoalB, !Subst),
equal_goals_cases(CaseAs, CaseBs, !Subst).
@@ -733,9 +735,9 @@
normalise_cases([], []).
normalise_cases([Case0 | Cases0], [Case | Cases]) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
normalise_goal(Goal0, Goal),
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
normalise_cases(Cases0, Cases).
:- pred normalise_goals(hlds_goals::in, hlds_goals::out) is det.
Index: compiler/build_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/build_mode_constraints.m,v
retrieving revision 1.28
diff -u -b -r1.28 build_mode_constraints.m
--- compiler/build_mode_constraints.m 12 Nov 2007 03:52:40 -0000 1.28
+++ compiler/build_mode_constraints.m 23 Nov 2007 09:21:12 -0000
@@ -314,7 +314,7 @@
GoalExpr = generic_call(_, _, _, _)
;
GoalExpr = switch(_, _, Cases),
- Goals = list.map(func(case(_, Goal)) = Goal, Cases),
+ Goals = list.map(func(case(_, _, Goal)) = Goal, Cases),
list.foldl(add_mc_vars_for_goal(PredId, ProgVarset), Goals, !VarInfo)
;
GoalExpr = unify(_, _, _, _, _)
Index: compiler/bytecode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode.m,v
retrieving revision 1.73
diff -u -b -r1.73 bytecode.m
--- compiler/bytecode.m 23 Nov 2007 07:34:54 -0000 1.73
+++ compiler/bytecode.m 23 Nov 2007 15:14:20 -0000
@@ -49,7 +49,8 @@
; byte_endof_disjunct(byte_label_id)
; byte_enter_switch(byte_var, byte_label_id)
; byte_endof_switch
- ; byte_enter_switch_arm(byte_cons_id, byte_label_id)
+ ; byte_enter_switch_arm(byte_cons_id, list(byte_cons_id),
+ byte_label_id)
; byte_endof_switch_arm(byte_label_id)
; byte_enter_if(byte_label_id, byte_label_id, byte_temp)
; byte_enter_then(byte_temp)
@@ -258,8 +259,12 @@
output_var(Var, !IO),
output_label_id(LabelId, !IO).
output_args(byte_endof_switch, !IO).
-output_args(byte_enter_switch_arm(ConsId, NextLabelId), !IO) :-
- output_cons_id(ConsId, !IO),
+output_args(byte_enter_switch_arm(MainConsId, OtherConsIds, NextLabelId),
+ !IO) :-
+ output_cons_id(MainConsId, !IO),
+ % The interpreter doesn't yet implement switch arms with more than one
+ % function symbol.
+ expect(unify(OtherConsIds, []), this_file, "output_args: OtherConsIds"),
output_label_id(NextLabelId, !IO).
output_args(byte_endof_switch_arm(LabelId), !IO) :-
output_label_id(LabelId, !IO).
@@ -388,8 +393,10 @@
debug_var(Var, !IO),
debug_label_id(LabelId, !IO).
debug_args(byte_endof_switch, !IO).
-debug_args(byte_enter_switch_arm(ConsId, NextLabelId), !IO) :-
- debug_cons_id(ConsId, !IO),
+debug_args(byte_enter_switch_arm(MainConsId, OtherConsIds,
+ NextLabelId), !IO) :-
+ debug_cons_id(MainConsId, !IO),
+ list.foldl(debug_cons_id, OtherConsIds, !IO),
debug_label_id(NextLabelId, !IO).
debug_args(byte_endof_switch_arm(LabelId), !IO) :-
debug_label_id(LabelId, !IO).
@@ -922,7 +929,7 @@
byte_code(byte_endof_disjunct(_), 8).
byte_code(byte_enter_switch(_, _), 9).
byte_code(byte_endof_switch, 10).
-byte_code(byte_enter_switch_arm(_, _), 11).
+byte_code(byte_enter_switch_arm(_, _, _), 11).
byte_code(byte_endof_switch_arm(_), 12).
byte_code(byte_enter_if(_, _, _), 13).
byte_code(byte_enter_then(_), 14).
@@ -967,7 +974,7 @@
byte_debug(byte_endof_disjunct(_), "endof_disjunct").
byte_debug(byte_enter_switch(_, _), "enter_switch").
byte_debug(byte_endof_switch, "endof_switch").
-byte_debug(byte_enter_switch_arm(_, _), "enter_switch_arm").
+byte_debug(byte_enter_switch_arm(_, _, _), "enter_switch_arm").
byte_debug(byte_endof_switch_arm(_), "endof_switch_arm").
byte_debug(byte_enter_if(_, _, _), "enter_if").
byte_debug(byte_enter_then(_), "enter_then").
Index: compiler/bytecode_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_data.m,v
retrieving revision 1.23
diff -u -b -r1.23 bytecode_data.m
--- compiler/bytecode_data.m 27 Feb 2007 02:10:53 -0000 1.23
+++ compiler/bytecode_data.m 23 Nov 2007 10:31:37 -0000
@@ -22,7 +22,7 @@
%---------------------------------------------------------------------------%
- % XXX this assumes strings contain 8-bit characters
+ % XXX This assumes strings contain 8-bit characters.
:- pred output_string(string::in, io::di, io::uo) is det.
:- pred string_to_byte_list(string::in, list(int)::out) is det.
@@ -77,12 +77,11 @@
io.write_byte(0, !IO).
string_to_byte_list(Val, List) :-
- % XXX this assumes strings contain 8-bit characters
- % Using char.to_int here is wrong; the output will depend
- % on the Mercury implementation's representation of chars,
- % so it may be different for different Mercury implementations.
- % In particular, it will do the wrong thing for Mercury
- % implementations which represent characters in Unicode.
+ % XXX This assumes strings contain 8-bit characters.
+ % Using char.to_int here is wrong; the output will depend on the Mercury
+ % implementation's representation of chars, so it may be different for
+ % different Mercury implementations. In particular, it will do the wrong
+ % thing for Mercury implementations which represent characters in Unicode.
string.to_char_list(Val, Chars),
ToInt = (pred(C::in, I::out) is det :- char.to_int(C, I)),
list.map(ToInt, Chars, List0),
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.116
diff -u -b -r1.116 bytecode_gen.m
--- compiler/bytecode_gen.m 23 Nov 2007 07:34:54 -0000 1.116
+++ compiler/bytecode_gen.m 29 Nov 2007 01:35:02 -0000
@@ -694,15 +694,17 @@
byte_info::in, byte_info::out, byte_tree::out) is det.
gen_switch([], _, _, !ByteInfo, empty).
-gen_switch([case(ConsId, Goal) | Cases], Var, EndLabel,
- !ByteInfo, Code) :-
- map_cons_id(!.ByteInfo, Var, ConsId, ByteConsId),
- gen_goal(Goal, !ByteInfo, ThisCode),
- gen_switch(Cases, Var, EndLabel, !ByteInfo, OtherCode),
+gen_switch([Case | Cases], Var, EndLabel, !ByteInfo, Code) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ map_cons_id(!.ByteInfo, Var, MainConsId, ByteMainConsId),
+ list.map(map_cons_id(!.ByteInfo, Var), OtherConsIds, ByteOtherConsIds),
+ gen_goal(Goal, !ByteInfo, GoalCode),
+ gen_switch(Cases, Var, EndLabel, !ByteInfo, CasesCode),
get_next_label(NextLabel, !ByteInfo),
- EnterCode = node([byte_enter_switch_arm(ByteConsId, NextLabel)]),
+ EnterCode = node([
+ byte_enter_switch_arm(ByteMainConsId, ByteOtherConsIds, NextLabel)]),
EndofCode = node([byte_endof_switch_arm(EndLabel), byte_label(NextLabel)]),
- Code = tree_list([EnterCode, ThisCode, EndofCode, OtherCode]).
+ Code = tree_list([EnterCode, GoalCode, EndofCode, CasesCode]).
%---------------------------------------------------------------------------%
@@ -734,7 +736,7 @@
;
Functor = qualified(ModuleName, FunctorName)
),
- ConsTag = cons_id_to_tag(ConsId, Type, ModuleInfo),
+ ConsTag = cons_id_to_tag(ModuleInfo, Type, ConsId),
map_cons_tag(ConsTag, ByteConsTag),
ByteConsId = byte_cons(ModuleName, FunctorName, Arity, ByteConsTag)
)
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.117
diff -u -b -r1.117 check_typeclass.m
--- compiler/check_typeclass.m 23 Nov 2007 07:34:55 -0000 1.117
+++ compiler/check_typeclass.m 14 Dec 2007 07:45:15 -0000
@@ -1338,7 +1338,7 @@
is_valid_instance_type(MI, ClassId, InstanceDefn, EqvType, N,
_, !SeenTypes, !Specs)
;
- ( TypeBody = hlds_du_type(_, _, _, _, _, _, _)
+ ( TypeBody = hlds_du_type(_, _, _, _, _, _, _, _)
; TypeBody = hlds_foreign_type(_)
; TypeBody = hlds_solver_type(_, _)
; TypeBody = hlds_abstract_type(_)
@@ -1577,7 +1577,7 @@
map.lookup(TypeTable, TypeCtor, TypeDefn),
get_type_defn_body(TypeDefn, Body),
(
- Body = hlds_du_type(Ctors, _, _, _, _, _, _),
+ Body = hlds_du_type(Ctors, _, _, _, _, _, _, _),
list.foldl2(check_ctor_type_ambiguities(TypeCtor, TypeDefn), Ctors,
!ModuleInfo, !Specs)
;
Index: compiler/closure_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/closure_analysis.m,v
retrieving revision 1.15
diff -u -b -r1.15 closure_analysis.m
--- compiler/closure_analysis.m 7 Aug 2007 07:09:47 -0000 1.15
+++ compiler/closure_analysis.m 23 Nov 2007 09:36:56 -0000
@@ -268,10 +268,10 @@
process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
Goal0 = hlds_goal(switch(SwitchVar, SwitchCanFail, Cases0), GoalInfo),
ProcessCase = (func(Case0) = Case - CaseInfo :-
- Case0 = case(ConsId, CaseGoal0),
+ Case0 = case(MainConsId, OtherConsIds, CaseGoal0),
process_goal(VarTypes, ModuleInfo, CaseGoal0, CaseGoal,
!.ClosureInfo, CaseInfo),
- Case = case(ConsId, CaseGoal)
+ Case = case(MainConsId, OtherConsIds, CaseGoal)
),
CasesAndInfos = list.map(ProcessCase, Cases0),
assoc_list.keys_and_values(CasesAndInfos, Cases, CasesInfo),
@@ -442,7 +442,7 @@
dump_closure_info_expr(Varset, scope(_, Goal), _, !IO) :-
dump_closure_info(Varset, Goal, !IO).
dump_closure_info_expr(Varset, switch(_, _, Cases), _, !IO) :-
- CaseToGoal = (func(case(_, Goal)) = Goal),
+ CaseToGoal = (func(case(_, _, Goal)) = Goal),
Goals = list.map(CaseToGoal, Cases),
list.foldl(dump_closure_info(Varset), Goals, !IO).
dump_closure_info_expr(Varset, if_then_else(_, Cond, Then, Else), _, !IO) :-
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.354
diff -u -b -r1.354 code_info.m
--- compiler/code_info.m 26 Nov 2007 05:13:18 -0000 1.354
+++ compiler/code_info.m 13 Dec 2007 00:34:36 -0000
@@ -745,11 +745,17 @@
%
:- func lookup_type_defn(code_info, mer_type) = hlds_type_defn.
+:- func lookup_cheaper_tag_test(code_info, mer_type) = maybe_cheaper_tag_test.
+
:- func filter_region_vars(code_info, set(prog_var)) = set(prog_var).
- % Given a constructor id, and a variable (so that we can work out the
- % type of the constructor), determine correct tag (representation)
- % of that constructor.
+ % XXX check if used
+ % Given a constructor id, and the type to which it belongs, determine
+ % the tag representing that constructor.
+ %
+:- func cons_id_to_tag_for_type(code_info, mer_type, cons_id) = cons_tag.
+
+ % As cons_id_to_tag_for_type, but get the type from the variable.
%
:- func cons_id_to_tag_for_var(code_info, prog_var, cons_id) = cons_tag.
@@ -774,7 +780,7 @@
%
:- func current_resume_point_vars(code_info) = set(prog_var).
-:- func variable_to_string(code_info, prog_var) = string.
+:- func variable_name(code_info, prog_var) = string.
% Create a code address which holds the address of the specified
% procedure.
@@ -934,14 +940,28 @@
unexpected(this_file, "lookup_type_defn: type ctor has no definition")
).
+lookup_cheaper_tag_test(CI, Type) = CheaperTagTest :-
+ (
+ search_type_defn(CI, Type, TypeDefn),
+ get_type_defn_body(TypeDefn, TypeBody),
+ TypeBody = hlds_du_type(_, _, CheaperTagTestPrime, _, _, _, _, _)
+ ->
+ CheaperTagTest = CheaperTagTestPrime
+ ;
+ CheaperTagTest = no_cheaper_tag_test
+ ).
+
filter_region_vars(CI, ForwardLiveVarsBeforeGoal) = RegionVars :-
VarTypes = code_info.get_var_types(CI),
RegionVars = set.filter(is_region_var(VarTypes),
ForwardLiveVarsBeforeGoal).
-cons_id_to_tag_for_var(CI, Var, ConsId) = ConsTag :-
+cons_id_to_tag_for_type(CI, Type, ConsId) = ConsTag :-
get_module_info(CI, ModuleInfo),
- ConsTag = cons_id_to_tag(ConsId, variable_type(CI, Var), ModuleInfo).
+ ConsTag = cons_id_to_tag(ModuleInfo, Type, ConsId).
+
+cons_id_to_tag_for_var(CI, Var, ConsId) =
+ cons_id_to_tag_for_type(CI, variable_type(CI, Var), ConsId).
%---------------------------------------------------------------------------%
@@ -974,7 +994,7 @@
map.keys(ResumeMap, ResumeMapVarList),
set.list_to_set(ResumeMapVarList, ResumeVars).
-variable_to_string(CI, Var) = Name :-
+variable_name(CI, Var) = Name :-
get_varset(CI, Varset),
varset.lookup_name(Varset, Var, Name).
@@ -1121,8 +1141,8 @@
:- pred reset_resume_known(position_info::in,
code_info::in, code_info::out) is det.
-:- pred generate_branch_end(abs_store_map::in, branch_end::in,
- branch_end::out, code_tree::out, code_info::in, code_info::out) is det.
+:- pred generate_branch_end(abs_store_map::in, branch_end::in, branch_end::out,
+ code_tree::out, code_info::in, code_info::out) is det.
:- pred after_all_branches(abs_store_map::in, branch_end::in,
code_info::in, code_info::out) is det.
@@ -1198,8 +1218,8 @@
;
MaybeEnd0 = yes(branch_end_info(EndCodeInfo0)),
- % Make sure the left context we leave the branched structure
- % with is valid for all branches.
+ % Make sure the left context we leave the branched structure with
+ % is valid for all branches.
get_fail_info(EndCodeInfo0, FailInfo0),
get_fail_info(EndCodeInfo1, FailInfo1),
FailInfo0 = fail_info(_, ResumeKnown0, CurfrMaxfr0, CondEnv0, Hijack0),
@@ -4420,11 +4440,11 @@
( map.search(StackSlots, Var, SlotLocn) ->
Slot = stack_slot_to_lval(SlotLocn)
;
- Name = variable_to_string(CI, Var),
+ Name = variable_name(CI, Var),
term.var_to_int(Var, Num),
string.int_to_string(Num, NumStr),
- string.append_list(["get_variable_slot: variable `",
- Name, "' (", NumStr, ") not found"], Str),
+ Str = "get_variable_slot: variable `" ++ Name ++ "' " ++
+ "(" ++ NumStr ++ ") not found",
unexpected(this_file, Str)
).
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.181
diff -u -b -r1.181 code_util.m
--- compiler/code_util.m 23 Nov 2007 07:34:57 -0000 1.181
+++ compiler/code_util.m 23 Nov 2007 08:06:50 -0000
@@ -282,7 +282,7 @@
:- pred cases_may_alloc_temp_frame(list(case)::in, bool::out) is det.
cases_may_alloc_temp_frame([], no).
-cases_may_alloc_temp_frame([case(_, Goal) | Cases], May) :-
+cases_may_alloc_temp_frame([case(_, _, Goal) | Cases], May) :-
( goal_may_alloc_temp_frame(Goal, yes) ->
May = yes
;
Index: compiler/complexity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/complexity.m,v
retrieving revision 1.30
diff -u -b -r1.30 complexity.m
--- compiler/complexity.m 23 Nov 2007 07:34:57 -0000 1.30
+++ compiler/complexity.m 23 Nov 2007 09:36:28 -0000
@@ -359,8 +359,8 @@
TSPB = mercury_term_size_prof_builtin_module,
SwitchArms = [
- case(cons(qualified(TSPB, "is_inactive"), 0), TransformedGoal),
- case(cons(qualified(TSPB, "is_active"), 0), OrigGoal)
+ case(cons(qualified(TSPB, "is_inactive"), 0), [], TransformedGoal),
+ case(cons(qualified(TSPB, "is_active"), 0), [], OrigGoal)
],
SwitchExpr = switch(IsActiveVar, cannot_fail, SwitchArms),
Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.87
diff -u -b -r1.87 constraint.m
--- compiler/constraint.m 23 Nov 2007 07:34:57 -0000 1.87
+++ compiler/constraint.m 23 Nov 2007 16:26:34 -0000
@@ -240,12 +240,14 @@
constraint_info::in, constraint_info::out, io::di, io::uo) is det.
propagate_cases(_, _, [], [], !Info, !IO).
-propagate_cases(Var, Constraints, [case(ConsId, Goal0) | Cases0],
- [case(ConsId, Goal) | Cases], !Info, !IO) :-
+propagate_cases(Var, Constraints, [Case0 | Cases0], [Case | Cases],
+ !Info, !IO) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
InstMap0 = !.Info ^ instmap,
- constraint_info_bind_var_to_functor(Var, ConsId, !Info),
+ constraint_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !Info),
propagate_goal(Goal0, Constraints, Goal, !Info, !IO),
!:Info = !.Info ^ instmap := InstMap0,
+ Case = case(MainConsId, OtherConsIds, Goal),
propagate_cases(Var, Constraints, Cases0, Cases, !Info, !IO).
%-----------------------------------------------------------------------------%
@@ -751,16 +753,16 @@
instmap.apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
!:Info = !.Info ^ instmap := InstMap.
-:- pred constraint_info_bind_var_to_functor(prog_var::in, cons_id::in,
- constraint_info::in, constraint_info::out) is det.
+:- pred constraint_info_bind_var_to_functors(prog_var::in, cons_id::in,
+ list(cons_id)::in, constraint_info::in, constraint_info::out) is det.
-constraint_info_bind_var_to_functor(Var, ConsId, !Info) :-
+constraint_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !Info) :-
InstMap0 = !.Info ^ instmap,
ModuleInfo0 = !.Info ^ module_info,
VarTypes = !.Info ^ vartypes,
map.lookup(VarTypes, Var, Type),
- instmap.bind_var_to_functor(Var, Type, ConsId, InstMap0, InstMap,
- ModuleInfo0, ModuleInfo),
+ bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
+ InstMap0, InstMap, ModuleInfo0, ModuleInfo),
!:Info = !.Info ^ instmap := InstMap,
!:Info = !.Info ^ module_info := ModuleInfo.
@@ -803,8 +805,8 @@
strip_constraint_markers_expr(switch(Var, CanFail, Cases0)) =
switch(Var, CanFail, Cases) :-
Cases = list.map(
- (func(case(ConsId, Goal)) =
- case(ConsId, strip_constraint_markers(Goal))
+ (func(case(MainConsId, OtherConsIds, Goal)) =
+ case(MainConsId, OtherConsIds, strip_constraint_markers(Goal))
), Cases0).
strip_constraint_markers_expr(negation(Goal)) =
negation(strip_constraint_markers(Goal)).
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.112
diff -u -b -r1.112 cse_detection.m
--- compiler/cse_detection.m 19 Nov 2007 06:11:16 -0000 1.112
+++ compiler/cse_detection.m 24 Nov 2007 10:00:04 -0000
@@ -409,9 +409,9 @@
detect_cse_in_cases_2([], _, !CseInfo, no, []).
detect_cse_in_cases_2([Case0 | Cases0], InstMap, !CseInfo, Redo,
[Case | Cases]) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
detect_cse_in_goal(Goal0, InstMap, !CseInfo, Redo1, Goal),
- Case = case(Functor, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
detect_cse_in_cases_2(Cases0, InstMap, !CseInfo, Redo2, Cases),
bool.or(Redo1, Redo2, Redo).
@@ -491,7 +491,7 @@
common_deconstruct_2([Goal0 | Goals0], Var, !CseState, !CseInfo,
[Goal | Goals]) :-
find_bind_var(Var, find_bind_var_for_cse_in_deconstruct, Goal0, Goal,
- !CseState, !CseInfo, yes),
+ !CseState, !CseInfo, did_find_deconstruct),
!.CseState = have_candidate(_, _, _),
common_deconstruct_2(Goals0, Var, !CseState, !CseInfo, Goals).
@@ -512,10 +512,12 @@
list(case)::out) is semidet.
common_deconstruct_cases_2([], _Var, !CseState, !CseInfo, []).
-common_deconstruct_cases_2([case(ConsId, Goal0) | Cases0], Var,
- !CseState, !CseInfo, [case(ConsId, Goal) | Cases]) :-
+common_deconstruct_cases_2([Case0 | Cases0], Var, !CseState, !CseInfo,
+ [Case | Cases]) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
find_bind_var(Var, find_bind_var_for_cse_in_deconstruct, Goal0, Goal,
- !CseState, !CseInfo, yes),
+ !CseState, !CseInfo, did_find_deconstruct),
+ Case = case(MainConsId, OtherConsIds, Goal),
!.CseState = have_candidate(_, _, _),
common_deconstruct_cases_2(Cases0, Var, !CseState, !CseInfo, Cases).
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.124
diff -u -b -r1.124 dead_proc_elim.m
--- compiler/dead_proc_elim.m 13 Aug 2007 03:01:38 -0000 1.124
+++ compiler/dead_proc_elim.m 23 Nov 2007 09:33:01 -0000
@@ -457,7 +457,7 @@
is det.
dead_proc_examine_cases([], _CurrProc, !Queue, !Needed).
-dead_proc_examine_cases([case(_, Goal) | Cases], CurrProc,
+dead_proc_examine_cases([case(_, _, Goal) | Cases], CurrProc,
!Queue, !Needed) :-
dead_proc_examine_goal(Goal, CurrProc, !Queue, !Needed),
dead_proc_examine_cases(Cases, CurrProc, !Queue, !Needed).
@@ -1037,7 +1037,7 @@
list.foldl(pre_modecheck_examine_goal, [If, Then, Else], !DeadInfo).
pre_modecheck_examine_goal_expr(switch(_, _, Cases), !DeadInfo) :-
ExamineCase = (pred(Case::in, Info0::in, Info::out) is det :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
pre_modecheck_examine_goal(Goal, Info0, Info)
),
list.foldl(ExamineCase, Cases, !DeadInfo).
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.69
diff -u -b -r1.69 deep_profiling.m
--- compiler/deep_profiling.m 2 Dec 2007 06:40:22 -0000 1.69
+++ compiler/deep_profiling.m 4 Dec 2007 00:13:32 -0000
@@ -125,8 +125,8 @@
ClonePredProcId = proc(PredId, CloneProcId),
ApplyInfo = apply_tail_recursion_info(!.ModuleInfo,
[PredProcId - ClonePredProcId], Detism, Outputs),
- apply_tail_recursion_to_goal(Goal0, ApplyInfo, Goal, no,
- FoundTailCall, _),
+ apply_tail_recursion_to_goal(Goal0, Goal, ApplyInfo, no, FoundTailCall,
+ _),
FoundTailCall = yes
->
proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
@@ -189,11 +189,11 @@
outputs :: list(prog_var)
).
-:- pred apply_tail_recursion_to_goal(hlds_goal::in,
- apply_tail_recursion_info::in, hlds_goal::out, bool::in, bool::out,
+:- pred apply_tail_recursion_to_goal(hlds_goal::in, hlds_goal::out,
+ apply_tail_recursion_info::in, bool::in, bool::out,
maybe(list(prog_var))::out) is det.
-apply_tail_recursion_to_goal(Goal0, ApplyInfo, Goal, !FoundTailCall,
+apply_tail_recursion_to_goal(Goal0, Goal, ApplyInfo, !FoundTailCall,
Continue) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
@@ -252,7 +252,7 @@
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
- apply_tail_recursion_to_conj(Goals0, ApplyInfo, Goals,
+ apply_tail_recursion_to_conj(Goals0, Goals, ApplyInfo,
!FoundTailCall, Continue),
GoalExpr = conj(ConjType, Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
@@ -263,22 +263,22 @@
)
;
GoalExpr0 = disj(Goals0),
- apply_tail_recursion_to_disj(Goals0, ApplyInfo, Goals, !FoundTailCall),
+ apply_tail_recursion_to_disj(Goals0, Goals, ApplyInfo, !FoundTailCall),
GoalExpr = disj(Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0),
Continue = no
;
GoalExpr0 = switch(Var, CanFail, Cases0),
- apply_tail_recursion_to_cases(Cases0, ApplyInfo, Cases,
+ apply_tail_recursion_to_cases(Cases0, Cases, ApplyInfo,
!FoundTailCall),
GoalExpr = switch(Var, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo0),
Continue = no
;
GoalExpr0 = if_then_else(Vars, Cond, Then0, Else0),
- apply_tail_recursion_to_goal(Then0, ApplyInfo, Then,
+ apply_tail_recursion_to_goal(Then0, Then, ApplyInfo,
!FoundTailCall, _),
- apply_tail_recursion_to_goal(Else0, ApplyInfo, Else,
+ apply_tail_recursion_to_goal(Else0, Else, ApplyInfo,
!FoundTailCall, _),
GoalExpr = if_then_else(Vars, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo0),
@@ -310,48 +310,46 @@
apply_tail_recursion_process_assign(Outputs0, ToVar, FromVar, Outputs).
:- pred apply_tail_recursion_to_conj(list(hlds_goal)::in,
- apply_tail_recursion_info::in, list(hlds_goal)::out,
+ list(hlds_goal)::out, apply_tail_recursion_info::in,
bool::in, bool::out, maybe(list(prog_var))::out) is det.
-apply_tail_recursion_to_conj([], ApplyInfo, [],
+apply_tail_recursion_to_conj([], [], ApplyInfo,
!FoundTailCall, yes(ApplyInfo ^ outputs)).
-apply_tail_recursion_to_conj([Goal0 | Goals0], ApplyInfo0, [Goal | Goals],
+apply_tail_recursion_to_conj([Goal0 | Goals0], [Goal | Goals], ApplyInfo0,
!FoundTailCall, Continue) :-
- apply_tail_recursion_to_conj(Goals0, ApplyInfo0, Goals,
- !FoundTailCall, Continue1),
+ apply_tail_recursion_to_conj(Goals0, Goals, ApplyInfo0, !FoundTailCall,
+ Continue1),
(
Continue1 = yes(Outputs),
- apply_tail_recursion_to_goal(Goal0,
- ApplyInfo0 ^ outputs := Outputs, Goal,
- !FoundTailCall, Continue)
+ apply_tail_recursion_to_goal(Goal0, Goal,
+ ApplyInfo0 ^ outputs := Outputs, !FoundTailCall, Continue)
;
Continue1 = no,
Goal = Goal0,
Continue = no
).
-:- pred apply_tail_recursion_to_disj(list(hlds_goal)::in,
- apply_tail_recursion_info::in, list(hlds_goal)::out,
- bool::in, bool::out) is det.
+:- pred apply_tail_recursion_to_disj(list(hlds_goal)::in, list(hlds_goal)::out,
+ apply_tail_recursion_info::in, bool::in, bool::out) is det.
-apply_tail_recursion_to_disj([], _, [], !FoundTailCall).
-apply_tail_recursion_to_disj([Goal0], ApplyInfo, [Goal],
- !FoundTailCall) :-
- apply_tail_recursion_to_goal(Goal0, ApplyInfo, Goal, !FoundTailCall, _).
-apply_tail_recursion_to_disj([Goal0 | Goals0], ApplyInfo, [Goal0 | Goals],
+apply_tail_recursion_to_disj([], [], _, !FoundTailCall).
+apply_tail_recursion_to_disj([Goal0], [Goal], ApplyInfo, !FoundTailCall) :-
+ apply_tail_recursion_to_goal(Goal0, Goal, ApplyInfo, !FoundTailCall, _).
+apply_tail_recursion_to_disj([Goal0 | Goals0], [Goal0 | Goals], ApplyInfo,
!FoundTailCall) :-
Goals0 = [_ | _],
- apply_tail_recursion_to_disj(Goals0, ApplyInfo, Goals, !FoundTailCall).
+ apply_tail_recursion_to_disj(Goals0, Goals, ApplyInfo, !FoundTailCall).
+
+:- pred apply_tail_recursion_to_cases(list(case)::in, list(case)::out,
+ apply_tail_recursion_info::in, bool::in, bool::out) is det.
-:- pred apply_tail_recursion_to_cases(list(case)::in,
- apply_tail_recursion_info::in, list(case)::out,
- bool::in, bool::out) is det.
-
-apply_tail_recursion_to_cases([], _, [], !FoundTailCall).
-apply_tail_recursion_to_cases([case(ConsId, Goal0) | Cases0], ApplyInfo,
- [case(ConsId, Goal) | Cases], !FoundTailCall) :-
- apply_tail_recursion_to_goal(Goal0, ApplyInfo, Goal, !FoundTailCall, _),
- apply_tail_recursion_to_cases(Cases0, ApplyInfo, Cases, !FoundTailCall).
+apply_tail_recursion_to_cases([], [], _, !FoundTailCall).
+apply_tail_recursion_to_cases([Case0 | Cases0], [Case | Cases], ApplyInfo,
+ !FoundTailCall) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ apply_tail_recursion_to_goal(Goal0, Goal, ApplyInfo, !FoundTailCall, _),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ apply_tail_recursion_to_cases(Cases0, Cases, ApplyInfo, !FoundTailCall).
%-----------------------------------------------------------------------------%
@@ -426,7 +424,7 @@
figure_out_rec_call_numbers_in_case_list([], !N, !TailCallSites).
figure_out_rec_call_numbers_in_case_list([Case|Cases], !N, !TailCallSites) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
figure_out_rec_call_numbers(Goal, !N, !TailCallSites),
figure_out_rec_call_numbers_in_case_list(Cases, !N, !TailCallSites).
@@ -1015,12 +1013,14 @@
deep_info::in, deep_info::out) is det.
deep_prof_transform_switch(_, _, _, [], [], no, !DeepInfo).
-deep_prof_transform_switch(MaybeNumCases, N, Path, [case(Id, Goal0) | Goals0],
- [case(Id, Goal) | Goals], AddedImpurity, !DeepInfo) :-
+deep_prof_transform_switch(MaybeNumCases, N, Path,
+ [Case0 | Cases0], [Case | Cases], AddedImpurity, !DeepInfo) :-
N1 = N + 1,
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
deep_prof_transform_goal(cord.snoc(Path, step_switch(N1, MaybeNumCases)),
Goal0, Goal, AddedImpurityFirst, !DeepInfo),
- deep_prof_transform_switch(MaybeNumCases, N1, Path, Goals0, Goals,
+ Case = case(MainConsId, OtherConsIds, Goal),
+ deep_prof_transform_switch(MaybeNumCases, N1, Path, Cases0, Cases,
AddedImpurityLater, !DeepInfo),
bool.or(AddedImpurityFirst, AddedImpurityLater, AddedImpurity).
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.82
diff -u -b -r1.82 deforest.m
--- compiler/deforest.m 23 Nov 2007 07:34:58 -0000 1.82
+++ compiler/deforest.m 23 Nov 2007 16:19:22 -0000
@@ -379,12 +379,14 @@
pd_info::in, pd_info::out, io::di, io::uo) is det.
deforest_cases(_, [], [], !PDInfo, !IO).
-deforest_cases(Var, [case(ConsId, Goal0) | Cases0],
- [case(ConsId, Goal) | Cases], !PDInfo, !IO) :-
- % Bind Var to ConsId in the instmap before processing this case.
+deforest_cases(Var, [Case0 | Cases0], [Case | Cases], !PDInfo, !IO) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ % Bind Var to MainConsId or one of the OtherConsIds in the instmap
+ % before processing this case.
pd_info_get_instmap(!.PDInfo, InstMap0),
- pd_info_bind_var_to_functor(Var, ConsId, !PDInfo),
+ pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo),
deforest_goal(Goal0, Goal, !PDInfo, !IO),
+ Case = case(MainConsId, OtherConsIds, Goal),
pd_info_set_instmap(InstMap0, !PDInfo),
deforest_cases(Var, Cases0, Cases, !PDInfo, !IO).
@@ -1715,12 +1717,13 @@
append_goal_to_cases(_, _, _, _, _, _, [], [], !PDInfo, !IO).
append_goal_to_cases(Var, BetweenGoals, GoalToAppend, NonLocals,
- CurrCase, Branches, [case(ConsId, Goal0) | Cases0],
- [case(ConsId, Goal) | Cases], !PDInfo, !IO) :-
+ CurrCase, Branches, [Case0 | Cases0], [Case | Cases], !PDInfo, !IO) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
pd_info_get_instmap(!.PDInfo, InstMap0),
- pd_info_bind_var_to_functor(Var, ConsId, !PDInfo),
+ pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo),
append_goal(Goal0, BetweenGoals, GoalToAppend, NonLocals,
CurrCase, Branches, Goal, !PDInfo, !IO),
+ Case = case(MainConsId, OtherConsIds, Goal),
NextCase = CurrCase + 1,
pd_info_set_instmap(InstMap0, !PDInfo),
append_goal_to_cases(Var, BetweenGoals, GoalToAppend,
Index: compiler/delay_construct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/delay_construct.m,v
retrieving revision 1.25
diff -u -b -r1.25 delay_construct.m
--- compiler/delay_construct.m 7 Aug 2007 07:09:50 -0000 1.25
+++ compiler/delay_construct.m 23 Nov 2007 09:18:26 -0000
@@ -269,9 +269,11 @@
delay_construct_info::in, list(case)::out) is det.
delay_construct_in_cases([], _, _, []).
-delay_construct_in_cases([case(Cons, Goal0) | Cases0], InstMap0, DelayInfo,
- [case(Cons, Goal) | Cases]) :-
+delay_construct_in_cases([Case0 | Cases0], InstMap0, DelayInfo,
+ [Case | Cases]) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
delay_construct_in_goal(Goal0, InstMap0, DelayInfo, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
delay_construct_in_cases(Cases0, InstMap0, DelayInfo, Cases).
%-----------------------------------------------------------------------------%
Index: compiler/delay_partial_inst.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/delay_partial_inst.m,v
retrieving revision 1.4
diff -u -b -r1.4 delay_partial_inst.m
--- compiler/delay_partial_inst.m 23 Nov 2007 07:34:59 -0000 1.4
+++ compiler/delay_partial_inst.m 23 Nov 2007 10:00:46 -0000
@@ -539,11 +539,12 @@
delay_partial_inst_info::in, delay_partial_inst_info::out) is det.
delay_partial_inst_in_cases(_, [], [], !ConstructMap, !DelayInfo).
-delay_partial_inst_in_cases(InstMap0,
- [case(Cons, Goal0) | Cases0], [case(Cons, Goal) | Cases],
+delay_partial_inst_in_cases(InstMap0, [Case0 | Cases0], [Case | Cases],
!ConstructMap, !DelayInfo) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
delay_partial_inst_in_goal(InstMap0, Goal0, Goal, !ConstructMap,
!DelayInfo),
+ Case = case(MainConsId, OtherConsIds, Goal),
delay_partial_inst_in_cases(InstMap0, Cases0, Cases, !ConstructMap,
!DelayInfo).
Index: compiler/dense_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dense_switch.m,v
retrieving revision 1.69
diff -u -b -r1.69 dense_switch.m
--- compiler/dense_switch.m 26 Nov 2007 05:13:19 -0000 1.69
+++ compiler/dense_switch.m 14 Dec 2007 04:53:23 -0000
@@ -16,69 +16,78 @@
:- module ll_backend.dense_switch.
:- interface.
-:- import_module backend_libs.switch_util.
:- import_module hlds.code_model.
:- import_module hlds.hlds_goal.
:- import_module ll_backend.code_info.
:- import_module ll_backend.llds.
:- import_module parse_tree.prog_data.
-:- import_module parse_tree.prog_type.
+
+:- import_module list.
%-----------------------------------------------------------------------------%
+:- type dense_switch_info.
+
% Should this switch be implemented as a dense jump table?
% If so, we return the starting and ending values for the table,
% and whether the switch is not covers all cases or not
% (we may convert locally semidet switches into locally det
% switches by adding extra cases whose body is just `fail').
%
-:- pred cases_list_is_dense_switch(code_info::in, prog_var::in,
- cases_list::in, can_fail::in, int::in, int::out, int::out, can_fail::out)
- is semidet.
+:- pred tagged_case_list_is_dense_switch(code_info::in, mer_type::in,
+ list(tagged_case)::in, int::in, int::in, int::in, int::in,
+ can_fail::in, dense_switch_info::out) is semidet.
% Generate code for a switch using a dense jump table.
%
-:- pred generate_dense_switch(cases_list::in, int::in, int::in, prog_var::in,
- code_model::in, can_fail::in, hlds_goal_info::in, label::in,
- branch_end::in, branch_end::out, code_tree::out,
+:- pred generate_dense_switch(list(tagged_case)::in, rval::in, string::in,
+ code_model::in, hlds_goal_info::in, dense_switch_info::in,
+ label::in, branch_end::in, branch_end::out, code_tree::out,
code_info::in, code_info::out) is det.
- % Also used by lookup_switch.
- %
-:- pred type_range(code_info::in, type_category::in, mer_type::in, int::out)
- is semidet.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module backend_libs.builtin_ops.
+:- import_module backend_libs.switch_util.
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_llds.
+:- import_module hlds.hlds_out.
+:- import_module libs.compiler_util.
:- import_module libs.tree.
:- import_module ll_backend.code_gen.
:- import_module ll_backend.trace_gen.
+:- import_module parse_tree.prog_type.
+:- import_module assoc_list.
:- import_module int.
-:- import_module list.
+:- import_module map.
+:- import_module maybe.
:- import_module pair.
+:- import_module svmap.
%-----------------------------------------------------------------------------%
-cases_list_is_dense_switch(CI, CaseVar, TaggedCases, CanFail0, ReqDensity,
- FirstVal, LastVal, CanFail) :-
+:- type dense_switch_info
+ ---> dense_switch_info(
+ first_value :: int,
+ last_value :: int,
+ new_can_fail :: can_fail
+ ).
+
+tagged_case_list_is_dense_switch(CI, VarType, TaggedCases,
+ LowerLimit, UpperLimit, NumValues, ReqDensity, CanFail0,
+ DenseSwitchInfo) :-
list.length(TaggedCases, NumCases),
NumCases > 2,
- TaggedCases = [FirstCase | _],
- FirstCase = extended_case(_, int_tag(FirstCaseVal), _, _),
- list.index1_det(TaggedCases, NumCases, LastCase),
- LastCase = extended_case(_, int_tag(LastCaseVal), _, _),
- Span = LastCaseVal - FirstCaseVal,
+
+ Span = UpperLimit - LowerLimit,
Range = Span + 1,
- Density = switch_density(NumCases, Range),
+ Density = switch_density(NumValues, Range),
Density > ReqDensity,
(
CanFail0 = can_fail,
@@ -86,12 +95,12 @@
% 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
% large enough to hold all of the values for the type.
- Type = variable_type(CI, CaseVar),
get_module_info(CI, ModuleInfo),
- classify_type(ModuleInfo, Type) = TypeCategory,
+ classify_type(ModuleInfo, VarType) = TypeCategory,
(
- dense_switch.type_range(CI, TypeCategory, Type, TypeRange),
- DetDensity = switch_density(NumCases, TypeRange),
+ type_range(ModuleInfo, TypeCategory, VarType, _Min, _Max,
+ TypeRange),
+ DetDensity = switch_density(NumValues, TypeRange),
DetDensity > ReqDensity
->
CanFail = cannot_fail,
@@ -99,127 +108,187 @@
LastVal = TypeRange - 1
;
CanFail = CanFail0,
- FirstVal = FirstCaseVal,
- LastVal = LastCaseVal
+ FirstVal = LowerLimit,
+ LastVal = UpperLimit
)
;
CanFail0 = cannot_fail,
CanFail = cannot_fail,
- FirstVal = FirstCaseVal,
- LastVal = LastCaseVal
- ).
-
-%---------------------------------------------------------------------------%
-
- % Determine the range of an atomic type. Fail if the type isn't the sort
- % of type that has a range or if the type's range is to big to switch on
- % (e.g. int).
- %
-type_range(CI, TypeCategory, Type, Range) :-
- get_module_info(CI, ModuleInfo),
- switch_util.type_range(TypeCategory, Type, ModuleInfo, Min, Max),
- Range = Max - Min + 1.
+ FirstVal = LowerLimit,
+ LastVal = UpperLimit
+ ),
+ DenseSwitchInfo = dense_switch_info(FirstVal, LastVal, CanFail).
%---------------------------------------------------------------------------%
-generate_dense_switch(Cases, StartVal, EndVal, Var, CodeModel, CanFail,
- SwitchGoalInfo, EndLabel, MaybeEnd0, MaybeEnd, Code, !CI) :-
+generate_dense_switch(TaggedCases, VarRval, VarName, CodeModel, SwitchGoalInfo,
+ DenseSwitchInfo, EndLabel, MaybeEnd0, MaybeEnd, Code, !CI) :-
% Evaluate the variable which we are going to be switching on.
- produce_variable(Var, VarCode, Rval, !CI),
% If the case values start at some number other than 0,
% then subtract that number to give us a zero-based index.
- ( StartVal = 0 ->
- Index = Rval
+ DenseSwitchInfo = dense_switch_info(FirstVal, LastVal, CanFail),
+ ( FirstVal = 0 ->
+ IndexRval = VarRval
;
- Index = binop(int_sub, Rval, const(llconst_int(StartVal)))
+ IndexRval = binop(int_sub, VarRval, const(llconst_int(FirstVal)))
),
% If the switch is not locally deterministic, we need to check that
% the value of the variable lies within the appropriate range.
(
CanFail = can_fail,
- Difference = EndVal - StartVal,
+ Difference = LastVal - FirstVal,
fail_if_rval_is_false(
- binop(unsigned_le, Index, const(llconst_int(Difference))),
- RangeCheck, !CI)
+ binop(unsigned_le, IndexRval, const(llconst_int(Difference))),
+ RangeCheckCode, !CI)
;
CanFail = cannot_fail,
- RangeCheck = empty
+ RangeCheckCode = empty
),
- % Now generate the jump table and the cases.
- generate_dense_cases(Cases, StartVal, EndVal, CodeModel, SwitchGoalInfo,
- EndLabel, MaybeEnd0, MaybeEnd, Labels, CasesCode, !CI),
-
- % XXX We keep track of the code_info at the end of one of the non-fail
- % cases. We have to do this because generating a `fail' slot last would
- % yield the wrong liveness and would not unset the failure continuation
+
+ % Generate the cases.
+ % We keep track of the code_info at the end of the non-fail cases.
+ % We have to do this because generating a `fail' slot last would yield
+ % the wrong liveness and would not unset the failure continuation
% for a nondet switch.
- DoJump = node([
- llds_instr(computed_goto(Index, Labels),
+ list.map_foldl3(generate_dense_case(VarName, CodeModel, SwitchGoalInfo,
+ EndLabel), TaggedCases, CasesCodes,
+ map.init, IndexMap, MaybeEnd0, MaybeEnd, !CI),
+ CasesCode = tree_list(CasesCodes),
+
+ % Generate the jump table.
+ map.to_assoc_list(IndexMap, IndexPairs),
+ generate_dense_jump_table(FirstVal, LastVal, IndexPairs, Targets,
+ no, MaybeFailLabel, !CI),
+ JumpCode = node([
+ llds_instr(computed_goto(IndexRval, Targets),
"switch (using dense jump table)")
]),
- % Assemble the code fragments.
- Code = tree_list([VarCode, RangeCheck, DoJump, CasesCode]).
-:- pred generate_dense_cases(cases_list::in, int::in, int::in, code_model::in,
- hlds_goal_info::in, label::in, branch_end::in, branch_end::out,
- list(label)::out, code_tree::out, code_info::in, code_info::out) is det.
-
-generate_dense_cases(Cases0, NextVal, EndVal, CodeModel, SwitchGoalInfo,
- EndLabel, !MaybeEnd, Labels, Code, !CI) :-
- ( NextVal > EndVal ->
- Labels = [],
- Code = node([
- llds_instr(label(EndLabel), "End of dense switch")
- ])
- ;
- get_next_label(ThisLabel, !CI),
- generate_dense_case(Cases0, Cases1, NextVal, CodeModel,
- SwitchGoalInfo, !MaybeEnd, ThisCode, Comment, !CI),
- LabelCode = node([
- llds_instr(label(ThisLabel), Comment)
+ % If there is no case for any index value in range, generate the failure
+ % code we execute for such cases.
+ (
+ MaybeFailLabel = no,
+ FailCode = empty
+ ;
+ MaybeFailLabel = yes(FailLabel),
+ FailComment = "compiler-introduced `fail' case of dense switch",
+ FailLabelCode = node([
+ llds_instr(label(FailLabel), FailComment)
]),
- JumpCode = node([
- llds_instr(goto(code_label(EndLabel)),
- "branch to end of dense switch")
+ generate_failure(FailureCode, !CI),
+ FailCode = tree(FailLabelCode, FailureCode)
+ ),
+
+ EndLabelCode = node([
+ llds_instr(label(EndLabel), "end of dense switch")
]),
- % Generate the rest of the cases.
- NextVal1 = NextVal + 1,
- generate_dense_cases(Cases1, NextVal1, EndVal, CodeModel,
- SwitchGoalInfo, EndLabel, !MaybeEnd, Labels1, OtherCasesCode, !CI),
- Labels = [ThisLabel | Labels1],
- Code = tree_list([LabelCode, ThisCode, JumpCode, OtherCasesCode])
- ).
+
+ % Assemble the code fragments.
+ Code = tree_list([RangeCheckCode, JumpCode, CasesCode, FailCode,
+ EndLabelCode]).
%---------------------------------------------------------------------------%
-:- pred generate_dense_case(cases_list::in, cases_list::out, int::in,
- code_model::in, hlds_goal_info::in, branch_end::in, branch_end::out,
- code_tree::out, string::out, code_info::in, code_info::out) is det.
+:- pred generate_dense_case(string::in, code_model::in, hlds_goal_info::in,
+ label::in, tagged_case::in, code_tree::out,
+ map(int, label)::in, map(int, label)::out,
+ branch_end::in, branch_end::out,
+ code_info::in, code_info::out) is det.
-generate_dense_case(!Cases, NextVal, CodeModel, SwitchGoalInfo, !MaybeEnd,
- Code, Comment, !CI) :-
- (
- !.Cases = [Case | !:Cases],
- Case = extended_case(_, int_tag(NextVal), _, Goal)
- ->
- Comment = "case of dense switch",
+generate_dense_case(VarName, CodeModel, SwitchGoalInfo, EndLabel,
+ TaggedCase, Code, !IndexMap, !MaybeEnd, !CI) :-
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ project_cons_name_and_tag(TaggedMainConsId, MainConsName, MainConsTag),
+ list.map2(project_cons_name_and_tag, TaggedOtherConsIds,
+ OtherConsNames, OtherConsTags),
+ LabelComment = case_comment(VarName, MainConsName, OtherConsNames),
+ get_next_label(Label, !CI),
+ record_dense_label_for_cons_tag(Label, MainConsTag, !IndexMap),
+ list.foldl(record_dense_label_for_cons_tag(Label), OtherConsTags,
+ !IndexMap),
+ LabelCode = node([
+ llds_instr(label(Label), LabelComment)
+ ]),
% We need to save the expression cache, etc.,
% and restore them when we've finished.
remember_position(!.CI, BranchStart),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
+ maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode, !CI),
code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
+ BranchToEndCode = node([
+ llds_instr(goto(code_label(EndLabel)),
+ "branch to end of dense switch")
+ ]),
goal_info_get_store_map(SwitchGoalInfo, StoreMap),
generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- Code = tree_list([TraceCode, GoalCode, SaveCode]),
- reset_to_position(BranchStart, !CI)
+ Code = tree_list([LabelCode, TraceCode, GoalCode, SaveCode,
+ BranchToEndCode]),
+ reset_to_position(BranchStart, !CI).
+
+:- pred record_dense_label_for_cons_tag(label::in, cons_tag::in,
+ map(int, label)::in, map(int, label)::out) is det.
+
+record_dense_label_for_cons_tag(Label, ConsTag, !IndexMap) :-
+ ( ConsTag = int_tag(Index) ->
+ svmap.det_insert(Index, Label, !IndexMap)
+ ;
+ unexpected(this_file, "record_label_for_index: not int_tag")
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred generate_dense_jump_table(int::in, int::in,
+ assoc_list(int, label)::in, list(maybe(label))::out,
+ maybe(label)::in, maybe(label)::out,
+ code_info::in, code_info::out) is det.
+
+generate_dense_jump_table(CurVal, LastVal, IndexPairs, Targets,
+ !MaybeFailLabel, !CI) :-
+ ( CurVal > LastVal ->
+ expect(unify(IndexPairs, []), this_file,
+ "generate_dense_jump_table: NextVal > LastVal, IndexList not []"),
+ Targets = []
+ ;
+ NextVal = CurVal + 1,
+ (
+ IndexPairs = [],
+ get_dense_fail_label(FailLabel, !MaybeFailLabel, !CI),
+ generate_dense_jump_table(NextVal, LastVal, IndexPairs,
+ LaterTargets, !MaybeFailLabel, !CI),
+ Targets = [yes(FailLabel) | LaterTargets]
+ ;
+ IndexPairs = [FirstIndexPair | LaterIndexPairs],
+ FirstIndexPair = FirstIndex - FirstLabel,
+ ( FirstIndex = CurVal ->
+ generate_dense_jump_table(NextVal, LastVal, LaterIndexPairs,
+ LaterTargets, !MaybeFailLabel, !CI),
+ Targets = [yes(FirstLabel) | LaterTargets]
+ ;
+ get_dense_fail_label(FailLabel, !MaybeFailLabel, !CI),
+ generate_dense_jump_table(NextVal, LastVal, IndexPairs,
+ LaterTargets, !MaybeFailLabel, !CI),
+ Targets = [yes(FailLabel) | LaterTargets]
+ )
+ )
+ ).
+
+:- pred get_dense_fail_label(label::out, maybe(label)::in, maybe(label)::out,
+ code_info::in, code_info::out) is det.
+
+get_dense_fail_label(FailLabel, !MaybeFailLabel, !CI) :-
+ (
+ !.MaybeFailLabel = no,
+ get_next_label(FailLabel, !CI),
+ !:MaybeFailLabel = yes(FailLabel)
;
- % This case didn't occur in the original case list
- % - just generate a `fail' for it.
- Comment = "compiler-introduced `fail' case of dense switch",
- generate_failure(Code, !CI)
+ !.MaybeFailLabel = yes(FailLabel)
).
+%---------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "dense_switch.m".
+
%----------------------------------------------------------------------------%
:- end_module dense_switch.
%----------------------------------------------------------------------------%
Index: compiler/dep_par_conj.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.23
diff -u -b -r1.23 dep_par_conj.m
--- compiler/dep_par_conj.m 5 Dec 2007 05:07:31 -0000 1.23
+++ compiler/dep_par_conj.m 7 Dec 2007 01:48:18 -0000
@@ -510,9 +510,9 @@
search_cases_for_par_conj([], [], _InstMap0, !Info).
search_cases_for_par_conj([Case0 | Cases0], [Case | Cases], InstMap0, !Info) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
search_goal_for_par_conj(Goal0, Goal, InstMap0, _, !Info),
- Case = case(Functor, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
search_cases_for_par_conj(Cases0, Cases, InstMap0, !Info).
%-----------------------------------------------------------------------------%
@@ -869,10 +869,10 @@
[], [], !VarSet, !VarTypes).
insert_wait_in_cases(ModuleInfo, FutureMap, ConsumedVar,
[Case0 | Cases0], [Case | Cases], !VarSet, !VarTypes) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
insert_wait_in_goal(ModuleInfo, FutureMap, ConsumedVar,
Goal0, Goal, !VarSet, !VarTypes),
- Case = case(Functor, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
insert_wait_in_cases(ModuleInfo, FutureMap, ConsumedVar,
Cases0, Cases, !VarSet, !VarTypes).
@@ -1017,10 +1017,10 @@
[], [], !VarSet, !VarTypes).
insert_signal_in_cases(ModuleInfo, FutureMap, ProducedVar,
[Case0 | Cases0], [Case | Cases], !VarSet, !VarTypes) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal, !VarSet, !VarTypes),
- Case = case(Functor, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
insert_signal_in_cases(ModuleInfo, FutureMap, ProducedVar,
Cases0, Cases, !VarSet, !VarTypes).
@@ -1142,9 +1142,9 @@
replace_sequences_in_cases([], [], !Info).
replace_sequences_in_cases([Case0 | Cases0], [Case | Cases], !Info) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
replace_sequences_in_goal(Goal0, Goal, !Info),
- Case = case(Functor, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
replace_sequences_in_cases(Cases0, Cases, !Info).
:- inst call_goal_expr
@@ -1531,12 +1531,11 @@
rename_apart_in_cases(_ModuleInfo,
[], [], _InstMap0, !VarSet, !VarTypes).
rename_apart_in_cases(ModuleInfo,
- [Case0 | Cases0], [Case | Cases], InstMap0,
- !VarSet, !VarTypes) :-
- Case0 = case(Functor, Goal0),
+ [Case0 | Cases0], [Case | Cases], InstMap0, !VarSet, !VarTypes) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
rename_apart_in_goal(ModuleInfo,
Goal0, Goal, InstMap0, !VarSet, !VarTypes),
- Case = case(Functor, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
rename_apart_in_cases(ModuleInfo,
Cases0, Cases, InstMap0, !VarSet, !VarTypes).
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.97
diff -u -b -r1.97 dependency_graph.m
--- compiler/dependency_graph.m 10 Oct 2007 14:35:25 -0000 1.97
+++ compiler/dependency_graph.m 23 Nov 2007 08:40:01 -0000
@@ -301,7 +301,7 @@
proc_info_get_goal(ProcInfo0, Goal),
digraph.lookup_key(!.DepGraph, proc(PredId, ProcId), Caller),
- add_dependency_arcs_in_goal(Goal, Caller, !DepGraph)
+ add_dependency_arcs_in_goal(Caller, Goal, !DepGraph)
;
IncludeImported = include_imported,
pred_info_get_import_status(PredInfo0, ImportStatus),
@@ -312,7 +312,7 @@
Imported = no,
proc_info_get_goal(ProcInfo0, Goal),
digraph.lookup_key(!.DepGraph, proc(PredId, ProcId), Caller),
- add_dependency_arcs_in_goal(Goal, Caller, !DepGraph)
+ add_dependency_arcs_in_goal(Caller, Goal, !DepGraph)
)
),
add_proc_arcs(ProcIds, PredId, ModuleInfo, IncludeImported, !DepGraph).
@@ -337,7 +337,7 @@
get_clause_list_any_order(ClausesRep, Clauses),
Goals = list.map(func(clause(_, Goal, _, _)) = Goal, Clauses),
digraph.lookup_key(!.DepGraph, PredId, Caller),
- add_dependency_arcs_in_list(Goals, Caller, !DepGraph)
+ add_dependency_arcs_in_list(Caller, Goals, !DepGraph)
),
add_pred_arcs(PredIds, ModuleInfo, IncludeImported, !DepGraph).
@@ -351,29 +351,29 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_goal(hlds_goal::in, digraph_key(T)::in,
+:- pred add_dependency_arcs_in_goal(digraph_key(T)::in, hlds_goal::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
-add_dependency_arcs_in_goal(hlds_goal(GoalExpr, _), Caller, !DepGraph) :-
+add_dependency_arcs_in_goal(Caller, hlds_goal(GoalExpr, _), !DepGraph) :-
(
( GoalExpr = conj(_, Goals)
; GoalExpr = disj(Goals)
),
- add_dependency_arcs_in_list(Goals, Caller, !DepGraph)
+ add_dependency_arcs_in_list(Caller, Goals, !DepGraph)
;
GoalExpr = switch(_Var, _Det, Cases),
- add_dependency_arcs_in_cases(Cases, Caller, !DepGraph)
+ add_dependency_arcs_in_cases(Caller, Cases, !DepGraph)
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
- add_dependency_arcs_in_goal(Cond, Caller, !DepGraph),
- add_dependency_arcs_in_goal(Then, Caller, !DepGraph),
- add_dependency_arcs_in_goal(Else, Caller, !DepGraph)
+ add_dependency_arcs_in_goal(Caller, Cond, !DepGraph),
+ add_dependency_arcs_in_goal(Caller, Then, !DepGraph),
+ add_dependency_arcs_in_goal(Caller, Else, !DepGraph)
;
( GoalExpr = negation(Goal)
; GoalExpr = scope(_, Goal)
),
- add_dependency_arcs_in_goal(Goal, Caller, !DepGraph)
+ add_dependency_arcs_in_goal(Caller, Goal, !DepGraph)
;
GoalExpr = generic_call(_, _, _, _)
;
@@ -402,11 +402,11 @@
;
Unify = simple_test(_, _)
;
- Unify = construct(_, Cons, _, _, _, _, _),
- add_dependency_arcs_in_cons(Cons, Caller, !DepGraph)
+ Unify = construct(_, ConsId, _, _, _, _, _),
+ add_dependency_arcs_in_cons(Caller, ConsId, !DepGraph)
;
- Unify = deconstruct(_, Cons, _, _, _, _),
- add_dependency_arcs_in_cons(Cons, Caller, !DepGraph)
+ Unify = deconstruct(_, ConsId, _, _, _, _),
+ add_dependency_arcs_in_cons(Caller, ConsId, !DepGraph)
;
Unify = complicated_unify(_, _, _)
)
@@ -415,44 +415,43 @@
;
GoalExpr = shorthand(ShorthandGoal),
ShorthandGoal = bi_implication(LHS, RHS),
- add_dependency_arcs_in_list([LHS, RHS], Caller, !DepGraph)
+ add_dependency_arcs_in_list(Caller, [LHS, RHS], !DepGraph)
).
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_list(list(hlds_goal)::in, digraph_key(T)::in,
+:- pred add_dependency_arcs_in_list(digraph_key(T)::in, list(hlds_goal)::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
-add_dependency_arcs_in_list([], _Caller, !DepGraph).
-add_dependency_arcs_in_list([Goal|Goals], Caller, !DepGraph) :-
- add_dependency_arcs_in_goal(Goal, Caller, !DepGraph),
- add_dependency_arcs_in_list(Goals, Caller, !DepGraph).
+add_dependency_arcs_in_list(_Caller, [], !DepGraph).
+add_dependency_arcs_in_list(Caller, [Goal | Goals], !DepGraph) :-
+ add_dependency_arcs_in_goal(Caller, Goal, !DepGraph),
+ add_dependency_arcs_in_list(Caller, Goals, !DepGraph).
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_cases(list(case)::in, digraph_key(T)::in,
+:- pred add_dependency_arcs_in_cases(digraph_key(T)::in, list(case)::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
-add_dependency_arcs_in_cases([], _Caller, !DepGraph).
-add_dependency_arcs_in_cases([case(Cons, Goal) | Goals], Caller, !DepGraph) :-
- add_dependency_arcs_in_cons(Cons, Caller, !DepGraph),
- add_dependency_arcs_in_goal(Goal, Caller, !DepGraph),
- add_dependency_arcs_in_cases(Goals, Caller, !DepGraph).
+add_dependency_arcs_in_cases(_Caller, [], !DepGraph).
+add_dependency_arcs_in_cases(Caller, [Case | Cases], !DepGraph) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ add_dependency_arcs_in_cons(Caller, MainConsId, !DepGraph),
+ list.foldl(add_dependency_arcs_in_cons(Caller), OtherConsIds, !DepGraph),
+ add_dependency_arcs_in_goal(Caller, Goal, !DepGraph),
+ add_dependency_arcs_in_cases(Caller, Cases, !DepGraph).
%-----------------------------------------------------------------------------%
-:- pred add_dependency_arcs_in_cons(cons_id::in, digraph_key(T)::in,
+:- pred add_dependency_arcs_in_cons(digraph_key(T)::in, cons_id::in,
dependency_graph(T)::in, dependency_graph(T)::out) is det
<= dependency_node(T).
-add_dependency_arcs_in_cons(cons(_, _), _Caller, !DepGraph).
-add_dependency_arcs_in_cons(int_const(_), _Caller, !DepGraph).
-add_dependency_arcs_in_cons(string_const(_), _Caller, !DepGraph).
-add_dependency_arcs_in_cons(float_const(_), _Caller, !DepGraph).
-add_dependency_arcs_in_cons(pred_const(ShroudedPredProcId, _), Caller,
- !DepGraph) :-
+add_dependency_arcs_in_cons(Caller, ConsId, !DepGraph) :-
+ (
+ ConsId = pred_const(ShroudedPredProcId, _),
PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
(
% If the node isn't in the graph, then we didn't insert it
@@ -462,16 +461,21 @@
digraph.add_edge(Caller, Callee, !DepGraph)
;
true
+ )
+ ;
+ ( ConsId = cons(_, _)
+ ; ConsId = int_const(_)
+ ; ConsId = string_const(_)
+ ; ConsId = float_const(_)
+ ; ConsId = type_ctor_info_const(_, _, _)
+ ; ConsId = base_typeclass_info_const(_, _, _, _)
+ ; ConsId = type_info_cell_constructor(_)
+ ; ConsId = typeclass_info_cell_constructor
+ ; ConsId = tabling_info_const(_)
+ ; ConsId = deep_profiling_proc_layout(_)
+ ; ConsId = table_io_decl(_)
+ )
).
-add_dependency_arcs_in_cons(type_ctor_info_const(_, _, _), _, !DepGraph).
-add_dependency_arcs_in_cons(base_typeclass_info_const(_, _, _, _), _,
- !DepGraph).
-add_dependency_arcs_in_cons(type_info_cell_constructor(_), _, !DepGraph).
-add_dependency_arcs_in_cons(typeclass_info_cell_constructor, _,
- !DepGraph).
-add_dependency_arcs_in_cons(tabling_info_const(_), _Caller, !DepGraph).
-add_dependency_arcs_in_cons(deep_profiling_proc_layout(_), _, !DepGraph).
-add_dependency_arcs_in_cons(table_io_decl(_), _Caller, !DepGraph).
%-----------------------------------------------------------------------------%
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.209
diff -u -b -r1.209 det_analysis.m
--- compiler/det_analysis.m 23 Nov 2007 07:34:59 -0000 1.209
+++ compiler/det_analysis.m 14 Dec 2007 00:26:15 -0000
@@ -93,8 +93,9 @@
%
:- pred det_infer_goal(hlds_goal::in, hlds_goal::out, instmap::in,
soln_context::in, list(failing_context)::in, maybe(pess_info)::in,
- det_info::in, determinism::out, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ determinism::out, list(failing_context)::out,
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
% Work out how many solutions are needed for a given determinism.
%
@@ -242,7 +243,7 @@
% on the undeclared procs.
global_inference_single_pass(DeclaredProcs, Debug, !ModuleInfo,
[], !:Specs, unchanged, _),
- global_checking_pass(UndeclaredProcs ++ DeclaredProcs, !.ModuleInfo,
+ global_checking_pass(UndeclaredProcs ++ DeclaredProcs, !ModuleInfo,
!Specs).
%-----------------------------------------------------------------------------%
@@ -283,9 +284,10 @@
proc_info_get_goal(Proc0, Goal0),
proc_info_get_initial_instmap(Proc0, !.ModuleInfo, InstMap0),
proc_info_get_vartypes(Proc0, VarTypes),
- det_info_init(!.ModuleInfo, VarTypes, PredId, ProcId, DetInfo),
- det_infer_goal(Goal0, Goal, InstMap0, SolnContext, [], no, DetInfo,
- InferDetism, _, [], !:Specs),
+ det_info_init(!.ModuleInfo, VarTypes, PredId, ProcId, DetInfo0),
+ det_infer_goal(Goal0, Goal, InstMap0, SolnContext, [], no,
+ InferDetism, _, DetInfo0, DetInfo, [], !:Specs),
+ det_info_get_module_info(DetInfo, !:ModuleInfo),
% Take the worst of the old and inferred detisms. This is needed to prevent
% loops on p :- not(p), at least if the initial assumed detism is det.
@@ -384,15 +386,15 @@
det_infer_goal(hlds_goal(GoalExpr0, GoalInfo0), hlds_goal(GoalExpr, GoalInfo),
InstMap0, !.SolnContext, RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo, Detism, GoalFailingContexts,
- !Specs) :-
+ MaybePromiseEqvSolutionSets, Detism, GoalFailingContexts,
+ !DetInfo, !Specs) :-
NonLocalVars = goal_info_get_nonlocals(GoalInfo0),
InstmapDelta = goal_info_get_instmap_delta(GoalInfo0),
% If a pure or semipure goal has no output variables, then the goal
% is in a single-solution context.
(
- det_no_output_vars(NonLocalVars, InstMap0, InstmapDelta, DetInfo),
+ det_no_output_vars(NonLocalVars, InstMap0, InstmapDelta, !.DetInfo),
Purity = goal_info_get_purity(GoalInfo0),
(
Purity = purity_impure
@@ -432,8 +434,8 @@
),
det_infer_goal_2(GoalExpr0, GoalExpr1, GoalInfo0, InstMap0, !.SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- InternalDetism0, GoalFailingContexts, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ InternalDetism0, GoalFailingContexts, !DetInfo, !Specs),
determinism_components(InternalDetism0, InternalCanFail, InternalSolns0),
(
@@ -540,13 +542,14 @@
:- pred det_infer_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
hlds_goal_info::in, instmap::in, soln_context::in,
- list(failing_context)::in, maybe(pess_info)::in, det_info::in,
+ list(failing_context)::in, maybe(pess_info)::in,
determinism::out, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_goal_2(GoalExpr0, GoalExpr, GoalInfo, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, !Specs) :-
+ RightFailingContexts, MaybePromiseEqvSolutionSets, Detism,
+ GoalFailingContexts, !DetInfo, !Specs) :-
(
GoalExpr0 = conj(ConjType, Goals0),
(
@@ -554,72 +557,72 @@
% The determinism of a conjunction is the worst case of the
% determinism of the goals of that conjuction.
det_infer_conj(Goals0, Goals, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, [], GoalFailingContexts, !Specs)
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ Detism, [], GoalFailingContexts, !DetInfo, !Specs)
;
ConjType = parallel_conj,
det_infer_par_conj(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !Specs)
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ Detism, GoalFailingContexts, !DetInfo, !Specs)
),
GoalExpr = conj(ConjType, Goals)
;
GoalExpr0 = disj(Goals0),
det_infer_disj(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ Detism, GoalFailingContexts, !DetInfo, !Specs),
GoalExpr = disj(Goals)
;
GoalExpr0 = switch(Var, SwitchCanFail, Cases0),
det_infer_switch(Var, SwitchCanFail, Cases0, Cases, GoalInfo, InstMap0,
SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, GoalFailingContexts, !Specs),
+ Detism, GoalFailingContexts, !DetInfo, !Specs),
GoalExpr = switch(Var, SwitchCanFail, Cases)
;
GoalExpr0 = plain_call(PredId, ProcId0, Args, Builtin, UnifyContext,
Name),
det_infer_call(PredId, ProcId0, ProcId, GoalInfo, SolnContext,
- RightFailingContexts, DetInfo,
- Detism, GoalFailingContexts, !Specs),
+ RightFailingContexts, Detism, GoalFailingContexts,
+ !.DetInfo, !Specs),
GoalExpr = plain_call(PredId, ProcId, Args, Builtin, UnifyContext,
Name)
;
GoalExpr0 = generic_call(GenericCall, _ArgVars, _Modes, CallDetism),
det_infer_generic_call(GenericCall, CallDetism, GoalInfo, SolnContext,
- RightFailingContexts, DetInfo,
- Detism, GoalFailingContexts, !Specs),
+ RightFailingContexts, Detism, GoalFailingContexts,
+ !.DetInfo, !Specs),
GoalExpr = GoalExpr0
;
GoalExpr0 = unify(LHS, RHS0, Mode, Unify, UnifyContext),
det_infer_unify(LHS, RHS0, Unify, UnifyContext, RHS, GoalInfo,
- InstMap0, SolnContext, RightFailingContexts, DetInfo, Detism,
- GoalFailingContexts, !Specs),
+ InstMap0, SolnContext, RightFailingContexts, Detism,
+ GoalFailingContexts, !DetInfo, !Specs),
GoalExpr = unify(LHS, RHS, Mode, Unify, UnifyContext)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
det_infer_if_then_else(Cond0, Cond, Then0, Then, Else0, Else,
InstMap0, SolnContext, RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, !Specs),
+ MaybePromiseEqvSolutionSets, Detism, GoalFailingContexts,
+ !DetInfo, !Specs),
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = negation(Goal0),
det_infer_not(Goal0, Goal, GoalInfo, InstMap0,
- MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, !Specs),
+ MaybePromiseEqvSolutionSets, Detism, GoalFailingContexts,
+ !DetInfo, !Specs),
GoalExpr = negation(Goal)
;
GoalExpr0 = scope(Reason, Goal0),
det_infer_scope(Reason, Goal0, Goal, GoalInfo, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets, Detism,
+ GoalFailingContexts, !DetInfo, !Specs),
GoalExpr = scope(Reason, Goal)
;
GoalExpr0 = call_foreign_proc(Attributes, PredId, ProcId,
_Args, _ExtraArgs, _MaybeTraceRuntimeCond, PragmaCode),
det_infer_foreign_proc(Attributes, PredId, ProcId, PragmaCode,
- GoalInfo, SolnContext, RightFailingContexts, DetInfo, Detism,
- GoalFailingContexts, !Specs),
+ GoalInfo, SolnContext, RightFailingContexts, Detism,
+ GoalFailingContexts, !.DetInfo, !Specs),
GoalExpr = GoalExpr0
;
GoalExpr0 = shorthand(_),
@@ -631,16 +634,17 @@
:- pred det_infer_conj(list(hlds_goal)::in, list(hlds_goal)::out, instmap::in,
soln_context::in, list(failing_context)::in, maybe(pess_info)::in,
- det_info::in, determinism::out,
+ determinism::out,
list(failing_context)::in, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_conj([], [], _InstMap0, _SolnContext, _RightFailingContexts,
- _MaybePromiseEqvSolutionSets, _DetInfo, detism_det,
- !ConjFailingContexts, !Specs).
+ _MaybePromiseEqvSolutionSets, detism_det,
+ !ConjFailingContexts, !DetInfo, !Specs).
det_infer_conj([Goal0 | Goals0], [Goal | Goals], InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo, Detism,
- !ConjFailingContexts, !Specs) :-
+ RightFailingContexts, MaybePromiseEqvSolutionSets, Detism,
+ !ConjFailingContexts, !DetInfo, !Specs) :-
% We should look to see when we get to a not_reached point
% and optimize away the remaining elements of the conjunction.
% But that optimization is done in the code generator anyway.
@@ -651,8 +655,8 @@
% First, process the second and subsequent conjuncts.
update_instmap(Goal0, InstMap0, InstMap1),
det_infer_conj(Goals0, Goals, InstMap1, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- TailDetism, !ConjFailingContexts, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ TailDetism, !ConjFailingContexts, !DetInfo, !Specs),
determinism_components(TailDetism, TailCanFail, _TailMaxSolns),
% Next, work out whether the first conjunct is in a first_soln context
@@ -671,8 +675,8 @@
% Process the first conjunct.
det_infer_goal(Goal0, Goal, InstMap0, HeadSolnContext,
!.ConjFailingContexts ++ RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo, HeadDetism,
- GoalFailingContexts, !Specs),
+ MaybePromiseEqvSolutionSets, HeadDetism, GoalFailingContexts,
+ !DetInfo, !Specs),
% Finally combine the results computed above.
det_conjunction_detism(HeadDetism, TailDetism, Detism),
@@ -680,16 +684,17 @@
:- pred det_infer_par_conj(list(hlds_goal)::in, list(hlds_goal)::out,
hlds_goal_info::in, instmap::in, soln_context::in,
- list(failing_context)::in, maybe(pess_info)::in, det_info::in,
+ list(failing_context)::in, maybe(pess_info)::in,
determinism::out, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_par_conj(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !Specs) :-
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ Detism, GoalFailingContexts, !DetInfo, !Specs) :-
det_infer_par_conj_goals(Goals0, Goals, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, [], GoalFailingContexts, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ Detism, [], GoalFailingContexts, !DetInfo, !Specs),
(
determinism_components(Detism, CanFail, Solns),
CanFail = cannot_fail,
@@ -719,7 +724,7 @@
Rest = "The current implementation supports only "
++ "single-solution non-failing parallel conjunctions.",
Pieces = [words(First), words(Rest)],
- det_diagnose_conj(Goals, detism_det, [], DetInfo, GoalMsgs),
+ det_diagnose_conj(Goals, InstMap0, detism_det, [], !DetInfo, GoalMsgs),
sort_error_msgs(GoalMsgs, SortedGoalMsgs),
Spec = error_spec(severity_error, phase_detism_check,
[simple_msg(Context, [always(Pieces)])] ++ SortedGoalMsgs),
@@ -728,24 +733,25 @@
:- pred det_infer_par_conj_goals(list(hlds_goal)::in, list(hlds_goal)::out,
instmap::in, soln_context::in, list(failing_context)::in,
- maybe(pess_info)::in, det_info::in, determinism::out,
+ maybe(pess_info)::in, determinism::out,
list(failing_context)::in, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_par_conj_goals([], [], _InstMap0, _SolnContext,
- _RightFailingContexts, _MaybePromiseEqvSolutionSets, _DetInfo,
- detism_det, !ConjFailingContexts, !Specs).
+ _RightFailingContexts, _MaybePromiseEqvSolutionSets,
+ detism_det, !ConjFailingContexts, !DetInfo, !Specs).
det_infer_par_conj_goals([Goal0 | Goals0], [Goal | Goals], InstMap0,
SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, !ConjFailingContexts, !Specs) :-
+ Detism, !ConjFailingContexts, !DetInfo, !Specs) :-
det_infer_goal(Goal0, Goal, InstMap0, SolnContext, RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo, HeadDetism, GoalFailingContexts,
- !Specs),
+ MaybePromiseEqvSolutionSets, HeadDetism, GoalFailingContexts,
+ !DetInfo, !Specs),
determinism_components(HeadDetism, HeadCanFail, HeadMaxSolns),
det_infer_par_conj_goals(Goals0, Goals, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- TailDetism, !ConjFailingContexts, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ TailDetism, !ConjFailingContexts, !DetInfo, !Specs),
determinism_components(TailDetism, TailCanFail, TailMaxSolns),
det_conjunction_maxsoln(HeadMaxSolns, TailMaxSolns, MaxSolns),
@@ -755,16 +761,18 @@
:- pred det_infer_disj(list(hlds_goal)::in, list(hlds_goal)::out,
hlds_goal_info::in, instmap::in, soln_context::in,
- list(failing_context)::in, maybe(pess_info)::in, det_info::in,
+ list(failing_context)::in, maybe(pess_info)::in,
determinism::out, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_disj(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !Specs) :-
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ Detism, GoalFailingContexts, !DetInfo, !Specs) :-
det_infer_disj_goals(Goals0, Goals, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- can_fail, at_most_zero, Detism, [], GoalFailingContexts0, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ can_fail, at_most_zero, Detism, [], GoalFailingContexts0,
+ !DetInfo, !Specs),
(
Goals = [],
Context = goal_info_get_context(GoalInfo),
@@ -777,20 +785,22 @@
:- pred det_infer_disj_goals(list(hlds_goal)::in, list(hlds_goal)::out,
instmap::in, soln_context::in, list(failing_context)::in,
- maybe(pess_info)::in, det_info::in, can_fail::in, soln_count::in,
+ maybe(pess_info)::in, can_fail::in, soln_count::in,
determinism::out, list(failing_context)::in, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_disj_goals([], [], _InstMap0, _SolnContext, _RightFailingContexts,
- _MaybePromiseEqvSolutionSets, _DetInfo, CanFail, MaxSolns, Detism,
- !DisjFailingContexts, !Specs) :-
+ _MaybePromiseEqvSolutionSets, CanFail, MaxSolns, Detism,
+ !DisjFailingContexts, !DetInfo, !Specs) :-
determinism_components(Detism, CanFail, MaxSolns).
det_infer_disj_goals([Goal0 | Goals0], [Goal | Goals], InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- !.CanFail, !.MaxSolns, Detism, !DisjFailingContexts, !Specs) :-
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ !.CanFail, !.MaxSolns, Detism, !DisjFailingContexts,
+ !DetInfo, !Specs) :-
det_infer_goal(Goal0, Goal, InstMap0, SolnContext, RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo, FirstDetism, GoalFailingContexts,
- !Specs),
+ MaybePromiseEqvSolutionSets, FirstDetism, GoalFailingContexts,
+ !DetInfo, !Specs),
determinism_components(FirstDetism, FirstCanFail, FirstMaxSolns),
Goal = hlds_goal(_, GoalInfo),
% If a disjunct cannot succeed but is marked with the
@@ -825,8 +835,8 @@
true
),
det_infer_disj_goals(Goals0, Goals, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- !.CanFail, !.MaxSolns, Detism, !DisjFailingContexts, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ !.CanFail, !.MaxSolns, Detism, !DisjFailingContexts, !DetInfo, !Specs),
!:DisjFailingContexts = GoalFailingContexts ++ !.DisjFailingContexts.
%-----------------------------------------------------------------------------%
@@ -834,22 +844,23 @@
:- pred det_infer_switch(prog_var::in, can_fail::in,
list(case)::in, list(case)::out,
hlds_goal_info::in, instmap::in, soln_context::in,
- list(failing_context)::in, maybe(pess_info)::in, det_info::in,
+ list(failing_context)::in, maybe(pess_info)::in,
determinism::out, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_switch(Var, SwitchCanFail, Cases0, Cases, GoalInfo, InstMap0,
SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, GoalFailingContexts, !Specs) :-
+ Detism, GoalFailingContexts, !DetInfo, !Specs) :-
% The determinism of a switch is the worst of the determinism of each
% of the cases. Also, if only a subset of the constructors are handled,
% then it is semideterministic or worse - this is determined
% in switch_detection.m and handled via the SwitchCanFail field.
- det_infer_switch_cases(Cases0, Cases, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
+ det_infer_switch_cases(Cases0, Cases, Var, InstMap0, SolnContext,
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
cannot_fail, at_most_zero, CasesDetism, [], GoalFailingContexts0,
- !Specs),
+ !DetInfo, !Specs),
determinism_components(CasesDetism, CasesCanFail, CasesSolns),
% The switch variable tests are in a first_soln context if and only
% if the switch goal as a whole was in a first_soln context and the
@@ -865,7 +876,7 @@
ExaminesRep = yes,
det_check_for_noncanonical_type(Var, ExaminesRep, SwitchCanFail,
SwitchSolnContext, GoalFailingContexts0, RightFailingContexts,
- GoalInfo, ccuc_switch, DetInfo, SwitchSolns, !Specs),
+ GoalInfo, ccuc_switch, !.DetInfo, SwitchSolns, !Specs),
det_conjunction_canfail(SwitchCanFail, CasesCanFail, CanFail),
det_conjunction_maxsoln(SwitchSolns, CasesSolns, NumSolns),
determinism_components(Detism, CanFail, NumSolns),
@@ -880,45 +891,53 @@
GoalFailingContexts = GoalFailingContexts0
).
-:- pred det_infer_switch_cases(list(case)::in, list(case)::out, instmap::in,
- soln_context::in, list(failing_context)::in, maybe(pess_info)::in,
- det_info::in, can_fail::in, soln_count::in, determinism::out,
- list(failing_context)::in, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+:- pred det_infer_switch_cases(list(case)::in, list(case)::out, prog_var::in,
+ instmap::in, soln_context::in, list(failing_context)::in,
+ maybe(pess_info)::in, can_fail::in, soln_count::in,
+ determinism::out, list(failing_context)::in, list(failing_context)::out,
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
-det_infer_switch_cases([], [], _InstMap0, _SolnContext, _RightFailingContexts,
- _MaybePromiseEqvSolutionSets, _DetInfo, CanFail, MaxSolns,
- Detism, !SwitchFailingContexts, !Specs) :-
+det_infer_switch_cases([], [], _Var, _InstMap0, _SolnContext,
+ _RightFailingContexts, _MaybePromiseEqvSolutionSets,
+ CanFail, MaxSolns, Detism, !SwitchFailingContexts, !DetInfo, !Specs) :-
determinism_components(Detism, CanFail, MaxSolns).
-det_infer_switch_cases([Case0 | Cases0], [Case | Cases], InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- !.CanFail, !.MaxSolns, Detism, !SwitchFailingContexts, !Specs) :-
+det_infer_switch_cases([Case0 | Cases0], [Case | Cases], Var, InstMap0,
+ SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
+ !.CanFail, !.MaxSolns, Detism, !SwitchFailingContexts,
+ !DetInfo, !Specs) :-
% Technically, we should update the instmap to reflect the knowledge that
% the var is bound to this particular constructor, but we wouldn't use
% that information here anyway, so we don't bother.
- Case0 = case(ConsId, Goal0),
- det_infer_goal(Goal0, Goal, InstMap0, SolnContext, RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo, FirstDetism, GoalFailingContexts,
- !Specs),
- Case = case(ConsId, Goal),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ det_info_get_module_info(!.DetInfo, ModuleInfo0),
+ det_info_get_vartypes(!.DetInfo, VarTypes),
+ map.lookup(VarTypes, Var, VarType),
+ bind_var_to_functors(Var, VarType, MainConsId, OtherConsIds,
+ InstMap0, InstMap1, ModuleInfo0, ModuleInfo),
+ det_info_set_module_info(ModuleInfo, !DetInfo),
+ det_infer_goal(Goal0, Goal, InstMap1, SolnContext, RightFailingContexts,
+ MaybePromiseEqvSolutionSets, FirstDetism, GoalFailingContexts,
+ !DetInfo, !Specs),
+ Case = case(MainConsId, OtherConsIds, Goal),
determinism_components(FirstDetism, FirstCanFail, FirstMaxSolns),
det_switch_canfail(!.CanFail, FirstCanFail, !:CanFail),
det_switch_maxsoln(!.MaxSolns, FirstMaxSolns, !:MaxSolns),
- det_infer_switch_cases(Cases0, Cases, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- !.CanFail, !.MaxSolns, Detism, !SwitchFailingContexts, !Specs),
+ det_infer_switch_cases(Cases0, Cases, Var, InstMap0, SolnContext,
+ RightFailingContexts, MaybePromiseEqvSolutionSets,
+ !.CanFail, !.MaxSolns, Detism, !SwitchFailingContexts,
+ !DetInfo, !Specs),
!:SwitchFailingContexts = GoalFailingContexts ++ !.SwitchFailingContexts.
%-----------------------------------------------------------------------------%
:- pred det_infer_call(pred_id::in, proc_id::in, proc_id::out,
hlds_goal_info::in, soln_context::in,
- list(failing_context)::in, det_info::in, determinism::out,
- list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ list(failing_context)::in, determinism::out, list(failing_context)::out,
+ det_info::in, list(error_spec)::in, list(error_spec)::out) is det.
det_infer_call(PredId, ProcId0, ProcId, GoalInfo, SolnContext,
- RightFailingContexts, DetInfo, Detism, GoalFailingContexts, !Specs) :-
+ RightFailingContexts, Detism, GoalFailingContexts, DetInfo, !Specs) :-
% For calls, just look up the determinism entry associated with
% the called predicate.
% This is the point at which annotations start changing
@@ -979,13 +998,12 @@
:- pred det_infer_generic_call(generic_call::in, determinism::in,
hlds_goal_info::in, soln_context::in,
- list(failing_context)::in, det_info::in, determinism::out,
- list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ list(failing_context)::in, determinism::out, list(failing_context)::out,
+ det_info::in, list(error_spec)::in, list(error_spec)::out) is det.
-det_infer_generic_call(GenericCall, CallDetism,
- GoalInfo, SolnContext, RightFailingContexts, DetInfo,
- Detism, GoalFailingContexts, !Specs) :-
+det_infer_generic_call(GenericCall, CallDetism, GoalInfo,
+ SolnContext, RightFailingContexts, Detism, GoalFailingContexts,
+ DetInfo, !Specs) :-
determinism_components(CallDetism, CanFail, NumSolns),
Context = goal_info_get_context(GoalInfo),
(
@@ -1026,13 +1044,12 @@
:- pred det_infer_foreign_proc(pragma_foreign_proc_attributes::in,
pred_id::in, proc_id::in, pragma_foreign_code_impl::in,
hlds_goal_info::in, soln_context::in,
- list(failing_context)::in, det_info::in, determinism::out,
- list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ list(failing_context)::in, determinism::out, list(failing_context)::out,
+ det_info::in, list(error_spec)::in, list(error_spec)::out) is det.
det_infer_foreign_proc(Attributes, PredId, ProcId, PragmaCode,
- GoalInfo, SolnContext, RightFailingContexts, DetInfo,
- Detism, GoalFailingContexts, !Specs) :-
+ GoalInfo, SolnContext, RightFailingContexts,
+ Detism, GoalFailingContexts, DetInfo, !Specs) :-
% Foreign_procs are handled in the same way as predicate calls.
det_info_get_module_info(DetInfo, ModuleInfo),
@@ -1127,13 +1144,13 @@
:- pred det_infer_unify(prog_var::in, unify_rhs::in,
unification::in, unify_context::in, unify_rhs::out,
hlds_goal_info::in, instmap::in, soln_context::in,
- list(failing_context)::in, det_info::in, determinism::out,
- list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ list(failing_context)::in, determinism::out, list(failing_context)::out,
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_unify(LHS, RHS0, Unify, UnifyContext, RHS, GoalInfo, InstMap0,
- SolnContext, RightFailingContexts, DetInfo, Detism,
- GoalFailingContexts, !Specs) :-
+ SolnContext, RightFailingContexts, Detism, GoalFailingContexts,
+ !DetInfo, !Specs) :-
% Unifications are either deterministic or semideterministic.
(
RHS0 = rhs_lambda_goal(Purity, PredOrFunc, EvalMethod, NonLocalVars,
@@ -1143,12 +1160,12 @@
;
LambdaSolnContext = all_solns
),
- det_info_get_module_info(DetInfo, ModuleInfo),
+ det_info_get_module_info(!.DetInfo, ModuleInfo),
instmap.pre_lambda_update(ModuleInfo, Vars, Modes, InstMap0, InstMap1),
det_infer_goal(Goal0, Goal, InstMap1, LambdaSolnContext, [],
- no, DetInfo, LambdaInferredDet, _LambdaFailingContexts, !Specs),
+ no, LambdaInferredDet, _LambdaFailingContexts, !DetInfo, !Specs),
det_check_lambda(LambdaDeclaredDet, LambdaInferredDet,
- Goal, GoalInfo, DetInfo, !Specs),
+ Goal, GoalInfo, InstMap1, !DetInfo, !Specs),
RHS = rhs_lambda_goal(Purity, PredOrFunc, EvalMethod, NonLocalVars,
Vars, Modes, LambdaDeclaredDet, Goal)
;
@@ -1161,7 +1178,7 @@
det_infer_unify_examines_rep(Unify, ExaminesRepresentation),
det_check_for_noncanonical_type(LHS, ExaminesRepresentation,
UnifyCanFail, SolnContext, RightFailingContexts, [], GoalInfo,
- ccuc_unify(UnifyContext), DetInfo, UnifyNumSolns, !Specs),
+ ccuc_unify(UnifyContext), !.DetInfo, UnifyNumSolns, !Specs),
determinism_components(Detism, UnifyCanFail, UnifyNumSolns),
(
UnifyCanFail = can_fail,
@@ -1205,22 +1222,22 @@
:- pred det_infer_if_then_else(hlds_goal::in, hlds_goal::out,
hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out,
instmap::in, soln_context::in, list(failing_context)::in,
- maybe(pess_info)::in, det_info::in, determinism::out,
- list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ maybe(pess_info)::in, determinism::out, list(failing_context)::out,
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_if_then_else(Cond0, Cond, Then0, Then, Else0, Else, InstMap0,
SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, GoalFailingContexts, !Specs) :-
+ Detism, GoalFailingContexts, !DetInfo, !Specs) :-
% We process the goal right-to-left, doing the `then' before the
% condition of the if-then-else, so that we can propagate the
% SolnContext correctly.
- % First process the `then' part
+ % First process the `then' part.
update_instmap(Cond0, InstMap0, InstMap1),
det_infer_goal(Then0, Then, InstMap1, SolnContext, RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo, ThenDetism, ThenFailingContexts,
- !Specs),
+ MaybePromiseEqvSolutionSets, ThenDetism, ThenFailingContexts,
+ !DetInfo, !Specs),
determinism_components(ThenDetism, ThenCanFail, ThenMaxSoln),
% Next, work out the right soln_context to use for the condition.
@@ -1237,14 +1254,14 @@
% Process the `condition' part
det_infer_goal(Cond0, Cond, InstMap0, CondSolnContext,
ThenFailingContexts ++ RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo,
- CondDetism, _CondFailingContexts, !Specs),
+ MaybePromiseEqvSolutionSets, CondDetism, _CondFailingContexts,
+ !DetInfo, !Specs),
determinism_components(CondDetism, CondCanFail, CondMaxSoln),
% Process the `else' part
det_infer_goal(Else0, Else, InstMap0, SolnContext, RightFailingContexts,
- MaybePromiseEqvSolutionSets, DetInfo, ElseDetism, ElseFailingContexts,
- !Specs),
+ MaybePromiseEqvSolutionSets, ElseDetism, ElseFailingContexts,
+ !DetInfo, !Specs),
determinism_components(ElseDetism, ElseCanFail, ElseMaxSoln),
% Finally combine the results from the three parts.
@@ -1283,12 +1300,13 @@
GoalFailingContexts = ThenFailingContexts ++ ElseFailingContexts.
:- pred det_infer_not(hlds_goal::in, hlds_goal::out, hlds_goal_info::in,
- instmap::in, maybe(pess_info)::in, det_info::in, determinism::out,
- list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ instmap::in, maybe(pess_info)::in,
+ determinism::out, list(failing_context)::out,
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_not(Goal0, Goal, GoalInfo, InstMap0, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, GoalFailingContexts, !Specs) :-
+ Detism, GoalFailingContexts, !DetInfo, !Specs) :-
% Negations are almost always semideterministic. It is an error for
% a negation to further instantiate any non-local variable. Such errors
% will be reported by the mode analysis.
@@ -1297,8 +1315,8 @@
% cannot succeed or cannot fail?
% Answer: yes, probably, but it's not a high priority.
det_infer_goal(Goal0, Goal, InstMap0, first_soln, [],
- MaybePromiseEqvSolutionSets, DetInfo, NegDetism, _NegatedGoalCanFail,
- !Specs),
+ MaybePromiseEqvSolutionSets, NegDetism, _NegatedGoalCanFail,
+ !DetInfo, !Specs),
det_negation_det(NegDetism, MaybeDetism),
(
MaybeDetism = no,
@@ -1321,19 +1339,20 @@
:- pred det_infer_scope(scope_reason::in, hlds_goal::in, hlds_goal::out,
hlds_goal_info::in, instmap::in, soln_context::in,
- list(failing_context)::in, maybe(pess_info)::in, det_info::in,
+ list(failing_context)::in, maybe(pess_info)::in,
determinism::out, list(failing_context)::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ det_info::in, det_info::out, list(error_spec)::in, list(error_spec)::out)
+ is det.
det_infer_scope(Reason, Goal0, Goal, GoalInfo, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets0, DetInfo, Detism,
- GoalFailingContexts, !Specs) :-
+ RightFailingContexts, MaybePromiseEqvSolutionSets0, Detism,
+ GoalFailingContexts, !DetInfo, !Specs) :-
% Existential quantification may require a cut to throw away solutions,
% but we cannot rely on explicit quantification to detect this.
% Therefore cuts are handled in det_infer_goal.
(
Reason = promise_solutions(Vars, Kind),
- det_get_proc_info(DetInfo, ProcInfo),
+ det_get_proc_info(!.DetInfo, ProcInfo),
proc_info_get_varset(ProcInfo, VarSet),
Context = goal_info_get_context(GoalInfo),
@@ -1423,7 +1442,7 @@
),
InstmapDelta = goal_info_get_instmap_delta(GoalInfo),
instmap_delta_changed_vars(InstmapDelta, ChangedVars),
- det_info_get_module_info(DetInfo, ModuleInfo),
+ det_info_get_module_info(!.DetInfo, ModuleInfo),
% BoundVars must include both vars whose inst has changed and vars
% with inst any which may have been further constrained by the goal.
set.divide(var_is_ground_in_instmap(ModuleInfo, InstMap0),
@@ -1496,13 +1515,13 @@
!:Specs = [ExtraSpec | !.Specs]
),
det_infer_goal(Goal0, Goal, InstMap0, SolnContextToUse,
- RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, !Specs)
+ RightFailingContexts, MaybePromiseEqvSolutionSets, Detism,
+ GoalFailingContexts, !DetInfo, !Specs)
;
Reason = trace_goal(_, _, _, _, _),
det_infer_goal(Goal0, Goal, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets0, DetInfo,
- Detism, GoalFailingContexts, !Specs),
+ RightFailingContexts, MaybePromiseEqvSolutionSets0,
+ Detism, GoalFailingContexts, !DetInfo, !Specs),
(
( Detism = detism_det
; Detism = detism_cc_multi
@@ -1527,8 +1546,8 @@
; Reason = from_ground_term(_)
),
det_infer_goal(Goal0, Goal, InstMap0, SolnContext,
- RightFailingContexts, MaybePromiseEqvSolutionSets0, DetInfo,
- Detism, GoalFailingContexts, !Specs)
+ RightFailingContexts, MaybePromiseEqvSolutionSets0,
+ Detism, GoalFailingContexts, !DetInfo, !Specs)
).
%-----------------------------------------------------------------------------%
@@ -1642,8 +1661,8 @@
suffix(":"), nl]
;
GoalContext = ccuc_unify(UnifyContext),
- unify_context_first_to_pieces(yes, _, UnifyContext, [],
- Pieces0)
+ unify_context_first_to_pieces(is_first, _,
+ UnifyContext, [], Pieces0)
),
(
Pieces0 = [],
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.140
diff -u -b -r1.140 det_report.m
--- compiler/det_report.m 3 Dec 2007 09:52:13 -0000 1.140
+++ compiler/det_report.m 14 Dec 2007 01:28:30 -0000
@@ -23,6 +23,7 @@
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
+:- import_module hlds.instmap.
:- import_module libs.globals.
:- import_module parse_tree.
:- import_module parse_tree.error_util.
@@ -65,26 +66,30 @@
% Check all the determinism declarations in this module.
% This is the main predicate exported by this module.
%
-:- pred global_checking_pass(pred_proc_list::in, module_info::in,
+:- pred global_checking_pass(pred_proc_list::in,
+ module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
% Check a lambda goal with the specified declared and inferred
% determinisms.
%
:- pred det_check_lambda(determinism::in, determinism::in, hlds_goal::in,
- hlds_goal_info::in, det_info::in,
+ hlds_goal_info::in, instmap::in, det_info::in, det_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
- % det_diagnose_conj(Goals, Desired, FailingContexts, DetInfo, Msgs):
+ % det_diagnose_conj(Goals, InstMap0, Desired, FailingContexts, DetInfo,
+ % Msgs):
%
- % The conjunction Goals should have determinism Desired, but doesn't.
- % Find out what is wrong, and return a list of messages giving the causes.
+ % The conjunction Goals with initial instmap InstMap0 should have
+ % determinism Desired, but doesn't. Find out what is wrong, and return
+ % a list of messages giving the causes.
%
% det_diagnose_conj is used for both normal [sequential] conjunctions
% and parallel conjunctions.
%
-:- pred det_diagnose_conj(list(hlds_goal)::in, determinism::in,
- list(switch_context)::in, det_info::in, list(error_msg)::out) is det.
+:- pred det_diagnose_conj(list(hlds_goal)::in, instmap::in, determinism::in,
+ list(switch_context)::in, det_info::in, det_info::out,
+ list(error_msg)::out) is det.
% Return a printable representation of the given promise_solutions_kind.
%
@@ -132,7 +137,9 @@
:- implementation.
+:- import_module check_hlds.inst_match.
:- import_module check_hlds.mode_util.
+:- import_module hlds.goal_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_out.
@@ -143,6 +150,7 @@
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
@@ -153,6 +161,7 @@
:- import_module map.
:- import_module maybe.
:- import_module pair.
+:- import_module set_tree234.
:- import_module solutions.
:- import_module string.
:- import_module term.
@@ -160,22 +169,22 @@
%-----------------------------------------------------------------------------%
-global_checking_pass([], _, !Specs).
-global_checking_pass([proc(PredId, ProcId) | Rest], ModuleInfo, !Specs) :-
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+global_checking_pass([], !ModuleInfo, !Specs).
+global_checking_pass([Proc | Procs], !ModuleInfo, !Specs) :-
+ Proc = proc(PredId, ProcId),
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo),
- check_determinism(PredId, ProcId, PredInfo, ProcInfo, ModuleInfo, !Specs),
- check_determinism_of_main(PredId, ProcId, PredInfo, ProcInfo,
- !Specs),
- check_for_multisoln_func(PredId, ProcId, PredInfo, ProcInfo, ModuleInfo,
+ check_determinism(PredId, ProcId, PredInfo, ProcInfo, !ModuleInfo, !Specs),
+ check_determinism_of_main(PredId, ProcId, PredInfo, ProcInfo, !Specs),
+ check_for_multisoln_func(PredId, ProcId, PredInfo, ProcInfo, !.ModuleInfo,
!Specs),
- global_checking_pass(Rest, ModuleInfo, !Specs).
+ global_checking_pass(Procs, !ModuleInfo, !Specs).
:- pred check_determinism(pred_id::in, proc_id::in, pred_info::in,
- proc_info::in, module_info::in,
+ proc_info::in, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-check_determinism(PredId, ProcId, PredInfo0, ProcInfo0, ModuleInfo, !Specs) :-
+check_determinism(PredId, ProcId, PredInfo0, ProcInfo0, !ModuleInfo, !Specs) :-
proc_info_get_declared_determinism(ProcInfo0, MaybeDetism),
proc_info_get_inferred_determinism(ProcInfo0, InferredDetism),
(
@@ -187,7 +196,7 @@
Cmp = sameas
;
Cmp = looser,
- module_info_get_globals(ModuleInfo, Globals),
+ module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, warn_det_decls_too_lax,
ShouldIssueWarning),
globals.lookup_bool_option(Globals, warn_inferred_erroneous,
@@ -230,7 +239,7 @@
->
Message = "warning: determinism declaration " ++
"could be tighter.\n",
- report_determinism_problem(PredId, ProcId, ModuleInfo,
+ report_determinism_problem(PredId, ProcId, !.ModuleInfo,
Message, DeclaredDetism, InferredDetism, ReportMsgs),
ReportSpec = error_spec(severity_warning, phase_detism_check,
ReportMsgs),
@@ -241,12 +250,15 @@
;
Cmp = tighter,
Message = "error: determinism declaration not satisfied.\n",
- report_determinism_problem(PredId, ProcId, ModuleInfo, Message,
+ report_determinism_problem(PredId, ProcId, !.ModuleInfo, Message,
DeclaredDetism, InferredDetism, ReportMsgs),
proc_info_get_goal(ProcInfo0, Goal),
proc_info_get_vartypes(ProcInfo0, VarTypes),
- det_info_init(ModuleInfo, VarTypes, PredId, ProcId, DetInfo),
- det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, GoalMsgs0),
+ proc_info_get_initial_instmap(ProcInfo0, !.ModuleInfo, InstMap0),
+ det_info_init(!.ModuleInfo, VarTypes, PredId, ProcId, DetInfo0),
+ det_diagnose_goal(Goal, InstMap0, DeclaredDetism, [],
+ DetInfo0, DetInfo, GoalMsgs0),
+ det_info_get_module_info(DetInfo, !:ModuleInfo),
sort_error_msgs(GoalMsgs0, GoalMsgs),
ReportSpec = error_spec(severity_error, phase_detism_check,
ReportMsgs ++ GoalMsgs),
@@ -391,15 +403,15 @@
words("Most likely, this procedure should be a predicate, not a function.")
].
-det_check_lambda(DeclaredDetism, InferredDetism, Goal, GoalInfo, DetInfo,
- !Specs) :-
+det_check_lambda(DeclaredDetism, InferredDetism, Goal, GoalInfo, InstMap0,
+ !DetInfo, !Specs) :-
compare_determinisms(DeclaredDetism, InferredDetism, Cmp),
(
Cmp = tighter,
- det_info_get_pred_id(DetInfo, PredId),
- det_info_get_proc_id(DetInfo, ProcId),
+ det_info_get_pred_id(!.DetInfo, PredId),
+ det_info_get_proc_id(!.DetInfo, ProcId),
Context = goal_info_get_context(GoalInfo),
- det_info_get_module_info(DetInfo, ModuleInfo),
+ det_info_get_module_info(!.DetInfo, ModuleInfo),
PredPieces = describe_one_proc_name_mode(ModuleInfo,
should_not_module_qualify, proc(PredId, ProcId)),
Pieces =
@@ -409,7 +421,8 @@
quote(determinism_to_string(DeclaredDetism)), suffix(","),
words("inferred"),
quote(determinism_to_string(InferredDetism)), suffix("'.")],
- det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, GoalMsgs),
+ det_diagnose_goal(Goal, InstMap0, DeclaredDetism, [], !DetInfo,
+ GoalMsgs),
sort_error_msgs(GoalMsgs, SortedGoalMsgs),
Spec = error_spec(severity_error, phase_detism_check,
[simple_msg(Context, [always(Pieces)])] ++ SortedGoalMsgs),
@@ -496,33 +509,36 @@
% The given goal should have determinism Desired, but doesn't.
% Find out what is wrong, and return a list of messages giving the causes.
%
-:- pred det_diagnose_goal(hlds_goal::in, determinism::in,
- list(switch_context)::in, det_info::in, list(error_msg)::out) is det.
+:- pred det_diagnose_goal(hlds_goal::in, instmap::in, determinism::in,
+ list(switch_context)::in, det_info::in, det_info::out,
+ list(error_msg)::out) is det.
-det_diagnose_goal(hlds_goal(GoalExpr, GoalInfo), Desired, SwitchContext,
- DetInfo, Msgs) :-
+det_diagnose_goal(Goal, InstMap0, Desired, SwitchContexts, !DetInfo, Msgs) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
Actual = goal_info_get_determinism(GoalInfo),
( compare_determinisms(Desired, Actual, tighter) ->
- det_diagnose_goal_2(GoalExpr, GoalInfo, Desired, Actual, SwitchContext,
- DetInfo, Msgs)
+ det_diagnose_goal_expr(GoalExpr, GoalInfo, InstMap0, Desired, Actual,
+ SwitchContexts, !DetInfo, Msgs)
;
Msgs = []
).
%-----------------------------------------------------------------------------%
-:- pred det_diagnose_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
- determinism::in, determinism::in, list(switch_context)::in,
- det_info::in, list(error_msg)::out) is det.
-
-det_diagnose_goal_2(conj(_, Goals), _GoalInfo, Desired, _Actual, Context,
- DetInfo, Msgs) :-
- det_diagnose_conj(Goals, Desired, Context, DetInfo, Msgs).
-
-det_diagnose_goal_2(disj(Goals), GoalInfo, Desired, Actual, SwitchContext,
- DetInfo, Msgs) :-
- det_diagnose_disj(Goals, Desired, Actual, SwitchContext, DetInfo, 0,
- ClausesWithSoln, Msgs1),
+:- pred det_diagnose_goal_expr(hlds_goal_expr::in, hlds_goal_info::in,
+ instmap::in, determinism::in, determinism::in, list(switch_context)::in,
+ det_info::in, det_info::out, list(error_msg)::out) is det.
+
+det_diagnose_goal_expr(GoalExpr, GoalInfo, InstMap0, Desired, Actual,
+ SwitchContexts, !DetInfo, Msgs) :-
+ (
+ GoalExpr = conj(_, Goals),
+ det_diagnose_conj(Goals, InstMap0, Desired, SwitchContexts, !DetInfo,
+ Msgs)
+ ;
+ GoalExpr = disj(Goals),
+ det_diagnose_disj(Goals, InstMap0, Desired, Actual, SwitchContexts,
+ !DetInfo, 0, ClausesWithSoln, Msgs1),
determinism_components(Desired, _, DesSolns),
(
DesSolns \= at_most_many,
@@ -530,77 +546,84 @@
ClausesWithSoln > 1
->
Context = goal_info_get_context(GoalInfo),
- Pieces = [words("Disjunction has multiple clauses with solutions.")],
+ Pieces =
+ [words("Disjunction has multiple clauses with solutions.")],
Msg = simple_msg(Context, [always(Pieces)]),
Msgs = [Msg] ++ Msgs1
;
Msgs = Msgs1
- ).
-
- % The determinism of a switch is the worst of the determinism of each of
- % the cases. Also, if only a subset of the constructors are handled,
+ )
+ ;
+ GoalExpr = switch(Var, SwitchCanFail, Cases),
+ % The determinism of a switch is the worst of the determinism of each
+ % of the cases. Also, if only a subset of the constructors are handled,
% then it is semideterministic or worse - this is determined
% in switch_detection.m and handled via the CanFail field.
- %
-det_diagnose_goal_2(switch(Var, SwitchCanFail, Cases), GoalInfo,
- Desired, _Actual, SwitchContext, DetInfo, Msgs) :-
(
SwitchCanFail = can_fail,
determinism_components(Desired, cannot_fail, _)
->
Context = goal_info_get_context(GoalInfo),
- det_diagnose_switch_context(SwitchContext, DetInfo, NestingPieces),
- det_get_proc_info(DetInfo, ProcInfo),
+ det_diagnose_switch_context(SwitchContexts, !.DetInfo,
+ NestingPieces),
+ det_get_proc_info(!.DetInfo, ProcInfo),
proc_info_get_varset(ProcInfo, VarSet),
- det_info_get_module_info(DetInfo, ModuleInfo),
VarStr = mercury_var_to_string(VarSet, no, Var),
+ det_info_get_module_info(!.DetInfo, ModuleInfo),
(
+ (
+ instmap.lookup_var(InstMap0, Var, VarInst),
+ inst_is_bound_to_functors(ModuleInfo, VarInst, Functors)
+ ->
+ functors_to_cons_ids(Functors, ConsIds)
+ ;
det_lookup_var_type(ModuleInfo, ProcInfo, Var, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
- ConsTable = TypeBody ^ du_type_cons_tag_values
+ ConsTable = TypeBody ^ du_type_cons_tag_values,
+ map.keys(ConsTable, ConsIds)
+ )
->
- map.keys(ConsTable, ConsIds),
- det_diagnose_missing_consids(ConsIds, Cases, Missing),
- cons_id_list_to_pieces(Missing, MissingPieces),
- Pieces = [words("The switch on "), fixed(VarStr),
+ % XXX If the current instmap has an entry giving the set of
+ % possible bindings for Var, we should restrict ConsIds
+ % to the functors that appear in it.
+ det_diagnose_missing_consids(ConsIds, Cases, MissingConsIds),
+ cons_id_list_to_pieces(MissingConsIds, MissingPieces),
+ Pieces = [words("The switch on"), fixed(VarStr),
words("does not cover") | MissingPieces]
;
- Pieces = [words("The switch on "), fixed(VarStr),
+ Pieces = [words("The switch on"), fixed(VarStr),
words("can fail.")]
),
Msgs1 = [simple_msg(Context, [always(NestingPieces ++ Pieces)])]
;
Msgs1 = []
),
- det_diagnose_switch(Var, Cases, Desired, SwitchContext, DetInfo, Msgs2),
- Msgs = Msgs1 ++ Msgs2.
-
-det_diagnose_goal_2(plain_call(PredId, ProcId, _, _, CallContext, _), GoalInfo,
- Desired, Actual, _, DetInfo, Msgs) :-
+ det_diagnose_switch_arms(Var, Cases, InstMap0, Desired, SwitchContexts,
+ !DetInfo, Msgs2),
+ Msgs = Msgs1 ++ Msgs2
+ ;
+ GoalExpr = plain_call(PredId, ProcId, _, _, CallContext, _),
Context = goal_info_get_context(GoalInfo),
- det_report_call_context(Context, CallContext, DetInfo, PredId, ProcId,
- InitMsgs, StartingPieces),
+ det_report_call_context(Context, CallContext, !.DetInfo,
+ PredId, ProcId, InitMsgs, StartingPieces),
det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces,
AtomicMsgs),
- Msgs = InitMsgs ++ AtomicMsgs.
-
-det_diagnose_goal_2(generic_call(GenericCall, _, _, _), GoalInfo,
- Desired, Actual, _, _DetInfo, Msgs) :-
+ Msgs = InitMsgs ++ AtomicMsgs
+ ;
+ GoalExpr = generic_call(GenericCall, _, _, _),
Context = goal_info_get_context(GoalInfo),
report_generic_call_context(GenericCall, StartingPieces),
- det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces, Msgs).
-
-det_diagnose_goal_2(unify(LHS, RHS, _, _, UnifyContext), GoalInfo,
- Desired, Actual, _, DetInfo, Msgs) :-
+ det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces,
+ Msgs)
+ ;
+ GoalExpr = unify(LHS, RHS, _, _, UnifyContext),
Context = goal_info_get_context(GoalInfo),
- First = yes,
- Last = yes,
- det_report_unify_context(First, Last, Context, UnifyContext,
- DetInfo, LHS, RHS, StartingPieces),
- det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces, Msgs).
-
-det_diagnose_goal_2(if_then_else(_Vars, Cond, Then, Else), _GoalInfo,
- Desired, _Actual, SwitchContext, DetInfo, Msgs) :-
+ det_report_unify_context(is_first, is_last, Context, UnifyContext,
+ !.DetInfo, LHS, RHS, StartingPieces),
+ det_diagnose_atomic_goal(Desired, Actual, Context, StartingPieces,
+ Msgs)
+ ;
+ GoalExpr = if_then_else(_Vars, Cond, Then, Else),
determinism_components(Desired, _DesiredCanFail, DesiredSolns),
Cond = hlds_goal(_CondGoal, CondInfo),
CondDetism = goal_info_get_determinism(CondInfo),
@@ -610,15 +633,19 @@
DesiredSolns \= at_most_many
->
determinism_components(DesiredCond, can_fail, DesiredSolns),
- det_diagnose_goal(Cond, DesiredCond, SwitchContext, DetInfo, Msgs1)
+ det_diagnose_goal(Cond, InstMap0, DesiredCond, SwitchContexts,
+ !DetInfo, MsgsCond)
;
- Msgs1 = []
+ MsgsCond = []
),
- det_diagnose_goal(Then, Desired, SwitchContext, DetInfo, Msgs2),
- det_diagnose_goal(Else, Desired, SwitchContext, DetInfo, Msgs3),
- Msgs = Msgs1 ++ Msgs2 ++ Msgs3.
-
-det_diagnose_goal_2(negation(_), GoalInfo, Desired, Actual, _, _, Msgs) :-
+ update_instmap(Cond, InstMap0, InstMap1),
+ det_diagnose_goal(Then, InstMap1, Desired, SwitchContexts, !DetInfo,
+ MsgsThen),
+ det_diagnose_goal(Else, InstMap0, Desired, SwitchContexts, !DetInfo,
+ MsgsElse),
+ Msgs = MsgsCond ++ MsgsThen ++ MsgsElse
+ ;
+ GoalExpr = negation(_),
determinism_components(Desired, DesiredCanFail, DesiredSolns),
determinism_components(Actual, ActualCanFail, ActualSolns),
(
@@ -637,31 +664,31 @@
Msgs = [simple_msg(Context, [always(Pieces)])]
;
Msgs = []
- ).
-
-det_diagnose_goal_2(scope(_, Goal), _, Desired, Actual, SwitchContext, DetInfo,
- Msgs) :-
- Goal = hlds_goal(_, GoalInfo),
- Internal = goal_info_get_determinism(GoalInfo),
+ )
+ ;
+ GoalExpr = scope(_, SubGoal),
+ SubGoal = hlds_goal(_, SubGoalInfo),
+ Internal = goal_info_get_determinism(SubGoalInfo),
( Actual = Internal ->
InternalDesired = Desired
;
determinism_components(Desired, CanFail, _),
determinism_components(InternalDesired, CanFail, at_most_many)
),
- det_diagnose_goal(Goal, InternalDesired, SwitchContext, DetInfo, Msgs).
-
-det_diagnose_goal_2(call_foreign_proc(_, _, _, _, _, _, _), GoalInfo, Desired,
- _, _, _, Msgs) :-
+ det_diagnose_goal(SubGoal, InstMap0, InternalDesired, SwitchContexts,
+ !DetInfo, Msgs)
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
Context = goal_info_get_context(GoalInfo),
DesiredStr = determinism_to_string(Desired),
Pieces = [words("Determinism declaration not satisfied."),
words("Desired determinism is " ++ DesiredStr ++ ".")],
- Msgs = [simple_msg(Context, [always(Pieces)])].
-
-det_diagnose_goal_2(shorthand(_), _, _, _, _, _, []) :-
+ Msgs = [simple_msg(Context, [always(Pieces)])]
+ ;
+ GoalExpr = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file, "det_diagnose_goal_2: unexpected shorthand").
+ unexpected(this_file, "det_diagnose_goal_expr: unexpected shorthand")
+ ).
%-----------------------------------------------------------------------------%
@@ -731,20 +758,25 @@
),
Msgs = [simple_msg(Context, [always(StartingPieces ++ Pieces)])].
-det_diagnose_conj([], _Desired, _SwitchContext, _DetInfo, []).
-det_diagnose_conj([Goal | Goals], Desired, SwitchContext, DetInfo, Msgs) :-
- det_diagnose_goal(Goal, Desired, SwitchContext, DetInfo, Msgs1),
- det_diagnose_conj(Goals, Desired, SwitchContext, DetInfo, Msgs2),
+det_diagnose_conj([], _InstMap0, _Desired, _SwitchContexts, !DetInfo, []).
+det_diagnose_conj([Goal | Goals], InstMap0, Desired, SwitchContexts, !DetInfo,
+ Msgs) :-
+ det_diagnose_goal(Goal, InstMap0, Desired, SwitchContexts, !DetInfo,
+ Msgs1),
+ update_instmap(Goal, InstMap0, InstMap1),
+ det_diagnose_conj(Goals, InstMap1, Desired, SwitchContexts, !DetInfo,
+ Msgs2),
Msgs = Msgs1 ++ Msgs2.
-:- pred det_diagnose_disj(list(hlds_goal)::in,
+:- pred det_diagnose_disj(list(hlds_goal)::in, instmap::in,
determinism::in, determinism::in, list(switch_context)::in,
- det_info::in, int::in, int::out, list(error_msg)::out) is det.
+ det_info::in, det_info::out, int::in, int::out, list(error_msg)::out)
+ is det.
-det_diagnose_disj([], _Desired, _Actual, _SwitchContext, _DetInfo,
- !ClausesWithSoln, []).
-det_diagnose_disj([Goal | Goals], Desired, Actual, SwitchContext, DetInfo,
- !ClausesWithSoln, Msgs) :-
+det_diagnose_disj([], _InstMap0, _Desired, _Actual, _SwitchContexts,
+ !DetInfo, !ClausesWithSoln, []).
+det_diagnose_disj([Goal | Goals], InstMap0, Desired, Actual, SwitchContexts,
+ !DetInfo, !ClausesWithSoln, Msgs) :-
determinism_components(Actual, ActualCanFail, _),
determinism_components(Desired, DesiredCanFail, DesiredSolns),
(
@@ -762,7 +794,8 @@
ClauseCanFail = can_fail
),
determinism_components(ClauseDesired, ClauseCanFail, DesiredSolns),
- det_diagnose_goal(Goal, ClauseDesired, SwitchContext, DetInfo, Msgs1),
+ det_diagnose_goal(Goal, InstMap0, ClauseDesired, SwitchContexts, !DetInfo,
+ Msgs1),
(
Goal = hlds_goal(_, GoalInfo),
GoalDetism = goal_info_get_determinism(GoalInfo),
@@ -772,19 +805,30 @@
;
!:ClausesWithSoln = !.ClausesWithSoln + 1
),
- det_diagnose_disj(Goals, Desired, Actual, SwitchContext, DetInfo,
- !ClausesWithSoln, Msgs2),
+ det_diagnose_disj(Goals, InstMap0, Desired, Actual, SwitchContexts,
+ !DetInfo, !ClausesWithSoln, Msgs2),
Msgs = Msgs1 ++ Msgs2.
-:- pred det_diagnose_switch(prog_var::in, list(case)::in, determinism::in,
- list(switch_context)::in, det_info::in, list(error_msg)::out) is det.
-
-det_diagnose_switch(_Var, [], _Desired, _SwitchContext, _DetInfo, []).
-det_diagnose_switch(Var, [case(ConsId, Goal) | Cases], Desired,
- SwitchContext0, DetInfo, Msgs) :-
- SwitchContext1 = [switch_context(Var, ConsId) | SwitchContext0],
- det_diagnose_goal(Goal, Desired, SwitchContext1, DetInfo, Msgs1),
- det_diagnose_switch(Var, Cases, Desired, SwitchContext0, DetInfo, Msgs2),
+:- pred det_diagnose_switch_arms(prog_var::in, list(case)::in, instmap::in,
+ determinism::in, list(switch_context)::in, det_info::in, det_info::out,
+ list(error_msg)::out) is det.
+
+det_diagnose_switch_arms(_Var, [], _, _Desired, _SwitchContexts, !DetInfo, []).
+det_diagnose_switch_arms(Var, [Case | Cases], InstMap0, Desired,
+ SwitchContexts0, !DetInfo, Msgs) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ NewSwitchContext = switch_context(Var, MainConsId, OtherConsIds),
+ SwitchContexts1 = [NewSwitchContext | SwitchContexts0],
+ det_info_get_vartypes(!.DetInfo, VarTypes),
+ map.lookup(VarTypes, Var, VarType),
+ det_info_get_module_info(!.DetInfo, ModuleInfo0),
+ bind_var_to_functors(Var, VarType, MainConsId, OtherConsIds,
+ InstMap0, InstMap1, ModuleInfo0, ModuleInfo),
+ det_info_set_module_info(ModuleInfo, !DetInfo),
+ det_diagnose_goal(Goal, InstMap1, Desired, SwitchContexts1,
+ !DetInfo, Msgs1),
+ det_diagnose_switch_arms(Var, Cases, InstMap0, Desired, SwitchContexts0,
+ !DetInfo, Msgs2),
Msgs = Msgs1 ++ Msgs2.
%-----------------------------------------------------------------------------%
@@ -792,17 +836,33 @@
:- pred det_diagnose_missing_consids(list(cons_id)::in, list(case)::in,
list(cons_id)::out) is det.
-det_diagnose_missing_consids([], _, []).
-det_diagnose_missing_consids([ConsId | ConsIds], Cases, Missing) :-
- det_diagnose_missing_consids(ConsIds, Cases, Missing0),
- (
- list.member(Case, Cases),
- Case = case(ConsId, _)
- ->
- Missing = Missing0
+det_diagnose_missing_consids(ConsIds, Cases, MissingConsIds) :-
+ compute_covered_cons_ids(Cases, set_tree234.init, CoveredConsIds),
+ find_uncovered_consids(ConsIds, CoveredConsIds, [], RevMissingConsIds),
+ list.reverse(RevMissingConsIds, MissingConsIds).
+
+:- pred find_uncovered_consids(list(cons_id)::in, set_tree234(cons_id)::in,
+ list(cons_id)::in, list(cons_id)::out) is det.
+
+find_uncovered_consids([], _, !RevMissingConsIds).
+find_uncovered_consids([ConsId | ConsIds], CoveredConsIds,
+ !RevMissingConsIds) :-
+ ( set_tree234.member(CoveredConsIds, ConsId) ->
+ true
;
- Missing = [ConsId | Missing0]
- ).
+ !:RevMissingConsIds = [ConsId | !.RevMissingConsIds]
+ ),
+ find_uncovered_consids(ConsIds, CoveredConsIds, !RevMissingConsIds).
+
+:- pred compute_covered_cons_ids(list(case)::in,
+ set_tree234(cons_id)::in, set_tree234(cons_id)::out) is det.
+
+compute_covered_cons_ids([], !CoveredConsIds).
+compute_covered_cons_ids([Case | Cases], !CoveredConsIds) :-
+ Case = case(MainConsId, OtherConsIds, _Goal),
+ set_tree234.insert(MainConsId, !CoveredConsIds),
+ set_tree234.insert_list(OtherConsIds, !CoveredConsIds),
+ compute_covered_cons_ids(Cases, !CoveredConsIds).
:- pred cons_id_list_to_pieces(list(cons_id)::in,
list(format_component)::out) is det.
@@ -826,7 +886,11 @@
%-----------------------------------------------------------------------------%
:- type switch_context
- ---> switch_context(prog_var, cons_id).
+ ---> switch_context(
+ prog_var, % The variable being switched on.
+ cons_id, % The first cons_id of this case.
+ list(cons_id) % Any other cons_ids of this case.
+ ).
:- pred det_diagnose_switch_context(list(switch_context)::in, det_info::in,
list(format_component)::out) is det.
@@ -836,10 +900,12 @@
HeadPieces ++ TailPieces) :-
det_get_proc_info(DetInfo, ProcInfo),
proc_info_get_varset(ProcInfo, VarSet),
- SwitchContext = switch_context(Var, ConsId),
- ConsIdStr = cons_id_to_string(ConsId),
+ SwitchContext = switch_context(Var, MainConsId, OtherConsIds),
+ MainConsIdStr = cons_id_to_string(MainConsId),
+ OtherConsIdStrs = list.map(cons_id_to_string, OtherConsIds),
+ ConsIdsStr = string.join_list(", ", [MainConsIdStr | OtherConsIdStrs]),
VarStr = mercury_var_to_string(VarSet, no, Var),
- HeadPieces = [words("Inside the case"), fixed(ConsIdStr),
+ HeadPieces = [words("Inside the case"), words(ConsIdsStr),
words("of the switch on"), fixed(VarStr), suffix(":"), nl],
det_diagnose_switch_context(SwitchContexts, DetInfo, TailPieces).
@@ -865,9 +931,7 @@
InitMsgs = [],
(
CallUnifyContext = yes(call_unify_context(LHS, RHS, UC)),
- First = yes,
- Last = yes,
- det_report_unify_context(First, Last, Context, UC, DetInfo,
+ det_report_unify_context(is_first, is_last, Context, UC, DetInfo,
LHS, RHS, StartingPieces)
;
% This shouldn't happen; every call to a compiler generated
@@ -879,10 +943,8 @@
;
(
CallUnifyContext = yes(call_unify_context(LHS, RHS, UC)),
- First = yes,
- Last = no,
- det_report_unify_context(First, Last, Context, UC, DetInfo,
- LHS, RHS, UnifyPieces0),
+ det_report_unify_context(is_first, is_not_last, Context, UC,
+ DetInfo, LHS, RHS, UnifyPieces0),
UnifyPieces = UnifyPieces0 ++ [suffix(":")],
UnifyMsg = simple_msg(Context, [always(UnifyPieces)]),
InitMsgs = [UnifyMsg]
@@ -909,7 +971,7 @@
% with a capital letter) and whether it is the last part (in which case we
% omit the word "in" on the final "... in unification ...").
%
-:- pred det_report_unify_context(bool::in, bool::in, prog_context::in,
+:- pred det_report_unify_context(is_first::in, is_last::in, prog_context::in,
unify_context::in, det_info::in, prog_var::in, unify_rhs::in,
list(format_component)::out) is det.
@@ -920,21 +982,21 @@
proc_info_get_varset(ProcInfo, VarSet),
det_info_get_module_info(DetInfo, ModuleInfo),
(
- !.First = yes,
+ !.First = is_first,
(
- Last = yes,
+ Last = is_last,
StartWords = "Unification"
;
- Last = no,
+ Last = is_not_last,
StartWords = "In unification"
)
;
- !.First = no,
+ !.First = is_not_first,
(
- Last = yes,
+ Last = is_last,
StartWords = "unification"
;
- Last = no,
+ Last = is_not_last,
StartWords = "in unification"
)
),
@@ -1031,18 +1093,19 @@
:- func det_report_context_lines(list(prog_context)) = string.
-det_report_context_lines(Contexts) = det_report_context_lines_2(Contexts, yes).
+det_report_context_lines(Contexts) =
+ det_report_context_lines_2(Contexts, is_first).
-:- func det_report_context_lines_2(list(prog_context), bool) = string.
+:- func det_report_context_lines_2(list(prog_context), is_first) = string.
det_report_context_lines_2([], _) = "".
det_report_context_lines_2([Context | Contexts], First) = Str :-
term.context_line(Context, Line),
(
- First = yes,
+ First = is_first,
Punct = ""
;
- First = no,
+ First = is_not_first,
(
Contexts = [_ | _],
Punct = ", "
@@ -1052,7 +1115,7 @@
)
),
int_to_string(Line, This),
- Later = det_report_context_lines_2(Contexts, no),
+ Later = det_report_context_lines_2(Contexts, is_not_first),
Str = Punct ++ This ++ Later.
%-----------------------------------------------------------------------------%
Index: compiler/det_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_util.m,v
retrieving revision 1.44
diff -u -b -r1.44 det_util.m
--- compiler/det_util.m 19 Oct 2007 06:22:50 -0000 1.44
+++ compiler/det_util.m 11 Dec 2007 15:58:19 -0000
@@ -41,9 +41,7 @@
% Given a list of cases, and a list of the possible cons_ids
% that the switch variable could be bound to, select out only
- % those cases whose cons_id occurs in the list of cases
- % We assume that the list of cases and the list of cons_ids
- % are sorted, so that we can do this using a simple sorted merge.
+ % those cases whose cons_id occurs in the list of possible cons_ids.
%
:- pred delete_unreachable_cases(list(case)::in, list(cons_id)::in,
list(case)::out) is det.
@@ -78,9 +76,9 @@
:- pred det_info_get_fully_strict(det_info::in, bool::out) is det.
:- pred det_info_get_vartypes(det_info::in, vartypes::out) is det.
-:- pred det_info_set_module_info(det_info::in, module_info::in, det_info::out)
+:- pred det_info_set_module_info(module_info::in, det_info::in, det_info::out)
is det.
-:- pred det_info_set_vartypes(det_info::in, vartypes::in, det_info::out)
+:- pred det_info_set_vartypes(vartypes::in, det_info::in, det_info::out)
is det.
%-----------------------------------------------------------------------------%
@@ -96,22 +94,42 @@
:- import_module parse_tree.prog_util.
:- import_module map.
+:- import_module set_tree234.
:- import_module term.
%-----------------------------------------------------------------------------%
-delete_unreachable_cases([], _, []).
-delete_unreachable_cases([_ | _], [], []).
-delete_unreachable_cases([Case | Cases0], [ConsId | ConsIds], Cases) :-
- Case = case(CaseConsId, _DisjList),
- ( CaseConsId = ConsId ->
- Cases = [Case | Cases1],
- delete_unreachable_cases(Cases0, ConsIds, Cases1)
- ; compare(<, CaseConsId, ConsId) ->
- delete_unreachable_cases(Cases0, [ConsId | ConsIds], Cases)
+delete_unreachable_cases(Cases0, PossibleConsIds, Cases) :-
+ PossibleConsIdSet = set_tree234.list_to_set(PossibleConsIds),
+ % We use a reverse list accumulator because we want to avoid requiring
+ % O(n) stack space.
+ delete_unreachable_cases_2(Cases0, PossibleConsIdSet, [], RevCases),
+ list.reverse(RevCases, Cases).
+
+:- pred delete_unreachable_cases_2(list(case)::in, set_tree234(cons_id)::in,
+ list(case)::in, list(case)::out) is det.
+
+delete_unreachable_cases_2([], _PossibleConsIdSet, !RevCases).
+delete_unreachable_cases_2([Case0 | Cases0], PossibleConsIdSet, !RevCases) :-
+ Case0 = case(MainConsId0, OtherConsIds0, Goal),
+ ( set_tree234.member(PossibleConsIdSet, MainConsId0) ->
+ list.filter(set_tree234.contains(PossibleConsIdSet),
+ OtherConsIds0, OtherConsIds),
+ Case = case(MainConsId0, OtherConsIds, Goal),
+ !:RevCases = [Case | !.RevCases]
;
- delete_unreachable_cases([Case | Cases0], ConsIds, Cases)
- ).
+ list.filter(set_tree234.contains(PossibleConsIdSet),
+ OtherConsIds0, OtherConsIds1),
+ (
+ OtherConsIds1 = []
+ % We don't add Case to !RevCases, effectively deleting it.
+ ;
+ OtherConsIds1 = [MainConsId | OtherConsIds],
+ Case = case(MainConsId, OtherConsIds, Goal),
+ !:RevCases = [Case | !.RevCases]
+ )
+ ),
+ delete_unreachable_cases_2(Cases0, PossibleConsIdSet, !RevCases).
interpret_unify(X, rhs_var(Y), !Subst) :-
unify_term(variable(X, context_init), variable(Y, context_init), !Subst).
@@ -185,8 +203,8 @@
det_info_get_fully_strict(DI, DI ^ di_fully_strict).
det_info_get_vartypes(DI, DI ^ di_vartypes).
-det_info_set_module_info(DI, ModuleInfo, DI ^ di_module_info := ModuleInfo).
-det_info_set_vartypes(DI, VarTypes, DI ^ di_vartypes := VarTypes).
+det_info_set_module_info(ModuleInfo, DI, DI ^ di_module_info := ModuleInfo).
+det_info_set_vartypes(VarTypes, DI, DI ^ di_vartypes := VarTypes).
%-----------------------------------------------------------------------------%
Index: compiler/distance_granularity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/distance_granularity.m,v
retrieving revision 1.5
diff -u -b -r1.5 distance_granularity.m
--- compiler/distance_granularity.m 23 Nov 2007 07:35:00 -0000 1.5
+++ compiler/distance_granularity.m 23 Nov 2007 15:21:13 -0000
@@ -796,11 +796,11 @@
apply_dg_to_switch([Case | Cases], !CasesAcc, CallerPredId, CallerProcId,
PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
Distance, !MaybeGranularityVar) :-
- Case = case(Functor, Goal0),
+ Case = case(MainConsId, OtherConsIds, Goal0),
apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId, PredIdSpecialized,
SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, no,
!MaybeGranularityVar, _),
- !:CasesAcc = [case(Functor, Goal) | !.CasesAcc],
+ !:CasesAcc = [case(MainConsId, OtherConsIds, Goal) | !.CasesAcc],
apply_dg_to_switch(Cases, !CasesAcc, CallerPredId, CallerProcId,
PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance,
!MaybeGranularityVar).
@@ -1022,10 +1022,10 @@
update_original_predicate_switch([Case | Cases], !CasesAcc, CallerPredId,
CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
Distance) :-
- Case = case(Functor, Goal0),
+ Case = case(MainConsId, OtherConsIds, Goal0),
update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
- !:CasesAcc = [ case(Functor, Goal) | !.CasesAcc ],
+ !:CasesAcc = [case(MainConsId, OtherConsIds, Goal) | !.CasesAcc],
update_original_predicate_switch(Cases, !CasesAcc, CallerPredId,
CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
Distance).
Index: compiler/dupproc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dupproc.m,v
retrieving revision 1.22
diff -u -b -r1.22 dupproc.m
--- compiler/dupproc.m 11 Oct 2007 11:45:17 -0000 1.22
+++ compiler/dupproc.m 14 Dec 2007 04:46:36 -0000
@@ -211,7 +211,7 @@
StdInstr = goto(StdTarget)
;
Instr = computed_goto(Rval, Targets),
- standardize_labels(Targets, StdTargets, DupProcMap),
+ standardize_maybe_labels(Targets, StdTargets, DupProcMap),
StdInstr = computed_goto(Rval, StdTargets)
;
Instr = if_val(Rval, Target),
@@ -293,13 +293,21 @@
% Compute the standard form of a list(label).
%
-:- pred standardize_labels(list(label)::in, list(label)::out,
- map(proc_label, proc_label)::in) is det.
+:- pred standardize_maybe_labels(list(maybe(label))::in,
+ list(maybe(label))::out, map(proc_label, proc_label)::in) is det.
-standardize_labels([], [], _DupProcMap).
-standardize_labels([Label | Labels], [StdLabel | StdLabels], DupProcMap) :-
+standardize_maybe_labels([], [], _DupProcMap).
+standardize_maybe_labels([MaybeLabel | MaybeLabels],
+ [StdMaybeLabel | StdMaybeLabels], DupProcMap) :-
+ (
+ MaybeLabel = yes(Label),
standardize_label(Label, StdLabel, DupProcMap),
- standardize_labels(Labels, StdLabels, DupProcMap).
+ StdMaybeLabel = yes(StdLabel)
+ ;
+ MaybeLabel = no,
+ StdMaybeLabel = no
+ ),
+ standardize_maybe_labels(MaybeLabels, StdMaybeLabels, DupProcMap).
% Compute the standard form of a code_addr.
%
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.46
diff -u -b -r1.46 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 23 Nov 2007 07:35:00 -0000 1.46
+++ compiler/equiv_type_hlds.m 25 Nov 2007 12:04:37 -0000
@@ -104,7 +104,7 @@
IsExported = no
)
;
- ( Body = hlds_du_type(_, _, _, _, _, _, _)
+ ( Body = hlds_du_type(_, _, _, _, _, _, _, _)
; Body = hlds_foreign_type(_)
; Body = hlds_solver_type(_, _)
; Body = hlds_abstract_type(_)
@@ -148,7 +148,7 @@
equiv_type.maybe_record_expanded_items(ModuleName, TypeCtorSymName,
!.MaybeRecompInfo, EquivTypeInfo0),
(
- Body0 = hlds_du_type(Ctors0, _, _, _, _, _, _),
+ Body0 = hlds_du_type(Ctors0, _, _, _, _, _, _, _),
equiv_type.replace_in_ctors(EqvMap, Ctors0, Ctors,
TVarSet0, TVarSet, EquivTypeInfo0, EquivTypeInfo),
Body = Body0 ^ du_type_ctors := Ctors
@@ -735,6 +735,17 @@
Goal = Goal0
).
+:- pred replace_in_case(eqv_map::in)
+ `with_type` replacer(case, replace_info)
+ `with_inst` replacer.
+
+replace_in_case(EqvMap, Case0, Case, Changed, !Info) :-
+ Case0 = case(MainConsId, OtherConsIds, CaseGoal0),
+ replace_in_goal(EqvMap, CaseGoal0, CaseGoal, Changed, !Info),
+ ( Changed = yes, Case = case(MainConsId, OtherConsIds, CaseGoal)
+ ; Changed = no, Case = Case0
+ ).
+
:- pred replace_in_goal_expr(eqv_map::in)
`with_type` replacer(hlds_goal_expr, replace_info)
`with_inst` replacer.
@@ -755,14 +766,7 @@
).
replace_in_goal_expr(EqvMap, GoalExpr0 @ switch(A, B, Cases0), GoalExpr,
Changed, !Info) :-
- replace_in_list(
- (pred((Case0 @ case(ConsId, CaseGoal0))::in, Case::out,
- CaseChanged::out, !.Info::in, !:Info::out) is det :-
- replace_in_goal(EqvMap, CaseGoal0, CaseGoal, CaseChanged, !Info),
- ( CaseChanged = yes, Case = case(ConsId, CaseGoal)
- ; CaseChanged = no, Case = Case0
- )
- ), Cases0, Cases, Changed, !Info),
+ replace_in_list(replace_in_case(EqvMap), Cases0, Cases, Changed, !Info),
( Changed = yes, GoalExpr = switch(A, B, Cases)
; Changed = no, GoalExpr = GoalExpr0
).
Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.28
diff -u -b -r1.28 erl_code_gen.m
--- compiler/erl_code_gen.m 4 Oct 2007 05:23:01 -0000 1.28
+++ compiler/erl_code_gen.m 23 Nov 2007 16:33:20 -0000
@@ -771,7 +771,7 @@
%
% Get the union of all nonlocal variables bound in all cases.
- CasesGoals = list.map((func(case(_, Goal)) = Goal), CasesList),
+ CasesGoals = list.map((func(case(_, _, Goal)) = Goal), CasesList),
union_bound_nonlocals_in_goals(!.Info, InstMap0, CasesGoals,
NonLocalsBoundInCases),
@@ -805,7 +805,14 @@
% less, so we don't use the workaround if any cases are longer than
% that.
all [String] (
- list.member(case(string_const(String), _), CasesList)
+ (
+ list.member(case(MainConsId, OtherConsIds, _), CasesList),
+ (
+ MainConsId = string_const(String)
+ ;
+ list.member(string_const(String), OtherConsIds)
+ )
+ )
=>
string.length(String) =< 255
)
@@ -849,11 +856,14 @@
erl_gen_info::in, erl_gen_info::out) is det.
erl_gen_case(Type, CodeModel, InstMap, MustBindNonLocals, MaybeSuccessExpr,
- case(ConsId, Goal), ELDSCase, !Info) :-
+ Case, ELDSCase, !Info) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ expect(unify(OtherConsIds, []), this_file,
+ "erl_gen_case: multi-cons-id switch arms NYI"),
erl_gen_info_get_module_info(!.Info, ModuleInfo),
- Size = cons_id_size(ModuleInfo, Type, ConsId),
+ Size = cons_id_size(ModuleInfo, Type, MainConsId),
erl_gen_info_new_anonymous_vars(Size, DummyVars, !Info),
- ( cons_id_to_term(ConsId, DummyVars, elds_anon_var, Pattern0, !Info) ->
+ ( cons_id_to_term(MainConsId, DummyVars, elds_anon_var, Pattern0, !Info) ->
Pattern = Pattern0
;
unexpected(this_file, "erl_gen_case: cannot pattern match on object")
@@ -862,16 +872,15 @@
MaybeSuccessExprForCase, !Info),
erl_gen_goal(CodeModel, InstMap, Goal, MaybeSuccessExprForCase, Statement0,
!Info),
- %
+
% To prevent warnings from the Erlang compiler we must make sure all cases
% bind the same set of variables. This might not be true if the Mercury
% compiler knows that a case calls a procedure which throws an exception.
- %
+
erl_bind_unbound_vars(!.Info, MustBindNonLocals, Goal, InstMap,
Statement0, Statement),
ELDSCase = elds_case(Pattern, Statement).
- %
% cons_id_size(ModuleInfo, Type, ConsId)
%
% Returns the size - 1 of the tuple which represents the
@@ -885,11 +894,10 @@
get_cons_defn(ModuleInfo, TypeCtor, ConsId, ConsDefn)
->
- %
% There will be a cell for each existential type variable
% which isn't mentioned in a typeclass constraint and
% a cell for each constraint and for each arg.
- %
+
Constraints = ConsDefn ^ cons_constraints,
constraint_list_get_tvars(Constraints, ConstrainedTVars),
ExistTVars = ConsDefn ^ cons_exist_tvars,
@@ -906,8 +914,11 @@
erl_gen_info::in, erl_gen_info::out) is det.
erl_gen_case_on_atom(CodeModel, InstMap, MustBindNonLocals, MaybeSuccessExpr,
- case(ConsId, Goal), ELDSCase, !Info) :-
- ( ConsId = string_const(String0) ->
+ Case, ELDSCase, !Info) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ expect(unify(OtherConsIds, []), this_file,
+ "erl_gen_case_on_atom: multi-cons-id switch arms NYI"),
+ ( MainConsId = string_const(String0) ->
String = String0
;
unexpected(this_file, "erl_gen_case_on_atom: non-string const")
@@ -916,11 +927,11 @@
MaybeSuccessExprForCase, !Info),
erl_gen_goal(CodeModel, InstMap, Goal, MaybeSuccessExprForCase, Statement0,
!Info),
- %
+
% To prevent warnings from the Erlang compiler we must make sure all cases
% bind the same set of variables. This might not be true if the Mercury
% compiler knows that a case calls a procedure which throws an exception.
- %
+
erl_bind_unbound_vars(!.Info, MustBindNonLocals, Goal, InstMap,
Statement0, Statement),
ELDSCase = elds_case(elds_atom_raw(String), Statement).
Index: compiler/exception_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/exception_analysis.m,v
retrieving revision 1.41
diff -u -b -r1.41 exception_analysis.m
--- compiler/exception_analysis.m 23 Nov 2007 07:35:00 -0000 1.41
+++ compiler/exception_analysis.m 23 Nov 2007 08:29:08 -0000
@@ -519,7 +519,7 @@
check_goal_for_exceptions_2(SCC, VarTypes, Goal, _, !Result, !ModuleInfo,
!IO) :-
Goal = switch(_, _, Cases),
- CaseGoals = list.map((func(case(_, CaseGoal)) = CaseGoal), Cases),
+ CaseGoals = list.map((func(case(_, _, CaseGoal)) = CaseGoal), Cases),
check_goals_for_exceptions(SCC, VarTypes, CaseGoals, !Result, !ModuleInfo,
!IO).
check_goal_for_exceptions_2(SCC, VarTypes, Goal, _, !Result,
Index: compiler/export.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.118
diff -u -b -r1.118 export.m
--- compiler/export.m 23 Nov 2007 07:35:01 -0000 1.118
+++ compiler/export.m 25 Nov 2007 11:46:08 -0000
@@ -811,8 +811,9 @@
),
unexpected(this_file, "invalid type for foreign_export_enum")
;
- TypeBody = hlds_du_type(Ctors, TagValues, IsEnumOrDummy,
- _MaybeUserEq, _ReservedTag, _ReservedAddr, _IsForeignType),
+ TypeBody = hlds_du_type(Ctors, TagValues, _CheaperTagTest,
+ IsEnumOrDummy, _MaybeUserEq, _ReservedTag, _ReservedAddr,
+ _IsForeignType),
(
IsEnumOrDummy = not_enum_or_dummy,
unexpected(this_file, "d.u. is not an enumeration.")
Index: compiler/follow_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.92
diff -u -b -r1.92 follow_code.m
--- compiler/follow_code.m 23 Nov 2007 07:35:01 -0000 1.92
+++ compiler/follow_code.m 23 Nov 2007 08:18:22 -0000
@@ -182,9 +182,9 @@
move_follow_code_in_cases([], [], !Changed).
move_follow_code_in_cases([Case0 | Cases0], [Case | Cases], !Changed) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
move_follow_code_in_goal(Goal0, Goal, !Changed),
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
move_follow_code_in_cases(Cases0, Cases, !Changed).
%-----------------------------------------------------------------------------%
@@ -304,10 +304,10 @@
move_follow_code_move_goals_cases([], _FollowGoals, _FollowPurity, []).
move_follow_code_move_goals_cases([Case0 | Cases0], FollowGoals, FollowPurity,
[Case | Cases]) :-
- Case0 = case(Cons, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
follow_code_conjoin_goal_and_goal_list(Goal0, FollowGoals, FollowPurity,
Goal),
- Case = case(Cons, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
move_follow_code_move_goals_cases(Cases0, FollowGoals, FollowPurity,
Cases).
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/follow_vars.m,v
retrieving revision 1.89
diff -u -b -r1.89 follow_vars.m
--- compiler/follow_vars.m 23 Nov 2007 07:35:01 -0000 1.89
+++ compiler/follow_vars.m 23 Nov 2007 16:15:09 -0000
@@ -387,16 +387,17 @@
int::in, int::out) is det.
find_follow_vars_in_cases([], [], _, _, !FollowVarsMap, !NextNonReserved).
-find_follow_vars_in_cases([case(Cons, Goal0) | Goals0],
- [case(Cons, Goal) | Goals], VarTypes, ModuleInfo,
- FollowVarsMap0, FollowVarsMap,
+find_follow_vars_in_cases([Case0 | Cases0], [Case | Cases],
+ VarTypes, ModuleInfo, FollowVarsMap0, FollowVarsMap,
NextNonReserved0, NextNonReserved) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
find_follow_vars_in_goal(Goal0, Goal1, VarTypes, ModuleInfo,
FollowVarsMap0, FollowVarsMap,
NextNonReserved0, NextNonReserved),
FollowVars = abs_follow_vars(FollowVarsMap, NextNonReserved),
goal_set_follow_vars(yes(FollowVars), Goal1, Goal),
- find_follow_vars_in_cases(Goals0, Goals, VarTypes, ModuleInfo,
+ Case = case(MainConsId, OtherConsIds, Goal),
+ find_follow_vars_in_cases(Cases0, Cases, VarTypes, ModuleInfo,
FollowVarsMap0, _FollowVarsMap,
NextNonReserved, _NextNonReserved).
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.76
diff -u -b -r1.76 foreign.m
--- compiler/foreign.m 23 Nov 2007 07:35:02 -0000 1.76
+++ compiler/foreign.m 25 Nov 2007 11:46:15 -0000
@@ -551,7 +551,7 @@
ForeignTypeName, _, Assertions),
ExportType = exported_type_foreign(ForeignTypeName, Assertions)
;
- ( Body = hlds_du_type(_, _, _, _, _, _, _)
+ ( Body = hlds_du_type(_, _, _, _, _, _, _, _)
; Body = hlds_eqv_type(_)
; Body = hlds_solver_type(_, _)
; Body = hlds_abstract_type(_)
Index: compiler/format_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/format_call.m,v
retrieving revision 1.11
diff -u -b -r1.11 format_call.m
--- compiler/format_call.m 7 Aug 2007 07:09:53 -0000 1.11
+++ compiler/format_call.m 23 Nov 2007 10:01:17 -0000
@@ -562,7 +562,7 @@
:- func project_case_goal(case) = hlds_goal.
-project_case_goal(case(_, Goal)) = Goal.
+project_case_goal(case(_, _, Goal)) = Goal.
:- pred traverse_disj(list(hlds_goal)::in, conj_id::in,
list(format_call_site)::in, list(format_call_site)::out,
Index: compiler/frameopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/frameopt.m,v
retrieving revision 1.113
diff -u -b -r1.113 frameopt.m
--- compiler/frameopt.m 23 Nov 2007 07:35:02 -0000 1.113
+++ compiler/frameopt.m 14 Dec 2007 04:47:21 -0000
@@ -1219,7 +1219,7 @@
;
LastUinstr0 = computed_goto(Rval, GotoTargets0)
->
- replace_labels_label_list(GotoTargets0, GotoTargets,
+ replace_labels_maybe_label_list(GotoTargets0, GotoTargets,
PreExitDummyLabelMap),
LastUinstr = computed_goto(Rval, GotoTargets),
LastInstr = llds_instr(LastUinstr, Comment),
Index: compiler/goal_form.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_form.m,v
retrieving revision 1.41
diff -u -b -r1.41 goal_form.m
--- compiler/goal_form.m 23 Nov 2007 07:35:02 -0000 1.41
+++ compiler/goal_form.m 23 Nov 2007 07:54:29 -0000
@@ -290,7 +290,7 @@
cases_can_throw([], cannot_throw, !ModuleInfo, !IO).
cases_can_throw([Case | Cases], Result, !ModuleInfo, !IO) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
goal_can_throw(Goal, Result0, !ModuleInfo, !IO),
(
Result0 = cannot_throw,
@@ -301,8 +301,8 @@
).
goal_can_loop_or_throw(Goal, Result, !ModuleInfo, !IO) :-
- % XXX this will need to change after the termination analyses are
- % converted to use the intermodule-analysis framework.
+ % XXX This will need to change after the termination analyses are converted
+ % to use the intermodule-analysis framework.
( goal_cannot_loop(!.ModuleInfo, Goal) ->
goal_can_throw(Goal, ThrowResult, !ModuleInfo, !IO),
(
@@ -442,7 +442,7 @@
:- func case_list_can_loop(maybe(module_info), list(case)) = bool.
case_list_can_loop(_, []) = no.
-case_list_can_loop(MaybeModuleInfo, [case(_, Goal) | Cases]) =
+case_list_can_loop(MaybeModuleInfo, [case(_, _, Goal) | Cases]) =
( goal_can_loop_func(MaybeModuleInfo, Goal) = yes ->
yes
;
@@ -550,7 +550,7 @@
:- func case_list_can_throw(maybe(module_info), list(case)) = bool.
case_list_can_throw(_, []) = no.
-case_list_can_throw(MaybeModuleInfo, [case(_, Goal) | Cases]) =
+case_list_can_throw(MaybeModuleInfo, [case(_, _, Goal) | Cases]) =
( goal_can_throw_func(MaybeModuleInfo, Goal) = yes ->
yes
;
@@ -683,7 +683,7 @@
:- pred cases_may_allocate_heap(list(case)::in, bool::out) is det.
cases_may_allocate_heap([], no).
-cases_may_allocate_heap([case(_, Goal) | Cases], May) :-
+cases_may_allocate_heap([case(_, _, Goal) | Cases], May) :-
( goal_may_allocate_heap(Goal, yes) ->
May = yes
;
@@ -719,7 +719,7 @@
:- pred cannot_stack_flush_cases(list(case)::in) is semidet.
cannot_stack_flush_cases([]).
-cannot_stack_flush_cases([case(_, Goal) | Cases]) :-
+cannot_stack_flush_cases([case(_, _, Goal) | Cases]) :-
cannot_stack_flush(Goal),
cannot_stack_flush_cases(Cases).
@@ -841,7 +841,7 @@
count_recursive_calls_cases([], _, _, _, _) :-
unexpected(this_file, "empty cases in count_recursive_calls_cases").
-count_recursive_calls_cases([case(_, Goal) | Cases], PredId, ProcId,
+count_recursive_calls_cases([case(_, _, Goal) | Cases], PredId, ProcId,
Min, Max) :-
(
Cases = [],
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.46
diff -u -b -r1.46 goal_path.m
--- compiler/goal_path.m 23 Nov 2007 07:35:02 -0000 1.46
+++ compiler/goal_path.m 23 Nov 2007 07:46:48 -0000
@@ -240,10 +240,12 @@
fill_switch_slots(_, _, _, _, [], []).
fill_switch_slots(Path0, N0, MaybeNumFunctors, SlotInfo,
- [case(ConsId, Goal0) | Cases0], [case(ConsId, Goal) | Cases]) :-
+ [Case0 | Cases0], [Case | Cases]) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
N1 = N0 + 1,
fill_goal_slots(cord.snoc(Path0, step_switch(N1, MaybeNumFunctors)),
SlotInfo, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
fill_switch_slots(Path0, N1, MaybeNumFunctors, SlotInfo, Cases0, Cases).
%-----------------------------------------------------------------------------%
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.152
diff -u -b -r1.152 goal_util.m
--- compiler/goal_util.m 23 Nov 2007 07:35:02 -0000 1.152
+++ compiler/goal_util.m 23 Nov 2007 16:29:08 -0000
@@ -214,8 +214,8 @@
% (deconstruction unification) to the case goal.
% This aborts if the constructor is existentially typed.
%
-:- pred case_to_disjunct(prog_var::in, cons_id::in, hlds_goal::in,
- instmap::in, hlds_goal::out, prog_varset::in, prog_varset::out,
+:- pred case_to_disjunct(prog_var::in, hlds_goal::in, instmap::in,
+ cons_id::in, hlds_goal::out, prog_varset::in, prog_varset::out,
vartypes::in, vartypes::out, module_info::in, module_info::out) is det.
% Transform an if-then-else into ( Cond, Then ; \+ Cond, Else ),
@@ -552,7 +552,7 @@
set(prog_var)::in, set(prog_var)::out) is det.
cases_goal_vars([], !Set).
-cases_goal_vars([case(_, Goal) | Cases], !Set) :-
+cases_goal_vars([case(_, _, Goal) | Cases], !Set) :-
goal_vars_2(Goal ^ hlds_goal_expr, !Set),
cases_goal_vars(Cases, !Set).
@@ -587,8 +587,10 @@
:- pred attach_features_to_case(list(goal_feature)::in,
case::in, case::out) is det.
-attach_features_to_case(Features, case(ConsId, Goal0), case(ConsId, Goal)) :-
- attach_features_to_all_goals(Features, Goal0, Goal).
+attach_features_to_case(Features, Case0, Case) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ attach_features_to_all_goals(Features, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal).
:- pred attach_features_goal_expr(list(goal_feature)::in,
hlds_goal_expr::in, hlds_goal_expr::out) is det.
@@ -759,7 +761,7 @@
proc_body_is_leaf_cases([]) = is_leaf.
proc_body_is_leaf_cases([Case | Cases]) = IsLeaf :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
(
proc_body_is_leaf(Goal) = is_leaf,
proc_body_is_leaf_cases(Cases) = is_leaf
@@ -805,7 +807,7 @@
:- pred cases_size(list(case)::in, int::out) is det.
cases_size([], 0).
-cases_size([case(_, Goal) | Cases], Size) :-
+cases_size([case(_, _, Goal) | Cases], Size) :-
goal_size(Goal, Size1),
cases_size(Cases, Size2),
Size = Size1 + Size2.
@@ -879,7 +881,7 @@
:- mode cases_calls(in, in) is semidet.
:- mode cases_calls(in, out) is nondet.
-cases_calls([case(_, Goal) | Cases], PredProcId) :-
+cases_calls([case(_, _, Goal) | Cases], PredProcId) :-
(
goal_calls(Goal, PredProcId)
;
@@ -937,7 +939,7 @@
:- mode cases_calls_pred_id(in, in) is semidet.
:- mode cases_calls_pred_id(in, out) is nondet.
-cases_calls_pred_id([case(_, Goal) | Cases], PredId) :-
+cases_calls_pred_id([case(_, _, Goal) | Cases], PredId) :-
(
goal_calls_pred_id(Goal, PredId)
;
@@ -1035,7 +1037,7 @@
case_list_calls_proc_in_list([], _, !CalledSet).
case_list_calls_proc_in_list([Case | Cases], PredProcIds, !CalledSet) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
goal_calls_proc_in_list_2(Goal, PredProcIds, !CalledSet),
case_list_calls_proc_in_list(Cases, PredProcIds, !CalledSet).
@@ -1054,7 +1056,7 @@
goals_contain_reconstruction(Goals).
goal_expr_contains_reconstruction(switch(_, _, Cases)) :-
list.member(Case, Cases),
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
goal_contains_reconstruction(Goal).
goal_expr_contains_reconstruction(if_then_else(_, Cond, Then, Else)) :-
goals_contain_reconstruction([Cond, Then, Else]).
@@ -1092,19 +1094,23 @@
list.member(Goal, DisjList).
direct_subgoal(switch(_, _, CaseList), Goal) :-
list.member(Case, CaseList),
- Case = case(_, Goal).
+ Case = case(_, _, Goal).
%-----------------------------------------------------------------------------%
switch_to_disjunction(_, [], _, [], !VarSet, !VarTypes, !ModuleInfo).
-switch_to_disjunction(Var, [case(ConsId, Goal0) | Cases], InstMap,
- [Goal | Goals], !VarSet, !VarTypes, !ModuleInfo) :-
- case_to_disjunct(Var, ConsId, Goal0, InstMap, Goal, !VarSet, !VarTypes,
+switch_to_disjunction(Var, [Case | Cases], InstMap, Goals,
+ !VarSet, !VarTypes, !ModuleInfo) :-
+ Case = case(MainConsId, OtherConsIds, CaseGoal),
+ case_to_disjunct(Var, CaseGoal, InstMap, MainConsId, MainDisjunctGoal,
+ !VarSet, !VarTypes, !ModuleInfo),
+ list.map_foldl3(case_to_disjunct(Var, CaseGoal, InstMap),
+ OtherConsIds, OtherDisjunctGoals, !VarSet, !VarTypes, !ModuleInfo),
+ switch_to_disjunction(Var, Cases, InstMap, CasesGoals, !VarSet, !VarTypes,
!ModuleInfo),
- switch_to_disjunction(Var, Cases, InstMap, Goals, !VarSet, !VarTypes,
- !ModuleInfo).
+ Goals = [MainDisjunctGoal | OtherDisjunctGoals] ++ CasesGoals.
-case_to_disjunct(Var, ConsId, CaseGoal, InstMap, Disjunct, !VarSet, !VarTypes,
+case_to_disjunct(Var, CaseGoal, InstMap, ConsId, Disjunct, !VarSet, !VarTypes,
!ModuleInfo) :-
ConsArity = cons_id_arity(ConsId),
svvarset.new_vars(ConsArity, ArgVars, !VarSet),
@@ -1630,9 +1636,9 @@
:- func maybe_strip_equality_pretest_case(case) = case.
maybe_strip_equality_pretest_case(Case0) = Case :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
Goal = maybe_strip_equality_pretest(Goal0),
- Case = case(ConsId, Goal).
+ Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
Index: compiler/granularity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/granularity.m,v
retrieving revision 1.9
diff -u -b -r1.9 granularity.m
--- compiler/granularity.m 7 Aug 2007 07:09:53 -0000 1.9
+++ compiler/granularity.m 23 Nov 2007 09:16:20 -0000
@@ -225,9 +225,9 @@
runtime_granularity_test_in_cases([], [], !Changed, _, _).
runtime_granularity_test_in_cases([Case0 | Cases0], [Case | Cases], !Changed,
SCC, ModuleInfo) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
runtime_granularity_test_in_goal(Goal0, Goal, !Changed, SCC, ModuleInfo),
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
runtime_granularity_test_in_cases(Cases0, Cases, !Changed, SCC,
ModuleInfo).
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.313
diff -u -b -r1.313 handle_options.m
--- compiler/handle_options.m 23 Nov 2007 07:35:03 -0000 1.313
+++ compiler/handle_options.m 14 Dec 2007 07:03:52 -0000
@@ -1076,6 +1076,9 @@
option_implies(highlevel_code, mutable_always_boxed, bool(no),
!Globals),
+ option_implies(highlevel_code, allow_multi_arm_switches, bool(no),
+ !Globals),
+
option_implies(target_debug, strip, bool(no), !Globals),
% Inlining happens before the deep profiling transformation, so if
@@ -2752,6 +2755,7 @@
convert_dump_alias("all", "abcdfgilmnprstuvzBCMPSTZ").
convert_dump_alias("most", "bcdfgilmnprstuvzP").
convert_dump_alias("trans", "bcdglmnstuvz").
+convert_dump_alias("mintrans", "bcdglmnstvz").
convert_dump_alias("codegen", "dfnprsu").
convert_dump_alias("vanessa", "ltuCIU").
convert_dump_alias("min", "ilv").
Index: compiler/hhf.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hhf.m,v
retrieving revision 1.32
diff -u -b -r1.32 hhf.m
--- compiler/hhf.m 7 Aug 2007 07:09:54 -0000 1.32
+++ compiler/hhf.m 13 Dec 2007 13:00:04 -0000
@@ -390,10 +390,10 @@
VarTypes0 = !.HI ^ vartypes,
(
map.search(VarTypes0, Var, Type),
- type_constructors(Type, ModuleInfo, Constructors),
- type_to_ctor_and_args(Type, TypeId, _)
+ type_constructors(ModuleInfo, Type, Constructors),
+ type_to_ctor_and_args(Type, TypeCtor, _)
->
- list.foldl(maybe_add_cons_id(Var, ModuleInfo, BaseVars, TypeId),
+ list.foldl(maybe_add_cons_id(Var, ModuleInfo, BaseVars, TypeCtor),
Constructors, !HI)
;
true
@@ -402,9 +402,9 @@
:- pred maybe_add_cons_id(prog_var::in, module_info::in, list(prog_var)::in,
type_ctor::in, constructor::in, hhf_info::in, hhf_info::out) is det.
-maybe_add_cons_id(Var, ModuleInfo, BaseVars, TypeId, Ctor, !HI) :-
+maybe_add_cons_id(Var, ModuleInfo, BaseVars, TypeCtor, Ctor, !HI) :-
Ctor = ctor(_, _, Name, Args, _),
- ConsId = make_cons_id(Name, Args, TypeId),
+ ConsId = make_cons_id(Name, Args, TypeCtor),
map.lookup(!.HI ^ inst_graph, Var, node(Functors0, MaybeParent)),
( map.contains(Functors0, ConsId) ->
true
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.170
diff -u -b -r1.170 higher_order.m
--- compiler/higher_order.m 23 Nov 2007 07:35:03 -0000 1.170
+++ compiler/higher_order.m 23 Nov 2007 09:16:01 -0000
@@ -692,9 +692,9 @@
traverse_cases_2(PreInfo, [Case0 | Cases0], [Case | Cases], !PostInfos,
!Info) :-
set_pre_branch_info(PreInfo, !Info),
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
traverse_goal_2(Goal0, Goal, !Info),
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
get_post_branch_info(!.Info, GoalPostInfo),
!:PostInfos = [GoalPostInfo | !.PostInfos],
traverse_cases_2(PreInfo, Cases0, Cases, !PostInfos, !Info).
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.35
diff -u -b -r1.35 hlds_code_util.m
--- compiler/hlds_code_util.m 23 Nov 2007 07:35:04 -0000 1.35
+++ compiler/hlds_code_util.m 28 Nov 2007 03:55:14 -0000
@@ -31,7 +31,7 @@
% Find out how a function symbol (constructor) is represented
% in the given type.
%
-:- func cons_id_to_tag(cons_id, mer_type, module_info) = cons_tag.
+:- func cons_id_to_tag(module_info, mer_type, cons_id) = cons_tag.
% Given a list of types, mangle the names so into a string which
% identifies them. The types must all have their top level functor
@@ -76,28 +76,46 @@
%-----------------------------------------------------------------------------%
-cons_id_to_tag(int_const(I), _, _) = int_tag(I).
-cons_id_to_tag(float_const(F), _, _) = float_tag(F).
-cons_id_to_tag(string_const(S), _, _) = string_tag(S).
-cons_id_to_tag(pred_const(ShroudedPredProcId, EvalMethod), _, _) =
- pred_closure_tag(PredId, ProcId, EvalMethod) :-
- proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId).
-cons_id_to_tag(type_ctor_info_const(M,T,A), _, _) =
- type_ctor_info_tag(M,T,A).
-cons_id_to_tag(base_typeclass_info_const(M,C,_,N), _, _) =
- base_typeclass_info_tag(M,C,N).
-cons_id_to_tag(type_info_cell_constructor(_), _, _) = unshared_tag(0).
-cons_id_to_tag(typeclass_info_cell_constructor, _, _) = unshared_tag(0).
-cons_id_to_tag(tabling_info_const(ShroudedPredProcId), _, _) =
- tabling_info_tag(PredId, ProcId) :-
- proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId).
-cons_id_to_tag(deep_profiling_proc_layout(ShroudedPredProcId), _, _) =
- deep_profiling_proc_layout_tag(PredId, ProcId) :-
- proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId).
-cons_id_to_tag(table_io_decl(ShroudedPredProcId), _, _) =
- table_io_decl_tag(PredId, ProcId) :-
- proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId).
-cons_id_to_tag(cons(Name, Arity), Type, ModuleInfo) = Tag :-
+cons_id_to_tag(ModuleInfo, Type, ConsId) = Tag:-
+ (
+ ConsId = int_const(I),
+ Tag = int_tag(I)
+ ;
+ ConsId = float_const(F),
+ Tag = float_tag(F)
+ ;
+ ConsId = string_const(S),
+ Tag = string_tag(S)
+ ;
+ ConsId = pred_const(ShroudedPredProcId, EvalMethod),
+ proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
+ Tag = pred_closure_tag(PredId, ProcId, EvalMethod)
+ ;
+ ConsId = type_ctor_info_const(ModuleName, TypeName, Arity),
+ Tag = type_ctor_info_tag(ModuleName, TypeName, Arity)
+ ;
+ ConsId = base_typeclass_info_const(ModuleName, ClassName, _Instance,
+ EncodedArgs),
+ Tag = base_typeclass_info_tag(ModuleName, ClassName, EncodedArgs)
+ ;
+ ( ConsId = type_info_cell_constructor(_)
+ ; ConsId = typeclass_info_cell_constructor
+ ),
+ Tag = unshared_tag(0)
+ ;
+ ConsId = tabling_info_const(ShroudedPredProcId),
+ proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
+ Tag = tabling_info_tag(PredId, ProcId)
+ ;
+ ConsId = deep_profiling_proc_layout(ShroudedPredProcId),
+ proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
+ Tag = deep_profiling_proc_layout_tag(PredId, ProcId)
+ ;
+ ConsId = table_io_decl(ShroudedPredProcId),
+ proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
+ Tag = table_io_decl_tag(PredId, ProcId)
+ ;
+ ConsId = cons(Name, Arity),
(
% Handle the `character' type specially.
Type = builtin_type(builtin_type_character),
@@ -108,8 +126,8 @@
Tag = int_tag(CharCode)
;
% Tuples do not need a tag. Note that unary tuples are not treated
- % as no_tag types. There's no reason why they couldn't be, it's just
- % not worth the effort.
+ % as no_tag types. There's no reason why they couldn't be, it is
+ % just not worth the effort.
type_is_tuple(Type, _)
->
Tag = single_functor_tag
@@ -121,7 +139,7 @@
map.lookup(TypeTable, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
(
- TypeBody = hlds_du_type(_, ConsTagTable, _, _, _, _, _)
+ TypeBody = hlds_du_type(_, ConsTagTable, _, _, _, _, _, _)
;
( TypeBody = hlds_eqv_type(_)
; TypeBody = hlds_foreign_type(_)
@@ -133,6 +151,7 @@
% Finally look up the cons_id in the table.
map.lookup(ConsTagTable, cons(Name, Arity), Tag)
+ )
).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.119
diff -u -b -r1.119 hlds_data.m
--- compiler/hlds_data.m 23 Nov 2007 07:35:04 -0000 1.119
+++ compiler/hlds_data.m 13 Dec 2007 09:12:14 -0000
@@ -167,6 +167,8 @@
% Their tag values.
du_type_cons_tag_values :: cons_tag_values,
+ du_type_chaper_tag_test :: maybe_cheaper_tag_test,
+
% Is this type an enumeration?
du_type_is_enum :: enum_or_dummy,
@@ -188,6 +190,15 @@
; hlds_solver_type(solver_type_details, maybe(unify_compare))
; hlds_abstract_type(is_solver_type).
+:- type maybe_cheaper_tag_test
+ ---> no_cheaper_tag_test
+ ; cheaper_tag_test(
+ more_expensive_cons_id :: cons_id,
+ more_expensive_cons_tag :: cons_tag,
+ less_expensive_cons_id :: cons_id,
+ less_expensive_cons_tag :: cons_tag
+ ).
+
:- type enum_or_dummy
---> is_mercury_enum
; is_foreign_enum(foreign_language)
@@ -221,6 +232,15 @@
%
:- type cons_tag_values == map(cons_id, cons_tag).
+ % A cons_id together with its tag.
+ %
+:- type tagged_cons_id
+ ---> tagged_cons_id(cons_id, cons_tag).
+
+ % Return the tag inside a tagged_cons_id.
+ %
+:- func project_tagged_cons_id_tag(tagged_cons_id) = cons_tag.
+
% A `cons_tag' specifies how a functor and its arguments (if any) are
% represented. Currently all values are represented as a single word;
% values which do not fit into a word are represented by a (possibly
@@ -359,6 +379,8 @@
:- type no_tag_type_table == map(type_ctor, no_tag_type).
+:- func get_maybe_cheaper_tag_test(hlds_type_body) = maybe_cheaper_tag_test.
+
% Return the primary tag, if any, for a cons_tag.
% A return value of `no' means the primary tag is unknown.
% A return value of `yes(N)' means the primary tag is N.
@@ -386,6 +408,21 @@
:- implementation.
+project_tagged_cons_id_tag(TaggedConsId) = Tag :-
+ TaggedConsId = tagged_cons_id(_, Tag).
+
+get_maybe_cheaper_tag_test(TypeBody) = CheaperTagTest :-
+ (
+ TypeBody = hlds_du_type(_, _, CheaperTagTest, _, _, _, _, _)
+ ;
+ ( TypeBody = hlds_eqv_type(_)
+ ; TypeBody = hlds_foreign_type(_)
+ ; TypeBody = hlds_solver_type(_, _)
+ ; TypeBody = hlds_abstract_type(_)
+ ),
+ CheaperTagTest = no_cheaper_tag_test
+ ).
+
% In some of the cases where we return `no' here,
% it would probably be OK to return `yes(0)'.
% But it's safe to be conservative...
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.184
diff -u -b -r1.184 hlds_goal.m
--- compiler/hlds_goal.m 23 Nov 2007 07:35:04 -0000 1.184
+++ compiler/hlds_goal.m 11 Dec 2007 02:49:21 -0000
@@ -19,6 +19,7 @@
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_data.
:- import_module hlds.instmap.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.program_representation.
@@ -825,14 +826,28 @@
%-----------------------------------------------------------------------------%
%
-% Information for switches
+% Information for switches.
%
:- type case
---> case(
- case_functor :: cons_id, % functor to match with,
- case_goal :: hlds_goal % goal to execute if match
- % succeeds.
+ % The list of functors for which this case arm is applicable.
+ case_first_functor :: cons_id,
+ case_later_functors :: list(cons_id),
+
+ % The code of the switch arm.
+ case_goal :: hlds_goal
+ ).
+
+:- type tagged_case
+ ---> tagged_case(
+ % The list of functors, and their tags, for which
+ % this case arm is applicable.
+ tagged_case_first_functor :: tagged_cons_id,
+ tagged_case_later_functors :: list(tagged_cons_id),
+
+ % The code of the switch arm.
+ tagged_case_goal :: hlds_goal
).
%-----------------------------------------------------------------------------%
@@ -1564,7 +1579,7 @@
%-----------------------------------------------------------------------------%
%
-% Information stored with all kinds of goals
+% Information stored with all kinds of goals.
%
% This type has eight fields, which means that the Boehm collector
@@ -2201,10 +2216,11 @@
list(case)::in, list(case)::out) is det.
rename_vars_in_cases(_Must, _Subn, [], []).
-rename_vars_in_cases(Must, Subn,
- [case(Cons, G0) | Gs0], [case(Cons, G) | Gs]) :-
- rename_vars_in_goal(Must, Subn, G0, G),
- rename_vars_in_cases(Must, Subn, Gs0, Gs).
+rename_vars_in_cases(Must, Subn, [Case0 | Cases0], [Case | Cases]) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ rename_vars_in_goal(Must, Subn, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ rename_vars_in_cases(Must, Subn, Cases0, Cases).
:- pred rename_unify_rhs(must_rename::in, prog_var_renaming::in,
unify_rhs::in, unify_rhs::out) is det.
@@ -2690,50 +2706,55 @@
%-----------------------------------------------------------------------------%
-set_goal_contexts(Context, hlds_goal(GoalExpr0, GoalInfo0),
- hlds_goal(GoalExpr, GoalInfo)) :-
+set_goal_contexts(Context, Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
goal_info_set_context(Context, GoalInfo0, GoalInfo),
- set_goal_contexts_2(Context, GoalExpr0, GoalExpr).
+ set_goal_contexts_expr(Context, GoalExpr0, GoalExpr),
+ Goal = hlds_goal(GoalExpr, GoalInfo).
+
+:- pred set_goal_contexts_case(prog_context::in, case::in, case::out) is det.
-:- pred set_goal_contexts_2(prog_context::in, hlds_goal_expr::in,
+set_goal_contexts_case(Context, Case0, Case) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ set_goal_contexts(Context, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal).
+
+:- pred set_goal_contexts_expr(prog_context::in, hlds_goal_expr::in,
hlds_goal_expr::out) is det.
-set_goal_contexts_2(Context, conj(ConjType, Goals0), conj(ConjType, Goals)) :-
+set_goal_contexts_expr(Context, conj(ConjType, Goals0), conj(ConjType, Goals)) :-
list.map(set_goal_contexts(Context), Goals0, Goals).
-set_goal_contexts_2(Context, disj(Goals0), disj(Goals)) :-
+set_goal_contexts_expr(Context, disj(Goals0), disj(Goals)) :-
list.map(set_goal_contexts(Context), Goals0, Goals).
-set_goal_contexts_2(Context, if_then_else(Vars, Cond0, Then0, Else0),
+set_goal_contexts_expr(Context, if_then_else(Vars, Cond0, Then0, Else0),
if_then_else(Vars, Cond, Then, Else)) :-
set_goal_contexts(Context, Cond0, Cond),
set_goal_contexts(Context, Then0, Then),
set_goal_contexts(Context, Else0, Else).
-set_goal_contexts_2(Context, switch(Var, CanFail, Cases0),
+set_goal_contexts_expr(Context, switch(Var, CanFail, Cases0),
switch(Var, CanFail, Cases)) :-
- list.map(
- (pred(case(ConsId, Goal0)::in, case(ConsId, Goal)::out) is det :-
- set_goal_contexts(Context, Goal0, Goal)
- ), Cases0, Cases).
-set_goal_contexts_2(Context, scope(Reason, Goal0), scope(Reason, Goal)) :-
+ list.map(set_goal_contexts_case(Context), Cases0, Cases).
+set_goal_contexts_expr(Context, scope(Reason, Goal0), scope(Reason, Goal)) :-
set_goal_contexts(Context, Goal0, Goal).
-set_goal_contexts_2(Context, negation(Goal0), negation(Goal)) :-
+set_goal_contexts_expr(Context, negation(Goal0), negation(Goal)) :-
set_goal_contexts(Context, Goal0, Goal).
-set_goal_contexts_2(_, Goal, Goal) :-
+set_goal_contexts_expr(_, Goal, Goal) :-
Goal = plain_call(_, _, _, _, _, _).
-set_goal_contexts_2(_, Goal, Goal) :-
+set_goal_contexts_expr(_, Goal, Goal) :-
Goal = generic_call(_, _, _, _).
-set_goal_contexts_2(_, Goal, Goal) :-
+set_goal_contexts_expr(_, Goal, Goal) :-
Goal = unify(_, _, _, _, _).
-set_goal_contexts_2(_, Goal, Goal) :-
+set_goal_contexts_expr(_, Goal, Goal) :-
Goal = call_foreign_proc(_, _, _, _, _, _, _).
-set_goal_contexts_2(Context, shorthand(ShorthandGoal0),
- shorthand(ShorthandGoal)) :-
- set_goal_contexts_2_shorthand(Context, ShorthandGoal0, ShorthandGoal).
+set_goal_contexts_expr(Context,
+ shorthand(ShorthandGoal0), shorthand(ShorthandGoal)) :-
+ set_goal_contexts_shorthand(Context, ShorthandGoal0, ShorthandGoal).
-:- pred set_goal_contexts_2_shorthand(prog_context::in,
+:- pred set_goal_contexts_shorthand(prog_context::in,
shorthand_goal_expr::in, shorthand_goal_expr::out) is det.
-set_goal_contexts_2_shorthand(Context, bi_implication(LHS0, RHS0),
- bi_implication(LHS, RHS)) :-
+set_goal_contexts_shorthand(Context,
+ bi_implication(LHS0, RHS0), bi_implication(LHS, RHS)) :-
set_goal_contexts(Context, LHS0, LHS),
set_goal_contexts(Context, RHS0, RHS).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.439
diff -u -b -r1.439 hlds_out.m
--- compiler/hlds_out.m 23 Nov 2007 07:35:05 -0000 1.439
+++ compiler/hlds_out.m 14 Dec 2007 07:03:53 -0000
@@ -35,6 +35,7 @@
:- import_module hlds.hlds_args.
:- import_module hlds.hlds_clauses.
+:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
@@ -85,6 +86,14 @@
%
:- func call_arg_id_to_string(call_id, int, pred_markers) = string.
+:- type is_first
+ ---> is_first
+ ; is_not_first.
+
+:- type is_last
+ ---> is_last
+ ; is_not_last.
+
% unify_context_to_pieces generates a message such as
% foo.m:123: in argument 3 of functor `foo/5':
% foo.m:123: in unification of `X' and `blah':
@@ -103,7 +112,8 @@
% The bool returned as the second argument will be `no' unless nothing
% was generated, in which case it will be the same as the first arg.
%
-:- pred unify_context_first_to_pieces(bool::in, bool::out, unify_context::in,
+:- pred unify_context_first_to_pieces(is_first::in, is_first::out,
+ unify_context::in,
list(format_component)::in, list(format_component)::out) is det.
:- func determinism_to_string(determinism) = string.
@@ -247,6 +257,20 @@
= string.
%-----------------------------------------------------------------------------%
+
+ % Given a tagged cons_id, return the name of the cons_id and the tag.
+ %
+:- pred project_cons_name_and_tag(tagged_cons_id::in, string::out,
+ cons_tag::out) is det.
+
+ % case_comment(VarName, MainConsName, OtherConsNames) = Comment:
+ %
+ % Create a comment describing the arm of the switch on VarName that covers
+ % MainConsName and OtherConsNames.
+ %
+:- func case_comment(string, string, list(string)) = string.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -514,7 +538,7 @@
%-----------------------------------------------------------------------------%
unify_context_to_pieces(UnifyContext, !Pieces) :-
- unify_context_first_to_pieces(no, _, UnifyContext, !Pieces).
+ unify_context_first_to_pieces(is_not_first, _, UnifyContext, !Pieces).
unify_context_first_to_pieces(!First, UnifyContext, !Pieces) :-
UnifyContext = unify_context(MainContext, RevSubContexts),
@@ -522,25 +546,25 @@
unify_main_context_to_pieces(!First, MainContext, !Pieces),
unify_sub_contexts_to_pieces(!First, SubContexts, !Pieces).
-:- pred unify_main_context_to_pieces(bool::in, bool::out,
+:- pred unify_main_context_to_pieces(is_first::in, is_first::out,
unify_main_context::in,
list(format_component)::in, list(format_component)::out) is det.
unify_main_context_to_pieces(!First, umc_explicit, !Pieces).
unify_main_context_to_pieces(!First, umc_head(ArgNum), !Pieces) :-
start_in_message_to_pieces(!.First, !Pieces),
- !:First = no,
+ !:First = is_not_first,
ArgNumStr = int_to_string(ArgNum),
!:Pieces = !.Pieces ++
[words("argument"), fixed(ArgNumStr), words("of clause head:"), nl].
unify_main_context_to_pieces(!First, umc_head_result, !Pieces) :-
start_in_message_to_pieces(!.First, !Pieces),
- !:First = no,
+ !:First = is_not_first,
!:Pieces = !.Pieces ++ [words("function result term of clause head:"), nl].
unify_main_context_to_pieces(!First, umc_call(CallId, ArgNum),
!Pieces) :-
start_in_message_to_pieces(!.First, !Pieces),
- !:First = no,
+ !:First = is_not_first,
% The markers argument below is used only for type class method
% implementations defined using the named syntax rather than
% the clause syntax, and the bodies of such procedures should
@@ -556,7 +580,7 @@
string.format("implicit %s unification:\n", [s(Source)], Msg),
!:Pieces = !.Pieces ++ [words(Msg), nl].
-:- pred unify_sub_contexts_to_pieces(bool::in, bool::out,
+:- pred unify_sub_contexts_to_pieces(is_first::in, is_first::out,
unify_sub_contexts::in,
list(format_component)::in, list(format_component)::out) is det.
@@ -567,11 +591,11 @@
0, ElementNum, AfterContexts)
->
in_element_to_pieces(!.First, ElementNum, !Pieces),
- !:First = no,
+ !:First = is_not_first,
unify_sub_contexts_to_pieces(!First, AfterContexts, !Pieces)
;
in_argument_to_pieces(!.First, SubContext, !Pieces),
- !:First = no,
+ !:First = is_not_first,
unify_sub_contexts_to_pieces(!First, SubContexts, !Pieces)
).
@@ -598,7 +622,7 @@
NumElementsBefore + 1, ElementNum, AfterContexts)
).
-:- pred in_argument_to_pieces(bool::in, pair(cons_id, int)::in,
+:- pred in_argument_to_pieces(is_first::in, pair(cons_id, int)::in,
list(format_component)::in, list(format_component)::out) is det.
in_argument_to_pieces(First, SubContext, !Pieces) :-
@@ -609,7 +633,7 @@
words("of functor"),
prefix("`"), fixed(cons_id_to_string(ConsId)), suffix("':"), nl].
-:- pred in_element_to_pieces(bool::in, int::in,
+:- pred in_element_to_pieces(is_first::in, int::in,
list(format_component)::in, list(format_component)::out) is det.
in_element_to_pieces(First, ElementNum, !Pieces) :-
@@ -618,17 +642,17 @@
!:Pieces = !.Pieces ++ [words("list element"),
prefix("#"), fixed(ElementNumStr), suffix(":"), nl].
-:- pred start_in_message_to_pieces(bool::in,
+:- pred start_in_message_to_pieces(is_first::in,
list(format_component)::in, list(format_component)::out) is det.
start_in_message_to_pieces(First, !Pieces) :-
(
- First = yes,
+ First = is_first,
% It is possible for First to be yes and !.Pieces to be nonempty,
% since !.Pieces may contain stuff from before the unify context.
!:Pieces = !.Pieces ++ [words("In")]
;
- First = no,
+ First = is_not_first,
!:Pieces = !.Pieces ++ [words("in")]
).
@@ -2383,6 +2407,9 @@
io.write_string(" := ", !IO),
write_functor_and_submodes(ConsId, ArgVars, ArgModes, ModuleInfo,
ProgVarSet, InstVarSet, AppendVarNums, Indent, !IO),
+
+ globals.io_lookup_string_option(dump_hlds_options, Verbose, !IO),
+ ( string.contains_char(Verbose, 'u') ->
(
Uniqueness = cell_is_unique,
write_indent(Indent, !IO),
@@ -2443,6 +2470,9 @@
io.write_string("% construct in region: ", !IO),
mercury_output_var(ProgVarSet, AppendVarNums, RegVar, !IO),
io.write_string("\n", !IO)
+ )
+ ;
+ true
).
write_unification(deconstruct(Var, ConsId, ArgVars, ArgModes, CanFail, CanCGC),
@@ -2903,13 +2933,14 @@
:- pred write_case(case::in, prog_var::in, module_info::in, prog_varset::in,
bool::in, int::in, maybe_vartypes::in, io::di, io::uo) is det.
-write_case(case(ConsId, Goal), Var, ModuleInfo, VarSet, AppendVarNums, Indent,
- VarTypes, !IO) :-
+write_case(case(MainConsId, OtherConsIds, Goal), Var, ModuleInfo,
+ VarSet, AppendVarNums, Indent, VarTypes, !IO) :-
write_indent(Indent, !IO),
io.write_string("% ", !IO),
mercury_output_var(VarSet, AppendVarNums, Var, !IO),
io.write_string(" has functor ", !IO),
- write_cons_id(ConsId, !IO),
+ write_cons_id(MainConsId, !IO),
+ list.foldl(write_alternative_cons_id, OtherConsIds, !IO),
io.write_string("\n", !IO),
% XXX if the output of this is to be used, e.g. in
% inter-module optimization, output a unification to bind the
@@ -2919,6 +2950,12 @@
write_goal_a(Goal, ModuleInfo, VarSet, AppendVarNums, Indent, "\n",
VarTypes, !IO).
+:- pred write_alternative_cons_id(cons_id::in, io::di, io::uo) is det.
+
+write_alternative_cons_id(ConsId, !IO) :-
+ io.write_string(" or ", !IO),
+ write_cons_id(ConsId, !IO).
+
:- pred write_cases(list(case)::in, prog_var::in, module_info::in,
prog_varset::in, bool::in, int::in, maybe_vartypes::in, io::di, io::uo)
is det.
@@ -3318,10 +3355,26 @@
:- pred write_type_body(int::in, tvarset::in, hlds_type_body::in,
io::di, io::uo) is det.
-write_type_body(Indent, TVarSet, hlds_du_type(Ctors, Tags, EnumDummy,
- MaybeUserEqComp, ReservedTag, ReservedAddr, Foreign), !IO) :-
+write_type_body(Indent, TVarSet, DuType, !IO) :-
+ DuType = hlds_du_type(Ctors, ConsTagMap, CheaperTagTest, EnumDummy,
+ MaybeUserEqComp, ReservedTag, ReservedAddr, Foreign),
io.write_string(" --->\n", !IO),
(
+ CheaperTagTest = no_cheaper_tag_test
+ ;
+ CheaperTagTest = cheaper_tag_test(ExpConsId, ExpConsTag,
+ CheapConsId, CheapConsTag),
+ io.write_string("/* cheaper tag test: ", !IO),
+ write_cons_id(ExpConsId, !IO),
+ io.write_string(" tag ", !IO),
+ io.print(ExpConsTag, !IO),
+ io.write_string(" -> ", !IO),
+ write_cons_id(CheapConsId, !IO),
+ io.write_string(" tag ", !IO),
+ io.print(CheapConsTag, !IO),
+ io.write_string(" */\n", !IO)
+ ),
+ (
EnumDummy = is_mercury_enum,
write_indent(Indent, !IO),
io.write_string("/* enumeration */\n", !IO)
@@ -3352,7 +3405,7 @@
;
ReservedAddr = does_not_use_reserved_address
),
- write_constructors(Indent, TVarSet, Ctors, Tags, !IO),
+ write_constructors(Indent, TVarSet, Ctors, ConsTagMap, !IO),
mercury_output_where_attributes(TVarSet, no, MaybeUserEqComp, !IO),
(
Foreign = yes(_),
@@ -4549,6 +4602,23 @@
IsConditional = unconditional_reuse,
io.write_string("always safe", !IO)
).
+
+%-----------------------------------------------------------------------------%
+
+project_cons_name_and_tag(TaggedConsId, ConsName, ConsTag) :-
+ TaggedConsId = tagged_cons_id(ConsId, ConsTag),
+ ConsName = hlds_out.cons_id_to_string(ConsId).
+
+case_comment(VarName, MainConsName, OtherConsNames) = Comment :-
+ (
+ OtherConsNames = [],
+ Comment = VarName ++ " has the functor " ++ MainConsName
+ ;
+ OtherConsNames = [_ | _],
+ Comment = VarName ++ " has one of the functors " ++
+ string.join_list(", ", [MainConsName | OtherConsNames])
+ ).
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/implicit_parallelism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implicit_parallelism.m,v
retrieving revision 1.5
diff -u -b -r1.5 implicit_parallelism.m
--- compiler/implicit_parallelism.m 23 Nov 2007 07:35:07 -0000 1.5
+++ compiler/implicit_parallelism.m 23 Nov 2007 09:15:44 -0000
@@ -836,10 +836,11 @@
!ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
process_switch_cases_for_implicit_parallelism([Case0 | Cases], !CasesAcc,
ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
!ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized, !SiteNumCounter),
- !:CasesAcc = !.CasesAcc ++ [case(Functor, Goal)],
+ Case = case(MainConsId, OtherConsIds, Goal),
+ !:CasesAcc = !.CasesAcc ++ [Case],
process_switch_cases_for_implicit_parallelism(Cases, !CasesAcc,
ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.157
diff -u -b -r1.157 inlining.m
--- compiler/inlining.m 8 Aug 2007 05:08:39 -0000 1.157
+++ compiler/inlining.m 23 Nov 2007 09:15:08 -0000
@@ -835,10 +835,11 @@
inline_info::in, inline_info::out) is det.
inlining_in_cases([], [], !Info).
-inlining_in_cases([case(Cons, Goal0) | Goals0], [case(Cons, Goal) | Goals],
- !Info) :-
+inlining_in_cases([Case0 | Cases0], [Case | Cases], !Info) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
inlining_in_goal(Goal0, Goal, !Info),
- inlining_in_cases(Goals0, Goals, !Info).
+ Case = case(MainConsId, OtherConsIds, Goal),
+ inlining_in_cases(Cases0, Cases, !Info).
%-----------------------------------------------------------------------------%
Index: compiler/inst_check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_check.m,v
retrieving revision 1.7
diff -u -b -r1.7 inst_check.m
--- compiler/inst_check.m 25 Sep 2007 04:56:39 -0000 1.7
+++ compiler/inst_check.m 25 Nov 2007 11:47:21 -0000
@@ -291,7 +291,7 @@
get_du_functors_for_type_def(TypeDef) = Functors :-
get_type_defn_body(TypeDef, TypeDefBody),
(
- TypeDefBody = hlds_du_type(Constructors, _, _, _, _, _, _),
+ TypeDefBody = hlds_du_type(Constructors, _, _, _, _, _, _, _),
Functors = list.map(constructor_to_sym_name_and_arity, Constructors)
;
( TypeDefBody = hlds_eqv_type(_)
Index: compiler/inst_match.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_match.m,v
retrieving revision 1.82
diff -u -b -r1.82 inst_match.m
--- compiler/inst_match.m 20 Nov 2007 22:14:11 -0000 1.82
+++ compiler/inst_match.m 13 Dec 2007 12:54:35 -0000
@@ -2018,16 +2018,12 @@
maybe_any_to_bound(yes(Type), ModuleInfo, Uniq, Inst) :-
\+ type_util.is_solver_type(ModuleInfo, Type),
- (
- type_constructors(Type, ModuleInfo, Constructors)
- ->
+ ( type_constructors(ModuleInfo, Type, Constructors) ->
constructors_to_bound_any_insts(ModuleInfo, Uniq,
Constructors, BoundInsts0),
list.sort_and_remove_dups(BoundInsts0, BoundInsts),
Inst = bound(Uniq, BoundInsts)
- ;
- type_may_contain_solver_type(Type, ModuleInfo)
- ->
+ ; type_may_contain_solver_type(ModuleInfo, Type) ->
% For a type for which constructors are not available (e.g. an
% abstract type) and which may contain solver types, we fail, meaning
% that we will use `any' for this type.
@@ -2036,9 +2032,9 @@
Inst = ground(Uniq, none)
).
-:- pred type_may_contain_solver_type(mer_type::in, module_info::in) is semidet.
+:- pred type_may_contain_solver_type(module_info::in, mer_type::in) is semidet.
-type_may_contain_solver_type(Type, ModuleInfo) :-
+type_may_contain_solver_type(ModuleInfo, Type) :-
type_may_contain_solver_type_2(classify_type(ModuleInfo, Type)) = yes.
:- func type_may_contain_solver_type_2(type_category) = bool.
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.54
diff -u -b -r1.54 inst_util.m
--- compiler/inst_util.m 19 Jan 2007 07:04:16 -0000 1.54
+++ compiler/inst_util.m 13 Dec 2007 12:51:52 -0000
@@ -1625,7 +1625,7 @@
% just "any".
(
MaybeType = yes(Type),
- type_constructors(Type, !.ModuleInfo, Constructors),
+ type_constructors(!.ModuleInfo, Type, Constructors),
constructors_to_bound_insts(!.ModuleInfo, UniqB, Constructors,
ListB0),
list.sort_and_remove_dups(ListB0, ListB),
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.60
diff -u -b -r1.60 instmap.m
--- compiler/instmap.m 28 Sep 2007 03:17:12 -0000 1.60
+++ compiler/instmap.m 13 Dec 2007 05:28:26 -0000
@@ -149,8 +149,7 @@
% Set an entry in an instmap.
%
-:- pred set(prog_var::in, mer_inst::in, instmap::in, instmap::out)
- is det.
+:- pred set(prog_var::in, mer_inst::in, instmap::in, instmap::out) is det.
% Set multiple entries in an instmap.
%
@@ -167,9 +166,18 @@
cons_id::in, instmap::in, instmap_delta::in, instmap_delta::out,
module_info::in, module_info::out) is det.
+:- pred instmap_delta_bind_var_to_functors(prog_var::in, mer_type::in,
+ cons_id::in, list(cons_id)::in, instmap::in,
+ instmap_delta::in, instmap_delta::out,
+ module_info::in, module_info::out) is det.
+
:- pred bind_var_to_functor(prog_var::in, mer_type::in, cons_id::in,
instmap::in, instmap::out, module_info::in, module_info::out) is det.
+:- pred bind_var_to_functors(prog_var::in, mer_type::in,
+ cons_id::in, list(cons_id)::in, instmap::in, instmap::out,
+ module_info::in, module_info::out) is det.
+
% Update the given instmap to include the initial insts of the
% lambda variables.
%
@@ -538,7 +546,7 @@
;
!.InstmapDelta = reachable(InstmappingDelta0),
- % Get the initial inst from the InstMap
+ % Get the initial inst from the InstMap.
lookup_var(InstMap, Var, OldInst),
% Compute the new inst by taking the old inst, applying the instmap
@@ -558,11 +566,46 @@
)
).
+instmap_delta_bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
+ InstMap, !InstmapDelta, !ModuleInfo) :-
+ (
+ !.InstmapDelta = unreachable
+ ;
+ !.InstmapDelta = reachable(InstmappingDelta0),
+
+ % Get the initial inst from the InstMap.
+ lookup_var(InstMap, Var, OldInst),
+
+ % Compute the new inst by taking the old inst, applying the instmap
+ % delta to it, and then unifying with bound(MainConsId, ...).
+ ( map.search(InstmappingDelta0, Var, NewInst0) ->
+ NewInst1 = NewInst0
+ ;
+ NewInst1 = OldInst
+ ),
+ bind_inst_to_functors(Type, MainConsId, OtherConsIds,
+ NewInst1, NewInst, !ModuleInfo),
+
+ % Add `Var :: OldInst -> NewInst' to the instmap delta.
+ ( NewInst \= OldInst ->
+ instmap_delta_set(Var, NewInst, !InstmapDelta)
+ ;
+ true
+ )
+ ).
+
bind_var_to_functor(Var, Type, ConsId, !InstMap, !ModuleInfo) :-
lookup_var(!.InstMap, Var, Inst0),
bind_inst_to_functor(Type, ConsId, Inst0, Inst, !ModuleInfo),
set(Var, Inst, !InstMap).
+bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
+ !InstMap, !ModuleInfo) :-
+ lookup_var(!.InstMap, Var, Inst0),
+ bind_inst_to_functors(Type, MainConsId, OtherConsIds, Inst0, Inst,
+ !ModuleInfo),
+ set(Var, Inst, !InstMap).
+
:- pred bind_inst_to_functor(mer_type::in, cons_id::in,
mer_inst::in, mer_inst::out, module_info::in, module_info::out) is det.
@@ -579,6 +622,41 @@
unexpected(this_file, "bind_inst_to_functor: mode error")
).
+:- pred bind_inst_to_functors(mer_type::in, cons_id::in, list(cons_id)::in,
+ mer_inst::in, mer_inst::out, module_info::in, module_info::out) is det.
+
+bind_inst_to_functors(Type, MainConsId, OtherConsIds, InitInst, FinalInst,
+ !ModuleInfo) :-
+ bind_inst_to_functor(Type, MainConsId, InitInst,
+ MainFinalInst, !ModuleInfo),
+ bind_inst_to_functors_others(Type, OtherConsIds, InitInst,
+ OtherFinalInsts, !ModuleInfo),
+ merge_var_insts([MainFinalInst | OtherFinalInsts], Type, !ModuleInfo,
+ MaybeMergedInst),
+ (
+ MaybeMergedInst = yes(FinalInst)
+ ;
+ MaybeMergedInst = no,
+ % bind_inst_to_functors should be called only when multi-cons-id
+ % switches are being or have been introduced into the HLDS, which
+ % should come only after mode checking has been done without finding
+ % any errors. Finding an error now would mean that some compiler pass
+ % executed between mode checking and how has screwed up.
+ unexpected(this_file,
+ "bind_inst_to_functors: no MaybeMergedInst")
+ ).
+
+:- pred bind_inst_to_functors_others(mer_type::in, list(cons_id)::in,
+ mer_inst::in, list(mer_inst)::out, module_info::in, module_info::out)
+ is det.
+
+bind_inst_to_functors_others(_Type, [], _InitInst, [], !ModuleInfo).
+bind_inst_to_functors_others(Type, [ConsId | ConsIds], InitInst,
+ [FinalInst | FinalInsts], !ModuleInfo) :-
+ bind_inst_to_functor(Type, ConsId, InitInst, FinalInst, !ModuleInfo),
+ bind_inst_to_functors_others(Type, ConsIds, InitInst, FinalInsts,
+ !ModuleInfo).
+
%-----------------------------------------------------------------------------%
pre_lambda_update(ModuleInfo, Vars, Modes, InstMap0, InstMap) :-
@@ -662,7 +740,7 @@
->
set.to_sorted_list(NonLocals, NonLocalsList),
mode_info_get_var_types(!.ModeInfo, VarTypes),
- merge_2(NonLocalsList, InstMapList, VarTypes,
+ merge_insts_of_vars(NonLocalsList, InstMapList, VarTypes,
InstMapping0, InstMapping, ModuleInfo0, ModuleInfo, ErrorList),
mode_info_set_module_info(ModuleInfo, !ModeInfo),
(
@@ -696,8 +774,8 @@
%-----------------------------------------------------------------------------%
- % merge_2(Vars, InstMapList, VarTypes, !InstMapping, !ModuleInfo,
- % Errors):
+ % merge_insts_of_vars(Vars, InstMapList, VarTypes, !InstMapping,
+ % !ModuleInfo, Errors):
%
% Given Vars, a list of variables, and InstMapList, a list of instmaps
% giving the insts of those variables (and possibly others) at the ends of
@@ -713,18 +791,18 @@
% If some variables in Vars have incompatible insts in two or more instmaps
% in InstMapList, return them in `Errors'.
%
-:- pred merge_2(list(prog_var)::in, list(instmap)::in, vartypes::in,
- instmapping::in, instmapping::out, module_info::in, module_info::out,
- merge_errors::out) is det.
+:- pred merge_insts_of_vars(list(prog_var)::in, list(instmap)::in,
+ vartypes::in, instmapping::in, instmapping::out,
+ module_info::in, module_info::out, merge_errors::out) is det.
-merge_2([], _, _, !InstMap, !ModuleInfo, []).
-merge_2([Var | Vars], InstMapList, VarTypes, !InstMapping,
+merge_insts_of_vars([], _, _, !InstMap, !ModuleInfo, []).
+merge_insts_of_vars([Var | Vars], InstMapList, VarTypes, !InstMapping,
!ModuleInfo, !:ErrorList) :-
- merge_2(Vars, InstMapList, VarTypes, !InstMapping, !ModuleInfo,
- !:ErrorList),
+ merge_insts_of_vars(Vars, InstMapList, VarTypes, !InstMapping,
+ !ModuleInfo, !:ErrorList),
map.lookup(VarTypes, Var, VarType),
list.map(lookup_var_in_instmap(Var), InstMapList, InstList),
- merge_var(InstList, Var, VarType, !ModuleInfo, MaybeInst),
+ merge_var_insts(InstList, VarType, !ModuleInfo, MaybeInst),
(
MaybeInst = no,
!:ErrorList = [merge_error(Var, InstList) | !.ErrorList],
@@ -739,22 +817,21 @@
lookup_var_in_instmap(Var, InstMap, Inst) :-
lookup_var(InstMap, Var, Inst).
- % merge_var(Insts, Var, Type, Inst, !ModuleInfo, !Error):
+ % merge_var_insts:(Insts, Type, !ModuleInfo, MaybeMergedInst):
%
- % Given a list of insts of the given variable that reflect the inst of that
+ % Given a list of insts of a given variable that reflect the inst of that
% variable at the ends of a branched control structure such as a
- % disjunction or if-then-else, return the final inst of that variable
- % after the branched control structure as a whole.
- %
- % Set !:Error to yes if two insts of the variable are incompatible.
+ % disjunction or if-then-else, return either `yes(MergedInst)' where
+ % MergedInst is the final inst of that variable after the branched control
+ % structure as a whole, or `no' if some of the insts are not compatible.
%
% We used to use a straightforward algorithm that, given a list of N insts,
% merged the tail N-1 insts, and merged the result with the head inst.
% While this is simple and efficient for small N, it has very bad
% performance for large N. The reason is that its complexity can be N^2,
% since in many cases each arm of the branched control structure binds
- % Var to a different function symbol, and this means that the inst of Var
- % evolves like this:
+ % the variable to a different function symbol, and this means that the
+ % merged inst evolves like this:
%
% bound(f)
% bound(f; g)
@@ -765,13 +842,13 @@
% number of insts by four by merging groups of four adjacent insts.
% The overall complexity is thus closer to N log N than N^2.
%
-:- pred merge_var(list(mer_inst)::in, prog_var::in, mer_type::in,
+:- pred merge_var_insts(list(mer_inst)::in, mer_type::in,
module_info::in, module_info::out, maybe(mer_inst)::out) is det.
-merge_var(Insts, Var, Type, !ModuleInfo, MaybeMergedInst) :-
- % Construct yes(Type) here once per merge_var pass to avoid merge_var_2
+merge_var_insts(Insts, Type, !ModuleInfo, MaybeMergedInst) :-
+ % Construct yes(Type) here once per merge_var pass to avoid merge_var_inst
% constructing the yes(Type) cell N times per pass.
- merge_var_2(Insts, Var, yes(Type), [], MergedInsts, !ModuleInfo,
+ merge_var_insts_pass(Insts, yes(Type), [], MergedInsts, !ModuleInfo,
no, Error),
(
Error = yes,
@@ -786,15 +863,15 @@
MaybeMergedInst = yes(MergedInst)
;
MergedInsts = [_, _ | _],
- merge_var(MergedInsts, Var, Type, !ModuleInfo, MaybeMergedInst)
+ merge_var_insts(MergedInsts, Type, !ModuleInfo, MaybeMergedInst)
)
).
-:- pred merge_var_2(list(mer_inst)::in, prog_var::in, maybe(mer_type)::in,
+:- pred merge_var_insts_pass(list(mer_inst)::in, maybe(mer_type)::in,
list(mer_inst)::in, list(mer_inst)::out, module_info::in, module_info::out,
bool::in, bool::out) is det.
-merge_var_2(Insts, Var, YesType, !MergedInsts, !ModuleInfo, !Error) :-
+merge_var_insts_pass(Insts, MaybeType, !MergedInsts, !ModuleInfo, !Error) :-
(
Insts = []
;
@@ -803,7 +880,7 @@
;
Insts = [Inst1, Inst2],
(
- inst_merge(Inst1, Inst2, YesType, Inst12, !ModuleInfo)
+ inst_merge(Inst1, Inst2, MaybeType, Inst12, !ModuleInfo)
->
!:MergedInsts = [Inst12 | !.MergedInsts]
;
@@ -812,8 +889,8 @@
;
Insts = [Inst1, Inst2, Inst3],
(
- inst_merge(Inst1, Inst2, YesType, Inst12, !ModuleInfo),
- inst_merge(Inst12, Inst3, YesType, Inst123, !ModuleInfo)
+ inst_merge(Inst1, Inst2, MaybeType, Inst12, !ModuleInfo),
+ inst_merge(Inst12, Inst3, MaybeType, Inst123, !ModuleInfo)
->
!:MergedInsts = [Inst123 | !.MergedInsts]
;
@@ -822,13 +899,13 @@
;
Insts = [Inst1, Inst2, Inst3, Inst4 | MoreInsts],
(
- inst_merge(Inst1, Inst2, YesType, Inst12, !ModuleInfo),
- inst_merge(Inst3, Inst4, YesType, Inst34, !ModuleInfo),
- inst_merge(Inst12, Inst34, YesType, Inst1234, !ModuleInfo)
+ inst_merge(Inst1, Inst2, MaybeType, Inst12, !ModuleInfo),
+ inst_merge(Inst3, Inst4, MaybeType, Inst34, !ModuleInfo),
+ inst_merge(Inst12, Inst34, MaybeType, Inst1234, !ModuleInfo)
->
!:MergedInsts = [Inst1234 | !.MergedInsts],
- merge_var_2(MoreInsts, Var, YesType, !MergedInsts, !ModuleInfo,
- !Error)
+ merge_var_insts_pass(MoreInsts, MaybeType, !MergedInsts,
+ !ModuleInfo, !Error)
;
!:Error = yes
)
@@ -909,11 +986,11 @@
InstMap0 = reachable(InstMapping0)
->
% Having got the first instmapping, to use as an accumulator,
- % all unify_2 which unifies each of the nonlocals from
+ % call unify_insts_of_vars which unifies each of the nonlocals from
% each instmap with the corresponding inst in the accumulator.
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
set.to_sorted_list(NonLocals, NonLocalsList),
- unify_2(NonLocalsList, InstMap0, InstMapList1,
+ unify_insts_of_vars(NonLocalsList, InstMap0, InstMapList1,
ModuleInfo0, ModuleInfo, InstMapping0, InstMapping, ErrorList),
mode_info_set_module_info(ModuleInfo, !ModeInfo),
@@ -935,49 +1012,49 @@
%-----------------------------------------------------------------------------%
- % unify_2(Vars, InitialInstMap, InstMaps, !ModuleInfo,
+ % unify_insts_of_vars(Vars, InitialInstMap, InstMaps, !ModuleInfo,
% !Instmap, ErrorList):
%
% Let `ErrorList' be the list of variables in `Vars' for which there are
% two instmaps in `InstMaps' for which the insts of the variable is
% incompatible.
%
-:- pred unify_2(list(prog_var)::in, instmap::in,
+:- pred unify_insts_of_vars(list(prog_var)::in, instmap::in,
list(pair(instmap, set(prog_var)))::in, module_info::in, module_info::out,
map(prog_var, mer_inst)::in, map(prog_var, mer_inst)::out,
merge_errors::out) is det.
-unify_2([], _, _, !ModuleInfo, !InstMap, []).
-unify_2([Var|Vars], InitialInstMap, InstMapList,
+unify_insts_of_vars([], _, _, !ModuleInfo, !InstMap, []).
+unify_insts_of_vars([Var | Vars], InitialInstMap, InstMapList,
!ModuleInfo, !InstMap, ErrorList) :-
- unify_2(Vars, InitialInstMap, InstMapList, !ModuleInfo, !InstMap,
- ErrorListTail),
+ unify_insts_of_vars(Vars, InitialInstMap, InstMapList, !ModuleInfo,
+ !InstMap, ErrorListTail),
lookup_var(InitialInstMap, Var, InitialVarInst),
- unify_var(InstMapList, Var, [], Insts, InitialVarInst, Inst,
+ unify_var_insts(InstMapList, Var, [], Insts, InitialVarInst, Inst,
!ModuleInfo, no, Error),
(
Error = yes,
- ErrorList = [ merge_error(Var, Insts) | ErrorListTail]
+ ErrorList = [merge_error(Var, Insts) | ErrorListTail]
;
Error = no,
ErrorList = ErrorListTail
),
map.set(!.InstMap, Var, Inst, !:InstMap).
- % unify_var(InstMaps, Var, InitialInstMap, ModuleInfo,
+ % unify_var_insts(InstMaps, Var, InitialInstMap, ModuleInfo,
% Insts, Error):
%
% Let `Insts' be the list of the inst of `Var' in each of the
% corresponding `InstMaps'. Let `Error' be yes iff there are two
% instmaps for which the inst of `Var' is incompatible.
%
-:- pred unify_var(list(pair(instmap, set(prog_var)))::in,
+:- pred unify_var_insts(list(pair(instmap, set(prog_var)))::in,
prog_var::in, list(mer_inst)::in, list(mer_inst)::out,
mer_inst::in, mer_inst::out, module_info::in, module_info::out,
bool::in, bool::out) is det.
-unify_var([], _, !Insts, !Inst, !ModuleInfo, !Error).
-unify_var([InstMap - Nonlocals| Rest], Var, !InstList, !Inst,
+unify_var_insts([], _, !Insts, !Inst, !ModuleInfo, !Error).
+unify_var_insts([InstMap - Nonlocals| Rest], Var, !InstList, !Inst,
!ModuleInfo, !Error) :-
( set.member(Var, Nonlocals) ->
lookup_var(InstMap, Var, VarInst),
@@ -997,7 +1074,7 @@
VarInst = free
),
!:InstList = [VarInst | !.InstList],
- unify_var(Rest, Var, !InstList, !Inst, !ModuleInfo, !Error).
+ unify_var_insts(Rest, Var, !InstList, !Inst, !ModuleInfo, !Error).
%-----------------------------------------------------------------------------%
@@ -1019,7 +1096,7 @@
( InstA = InstB ->
AssocList1 = AssocList
;
- AssocList = [ Var - InstB | AssocList1 ]
+ AssocList = [Var - InstB | AssocList1]
),
compute_instmap_delta_2(Vars, InstMapA, InstMapB, AssocList1).
@@ -1035,8 +1112,7 @@
instmapping::in, vartypes::in, module_info::in) is semidet.
no_output_vars_2([], _, _, _, _).
-no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, VarTypes,
- ModuleInfo) :-
+no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, VarTypes, ModuleInfo) :-
% We use `inst_matches_binding' to check that the new inst has only
% added information or lost uniqueness, not bound anything.
% If the instmap delta contains the variable, the variable may still
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.225
diff -u -b -r1.225 intermod.m
--- compiler/intermod.m 23 Nov 2007 07:35:07 -0000 1.225
+++ compiler/intermod.m 25 Nov 2007 12:05:16 -0000
@@ -527,7 +527,8 @@
bool::out, intermod_info::in, intermod_info::out) is det.
intermod_traverse_list_of_goals([], [], yes, !Info).
-intermod_traverse_list_of_goals([Goal0 | Goals0], [Goal | Goals], !:DoWrite, !Info) :-
+intermod_traverse_list_of_goals([Goal0 | Goals0], [Goal | Goals], !:DoWrite,
+ !Info) :-
intermod_traverse_goal(Goal0, Goal, !:DoWrite, !Info),
(
!.DoWrite = yes,
@@ -541,9 +542,10 @@
intermod_info::in, intermod_info::out) is det.
intermod_traverse_cases([], [], yes, !Info).
-intermod_traverse_cases([case(F, Goal0) | Cases0],
- [case(F, Goal) | Cases], !:DoWrite, !Info) :-
+intermod_traverse_cases([Case0 | Cases0], [Case | Cases], !:DoWrite, !Info) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
intermod_traverse_goal(Goal0, Goal, !:DoWrite, !Info),
+ Case = case(MainConsId, OtherConsIds, Goal),
(
!.DoWrite = yes,
intermod_traverse_cases(Cases0, Cases, !:DoWrite, !Info)
@@ -973,8 +975,8 @@
( should_write_type(ModuleName, TypeCtor, TypeDefn0) ->
hlds_data.get_type_defn_body(TypeDefn0, TypeBody0),
(
- TypeBody0 = hlds_du_type(Ctors, Tags, Enum, MaybeUserEqComp0,
- ReservedTag, ReservedAddr, MaybeForeign0),
+ TypeBody0 = hlds_du_type(Ctors, Tags, CheaperTagTest, Enum,
+ MaybeUserEqComp0, ReservedTag, ReservedAddr, MaybeForeign0),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
@@ -1004,8 +1006,8 @@
MaybeUserEqComp0, MaybeUserEqComp, !Info),
MaybeForeign = MaybeForeign0
),
- TypeBody = hlds_du_type(Ctors, Tags, Enum, MaybeUserEqComp,
- ReservedTag, ReservedAddr, MaybeForeign),
+ TypeBody = hlds_du_type(Ctors, Tags, CheaperTagTest, Enum,
+ MaybeUserEqComp, ReservedTag, ReservedAddr, MaybeForeign),
hlds_data.set_type_defn_body(TypeBody, TypeDefn0, TypeDefn)
;
TypeBody0 = hlds_foreign_type(ForeignTypeBody0),
@@ -1270,7 +1272,7 @@
hlds_data.get_type_defn_context(TypeDefn, Context),
TypeCtor = type_ctor(Name, Arity),
(
- Body = hlds_du_type(Ctors, _, _, MaybeUserEqComp, _, _, _),
+ Body = hlds_du_type(Ctors, _, _, _, MaybeUserEqComp, _, _, _),
TypeBody = parse_tree_du_type(Ctors, MaybeUserEqComp)
;
Body = hlds_eqv_type(EqvType),
@@ -1361,7 +1363,7 @@
true
),
(
- Body = hlds_du_type(_, ConsTagVals, EnumOrDummy, _, _, _, _),
+ Body = hlds_du_type(_, ConsTagVals, _, EnumOrDummy, _, _, _, _),
EnumOrDummy = is_foreign_enum(Lang)
->
map.foldl(gather_foreign_enum_value_pair, ConsTagVals, [],
Index: compiler/interval.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/interval.m,v
retrieving revision 1.35
diff -u -b -r1.35 interval.m
--- compiler/interval.m 23 Nov 2007 07:35:07 -0000 1.35
+++ compiler/interval.m 23 Nov 2007 15:51:34 -0000
@@ -514,9 +514,10 @@
T::in, T::out) is det <= build_interval_info_acc(T).
build_interval_info_in_cases([], _, _, _, _, [], !IntervalInfo, !Acc).
-build_interval_info_in_cases([case(_Var, Goal) | Cases],
+build_interval_info_in_cases([Case | Cases],
StartAnchor, EndAnchor, BeforeId, AfterId,
[OpenIntervals | OpenIntervalsList], !IntervalInfo, !Acc) :-
+ Case = case(_MainConsId, _OtherConsIds, Goal),
enter_branch_tail(EndAnchor, AfterId, !IntervalInfo),
build_interval_info_in_goal(Goal, !IntervalInfo, !Acc),
reached_branch_start(doesnt_need_flush, StartAnchor, BeforeId,
@@ -1180,11 +1181,12 @@
maybe(goal_feature)::in) is det.
record_decisions_in_cases([], [], !VarInfo, _, _, _).
-record_decisions_in_cases([case(Var, Goal0) | Cases0],
- [case(Var, Goal) | Cases], !VarInfo, VarRename0, InsertMap,
- MaybeFeature) :-
+record_decisions_in_cases([Case0 | Cases0], [Case | Cases],
+ !VarInfo, VarRename0, InsertMap, MaybeFeature) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
record_decisions_in_goal(Goal0, Goal, !VarInfo, VarRename0, _,
InsertMap, MaybeFeature),
+ Case = case(MainConsId, OtherConsIds, Goal),
record_decisions_in_cases(Cases0, Cases, !VarInfo, VarRename0,
InsertMap, MaybeFeature).
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.108
diff -u -b -r1.108 jumpopt.m
--- compiler/jumpopt.m 19 Nov 2007 06:36:24 -0000 1.108
+++ compiler/jumpopt.m 14 Dec 2007 05:14:39 -0000
@@ -512,14 +512,14 @@
NewRemain = usual_case
)
;
- Uinstr0 = computed_goto(Index, LabelList0),
+ Uinstr0 = computed_goto(Index, Targets0),
% Short-circuit all the destination labels.
- short_labels(Instrmap, LabelList0, LabelList),
- ( LabelList = LabelList0 ->
+ short_maybe_labels(Instrmap, Targets0, Targets),
+ ( Targets = Targets0 ->
NewRemain = usual_case
;
Shorted = Comment0 ++ " (some shortcircuits)",
- NewInstrs = [llds_instr(computed_goto(Index, LabelList), Shorted)],
+ NewInstrs = [llds_instr(computed_goto(Index, Targets), Shorted)],
NewRemain = specified(NewInstrs, Instrs0)
)
;
@@ -968,12 +968,21 @@
Label = Label0
).
-:- pred short_labels(instrmap::in, list(label)::in, list(label)::out) is det.
+:- pred short_maybe_labels(instrmap::in,
+ list(maybe(label))::in, list(maybe(label))::out) is det.
-short_labels(_Instrmap, [], []).
-short_labels(Instrmap, [Label0 | Labels0], [Label | Labels]) :-
+short_maybe_labels(_Instrmap, [], []).
+short_maybe_labels(Instrmap, [MaybeLabel0 | MaybeLabels0],
+ [MaybeLabel | MaybeLabels]) :-
+ (
+ MaybeLabel0 = yes(Label0),
short_label(Instrmap, Label0, Label),
- short_labels(Instrmap, Labels0, Labels).
+ MaybeLabel = yes(Label)
+ ;
+ MaybeLabel0 = no,
+ MaybeLabel = no
+ ),
+ short_maybe_labels(Instrmap, MaybeLabels0, MaybeLabels).
%-----------------------------------------------------------------------------%
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.132
diff -u -b -r1.132 lambda.m
--- compiler/lambda.m 23 Nov 2007 07:35:08 -0000 1.132
+++ compiler/lambda.m 23 Nov 2007 09:13:43 -0000
@@ -271,9 +271,10 @@
lambda_info::in, lambda_info::out) is det.
lambda_process_cases([], [], !Info).
-lambda_process_cases([case(ConsId, Goal0) | Cases0],
- [case(ConsId, Goal) | Cases], !Info) :-
+lambda_process_cases([Case0 | Cases0], [Case | Cases], !Info) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
lambda_process_goal(Goal0, Goal, !Info),
+ Case = case(MainConsId, OtherConsIds, Goal),
lambda_process_cases(Cases0, Cases, !Info).
:- pred lambda_process_unify_goal(prog_var::in, unify_rhs::in, unify_mode::in,
Index: compiler/lco.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lco.m,v
retrieving revision 1.48
diff -u -b -r1.48 lco.m
--- compiler/lco.m 23 Nov 2007 07:35:08 -0000 1.48
+++ compiler/lco.m 28 Nov 2007 03:56:54 -0000
@@ -421,9 +421,10 @@
lco_info::in, lco_info::out, lco_const_info::in) is det.
lco_in_cases([], [], !Info, _ConstInfo).
-lco_in_cases([case(Cons, Goal0) | Cases0], [case(Cons, Goal) | Cases],
- !Info, ConstInfo) :-
+lco_in_cases([Case0 | Cases0], [Case | Cases], !Info, ConstInfo) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
lco_in_goal(Goal0, Goal, !Info, ConstInfo),
+ Case = case(MainConsId, OtherConsIds, Goal),
lco_in_cases(Cases0, Cases, !Info, ConstInfo).
%-----------------------------------------------------------------------------%
@@ -468,7 +469,7 @@
),
all_true(acceptable_construct_mode(ModuleInfo), ArgUniModes),
map.lookup(VarTypes, ConstructedVar, ConstructedType),
- ConsTag = cons_id_to_tag(ConsId, ConstructedType, ModuleInfo),
+ ConsTag = cons_id_to_tag(ModuleInfo, ConstructedType, ConsId),
% The code generator can't handle the other tags. For example, it
% doesn't make sense to take the address of the field of a function
% symbol of a `notag' type.
@@ -965,10 +966,12 @@
:- pred transform_variant_case(module_info::in, assoc_list(prog_var)::in,
instmap::in, case::in, case::out, bool::out) is det.
-transform_variant_case(ModuleInfo, VarToAddr, InstMap0,
- case(ConsId, Goal0), case(ConsId, Goal), Changed) :-
+transform_variant_case(ModuleInfo, VarToAddr, InstMap0, Case0, Case,
+ Changed) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
transform_variant_goal(ModuleInfo, VarToAddr, InstMap0, Goal0, Goal,
- Changed).
+ Changed),
+ Case = case(MainConsId, OtherConsIds, Goal).
:- pred transform_variant_atomic_goal(module_info::in,
assoc_list(prog_var)::in, instmap::in, hlds_goal_info::in,
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.133
diff -u -b -r1.133 live_vars.m
--- compiler/live_vars.m 23 Nov 2007 07:35:08 -0000 1.133
+++ compiler/live_vars.m 23 Nov 2007 09:45:19 -0000
@@ -596,13 +596,14 @@
build_live_sets_in_cases([], [], _, _,
!StackAlloc, !Liveness, !NondetLiveness, !ParStackVars).
-build_live_sets_in_cases([case(Cons, Goal0) | Cases0],
- [case(Cons, Goal) | Cases], ResumeVars0, AllocData,
- !StackAlloc, Liveness0, Liveness, NondetLiveness0, NondetLiveness,
- !ParStackVars) :-
+build_live_sets_in_cases([Case0 | Cases0], [Case | Cases],
+ ResumeVars0, AllocData, !StackAlloc,
+ Liveness0, Liveness, NondetLiveness0, NondetLiveness, !ParStackVars) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
build_live_sets_in_goal(Goal0, Goal, ResumeVars0, AllocData,
!StackAlloc, Liveness0, Liveness, NondetLiveness0, NondetLiveness1,
!ParStackVars),
+ Case = case(MainConsId, OtherConsIds, Goal),
build_live_sets_in_cases(Cases0, Cases, ResumeVars0, AllocData,
!StackAlloc, Liveness0, _Liveness2, NondetLiveness0, NondetLiveness2,
!ParStackVars),
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.90
diff -u -b -r1.90 livemap.m
--- compiler/livemap.m 23 Nov 2007 07:35:08 -0000 1.90
+++ compiler/livemap.m 14 Dec 2007 04:50:27 -0000
@@ -206,9 +206,9 @@
MaybeSpecial = no
)
;
- Uinstr0 = computed_goto(Rval, Labels),
+ Uinstr0 = computed_goto(Rval, MaybeLabels),
livemap.make_live_in_rvals([Rval], set.init, !:Livevals),
- list.foldl(livemap_insert_label_livevals(!.Livemap), Labels,
+ list.foldl(livemap_insert_maybe_label_livevals(!.Livemap), MaybeLabels,
!Livevals)
;
Uinstr0 = if_val(Rval, CodeAddr),
@@ -524,6 +524,17 @@
set.init(Livevals1),
livemap_insert_proper_livevals(Livelist, Livevals1, Livevals).
+:- pred livemap_insert_maybe_label_livevals(livemap::in, maybe(label)::in,
+ lvalset::in, lvalset::out) is det.
+
+livemap_insert_maybe_label_livevals(Livemap, MaybeLabel, !Livevals) :-
+ (
+ MaybeLabel = yes(Label),
+ livemap_insert_label_livevals(Livemap, Label, !Livevals)
+ ;
+ MaybeLabel = no
+ ).
+
:- pred livemap_insert_label_livevals(livemap::in, label::in,
lvalset::in, lvalset::out) is det.
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.158
diff -u -b -r1.158 liveness.m
--- compiler/liveness.m 23 Nov 2007 07:35:09 -0000 1.158
+++ compiler/liveness.m 23 Nov 2007 16:16:27 -0000
@@ -536,15 +536,17 @@
set(prog_var)::in, set(prog_var)::out) is det.
detect_liveness_in_cases([], [], _Liveness, _NonLocals, _LiveInfo, !Union).
-detect_liveness_in_cases([case(Cons, Goal0) | Goals0],
- [case(Cons, Goal) | Goals], Liveness0, NonLocals, LiveInfo, !Union) :-
+detect_liveness_in_cases([Case0 | Cases0], [Case | Cases], Liveness0,
+ NonLocals, LiveInfo, !Union) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
detect_liveness_in_goal(Goal0, Goal1, Liveness0, Liveness1, LiveInfo),
set.union(Liveness1, !Union),
- detect_liveness_in_cases(Goals0, Goals, Liveness0, NonLocals, LiveInfo,
+ detect_liveness_in_cases(Cases0, Cases, Liveness0, NonLocals, LiveInfo,
!Union),
set.intersect(!.Union, NonLocals, NonLocalUnion),
set.difference(NonLocalUnion, Liveness1, Residue),
- add_liveness_after_goal(Goal1, Residue, Goal).
+ add_liveness_after_goal(Goal1, Residue, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
@@ -785,9 +787,10 @@
% it must be put in the pre-death set of that case.
set.insert(!.Union, SwitchVar, !:Union),
set.intersect(!.Union, CompletedNonLocals, CompletedNonLocalUnion).
-detect_deadness_in_cases(SwitchVar, [case(Cons, Goal0) | Goals0],
- [case(Cons, Goal) | Goals], Deadness0, Liveness0,
- CompletedNonLocals, LiveInfo, !Union, CompletedNonLocalUnion) :-
+detect_deadness_in_cases(SwitchVar, [Case0 | Cases0], [Case | Cases],
+ Deadness0, Liveness0, CompletedNonLocals, LiveInfo, !Union,
+ CompletedNonLocalUnion) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
detect_deadness_in_goal(Goal0, Goal1, Deadness0, DeadnessGoal,
Liveness0, LiveInfo),
Goal1 = hlds_goal(_, GoalInfo1),
@@ -798,11 +801,12 @@
InstmapReachable = no
),
union_branch_deadness(DeadnessGoal, Deadness0, InstmapReachable, !Union),
- detect_deadness_in_cases(SwitchVar, Goals0, Goals, Deadness0,
+ detect_deadness_in_cases(SwitchVar, Cases0, Cases, Deadness0,
Liveness0, CompletedNonLocals, LiveInfo, !Union,
CompletedNonLocalUnion),
add_branch_pre_deaths(DeadnessGoal, Deadness0, CompletedNonLocalUnion,
- InstmapReachable, Goal1, Goal).
+ InstmapReachable, Goal1, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
@@ -988,7 +992,7 @@
:- pred find_reachable_case(list(case)::in, hlds_goal::out) is semidet.
-find_reachable_case([case(_, Goal) | Cases], ReachableGoal) :-
+find_reachable_case([case(_, _, Goal) | Cases], ReachableGoal) :-
Goal = hlds_goal(_, GoalInfo),
InstmapDelta = goal_info_get_instmap_delta(GoalInfo),
( instmap_delta_is_unreachable(InstmapDelta) ->
@@ -1200,11 +1204,12 @@
maybe(pair(set(prog_var)))::out) is det.
delay_death_cases([], [], _, _, _, no).
-delay_death_cases([case(ConsId, Goal0) | Cases0],
- [case(ConsId, Goal) - DelayedDeadGoal | Cases],
+delay_death_cases([Case0 | Cases0], [Case - DelayedDeadGoal | Cases],
BornVars0, DelayedDead0, VarSet, yes(BornVars - DelayedDead)) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
delay_death_goal(Goal0, Goal, BornVars0, BornVarsGoal,
DelayedDead0, DelayedDeadGoal, VarSet),
+ Case = case(MainConsId, OtherConsIds, Goal),
delay_death_cases(Cases0, Cases, BornVars0, DelayedDead0, VarSet,
MaybeBornVarsDelayedDead),
(
@@ -1235,14 +1240,15 @@
:- func kill_excess_delayed_dead_case(set(prog_var),
pair(case, set(prog_var))) = case.
-kill_excess_delayed_dead_case(FinalDelayedDead,
- case(ConsId, Goal0) - DelayedDead0) = case(ConsId, Goal) :-
+kill_excess_delayed_dead_case(FinalDelayedDead, Case0 - DelayedDead0) = Case :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
set.difference(DelayedDead0, FinalDelayedDead, ToBeKilled),
Goal0 = hlds_goal(GoalExpr, GoalInfo0),
goal_info_get_post_deaths(GoalInfo0, PostDeath0),
set.union(PostDeath0, ToBeKilled, PostDeath),
goal_info_set_post_deaths(PostDeath, GoalInfo0, GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo).
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1549,11 +1555,12 @@
live_info::in, set(prog_var)::in) is det.
detect_resume_points_in_cases([], [], !Liveness, _, _).
-detect_resume_points_in_cases([case(ConsId, Goal0) | Cases0],
- [case(ConsId, Goal) | Cases], Liveness0, LivenessFirst,
- LiveInfo, ResumeVars0) :-
+detect_resume_points_in_cases([Case0 | Cases0], [Case | Cases],
+ Liveness0, LivenessFirst, LiveInfo, ResumeVars0) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
detect_resume_points_in_goal(Goal0, Goal, Liveness0, LivenessFirst,
LiveInfo, ResumeVars0),
+ Case = case(MainConsId, OtherConsIds, Goal),
(
Cases0 = [_ | _],
detect_resume_points_in_cases(Cases0, Cases,
Index: compiler/ll_backend.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ll_backend.m,v
retrieving revision 1.20
diff -u -b -r1.20 ll_backend.m
--- compiler/ll_backend.m 27 Feb 2007 20:36:27 -0000 1.20
+++ compiler/ll_backend.m 11 Dec 2007 12:23:26 -0000
@@ -46,6 +46,7 @@
:- include_module lookup_switch.
:- include_module string_switch.
:- include_module tag_switch.
+ :- include_module switch_case.
:- include_module pragma_c_gen.
:- include_module par_conj_gen.
:- include_module middle_rec.
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.354
diff -u -b -r1.354 llds.m
--- compiler/llds.m 11 Oct 2007 11:45:18 -0000 1.354
+++ compiler/llds.m 14 Dec 2007 07:48:52 -0000
@@ -302,10 +302,11 @@
% do_redo, etc., can get optimized into the invocations of macros
% fail(), redo(), etc..
- ; computed_goto(rval, list(label))
+ ; computed_goto(rval, list(maybe(label)))
% Evaluate rval, which should be an integer, and jump to the
% (rval+1)th label in the list. e.g. computed_goto(2, [A, B, C, D])
- % will branch to label C.
+ % will branch to label C. A label that isn't there implicitly means
+ % "not reached".
; arbitrary_c_code(proc_affects_liveness, c_code_live_lvals, string)
% Do whatever is specified by the string, which can be any piece
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.319
diff -u -b -r1.319 llds_out.m
--- compiler/llds_out.m 23 Nov 2007 07:35:09 -0000 1.319
+++ compiler/llds_out.m 14 Dec 2007 05:27:20 -0000
@@ -2398,7 +2398,7 @@
io.write_string("\tMR_COMPUTED_GOTO(", !IO),
output_rval_as_type(Rval, unsigned, !IO),
io.write_string(",\n\t\t", !IO),
- output_label_list(Labels, !IO),
+ output_label_list_or_not_reached(Labels, !IO),
io.write_string(");\n", !IO).
output_instruction(if_val(Rval, Target), ProfInfo, !IO) :-
@@ -4576,24 +4576,35 @@
Str = "MR_LABEL_AP(" ++ LabelStr ++ ")"
).
-:- pred output_label_list(list(label)::in, io::di, io::uo) is det.
+:- pred output_label_list_or_not_reached(list(maybe(label))::in,
+ io::di, io::uo) is det.
-output_label_list([], !IO).
-output_label_list([Label | Labels], !IO) :-
- io.write_string("MR_LABEL_AP(", !IO),
- output_label(Label, no, !IO),
- io.write_string(")", !IO),
- output_label_list_2(Labels, !IO).
+output_label_list_or_not_reached([], !IO).
+output_label_list_or_not_reached([MaybeLabel | MaybeLabels], !IO) :-
+ output_label_or_not_reached(MaybeLabel, !IO),
+ output_label_list_or_not_reached_2(MaybeLabels, !IO).
-:- pred output_label_list_2(list(label)::in, io::di, io::uo) is det.
+:- pred output_label_list_or_not_reached_2(list(maybe(label))::in,
+ io::di, io::uo) is det.
-output_label_list_2([], !IO).
-output_label_list_2([Label | Labels], !IO) :-
+output_label_list_or_not_reached_2([], !IO).
+output_label_list_or_not_reached_2([MaybeLabel | MaybeLabels], !IO) :-
io.write_string(" MR_AND\n\t\t", !IO),
+ output_label_or_not_reached(MaybeLabel, !IO),
+ output_label_list_or_not_reached_2(MaybeLabels, !IO).
+
+:- pred output_label_or_not_reached(maybe(label)::in, io::di, io::uo) is det.
+
+output_label_or_not_reached(MaybeLabel, !IO) :-
+ (
+ MaybeLabel = yes(Label),
io.write_string("MR_LABEL_AP(", !IO),
output_label(Label, no, !IO),
- io.write_string(")", !IO),
- output_label_list_2(Labels, !IO).
+ io.write_string(")", !IO)
+ ;
+ MaybeLabel = no,
+ io.write_string("MR_ENTRY(MR_do_not_reached)", !IO)
+ ).
:- pred output_label_defn(label::in, io::di, io::uo) is det.
Index: compiler/llds_to_x86_64.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_to_x86_64.m,v
retrieving revision 1.9
diff -u -b -r1.9 llds_to_x86_64.m
--- compiler/llds_to_x86_64.m 11 Oct 2007 11:45:19 -0000 1.9
+++ compiler/llds_to_x86_64.m 14 Dec 2007 05:20:14 -0000
@@ -289,7 +289,7 @@
"instr_to_x86_64: computed_goto: unexpected: Rval")
)
),
- labels_to_string(Labels, "", LabelStr),
+ maybe_labels_to_string(Labels, "", LabelStr),
ScratchReg = ll_backend.x86_64_regs.reg_map_get_scratch_reg(!.RegMap),
ll_backend.x86_64_regs.reg_map_remove_scratch_reg(!RegMap),
TempReg = operand_reg(ScratchReg),
@@ -978,12 +978,19 @@
% Get a string representation of llds labels.
%
-:- pred labels_to_string(list(label)::in, string::in, string::out) is det.
+:- pred maybe_labels_to_string(list(maybe(label))::in, string::in, string::out)
+ is det.
-labels_to_string([], Str, Str).
-labels_to_string([Label | Labels], Str0, Str) :-
- LabelStr = ll_backend.llds_out.label_to_c_string(Label, no),
- labels_to_string(Labels, Str0 ++ LabelStr, Str).
+maybe_labels_to_string([], Str, Str).
+maybe_labels_to_string([MaybeLabel | MaybeLabels], Str0, Str) :-
+ (
+ MaybeLabel = yes(Label),
+ LabelStr = ll_backend.llds_out.label_to_c_string(Label, no)
+ ;
+ MaybeLabel = no,
+ LabelStr = "<<do_not_reached>>"
+ ),
+ maybe_labels_to_string(MaybeLabels, Str0 ++ LabelStr, Str).
%----------------------------------------------------------------------------%
Index: compiler/lookup_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lookup_switch.m,v
retrieving revision 1.78
diff -u -b -r1.78 lookup_switch.m
--- compiler/lookup_switch.m 27 Sep 2007 10:42:05 -0000 1.78
+++ compiler/lookup_switch.m 13 Dec 2007 09:21:10 -0000
@@ -42,7 +42,6 @@
:- module ll_backend.lookup_switch.
:- interface.
-:- import_module backend_libs.switch_util.
:- import_module hlds.code_model.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_llds.
@@ -50,21 +49,22 @@
:- import_module ll_backend.llds.
:- import_module parse_tree.prog_data.
+:- import_module list.
+
%-----------------------------------------------------------------------------%
:- type lookup_switch_info.
% Decide whether we can generate code for this switch using a lookup table.
- % The cases_list must be sorted on the index values.
%
-:- pred is_lookup_switch(prog_var::in, cases_list::in,
- hlds_goal_info::in, can_fail::in, int::in, abs_store_map::in,
- branch_end::in, branch_end::out, code_model::in, lookup_switch_info::out,
- code_info::in, code_info::out) is semidet.
+:- pred is_lookup_switch(mer_type::in, list(tagged_case)::in,
+ int::in, int::in, int::in, hlds_goal_info::in, can_fail::in, int::in,
+ abs_store_map::in, branch_end::in, branch_end::out, code_model::in,
+ lookup_switch_info::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(prog_var::in, abs_store_map::in, branch_end::in,
+:- pred generate_lookup_switch(rval::in, abs_store_map::in, branch_end::in,
lookup_switch_info::in, code_tree::out, code_info::in, code_info::out)
is det.
@@ -74,6 +74,7 @@
:- implementation.
:- import_module backend_libs.builtin_ops.
+:- import_module backend_libs.switch_util.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_form.
:- import_module hlds.hlds_data.
@@ -90,12 +91,12 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
-:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module string.
+:- import_module svmap.
%-----------------------------------------------------------------------------%
@@ -152,8 +153,9 @@
% Most of this predicate is taken from dense_switch.m.
%
-is_lookup_switch(CaseVar, TaggedCases0, GoalInfo, SwitchCanFail0, ReqDensity,
- StoreMap, !MaybeEnd, CodeModel, LookupSwitchInfo, !CI) :-
+is_lookup_switch(Type, TaggedCases0, LowerLimit, UpperLimit, NumValues,
+ GoalInfo, SwitchCanFail0, ReqDensity, StoreMap, !MaybeEnd, CodeModel,
+ 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.
@@ -189,19 +191,15 @@
% 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.
- list.length(TaggedCases, NumCases),
- TaggedCases = [FirstCase | _],
- FirstCase = extended_case(_, int_tag(FirstCaseVal), _, _),
- list.index1_det(TaggedCases, NumCases, LastCase),
- LastCase = extended_case(_, int_tag(LastCaseVal), _, _),
- Span = LastCaseVal - FirstCaseVal,
+
+ Span = UpperLimit - LowerLimit,
Range = Span + 1,
- Density = switch_density(NumCases, Range),
+ Density = switch_density(NumValues, Range),
Density > ReqDensity,
% If there are going to be no gaps in the lookup table then we won't need
% a bitvector test to see if this switch has a value for this case.
- ( NumCases = Range ->
+ ( NumValues = Range ->
NeedBitVecCheck0 = dont_need_bit_vec_check
;
NeedBitVecCheck0 = need_bit_vec_check
@@ -213,12 +211,11 @@
% range of the type is sufficiently small, we can make the jump table
% large enough to hold all of the values for the type, but then we
% will need to do the bitvector test.
- Type = variable_type(!.CI, CaseVar),
get_module_info(!.CI, ModuleInfo),
classify_type(ModuleInfo, Type) = TypeCategory,
(
- dense_switch.type_range(!.CI, TypeCategory, Type, TypeRange),
- DetDensity = switch_density(NumCases, TypeRange),
+ type_range(ModuleInfo, TypeCategory, Type, _, _, TypeRange),
+ DetDensity = switch_density(NumValues, TypeRange),
DetDensity > ReqDensity
->
NeedRangeCheck = dont_need_range_check,
@@ -228,21 +225,22 @@
;
NeedRangeCheck = need_range_check,
NeedBitVecCheck = NeedBitVecCheck0,
- FirstVal = FirstCaseVal,
- LastVal = LastCaseVal
+ FirstVal = LowerLimit,
+ LastVal = UpperLimit
)
;
SwitchCanFail = cannot_fail,
NeedRangeCheck = dont_need_range_check,
NeedBitVecCheck = NeedBitVecCheck0,
- FirstVal = FirstCaseVal,
- LastVal = LastCaseVal
+ FirstVal = LowerLimit,
+ LastVal = UpperLimit
),
figure_out_output_vars(!.CI, GoalInfo, OutVars),
remember_position(!.CI, CurPos),
generate_constants_for_lookup_switch(TaggedCases, OutVars, StoreMap,
- CaseSolns, !MaybeEnd, MaybeLiveness, set.init, ResumeVars,
- no, GoalsMayModifyTrail, !CI),
+ MaybeLiveness, map.init, CaseSolnMap, !MaybeEnd,
+ set.init, ResumeVars, no, GoalsMayModifyTrail, !CI),
+ map.to_assoc_list(CaseSolnMap, CaseSolns),
reset_to_position(CurPos, !CI),
(
MaybeLiveness = yes(Liveness)
@@ -296,12 +294,13 @@
%---------------------------------------------------------------------------%
-:- pred filter_out_failing_cases(cases_list::in,
- cases_list::in, cases_list::out, can_fail::in, can_fail::out) is det.
+:- pred filter_out_failing_cases(list(tagged_case)::in,
+ list(tagged_case)::in, list(tagged_case)::out,
+ can_fail::in, can_fail::out) is det.
filter_out_failing_cases([], !RevTaggedCases, !SwitchCanFail).
filter_out_failing_cases([Case | Cases], !RevTaggedCases, !SwitchCanFail) :-
- Case = extended_case(_, _, _, Goal),
+ Case = tagged_case(_, _, Goal),
Goal = hlds_goal(GoalExpr, _),
( GoalExpr = disj([]) ->
!:SwitchCanFail = can_fail
@@ -312,18 +311,18 @@
%---------------------------------------------------------------------------%
-:- pred generate_constants_for_lookup_switch(cases_list::in,
- list(prog_var)::in, abs_store_map::in, assoc_list(int, soln_consts)::out,
- branch_end::in, branch_end::out, maybe(set(prog_var))::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, _StoreMap, [], !MaybeEnd, no,
- !ResumeVars, !GoalTrailOps, !CI).
-generate_constants_for_lookup_switch([Case | Cases], Vars, StoreMap,
- [CaseVal | Rest], !MaybeEnd, MaybeLiveness, !ResumeVars,
+:- pred generate_constants_for_lookup_switch(list(tagged_case)::in,
+ list(prog_var)::in, abs_store_map::in, maybe(set(prog_var))::out,
+ map(int, soln_consts)::in, map(int, soln_consts)::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, _StoreMap, no, !IndexMap,
+ !MaybeEnd, !ResumeVars, !GoalTrailOps, !CI).
+generate_constants_for_lookup_switch([TaggedCase | TaggedCases], Vars,
+ StoreMap, MaybeLiveness, !IndexMap, !MaybeEnd, !ResumeVars,
!GoalsMayModifyTrail, !CI) :-
- Case = extended_case(_, int_tag(CaseTag), _, Goal),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
Goal = hlds_goal(GoalExpr, GoalInfo),
% Goals with these features need special treatment in generate_goal.
@@ -361,7 +360,7 @@
!MaybeEnd, MaybeLiveness, !CI),
set_instmap(InstMap, !CI),
post_goal_update(GoalInfo, !CI),
- CaseVal = CaseTag - several_solns(Solns)
+ SolnConsts = several_solns(Solns)
;
goal_is_conj_of_unify(Goal),
% The pre- and post-goal updates for the goals themselves
@@ -370,27 +369,39 @@
generate_constants_for_arm(Goal, Vars, StoreMap, Soln,
!MaybeEnd, Liveness, !CI),
MaybeLiveness = yes(Liveness),
- CaseVal = CaseTag - one_soln(Soln)
+ SolnConsts = one_soln(Soln)
),
- generate_constants_for_lookup_switch(Cases, Vars, StoreMap, Rest,
- !MaybeEnd, _, !ResumeVars, !GoalsMayModifyTrail, !CI).
+ record_lookup_for_tagged_cons_id(SolnConsts, TaggedMainConsId, !IndexMap),
+ list.foldl(record_lookup_for_tagged_cons_id(SolnConsts),
+ TaggedOtherConsIds, !IndexMap),
+ generate_constants_for_lookup_switch(TaggedCases, Vars,
+ StoreMap, _MaybeLivenessRest, !IndexMap, !MaybeEnd, !ResumeVars,
+ !GoalsMayModifyTrail, !CI).
+
+:- pred record_lookup_for_tagged_cons_id(soln_consts::in, tagged_cons_id::in,
+ map(int, soln_consts)::in, map(int, soln_consts)::out) is det.
+
+record_lookup_for_tagged_cons_id(SolnConsts, TaggedConsId, !IndexMap) :-
+ TaggedConsId = tagged_cons_id(_ConsId, ConsTag),
+ ( ConsTag = int_tag(Index) ->
+ svmap.det_insert(Index, SolnConsts, !IndexMap)
+ ;
+ unexpected(this_file, "record_lookup_for_tagged_cons_id: not int_tag")
+ ).
%---------------------------------------------------------------------------%
-generate_lookup_switch(Var, StoreMap, MaybeEnd0, LookupSwitchInfo, Code,
+generate_lookup_switch(VarRval, StoreMap, MaybeEnd0, LookupSwitchInfo, Code,
!CI) :-
LookupSwitchInfo = lookup_switch_info(StartVal, EndVal, CaseConsts,
OutVars, LLDSTypes, NeedRangeCheck, NeedBitVecCheck, Liveness),
- % Evaluate the variable which we are going to be switching on.
- produce_variable(Var, VarCode, Rval, !CI),
-
% If the case values start at some number other than 0,
% then subtract that number to give us a zero-based index.
( StartVal = 0 ->
- IndexRval = Rval
+ IndexRval = VarRval
;
- IndexRval = binop(int_sub, Rval, const(llconst_int(StartVal)))
+ IndexRval = binop(int_sub, VarRval, const(llconst_int(StartVal)))
),
% If the switch is not locally deterministic, we may need to check that
@@ -430,7 +441,7 @@
StartVal, EndVal, CaseSolns, ResumeVars, AddTrailOps, OutVars,
LLDSTypes, NeedBitVecCheck, Liveness, RestCode, !CI)
),
- Code = tree_list([Comment, VarCode, RangeCheckCode, RestCode]).
+ Code = tree_list([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,
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.43
diff -u -b -r1.43 loop_inv.m
--- compiler/loop_inv.m 23 Nov 2007 07:35:09 -0000 1.43
+++ compiler/loop_inv.m 23 Nov 2007 10:19:16 -0000
@@ -411,7 +411,7 @@
:- func case_goals(list(case)) = hlds_goals.
case_goals(Cases) =
- list.map(func(case(_ConsId, Goal)) = Goal, Cases).
+ list.map(func(case(_MainConsId, _OtherConsIds, Goal)) = Goal, Cases).
%-----------------------------------------------------------------------------%
@@ -933,7 +933,8 @@
gen_aux_proc_switch(Info, Cases) =
list.map(
- func(case(CaseId, Goal)) = case(CaseId, gen_aux_proc_2(Info, Goal)),
+ func(case(MainCaseId, OtherConsIds, Goal)) =
+ case(MainCaseId, OtherConsIds, gen_aux_proc_2(Info, Goal)),
Cases
).
@@ -1028,8 +1029,9 @@
hlds_goal(switch(Var, CanFail, list.map(GOPCase, Cases)), GoalInfo)
:-
GOPCase =
- ( func(case(ConsId, Goal)) =
- case(ConsId, gen_out_proc_2(PPId, CallAux, Goal)) ).
+ ( func(case(MainConsId, OtherConsIds, Goal)) =
+ case(MainConsId, OtherConsIds,
+ gen_out_proc_2(PPId, CallAux, Goal)) ).
gen_out_proc_2(PPId, CallAux,
hlds_goal(negation(NegatedGoal), GoalInfo)) =
Index: compiler/make_hlds_warn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_warn.m,v
retrieving revision 1.24
diff -u -b -r1.24 make_hlds_warn.m
--- compiler/make_hlds_warn.m 7 Aug 2007 07:09:58 -0000 1.24
+++ compiler/make_hlds_warn.m 23 Nov 2007 09:46:06 -0000
@@ -242,7 +242,7 @@
warn_singletons_in_cases([], _, _, _, _, !IO).
warn_singletons_in_cases([Case | Cases], QuantVars, VarSet, CallPredId,
ModuleInfo, !Specs) :-
- Case = case(_ConsId, Goal),
+ Case = case(_MainConsId, _OtherConsIds, Goal),
warn_singletons_in_goal(Goal, QuantVars, VarSet, CallPredId,
ModuleInfo, !Specs),
warn_singletons_in_cases(Cases, QuantVars, VarSet, CallPredId,
Index: compiler/mark_static_terms.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mark_static_terms.m,v
retrieving revision 1.28
diff -u -b -r1.28 mark_static_terms.m
--- compiler/mark_static_terms.m 6 Jan 2007 09:23:40 -0000 1.28
+++ compiler/mark_static_terms.m 23 Nov 2007 09:37:43 -0000
@@ -136,10 +136,10 @@
cases_mark_static_terms([], [], _SI0).
cases_mark_static_terms([Case0 | Cases0], [Case | Cases], SI0) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
% We throw away the static_info obtained after each branch.
goal_mark_static_terms(Goal0, Goal, SI0, _SI),
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
cases_mark_static_terms(Cases0, Cases, SI0).
:- pred unification_mark_static_terms(unification::in, unification::out,
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.132
diff -u -b -r1.132 middle_rec.m
--- compiler/middle_rec.m 26 Nov 2007 05:13:20 -0000 1.132
+++ compiler/middle_rec.m 26 Nov 2007 05:18:27 -0000
@@ -57,8 +57,8 @@
match_and_generate(Goal, Instrs, !CI) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
GoalExpr = switch(Var, cannot_fail, [Case1, Case2]),
- Case1 = case(ConsId1, Goal1),
- Case2 = case(ConsId2, Goal2),
+ Case1 = case(ConsId1, [], Goal1),
+ Case2 = case(ConsId2, [], Goal2),
(
contains_only_builtins(Goal1) = yes,
contains_simple_recursive_call(Goal2, !.CI)
@@ -200,7 +200,7 @@
:- func contains_only_builtins_cases(list(case)) = bool.
contains_only_builtins_cases([]) = yes.
-contains_only_builtins_cases([case(_ConsId, Goal) | Cases]) = OnlyBuiltins :-
+contains_only_builtins_cases([case(_, _, Goal) | Cases]) = OnlyBuiltins :-
( contains_only_builtins(Goal) = yes ->
OnlyBuiltins = contains_only_builtins_cases(Cases)
;
@@ -234,17 +234,19 @@
EntryLabel = make_local_entry_label(ModuleInfo, PredId, ProcId, no),
pre_goal_update(SwitchGoalInfo, no, !CI),
- unify_gen.generate_tag_test(Var, BaseConsId, branch_on_success,
+ VarType = variable_type(!.CI, Var),
+ CheaperTagTest = lookup_cheaper_tag_test(!.CI, VarType),
+ generate_tag_test(Var, BaseConsId, CheaperTagTest, branch_on_success,
BaseLabel, EntryTestCode, !CI),
tree.flatten(EntryTestCode, EntryTestListList),
list.condense(EntryTestListList, EntryTestList),
goal_info_get_store_map(SwitchGoalInfo, StoreMap),
remember_position(!.CI, BranchStart),
- code_gen.generate_goal(model_det, Base, BaseGoalCode, !CI),
+ generate_goal(model_det, Base, BaseGoalCode, !CI),
generate_branch_end(StoreMap, no, MaybeEnd1, BaseSaveCode, !CI),
reset_to_position(BranchStart, !CI),
- code_gen.generate_goal(model_det, Recursive, RecGoalCode, !CI),
+ generate_goal(model_det, Recursive, RecGoalCode, !CI),
generate_branch_end(StoreMap, MaybeEnd1, MaybeEnd, RecSaveCode, !CI),
post_goal_update(SwitchGoalInfo, !CI),
@@ -255,8 +257,8 @@
assoc_list.from_corresponding_lists(HeadVars, ArgModes, Args),
setup_return(Args, LiveArgs, EpilogCode, !CI),
- BaseCode = tree(BaseGoalCode, tree(BaseSaveCode, EpilogCode)),
- RecCode = tree(RecGoalCode, tree(RecSaveCode, EpilogCode)),
+ BaseCode = tree_list([BaseGoalCode, BaseSaveCode, EpilogCode]),
+ RecCode = tree_list([RecGoalCode, RecSaveCode, EpilogCode]),
LiveValCode = [llds_instr(livevals(LiveArgs), "")],
tree.flatten(BaseCode, BaseListList),
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.33
diff -u -b -r1.33 ml_string_switch.m
--- compiler/ml_string_switch.m 14 Sep 2007 00:57:05 -0000 1.33
+++ compiler/ml_string_switch.m 11 Dec 2007 13:26:08 -0000
@@ -20,15 +20,18 @@
:- module ml_backend.ml_string_switch.
:- interface.
-:- import_module backend_libs.switch_util.
:- import_module hlds.code_model.
+:- import_module hlds.hlds_goal.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.mlds.
:- import_module parse_tree.prog_data.
-:- pred generate(cases_list::in, prog_var::in, code_model::in, can_fail::in,
- prog_context::in, mlds_defns::out, statements::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+:- import_module list.
+
+:- pred ml_generate_string_switch(list(tagged_case)::in, prog_var::in,
+ code_model::in, can_fail::in, prog_context::in,
+ mlds_defns::out, statements::out, ml_gen_info::in, ml_gen_info::out)
+ is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -36,6 +39,7 @@
:- implementation.
:- import_module backend_libs.builtin_ops.
+:- import_module backend_libs.switch_util.
:- import_module hlds.hlds_data.
:- import_module libs.compiler_util.
:- import_module ml_backend.ml_code_gen.
@@ -43,15 +47,16 @@
:- import_module bool.
:- import_module int.
-:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module string.
+:- import_module unit.
%-----------------------------------------------------------------------------%
-generate(Cases, Var, CodeModel, _CanFail, Context, Decls, Statements, !Info) :-
+ml_generate_string_switch(Cases, Var, CodeModel, _CanFail, Context,
+ Decls, Statements, !Info) :-
MLDS_Context = mlds_make_context(Context),
% Compute the value we're going to switch on.
@@ -98,9 +103,12 @@
HashMask = TableSize - 1,
% Compute the hash table.
- switch_util.string_hash_cases(Cases, HashMask, HashValsMap),
+ switch_util.string_hash_cases(Cases, HashMask,
+ represent_tagged_case_by_itself, unit, _, unit, _, unit, _,
+ HashValsMap),
map.to_assoc_list(HashValsMap, HashValsList),
- switch_util.calc_hash_slots(HashValsList, HashValsMap, HashSlotsMap),
+ switch_util.calc_string_hash_slots(HashValsList, HashValsMap,
+ HashSlotsMap),
% Generate the code for when the hash lookup fails.
(
@@ -120,7 +128,7 @@
),
% Generate the code etc. for the hash table.
- gen_hash_slots(0, TableSize, HashSlotsMap, CodeModel,
+ ml_gen_string_hash_slots(0, TableSize, HashSlotsMap, CodeModel,
Context, Strings, NextSlots, SlotsCases, !Info),
% Generate the following local constant declarations:
@@ -223,48 +231,52 @@
%-----------------------------------------------------------------------------%
-:- pred gen_hash_slots(int::in, int::in,
- map(int, hash_slot)::in, code_model::in, prog_context::in,
- list(mlds_initializer)::out, list(mlds_initializer)::out,
+:- pred ml_gen_string_hash_slots(int::in, int::in,
+ map(int, string_hash_slot(tagged_case))::in, code_model::in,
+ prog_context::in, list(mlds_initializer)::out, list(mlds_initializer)::out,
list(mlds_switch_case)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-gen_hash_slots(Slot, TableSize, HashSlotMap, CodeModel, Context, Strings,
- NextSlots, MLDS_Cases, !Info) :-
+ml_gen_string_hash_slots(Slot, TableSize, HashSlotMap, CodeModel, Context,
+ Strings, NextSlots, MLDS_Cases, !Info) :-
( Slot = TableSize ->
Strings = [],
NextSlots = [],
MLDS_Cases = []
;
MLDS_Context = mlds_make_context(Context),
- gen_hash_slot(Slot, HashSlotMap, CodeModel, MLDS_Context, String,
- NextSlot, SlotCases, !Info),
- gen_hash_slots(Slot + 1, TableSize, HashSlotMap, CodeModel, Context,
- Strings0, NextSlots0, MLDS_Cases0, !Info),
+ ml_gen_string_hash_slot(Slot, HashSlotMap, CodeModel, MLDS_Context,
+ String, NextSlot, SlotCases, !Info),
+ ml_gen_string_hash_slots(Slot + 1, TableSize, HashSlotMap, CodeModel,
+ Context, Strings0, NextSlots0, MLDS_Cases0, !Info),
Strings = [String | Strings0],
NextSlots = [NextSlot | NextSlots0],
MLDS_Cases = SlotCases ++ MLDS_Cases0
).
-:- pred gen_hash_slot(int::in, map(int, hash_slot)::in,
- code_model::in, mlds_context::in, mlds_initializer::out,
- mlds_initializer::out, list(mlds_switch_case)::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_gen_string_hash_slot(int::in,
+ map(int, string_hash_slot(tagged_case))::in, code_model::in,
+ mlds_context::in, mlds_initializer::out, mlds_initializer::out,
+ list(mlds_switch_case)::out, ml_gen_info::in, ml_gen_info::out) is det.
-gen_hash_slot(Slot, HashSlotMap, CodeModel, MLDS_Context,
+ml_gen_string_hash_slot(Slot, HashSlotMap, CodeModel, MLDS_Context,
init_obj(StringRval), init_obj(NextSlotRval), MLDS_Cases, !Info) :-
- ( map.search(HashSlotMap, Slot, hash_slot(Case, Next)) ->
+ ( map.search(HashSlotMap, Slot, string_hash_slot(Next, String, Case)) ->
NextSlotRval = const(mlconst_int(Next)),
- Case = extended_case(_, ConsTag, _, Goal),
- ( ConsTag = string_tag(String0) ->
- String = String0
+ Case = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ expect(unify(TaggedOtherConsIds, []), this_file,
+ "ml_gen_string_hash_slot: other cons_ids"),
+ TaggedMainConsId = tagged_cons_id(_ConsId, ConsTag),
+ ( ConsTag = string_tag(StringPrime) ->
+ expect(unify(String, StringPrime), this_file,
+ "ml_gen_string_hash_slot: string mismatch")
;
- unexpected(this_file, "gen_hash_slots: string expected")
+ unexpected(this_file, "ml_gen_string_hash_slot: string expected")
),
StringRval = const(mlconst_string(String)),
ml_gen_goal(CodeModel, Goal, GoalStatement, !Info),
- string.append_list(["case """, String, """"], CommentString),
+ CommentString = "case """ ++ String ++ """",
Comment = statement(ml_stmt_atomic(comment(CommentString)),
MLDS_Context),
CaseStatement = statement(ml_stmt_block([], [Comment, GoalStatement]),
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.34
diff -u -b -r1.34 ml_switch_gen.m
--- compiler/ml_switch_gen.m 11 Sep 2007 03:12:30 -0000 1.34
+++ compiler/ml_switch_gen.m 13 Dec 2007 08:56:17 -0000
@@ -105,6 +105,7 @@
:- import_module backend_libs.switch_util.
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_module.
:- import_module libs.compiler_util.
:- import_module libs.options.
:- import_module ml_backend.ml_code_gen.
@@ -113,9 +114,12 @@
:- import_module ml_backend.ml_string_switch.
:- import_module ml_backend.ml_tag_switch.
:- import_module ml_backend.ml_unify_gen.
+:- import_module parse_tree.prog_type.
+:- import_module assoc_list.
:- import_module bool.
:- import_module int.
+:- import_module map.
:- import_module maybe.
:- import_module pair.
@@ -125,29 +129,31 @@
!Info) :-
% Lookup the representation of the constructors for the tag tests
% and their corresponding priorities.
- ml_switch_lookup_tags(!.Info, Cases, CaseVar, TaggedCases0),
+ ml_switch_lookup_tags(!.Info, Cases, CaseVar, CostTaggedCases),
% Sort the cases according to the priority of their tag tests.
- list.sort_and_remove_dups(TaggedCases0, TaggedCases),
+ list.sort_and_remove_dups(CostTaggedCases, SortedCostTaggedCases),
+ assoc_list.values(SortedCostTaggedCases, SortedTaggedCases),
% Figure out what kind of switch this is.
SwitchCategory = determine_category(!.Info, CaseVar),
ml_gen_info_get_globals(!.Info, Globals),
globals.lookup_bool_option(Globals, smart_indexing, Indexing),
(
- % Check for a switch on a type whose representation
- % uses reserved addresses.
- list.member(Case, TaggedCases),
- Case = extended_case(_Priority, Tag, _ConsId, _Goal),
- (
- Tag = reserved_address_tag(_)
- ;
- Tag = shared_with_reserved_addresses_tag(_, _)
- )
+ % Check for a switch on a type whose representation uses
+ % reserved addresses.
+ ml_variable_type(!.Info, CaseVar, CaseVarType),
+ type_to_ctor_det(CaseVarType, CaseVarTypeCtor),
+ ml_gen_info_get_module_info(!.Info, ModuleInfo),
+ module_info_get_type_table(ModuleInfo, TypeTable),
+ % The search will fail for builtin types.
+ map.search(TypeTable, CaseVarTypeCtor, CaseVarTypeDefn),
+ hlds_data.get_type_defn_body(CaseVarTypeDefn, CaseVarTypeBody),
+ CaseVarTypeBody ^ du_type_reserved_addr = uses_reserved_address
->
% XXX This may be inefficient in some cases.
- ml_switch_generate_if_else_chain(TaggedCases, CaseVar, CodeModel,
- CanFail, Context, Decls, Statements, !Info)
+ ml_switch_generate_if_then_else_chain(SortedTaggedCases, CaseVar,
+ CodeModel, CanFail, Context, Decls, Statements, !Info)
;
% XXX Lookup switches are NYI
% When we do get around to implementing them,
@@ -157,26 +163,26 @@
% % Note that if/when the MLDS back-end supports execution
% % tracing, we would also need to check that tracing is not
% % enabled.
-% list.length(TaggedCases, NumCases),
+% list.length(SortedTaggedCases, NumCases),
% globals.lookup_int_option(Globals, lookup_switch_size,
% LookupSize),
% NumCases >= LookupSize,
% globals.lookup_int_option(Globals, lookup_switch_req_density,
% ReqDensity),
-% lookup_switch.is_lookup_switch(CaseVar, TaggedCases, GoalInfo,
+% lookup_switch.is_lookup_switch(CaseVar, SortedTaggedCases, GoalInfo,
% CanFail, ReqDensity,
% CodeModel, FirstVal, LastVal, NeedRangeCheck,
% NeedBitVecCheck, OutVars, CaseVals, !Info)
% ->
% MaybeEnd = MaybeEndPrime,
-% ml_lookup_switch.generate(CaseVar, OutVars, CaseVals,
+% ml_generate_lookup_switch(CaseVar, OutVars, CaseVals,
% FirstVal, LastVal, NeedRangeCheck, NeedBitVecCheck,
% Decls, Statements, !Info)
% ;
% Try using a string hash switch.
Indexing = yes,
SwitchCategory = string_switch,
- list.length(TaggedCases, NumCases),
+ list.length(SortedTaggedCases, NumCases),
globals.lookup_int_option(Globals, string_switch_size, StringSize),
NumCases >= StringSize,
% We can implement string hash switches using either
@@ -198,18 +204,18 @@
globals.lookup_bool_option(Globals, prefer_switch, yes)
)
->
- ml_string_switch.generate(TaggedCases, CaseVar, CodeModel,
+ ml_generate_string_switch(SortedTaggedCases, CaseVar, CodeModel,
CanFail, Context, Decls, Statements, !Info)
;
% Try using a tag switch.
Indexing = yes,
SwitchCategory = tag_switch,
- list.length(TaggedCases, NumCases),
+ list.length(SortedTaggedCases, NumCases),
globals.lookup_int_option(Globals, tag_switch_size, TagSize),
NumCases >= TagSize,
target_supports_int_switch(Globals)
->
- ml_tag_switch.generate(TaggedCases, CaseVar, CodeModel,
+ ml_generate_tag_switch(SortedTaggedCases, CaseVar, CodeModel,
CanFail, Context, Decls, Statements, !Info)
;
% Try using a "direct-mapped" switch. This also handles dense
@@ -225,13 +231,13 @@
target_supports_computed_goto(Globals)
)
->
- ml_switch_generate_mlds_switch(TaggedCases, CaseVar, CodeModel,
+ ml_switch_generate_mlds_switch(SortedTaggedCases, CaseVar, CodeModel,
CanFail, Context, Decls, Statements, !Info)
;
% The fallback method: if all else fails, generate an if-then-else
% chain which tests each of the cases in turn.
- ml_switch_generate_if_else_chain(TaggedCases, CaseVar, CodeModel,
- CanFail, Context, Decls, Statements, !Info)
+ ml_switch_generate_if_then_else_chain(SortedTaggedCases, CaseVar,
+ CodeModel, CanFail, Context, Decls, Statements, !Info)
).
%-----------------------------------------------------------------------------%
@@ -329,27 +335,32 @@
% Also look up the priority of each tag test.
%
:- pred ml_switch_lookup_tags(ml_gen_info::in, list(case)::in, prog_var::in,
- cases_list::out) is det.
+ assoc_list(int, tagged_case)::out) is det.
ml_switch_lookup_tags(_Info, [], _, []).
-ml_switch_lookup_tags(Info, [Case | Cases], Var, [TaggedCase | TaggedCases]) :-
- Case = case(ConsId, Goal),
+ml_switch_lookup_tags(Info, [Case | Cases], Var,
+ [CostTaggedCase | CostTaggedCases]) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ expect(unify(OtherConsIds, []), this_file,
+ "ml_switch_lookup_tags: multi-cons-id switch arms NYI"),
ml_variable_type(Info, Var, Type),
- ml_cons_id_to_tag(Info, ConsId, Type, Tag),
- Priority = switch_util.switch_priority(Tag),
- TaggedCase = extended_case(Priority, Tag, ConsId, Goal),
- ml_switch_lookup_tags(Info, Cases, Var, TaggedCases).
+ ml_cons_id_to_tag(Info, MainConsId, Type, MainConsTag),
+ Cost = estimate_switch_tag_test_cost(MainConsTag),
+ TaggedMainConsId = tagged_cons_id(MainConsId, MainConsTag),
+ TaggedCase = tagged_case(TaggedMainConsId, [], Goal),
+ CostTaggedCase = Cost - TaggedCase,
+ ml_switch_lookup_tags(Info, Cases, Var, CostTaggedCases).
%-----------------------------------------------------------------------------%
% Generate a chain of if-then-elses to test each case in turn.
%
-:- pred ml_switch_generate_if_else_chain(list(extended_case)::in, prog_var::in,
- code_model::in, can_fail::in, prog_context::in,
+:- pred ml_switch_generate_if_then_else_chain(list(tagged_case)::in,
+ prog_var::in, code_model::in, can_fail::in, prog_context::in,
mlds_defns::out, statements::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_switch_generate_if_else_chain([], _Var, CodeModel, CanFail, Context,
+ml_switch_generate_if_then_else_chain([], _Var, CodeModel, CanFail, Context,
[], Statements, !Info) :-
(
CanFail = can_fail,
@@ -358,11 +369,14 @@
CanFail = cannot_fail,
unexpected(this_file, "switch failure")
).
-ml_switch_generate_if_else_chain([Case | Cases], Var, CodeModel, CanFail,
- Context, Decls, Statements, !Info) :-
- Case = extended_case(_, _Tag, ConsId, Goal),
+ml_switch_generate_if_then_else_chain([TaggedCase | TaggedCases], Var,
+ CodeModel, CanFail, Context, Decls, Statements, !Info) :-
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ expect(unify(TaggedOtherConsIds, []), this_file,
+ "ml_switch_generate_if_then_else_chain: OtherTaggedConsIds != []"),
+ TaggedMainConsId = tagged_cons_id(ConsId, _Tag),
(
- Cases = [],
+ TaggedCases = [],
CanFail = cannot_fail
->
ml_gen_goal(CodeModel, Goal, Decls, Statements, !Info)
@@ -370,7 +384,7 @@
ml_gen_tag_test(Var, ConsId, TagTestDecls, TagTestStatements,
TagTestExpression, !Info),
ml_gen_goal(CodeModel, Goal, GoalStatement, !Info),
- ml_switch_generate_if_else_chain(Cases, Var, CodeModel,
+ ml_switch_generate_if_then_else_chain(TaggedCases, Var, CodeModel,
CanFail, Context, RestDecls, RestStatements, !Info),
Rest = ml_gen_block(RestDecls, RestStatements, Context),
IfStmt = ml_stmt_if_then_else(TagTestExpression, GoalStatement,
@@ -386,9 +400,10 @@
% where we map a Mercury switch directly to a switch in the target
% language.
%
-:- pred ml_switch_generate_mlds_switch(list(extended_case)::in, prog_var::in,
- code_model::in, can_fail::in, prog_context::in, mlds_defns::out,
- statements::out, ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_switch_generate_mlds_switch(list(tagged_case)::in,
+ prog_var::in, code_model::in, can_fail::in, prog_context::in,
+ mlds_defns::out, statements::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
ml_switch_generate_mlds_switch(Cases, Var, CodeModel, CanFail, Context,
Decls, Statements, !Info) :-
@@ -413,30 +428,33 @@
ml_gen_info_get_module_info(Info, ModuleInfo),
ExportedType = to_exported_type(ModuleInfo, Type),
MLDS_Type = mercury_type(Type, TypeCategory, ExportedType),
- switch_util.type_range(TypeCategory, Type, ModuleInfo,
- MinRange, MaxRange)
+ switch_util.type_range(ModuleInfo, TypeCategory, Type,
+ MinRange, MaxRange, _NumValuesInRange)
->
Range = range(MinRange, MaxRange)
;
Range = range_unknown
).
-:- pred ml_switch_generate_mlds_cases(list(extended_case)::in,
+:- pred ml_switch_generate_mlds_cases(list(tagged_case)::in,
code_model::in, list(mlds_switch_case)::out,
ml_gen_info::in, ml_gen_info::out) is det.
ml_switch_generate_mlds_cases([], _, [], !Info).
-ml_switch_generate_mlds_cases([Case | Cases], CodeModel,
+ml_switch_generate_mlds_cases([TaggedCase | TaggedCases], CodeModel,
[MLDS_Case | MLDS_Cases], !Info) :-
- ml_switch_generate_mlds_case(Case, CodeModel, MLDS_Case, !Info),
- ml_switch_generate_mlds_cases(Cases, CodeModel, MLDS_Cases, !Info).
+ ml_switch_generate_mlds_case(TaggedCase, CodeModel, MLDS_Case, !Info),
+ ml_switch_generate_mlds_cases(TaggedCases, CodeModel, MLDS_Cases, !Info).
-:- pred ml_switch_generate_mlds_case(extended_case::in, code_model::in,
+:- pred ml_switch_generate_mlds_case(tagged_case::in, code_model::in,
mlds_switch_case::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_switch_generate_mlds_case(Case, CodeModel, MLDS_Case, !Info) :-
- Case = extended_case(_Priority, Tag, _ConsId, Goal),
+ml_switch_generate_mlds_case(TaggedCase, CodeModel, MLDS_Case, !Info) :-
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ expect(unify(TaggedOtherConsIds, []), this_file,
+ "ml_switch_generate_mlds_case: OtherTaggedConsIds != []"),
+ TaggedMainConsId = tagged_cons_id(_ConsId, Tag),
(
Tag = int_tag(Int),
Rval = const(mlconst_int(Int))
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.24
diff -u -b -r1.24 ml_tag_switch.m
--- compiler/ml_tag_switch.m 23 Nov 2007 07:35:14 -0000 1.24
+++ compiler/ml_tag_switch.m 11 Dec 2007 12:17:21 -0000
@@ -17,8 +17,8 @@
:- module ml_backend.ml_tag_switch.
:- interface.
-:- import_module backend_libs.switch_util.
:- import_module hlds.code_model.
+:- import_module hlds.hlds_goal.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.mlds.
:- import_module parse_tree.prog_data.
@@ -29,9 +29,10 @@
% Generate efficient indexing code for tag based switches.
%
-:- pred generate(list(extended_case)::in, prog_var::in, code_model::in,
- can_fail::in, prog_context::in, mlds_defns::out, statements::out,
- ml_gen_info::in, ml_gen_info::out) is det.
+:- pred ml_generate_tag_switch(list(tagged_case)::in, prog_var::in,
+ code_model::in, can_fail::in, prog_context::in,
+ mlds_defns::out, statements::out, ml_gen_info::in, ml_gen_info::out)
+ is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -40,6 +41,7 @@
:- import_module backend_libs.builtin_ops.
:- import_module backend_libs.rtti.
+:- import_module backend_libs.switch_util.
:- import_module hlds.hlds_data.
:- import_module libs.compiler_util.
:- import_module ml_backend.ml_code_gen.
@@ -51,10 +53,12 @@
:- import_module int.
:- import_module map.
:- import_module pair.
+:- import_module unit.
%-----------------------------------------------------------------------------%
-generate(Cases, Var, CodeModel, CanFail, Context, Decls, Statements, !Info) :-
+ml_generate_tag_switch(TaggedCases, Var, CodeModel, CanFail, Context,
+ Decls, Statements, !Info) :-
% Generate the rval for the primary tag.
ml_gen_var(!.Info, Var, VarLval),
VarRval = lval(VarLval),
@@ -69,7 +73,9 @@
switch_util.get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap),
map.to_assoc_list(PtagCountMap, PtagCountList),
map.init(PtagCaseMap0),
- switch_util.group_cases_by_ptag(Cases, PtagCaseMap0, PtagCaseMap),
+ switch_util.group_cases_by_ptag(TaggedCases,
+ represent_tagged_case_by_itself, unit, _, unit, _, unit, _,
+ PtagCaseMap0, PtagCaseMap),
switch_util.order_ptags_by_count(PtagCountList, PtagCaseMap,
PtagCaseList),
@@ -87,7 +93,7 @@
Decls = [],
Statements = [SwitchStatement].
-:- pred gen_ptag_cases(ptag_case_list::in, prog_var::in,
+:- pred gen_ptag_cases(ptag_case_list(tagged_case)::in, prog_var::in,
can_fail::in, code_model::in, ptag_count_map::in,
prog_context::in, list(mlds_switch_case)::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -100,7 +106,7 @@
gen_ptag_cases(Cases, Var, CanFail, CodeModel,
PtagCountMap, Context, MLDS_Cases, !Info).
-:- pred gen_ptag_case(pair(tag_bits, ptag_case)::in,
+:- pred gen_ptag_case(pair(tag_bits, ptag_case(tagged_case))::in,
prog_var::in, can_fail::in, code_model::in, ptag_count_map::in,
prog_context::in, mlds_switch_case::out,
ml_gen_info::in, ml_gen_info::out) is det.
@@ -120,7 +126,9 @@
GoalList = [],
unexpected(this_file, "no goal for non-shared tag")
;
- GoalList = [_Stag - stag_goal(_ConsId, Goal)],
+ GoalList = [_Stag - TaggedCase],
+ TaggedCase = tagged_case(_MainTaggedConsId, _OtherTaggedConsIds,
+ Goal),
ml_gen_goal(CodeModel, Goal, Statement, !Info)
;
GoalList = [_, _ | _],
@@ -146,9 +154,11 @@
)
),
(
- GoalList = [_Stag - stag_goal(_ConsId, Goal)],
+ GoalList = [_Stag - TaggedCase],
CaseCanFail = cannot_fail
->
+ TaggedCase = tagged_case(_MainTaggedConsId, _OtherTaggedConsIds,
+ Goal),
% There is only one possible matching goal,
% so we don't need to switch on it.
ml_gen_goal(CodeModel, Goal, Statement, !Info)
@@ -160,9 +170,10 @@
PrimaryTagRval = const(mlconst_int(PrimaryTag)),
MLDS_Case = mlds_switch_case([match_value(PrimaryTagRval)], Statement).
-:- pred gen_stag_switch(stag_goal_list::in, int::in, sectag_locn::in,
- prog_var::in, code_model::in, can_fail::in, prog_context::in,
- statement::out, ml_gen_info::in, ml_gen_info::out) is det.
+:- pred gen_stag_switch(stag_goal_list(tagged_case)::in, int::in,
+ sectag_locn::in, prog_var::in, code_model::in, can_fail::in,
+ prog_context::in, statement::out, ml_gen_info::in, ml_gen_info::out)
+ is det.
gen_stag_switch(Cases, PrimaryTag, StagLocn, Var, CodeModel, CanFail, Context,
Statement, !Info) :-
@@ -194,7 +205,7 @@
MLDS_Context = mlds_make_context(Context),
ml_simplify_switch(SwitchStmt, MLDS_Context, Statement, !Info).
-:- pred gen_stag_cases(stag_goal_list::in, code_model::in,
+:- pred gen_stag_cases(stag_goal_list(tagged_case)::in, code_model::in,
list(mlds_switch_case)::out, ml_gen_info::in, ml_gen_info::out) is det.
gen_stag_cases([], _, [], !Info).
@@ -202,12 +213,12 @@
gen_stag_case(Case, CodeModel, MLDS_Case, !Info),
gen_stag_cases(Cases, CodeModel, MLDS_Cases, !Info).
-:- pred gen_stag_case(pair(tag_bits, stag_goal)::in,
+:- pred gen_stag_case(pair(tag_bits, tagged_case)::in,
code_model::in, mlds_switch_case::out,
ml_gen_info::in, ml_gen_info::out) is det.
gen_stag_case(Case, CodeModel, MLDS_Case, !Info) :-
- Case = Stag - stag_goal(_ConsId, Goal),
+ Case = Stag - tagged_case(_MainTaggedConsId, _OtherTaggedConsIds, Goal),
StagRval = const(mlconst_int(Stag)),
ml_gen_goal(CodeModel, Goal, Statement, !Info),
MLDS_Case = mlds_switch_case([match_value(StagRval)], Statement).
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.72
diff -u -b -r1.72 ml_type_gen.m
--- compiler/ml_type_gen.m 23 Nov 2007 07:35:14 -0000 1.72
+++ compiler/ml_type_gen.m 25 Nov 2007 12:43:23 -0000
@@ -148,14 +148,19 @@
:- pred ml_gen_type_2(hlds_type_body::in, module_info::in, type_ctor::in,
hlds_type_defn::in, mlds_defns::in, mlds_defns::out) is det.
-ml_gen_type_2(hlds_abstract_type(_), _, _, _, !Defns).
-ml_gen_type_2(hlds_eqv_type(_EqvType), _, _, _, !Defns).
+ml_gen_type_2(TypeBody, ModuleInfo, TypeCtor, TypeDefn, !Defns) :-
+ (
+ TypeBody = hlds_abstract_type(_)
+ ;
+ TypeBody = hlds_eqv_type(_EqvType)
% XXX Fixme!
% For a description of the problems with equivalence types,
% see our BABEL'01 paper "Compiling Mercury to the .NET CLR".
-ml_gen_type_2(hlds_du_type(Ctors, TagValues, EnumDummy, MaybeUserEqComp,
- _ReservedTag, _, _), ModuleInfo, TypeCtor, TypeDefn, !Defns) :-
- % XXX we probably shouldn't ignore _ReservedTag
+ % The same issue arises for some of the cases below.
+ ;
+ TypeBody = hlds_du_type(Ctors, TagValues, _CheaperTagTest, EnumDummy,
+ MaybeUserEqComp, _ReservedTag, _, _),
+ % XXX We probably shouldn't ignore _ReservedTag.
ml_gen_equality_members(MaybeUserEqComp, MaybeEqualityMembers),
(
( EnumDummy = is_mercury_enum
@@ -173,10 +178,12 @@
EnumDummy = not_enum_or_dummy,
ml_gen_du_parent_type(ModuleInfo, TypeCtor, TypeDefn,
Ctors, TagValues, MaybeEqualityMembers, !Defns)
+ )
+ ;
+ TypeBody = hlds_foreign_type(_)
+ ;
+ TypeBody = hlds_solver_type(_, _)
).
- % XXX Fixme! Same issues here as for eqv_type/1.
-ml_gen_type_2(hlds_foreign_type(_), _, _, _, !Defns).
-ml_gen_type_2(hlds_solver_type(_, _), _, _, _, !Defns).
%-----------------------------------------------------------------------------%
%
@@ -1068,8 +1075,9 @@
),
unexpected(this_file, "ml_gen_exported_enum - invalid type (2).")
;
- TypeBody = hlds_du_type(Ctors, TagValues, _IsEnumOrDummy, _MaybeUserEq,
- _ReservedTag, _ReservedAddr, _IsForeignType),
+ TypeBody = hlds_du_type(Ctors, TagValues, _CheaperTagTest,
+ _IsEnumOrDummy, _MaybeUserEq, _ReservedTag, _ReservedAddr,
+ _IsForeignType),
list.foldl(generate_foreign_enum_constant(Mapping, TagValues),
Ctors, [], NamesAndTags),
MLDS_ExportedEnum = mlds_exported_enum(Lang, Context,
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.118
diff -u -b -r1.118 ml_unify_gen.m
--- compiler/ml_unify_gen.m 23 Nov 2007 07:35:14 -0000 1.118
+++ compiler/ml_unify_gen.m 28 Nov 2007 03:56:34 -0000
@@ -556,7 +556,7 @@
%
ml_cons_id_to_tag(Info, ConsId, Type, Tag) :-
ml_gen_info_get_module_info(Info, ModuleInfo),
- Tag = cons_id_to_tag(ConsId, Type, ModuleInfo).
+ Tag = cons_id_to_tag(ModuleInfo, Type, ConsId).
% Generate code to construct a new object.
%
@@ -1820,7 +1820,7 @@
hlds_data.get_type_defn_body(TypeDefn, TypeDefnBody),
(
TypeDefnBody =
- hlds_du_type(Ctors, TagValues, _, _, _ReservedTag, _, _),
+ hlds_du_type(Ctors, TagValues, _, _, _, _ReservedTag, _, _),
% XXX we probably shouldn't ignore ReservedTag here
(
some [Ctor] (
Index: compiler/mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_constraints.m,v
retrieving revision 1.43
diff -u -b -r1.43 mode_constraints.m
--- compiler/mode_constraints.m 12 Nov 2007 03:52:43 -0000 1.43
+++ compiler/mode_constraints.m 23 Nov 2007 09:21:37 -0000
@@ -554,9 +554,11 @@
number_robdd_variables_in_cases(_, _, Occurring, [], [], !RInfo) :-
set.init(Occurring).
number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring,
- [case(C, Goal0) | Cases0], [case(C, Goal) | Cases], !RInfo) :-
+ [Case0 | Cases0], [Case | Cases], !RInfo) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring0,
Goal0, Goal, !RInfo),
+ Case = case(MainConsId, OtherConsIds, Goal),
number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring1,
Cases0, Cases, !RInfo),
Occurring = Occurring0 `set.union` Occurring1.
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.121
diff -u -b -r1.121 mode_errors.m
--- compiler/mode_errors.m 23 Nov 2007 07:35:15 -0000 1.121
+++ compiler/mode_errors.m 24 Nov 2007 02:50:23 -0000
@@ -1054,7 +1054,7 @@
suffix(":"), nl].
mode_context_to_pieces(mode_context_unify(UnifyContext, _Side), _Markers)
= Pieces :-
- unify_context_first_to_pieces(no, _, UnifyContext, [], Pieces).
+ unify_context_first_to_pieces(is_not_first, _, UnifyContext, [], Pieces).
%-----------------------------------------------------------------------------%
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.201
diff -u -b -r1.201 mode_util.m
--- compiler/mode_util.m 30 Nov 2007 01:49:22 -0000 1.201
+++ compiler/mode_util.m 30 Nov 2007 07:27:21 -0000
@@ -1210,15 +1210,15 @@
_VarTypes, _InstMap, _NonLocals, [], !RI).
recompute_instmap_delta_cases_2(Atomic, Var, [Case0 | Cases0], [Case | Cases],
VarTypes, InstMap0, NonLocals, [InstMapDelta | InstMapDeltas], !RI) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
map.lookup(VarTypes, Var, Type),
- update_module_info(instmap.bind_var_to_functor(Var, Type, Functor,
- InstMap0), InstMap1, !RI),
+ update_module_info(bind_var_to_functors(Var, Type,
+ MainConsId, OtherConsIds, InstMap0), InstMap1, !RI),
recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap1,
InstMapDelta0, !RI),
- update_module_info(instmap_delta_bind_var_to_functor(Var, Type,
- Functor, InstMap0, InstMapDelta0), InstMapDelta, !RI),
- Case = case(Functor, Goal),
+ update_module_info(instmap_delta_bind_var_to_functors(Var, Type,
+ MainConsId, OtherConsIds, InstMap0, InstMapDelta0), InstMapDelta, !RI),
+ Case = case(MainConsId, OtherConsIds, Goal),
recompute_instmap_delta_cases_2(Atomic, Var, Cases0, Cases,
VarTypes, InstMap0, NonLocals, InstMapDeltas, !RI).
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.122
diff -u -b -r1.122 modecheck_unify.m
--- compiler/modecheck_unify.m 23 Nov 2007 07:35:16 -0000 1.122
+++ compiler/modecheck_unify.m 13 Dec 2007 12:56:08 -0000
@@ -1302,7 +1302,7 @@
;
% If the type has only one constructor, then the unification
% cannot fail.
- type_constructors(TypeOfX, ModuleInfo, Constructors),
+ type_constructors(ModuleInfo, TypeOfX, Constructors),
Constructors = [_]
->
CanFail = cannot_fail
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.364
diff -u -b -r1.364 modes.m
--- compiler/modes.m 29 Nov 2007 05:29:36 -0000 1.364
+++ compiler/modes.m 29 Nov 2007 06:24:39 -0000
@@ -251,7 +251,7 @@
:- pred mode_info_remove_goals_live_vars(list(hlds_goal)::in,
mode_info::in, mode_info::out) is det.
- % modecheck_functor_test(ConsId, Var):
+ % modecheck_functor_test(Var, ConsId, !ModeInfo):
%
% Update the instmap to reflect the fact that Var was bound to ConsId.
% This is used for the functor tests in `switch' statements.
@@ -259,11 +259,20 @@
:- pred modecheck_functor_test(prog_var::in, cons_id::in,
mode_info::in, mode_info::out) is det.
- % compute_goal_instmap_delta(InstMap0, Goal,
- % GoalInfo0, GoalInfo, ModeInfo0, ModeInfo):
+ % modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo):
%
- % Work out the instmap_delta for a goal from
- % the instmaps before and after the goal.
+ % Update the instmap to reflect the fact that Var was bound to either
+ % MainConsId or one of the OtherConsIds.
+ % This is used for the functor tests in `switch' statements.
+ %
+:- pred modecheck_functors_test(prog_var::in, cons_id::in, list(cons_id)::in,
+ mode_info::in, mode_info::out) is det.
+
+ % compute_goal_instmap_delta(InstMap0, GoalExpr, GoalInfo0, GoalInfo,
+ % !ModeInfo):
+ %
+ % Work out the instmap_delta for a goal from the instmaps before and after
+ % the goal.
%
:- pred compute_goal_instmap_delta(instmap::in, hlds_goal_expr::in,
hlds_goal_info::in, hlds_goal_info::out,
@@ -1000,10 +1009,10 @@
modecheck_clause_switch(HeadVars, InstMap0, ArgFinalInsts0, Var, Case0, Case,
!ModeInfo, !IO) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
mode_info_set_instmap(InstMap0, !ModeInfo),
- modecheck_functor_test(Var, ConsId, !ModeInfo),
+ modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
% Modecheck this case (if it is reachable).
mode_info_get_instmap(!.ModeInfo, InstMap1),
@@ -1024,7 +1033,7 @@
% Check that final insts match those specified in the mode declaration.
modecheck_final_insts(HeadVars, no, ArgFinalInsts0,
_ArgFinalInsts, Goal2, Goal, !ModeInfo),
- Case = case(ConsId, Goal).
+ Case = case(MainConsId, OtherConsIds, Goal).
:- pred unique_modecheck_clause_disj(list(prog_var)::in, instmap::in,
list(mer_inst)::in, determinism::in, set(prog_var)::in, bag(prog_var)::in,
@@ -1049,10 +1058,10 @@
unique_modecheck_clause_switch(HeadVars, InstMap0, ArgFinalInsts0, Var,
Case0, Case, !ModeInfo, !IO) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
mode_info_set_instmap(InstMap0, !ModeInfo),
- modecheck_functor_test(Var, ConsId, !ModeInfo),
+ modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, InstMap1),
( instmap.is_reachable(InstMap1) ->
@@ -1071,7 +1080,7 @@
% Check that final insts match those specified in the mode declaration.
modecheck_final_insts(HeadVars, no, ArgFinalInsts0, _ArgFinalInsts,
Goal2, Goal, !ModeInfo),
- Case = case(ConsId, Goal).
+ Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
@@ -2756,12 +2765,12 @@
modecheck_case_list([], _Var, [], [], !ModeInfo, !IO).
modecheck_case_list([Case0 | Cases0], Var, [Case | Cases],
[InstMap | InstMaps], !ModeInfo, !IO) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
mode_info_get_instmap(!.ModeInfo, InstMap0),
% Record the fact that Var was bound to ConsId in the
% instmap before processing this case.
- modecheck_functor_test(Var, ConsId, !ModeInfo),
+ modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
% Modecheck this case (if it is reachable).
mode_info_get_instmap(!.ModeInfo, InstMap1),
@@ -2778,28 +2787,41 @@
% Don't lose the information added by the functor test above.
fixup_switch_var(Var, InstMap0, InstMap, Goal1, Goal),
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
mode_info_set_instmap(InstMap0, !ModeInfo),
modecheck_case_list(Cases0, Var, Cases, InstMaps, !ModeInfo, !IO).
- % modecheck_functor_test(ConsId, Var):
- %
- % Update the instmap to reflect the fact that Var was bound to ConsId.
- % This is used for the functor tests in `switch' statements.
- %
modecheck_functor_test(Var, ConsId, !ModeInfo) :-
% Figure out the arity of this constructor, _including_ any type-infos
% or typeclass-infos inserted for existential data types.
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
mode_info_get_var_types(!.ModeInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
- AdjustedArity = cons_id_adjusted_arity(ModuleInfo, Type, ConsId),
+ BoundInst = cons_id_to_bound_inst(ModuleInfo, Type, ConsId),
+
+ % Record the fact that Var was bound to ConsId.
+ modecheck_set_var_inst(Var, bound(unique, [BoundInst]), no, !ModeInfo).
+
+modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo) :-
+ % Figure out the arity of this constructor, _including_ any type-infos
+ % or typeclass-infos inserted for existential data types.
+ mode_info_get_module_info(!.ModeInfo, ModuleInfo),
+ mode_info_get_var_types(!.ModeInfo, VarTypes),
+ map.lookup(VarTypes, Var, Type),
+ BoundInsts = list.map(cons_id_to_bound_inst(ModuleInfo, Type),
+ [MainConsId | OtherConsIds]),
- % record the fact that Var was bound to ConsId in the instmap
- list.duplicate(AdjustedArity, free, ArgInsts),
- modecheck_set_var_inst(Var,
- bound(unique, [bound_functor(ConsId, ArgInsts)]), no, !ModeInfo).
+ % Record the fact that Var was bound to MainConsId or one of the
+ % OtherConsIds.
+ modecheck_set_var_inst(Var, bound(unique, BoundInsts), no, !ModeInfo).
+
+:- func cons_id_to_bound_inst(module_info, mer_type, cons_id) = bound_inst.
+
+cons_id_to_bound_inst(ModuleInfo, Type, ConsId) = BoundInst :-
+ ConsIdAdjustedArity = cons_id_adjusted_arity(ModuleInfo, Type, ConsId),
+ list.duplicate(ConsIdAdjustedArity, free, ArgInsts),
+ BoundInst = bound_functor(ConsId, ArgInsts).
%-----------------------------------------------------------------------------%
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.201
diff -u -b -r1.201 opt_debug.m
--- compiler/opt_debug.m 23 Nov 2007 04:30:01 -0000 1.201
+++ compiler/opt_debug.m 14 Dec 2007 05:22:16 -0000
@@ -83,6 +83,9 @@
:- func dump_label(maybe(proc_label), label) = string.
+:- func dump_labels_or_not_reached(maybe(proc_label), list(maybe(label)))
+ = string.
+
:- func dump_labels(maybe(proc_label), list(label)) = string.
:- func dump_label_pairs(maybe(proc_label), list(pair(label))) = string.
@@ -630,6 +633,18 @@
Str = dump_proclabel(ProcLabel)
).
+dump_labels_or_not_reached(_, []) = "".
+dump_labels_or_not_reached(MaybeProcLabel, [MaybeLabel | MaybeLabels]) = Str :-
+ (
+ MaybeLabel = yes(Label),
+ LabelStr = dump_label(MaybeProcLabel, Label)
+ ;
+ MaybeLabel = no,
+ LabelStr = dump_code_addr(MaybeProcLabel, do_not_reached)
+ ),
+ Str = " " ++ LabelStr ++
+ dump_labels_or_not_reached(MaybeProcLabel, MaybeLabels).
+
dump_labels(_, []) = "".
dump_labels(MaybeProcLabel, [Label | Labels]) =
" " ++ dump_label(MaybeProcLabel, Label) ++
@@ -761,7 +776,7 @@
;
Instr = computed_goto(Rval, Labels),
Str = "computed_goto " ++ dump_rval(yes(ProcLabel), Rval) ++ ":"
- ++ dump_labels(yes(ProcLabel), Labels)
+ ++ dump_labels_or_not_reached(yes(ProcLabel), Labels)
;
Instr = arbitrary_c_code(AL, _, Code),
Str = "arbitrary_c_code(" ++ dump_affects_liveness(AL) ++ "\n" ++
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.167
diff -u -b -r1.167 opt_util.m
--- compiler/opt_util.m 11 Oct 2007 11:45:20 -0000 1.167
+++ compiler/opt_util.m 14 Dec 2007 05:05:44 -0000
@@ -309,8 +309,8 @@
:- pred replace_labels_code_addr(code_addr::in, code_addr::out,
map(label, label)::in) is det.
-:- pred replace_labels_label_list(list(label)::in, list(label)::out,
- map(label, label)::in) is det.
+:- pred replace_labels_maybe_label_list(list(maybe(label))::in,
+ list(maybe(label))::out, map(label, label)::in) is det.
:- pred replace_labels_label(label::in, label::out, map(label, label)::in)
is det.
@@ -1256,7 +1256,9 @@
instr_labels_2(mkframe(_, no), [], []).
instr_labels_2(label(_), [], []).
instr_labels_2(goto(Addr), [], [Addr]).
-instr_labels_2(computed_goto(_, Labels), Labels, []).
+instr_labels_2(computed_goto(_, MaybeLabels), Labels, []) :-
+ possible_targets_maybe_labels(MaybeLabels, [], RevLabels),
+ list.reverse(RevLabels, Labels).
instr_labels_2(arbitrary_c_code(_, _, _), [], []).
instr_labels_2(if_val(_, Addr), [], [Addr]).
instr_labels_2(save_maxfr(_), [], []).
@@ -1315,7 +1317,9 @@
Labels = [],
CodeAddrs = [CodeAddr]
).
-possible_targets(computed_goto(_, Labels), Labels, []).
+possible_targets(computed_goto(_, MaybeLabels), Labels, []) :-
+ possible_targets_maybe_labels(MaybeLabels, [], RevLabels),
+ list.reverse(RevLabels, Labels).
possible_targets(arbitrary_c_code(_, _, _), [], []).
possible_targets(if_val(_, CodeAddr), Labels, CodeAddrs) :-
( CodeAddr = code_label(Label) ->
@@ -1354,6 +1358,19 @@
foreign_proc_labels(MaybeFixedLabel, MaybeLayoutLabel,
no, MaybeSubLabel, Labels).
+:- pred possible_targets_maybe_labels(list(maybe(label))::in,
+ list(label)::in, list(label)::out) is det.
+
+possible_targets_maybe_labels([], !RevLabels).
+possible_targets_maybe_labels([MaybeLabel | MaybeLabels], !RevLabels) :-
+ (
+ MaybeLabel = yes(Label),
+ !:RevLabels = [Label | !.RevLabels]
+ ;
+ MaybeLabel = no
+ ),
+ possible_targets_maybe_labels(MaybeLabels, !RevLabels).
+
:- pred foreign_proc_labels(maybe(label)::in, maybe(label)::in,
maybe(label)::in, maybe(label)::in, list(label)::out) is det.
@@ -2151,7 +2168,7 @@
replace_labels_code_addr(Target0, Target, ReplMap),
Uinstr = goto(Target)
;
- Uinstr0 = computed_goto(Rval0, Labels0),
+ Uinstr0 = computed_goto(Rval0, MaybeLabels0),
(
ReplData = yes,
replace_labels_rval(Rval0, Rval, ReplMap)
@@ -2159,8 +2176,8 @@
ReplData = no,
Rval = Rval0
),
- replace_labels_label_list(Labels0, Labels, ReplMap),
- Uinstr = computed_goto(Rval, Labels)
+ replace_labels_maybe_label_list(MaybeLabels0, MaybeLabels, ReplMap),
+ Uinstr = computed_goto(Rval, MaybeLabels)
;
Uinstr0 = arbitrary_c_code(AffectsLiveness, Lvals0, Code),
(
@@ -2581,10 +2598,18 @@
Addr = Addr0
).
-replace_labels_label_list([], [], _ReplMap).
-replace_labels_label_list([Label0 | Labels0], [Label | Labels], ReplMap) :-
+replace_labels_maybe_label_list([], [], _ReplMap).
+replace_labels_maybe_label_list([MaybeLabel0 | MaybeLabels0],
+ [MaybeLabel | MaybeLabels], ReplMap) :-
+ (
+ MaybeLabel0 = yes(Label0),
replace_labels_label(Label0, Label, ReplMap),
- replace_labels_label_list(Labels0, Labels, ReplMap).
+ MaybeLabel = yes(Label)
+ ;
+ MaybeLabel0 = no,
+ MaybeLabel = no
+ ),
+ replace_labels_maybe_label_list(MaybeLabels0, MaybeLabels, ReplMap).
replace_labels_label(Label0, Label, ReplMap) :-
( map.search(ReplMap, Label0, NewLabel) ->
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.605
diff -u -b -r1.605 options.m
--- compiler/options.m 26 Nov 2007 05:13:20 -0000 1.605
+++ compiler/options.m 26 Nov 2007 05:17:38 -0000
@@ -482,6 +482,8 @@
% Insert calls to solver type initialisation predicates when
% the inst of solver type variables changes from free to any.
+ ; allow_multi_arm_switches
+
% Code generation options
; low_level_debug
; table_debug
@@ -1228,7 +1230,8 @@
% stable.
size_region_disj_snapshot - int(4),
size_region_commit_entry - int(1),
- solver_type_auto_init - bool(no)
+ solver_type_auto_init - bool(no),
+ allow_multi_arm_switches - bool(yes)
]).
option_defaults_2(code_gen_option, [
% Code Generation Options
@@ -2020,6 +2023,7 @@
long_option("size-region-disj-snapshot", size_region_disj_snapshot).
long_option("size-region-commit-entry", size_region_commit_entry).
long_option("solver-type-auto-init", solver_type_auto_init).
+long_option("allow-multi-arm-switches", allow_multi_arm_switches).
% code generation options
long_option("low-level-debug", low_level_debug).
@@ -4137,6 +4141,12 @@
% "--solver-type-auto-init",
% "(This option is not for general use.)",
% Allow automatic initialisation of solver types.
+
+ % This is a developer only option.
+% "--allow-multi-arm-switches",
+% "(This option is not for general use.)",
+% Allow the compiler to generate switches in which one arm handles
+% more than one cons_id.
]).
:- pred options_help_code_generation(io::di, io::uo) is det.
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.35
diff -u -b -r1.35 pd_cost.m
--- compiler/pd_cost.m 10 Oct 2007 14:35:27 -0000 1.35
+++ compiler/pd_cost.m 23 Nov 2007 09:11:50 -0000
@@ -156,7 +156,7 @@
:- pred cases_cost(list(case)::in, int::in, int::out) is det.
cases_cost([], Cost, Cost).
-cases_cost([case(_, Goal) | Cases], Cost0, Cost) :-
+cases_cost([case(_, _, Goal) | Cases], Cost0, Cost) :-
goal_cost(Goal, Cost1),
Cost2 = Cost0 + Cost1,
cases_cost(Cases, Cost2, Cost).
Index: compiler/pd_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_info.m,v
retrieving revision 1.36
diff -u -b -r1.36 pd_info.m
--- compiler/pd_info.m 23 Nov 2007 07:35:19 -0000 1.36
+++ compiler/pd_info.m 23 Nov 2007 16:18:49 -0000
@@ -107,8 +107,8 @@
:- pred pd_info_update_goal(hlds_goal::in, pd_info::in, pd_info::out) is det.
-:- pred pd_info_bind_var_to_functor(prog_var::in, cons_id::in,
- pd_info::in, pd_info::out) is det.
+:- pred pd_info_bind_var_to_functors(prog_var::in,
+ cons_id::in, list(cons_id)::in, pd_info::in, pd_info::out) is det.
:- pred pd_info_unset_unfold_info(pd_info::in, pd_info::out) is det.
@@ -203,14 +203,14 @@
instmap.apply_instmap_delta(InstMap0, Delta, InstMap),
pd_info_set_instmap(InstMap, !PDInfo).
-pd_info_bind_var_to_functor(Var, ConsId, !PDInfo) :-
+pd_info_bind_var_to_functors(Var, MainConsId, OtherConsIds, !PDInfo) :-
pd_info_get_instmap(!.PDInfo, InstMap0),
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
pd_info_get_proc_info(!.PDInfo, ProcInfo),
proc_info_get_vartypes(ProcInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
- instmap.bind_var_to_functor(Var, Type, ConsId, InstMap0, InstMap,
- ModuleInfo0, ModuleInfo),
+ bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
+ InstMap0, InstMap, ModuleInfo0, ModuleInfo),
pd_info_set_instmap(InstMap, !PDInfo),
pd_info_set_module_info(ModuleInfo, !PDInfo).
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.64
diff -u -b -r1.64 pd_util.m
--- compiler/pd_util.m 23 Nov 2007 07:35:19 -0000 1.64
+++ compiler/pd_util.m 11 Dec 2007 15:54:32 -0000
@@ -371,14 +371,15 @@
pd_info_get_proc_info(!.PDInfo, ProcInfo),
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
- ModuleInfo0, ModuleInfo),
- pd_info_set_module_info(ModuleInfo, !PDInfo),
+ ModuleInfo0, ModuleInfo1),
proc_info_get_vartypes(ProcInfo, VarTypes),
- det_info_init(ModuleInfo, VarTypes, PredId, ProcId, DetInfo),
+ det_info_init(ModuleInfo1, VarTypes, PredId, ProcId, DetInfo0),
pd_info_get_instmap(!.PDInfo, InstMap),
- det_infer_goal(Goal0, Goal, InstMap, SolnContext, [], no, DetInfo, _, _,
- [], Specs),
+ det_infer_goal(Goal0, Goal, InstMap, SolnContext, [], no, _, _,
+ DetInfo0, DetInfo, [], Specs),
+ det_info_get_module_info(DetInfo, ModuleInfo2),
+ pd_info_set_module_info(ModuleInfo2, !PDInfo),
% Make sure there were no errors.
globals.io_get_globals(Globals, !IO),
@@ -574,7 +575,7 @@
get_branch_instmap_deltas(hlds_goal(switch(_, _, Cases), _), InstMapDeltas) :-
GetCaseInstMapDelta =
(pred(Case::in, InstMapDelta::out) is det :-
- Case = case(_, hlds_goal(_, CaseInfo)),
+ Case = case(_, _, hlds_goal(_, CaseInfo)),
InstMapDelta = goal_info_get_instmap_delta(CaseInfo)
),
list.map(GetCaseInstMapDelta, Cases, InstMapDeltas).
@@ -715,17 +716,18 @@
module_info::in, module_info::out) is det.
examine_case_list(_, _, _, [], _, _, !Vars, !ModuleInfo).
-examine_case_list(ProcArgInfo, BranchNo, Var,
- [case(ConsId, Goal) | Goals], VarTypes, InstMap, !Vars, !ModuleInfo) :-
+examine_case_list(ProcArgInfo, BranchNo, Var, [Case | Cases],
+ VarTypes, InstMap0, !Vars, !ModuleInfo) :-
map.lookup(VarTypes, Var, Type),
- instmap.bind_var_to_functor(Var, Type, ConsId, InstMap, InstMap1,
- !ModuleInfo),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
+ InstMap0, InstMap1, !ModuleInfo),
goal_to_conj_list(Goal, GoalList),
examine_branch(!.ModuleInfo, ProcArgInfo, BranchNo, GoalList,
VarTypes, InstMap1, !Vars),
NextBranch = BranchNo + 1,
- examine_case_list(ProcArgInfo, NextBranch, Var, Goals,
- VarTypes, InstMap, !Vars, !ModuleInfo).
+ examine_case_list(ProcArgInfo, NextBranch, Var, Cases,
+ VarTypes, InstMap0, !Vars, !ModuleInfo).
:- pred examine_branch(module_info::in, pd_arg_info::in, int::in,
hlds_goals::in, vartypes::in, instmap::in,
Index: compiler/peephole.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/peephole.m,v
retrieving revision 1.100
diff -u -b -r1.100 peephole.m
--- compiler/peephole.m 23 Nov 2007 07:35:19 -0000 1.100
+++ compiler/peephole.m 14 Dec 2007 05:08:26 -0000
@@ -102,17 +102,18 @@
% Build a map that associates each label in a computed goto with the
% values of the switch rval that cause a jump to it.
%
-:- pred build_peephole_jump_label_map(list(label)::in, int::in,
- map(label, list(int))::in, map(label, list(int))::out) is det.
+:- pred build_peephole_jump_label_map(list(maybe(label))::in, int::in,
+ map(label, list(int))::in, map(label, list(int))::out) is semidet.
build_peephole_jump_label_map([], _, !LabelMap).
-build_peephole_jump_label_map([Label | Labels], Val, !LabelMap) :-
+build_peephole_jump_label_map([MaybeLabel | MaybeLabels], Val, !LabelMap) :-
+ MaybeLabel = yes(Label),
( map.search(!.LabelMap, Label, Vals0) ->
map.det_update(!.LabelMap, Label, [Val | Vals0], !:LabelMap)
;
map.det_insert(!.LabelMap, Label, [Val], !:LabelMap)
),
- build_peephole_jump_label_map(Labels, Val + 1, !LabelMap).
+ build_peephole_jump_label_map(MaybeLabels, Val + 1, !LabelMap).
% If one of the two labels has only one associated value, return it and
% the associated value as the first two output arguments, and the
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.323
diff -u -b -r1.323 polymorphism.m
--- compiler/polymorphism.m 23 Nov 2007 07:35:19 -0000 1.323
+++ compiler/polymorphism.m 23 Nov 2007 09:22:45 -0000
@@ -1690,9 +1690,9 @@
polymorphism_process_case_list([], [], !Info).
polymorphism_process_case_list([Case0 | Cases0], [Case | Cases], !Info) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
polymorphism_process_goal(Goal0, Goal, !Info),
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
polymorphism_process_case_list(Cases0, Cases, !Info).
%-----------------------------------------------------------------------------%
Index: compiler/post_term_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_term_analysis.m,v
retrieving revision 1.17
diff -u -b -r1.17 post_term_analysis.m
--- compiler/post_term_analysis.m 25 Sep 2007 04:56:40 -0000 1.17
+++ compiler/post_term_analysis.m 25 Nov 2007 12:05:25 -0000
@@ -211,7 +211,7 @@
unify_compare::out) is semidet.
get_user_unify_compare(_ModuleInfo, TypeBody, UnifyCompare) :-
- TypeBody = hlds_du_type(_, _, _, yes(UnifyCompare), _, _, _).
+ TypeBody = hlds_du_type(_, _, _, _, yes(UnifyCompare), _, _, _).
get_user_unify_compare(ModuleInfo, TypeBody, UnifyCompare) :-
TypeBody = hlds_foreign_type(ForeignTypeBody),
foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo,
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.121
diff -u -b -r1.121 post_typecheck.m
--- compiler/post_typecheck.m 23 Nov 2007 07:35:20 -0000 1.121
+++ compiler/post_typecheck.m 25 Nov 2007 11:47:33 -0000
@@ -1366,7 +1366,7 @@
map.lookup(Types, TermTypeCtor, TermTypeDefn),
hlds_data.get_type_defn_body(TermTypeDefn, TermTypeBody),
(
- TermTypeBody = hlds_du_type(Ctors, _, _, _, _, _, _),
+ TermTypeBody = hlds_du_type(Ctors, _, _, _, _, _, _, _),
get_constructor_containing_field_2(Ctors, FieldName, ConsId,
FieldNumber)
;
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.56
diff -u -b -r1.56 prog_rep.m
--- compiler/prog_rep.m 23 Nov 2007 07:35:22 -0000 1.56
+++ compiler/prog_rep.m 23 Nov 2007 15:08:32 -0000
@@ -95,8 +95,8 @@
Info = info(FileName, VarTypes, VarNumMap, VarNumRep, ModuleInfo),
var_num_rep_byte(VarNumRep, VarNumRepByte),
- string_to_byte_list(FileName, !StackInfo, FileNameBytes),
- goal_to_byte_list(Goal, InstMap0, Info, !StackInfo, GoalBytes),
+ string_to_byte_list(FileName, FileNameBytes, !StackInfo),
+ goal_to_byte_list(Goal, InstMap0, Info, GoalBytes, !StackInfo),
ProcRepBytes0 = [VarNumRepByte] ++ FileNameBytes ++
vars_to_byte_list(Info, HeadVars) ++ GoalBytes,
int32_to_byte_list(list.length(ProcRepBytes0) + 4, LimitBytes),
@@ -116,46 +116,49 @@
%---------------------------------------------------------------------------%
:- pred goal_to_byte_list(hlds_goal::in, instmap::in, prog_rep_info::in,
- stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
+ list(int)::out, stack_layout_info::in, stack_layout_info::out) is det.
-goal_to_byte_list(hlds_goal(GoalExpr, GoalInfo), InstMap0, Info,
- !StackInfo, Bytes) :-
- goal_expr_to_byte_list(GoalExpr, GoalInfo, InstMap0, Info, !StackInfo,
- Bytes).
+goal_to_byte_list(hlds_goal(GoalExpr, GoalInfo), InstMap0, Info, Bytes,
+ !StackInfo) :-
+ goal_expr_to_byte_list(GoalExpr, GoalInfo, InstMap0, Info, Bytes,
+ !StackInfo).
:- pred goal_expr_to_byte_list(hlds_goal_expr::in, hlds_goal_info::in,
- instmap::in, prog_rep_info::in,
- stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
+ instmap::in, prog_rep_info::in, list(int)::out,
+ stack_layout_info::in, stack_layout_info::out) is det.
-goal_expr_to_byte_list(conj(ConjType, Goals), _, InstMap0, Info, !StackInfo,
- Bytes) :-
+goal_expr_to_byte_list(GoalExpr, GoalInfo, InstMap0, Info, Bytes,
+ !StackInfo) :-
+ (
+ GoalExpr = conj(ConjType, Goals),
expect(unify(ConjType, plain_conj), this_file,
"non-plain conjunction and declarative debugging"),
- conj_to_byte_list(Goals, InstMap0, Info, !StackInfo, ConjBytes),
+ conj_to_byte_list(Goals, InstMap0, Info, ConjBytes, !StackInfo),
Bytes = [goal_type_to_byte(goal_conj)] ++
- length_to_byte_list(Goals) ++ ConjBytes.
-goal_expr_to_byte_list(disj(Goals), _, InstMap0, Info, !StackInfo, Bytes) :-
- disj_to_byte_list(Goals, InstMap0, Info, !StackInfo, DisjBytes),
+ length_to_byte_list(Goals) ++ ConjBytes
+ ;
+ GoalExpr = disj(Goals),
+ disj_to_byte_list(Goals, InstMap0, Info, DisjBytes, !StackInfo),
Bytes = [goal_type_to_byte(goal_disj)] ++
- length_to_byte_list(Goals) ++ DisjBytes.
-goal_expr_to_byte_list(negation(Goal), _GoalInfo, InstMap0, Info, !StackInfo,
- Bytes) :-
- goal_to_byte_list(Goal, InstMap0, Info, !StackInfo, GoalBytes),
- Bytes = [goal_type_to_byte(goal_neg)] ++ GoalBytes.
-goal_expr_to_byte_list(if_then_else(_, Cond, Then, Else), _, InstMap0, Info,
- !StackInfo, Bytes) :-
+ length_to_byte_list(Goals) ++ DisjBytes
+ ;
+ GoalExpr = negation(SubGoal),
+ goal_to_byte_list(SubGoal, InstMap0, Info, SubGoalBytes, !StackInfo),
+ Bytes = [goal_type_to_byte(goal_neg)] ++ SubGoalBytes
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
Cond = hlds_goal(_, CondGoalInfo),
InstMapDelta = goal_info_get_instmap_delta(CondGoalInfo),
instmap.apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
- goal_to_byte_list(Cond, InstMap0, Info, !StackInfo, CondBytes),
- goal_to_byte_list(Then, InstMap1, Info, !StackInfo, ThenBytes),
- goal_to_byte_list(Else, InstMap0, Info, !StackInfo, ElseBytes),
+ goal_to_byte_list(Cond, InstMap0, Info, CondBytes, !StackInfo),
+ goal_to_byte_list(Then, InstMap1, Info, ThenBytes, !StackInfo),
+ goal_to_byte_list(Else, InstMap0, Info, ElseBytes, !StackInfo),
Bytes = [goal_type_to_byte(goal_ite)] ++
- CondBytes ++ ThenBytes ++ ElseBytes.
-goal_expr_to_byte_list(unify(_, _, _, Uni, _), GoalInfo, InstMap0, Info,
- !StackInfo, Bytes) :-
- atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info, !StackInfo,
- AtomicBytes, BoundVars),
+ CondBytes ++ ThenBytes ++ ElseBytes
+ ;
+ GoalExpr = unify(_, _, _, Uni, _),
+ atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info,
+ AtomicBytes, BoundVars, !StackInfo),
(
Uni = assign(Target, Source),
Bytes = [goal_type_to_byte(goal_assign)] ++
@@ -164,7 +167,7 @@
AtomicBytes
;
Uni = construct(Var, ConsId, Args, ArgModes, _, _, _),
- cons_id_to_byte_list(ConsId, !StackInfo, ConsIdBytes),
+ cons_id_to_byte_list(ConsId, ConsIdBytes, !StackInfo),
( list.all_true(lhs_final_is_ground(Info), ArgModes) ->
Bytes = [goal_type_to_byte(goal_construct)] ++
var_to_byte_list(Info, Var) ++
@@ -181,7 +184,7 @@
)
;
Uni = deconstruct(Var, ConsId, Args, ArgModes, _, _),
- cons_id_to_byte_list(ConsId, !StackInfo, ConsIdBytes),
+ cons_id_to_byte_list(ConsId, ConsIdBytes, !StackInfo),
( list.member(Var, BoundVars) ->
filter_input_args(Info, ArgModes, Args, MaybeArgs),
Bytes = [goal_type_to_byte(goal_partial_deconstruct)]++
@@ -205,30 +208,29 @@
;
Uni = complicated_unify(_, _, _),
unexpected(this_file, "goal_expr_to_byte_list: complicated_unify")
- ).
-goal_expr_to_byte_list(switch(SwitchVar, _, Cases), _, InstMap0, Info,
- !StackInfo, Bytes) :-
- cases_to_byte_list(Cases, InstMap0, Info, !StackInfo, CasesBytes),
+ )
+ ;
+ GoalExpr = switch(SwitchVar, _, Cases),
+ cases_to_byte_list(Cases, InstMap0, Info, CasesBytes, !StackInfo),
Bytes = [goal_type_to_byte(goal_switch)] ++
var_to_byte_list(Info, SwitchVar) ++
- length_to_byte_list(Cases) ++ CasesBytes.
-goal_expr_to_byte_list(scope(_, Goal), GoalInfo, InstMap0, Info, !StackInfo,
- Bytes) :-
- Goal = hlds_goal(_, InnerGoalInfo),
+ length_to_byte_list(Cases) ++ CasesBytes
+ ;
+ GoalExpr = scope(_, SubGoal),
+ SubGoal = hlds_goal(_, SuboalInfo),
OuterDetism = goal_info_get_determinism(GoalInfo),
- InnerDetism = goal_info_get_determinism(InnerGoalInfo),
+ InnerDetism = goal_info_get_determinism(SuboalInfo),
( InnerDetism = OuterDetism ->
MaybeCut = 0
;
MaybeCut = 1
),
- goal_to_byte_list(Goal, InstMap0, Info, !StackInfo, GoalBytes),
- Bytes = [goal_type_to_byte(goal_scope)] ++
- [MaybeCut] ++ GoalBytes.
-goal_expr_to_byte_list(generic_call(GenericCall, Args, _, _),
- GoalInfo, InstMap0, Info, !StackInfo, Bytes) :-
- atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info, !StackInfo,
- AtomicBytes, _),
+ goal_to_byte_list(SubGoal, InstMap0, Info, GoalBytes, !StackInfo),
+ Bytes = [goal_type_to_byte(goal_scope)] ++ [MaybeCut] ++ GoalBytes
+ ;
+ GoalExpr = generic_call(GenericCall, Args, _, _),
+ atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info,
+ AtomicBytes, _BoundVars, !StackInfo),
(
GenericCall = higher_order(PredVar, _, _, _),
Bytes = [goal_type_to_byte(goal_ho_call)] ++
@@ -244,7 +246,7 @@
AtomicBytes
;
GenericCall = event_call(EventName),
- string_to_byte_list(EventName, !StackInfo, EventNameBytes),
+ string_to_byte_list(EventName, EventNameBytes, !StackInfo),
Bytes = [goal_type_to_byte(goal_event_call)] ++
EventNameBytes ++
vars_to_byte_list(Info, Args) ++
@@ -259,17 +261,17 @@
;
unexpected(this_file, "goal_expr_to_byte_list: cast arity != 2")
)
- ).
-goal_expr_to_byte_list(plain_call(PredId, _, Args, Builtin, _, _),
- GoalInfo, InstMap0, Info, !StackInfo, Bytes) :-
- atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info, !StackInfo,
- AtomicBytes, _),
+ )
+ ;
+ GoalExpr = plain_call(PredId, _, Args, Builtin, _, _),
+ atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info,
+ AtomicBytes, _BoundVars, !StackInfo),
module_info_pred_info(Info ^ module_info, PredId, PredInfo),
ModuleSymName = pred_info_module(PredInfo),
ModuleName = sym_name_to_string(ModuleSymName),
PredName = pred_info_name(PredInfo),
- string_to_byte_list(ModuleName, !StackInfo, ModuleNameBytes),
- string_to_byte_list(PredName, !StackInfo, PredNameBytes),
+ string_to_byte_list(ModuleName, ModuleNameBytes, !StackInfo),
+ string_to_byte_list(PredName, PredNameBytes, !StackInfo),
(
Builtin = not_builtin,
Bytes = [goal_type_to_byte(goal_plain_call)] ++
@@ -286,17 +288,19 @@
PredNameBytes ++
vars_to_byte_list(Info, Args) ++
AtomicBytes
- ).
-goal_expr_to_byte_list(call_foreign_proc(_, _PredId, _, Args, _, _, _),
- GoalInfo, InstMap0, Info, !StackInfo, Bytes) :-
+ )
+ ;
+ GoalExpr = call_foreign_proc(_, _PredId, _, Args, _, _, _),
ArgVars = list.map(foreign_arg_var, Args),
- atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info, !StackInfo,
- AtomicBytes, _),
+ atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info,
+ AtomicBytes, _BoundVars, !StackInfo),
Bytes = [goal_type_to_byte(goal_foreign)] ++
- vars_to_byte_list(Info, ArgVars) ++ AtomicBytes.
-goal_expr_to_byte_list(shorthand(_), _, _, _, !StackInfo, _) :-
+ vars_to_byte_list(Info, ArgVars) ++ AtomicBytes
+ ;
+ GoalExpr = shorthand(_),
% these should have been expanded out by now
- unexpected(this_file, "goal_expr_to_byte_list: unexpected shorthand").
+ unexpected(this_file, "goal_expr_to_byte_list: unexpected shorthand")
+ ).
:- pred lhs_final_is_ground(prog_rep_info::in, uni_mode::in) is semidet.
@@ -328,11 +332,11 @@
%---------------------------------------------------------------------------%
:- pred atomic_goal_info_to_byte_list(hlds_goal_info::in, instmap::in,
- prog_rep_info::in, stack_layout_info::in, stack_layout_info::out,
- list(int)::out, list(prog_var)::out) is det.
+ prog_rep_info::in, list(int)::out, list(prog_var)::out,
+ stack_layout_info::in, stack_layout_info::out) is det.
-atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info, !StackInfo, Bytes,
- BoundVars) :-
+atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info, Bytes, BoundVars,
+ !StackInfo) :-
Detism = goal_info_get_determinism(GoalInfo),
Context = goal_info_get_context(GoalInfo),
term.context_file(Context, FileName0),
@@ -347,17 +351,32 @@
instmap_changed_vars(InstMap0, InstMap, Info ^ vartypes,
Info ^ module_info, ChangedVars),
set.to_sorted_list(ChangedVars, BoundVars),
- string_to_byte_list(FileName, !StackInfo, FileNameBytes),
+ string_to_byte_list(FileName, FileNameBytes, !StackInfo),
Bytes = [represent_determinism(Detism)] ++
FileNameBytes ++
lineno_to_byte_list(LineNo) ++
vars_to_byte_list(Info, BoundVars).
-:- pred cons_id_to_byte_list(cons_id::in,
- stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
+:- pred cons_id_and_arity_to_byte_list(cons_id::in, list(int)::out,
+ stack_layout_info::in, stack_layout_info::out) is det.
-cons_id_to_byte_list(SymName, !StackInfo, Bytes) :-
- string_to_byte_list(cons_id_rep(SymName), !StackInfo, Bytes).
+cons_id_and_arity_to_byte_list(ConsId, ConsIdBytes, !StackInfo) :-
+ cons_id_to_byte_list(ConsId, FunctorBytes, !StackInfo),
+ MaybeArity = cons_id_maybe_arity(ConsId),
+ (
+ MaybeArity = yes(Arity)
+ ;
+ MaybeArity = no,
+ Arity = 0
+ ),
+ short_to_byte_list(Arity, ArityBytes),
+ ConsIdBytes = FunctorBytes ++ ArityBytes.
+
+:- pred cons_id_to_byte_list(cons_id::in, list(int)::out,
+ stack_layout_info::in, stack_layout_info::out) is det.
+
+cons_id_to_byte_list(SymName, Bytes, !StackInfo) :-
+ string_to_byte_list(cons_id_rep(SymName), Bytes, !StackInfo).
:- func cons_id_rep(cons_id) = string.
@@ -384,48 +403,45 @@
%---------------------------------------------------------------------------%
:- pred conj_to_byte_list(hlds_goals::in, instmap::in, prog_rep_info::in,
- stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
+ list(int)::out, stack_layout_info::in, stack_layout_info::out) is det.
-conj_to_byte_list([], _, _, !StackInfo, []).
-conj_to_byte_list([Goal | Goals], InstMap0, Info, !StackInfo, Bytes) :-
- goal_to_byte_list(Goal, InstMap0, Info, !StackInfo, GoalBytes),
+conj_to_byte_list([], _, _, [], !StackInfo).
+conj_to_byte_list([Goal | Goals], InstMap0, Info, Bytes, !StackInfo) :-
+ goal_to_byte_list(Goal, InstMap0, Info, GoalBytes, !StackInfo),
Goal = hlds_goal(_, GoalInfo),
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
instmap.apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
- conj_to_byte_list(Goals, InstMap1, Info, !StackInfo, GoalsBytes),
+ conj_to_byte_list(Goals, InstMap1, Info, GoalsBytes, !StackInfo),
Bytes = GoalBytes ++ GoalsBytes.
%---------------------------------------------------------------------------%
:- pred disj_to_byte_list(hlds_goals::in, instmap::in, prog_rep_info::in,
- stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
+ list(int)::out, stack_layout_info::in, stack_layout_info::out) is det.
-disj_to_byte_list([], _, _, !StackInfo, []).
-disj_to_byte_list([Goal | Goals], InstMap0, Info, !StackInfo, Bytes) :-
- goal_to_byte_list(Goal, InstMap0, Info, !StackInfo, GoalBytes),
- disj_to_byte_list(Goals, InstMap0, Info, !StackInfo, GoalsBytes),
+disj_to_byte_list([], _, _, [], !StackInfo).
+disj_to_byte_list([Goal | Goals], InstMap0, Info, Bytes, !StackInfo) :-
+ goal_to_byte_list(Goal, InstMap0, Info, GoalBytes, !StackInfo),
+ disj_to_byte_list(Goals, InstMap0, Info, GoalsBytes, !StackInfo),
Bytes = GoalBytes ++ GoalsBytes.
%---------------------------------------------------------------------------%
:- pred cases_to_byte_list(list(case)::in, instmap::in, prog_rep_info::in,
- stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
+ list(int)::out, stack_layout_info::in, stack_layout_info::out) is det.
-cases_to_byte_list([], _, _, !StackInfo, []).
-cases_to_byte_list([case(ConsId, Goal) | Cases], InstMap0, Info, !StackInfo,
- Bytes) :-
- cons_id_to_byte_list(ConsId, !StackInfo, ConsIdBytes),
- MaybeArity = cons_id_maybe_arity(ConsId),
- (
- MaybeArity = yes(Arity)
- ;
- MaybeArity = no,
- Arity = 0
- ),
- short_to_byte_list(Arity, ArityBytes),
- goal_to_byte_list(Goal, InstMap0, Info, !StackInfo, GoalBytes),
- cases_to_byte_list(Cases, InstMap0, Info, !StackInfo, CasesBytes),
- Bytes = ConsIdBytes ++ ArityBytes ++ GoalBytes ++ CasesBytes.
+cases_to_byte_list([], _, _, [], !StackInfo).
+cases_to_byte_list([Case | Cases], InstMap0, Info, Bytes, !StackInfo) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ cons_id_and_arity_to_byte_list(MainConsId, MainConsIdBytes, !StackInfo),
+ list.map_foldl(cons_id_and_arity_to_byte_list, OtherConsIds,
+ OtherConsIdsByteLists, !StackInfo),
+ list.condense(OtherConsIdsByteLists, OtherConsIdsBytes),
+ NumOtherConsIdBytes = length_to_byte_list(OtherConsIds),
+ goal_to_byte_list(Goal, InstMap0, Info, GoalBytes, !StackInfo),
+ cases_to_byte_list(Cases, InstMap0, Info, CasesBytes, !StackInfo),
+ Bytes = MainConsIdBytes ++ NumOtherConsIdBytes ++ OtherConsIdsBytes
+ ++ GoalBytes ++ CasesBytes.
%---------------------------------------------------------------------------%
@@ -440,10 +456,10 @@
% but we here use them to represent unsigned quantities. This effectively
% halves their range.
-:- pred string_to_byte_list(string::in,
- stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
+:- pred string_to_byte_list(string::in, list(int)::out,
+ stack_layout_info::in, stack_layout_info::out) is det.
-string_to_byte_list(String, !StackInfo, Bytes) :-
+string_to_byte_list(String, Bytes, !StackInfo) :-
stack_layout.lookup_string_in_table(String, Index, !StackInfo),
int32_to_byte_list(Index, Bytes).
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.115
diff -u -b -r1.115 purity.m
--- compiler/purity.m 23 Nov 2007 07:35:23 -0000 1.115
+++ compiler/purity.m 23 Nov 2007 09:22:22 -0000
@@ -927,9 +927,11 @@
purity_info::in, purity_info::out) is det.
compute_cases_purity([], [], !Purity, !ContainsTrace, !Info).
-compute_cases_purity([case(Ctor, Goal0) | Cases0], [case(Ctor, Goal) | Cases],
- !Purity, !ContainsTrace, !Info) :-
+compute_cases_purity([Case0 | Cases0], [Case | Cases], !Purity, !ContainsTrace,
+ !Info) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
compute_goal_purity(Goal0, Goal, GoalPurity, GoalContainsTrace, !Info),
+ Case = case(MainConsId, OtherConsIds, Goal),
!:Purity = worst_purity(GoalPurity, !.Purity),
!:ContainsTrace = worst_contains_trace(GoalContainsTrace, !.ContainsTrace),
compute_cases_purity(Cases0, Cases, !Purity, !ContainsTrace, !Info).
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.122
diff -u -b -r1.122 quantification.m
--- compiler/quantification.m 23 Nov 2007 07:35:23 -0000 1.122
+++ compiler/quantification.m 23 Nov 2007 08:06:38 -0000
@@ -893,9 +893,11 @@
list(set_of_var)::in, list(set_of_var)::out) is det.
implicitly_quantify_cases([], [], !Info, !NonLocalVarSets).
-implicitly_quantify_cases([case(Cons, Goal0) | Cases0],
- [case(Cons, Goal) | Cases], !Info, !NonLocalVarSets) :-
+implicitly_quantify_cases([Case0 | Cases0], [Case | Cases],
+ !Info, !NonLocalVarSets) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
implicitly_quantify_goal_quant_info(Goal0, Goal, !Info),
+ Case = case(MainConsId, OtherConsIds, Goal),
get_nonlocals(!.Info, GoalNonLocalVars),
!:NonLocalVarSets = [GoalNonLocalVars | !.NonLocalVarSets],
implicitly_quantify_cases(Cases0, Cases, !Info, !NonLocalVarSets).
@@ -1043,10 +1045,10 @@
compute_case_vars(_, [], !Sets, !LambdaSets).
compute_case_vars(NonLocalsToRecompute, [Case | Cases], !Sets, !LambdaSets) :-
- Case = case(_Cons, hlds_goal(Goal, _GoalInfo)),
+ Case = case(_MainConsId, _OtherConsIds, hlds_goal(GoalExpr, _GoalInfo)),
EmptySet = init,
EmptyLambdaSet = init,
- goal_vars_2(NonLocalsToRecompute, Goal,
+ goal_vars_2(NonLocalsToRecompute, GoalExpr,
EmptySet, GoalSet, EmptyLambdaSet, GoalLambdaSet),
!:Sets = [GoalSet | !.Sets],
!:LambdaSets = [GoalLambdaSet | !.LambdaSets],
Index: compiler/rbmm.actual_region_arguments.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.actual_region_arguments.m,v
retrieving revision 1.1
diff -u -b -r1.1 rbmm.actual_region_arguments.m
--- compiler/rbmm.actual_region_arguments.m 22 Oct 2007 02:30:31 -0000 1.1
+++ compiler/rbmm.actual_region_arguments.m 23 Nov 2007 10:03:06 -0000
@@ -200,7 +200,7 @@
record_actual_region_arguments_case(ModuleInfo, PPId, RptaInfoTable,
ConstantRTable, DeadRTable, BornRTable, Case, !ActualRegionArgProc) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
record_actual_region_arguments_goal(ModuleInfo, PPId, RptaInfoTable,
ConstantRTable, DeadRTable, BornRTable, Goal, !ActualRegionArgProc).
Index: compiler/rbmm.add_rbmm_goal_infos.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.add_rbmm_goal_infos.m,v
retrieving revision 1.1
diff -u -b -r1.1 rbmm.add_rbmm_goal_infos.m
--- compiler/rbmm.add_rbmm_goal_infos.m 6 Sep 2007 12:45:24 -0000 1.1
+++ compiler/rbmm.add_rbmm_goal_infos.m 23 Nov 2007 10:03:54 -0000
@@ -282,7 +282,7 @@
;
% The process here is similar to the above code for disjunctions.
Cases = [Case | _],
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
Goal = hlds_goal(_, CaseInfo),
CaseRbmmInfo = goal_info_get_rbmm(CaseInfo),
CaseRbmmInfo = rbmm_goal_info(Created, Removed, Carried, _, _),
@@ -290,7 +290,7 @@
set.init),
list.foldl(
(pred(C::in, Gs0::in, Gs::out) is det :-
- C = case(_, G),
+ C = case(_, _, G),
Gs = [G | Gs0]
), Cases, [], Goals),
compute_rbmm_info_goals(Goals, SwitchRbmmInfo0, SwitchRbmmInfo),
@@ -489,11 +489,11 @@
collect_rbmm_goal_info_case(ModuleInfo, ProcInfo, Graph,
ActualRegionsArgsProc, ResurRenamingProc, IteRenamingProc,
NameToRegionVarProc, !Case) :-
- !.Case = case(Functor, Goal0),
+ !.Case = case(MainConsId, OtherConsIds, Goal0),
collect_rbmm_goal_info_goal(ModuleInfo, ProcInfo, Graph,
ActualRegionsArgsProc, ResurRenamingProc, IteRenamingProc,
NameToRegionVarProc, Goal0, Goal),
- !:Case = case(Functor, Goal).
+ !:Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
Index: compiler/rbmm.condition_renaming.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.condition_renaming.m,v
retrieving revision 1.6
diff -u -b -r1.6 rbmm.condition_renaming.m
--- compiler/rbmm.condition_renaming.m 12 Nov 2007 03:52:44 -0000 1.6
+++ compiler/rbmm.condition_renaming.m 23 Nov 2007 10:04:20 -0000
@@ -320,7 +320,7 @@
collect_non_local_and_in_cond_regions_case(Graph, LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc, Case,
!NonLocalRegionProc, !InCondRegionsProc) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
collect_non_local_and_in_cond_regions_goal(Graph,
LRBeforeProc, LRAfterProc, ResurRenamingProc, ResurRenamingAnnoProc,
Goal, !NonLocalRegionProc, !InCondRegionsProc).
@@ -538,7 +538,7 @@
collect_non_local_regions_in_ite_case(Graph, LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc, Case, !NonLocalRegionProc) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
collect_non_local_regions_in_ite(Graph, LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc, Goal, !NonLocalRegionProc).
@@ -711,7 +711,7 @@
collect_regions_created_in_condition_case(Graph,
LRBeforeProc, LRAfterProc, ResurRenamingProc, ResurRenamingAnnoProc,
Case, !InCondRegionsProc) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
collect_regions_created_in_condition(Graph, LRBeforeProc, LRAfterProc,
ResurRenamingProc, ResurRenamingAnnoProc, Goal, !InCondRegionsProc).
@@ -859,7 +859,7 @@
collect_ite_renaming_case(IteRenamedRegionProc, Graph, Case,
!IteRenamingProc) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
collect_ite_renaming_goal(IteRenamedRegionProc, Graph, Goal,
!IteRenamingProc).
@@ -969,7 +969,7 @@
collect_ite_renaming_in_condition_case(IteRenamedRegionProc, Graph, Case,
!IteRenamingProc) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
collect_ite_renaming_in_condition(IteRenamedRegionProc, Graph, Goal,
!IteRenamingProc).
Index: compiler/rbmm.execution_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.execution_path.m,v
retrieving revision 1.5
diff -u -b -r1.5 rbmm.execution_path.m
--- compiler/rbmm.execution_path.m 23 Jul 2007 05:06:13 -0000 1.5
+++ compiler/rbmm.execution_path.m 23 Nov 2007 10:06:32 -0000
@@ -211,14 +211,16 @@
execution_paths_covered_cases(_, _, [], _, []).
execution_paths_covered_cases(ProcInfo, Switch, [Case | Cases], !ExecPaths) :-
- Case = case(ConsId, CaseGoal),
+ Case = case(MainConsId, OtherConsIds, CaseGoal),
+ expect(unify(OtherConsIds, []), this_file,
+ "NYI: execution_paths_covered_cases for multi-cons-id cases"),
Switch = hlds_goal(_SwitchExpr, Info),
ProgPoint = program_point_init(Info),
% Handle the unification on the switch var if it has been removed.
% We add a dummy program point for this unification.
(
- ConsId = cons(_SymName, Arity),
+ MainConsId = cons(_SymName, Arity),
( Arity = 0 ->
append_to_each_execution_path(!.ExecPaths,
[[pair(ProgPoint, Switch)]], ExecPathsBeforeCase)
@@ -226,25 +228,25 @@
ExecPathsBeforeCase = !.ExecPaths
)
;
- ( ConsId = int_const(_Int)
- ; ConsId = string_const(_String)
- ; ConsId = float_const(_Float)
+ ( MainConsId = int_const(_Int)
+ ; MainConsId = string_const(_String)
+ ; MainConsId = float_const(_Float)
),
% need to add a dummy pp
append_to_each_execution_path(!.ExecPaths,
[[pair(ProgPoint, Switch)]], ExecPathsBeforeCase)
;
- ( ConsId = pred_const(_, _)
- ; ConsId = type_ctor_info_const(_, _, _)
- ; ConsId = base_typeclass_info_const(_, _, _, _)
- ; ConsId = type_info_cell_constructor(_)
- ; ConsId = typeclass_info_cell_constructor
- ; ConsId = tabling_info_const(_)
- ; ConsId = deep_profiling_proc_layout(_)
- ; ConsId = table_io_decl(_)
+ ( MainConsId = pred_const(_, _)
+ ; MainConsId = type_ctor_info_const(_, _, _)
+ ; MainConsId = base_typeclass_info_const(_, _, _, _)
+ ; MainConsId = type_info_cell_constructor(_)
+ ; MainConsId = typeclass_info_cell_constructor
+ ; MainConsId = tabling_info_const(_)
+ ; MainConsId = deep_profiling_proc_layout(_)
+ ; MainConsId = table_io_decl(_)
),
- unexpected(this_file, "execution_paths_covered_cases: new cons_id "
- ++ "encountered")
+ unexpected(this_file,
+ "execution_paths_covered_cases: new cons_id encountered")
),
execution_paths_covered_goal(ProcInfo, CaseGoal,
ExecPathsBeforeCase, ExecPathsCase),
@@ -252,8 +254,8 @@
!.ExecPaths, ExecPathsCases),
!:ExecPaths = ExecPathsCase ++ ExecPathsCases.
- % extend each execution path in the first list with each in the
- % second list, all the extended execution paths are put in the third list
+ % Extend each execution path in the first list with each in the
+ % second list, all the extended execution paths are put in the third list.
%
:- pred append_to_each_execution_path(list(execution_path)::in,
list(execution_path)::in, list(execution_path)::out) is det.
Index: compiler/rbmm.points_to_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.points_to_analysis.m,v
retrieving revision 1.6
diff -u -b -r1.6 rbmm.points_to_analysis.m
--- compiler/rbmm.points_to_analysis.m 23 Jul 2007 05:06:14 -0000 1.6
+++ compiler/rbmm.points_to_analysis.m 23 Nov 2007 10:06:46 -0000
@@ -173,7 +173,7 @@
:- pred intra_analyse_case(case::in, rpta_info::in, rpta_info::out) is det.
intra_analyse_case(Case, !RptaInfo) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
intra_analyse_goal(Goal, !RptaInfo).
%-----------------------------------------------------------------------------%
@@ -432,7 +432,7 @@
rpta_fixpoint_table::out, rpta_info::in, rpta_info::out) is det.
inter_analyse_case(ModuleInfo, InfoTable, Case, !FPtable, !RptaInfo) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPtable, !RptaInfo).
% Unifications are ignored in interprocedural analysis
Index: compiler/rbmm.region_transformation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.region_transformation.m,v
retrieving revision 1.4
diff -u -b -r1.4 rbmm.region_transformation.m
--- compiler/rbmm.region_transformation.m 6 Sep 2007 12:45:24 -0000 1.4
+++ compiler/rbmm.region_transformation.m 23 Nov 2007 10:08:20 -0000
@@ -628,13 +628,16 @@
region_transform_case(ModuleInfo, Graph, ResurRenamingProc,
IteRenamingProc, ActualRegionArgProc, RegionInstructionProc,
ResurRenamingAnnoProc, IteRenamingAnnoProc, Switch,
- case(ConsId, !.Goal), case(ConsId, !:Goal),
+ case(MainConsId, OtherConsIds, !.Goal),
+ case(MainConsId, OtherConsIds, !:Goal),
!NameToVar, !VarSet, !VarTypes) :-
+ expect(unify(OtherConsIds, []), this_file,
+ "NYI: region_transform_case for multi-cons-id cases"),
(
- ( ConsId = cons(_, 0)
- ; ConsId = int_const(_)
- ; ConsId = string_const(_)
- ; ConsId = float_const(_)
+ ( MainConsId = cons(_, 0)
+ ; MainConsId = int_const(_)
+ ; MainConsId = string_const(_)
+ ; MainConsId = float_const(_)
),
Switch = hlds_goal(switch(_, _, _), Info)
->
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.45
diff -u -b -r1.45 recompilation.usage.m
--- compiler/recompilation.usage.m 14 Nov 2007 04:24:50 -0000 1.45
+++ compiler/recompilation.usage.m 25 Nov 2007 12:04:26 -0000
@@ -1055,7 +1055,8 @@
:- pred find_items_used_by_type_body(hlds_type_body::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
-find_items_used_by_type_body(hlds_du_type(Ctors, _, _, _, _, _, _), !Info) :-
+find_items_used_by_type_body(hlds_du_type(Ctors, _, _, _, _, _, _, _),
+ !Info) :-
list.foldl(find_items_used_by_ctor, Ctors, !Info).
find_items_used_by_type_body(hlds_eqv_type(Type), !Info) :-
find_items_used_by_type(Type, !Info).
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.75
diff -u -b -r1.75 saved_vars.m
--- compiler/saved_vars.m 7 Aug 2007 07:10:04 -0000 1.75
+++ compiler/saved_vars.m 23 Nov 2007 09:40:09 -0000
@@ -481,9 +481,11 @@
prog_var::in, slot_info::in, slot_info::out) is det.
push_into_cases_rename([], [], _Construct, _Var, !SlotInfo).
-push_into_cases_rename([case(ConsId, Goal0) | Cases0],
- [case(ConsId, Goal) | Cases], Construct, Var, !SlotInfo) :-
+push_into_cases_rename([Case0 | Cases0], [Case | Cases], Construct, Var,
+ !SlotInfo) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
push_into_goal_rename(Goal0, Goal, Construct, Var, !SlotInfo),
+ Case = case(MainConsId, OtherConsIds, Goal),
push_into_cases_rename(Cases0, Cases, Construct, Var, !SlotInfo).
%-----------------------------------------------------------------------------%
@@ -505,9 +507,10 @@
slot_info::in, slot_info::out) is det.
saved_vars_in_switch([], [], !SlotInfo).
-saved_vars_in_switch([case(Cons, Goal0) | Cases0],
- [case(Cons, Goal) | Cases], !SlotInfo) :-
+saved_vars_in_switch([Case0 | Cases0], [Case | Cases], !SlotInfo) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
saved_vars_in_goal(Goal0, Goal, !SlotInfo),
+ Case = case(MainConsId, OtherConsIds, Goal),
saved_vars_in_switch(Cases0, Cases, !SlotInfo).
%-----------------------------------------------------------------------------%
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.221
diff -u -b -r1.221 simplify.m
--- compiler/simplify.m 23 Nov 2007 07:35:24 -0000 1.221
+++ compiler/simplify.m 11 Dec 2007 16:00:12 -0000
@@ -593,9 +593,10 @@
PredInfo, ProcInfo, ModuleInfo2, ModuleInfo3),
simplify_info_set_module_info(ModuleInfo3, !Info),
- simplify_info_get_det_info(!.Info, DetInfo),
- det_infer_goal(Goal3, Goal, InstMap0, SolnContext, [], no, DetInfo,
- _, _, [], _)
+ simplify_info_get_det_info(!.Info, DetInfo0),
+ det_infer_goal(Goal3, Goal, InstMap0, SolnContext, [], no,
+ _, _, DetInfo0, DetInfo, [], _),
+ simplify_info_set_det_info(DetInfo, !Info)
;
Goal = Goal3
).
@@ -1024,13 +1025,14 @@
Context = goal_info_get_context(GoalInfo0),
hlds_goal(GoalExpr, GoalInfo) = fail_goal_with_context(Context)
;
- Cases = [case(ConsId, SingleGoal)],
+ Cases = [case(MainConsId, OtherConsIds, SingleGoal)],
% A singleton switch is equivalent to the goal itself with a
% possibly can_fail unification with the functor on the front.
- Arity = cons_id_arity(ConsId),
+ MainConsIdArity = cons_id_arity(MainConsId),
(
SwitchCanFail = can_fail,
- MaybeConsIds \= yes([ConsId])
+ OtherConsIds = [],
+ MaybeConsIds \= yes([MainConsId])
->
% Don't optimize in the case of an existentially typed constructor
% because currently create_test_unification does not handle the
@@ -1040,7 +1042,7 @@
simplify_info_get_var_types(!.Info, VarTypes1),
map.lookup(VarTypes1, Var, Type),
simplify_info_get_module_info(!.Info, ModuleInfo1),
- ( type_util.is_existq_cons(ModuleInfo1, Type, ConsId) ->
+ ( type_util.is_existq_cons(ModuleInfo1, Type, MainConsId) ->
GoalExpr = switch(Var, SwitchCanFail, Cases),
NonLocals = goal_info_get_nonlocals(GoalInfo0),
simplify_info_get_var_types(!.Info, VarTypes),
@@ -1049,7 +1051,8 @@
simplify_info_set_module_info(ModuleInfo2, !Info),
goal_info_set_instmap_delta(NewDelta, GoalInfo0, GoalInfo)
;
- create_test_unification(Var, ConsId, Arity, UnifyGoal, !Info),
+ create_test_unification(Var, MainConsId, MainConsIdArity,
+ UnifyGoal, !Info),
% Conjoin the test and the rest of the case.
goal_to_conj_list(SingleGoal, SingleGoalConj),
@@ -1061,8 +1064,9 @@
set.insert(NonLocals0, Var, NonLocals),
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
simplify_info_get_instmap(!.Info, InstMap),
- instmap_delta_bind_var_to_functor(Var, Type, ConsId, InstMap,
- InstMapDelta0, InstMapDelta, ModuleInfo1, ModuleInfo),
+ instmap_delta_bind_var_to_functor(Var, Type, MainConsId,
+ InstMap, InstMapDelta0, InstMapDelta,
+ ModuleInfo1, ModuleInfo),
simplify_info_set_module_info(ModuleInfo, !Info),
CaseDetism = goal_info_get_determinism(GoalInfo0),
det_conjunction_detism(detism_semi, CaseDetism, Detism),
@@ -1101,7 +1105,7 @@
list.length(Cases, CasesLength),
( CasesLength \= Cases0Length ->
% If we pruned some cases, variables used by those cases may no longer
- % be non-local to the switch. Also, the determinism may have changed
+ % be nonlocal to the switch. Also, the determinism may have changed
% (especially if we pruned all the cases). If the switch now can't
% succeed, it is necessary to recompute instmap_deltas and rerun
% determinism analysis to avoid aborts in the code generator because
@@ -1616,8 +1620,9 @@
can_switch_on_type(TypeBody) = CanSwitchOnType :-
(
- TypeBody = hlds_du_type(_Ctors, _TagValues, IsEnumOrDummy,
- _UserEq, _ReservedTag, _ReservedAddr, _MaybeForeignType),
+ TypeBody = hlds_du_type(_Ctors, _TagValues, _CheaperTagTest,
+ IsEnumOrDummy, _UserEq, _ReservedTag, _ReservedAddr,
+ _MaybeForeignType),
% We don't care about _UserEq, since the unification with *any* functor
% of the type indicates that we are deconstructing the physical
% representation, not the logical value.
@@ -2997,12 +3002,12 @@
simplify_switch(Var, [Case0 | Cases0], RevCases0, Cases, !InstMaps,
!CanFail, Info0, !Info, !IO) :-
simplify_info_get_instmap(Info0, InstMap0),
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
simplify_info_get_module_info(!.Info, ModuleInfo0),
simplify_info_get_var_types(!.Info, VarTypes),
map.lookup(VarTypes, Var, Type),
- instmap.bind_var_to_functor(Var, Type, ConsId, InstMap0, InstMap1,
- ModuleInfo0, ModuleInfo1),
+ bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
+ InstMap0, InstMap1, ModuleInfo0, ModuleInfo1),
simplify_info_set_module_info(ModuleInfo1, !Info),
simplify_info_set_instmap(InstMap1, !Info),
simplify_goal(Goal0, Goal, !Info, !IO),
@@ -3012,7 +3017,7 @@
RevCases = RevCases0,
!:CanFail = can_fail
;
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
Goal = hlds_goal(_, GoalInfo),
% Make sure the switched on variable appears in the instmap delta.
@@ -3023,7 +3028,7 @@
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo),
simplify_info_get_module_info(!.Info, ModuleInfo2),
- instmap_delta_bind_var_to_functor(Var, Type, ConsId,
+ instmap_delta_bind_var_to_functors(Var, Type, MainConsId, OtherConsIds,
InstMap0, InstMapDelta0, InstMapDelta, ModuleInfo2, ModuleInfo),
simplify_info_set_module_info(ModuleInfo, !Info),
@@ -3340,9 +3345,9 @@
case_list_contains_trace([], [], !ContainsTrace).
case_list_contains_trace([Case0 | Cases0], [Case | Cases], !ContainsTrace) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
goal_contains_trace(Goal0, Goal, GoalContainsTrace),
- Case = case(ConsId, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
!:ContainsTrace = worst_contains_trace(GoalContainsTrace, !.ContainsTrace),
case_list_contains_trace(Cases0, Cases, !ContainsTrace).
@@ -3561,7 +3566,7 @@
simplify_info_set_common_info(Common, Info, Info ^ common_info := Common).
simplify_info_set_varset(VarSet, Info, Info ^ varset := VarSet).
simplify_info_set_var_types(VarTypes, Info, Info ^ det_info := DetInfo) :-
- det_info_set_vartypes(Info ^ det_info, VarTypes, DetInfo).
+ det_info_set_vartypes(VarTypes, Info ^ det_info, DetInfo).
simplify_info_set_requantify(Info, Info ^ requantify := yes).
simplify_info_set_recompute_atomic(Info, Info ^ recompute_atomic := yes).
simplify_info_set_rerun_det(Info, Info ^ rerun_det := yes).
@@ -3605,7 +3610,7 @@
simplify_info_set_module_info(ModuleInfo, !Info) :-
simplify_info_get_det_info(!.Info, DetInfo0),
- det_info_set_module_info(DetInfo0, ModuleInfo, DetInfo),
+ det_info_set_module_info(ModuleInfo, DetInfo0, DetInfo),
simplify_info_set_det_info(DetInfo, !Info).
simplify_info_apply_type_substitution(TSubst, !Info) :-
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.54
diff -u -b -r1.54 size_prof.m
--- compiler/size_prof.m 23 Nov 2007 07:35:24 -0000 1.54
+++ compiler/size_prof.m 23 Nov 2007 09:07:54 -0000
@@ -578,11 +578,11 @@
!:Info = !.Info ^ type_ctor_map := TypeCtorMap0,
!:Info = !.Info ^ rev_type_ctor_map := RevTypeCtorMap0,
!:Info = !.Info ^ known_size_map := KnownSizeMap0,
- First0 = case(FirstConsId, FirstGoal0),
+ First0 = case(FirstMainConsId, FirstOtherConsIds, FirstGoal0),
process_goal(FirstGoal0, FirstGoal, !Info),
TypeInfoMapFirst = !.Info ^ type_info_map,
KnownSizeMapFirst = !.Info ^ known_size_map,
- First = case(FirstConsId, FirstGoal),
+ First = case(FirstMainConsId, FirstOtherConsIds, FirstGoal),
(
Later0 = [Head0 | Tail0],
map.union(select_first, TargetTypeInfoMap,
Index: compiler/ssdebug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ssdebug.m,v
retrieving revision 1.14
diff -u -b -r1.14 ssdebug.m
--- compiler/ssdebug.m 5 Dec 2007 05:38:54 -0000 1.14
+++ compiler/ssdebug.m 7 Dec 2007 01:48:20 -0000
@@ -810,8 +810,8 @@
SSDBModule = mercury_ssdb_builtin_module,
ConsIdDoRetry = cons(qualified(SSDBModule, "do_retry"), 0),
ConsIdDoNotRetry = cons(qualified(SSDBModule, "do_not_retry"), 0),
- CaseDoRetry = case(ConsIdDoRetry, DoRetryGoal),
- CaseDoNotRetry = case(ConsIdDoNotRetry, DoNotRetryGoal),
+ CaseDoRetry = case(ConsIdDoRetry, [], DoRetryGoal),
+ CaseDoNotRetry = case(ConsIdDoNotRetry, [], DoNotRetryGoal),
SwitchGoal = hlds_goal(
switch(SwitchVar, cannot_fail, [CaseDoRetry, CaseDoNotRetry]),
GoalInfo).
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.106
diff -u -b -r1.106 store_alloc.m
--- compiler/store_alloc.m 23 Nov 2007 07:35:25 -0000 1.106
+++ compiler/store_alloc.m 23 Nov 2007 09:39:28 -0000
@@ -317,13 +317,14 @@
set(prog_var)::in, store_alloc_info::in) is det.
store_alloc_in_cases([], [], !Liveness, _, [], _, _).
-store_alloc_in_cases([case(Cons, Goal0) | Goals0], [case(Cons, Goal) | Goals],
- Liveness0, Liveness,
+store_alloc_in_cases([Case0 | Cases0], [Case | Cases], Liveness0, Liveness,
LastLocns0, [LastLocnsGoal | LastLocnsCases],
ResumeVars0, StoreAllocInfo) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
store_alloc_in_goal(Goal0, Goal, Liveness0, Liveness,
LastLocns0, LastLocnsGoal, ResumeVars0, StoreAllocInfo),
- store_alloc_in_cases(Goals0, Goals, Liveness0, _Liveness1,
+ Case = case(MainConsId, OtherConsIds, Goal),
+ store_alloc_in_cases(Cases0, Cases, Liveness0, _Liveness1,
LastLocns0, LastLocnsCases, ResumeVars0, StoreAllocInfo).
%-----------------------------------------------------------------------------%
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.63
diff -u -b -r1.63 stratify.m
--- compiler/stratify.m 23 Nov 2007 07:35:26 -0000 1.63
+++ compiler/stratify.m 23 Nov 2007 10:02:37 -0000
@@ -251,7 +251,7 @@
first_order_check_case_list([], _, _, _, _, !ModuleInfo, !IO).
first_order_check_case_list([Case | Goals], Negated, WholeScc, ThisPredProcId,
Error, !ModuleInfo, !IO) :-
- Case = case(_ConsId, hlds_goal(GoalExpr, GoalInfo)),
+ Case = case(_, _, hlds_goal(GoalExpr, GoalInfo)),
first_order_check_goal(GoalExpr, GoalInfo, Negated, WholeScc,
ThisPredProcId, Error, !ModuleInfo, !IO),
first_order_check_case_list(Goals, Negated, WholeScc, ThisPredProcId,
@@ -407,7 +407,7 @@
higher_order_check_case_list([], _, _, _, _, _, !ModuleInfo, !IO).
higher_order_check_case_list([Case | Goals], Negated, WholeScc, ThisPredProcId,
HighOrderLoops, Error, !ModuleInfo, !IO) :-
- Case = case(_ConsId, hlds_goal(GoalExpr, GoalInfo)),
+ Case = case(_, _, hlds_goal(GoalExpr, GoalInfo)),
higher_order_check_goal(GoalExpr, GoalInfo, Negated, WholeScc,
ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
higher_order_check_case_list(Goals, Negated, WholeScc, ThisPredProcId,
@@ -780,7 +780,7 @@
check_case_list([], !Calls, !HasAT, !CallsHO).
check_case_list([Case | Goals], !Calls, !HasAT, !CallsHO) :-
- Case = case(_ConsId, hlds_goal(GoalExpr, _)),
+ Case = case(_, _, hlds_goal(GoalExpr, _)),
check_goal1(GoalExpr, !Calls, !HasAT, !CallsHO),
check_case_list(Goals, !Calls, !HasAT, !CallsHO).
@@ -859,7 +859,7 @@
check_case_list([], !Calls).
check_case_list([Case | Goals], !Calls) :-
- Case = case(_ConsId, hlds_goal(GoalExpr, _)),
+ Case = case(_, _, hlds_goal(GoalExpr, _)),
get_called_procs(GoalExpr, !Calls),
check_case_list(Goals, !Calls).
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.63
diff -u -b -r1.63 string_switch.m
--- compiler/string_switch.m 27 Sep 2007 10:42:06 -0000 1.63
+++ compiler/string_switch.m 14 Dec 2007 05:15:57 -0000
@@ -17,15 +17,16 @@
:- module ll_backend.string_switch.
:- interface.
-:- import_module backend_libs.switch_util.
:- import_module hlds.code_model.
:- import_module hlds.hlds_goal.
:- import_module ll_backend.code_info.
:- import_module ll_backend.llds.
:- import_module parse_tree.prog_data.
-:- pred generate_string_switch(cases_list::in, prog_var::in, code_model::in,
- can_fail::in, hlds_goal_info::in, label::in,
+:- 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,
branch_end::in, branch_end::out, code_tree::out,
code_info::in, code_info::out) is det.
@@ -35,16 +36,17 @@
:- implementation.
:- import_module backend_libs.builtin_ops.
+:- import_module backend_libs.switch_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_llds.
:- import_module libs.compiler_util.
:- import_module libs.tree.
:- import_module ll_backend.code_gen.
+:- import_module ll_backend.switch_case.
:- import_module ll_backend.trace_gen.
:- import_module int.
-:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
@@ -52,11 +54,22 @@
%-----------------------------------------------------------------------------%
-generate_string_switch(Cases, Var, CodeModel, _CanFail, SwitchGoalInfo,
- EndLabel, !MaybeEnd, Code, !CI) :-
- produce_variable(Var, VarCode, VarRval, !CI),
+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, StringReg, !CI),
+ release_reg(SlotReg, !CI),
+ release_reg(StringReg, !CI),
+
get_next_label(LoopLabel, !CI),
get_next_label(FailLabel, !CI),
get_next_label(JumpLabel, !CI),
@@ -71,36 +84,39 @@
TableSize = 2 * RoundedNumCases,
HashMask = TableSize - 1,
+ remember_position(!.CI, BranchStart),
+ Params = represent_params(VarName, SwitchGoalInfo, CodeModel, BranchStart,
+ EndLabel),
+
% Compute the hash table.
- switch_util.string_hash_cases(Cases, HashMask, HashValsMap),
+ map.init(CaseLabelMap0),
+ switch_util.string_hash_cases(Cases, HashMask,
+ represent_tagged_case_for_llds(Params),
+ CaseLabelMap0, CaseLabelMap, !MaybeEnd, !CI, HashValsMap),
map.to_assoc_list(HashValsMap, HashValsList),
- switch_util.calc_hash_slots(HashValsList, HashValsMap, HashSlotsMap),
-
- % Note that it is safe to release the registers now, even though we haven't
- % yet generated all the code which uses them, because that code will be
- % executed before the code for the cases (which might reuse those
- % registers), and because that code is generated manually (below)
- % so we don't need the reg info to be valid when we generate it.
+ switch_util.calc_string_hash_slots(HashValsList, HashValsMap,
+ HashSlotsMap),
- release_reg(SlotReg, !CI),
- release_reg(StringReg, !CI),
-
- % Generate the code for when the hash lookup fails. This must be done
- % before gen_hash_slots, since we want to use the exprn_info corresponding
- % to the start of the switch, not to the end of the last case.
+ % 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),
- % Generate the code etc. for the hash table.
- gen_hash_slots(0, TableSize, HashSlotsMap, CodeModel, SwitchGoalInfo,
- FailLabel, EndLabel, !MaybeEnd, Strings, Labels, NextSlots,
- SlotsCode, !CI),
-
- % Generate code which does the hash table lookup
- (
- add_scalar_static_cell_natural_types(NextSlots, NextSlotsTableAddr,
- !CI),
- NextSlotsTable = const(llconst_data_addr(NextSlotsTableAddr, no)),
+ % Generate the data structures for the hash table.
+ gen_string_hash_slots(0, TableSize, HashSlotsMap, FailLabel,
+ Strings, NextSlots, Targets),
+
+ % Generate the code for the cases.
+ map.foldl(add_remaining_case, CaseLabelMap, empty, CasesCode),
+ EndLabelCode = node([
+ llds_instr(label(EndLabel), "end of hashed string switch")
+ ]),
+
+ % Generate the code for the hash table lookup.
+ % XXX We should be using one vector cell, not two scalar cells.
+ add_scalar_static_cell_natural_types(NextSlots, NextSlotsTableAddr, !CI),
add_scalar_static_cell_natural_types(Strings, StringTableAddr, !CI),
+ NextSlotsTable = const(llconst_data_addr(NextSlotsTableAddr, no)),
StringTable = const(llconst_data_addr(StringTableAddr, no)),
HashLookupCode = node([
llds_instr(comment("hashed string switch"), ""),
@@ -126,89 +142,54 @@
code_label(LoopLabel)),
"keep searching until we reach the end of the chain"),
llds_instr(label(FailLabel), "no match, so fail")
- ])
- ),
+ ]),
+
JumpCode = node([
llds_instr(label(JumpLabel), "we found a match"),
- llds_instr(computed_goto(lval(SlotReg), Labels),
+ llds_instr(computed_goto(lval(SlotReg), Targets),
"jump to the corresponding code")
]),
- Code = tree_list([VarCode, HashLookupCode, FailCode, JumpCode, SlotsCode]).
+ Code = tree_list([HashLookupCode, FailCode, JumpCode, CasesCode,
+ EndLabelCode]).
-:- pred gen_hash_slots(int::in, int::in,
- map(int, hash_slot)::in, code_model::in, hlds_goal_info::in, label::in,
- label::in, branch_end::in, branch_end::out,
- list(rval)::out, list(label)::out, list(rval)::out, code_tree::out,
- code_info::in, code_info::out) is det.
+:- pred gen_string_hash_slots(int::in, int::in,
+ map(int, string_hash_slot(label))::in, label::in,
+ list(rval)::out, list(rval)::out, list(maybe(label))::out) is det.
-gen_hash_slots(Slot, TableSize, HashSlotMap, CodeModel, SwitchGoalInfo,
- FailLabel, EndLabel, !MaybeEnd, Strings, Labels, NextSlots,
- Code, !CI) :-
+gen_string_hash_slots(Slot, TableSize, HashSlotMap, FailLabel,
+ Strings, NextSlots, Targets) :-
( Slot = TableSize ->
Strings = [],
- Labels = [],
NextSlots = [],
- Code = node([
- llds_instr(label(EndLabel), "end of hashed string switch")
- ])
+ Targets = []
;
- gen_hash_slot(Slot, TableSize, HashSlotMap, CodeModel, SwitchGoalInfo,
- FailLabel, EndLabel, !MaybeEnd, String, Label, NextSlot,
- SlotCode, !CI),
- Slot1 = Slot + 1,
- gen_hash_slots(Slot1, TableSize, HashSlotMap, CodeModel,
- SwitchGoalInfo, FailLabel, EndLabel, !MaybeEnd, Strings0, Labels0,
- NextSlots0, Code0, !CI),
- Strings = [String | Strings0],
- Labels = [Label | Labels0],
- NextSlots = [NextSlot | NextSlots0],
- Code = tree(SlotCode, Code0)
+ gen_string_hash_slot(Slot, HashSlotMap, FailLabel,
+ String, NextSlot, Target),
+ gen_string_hash_slots(Slot + 1, TableSize, HashSlotMap, FailLabel,
+ TailStrings, TailNextSlots, TailTargets),
+ Strings = [String | TailStrings],
+ NextSlots = [NextSlot | TailNextSlots],
+ Targets = [Target | TailTargets]
).
-:- pred gen_hash_slot(int::in, int::in, map(int, hash_slot)::in,
- code_model::in, hlds_goal_info::in, label::in, label::in,
- branch_end::in, branch_end::out, rval::out, label::out, rval::out,
- code_tree::out, code_info::in, code_info::out) is det.
-
-gen_hash_slot(Slot, TblSize, HashSlotMap, CodeModel, SwitchGoalInfo, FailLabel,
- EndLabel, !MaybeEnd, StringRval, Label, NextSlotRval, Code, !CI) :-
- ( map.search(HashSlotMap, Slot, hash_slot(Case, Next)) ->
+:- pred gen_string_hash_slot(int::in, map(int, string_hash_slot(label))::in,
+ label::in, rval::out, rval::out, maybe(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)),
- Case = extended_case(_, ConsTag, _, Goal),
- ( ConsTag = string_tag(String0) ->
- String = String0
- ;
- unexpected(this_file, "gen_hash_slots: string expected")
- ),
StringRval = const(llconst_string(String)),
- get_next_label(Label, !CI),
- string.append_list(["case """, String, """"], Comment),
- LabelCode = node([llds_instr(label(Label), Comment)]),
- remember_position(!.CI, BranchStart),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- goal_info_get_store_map(SwitchGoalInfo, StoreMap),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- ( this_is_last_case(Slot, TblSize, HashSlotMap) ->
- true
- ;
- reset_to_position(BranchStart, !CI)
- ),
- FinishCode = node([
- llds_instr(goto(code_label(EndLabel)), "jump to end of switch")
- ]),
- Code = tree_list([LabelCode, TraceCode, GoalCode, SaveCode,
- FinishCode])
+ Target = yes(CaseLabel)
;
StringRval = const(llconst_int(0)),
- Label = FailLabel,
NextSlotRval = const(llconst_int(-2)),
- Code = empty
+ Target = yes(FailLabel)
).
-:- pred this_is_last_case(int::in, int::in, map(int, hash_slot)::in)
- is semidet.
+:- pred this_is_last_case(int::in, int::in,
+ map(int, string_hash_slot(label))::in) is semidet.
this_is_last_case(Slot, TableSize, Table) :-
Slot1 = Slot + 1,
Index: compiler/structure_reuse.direct.choose_reuse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.choose_reuse.m,v
retrieving revision 1.10
diff -u -b -r1.10 structure_reuse.direct.choose_reuse.m
--- compiler/structure_reuse.direct.choose_reuse.m 25 Sep 2007 04:56:41 -0000 1.10
+++ compiler/structure_reuse.direct.choose_reuse.m 25 Nov 2007 12:39:57 -0000
@@ -1007,7 +1007,7 @@
(
map.lookup(VarTypes, Var, Type),
type_to_type_defn_body(ModuleInfo, Type, TypeBody),
- TypeBody = hlds_du_type(_, ConsTagValues, _, _, _, _, _),
+ TypeBody = hlds_du_type(_, ConsTagValues, _, _, _, _, _, _),
map.search(ConsTagValues, ConsId, ConsTag),
MaybeSecondaryTag = get_secondary_tag(ConsTag),
MaybeSecondaryTag = yes(_)
@@ -1139,9 +1139,9 @@
:- pred annotate_reuses_in_case(background_info::in, match::in,
case::in, case::out) is det.
annotate_reuses_in_case(Background, Match, !Case) :-
- !.Case = case(A, Goal0),
+ !.Case = case(MainConsId, OtherConsIds, Goal0),
annotate_reuses_in_goal(Background, Match, Goal0, Goal),
- !:Case = case(A, Goal).
+ !:Case = case(MainConsId, OtherConsIds, Goal).
:- pred annotate_reuse_for_unification(background_info::in, match::in,
unification::in, hlds_goal_info::in, hlds_goal_info::out) is det.
@@ -1414,9 +1414,9 @@
case::in, case::out) is det.
check_for_cell_caching_in_case(DeadCellTable, !Case) :-
- !.Case = case(A, Goal0),
+ !.Case = case(MainConsId, OtherConsIds, Goal0),
check_for_cell_caching_2(DeadCellTable, Goal0, Goal),
- !:Case = case(A, Goal).
+ !:Case = case(MainConsId, OtherConsIds, Goal).
:- pred check_for_cell_caching_in_unification(dead_cell_table::in,
unification::in, unification::out,
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.12
diff -u -b -r1.12 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m 7 Aug 2007 07:10:06 -0000 1.12
+++ compiler/structure_reuse.indirect.m 23 Nov 2007 09:34:19 -0000
@@ -408,13 +408,13 @@
indirect_reuse_analyse_case(BaseInfo, AnalysisInfo0, Case0, Case, AnalysisInfo,
!FixpointTable, !IO) :-
- Case0 = case(ConsId, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
% Replace the state of the fixpoint_table in AnalysisInfo0:
NewAnalysisInfo = AnalysisInfo0 ^ fptable := !.FixpointTable,
indirect_reuse_analyse_goal(BaseInfo, Goal0, Goal, NewAnalysisInfo,
AnalysisInfo, !IO),
!:FixpointTable = AnalysisInfo ^ fptable,
- Case = case(ConsId, Goal).
+ Case = case(MainConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
Index: compiler/structure_reuse.lbu.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.lbu.m,v
retrieving revision 1.9
diff -u -b -r1.9 structure_reuse.lbu.m
--- compiler/structure_reuse.lbu.m 7 Aug 2007 07:10:06 -0000 1.9
+++ compiler/structure_reuse.lbu.m 23 Nov 2007 09:34:00 -0000
@@ -203,9 +203,9 @@
case::out, set(prog_var)::in, set(prog_var)::out) is det.
backward_use_in_case(LBU0, VarTypes, !Case, !LBU):-
- !.Case = case(Cons, Goal0),
+ !.Case = case(MainConsId, OtherConsIds, Goal0),
backward_use_in_goal(VarTypes, Goal0, Goal, LBU0, NewLBU),
- !:Case = case(Cons, Goal),
+ !:Case = case(MainConsId, OtherConsIds, Goal),
set.union(NewLBU, !LBU).
:- pred backward_use_in_disj(vartypes::in, list(hlds_goal)::in,
Index: compiler/structure_reuse.lfu.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.lfu.m,v
retrieving revision 1.7
diff -u -b -r1.7 structure_reuse.lfu.m
--- compiler/structure_reuse.lfu.m 6 Jan 2007 09:23:53 -0000 1.7
+++ compiler/structure_reuse.lfu.m 23 Nov 2007 09:33:46 -0000
@@ -181,9 +181,9 @@
forward_use_in_case(VarTypes, Inst0, Dead0, !Case,
!InstantiatedVars, !DeadVars) :-
- !.Case = case(Cons, Goal0),
+ !.Case = case(MainConsId, OtherConsIds, Goal0),
forward_use_in_goal(VarTypes, Goal0, Goal, Inst0, Inst, Dead0, Dead),
- !:Case = case(Cons, Goal),
+ !:Case = case(MainConsId, OtherConsIds, Goal),
set.union(Inst, !InstantiatedVars),
set.union(Dead, !DeadVars).
Index: compiler/structure_reuse.versions.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.versions.m,v
retrieving revision 1.7
diff -u -b -r1.7 structure_reuse.versions.m
--- compiler/structure_reuse.versions.m 17 May 2007 03:52:51 -0000 1.7
+++ compiler/structure_reuse.versions.m 23 Nov 2007 09:33:28 -0000
@@ -313,9 +313,9 @@
io::di, io::uo) is det.
process_case(ReuseMap, !Case, !IO) :-
- !.Case = case(ConsId, Goal0),
+ !.Case = case(MainConsId, OtherConsIds, Goal0),
process_goal(ReuseMap, Goal0, Goal, !IO),
- !:Case = case(ConsId, Goal).
+ !:Case = case(MainConsId, OtherConsIds, Goal).
%------------------------------------------------------------------------------%
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.23
diff -u -b -r1.23 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 7 Aug 2007 07:10:06 -0000 1.23
+++ compiler/structure_sharing.analysis.m 23 Nov 2007 09:33:10 -0000
@@ -439,7 +439,7 @@
analyse_case(ModuleInfo, PredInfo, ProcInfo, SharingTable, Sharing0,
Case, !FixpointTable, !Sharing, !IO) :-
- Case = case(_, Goal),
+ Case = case(_, _, Goal),
analyse_goal(ModuleInfo, PredInfo, ProcInfo, SharingTable, Goal,
!FixpointTable, Sharing0, CaseSharing, !IO),
!:Sharing = sharing_as_least_upper_bound(ModuleInfo, ProcInfo, !.Sharing,
Index: compiler/switch_case.m
===================================================================
RCS file: compiler/switch_case.m
diff -N compiler/switch_case.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/switch_case.m 12 Dec 2007 13:09:36 -0000
@@ -0,0 +1,141 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: switch_case.m.
+% Author: zs.
+%
+% Utility predicates for handling switch cases, especially those representing
+% more than one cons_id, for the LLDS backend.
+%
+%-----------------------------------------------------------------------------%
+
+:- module ll_backend.switch_case.
+
+:- interface.
+
+:- import_module hlds.code_model.
+:- import_module hlds.hlds_goal.
+:- import_module ll_backend.code_info.
+:- import_module ll_backend.llds.
+
+:- import_module map.
+
+:- type represent_params
+ ---> represent_params(
+ switch_var_name :: string,
+ switch_goal_info :: hlds_goal_info,
+ switch_code_model :: code_model,
+ starting_position :: position_info,
+ switch_end_label :: label
+ ).
+
+:- type case_code_included
+ ---> case_code_not_yet_included
+ ; case_code_already_included.
+
+:- type case_label_info
+ ---> case_label_info(
+ case_description :: string,
+ case_code :: code_tree,
+ case_code_included :: case_code_included
+ ).
+
+:- type case_label_map == map(label, case_label_info).
+
+ % represent_tagged_case_for_llds(Params, TaggedCase, Label,
+ % !CaseLabelMap, !MaybeEnd, !CI):
+ %
+ % Given TaggedCase, generate code for it (using the information in Params,
+ % and updating MaybeEnd and CI). The code will start with the newly
+ % allocated label Label. This label will represent the case in
+ % CaseLabelMap. The corresponding case_label_info will contain a comment
+ % describing the case in terms of the cons_ids it handles, the generated
+ % code (starting with the label instruction for Label and ending with
+ % the jump to the end label of the switch), and an indication that this
+ % code has not yet been included anywhere.
+ %
+:- pred represent_tagged_case_for_llds(represent_params::in,
+ tagged_case::in, label::out, case_label_map::in, case_label_map::out,
+ branch_end::in, branch_end::out, code_info::in, code_info::out) is det.
+
+ % generate_case_code_or_jump(CaseLabel, Code, !CaseLabelMap):
+ %
+:- pred generate_case_code_or_jump(label::in, code_tree::out,
+ case_label_map::in, case_label_map::out) is det.
+
+:- pred add_remaining_case(label::in, case_label_info::in,
+ code_tree::in, code_tree::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module backend_libs.switch_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_llds.
+:- import_module hlds.hlds_out.
+:- import_module libs.tree.
+:- import_module ll_backend.code_gen.
+:- import_module ll_backend.trace_gen.
+
+:- import_module list.
+:- import_module string.
+:- import_module svmap.
+
+represent_tagged_case_for_llds(Params, TaggedCase, Label, !CaseLabelMap,
+ !MaybeEnd, !CI) :-
+ Params = represent_params(SwitchVarName, SwitchGoalInfo, CodeModel,
+ BranchStart, EndLabel),
+ TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, Goal),
+ project_cons_name_and_tag(MainTaggedConsId, MainConsName, _),
+ list.map2(project_cons_name_and_tag, OtherTaggedConsIds,
+ OtherConsNames, _),
+ Comment = case_comment(SwitchVarName, MainConsName, OtherConsNames),
+ reset_to_position(BranchStart, !CI),
+ get_next_label(Label, !CI),
+ LabelCode = node([llds_instr(label(Label), Comment)]),
+ maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode, !CI),
+ generate_goal(CodeModel, Goal, GoalCode, !CI),
+ goal_info_get_store_map(SwitchGoalInfo, StoreMap),
+ generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
+ GotoEndCode = node([
+ llds_instr(goto(code_label(EndLabel)),
+ "goto end of switch on " ++ SwitchVarName)
+ ]),
+ Code = tree_list([LabelCode, TraceCode, GoalCode, SaveCode, GotoEndCode]),
+ CaseInfo = case_label_info(Comment, Code, case_code_not_yet_included),
+ svmap.det_insert(Label, CaseInfo, !CaseLabelMap).
+
+generate_case_code_or_jump(CaseLabel, Code, !CaseLabelMap) :-
+ map.lookup(!.CaseLabelMap, CaseLabel, CaseInfo0),
+ CaseInfo0 = case_label_info(Comment, CaseCode, CaseIncluded),
+ (
+ CaseIncluded = case_code_not_yet_included,
+ Code = CaseCode,
+ CaseInfo = CaseInfo0 ^ case_code_included
+ := case_code_already_included,
+ svmap.det_update(CaseLabel, CaseInfo, !CaseLabelMap)
+ ;
+ CaseIncluded = case_code_already_included,
+ % We cannot include the case's code, since it has already been included
+ % somewhere else.
+ Code = node([
+ llds_instr(goto(code_label(CaseLabel)), "goto " ++ Comment)
+ ])
+ ).
+
+add_remaining_case(_Label, CaseInfo, !Code) :-
+ CaseInfo = case_label_info(_Comment, CaseCode, CaseIncluded),
+ (
+ CaseIncluded = case_code_not_yet_included,
+ !:Code = tree(!.Code, CaseCode)
+ ;
+ CaseIncluded = case_code_already_included
+ ).
+
+%-----------------------------------------------------------------------------%
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.137
diff -u -b -r1.137 switch_detection.m
--- compiler/switch_detection.m 23 Nov 2007 07:35:26 -0000 1.137
+++ compiler/switch_detection.m 13 Dec 2007 13:09:32 -0000
@@ -7,7 +7,7 @@
%-----------------------------------------------------------------------------%
%
% File: switch_detection.m.
-% Main author: fjh.
+% Main authors: fjh, zs.
%
% Switch detection - when a disjunction contains disjuncts that unify the
% same input variable with different function symbols, replace (part of)
@@ -25,7 +25,6 @@
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
-:- import_module bool.
:- import_module io.
:- import_module list.
@@ -37,6 +36,10 @@
:- pred detect_switches_in_proc(proc_id::in, pred_id::in,
module_info::in, module_info::out) is det.
+:- type found_deconstruct
+ ---> did_find_deconstruct
+ ; did_not_find_deconstruct.
+
% find_bind_var(Var, ProcessUnify, Goal0, Goal, !Result, !Info,
% FoundDeconstruct):
%
@@ -51,7 +54,7 @@
:- pred find_bind_var(prog_var::in,
process_unify(Result, Info)::in(process_unify),
hlds_goal::in, hlds_goal::out, Result::in, Result::out,
- Info::in, Info::out, bool::out) is det.
+ Info::in, Info::out, found_deconstruct::out) is det.
:- type process_unify(Result, Info) ==
pred(prog_var, hlds_goal, list(hlds_goal), Result, Result, Info, Info).
@@ -72,61 +75,99 @@
:- import_module hlds.quantification.
:- import_module libs.
:- import_module libs.compiler_util.
+:- import_module libs.globals.
+:- import_module libs.options.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_mode.
:- 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 set_tree234.
+:- import_module string.
+:- import_module svmap.
:- import_module term.
:- import_module unit.
%-----------------------------------------------------------------------------%
+:- type allow_multi_arm
+ ---> allow_multi_arm
+ ; dont_allow_multi_arm.
+
+:- pred lookup_allow_multi_arm(module_info::in, allow_multi_arm::out) is det.
+
+lookup_allow_multi_arm(ModuleInfo, AllowMulti) :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, allow_multi_arm_switches, Allow),
+ (
+ Allow = yes,
+ AllowMulti = allow_multi_arm
+ ;
+ Allow = no,
+ AllowMulti = dont_allow_multi_arm
+ ).
+
detect_switches(!ModuleInfo, !IO) :-
% Traverse the module structure, calling `detect_switches_in_goal'
% for each procedure body.
+ lookup_allow_multi_arm(!.ModuleInfo, AllowMulti),
module_info_predids(PredIds, !ModuleInfo),
- detect_switches_in_preds(PredIds, !ModuleInfo, !IO).
+ detect_switches_in_preds_allow(PredIds, AllowMulti, !ModuleInfo, !IO).
-:- pred detect_switches_in_preds(list(pred_id)::in,
+:- pred detect_switches_in_preds_allow(list(pred_id)::in, allow_multi_arm::in,
module_info::in, module_info::out, io::di, io::uo) is det.
-detect_switches_in_preds([], !ModuleInfo, !IO).
-detect_switches_in_preds([PredId | PredIds], !ModuleInfo, !IO) :-
+detect_switches_in_preds_allow([], _, !ModuleInfo, !IO).
+detect_switches_in_preds_allow([PredId | PredIds], AllowMulti, !ModuleInfo,
+ !IO) :-
module_info_preds(!.ModuleInfo, PredTable),
map.lookup(PredTable, PredId, PredInfo),
- detect_switches_in_pred(PredId, PredInfo, !ModuleInfo, !IO),
- detect_switches_in_preds(PredIds, !ModuleInfo, !IO).
+ detect_switches_in_pred_allow(PredId, PredInfo, AllowMulti, !ModuleInfo,
+ !IO),
+ detect_switches_in_preds_allow(PredIds, AllowMulti, !ModuleInfo, !IO).
-:- pred detect_switches_in_pred(pred_id::in, pred_info::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
+:- pred detect_switches_in_pred_allow(pred_id::in, pred_info::in,
+ allow_multi_arm::in, module_info::in, module_info::out,
+ io::di, io::uo) is det.
-detect_switches_in_pred(PredId, PredInfo0, !ModuleInfo, !IO) :-
+detect_switches_in_pred_allow(PredId, PredInfo0, AllowMulti, !ModuleInfo,
+ !IO) :-
ProcIds = pred_info_non_imported_procids(PredInfo0),
(
ProcIds = [_ | _],
write_pred_progress_message("% Detecting switches in ", PredId,
!.ModuleInfo, !IO),
- detect_switches_in_procs(ProcIds, PredId, !ModuleInfo)
+ detect_switches_in_procs_allow(ProcIds, PredId, AllowMulti,
+ !ModuleInfo)
% This is where we should print statistics, if we ever need
% to debug the performance of switch detection.
;
ProcIds = []
).
-:- pred detect_switches_in_procs(list(proc_id)::in, pred_id::in,
- module_info::in, module_info::out) is det.
+:- pred detect_switches_in_procs_allow(list(proc_id)::in, pred_id::in,
+ allow_multi_arm::in, module_info::in, module_info::out) is det.
-detect_switches_in_procs([], _PredId, !ModuleInfo).
-detect_switches_in_procs([ProcId | ProcIds], PredId, !ModuleInfo) :-
- detect_switches_in_proc(ProcId, PredId, !ModuleInfo),
- detect_switches_in_procs(ProcIds, PredId, !ModuleInfo).
+detect_switches_in_procs_allow([], _PredId, _AllowMulti, !ModuleInfo).
+detect_switches_in_procs_allow([ProcId | ProcIds], PredId, AllowMulti,
+ !ModuleInfo) :-
+ detect_switches_in_proc_allow(ProcId, PredId, AllowMulti, !ModuleInfo),
+ detect_switches_in_procs_allow(ProcIds, PredId, AllowMulti, !ModuleInfo).
detect_switches_in_proc(ProcId, PredId, !ModuleInfo) :-
+ lookup_allow_multi_arm(!.ModuleInfo, AllowMulti),
+ detect_switches_in_proc_allow(ProcId, PredId, AllowMulti, !ModuleInfo).
+
+:- pred detect_switches_in_proc_allow(proc_id::in, pred_id::in,
+ allow_multi_arm::in, module_info::in, module_info::out) is det.
+
+detect_switches_in_proc_allow(ProcId, PredId, AllowMulti, !ModuleInfo) :-
module_info_preds(!.ModuleInfo, PredTable0),
map.lookup(PredTable0, PredId, PredInfo0),
pred_info_get_procedures(PredInfo0, ProcTable0),
@@ -138,15 +179,15 @@
proc_info_get_goal(ProcInfo0, Goal0),
proc_info_get_vartypes(ProcInfo0, VarTypes),
proc_info_get_initial_instmap(ProcInfo0, !.ModuleInfo, InstMap0),
- detect_switches_in_goal(!.ModuleInfo, VarTypes, InstMap0, Goal0, Goal,
- no, Requant),
+ detect_switches_in_goal(VarTypes, AllowMulti, InstMap0,
+ Goal0, Goal, !ModuleInfo, dont_need_to_requantify, Requant),
proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
(
- Requant = yes,
+ Requant = need_to_requantify,
requantify_proc(ProcInfo1, ProcInfo)
;
- Requant = no,
+ Requant = dont_need_to_requantify,
ProcInfo = ProcInfo1
),
map.det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
@@ -156,124 +197,296 @@
%-----------------------------------------------------------------------------%
+:- type need_to_requantify
+ ---> dont_need_to_requantify
+ ; need_to_requantify.
+
% Given a goal, and the instmap on entry to that goal,
% replace disjunctions with switches whereever possible.
%
-:- pred detect_switches_in_goal(module_info::in, vartypes::in,
- instmap::in, hlds_goal::in, hlds_goal::out, bool::in, bool::out) is det.
-
-detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0, !Goal, !Requant) :-
- detect_switches_in_goal_1(ModuleInfo, VarTypes, InstMap0, _InstMap,
- !Goal, !Requant).
+:- pred detect_switches_in_goal(vartypes::in, allow_multi_arm::in, instmap::in,
+ hlds_goal::in, hlds_goal::out, module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
+
+detect_switches_in_goal(VarTypes, AllowMulti, InstMap0,
+ !Goal, !ModuleInfo, !Requant) :-
+ detect_switches_in_goal_update_instmap(VarTypes, AllowMulti,
+ InstMap0, _InstMap, !Goal, !ModuleInfo, !Requant).
% This version is the same as the above except that it returns the
% resulting instmap on exit from the goal, which is computed by applying
% the instmap delta specified in the goal's goalinfo.
%
-:- pred detect_switches_in_goal_1(module_info::in, vartypes::in,
- instmap::in, instmap::out, hlds_goal::in, hlds_goal::out,
- bool::in, bool::out) is det.
+:- pred detect_switches_in_goal_update_instmap(vartypes::in,
+ allow_multi_arm::in, instmap::in, instmap::out,
+ hlds_goal::in, hlds_goal::out, module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
-detect_switches_in_goal_1(ModuleInfo, VarTypes, !InstMap,
- Goal0, Goal, !Requant) :-
+detect_switches_in_goal_update_instmap(VarTypes, AllowMulti,
+ !InstMap, Goal0, Goal, !ModuleInfo, !Requant) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
- detect_switches_in_goal_2(ModuleInfo, VarTypes, !.InstMap, GoalInfo,
- GoalExpr0, GoalExpr, !Requant),
+ detect_switches_in_goal_expr(VarTypes, AllowMulti, !.InstMap,
+ GoalInfo, GoalExpr0, GoalExpr, !ModuleInfo, !Requant),
Goal = hlds_goal(GoalExpr, GoalInfo),
update_instmap(Goal0, !InstMap).
% Here we process each of the different sorts of goals.
%
-:- pred detect_switches_in_goal_2(module_info::in, vartypes::in, instmap::in,
- hlds_goal_info::in, hlds_goal_expr::in, hlds_goal_expr::out,
- bool::in, bool::out) is det.
+:- pred detect_switches_in_goal_expr(vartypes::in, allow_multi_arm::in,
+ instmap::in, hlds_goal_info::in, hlds_goal_expr::in, hlds_goal_expr::out,
+ module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
-detect_switches_in_goal_2(ModuleInfo, VarTypes, InstMap0, GoalInfo,
- Goal0, Goal, !Requant) :-
+detect_switches_in_goal_expr(VarTypes, AllowMulti, InstMap0,
+ GoalInfo, GoalExpr0, GoalExpr, !ModuleInfo, !Requant) :-
(
- Goal0 = disj(Goals0),
+ GoalExpr0 = disj(Disjuncts0),
(
- Goals0 = [],
- Goal = disj([])
+ Disjuncts0 = [],
+ GoalExpr = disj([])
;
- Goals0 = [_ | _],
+ Disjuncts0 = [_ | _],
NonLocals = goal_info_get_nonlocals(GoalInfo),
set.to_sorted_list(NonLocals, NonLocalsList),
- detect_switches_in_disj(NonLocalsList, Goals0, GoalInfo, InstMap0,
- VarTypes, NonLocalsList, ModuleInfo, [], Goal, !Requant)
+ detect_switches_in_disj(GoalInfo, NonLocalsList,
+ VarTypes, AllowMulti, Disjuncts0, NonLocalsList, InstMap0,
+ [], GoalExpr, !ModuleInfo, !Requant)
)
;
- Goal0 = conj(ConjType, Goals0),
- detect_switches_in_conj(ModuleInfo, VarTypes, InstMap0,
- Goals0, Goals, !Requant),
- Goal = conj(ConjType, Goals)
- ;
- Goal0 = negation(SubGoal0),
- detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0,
- SubGoal0, SubGoal, !Requant),
- Goal = negation(SubGoal)
- ;
- Goal0 = if_then_else(Vars, Cond0, Then0, Else0),
- detect_switches_in_goal_1(ModuleInfo, VarTypes, InstMap0, InstMap1,
- Cond0, Cond, !Requant),
- detect_switches_in_goal(ModuleInfo, VarTypes, InstMap1, Then0, Then,
- !Requant),
- detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0, Else0, Else,
- !Requant),
- Goal = if_then_else(Vars, Cond, Then, Else)
- ;
- Goal0 = switch(Var, CanFail, Cases0),
- detect_switches_in_cases(ModuleInfo, VarTypes, InstMap0,
- Cases0, Cases, !Requant),
- Goal = switch(Var, CanFail, Cases)
- ;
- Goal0 = scope(Reason, SubGoal0),
- detect_switches_in_goal(ModuleInfo, VarTypes, InstMap0,
- SubGoal0, SubGoal, !Requant),
- Goal = scope(Reason, SubGoal)
+ GoalExpr0 = conj(ConjType, Goals0),
+ detect_switches_in_conj(VarTypes, AllowMulti, InstMap0,
+ Goals0, Goals, !ModuleInfo, !Requant),
+ GoalExpr = conj(ConjType, Goals)
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ detect_switches_in_goal(VarTypes, AllowMulti, InstMap0,
+ SubGoal0, SubGoal, !ModuleInfo, !Requant),
+ GoalExpr = negation(SubGoal)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ detect_switches_in_goal_update_instmap(VarTypes, AllowMulti,
+ InstMap0, InstMap1, Cond0, Cond, !ModuleInfo, !Requant),
+ detect_switches_in_goal(VarTypes, AllowMulti,
+ InstMap1, Then0, Then, !ModuleInfo, !Requant),
+ detect_switches_in_goal(VarTypes, AllowMulti,
+ InstMap0, Else0, Else, !ModuleInfo, !Requant),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ detect_switches_in_cases(Var, VarTypes, AllowMulti, InstMap0,
+ Cases0, Cases, !ModuleInfo, !Requant),
+ GoalExpr = switch(Var, CanFail, Cases)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ detect_switches_in_goal(VarTypes, AllowMulti, InstMap0,
+ SubGoal0, SubGoal, !ModuleInfo, !Requant),
+ GoalExpr = scope(Reason, SubGoal)
;
- Goal0 = unify(_, RHS0, _, _, _),
+ GoalExpr0 = unify(_, RHS0, _, _, _),
(
RHS0 = rhs_lambda_goal(_, _, _, _, Vars, Modes, _, LambdaGoal0),
% We need to insert the initial insts for the lambda variables
% in the instmap before processing the lambda goal.
- instmap.pre_lambda_update(ModuleInfo, Vars, Modes,
+ instmap.pre_lambda_update(!.ModuleInfo, Vars, Modes,
InstMap0, InstMap1),
- detect_switches_in_goal(ModuleInfo, VarTypes, InstMap1,
- LambdaGoal0, LambdaGoal, !Requant),
+ detect_switches_in_goal(VarTypes, AllowMulti, InstMap1,
+ LambdaGoal0, LambdaGoal, !ModuleInfo, !Requant),
RHS = RHS0 ^ rhs_lambda_goal := LambdaGoal,
- Goal = Goal0 ^ unify_rhs := RHS
+ GoalExpr = GoalExpr0 ^ unify_rhs := RHS
;
( RHS0 = rhs_var(_)
; RHS0 = rhs_functor(_, _, _)
),
- Goal = Goal0
+ GoalExpr = GoalExpr0
)
;
- Goal0 = generic_call(_, _, _, _),
- Goal = Goal0
- ;
- Goal0 = plain_call(_, _, _, _, _, _),
- Goal = Goal0
- ;
- Goal0 = call_foreign_proc(_, _, _, _, _, _, _),
- Goal = Goal0
+ ( GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ GoalExpr = GoalExpr0
;
- Goal0 = shorthand(_),
+ GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
unexpected(this_file, "detect_switches_in_goal_2: shorthand")
).
%-----------------------------------------------------------------------------%
-:- type cases == map(cons_id, list(hlds_goal)).
+:- type case_arm
+ ---> single_cons_id_arm(cons_id, hlds_goal)
+ ; multi_cons_id_arm(cons_id, list(cons_id), hlds_goal).
+
+:- type cons_id_state
+ ---> cons_id_has_all_singles
+ ; cons_id_has_one_multi
+ ; cons_id_has_conflict.
+
+:- type cons_id_entry
+ ---> cons_id_entry(
+ cons_id_state :: cons_id_state,
+ cons_id_arms :: cord(case_arm)
+ ).
+
+:- type cases_table
+ ---> cases_table(
+ cases_map :: map(cons_id, cons_id_entry),
+ conflict_cons_ids :: set_tree234(cons_id)
+ ).
+
+:- func convert_cases_table(hlds_goal_info, cases_table) = list(case).
+
+convert_cases_table(GoalInfo, CasesTable) = SortedCases :-
+ CasesTable = cases_table(CasesMap, ConflictIds),
+ map.to_assoc_list(CasesMap, CasesAssocList),
+ list.foldl2(convert_case(GoalInfo, ConflictIds), CasesAssocList, [], Cases,
+ set_tree234.init, _AlreadyHandledConsIds),
+ list.sort(Cases, SortedCases).
+
+:- pred convert_case(hlds_goal_info::in, set_tree234(cons_id)::in,
+ pair(cons_id, cons_id_entry)::in, list(case)::in, list(case)::out,
+ set_tree234(cons_id)::in, set_tree234(cons_id)::out) is det.
+
+convert_case(GoalInfo, ConflictConsIds, ConsId - Entry, !Cases,
+ !AlreadyHandledConsIds) :-
+ ( set_tree234.member(!.AlreadyHandledConsIds, ConsId) ->
+ Entry = cons_id_entry(State, _ArmCord),
+ expect(unify(State, cons_id_has_one_multi), this_file,
+ "convert_case: already handled but not cons_id_has_one_multi")
+ ;
+ Entry = cons_id_entry(State, ArmsCord),
+ Arms = cord.list(ArmsCord),
+ (
+ State = cons_id_has_conflict,
+ set_tree234.is_member(ConflictConsIds, ConsId, IsMember),
+ expect(unify(IsMember, yes), this_file,
+ "convert_case: conflict status but not in ConflictConsIds"),
+ Disjuncts = list.map(project_arm_goal, Arms),
+ disj_list_to_goal(Disjuncts, GoalInfo, Goal),
+ Case = case(ConsId, [], Goal),
+ !:Cases = [Case | !.Cases]
+ ;
+ State = cons_id_has_all_singles,
+ set_tree234.is_member(ConflictConsIds, ConsId, IsMember),
+ expect(unify(IsMember, no), this_file,
+ "convert_case: singles status but in ConflictConsIds"),
+ Disjuncts = list.map(project_single_arm_goal, Arms),
+ disj_list_to_goal(Disjuncts, GoalInfo, Goal),
+ Case = case(ConsId, [], Goal),
+ !:Cases = [Case | !.Cases]
+ ;
+ State = cons_id_has_one_multi,
+ ( Arms = [multi_cons_id_arm(MainConsId, OtherConsIds0, Goal)] ->
+ ( ConsId = MainConsId ->
+ list.filter(set_tree234.contains(ConflictConsIds),
+ OtherConsIds0, _, OtherConsIds),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ set_tree234.insert_list(OtherConsIds,
+ !AlreadyHandledConsIds),
+ !:Cases = [Case | !.Cases]
+ ;
+ % The code that creates multi_cons_id_arms should ensure
+ % that [MainConsId | OtherConsIds] is sorted, and
+ % convert_cases_table should call convert_case for
+ % ConsIds in the same sorted order. If the first elements
+ % of the two lists don't match, something has gone wrong.
+ unexpected(this_file, "convert_case: " ++
+ "cons_id_has_one_multi: ConsId != MainConsId")
+ )
+ ;
+ unexpected(this_file,
+ "convert_case: misleading cons_id_has_one_multi")
+ )
+ )
+ ).
+
+:- func project_arm_goal(case_arm) = hlds_goal.
+
+project_arm_goal(single_cons_id_arm(_, Goal)) = Goal.
+project_arm_goal(multi_cons_id_arm(_, _, Goal)) = Goal.
+
+:- func project_single_arm_goal(case_arm) = hlds_goal.
+
+project_single_arm_goal(single_cons_id_arm(_, Goal)) = Goal.
+project_single_arm_goal(multi_cons_id_arm(_, _, _)) = _ :-
+ unexpected(this_file, "project_single_arm_goal: multi arm").
+
+:- func num_cases_in_table(cases_table) = int.
-:- type sorted_case_list == list(case).
- % The sorted_case_list should always be sorted on cons_id -
- % `delete_unreachable_cases' relies on this.
+num_cases_in_table(cases_table(CasesMap, _)) = map.count(CasesMap).
+
+:- pred add_single_entry(cons_id::in, hlds_goal::in,
+ cases_table::in, cases_table::out) is det.
+
+add_single_entry(ConsId, Goal, CasesTable0, CasesTable) :-
+ CasesTable0 = cases_table(CasesMap0, ConflictConsIds0),
+ Arm = single_cons_id_arm(ConsId, Goal),
+ ( map.search(CasesMap0, ConsId, Entry0) ->
+ Entry0 = cons_id_entry(State0, Arms0),
+ (
+ State0 = cons_id_has_all_singles,
+ State = cons_id_has_all_singles,
+ ConflictConsIds = ConflictConsIds0
+ ;
+ State0 = cons_id_has_one_multi,
+ State = cons_id_has_conflict,
+ set_tree234.insert(ConsId, ConflictConsIds0, ConflictConsIds)
+ ;
+ State0 = cons_id_has_conflict,
+ State = cons_id_has_conflict,
+ ConflictConsIds = ConflictConsIds0
+ ),
+ Arms = cord.snoc(Arms0, Arm),
+ Entry = cons_id_entry(State, Arms),
+ map.det_update(CasesMap0, ConsId, Entry, CasesMap)
+ ;
+ State = cons_id_has_all_singles,
+ Arms = cord.singleton(Arm),
+ Entry = cons_id_entry(State, Arms),
+ map.det_insert(CasesMap0, ConsId, Entry, CasesMap),
+ ConflictConsIds = ConflictConsIds0
+ ),
+ CasesTable = cases_table(CasesMap, ConflictConsIds).
+
+:- pred add_multi_entry(cons_id::in, list(cons_id)::in, hlds_goal::in,
+ cases_table::in, cases_table::out) is det.
+
+add_multi_entry(MainConsId, OtherConsIds, Goal, CasesTable0, CasesTable) :-
+ Arm = multi_cons_id_arm(MainConsId, OtherConsIds, Goal),
+ list.foldl(add_multi_entry_for_cons_id(Arm), [MainConsId | OtherConsIds],
+ CasesTable0, CasesTable).
+
+:- pred add_multi_entry_for_cons_id(case_arm::in, cons_id::in,
+ cases_table::in, cases_table::out) is det.
+
+add_multi_entry_for_cons_id(Arm, ConsId, CasesTable0, CasesTable) :-
+ CasesTable0 = cases_table(CasesMap0, ConflictConsIds0),
+ ( map.search(CasesMap0, ConsId, Entry0) ->
+ Entry0 = cons_id_entry(State0, Arms0),
+ (
+ ( State0 = cons_id_has_all_singles
+ ; State0 = cons_id_has_one_multi
+ ),
+ set_tree234.insert(ConsId, ConflictConsIds0, ConflictConsIds)
+ ;
+ State0 = cons_id_has_conflict,
+ ConflictConsIds = ConflictConsIds0
+ ),
+ State = cons_id_has_conflict,
+ Arms = cord.snoc(Arms0, Arm),
+ Entry = cons_id_entry(State, Arms),
+ map.det_update(CasesMap0, ConsId, Entry, CasesMap)
+ ;
+ State = cons_id_has_one_multi,
+ Arms = cord.singleton(Arm),
+ Entry = cons_id_entry(State, Arms),
+ map.det_insert(CasesMap0, ConsId, Entry, CasesMap),
+ ConflictConsIds = ConflictConsIds0
+ ),
+ CasesTable = cases_table(CasesMap, ConflictConsIds).
:- type again
- ---> again(prog_var, list(hlds_goal), sorted_case_list).
+ ---> again(prog_var, list(hlds_goal), list(case)).
% This is the interesting bit - we've found a non-empty disjunction,
% and we've got a list of the non-local variables of that disjunction.
@@ -281,18 +494,20 @@
% of the disjuncts such that each group of disjunctions can only succeed
% if the variable is bound to a different functor.
%
-:- pred detect_switches_in_disj(list(prog_var)::in, list(hlds_goal)::in,
- hlds_goal_info::in, instmap::in, vartypes::in,
- list(prog_var)::in, module_info::in, list(again)::in,
- hlds_goal_expr::out, bool::in, bool::out) is det.
+:- pred detect_switches_in_disj(hlds_goal_info::in,
+ list(prog_var)::in, vartypes::in, allow_multi_arm::in,
+ list(hlds_goal)::in, list(prog_var)::in, instmap::in, list(again)::in,
+ hlds_goal_expr::out, module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
-detect_switches_in_disj([Var | Vars], Goals0, GoalInfo, InstMap,
- VarTypes, AllVars, ModuleInfo, Again0, Goal, !Requant) :-
+detect_switches_in_disj(GoalInfo, AllVars, VarTypes, AllowMulti, Disjuncts0,
+ [Var | Vars], InstMap, AgainList0, GoalExpr, !ModuleInfo, !Requant) :-
% Can we do at least a partial switch on this variable?
(
instmap.lookup_var(InstMap, Var, VarInst0),
- inst_is_bound(ModuleInfo, VarInst0),
- partition_disj(Goals0, Var, GoalInfo, Left, CasesList, !Requant)
+ inst_is_bound(!.ModuleInfo, VarInst0),
+ partition_disj(AllowMulti, Disjuncts0, Var, GoalInfo, Left, CasesList,
+ !Requant)
->
% A switch needs to have at least two cases.
%
@@ -305,12 +520,12 @@
% Are there any disjuncts that are not part of the switch? No.
Left = [],
( CasesList = [_, _ | _] ->
- cases_to_switch(CasesList, Var, VarTypes, GoalInfo, InstMap,
- ModuleInfo, Goal, !Requant)
+ cases_to_switch(Var, VarTypes, AllowMulti,
+ CasesList, InstMap, GoalExpr, !ModuleInfo, !Requant)
;
- detect_sub_switches_in_disj(ModuleInfo, VarTypes, InstMap,
- Goals0, Goals, !Requant),
- Goal = disj(Goals)
+ detect_sub_switches_in_disj(VarTypes, AllowMulti,
+ InstMap, Disjuncts0, Disjuncts, !ModuleInfo, !Requant),
+ GoalExpr = disj(Disjuncts)
)
;
% Are there any disjuncts that are not part of the switch? Yes.
@@ -318,34 +533,36 @@
% Insert this switch into the list of incomplete switches
% only if it has at least two cases.
( CasesList = [_, _ | _] ->
- Again1 = [again(Var, Left, CasesList) | Again0]
+ AgainList1 = [again(Var, Left, CasesList) | AgainList0]
;
- Again1 = Again0
+ AgainList1 = AgainList0
),
% Try to find a switch.
- detect_switches_in_disj(Vars, Goals0, GoalInfo, InstMap, VarTypes,
- AllVars, ModuleInfo, Again1, Goal, !Requant)
+ detect_switches_in_disj(GoalInfo, AllVars, VarTypes,
+ AllowMulti, Disjuncts0, Vars, InstMap, AgainList1, GoalExpr,
+ !ModuleInfo, !Requant)
)
;
- detect_switches_in_disj(Vars, Goals0, GoalInfo, InstMap,
- VarTypes, AllVars, ModuleInfo, Again0, Goal, !Requant)
+ detect_switches_in_disj(GoalInfo, AllVars, VarTypes,
+ AllowMulti, Disjuncts0, Vars, InstMap, AgainList0, GoalExpr,
+ !ModuleInfo, !Requant)
).
-detect_switches_in_disj([], Goals0, GoalInfo, InstMap,
- VarTypes, AllVars, ModuleInfo, AgainList0, disj(Goals), !Requant) :-
+detect_switches_in_disj(GoalInfo, AllVars, VarTypes, AllowMulti, Disjuncts0,
+ [], InstMap, AgainList0, disj(Disjuncts), !ModuleInfo, !Requant) :-
(
AgainList0 = [],
- detect_sub_switches_in_disj(ModuleInfo, VarTypes, InstMap,
- Goals0, Goals, !Requant)
+ detect_sub_switches_in_disj(VarTypes, AllowMulti, InstMap,
+ Disjuncts0, Disjuncts, !ModuleInfo, !Requant)
;
AgainList0 = [Again | AgainList1],
select_best_switch(AgainList1, Again, BestAgain),
BestAgain = again(Var, Left0, CasesList),
- cases_to_switch(CasesList, Var, VarTypes, GoalInfo, InstMap,
- ModuleInfo, SwitchGoal, !Requant),
- detect_switches_in_disj(AllVars, Left0, GoalInfo, InstMap,
- VarTypes, AllVars, ModuleInfo, [], Left, !Requant),
+ cases_to_switch(Var, VarTypes, AllowMulti,
+ CasesList, InstMap, SwitchGoalExpr, !ModuleInfo, !Requant),
+ detect_switches_in_disj(GoalInfo, AllVars, VarTypes, AllowMulti,
+ Left0, AllVars, InstMap, [], Left, !ModuleInfo, !Requant),
goal_to_disj_list(hlds_goal(Left, GoalInfo), LeftList),
- Goals = [hlds_goal(SwitchGoal, GoalInfo) | LeftList]
+ Disjuncts = [hlds_goal(SwitchGoalExpr, GoalInfo) | LeftList]
).
:- pred select_best_switch(list(again)::in, again::in, again::out) is det.
@@ -365,47 +582,58 @@
),
select_best_switch(AgainList, BestAgain1, BestAgain).
-:- pred detect_sub_switches_in_disj(module_info::in, vartypes::in, instmap::in,
- list(hlds_goal)::in, list(hlds_goal)::out, bool::in, bool::out) is det.
+:- pred detect_sub_switches_in_disj(vartypes::in,
+ allow_multi_arm::in, instmap::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
-detect_sub_switches_in_disj(_ModuleInfo, _VarTypes, _InstMap, [], [],
- !Requant).
-detect_sub_switches_in_disj(ModuleInfo, VarTypes, InstMap,
- [Goal0 | Goals0], [Goal | Goals], !Requant) :-
- detect_switches_in_goal(ModuleInfo, VarTypes, InstMap, Goal0, Goal,
- !Requant),
- detect_sub_switches_in_disj(ModuleInfo, VarTypes, InstMap,
- Goals0, Goals, !Requant).
-
-:- pred detect_switches_in_cases(module_info::in, vartypes::in, instmap::in,
- list(case)::in, list(case)::out, bool::in, bool::out) is det.
-
-detect_switches_in_cases(_, _, _, [], [], !Requant).
-detect_switches_in_cases(ModuleInfo, VarTypes, InstMap,
- [Case0 | Cases0], [Case | Cases], !Requant) :-
- Case0 = case(Functor, Goal0),
- detect_switches_in_goal(ModuleInfo, VarTypes, InstMap, Goal0, Goal,
- !Requant),
- Case = case(Functor, Goal),
- detect_switches_in_cases(ModuleInfo, VarTypes, InstMap, Cases0, Cases,
- !Requant).
-
-:- pred detect_switches_in_conj(module_info::in, vartypes::in, instmap::in,
- list(hlds_goal)::in, list(hlds_goal)::out, bool::in, bool::out) is det.
-
-detect_switches_in_conj(_, _, _, [], [], !Requant).
-detect_switches_in_conj(ModuleInfo, VarTypes, InstMap0,
- [Goal0 | Goals0], [Goal | Goals], !Requant) :-
- detect_switches_in_goal_1(ModuleInfo, VarTypes, InstMap0, InstMap1,
- Goal0, Goal, !Requant),
- detect_switches_in_conj(ModuleInfo, VarTypes, InstMap1, Goals0, Goals,
- !Requant).
+detect_sub_switches_in_disj(_, _, _, [], [], !ModuleInfo, !Requant).
+detect_sub_switches_in_disj(VarTypes, AllowMulti, InstMap,
+ [Goal0 | Goals0], [Goal | Goals], !ModuleInfo, !Requant) :-
+ detect_switches_in_goal(VarTypes, AllowMulti, InstMap,
+ Goal0, Goal, !ModuleInfo, !Requant),
+ detect_sub_switches_in_disj(VarTypes, AllowMulti, InstMap,
+ Goals0, Goals, !ModuleInfo, !Requant).
+
+:- pred detect_switches_in_cases(prog_var::in, vartypes::in,
+ allow_multi_arm::in, instmap::in, list(case)::in, list(case)::out,
+ module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
+
+detect_switches_in_cases(_, _, _, _, [], [], !ModuleInfo, !Requant).
+detect_switches_in_cases(Var, VarTypes, AllowMulti, InstMap0,
+ [Case0 | Cases0], [Case | Cases], !ModuleInfo, !Requant) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ map.lookup(VarTypes, Var, VarType),
+ bind_var_to_functors(Var, VarType, MainConsId, OtherConsIds,
+ InstMap0, InstMap1, !ModuleInfo),
+ detect_switches_in_goal(VarTypes, AllowMulti, InstMap1,
+ Goal0, Goal, !ModuleInfo, !Requant),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ detect_switches_in_cases(Var, VarTypes, AllowMulti, InstMap0,
+ Cases0, Cases, !ModuleInfo, !Requant).
+
+:- pred detect_switches_in_conj(vartypes::in,
+ allow_multi_arm::in, instmap::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
+
+detect_switches_in_conj(_, _, _, [], [], !ModuleInfo, !Requant).
+detect_switches_in_conj(VarTypes, AllowMulti, InstMap0,
+ [Goal0 | Goals0], [Goal | Goals], !ModuleInfo, !Requant) :-
+ detect_switches_in_goal_update_instmap(VarTypes, AllowMulti,
+ InstMap0, InstMap1, Goal0, Goal, !ModuleInfo, !Requant),
+ detect_switches_in_conj(VarTypes, AllowMulti,
+ InstMap1, Goals0, Goals, !ModuleInfo, !Requant).
%-----------------------------------------------------------------------------%
- % partition_disj(Goals, Var, GoalInfo, VarTypes, ModuleInfo, Left, Cases):
+ % partition_disj(AllowMulti, Disjuncts, Var, GoalInfo, VarTypes,
+ % ModuleInfo, Left, Cases):
%
- % Attempts to partition the disjunction `Goals' into a switch on `Var'.
+ % Attempts to partition the disjunction `Disjuncts' into a switch on `Var'.
% If at least partially successful, returns the resulting `Cases', with
% any disjunction goals not fitting into the switch in Left.
%
@@ -416,95 +644,134 @@
% unifications at the start of each disjunction, to build up a
% substitution.
%
-:- pred partition_disj(list(hlds_goal)::in, prog_var::in, hlds_goal_info::in,
- list(hlds_goal)::out, sorted_case_list::out, bool::in, bool::out)
- is semidet.
-
-partition_disj(Goals0, Var, GoalInfo, Left, CasesList, !Requant) :-
- map.init(Cases0),
- partition_disj_trial(Goals0, Var, [], Left1, Cases0, Cases1),
- map.to_assoc_list(Cases1, CasesAssocList1),
+:- pred partition_disj(allow_multi_arm::in, list(hlds_goal)::in,
+ prog_var::in, hlds_goal_info::in, list(hlds_goal)::out, list(case)::out,
+ need_to_requantify::in, need_to_requantify::out) is semidet.
+
+partition_disj(AllowMulti, Disjuncts0, Var, GoalInfo, Left, Cases, !Requant) :-
+ CasesTable0 = cases_table(map.init, set_tree234.init),
+ partition_disj_trial(Disjuncts0, Var, [], Left1, CasesTable0, CasesTable1),
(
Left1 = [],
- CasesAssocList1 = [_ | _], % There must be at least one case.
+ % There must be at least one case in CasesTable1.
+ num_cases_in_table(CasesTable1) >= 1,
Left = Left1,
- fix_case_list(CasesAssocList1, GoalInfo, CasesList)
+ Cases = convert_cases_table(GoalInfo, CasesTable1)
;
Left1 = [_ | _],
- % We don't insist on CasesAssocList1 not being empty, to allow for
- % switches in which *all* cases contain subsidiary disjunctions.
- ( expand_sub_disjs(Var, Left1, Cases1, Cases) ->
+ % We don't insist on there being at least one case in CasesTable1,
+ % to allow for switches in which *all* cases contain subsidiary
+ % disjunctions.
+ ( expand_sub_disjs(AllowMulti, Var, Left1, CasesTable1, CasesTable) ->
Left = [],
- map.to_assoc_list(Cases, CasesAssocList),
- CasesAssocList = [_ | _], % There must be at least one case.
- fix_case_list(CasesAssocList, GoalInfo, CasesList),
- !:Requant = yes
+ num_cases_in_table(CasesTable) >= 1,
+ Cases = convert_cases_table(GoalInfo, CasesTable),
+ !:Requant = need_to_requantify
;
Left = Left1,
- fix_case_list(CasesAssocList1, GoalInfo, CasesList)
+ Cases = convert_cases_table(GoalInfo, CasesTable1)
)
).
%-----------------------------------------------------------------------------%
-:- pred expand_sub_disjs(prog_var::in, list(hlds_goal)::in,
- cases::in, cases::out) is semidet.
+:- pred expand_sub_disjs(allow_multi_arm::in, prog_var::in,
+ list(hlds_goal)::in, cases_table::in, cases_table::out) is semidet.
-expand_sub_disjs(_Var, [], !Cases).
-expand_sub_disjs(Var, [LeftGoal | LeftGoals], !Cases) :-
- expand_sub_disj(Var, LeftGoal, !Cases),
- expand_sub_disjs(Var, LeftGoals, !Cases).
+expand_sub_disjs(_AllowMulti, _Var, [], !CasesTable).
+expand_sub_disjs(AllowMulti, Var, [LeftGoal | LeftGoals], !CasesTable) :-
+ expand_sub_disj(AllowMulti, Var, LeftGoal, !CasesTable),
+ expand_sub_disjs(AllowMulti, Var, LeftGoals, !CasesTable).
-:- pred expand_sub_disj(prog_var::in, hlds_goal::in, cases::in, cases::out)
- is semidet.
+:- pred expand_sub_disj(allow_multi_arm::in, prog_var::in, hlds_goal::in,
+ cases_table::in, cases_table::out) is semidet.
-expand_sub_disj(Var, Goal, !Cases) :-
+expand_sub_disj(AllowMulti, Var, Goal, !CasesTable) :-
Goal = hlds_goal(GoalExpr, GoalInfo0),
goal_info_add_feature(feature_duplicated_for_switch, GoalInfo0, GoalInfo),
( GoalExpr = conj(plain_conj, SubGoals) ->
- expand_sub_disj_process_conj(Var, SubGoals, [], GoalInfo, !Cases)
+ expand_sub_disj_process_conj(AllowMulti, Var, SubGoals, [], GoalInfo,
+ !CasesTable)
; GoalExpr = disj(_) ->
- expand_sub_disj_process_conj(Var, [Goal], [], GoalInfo, !Cases)
+ expand_sub_disj_process_conj(AllowMulti, Var, [Goal], [], GoalInfo,
+ !CasesTable)
;
fail
).
-:- pred expand_sub_disj_process_conj(prog_var::in, list(hlds_goal)::in,
- list(hlds_goal)::in, hlds_goal_info::in, cases::in, cases::out) is semidet.
+:- pred expand_sub_disj_process_conj(allow_multi_arm::in, prog_var::in,
+ list(hlds_goal)::in, list(hlds_goal)::in, hlds_goal_info::in,
+ cases_table::in, cases_table::out) is semidet.
-expand_sub_disj_process_conj(Var, ConjGoals, !.RevUnifies, GoalInfo,
- !Cases) :-
+expand_sub_disj_process_conj(AllowMulti, Var, ConjGoals, !.RevUnifies,
+ GoalInfo, !CasesTable) :-
(
ConjGoals = [],
fail
;
- ConjGoals = [FirstGoal | RestGoals],
- FirstGoal = hlds_goal(FirstGoalExpr, _),
+ ConjGoals = [FirstGoal | LaterGoals],
+ FirstGoal = hlds_goal(FirstGoalExpr, FirstGoalInfo),
(
FirstGoalExpr = unify(_, _, _, _, _),
!:RevUnifies = [FirstGoal | !.RevUnifies],
- expand_sub_disj_process_conj(Var, RestGoals, !.RevUnifies,
- GoalInfo, !Cases)
+ expand_sub_disj_process_conj(AllowMulti, Var, LaterGoals,
+ !.RevUnifies, GoalInfo, !CasesTable)
;
FirstGoalExpr = disj(Disjuncts),
Disjuncts = [_ | _],
+ (
+ AllowMulti = allow_multi_arm,
+ !.RevUnifies = [],
+
+ % If the unifications pick up the values of variables,
+ % we would need to include in the switch arm of each cons_id
+ % not just LaterGoals, but also the disjunct in FirstGoal
+ % that does this picking up. This disjunct would have to be
+ % specific to each cons_id, so it could not be shared with
+ % other cons_ids.
+ NonLocals = goal_info_get_nonlocals(FirstGoalInfo),
+ set.delete(NonLocals, Var, OtherNonLocals),
+ set.empty(OtherNonLocals),
+
+ all_disjuncts_are_switch_var_unifies(Var, Disjuncts,
+ DisjConsIds),
+ list.sort(DisjConsIds, SortedDisjConsIds),
+ SortedDisjConsIds = [MainConsId | OtherConsIds]
+ ->
+ SharedGoal = hlds_goal(conj(plain_conj, LaterGoals), GoalInfo),
+ add_multi_entry(MainConsId, OtherConsIds, SharedGoal,
+ !CasesTable)
+ ;
list.reverse(!.RevUnifies, Unifies),
list.map(
- create_expanded_conjunction(Unifies, RestGoals, GoalInfo),
+ create_expanded_conjunction(Unifies, LaterGoals, GoalInfo),
Disjuncts, ExpandedConjunctions),
- partition_disj_trial(ExpandedConjunctions, Var, [], Left, !Cases),
+ partition_disj_trial(ExpandedConjunctions, Var, [], Left,
+ !CasesTable),
Left = []
)
+ )
).
+:- pred all_disjuncts_are_switch_var_unifies(prog_var::in,
+ list(hlds_goal)::in, list(cons_id)::out) is semidet.
+
+all_disjuncts_are_switch_var_unifies(_Var, [], []).
+all_disjuncts_are_switch_var_unifies(Var, [Goal | Goals],
+ [ConsId | ConsIds]) :-
+ Goal = hlds_goal(GoalExpr, _GoalInfo),
+ GoalExpr = unify(_LHS, _RHS, _, UnifyInfo0, _),
+ UnifyInfo0 = deconstruct(Var, ConsId, _, _, _, _),
+ all_disjuncts_are_switch_var_unifies(Var, Goals, ConsIds).
+
:- pred create_expanded_conjunction(list(hlds_goal)::in, list(hlds_goal)::in,
hlds_goal_info::in, hlds_goal::in, hlds_goal::out) is det.
-create_expanded_conjunction(Unifies, RestGoals, GoalInfo, Disjunct, Goal) :-
+create_expanded_conjunction(Unifies, LaterGoals, GoalInfo, Disjunct, Goal) :-
( Disjunct = hlds_goal(conj(plain_conj, DisjunctGoals), _) ->
- Conjuncts = Unifies ++ DisjunctGoals ++ RestGoals
+ Conjuncts = Unifies ++ DisjunctGoals ++ LaterGoals
;
- Conjuncts = Unifies ++ [Disjunct] ++ RestGoals
+ Conjuncts = Unifies ++ [Disjunct] ++ LaterGoals
),
Goal = hlds_goal(conj(plain_conj, Conjuncts), GoalInfo).
@@ -512,26 +779,20 @@
:- pred partition_disj_trial(list(hlds_goal)::in, prog_var::in,
list(hlds_goal)::in, list(hlds_goal)::out,
- cases::in, cases::out) is det.
+ cases_table::in, cases_table::out) is det.
-partition_disj_trial([], _Var, !Left, !Cases).
-partition_disj_trial([Goal0 | Goals], Var, !Left, !Cases) :-
- find_bind_var(Var, find_bind_var_for_switch_in_deconstruct, Goal0, Goal,
- no, MaybeFunctor, unit, _, _),
+partition_disj_trial([], _Var, !Left, !CasesTable).
+partition_disj_trial([Disjunct0 | Disjuncts0], Var, !Left, !CasesTable) :-
+ find_bind_var(Var, find_bind_var_for_switch_in_deconstruct, Disjunct0,
+ Disjunct, no, MaybeConsId, unit, _, _),
(
- MaybeFunctor = yes(Functor),
- ( map.search(!.Cases, Functor, DisjList0) ->
- DisjList = [Goal | DisjList0],
- map.det_update(!.Cases, Functor, DisjList, !:Cases)
- ;
- DisjList = [Goal],
- map.det_insert(!.Cases, Functor, DisjList, !:Cases)
- )
+ MaybeConsId = yes(ConsId),
+ add_single_entry(ConsId, Disjunct, !CasesTable)
;
- MaybeFunctor = no,
- !:Left = [Goal0 | !.Left]
+ MaybeConsId = no,
+ !:Left = [Disjunct0 | !.Left]
),
- partition_disj_trial(Goals, Var, !Left, !Cases).
+ partition_disj_trial(Disjuncts0, Var, !Left, !CasesTable).
:- pred find_bind_var_for_switch_in_deconstruct(prog_var::in, hlds_goal::in,
list(hlds_goal)::out, maybe(cons_id)::in, maybe(cons_id)::out,
@@ -575,13 +836,13 @@
DeconstructSearch),
(
DeconstructSearch = before_deconstruct,
- FoundDeconstruct = no
+ FoundDeconstruct = did_not_find_deconstruct
;
DeconstructSearch = found_deconstruct,
- FoundDeconstruct = yes
+ FoundDeconstruct = did_find_deconstruct
;
DeconstructSearch = given_up_search,
- FoundDeconstruct = no
+ FoundDeconstruct = did_not_find_deconstruct
).
:- type deconstruct_search
@@ -694,33 +955,36 @@
%-----------------------------------------------------------------------------%
-:- pred cases_to_switch(sorted_case_list::in, prog_var::in, vartypes::in,
- hlds_goal_info::in, instmap::in, module_info::in, hlds_goal_expr::out,
- bool::in, bool::out) is det.
+:- pred cases_to_switch(prog_var::in, vartypes::in, allow_multi_arm::in,
+ list(case)::in, instmap::in, hlds_goal_expr::out,
+ module_info::in, module_info::out,
+ need_to_requantify::in, need_to_requantify::out) is det.
-cases_to_switch(CasesList, Var, VarTypes, _GoalInfo, InstMap, ModuleInfo,
- Goal, !Requant) :-
+cases_to_switch(Var, VarTypes, AllowMulti, Cases0, InstMap, GoalExpr,
+ !ModuleInfo, !Requant) :-
instmap.lookup_var(InstMap, Var, VarInst),
- ( inst_is_bound_to_functors(ModuleInfo, VarInst, Functors) ->
- functors_to_cons_ids(Functors, ConsIds0),
- list.sort(ConsIds0, ConsIds),
- delete_unreachable_cases(CasesList, ConsIds, CasesList1),
- ( list.same_length(Functors, CasesList1) ->
- CanFail = cannot_fail
- ;
- CanFail = can_fail
- )
+ ( inst_is_bound_to_functors(!.ModuleInfo, VarInst, Functors) ->
+ functors_to_cons_ids(Functors, ConsIds),
+ delete_unreachable_cases(Cases0, ConsIds, Cases1),
+ CanFail = compute_can_fail(ConsIds, Cases1)
;
+ Cases1 = Cases0,
map.lookup(VarTypes, Var, Type),
- CasesList1 = CasesList,
- ( switch_covers_all_cases(ModuleInfo, Type, CasesList1) ->
- CanFail = cannot_fail
+ ( switch_type_num_functors(!.ModuleInfo, Type, NumFunctors) ->
+ % We could check for each cons_id of the type whether a case covers
+ % it, but given that type checking ensures that the set of covered
+ % cons_ids is a subset of the set of cons_ids of the type, checking
+ % whether the cardinalities of the two sets match is *equivalent*
+ % to checking whether they are the same set.
+ CanFail = switch_covers_n_cases(NumFunctors, Cases1)
;
+ % switch_type_num_functors fails only for types on which
+ % you cannot have a complete switch, e.g. integers and strings.
CanFail = can_fail
)
),
- detect_switches_in_cases(ModuleInfo, VarTypes, InstMap,
- CasesList1, Cases, !Requant),
+ detect_switches_in_cases(Var, VarTypes, AllowMulti, InstMap,
+ Cases1, Cases, !ModuleInfo, !Requant),
% We turn switches with no arms into fail, since this avoids having
% the code generator flush the control variable of the switch.
@@ -730,36 +994,54 @@
% nonexistent anyway.
(
Cases = [],
- Goal = disj([])
+ GoalExpr = disj([])
;
Cases = [_ | _],
- Goal = switch(Var, CanFail, Cases)
+ GoalExpr = switch(Var, CanFail, Cases)
+ ).
+
+:- func compute_can_fail(list(cons_id), list(case)) = can_fail.
+
+compute_can_fail(Functors, Cases) = SwitchCanFail :-
+ UncoveredFunctors0 = set_tree234.list_to_set(Functors),
+ delete_covered_functors(Cases, UncoveredFunctors0, UncoveredFunctors),
+ ( set_tree234.empty(UncoveredFunctors) ->
+ SwitchCanFail = cannot_fail
+ ;
+ SwitchCanFail = can_fail
).
- % Check whether a switch handles all the possible constants/functors
- % for the type.
+ % Delete from !UncoveredConsIds all cons_ids mentioned in any of the cases.
%
-:- pred switch_covers_all_cases(module_info::in, mer_type::in,
- sorted_case_list::in) is semidet.
+:- pred delete_covered_functors(list(case)::in,
+ set_tree234(cons_id)::in, set_tree234(cons_id)::out) is det.
-switch_covers_all_cases(ModuleInfo, Type, CasesList) :-
- switch_type_num_functors(ModuleInfo, Type, NumFunctors),
- list.length(CasesList, NumCases),
- NumCases = NumFunctors.
+delete_covered_functors([], !UncoveredConsIds).
+delete_covered_functors([Case | Cases], !UncoveredConsIds) :-
+ Case = case(MainConsId, OtherConsIds, _Goal),
+ set_tree234.delete(MainConsId, !UncoveredConsIds),
+ list.foldl(set_tree234.delete, OtherConsIds, !UncoveredConsIds),
+ delete_covered_functors(Cases, !UncoveredConsIds).
- % Convert the assoc_list(cons_id, list(hlds_goal)) back into a plain
- % list(case).
+ % Check whether a switch handles the given number of cons_ids.
%
-:- pred fix_case_list(assoc_list(cons_id, list(hlds_goal))::in,
- hlds_goal_info::in, list(case)::out) is det.
+:- func switch_covers_n_cases(int, list(case)) = can_fail.
+
+switch_covers_n_cases(NumFunctors, Cases) = SwitchCanFail :-
+ NumCoveredConsIds = count_covered_cons_ids(Cases),
+ ( NumCoveredConsIds = NumFunctors ->
+ SwitchCanFail = cannot_fail
+ ;
+ SwitchCanFail = can_fail
+ ).
+
+:- func count_covered_cons_ids(list(case)) = int.
-fix_case_list([], _, []).
-fix_case_list([Functor - DisjList0 | Cases0], GoalInfo,
- [case(Functor, Goal) | Cases]) :-
- % We need to put the list back the right way around.
- list.reverse(DisjList0, DisjList),
- disj_list_to_goal(DisjList, GoalInfo, Goal),
- fix_case_list(Cases0, GoalInfo, Cases).
+count_covered_cons_ids([]) = 0.
+count_covered_cons_ids([Case | Cases]) = CaseCount + CasesCount :-
+ Case = case(_MainConsId, OtherConsIds, _Goal),
+ CaseCount = 1 + list.length(OtherConsIds),
+ CasesCount = count_covered_cons_ids(Cases).
%-----------------------------------------------------------------------------%
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.106
diff -u -b -r1.106 switch_gen.m
--- compiler/switch_gen.m 26 Nov 2007 05:13:21 -0000 1.106
+++ compiler/switch_gen.m 13 Dec 2007 09:09:20 -0000
@@ -69,6 +69,8 @@
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_out.
+:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module libs.tree.
@@ -81,48 +83,56 @@
:- import_module ll_backend.unify_gen.
:- import_module parse_tree.prog_type.
+:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module pair.
+:- import_module string.
%-----------------------------------------------------------------------------%
-generate_switch(CodeModel, CaseVar, CanFail, Cases, GoalInfo, Code, !CI) :-
+generate_switch(CodeModel, Var, CanFail, Cases, GoalInfo, Code, !CI) :-
% Choose which method to use to generate the switch.
% CanFail says whether the switch covers all cases.
goal_info_get_store_map(GoalInfo, StoreMap),
get_next_label(EndLabel, !CI),
- lookup_tags(!.CI, Cases, CaseVar, TaggedCases0),
+ get_module_info(!.CI, ModuleInfo),
+ VarType = variable_type(!.CI, Var),
+ tag_cases(ModuleInfo, VarType, Cases, TaggedCases0, MaybeIntSwitchInfo),
list.sort_and_remove_dups(TaggedCases0, TaggedCases),
get_globals(!.CI, Globals),
globals.lookup_bool_option(Globals, smart_indexing, Indexing),
- CaseVarType = variable_type(!.CI, CaseVar),
- type_to_ctor_det(CaseVarType, CaseVarTypeCtor),
- get_module_info(!.CI, ModuleInfo),
- TypeCategory = classify_type(ModuleInfo, CaseVarType),
+ type_to_ctor_det(VarType, VarTypeCtor),
+ TypeCategory = classify_type(ModuleInfo, VarType),
SwitchCategory = switch_util.type_cat_to_switch_cat(TypeCategory),
+
+ VarName = variable_name(!.CI, Var),
+ produce_variable(Var, VarCode, VarRval, !CI),
(
(
Indexing = no
;
module_info_get_type_table(ModuleInfo, TypeTable),
% The search will fail for builtin types.
- map.search(TypeTable, CaseVarTypeCtor, CaseVarTypeDefn),
- hlds_data.get_type_defn_body(CaseVarTypeDefn, CaseVarTypeBody),
- CaseVarTypeBody ^ du_type_reserved_addr = uses_reserved_address
+ map.search(TypeTable, VarTypeCtor, VarTypeDefn),
+ hlds_data.get_type_defn_body(VarTypeDefn, VarTypeBody),
+ VarTypeBody ^ du_type_reserved_addr = uses_reserved_address
)
->
- order_and_generate_cases(TaggedCases, CaseVar, CodeModel, CanFail,
- GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ order_and_generate_cases(TaggedCases, VarRval, VarType, VarName,
+ CodeModel, CanFail, GoalInfo, EndLabel, no, MaybeEnd, SwitchCode,
+ !CI)
;
(
SwitchCategory = atomic_switch,
list.length(TaggedCases, NumCases),
(
+ MaybeIntSwitchInfo =
+ int_switch(LowerLimit, UpperLimit, NumValues),
get_maybe_trace_info(!.CI, MaybeTraceInfo),
MaybeTraceInfo = no,
globals.lookup_int_option(Globals, lookup_switch_size,
@@ -130,57 +140,67 @@
NumCases >= LookupSize,
globals.lookup_int_option(Globals, lookup_switch_req_density,
ReqDensity),
- is_lookup_switch(CaseVar, TaggedCases, GoalInfo, CanFail,
- ReqDensity, StoreMap, no, MaybeEndPrime, CodeModel,
- LookupSwitchInfo, !CI)
+ is_lookup_switch(VarType, TaggedCases, LowerLimit, UpperLimit,
+ NumValues, GoalInfo, CanFail, ReqDensity, StoreMap,
+ no, MaybeEndPrime, CodeModel, LookupSwitchInfo, !CI)
->
MaybeEnd = MaybeEndPrime,
- generate_lookup_switch(CaseVar, StoreMap, no, LookupSwitchInfo,
- Code, !CI)
+ generate_lookup_switch(VarRval, StoreMap, no, LookupSwitchInfo,
+ SwitchCode, !CI)
;
+ MaybeIntSwitchInfo =
+ int_switch(LowerLimit, UpperLimit, NumValues),
globals.lookup_int_option(Globals, dense_switch_size,
DenseSize),
NumCases >= DenseSize,
globals.lookup_int_option(Globals, dense_switch_req_density,
ReqDensity),
- cases_list_is_dense_switch(!.CI, CaseVar, TaggedCases, CanFail,
- ReqDensity, FirstVal, LastVal, CanFail1)
- ->
- generate_dense_switch(TaggedCases, FirstVal, LastVal, CaseVar,
- CodeModel, CanFail1, GoalInfo, EndLabel, no, MaybeEnd,
- Code, !CI)
- ;
- order_and_generate_cases(TaggedCases, CaseVar, CodeModel,
- CanFail, GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ tagged_case_list_is_dense_switch(!.CI, VarType, TaggedCases,
+ LowerLimit, UpperLimit, NumValues, ReqDensity, CanFail,
+ DenseSwitchInfo)
+ ->
+ generate_dense_switch(TaggedCases, VarRval, VarName, CodeModel,
+ GoalInfo, DenseSwitchInfo, EndLabel,
+ no, MaybeEnd, SwitchCode, !CI)
+ ;
+ order_and_generate_cases(TaggedCases, VarRval, VarType,
+ VarName, CodeModel, CanFail, GoalInfo, EndLabel,
+ no, MaybeEnd, SwitchCode, !CI)
)
;
SwitchCategory = string_switch,
list.length(TaggedCases, NumCases),
globals.lookup_int_option(Globals, string_switch_size, StringSize),
( NumCases >= StringSize ->
- generate_string_switch(TaggedCases, CaseVar, CodeModel,
- CanFail, GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
- ;
- order_and_generate_cases(TaggedCases, CaseVar, CodeModel,
- CanFail, GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ generate_string_switch(TaggedCases, VarRval, VarName,
+ CodeModel, CanFail, GoalInfo, EndLabel,
+ no, MaybeEnd, SwitchCode, !CI)
+ ;
+ order_and_generate_cases(TaggedCases, VarRval, VarType,
+ VarName, CodeModel, CanFail, GoalInfo, EndLabel,
+ no, MaybeEnd, SwitchCode, !CI)
)
;
SwitchCategory = tag_switch,
list.length(TaggedCases, NumCases),
globals.lookup_int_option(Globals, tag_switch_size, TagSize),
( NumCases >= TagSize ->
- generate_tag_switch(TaggedCases, CaseVar, CodeModel, CanFail,
- GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
- ;
- order_and_generate_cases(TaggedCases, CaseVar, CodeModel,
- CanFail, GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ generate_tag_switch(TaggedCases, VarRval, VarType, VarName,
+ CodeModel, CanFail, GoalInfo, EndLabel, no, MaybeEnd,
+ SwitchCode, !CI)
+ ;
+ order_and_generate_cases(TaggedCases, VarRval, VarType,
+ VarName, CodeModel, CanFail, GoalInfo, EndLabel,
+ no, MaybeEnd, SwitchCode, !CI)
)
;
SwitchCategory = other_switch,
- order_and_generate_cases(TaggedCases, CaseVar, CodeModel,
- CanFail, GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ order_and_generate_cases(TaggedCases, VarRval, VarType,
+ VarName, CodeModel, CanFail, GoalInfo, EndLabel,
+ no, MaybeEnd, SwitchCode, !CI)
)
),
+ Code = tree(VarCode, SwitchCode),
after_all_branches(StoreMap, MaybeEnd, !CI).
%-----------------------------------------------------------------------------%
@@ -190,26 +210,13 @@
%
:- func determine_switch_category(code_info, prog_var) = switch_category.
-determine_switch_category(CI, CaseVar) = SwitchCategory :-
- Type = variable_type(CI, CaseVar),
+determine_switch_category(CI, Var) = SwitchCategory :-
+ Type = variable_type(CI, Var),
get_module_info(CI, ModuleInfo),
classify_type(ModuleInfo, Type) = TypeCategory,
SwitchCategory = switch_util.type_cat_to_switch_cat(TypeCategory).
%-----------------------------------------------------------------------------%
-
-:- pred lookup_tags(code_info::in, list(case)::in, prog_var::in,
- cases_list::out) is det.
-
-lookup_tags(_, [], _, []).
-lookup_tags(CI, [Case | Cases], Var, [TaggedCase | TaggedCases]) :-
- Case = case(ConsId, Goal),
- Tag = cons_id_to_tag_for_var(CI, Var, ConsId),
- Priority = switch_util.switch_priority(Tag),
- TaggedCase = extended_case(Priority, Tag, ConsId, Goal),
- lookup_tags(CI, Cases, Var, TaggedCases).
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Generate a switch as a chain of if-then-elses.
@@ -237,27 +244,33 @@
% and put that one first. This minimizes the number of pipeline
% breaks caused by taken branches.
%
-:- pred order_and_generate_cases(list(extended_case)::in, prog_var::in,
- code_model::in, can_fail::in, hlds_goal_info::in, label::in,
+:- 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, code_tree::out,
code_info::in, code_info::out) is det.
-order_and_generate_cases(Cases0, Var, CodeModel, CanFail, GoalInfo, EndLabel,
- !MaybeEnd, Code, !CI) :-
- % XXX We should use _VarRval below; we shouldn't produce the variable
- % again.
- produce_variable(Var, VarCode, _VarRval, !CI),
- VarType = variable_type(!.CI, Var),
- order_cases(Cases0, Cases, VarType, CodeModel, CanFail, !.CI),
- generate_if_then_else_chain_cases(Cases, Var, CodeModel, CanFail, GoalInfo,
- EndLabel, !MaybeEnd, CasesCode, !CI),
- Code = tree(VarCode, CasesCode).
+order_and_generate_cases(TaggedCases, VarRval, VarType, VarName, CodeModel,
+ CanFail, GoalInfo, EndLabel, !MaybeEnd, Code, !CI) :-
+ order_cases(TaggedCases, OrderedTaggedCases, VarType, CodeModel, CanFail,
+ !.CI),
+ type_to_ctor_det(VarType, TypeCtor),
+ get_module_info(!.CI, ModuleInfo),
+ module_info_get_type_table(ModuleInfo, TypeTable),
+ ( map.search(TypeTable, TypeCtor, TypeDefn) ->
+ get_type_defn_body(TypeDefn, TypeBody),
+ CheaperTagTest = get_maybe_cheaper_tag_test(TypeBody)
+ ;
+ CheaperTagTest = no_cheaper_tag_test
+ ),
+ generate_if_then_else_chain_cases(OrderedTaggedCases, VarRval, VarType,
+ VarName, CheaperTagTest, CodeModel, CanFail, GoalInfo, EndLabel,
+ !MaybeEnd, Code, !CI).
-:- pred order_cases(list(extended_case)::in, list(extended_case)::out,
+:- 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.
order_cases(Cases0, Cases, VarType, CodeModel, CanFail, CI) :-
- % We do ordering here based on three out of four considerations.
+ % We do ordering here based on five considerations.
%
% - We try to put tests against reserved addresses first, so later cases
% can assume those tests have already been done.
@@ -266,17 +279,25 @@
% - If the recursion structure of the predicate is sufficiently simple that
% we can make a good guess at which case will be executed more
% frequently, we try to put the frequent case first.
- % - We try to put cheap-to-execute tests first.
+ % - We try to put cheap-to-execute tests first; for arms with more than one
+ % cons_id, we sum the costs of their tests. The main aim of this is to
+ % reduce the average cost at runtime. For cannot_fail switches, putting
+ % the most expensive-to-test case last has the additional benefit that
+ % we don't ever need to execute that test, since the failure of all the
+ % previous ones guarantees that it could not fail. This should be
+ % especially useful for switches in which many cons_ids share a single
+ % arm.
+ %
+ % Each consideration is implemented by its own predicate, which calls the
+ % predicate of the next consideration to decide ties. The predicates for
+ % the four considerations are
+ %
+ % - order_cases,
+ % - order_cannot_succeed_cases,
+ % - order_recursive_cases,
+ % - order_tag_test_cost
%
- % order_cases acts on the first consideration. order_cannot_succeed_cases
- % acts on the second and indirectly (by calling order_recursive_cases) the
- % third.
- %
- % The fourth consideration has already been acted upon when the switch
- % priorities were put into each extended case, and the list of cases sorted
- % on that priority. That is why we take care not to upset the existing
- % order except when one of the first three considerations dictate a need
- % to do so.
+ % respectively.
(
search_type_defn(CI, VarType, VarTypeDefn),
@@ -285,31 +306,64 @@
->
separate_reserved_address_cases(Cases0,
ReservedAddrCases0, NonReservedAddrCases0),
- order_cannot_succeed_cases(ReservedAddrCases0, ReservedAddrCases,
+ order_can_and_cannot_succeed_cases(
+ ReservedAddrCases0, ReservedAddrCases,
CodeModel, CanFail, CI),
- order_cannot_succeed_cases(NonReservedAddrCases0, NonReservedAddrCases,
+ order_can_and_cannot_succeed_cases(
+ NonReservedAddrCases0, NonReservedAddrCases,
CodeModel, CanFail, CI),
Cases = ReservedAddrCases ++ NonReservedAddrCases
;
% The type is either not a discriminated union type (e.g. in int or
% string), or it is a discriminated union type that does not use
% reserved addresses.
- order_cannot_succeed_cases(Cases0, Cases, CodeModel, CanFail, CI)
+ order_can_and_cannot_succeed_cases(Cases0, Cases,
+ CodeModel, CanFail, CI)
).
-:- pred separate_reserved_address_cases(list(extended_case)::in,
- list(extended_case)::out, list(extended_case)::out) is det.
+%-----------------------------------------------------------------------------%
+
+:- pred separate_reserved_address_cases(list(tagged_case)::in,
+ list(tagged_case)::out, list(tagged_case)::out) is det.
separate_reserved_address_cases([], [], []).
-separate_reserved_address_cases([Case | Cases],
+separate_reserved_address_cases([TaggedCase | TaggedCases],
ReservedAddrCases, NonReservedAddrCases) :-
- separate_reserved_address_cases(Cases,
- ReservedAddrCases1, NonReservedAddrCases1),
- Case = extended_case(_, ConsTag, _, _),
+ separate_reserved_address_cases(TaggedCases,
+ ReservedAddrCasesTail, NonReservedAddrCasesTail),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, _),
+ TaggedConsIds = [TaggedMainConsId | TaggedOtherConsIds],
+ ContainsReservedAddr = list_contains_reserved_addr_tag(TaggedConsIds),
+ (
+ ContainsReservedAddr = yes,
+ ReservedAddrCases = [TaggedCase | ReservedAddrCasesTail],
+ NonReservedAddrCases = NonReservedAddrCasesTail
+ ;
+ ContainsReservedAddr = no,
+ ReservedAddrCases = ReservedAddrCasesTail,
+ NonReservedAddrCases = [TaggedCase | NonReservedAddrCasesTail]
+ ).
+
+:- func list_contains_reserved_addr_tag(list(tagged_cons_id)) = bool.
+
+list_contains_reserved_addr_tag([]) = no.
+list_contains_reserved_addr_tag([TaggedConsId | TaggedConsIds]) = Contains :-
+ HeadContains = is_reserved_addr_tag(TaggedConsId),
+ (
+ HeadContains = yes,
+ Contains = yes
+ ;
+ HeadContains = no,
+ Contains = list_contains_reserved_addr_tag(TaggedConsIds)
+ ).
+
+:- func is_reserved_addr_tag(tagged_cons_id) = bool.
+
+is_reserved_addr_tag(TaggedConsId) = IsReservedAddr :-
+ TaggedConsId = tagged_cons_id(_, ConsTag),
(
ConsTag = reserved_address_tag(_),
- ReservedAddrCases = [Case | ReservedAddrCases1],
- NonReservedAddrCases = NonReservedAddrCases1
+ IsReservedAddr = yes
;
( ConsTag = no_tag
; ConsTag = base_typeclass_info_tag(_, _, _)
@@ -328,15 +382,16 @@
; ConsTag = type_ctor_info_tag(_, _, _)
; ConsTag = unshared_tag(_)
),
- ReservedAddrCases = ReservedAddrCases1,
- NonReservedAddrCases = [Case | NonReservedAddrCases1]
+ IsReservedAddr = no
).
-:- pred order_cannot_succeed_cases(
- list(extended_case)::in, list(extended_case)::out,
+%-----------------------------------------------------------------------------%
+
+:- pred order_can_and_cannot_succeed_cases(
+ list(tagged_case)::in, list(tagged_case)::out,
code_model::in, can_fail::in, code_info::in) is det.
-order_cannot_succeed_cases(Cases0, Cases, CodeModel, CanFail, CI) :-
+order_can_and_cannot_succeed_cases(Cases0, Cases, CodeModel, CanFail, CI) :-
separate_cannot_succeed_cases(Cases0, CanSucceedCases, CannotSucceedCases),
(
CannotSucceedCases = [],
@@ -347,15 +402,15 @@
Cases = CanSucceedCases ++ CannotSucceedCases
).
-:- pred separate_cannot_succeed_cases(list(extended_case)::in,
- list(extended_case)::out, list(extended_case)::out) is det.
+:- pred separate_cannot_succeed_cases(list(tagged_case)::in,
+ list(tagged_case)::out, list(tagged_case)::out) is det.
separate_cannot_succeed_cases([], [], []).
separate_cannot_succeed_cases([Case | Cases],
CanSucceedCases, CannotSucceedCases) :-
separate_cannot_succeed_cases(Cases,
CanSucceedCases1, CannotSucceedCases1),
- Case = extended_case(_, _, _, Goal),
+ Case = tagged_case(_, _, Goal),
Goal = hlds_goal(_, GoalInfo),
Detism = goal_info_get_determinism(GoalInfo),
determinism_components(Detism, _CanFail, SolnCount),
@@ -372,8 +427,9 @@
CannotSucceedCases = [Case | CannotSucceedCases1]
).
-:- pred order_recursive_cases(
- list(extended_case)::in, list(extended_case)::out,
+%-----------------------------------------------------------------------------%
+
+:- pred order_recursive_cases(list(tagged_case)::in, list(tagged_case)::out,
code_model::in, can_fail::in, code_info::in) is det.
order_recursive_cases(Cases0, Cases, CodeModel, CanFail, CI) :-
@@ -381,8 +437,8 @@
CodeModel = model_det,
CanFail = cannot_fail,
Cases0 = [Case1, Case2],
- Case1 = extended_case(_, _, _, Goal1),
- Case2 = extended_case(_, _, _, Goal2)
+ Case1 = tagged_case(_, _, Goal1),
+ Case2 = tagged_case(_, _, Goal2)
->
get_module_info(CI, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
@@ -443,24 +499,46 @@
Cases = [MultiRecCase, BaseCase]
)
;
- Cases = Cases0
+ order_tag_test_cost(Cases0, Cases)
)
;
- Cases = Cases0
+ order_tag_test_cost(Cases0, Cases)
).
%-----------------------------------------------------------------------------%
-:- pred generate_if_then_else_chain_cases(list(extended_case)::in,
- prog_var::in, code_model::in, can_fail::in, hlds_goal_info::in, label::in,
+:- pred order_tag_test_cost(list(tagged_case)::in, list(tagged_case)::out)
+ is det.
+
+order_tag_test_cost(Cases0, Cases) :-
+ CostedCases = list.map(estimate_cost_of_case_test, Cases0),
+ list.sort(CostedCases, SortedCostedCases),
+ assoc_list.values(SortedCostedCases, Cases).
+
+:- func estimate_cost_of_case_test(tagged_case) = pair(int, tagged_case).
+
+estimate_cost_of_case_test(TaggedCase) = Cost - TaggedCase :-
+ TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _Goal),
+ MainTag = project_tagged_cons_id_tag(MainTaggedConsId),
+ MainCost = estimate_switch_tag_test_cost(MainTag),
+ OtherTags = list.map(project_tagged_cons_id_tag, OtherTaggedConsIds),
+ OtherCosts = list.map(estimate_switch_tag_test_cost, OtherTags),
+ Cost = list.foldl(int.plus, [MainCost | OtherCosts], 0).
+
+%-----------------------------------------------------------------------------%
+
+:- pred generate_if_then_else_chain_cases(list(tagged_case)::in,
+ rval::in, mer_type::in, string::in, maybe_cheaper_tag_test::in,
+ code_model::in, can_fail::in, hlds_goal_info::in, label::in,
branch_end::in, branch_end::out, code_tree::out,
code_info::in, code_info::out) is det.
-generate_if_then_else_chain_cases(Cases, Var, CodeModel, CanFail,
- SwitchGoalInfo, EndLabel, !MaybeEnd, Code, !CI) :-
+generate_if_then_else_chain_cases(Cases, VarRval, VarType, VarName,
+ CheaperTagTest, CodeModel, CanFail, SwitchGoalInfo, EndLabel,
+ !MaybeEnd, Code, !CI) :-
(
Cases = [HeadCase | TailCases],
- HeadCase = extended_case(_, _, Cons, Goal),
+ HeadCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, Goal),
remember_position(!.CI, BranchStart),
goal_info_get_store_map(SwitchGoalInfo, StoreMap),
(
@@ -468,29 +546,38 @@
; CanFail = can_fail
)
->
- unify_gen.generate_tag_test(Var, Cons, branch_on_failure,
- NextLabel, TestCode, !CI),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
+ generate_raw_tag_test_case(VarRval, VarType, VarName,
+ MainTaggedConsId, OtherTaggedConsIds, CheaperTagTest,
+ branch_on_failure, NextLabel, TestCode, !CI),
ElseCode = node([
llds_instr(goto(code_label(EndLabel)),
- "skip to the end of the switch"),
+ "skip to the end of the switch on " ++ VarName),
llds_instr(label(NextLabel), "next case")
- ]),
- HeadCaseCode = tree_list([TestCode, TraceCode, GoalCode, SaveCode,
- ElseCode])
+ ])
;
+ % When debugging code generator output, need a way to tell which
+ % case's code is next. We normally hang this comment on the test,
+ % but in this case there is no test.
+ project_cons_name_and_tag(MainTaggedConsId, MainConsName, _),
+ list.map2(project_cons_name_and_tag, OtherTaggedConsIds,
+ OtherConsNames, _),
+ Comment = case_comment(VarName, MainConsName, OtherConsNames),
+ TestCode = node([
+ llds_instr(comment(Comment), "")
+ ]),
+ ElseCode = empty
+ ),
+
maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
!CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
+ generate_goal(CodeModel, Goal, GoalCode, !CI),
generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- HeadCaseCode = tree_list([TraceCode, GoalCode, SaveCode])
- ),
+ HeadCaseCode = tree_list([TestCode, TraceCode, GoalCode, SaveCode,
+ ElseCode]),
reset_to_position(BranchStart, !CI),
- generate_if_then_else_chain_cases(TailCases, Var, CodeModel, CanFail,
- SwitchGoalInfo, EndLabel, !MaybeEnd, TailCasesCode, !CI),
+ generate_if_then_else_chain_cases(TailCases, VarRval, VarType, VarName,
+ CheaperTagTest, CodeModel, CanFail, SwitchGoalInfo, EndLabel,
+ !MaybeEnd, TailCasesCode, !CI),
Code = tree(HeadCaseCode, TailCasesCode)
;
Cases = [],
@@ -504,8 +591,15 @@
CanFail = cannot_fail,
FailCode = empty
),
- EndCode = node([llds_instr(label(EndLabel), "end of switch")]),
+ EndCode = node([llds_instr(label(EndLabel),
+ "end of the switch on " ++ VarName)]),
Code = tree(FailCode, EndCode)
).
%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "switch_gen.m".
+
+%-----------------------------------------------------------------------------%
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.39
diff -u -b -r1.39 switch_util.m
--- compiler/switch_util.m 23 Nov 2007 07:35:26 -0000 1.39
+++ compiler/switch_util.m 13 Dec 2007 08:55:21 -0000
@@ -7,7 +7,7 @@
%-----------------------------------------------------------------------------%
%
% File: switch_util.m.
-% Author: fjh.
+% Authors: fjh, zs.
%
% This module defines stuff for generating switches that is shared
% between the MLDS and LLDS back-ends.
@@ -30,18 +30,39 @@
:- import_module list.
:- import_module map.
:- import_module pair.
+:- import_module unit.
%-----------------------------------------------------------------------------%
%
-% Stuff for categorizing switches
+% General stuff, for adding tags to cons_ids in switches and for representing
+% switch arms.
%
-% An extended_case is an HLDS case annotated with some additional info.
-% The first (int) field is the priority, as computed by switch_priority/2.
+:- type maybe_int_switch_info
+ ---> int_switch(
+ lower_limit :: int,
+ upper_limit :: int,
+ num_values :: int
+ )
+ ; not_int_switch.
+
+ % tag_cases(ModuleInfo, Type, Cases, TaggedCases, MaybeIntSwitchInfo):
+ %
+ % Given a switch on a variable of type Type, tag each case in Cases
+ % with the tags corresponding to its cons_ids. If all tags are integers,
+ % return the lower and upper limits on these integers, as well as a count
+ % of how many of them there are.
+ %
+:- pred tag_cases(module_info::in, mer_type::in, list(case)::in,
+ list(tagged_case)::out, maybe_int_switch_info::out) is det.
-:- type extended_case
- ---> extended_case(int, cons_tag, cons_id, hlds_goal).
-:- type cases_list == list(extended_case).
+:- pred represent_tagged_case_by_itself(tagged_case::in, tagged_case::out,
+ unit::in, unit::out, unit::in, unit::out, unit::in, unit::out) is det.
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff for categorizing switches.
+%
:- type switch_category
---> atomic_switch % a switch on int/char/enum
@@ -53,21 +74,27 @@
%
:- func type_cat_to_switch_cat(type_category) = switch_category.
- % Return the priority of a constructor test.
- % A low number here indicates a high priority.
- % We prioritize the tag tests so that the cheapest
- % (most efficient) ones come first.
+ % Return an estimate of the runtime cost of a constructor test for the
+ % given tag. We try to put the cheap tests first.
%
-:- func switch_priority(cons_tag) = int.
+ % Abort on cons_tags that should never be switched on.
+ %
+:- func estimate_switch_tag_test_cost(cons_tag) = int.
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff for dense switches.
+%
- % type_range(TypeCategory, Type, ModuleInfo, Min, Max):
+ % type_range(ModuleInfo, TypeCategory, Type, Min, Max, NumValues):
%
- % Determine the range [Min..Max] of an atomic type.
+ % Determine the range [Min..Max] of an atomic type, and the number of
+ % values in that range (including both endpoints).
% Fail if the type isn't the sort of type that has a range
% or if the type's range is too big to switch on (e.g. int).
%
-:- pred type_range(type_category::in, mer_type::in, module_info::in,
- int::out, int::out) is semidet.
+:- pred type_range(module_info::in, type_category::in, mer_type::in,
+ int::out, int::out, int::out) is semidet.
% Calculate the percentage density given the range and the number of cases.
%
@@ -75,19 +102,22 @@
%-----------------------------------------------------------------------------%
%
-% Stuff for string hash switches
+% Stuff for string hash switches.
%
% For a string switch, compute the hash value for each case in the list
% of cases, and store the cases in a map from hash values to cases.
%
-:- pred string_hash_cases(cases_list::in, int::in, map(int, cases_list)::out)
- is det.
+:- pred string_hash_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))::out) is det.
-:- type hash_slot
- ---> hash_slot(extended_case, int).
+:- type string_hash_slot(CaseRep)
+ ---> string_hash_slot(int, string, CaseRep).
- % calc_hash_slots(AssocList, HashMap, Map):
+ % 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
@@ -96,55 +126,77 @@
% hash value for one of the other cases), and use it instead.
% Keep track of the hash chains as we do this.
%
-:- pred calc_hash_slots(assoc_list(int, cases_list)::in,
- map(int, cases_list)::in, map(int, hash_slot)::out) is det.
+ % 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.
%-----------------------------------------------------------------------------%
%
-% Stuff for tag switches
+% Stuff for tag switches.
+%
+
+% Map secondary tag values (-1 stands for none) to information about their
+% switch arm. This "information about the switch arm" is polymorphic, because
+% in the presence of switch arms that correspond to more than one cons_id,
+% cons_ids whose tags may not all use the same primary tag, we will need to
+% duplicate this information, with at least one copy per primary tag.
+%
+% In the LLDS backend, we can (and do) give a label to each goal. The
+% predicates in this module will duplicate only the label, and our caller
+% has the responsibility of ensuring that each label/goal pair is defined
+% only once.
%
+% With the MLDS, we don't (yet) do this, because some MLDS backends (e.g. Java)
+% don't support labels. Instead, if need be we duplicate the HLDS goal, which
+% means we will generate MLDS code for it more than once.
-% Map secondary tag values (-1 stands for none) to their goal.
-:- type stag_goal ---> stag_goal(cons_id, hlds_goal).
-:- type stag_goal_map == map(int, stag_goal).
-:- type stag_goal_list == assoc_list(int, stag_goal).
+:- type stag_goal_map(CaseRep) == map(int, CaseRep).
+:- type stag_goal_list(CaseRep) == assoc_list(int, CaseRep).
-% Map primary tag values to the set of their goals.
-:- type ptag_case ---> ptag_case(sectag_locn, stag_goal_map).
-:- type ptag_case_map == map(tag_bits, ptag_case).
-:- type ptag_case_list == assoc_list(tag_bits, ptag_case).
+% Map primary tag values to the set of their switch arms.
+
+:- type ptag_case(CaseRep)
+ ---> ptag_case(sectag_locn, stag_goal_map(CaseRep)).
+:- type ptag_case_map(CaseRep) == map(tag_bits, ptag_case(CaseRep)).
+:- type ptag_case_list(CaseRep) == assoc_list(tag_bits, ptag_case(CaseRep)).
% Map primary tag values to the number of constructors sharing them.
+
:- type ptag_count_map == map(tag_bits, pair(sectag_locn, int)).
:- type ptag_count_list == assoc_list(tag_bits, pair(sectag_locn, int)).
% Group together all the cases that depend on the given variable
% having the same primary tag value.
%
-:- pred group_cases_by_ptag(cases_list::in, ptag_case_map::in,
- ptag_case_map::out) is det.
+ % XXX
+:- pred group_cases_by_ptag(list(tagged_case)::in,
+ pred(tagged_case, CaseRep, StateA, StateA, StateB, StateB, StateC, StateC)
+ ::in(pred(in, out, in, out, in, out, in, out) is det),
+ StateA::in, StateA::out, StateB::in, StateB::out, StateC::in, StateC::out,
+ ptag_case_map(CaseRep)::in, ptag_case_map(CaseRep)::out) is det.
- % Order the primary tags based on the number of secondary tags
- % associated with them, putting the ones with the most secondary tags
- % first.
+ % Order the primary tags based on the number of secondary tags associated
+ % with them, putting the ones with the most secondary tags first.
%
% Note that it is not an error for a primary tag to have no case list;
% this can happen in semidet switches, or in det switches where the
% initial inst of the switch variable is a bound(...) inst representing
% a subtype.
%
-:- pred order_ptags_by_count(ptag_count_list::in, ptag_case_map::in,
- ptag_case_list::out) is det.
+:- pred order_ptags_by_count(ptag_count_list::in,
+ ptag_case_map(CaseRep)::in, ptag_case_list(CaseRep)::out) is det.
- % order_ptags_by_value(FirstPtag, MaxPtag, PtagCaseMap0, PtagCaseList):
+ % order_ptags_by_value(FirstPtag, MaxPtag, !PtagCaseList):
%
% Order the primary tags based on their value, lowest value first.
% We scan through the primary tags values from zero to maximum.
% Note that it is not an error for a primary tag to have no case list,
- % since this can happen in semidet switches.
+ % for the reason documented in the comment above for order_ptags_by_count.
%
-:- pred order_ptags_by_value(int::in, int::in, ptag_case_map::in,
- ptag_case_list::out) is det.
+:- pred order_ptags_by_value(int::in, int::in,
+ ptag_case_map(CaseRep)::in, ptag_case_list(CaseRep)::out) is det.
% Find out how many secondary tags share each primary tag
% of the given variable.
@@ -156,99 +208,122 @@
:- implementation.
+:- import_module hlds.hlds_code_util.
+:- import_module hlds.hlds_out.
:- import_module libs.
:- import_module libs.compiler_util.
:- import_module parse_tree.prog_type.
:- import_module char.
+:- import_module cord.
:- import_module int.
:- import_module string.
:- import_module svmap.
%-----------------------------------------------------------------------------%
+%
+% General stuff, for adding tags to cons_ids in switches and for representing
+% switch arms.
+%
-string_hash_cases([], _, Map) :-
- map.init(Map).
-string_hash_cases([Case | Cases], HashMask, Map) :-
- string_hash_cases(Cases, HashMask, Map0),
- ( Case = extended_case(_, string_tag(String0), _, _) ->
- String = String0
+:- type is_int_switch
+ ---> is_int_switch
+ ; is_not_int_switch.
+
+tag_cases(_ModuleInfo, _SwitchType, [], [], _) :-
+ unexpected(this_file, "tag_cases: no cases").
+tag_cases(ModuleInfo, SwitchVarType, [Case | Cases],
+ [TaggedCase | TaggedCases], MaybeIntSwitchLimits) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ MainConsTag = cons_id_to_tag(ModuleInfo, SwitchVarType, MainConsId),
+ TaggedMainConsId = tagged_cons_id(MainConsId, MainConsTag),
+ ( MainConsTag = int_tag(IntTag) ->
+ list.map_foldl4(tag_cons_id_in_int_switch(ModuleInfo, SwitchVarType),
+ OtherConsIds, TaggedOtherConsIds,
+ IntTag, LowerLimit1, IntTag, UpperLimit1,
+ 1, NumValues1, is_int_switch, IsIntSwitch1),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ tag_cases_in_int_switch(ModuleInfo, SwitchVarType, Cases, TaggedCases,
+ LowerLimit1, LowerLimit, UpperLimit1, UpperLimit,
+ NumValues1, NumValues, IsIntSwitch1, IsIntSwitch),
+ (
+ IsIntSwitch = is_int_switch,
+ MaybeIntSwitchLimits = int_switch(LowerLimit, UpperLimit,
+ NumValues)
;
- unexpected(this_file, "string_hash_cases: non-string case?")
- ),
- string.hash(String, HashVal0),
- HashVal = HashVal0 /\ HashMask,
- ( map.search(Map0, HashVal, CaseList0) ->
- map.det_update(Map0, HashVal, [Case | CaseList0], Map)
+ IsIntSwitch = is_not_int_switch,
+ MaybeIntSwitchLimits = not_int_switch
+ )
;
- map.det_insert(Map0, HashVal, [Case], Map)
+ list.map(tag_cons_id(ModuleInfo, SwitchVarType), OtherConsIds,
+ TaggedOtherConsIds),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ tag_cases_plain(ModuleInfo, SwitchVarType, Cases, TaggedCases),
+ MaybeIntSwitchLimits = not_int_switch
).
-calc_hash_slots(HashValList, HashMap, Map) :-
- calc_hash_slots_1(HashValList, HashMap, map.init, Map, 0, _).
+:- pred tag_cases_plain(module_info::in, mer_type::in, list(case)::in,
+ list(tagged_case)::out) is det.
-:- pred calc_hash_slots_1(assoc_list(int, cases_list)::in,
- map(int, cases_list)::in, map(int, hash_slot)::in,
- map(int, hash_slot)::out, int::in, int::out) is det.
-
-calc_hash_slots_1([], _, !Map, !LastUsed).
-calc_hash_slots_1([HashVal - Cases | Rest], HashMap, !Map, !LastUsed) :-
- calc_hash_slots_2(Cases, HashVal, HashMap, !Map, !LastUsed),
- calc_hash_slots_1(Rest, HashMap, !Map, !LastUsed).
-
-:- pred calc_hash_slots_2(cases_list::in, int::in, map(int, cases_list)::in,
- map(int, hash_slot)::in, map(int, hash_slot)::out, int::in, int::out)
- is det.
-
-calc_hash_slots_2([], _HashVal, _HashMap, !Map, !LastUsed).
-calc_hash_slots_2([Case | Cases], HashVal, HashMap, !Map, !LastUsed) :-
- calc_hash_slots_2(Cases, HashVal, HashMap, !Map, !LastUsed),
- ( map.contains(!.Map, HashVal) ->
- follow_hash_chain(!.Map, HashVal, ChainEnd),
- next_free_hash_slot(!.Map, HashMap, !LastUsed),
- map.lookup(!.Map, ChainEnd, hash_slot(PrevCase, _)),
- svmap.det_update(ChainEnd, hash_slot(PrevCase, !.LastUsed), !Map),
- svmap.det_insert(!.LastUsed, hash_slot(Case, -1), !Map)
+tag_cases_plain(_, _, [], []).
+tag_cases_plain(ModuleInfo, SwitchVarType, [Case | Cases],
+ [TaggedCase | TaggedCases]) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ tag_cons_id(ModuleInfo, SwitchVarType, MainConsId, TaggedMainConsId),
+ list.map(tag_cons_id(ModuleInfo, SwitchVarType),
+ OtherConsIds, TaggedOtherConsIds),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ tag_cases_plain(ModuleInfo, SwitchVarType, Cases, TaggedCases).
+
+:- pred tag_cases_in_int_switch(module_info::in, mer_type::in, list(case)::in,
+ list(tagged_case)::out, int::in, int::out, int::in, int::out,
+ int::in, int::out, is_int_switch::in, is_int_switch::out) is det.
+
+tag_cases_in_int_switch(_, _, [], [], !LowerLimit, !UpperLimit, !NumValues,
+ !IsIntSwitch).
+tag_cases_in_int_switch(ModuleInfo, SwitchVarType, [Case | Cases],
+ [TaggedCase | TaggedCases], !LowerLimit, !UpperLimit, !NumValues,
+ !IsIntSwitch) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ tag_cons_id_in_int_switch(ModuleInfo, SwitchVarType,
+ MainConsId, TaggedMainConsId, !LowerLimit, !UpperLimit,
+ !NumValues, !IsIntSwitch),
+ list.map_foldl4(tag_cons_id_in_int_switch(ModuleInfo, SwitchVarType),
+ OtherConsIds, TaggedOtherConsIds, !LowerLimit, !UpperLimit,
+ !NumValues, !IsIntSwitch),
+ TaggedCase = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
+ tag_cases_in_int_switch(ModuleInfo, SwitchVarType, Cases, TaggedCases,
+ !LowerLimit, !UpperLimit, !NumValues, !IsIntSwitch).
+
+:- pred tag_cons_id(module_info::in, mer_type::in, cons_id::in,
+ tagged_cons_id::out) is det.
+
+tag_cons_id(ModuleInfo, SwitchVarType, ConsId, TaggedConsId) :-
+ ConsTag = cons_id_to_tag(ModuleInfo, SwitchVarType, ConsId),
+ TaggedConsId = tagged_cons_id(ConsId, ConsTag).
+
+:- pred tag_cons_id_in_int_switch(module_info::in, mer_type::in, cons_id::in,
+ tagged_cons_id::out, int::in, int::out, int::in, int::out,
+ int::in, int::out, is_int_switch::in, is_int_switch::out) is det.
+
+tag_cons_id_in_int_switch(ModuleInfo, SwitchVarType, ConsId, TaggedConsId,
+ !LowerLimit, !UpperLimit, !NumValues, !IsIntSwitch) :-
+ ConsTag = cons_id_to_tag(ModuleInfo, SwitchVarType, ConsId),
+ TaggedConsId = tagged_cons_id(ConsId, ConsTag),
+ ( ConsTag = int_tag(IntTag) ->
+ int.min(IntTag, !LowerLimit),
+ int.max(IntTag, !UpperLimit),
+ !:NumValues = !.NumValues + 1
;
- svmap.det_insert(HashVal, hash_slot(Case, -1), !Map)
+ !:IsIntSwitch = is_not_int_switch
).
-:- pred follow_hash_chain(map(int, hash_slot)::in, int::in, int::out) is det.
-
-follow_hash_chain(Map, Slot, LastSlot) :-
- map.lookup(Map, Slot, hash_slot(_, NextSlot)),
- (
- NextSlot >= 0,
- map.contains(Map, NextSlot)
- ->
- follow_hash_chain(Map, NextSlot, LastSlot)
- ;
- LastSlot = Slot
- ).
-
- % next_free_hash_slot(M, H_M, LastUsed, FreeSlot):
- %
- % Find the next available slot FreeSlot in the hash table which is not
- % already used (contained in M) and which is not going to be used a
- % primary slot (contained in H_M), starting at the slot after LastUsed.
- %
-:- pred next_free_hash_slot(map(int, hash_slot)::in,
- map(int, cases_list)::in, int::in, int::out) is det.
-
-next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
- NextSlot = LastUsed + 1,
- (
- \+ map.contains(Map, NextSlot),
- \+ map.contains(H_Map, NextSlot)
- ->
- FreeSlot = NextSlot
- ;
- next_free_hash_slot(Map, H_Map, NextSlot, FreeSlot)
- ).
+represent_tagged_case_by_itself(TaggedCase, TaggedCase,
+ !StateA, !StateB, !StateC).
%-----------------------------------------------------------------------------%
%
-% Stuff for categorizing switches
+% Stuff for categorizing switches.
%
type_cat_to_switch_cat(type_cat_enum) = atomic_switch.
@@ -275,47 +350,85 @@
type_cat_to_switch_cat(type_cat_base_typeclass_info) = _ :-
unexpected(this_file, "type_cat_to_switch_cat: base_typeclass_info").
-switch_priority(no_tag) = 0. % should never occur
-switch_priority(int_tag(_)) = 1.
-switch_priority(foreign_tag(_, _)) = 1.
-switch_priority(reserved_address_tag(_)) = 1.
-switch_priority(shared_local_tag(_, _)) = 1.
-switch_priority(single_functor_tag) = 2.
-switch_priority(unshared_tag(_)) = 2.
-switch_priority(float_tag(_)) = 3.
-switch_priority(shared_remote_tag(_, _)) = 4.
-switch_priority(string_tag(_)) = 5.
-switch_priority(shared_with_reserved_addresses_tag(RAs, Tag)) =
- switch_priority(Tag) + list.length(RAs).
- % The following tags should all never occur in switches.
-switch_priority(pred_closure_tag(_, _, _)) = 6.
-switch_priority(type_ctor_info_tag(_, _, _)) = 6.
-switch_priority(base_typeclass_info_tag(_, _, _)) = 6.
-switch_priority(tabling_info_tag(_, _)) = 6.
-switch_priority(deep_profiling_proc_layout_tag(_, _)) = 6.
-switch_priority(table_io_decl_tag(_, _)) = 6.
-
-type_range(type_cat_char, _, _, MinChar, MaxChar) :-
- % XXX the following code uses the host's character size,
- % not the target's, so it won't work if cross-compiling
- % to a machine with a different character size.
- % Note also that the code in dense_switch.m and the code
- % in lookup_switch.m assume that char.min_char_value is 0.
- char.min_char_value(MinChar),
- char.max_char_value(MaxChar).
-type_range(type_cat_enum, Type, ModuleInfo, 0, MaxEnum) :-
- ( type_to_ctor_and_args(Type, TypeCtorPrime, _) ->
- TypeCtor = TypeCtorPrime
+estimate_switch_tag_test_cost(Tag) = Cost :-
+ (
+ ( Tag = int_tag(_)
+ ; Tag = foreign_tag(_, _)
+ ; Tag = reserved_address_tag(_)
+ ; Tag = shared_local_tag(_, _)
+ ),
+ % You need only a single word compare.
+ Cost = 1
+ ;
+ Tag = single_functor_tag,
+ % There is no cost incurred here except the cost of testing for all the
+ % reserved addresses this tag is shared with; the Cost = 2 is an
+ % estimate (XXX probably not very accurate) of the fixed cost
+ % of the scan over them.
+ Cost = 2
+ ;
+ Tag = unshared_tag(_),
+ % You need to compute the primary tag and compare it.
+ Cost = 2
+ ;
+ Tag = float_tag(_),
+ % You need to follow a pointer and then compare 64 bits
+ % (two words on 32 bit machines, which are still the most common).
+ Cost = 3
+ ;
+ Tag = shared_remote_tag(_, _),
+ % You need to compute the primary tag, compare it, follow a pointer
+ % and then compare the remote secondary tag.
+ Cost = 4
+ ;
+ Tag = string_tag(String),
+ % You need to follow a pointer and then compare all the characters to
+ % the end of the string. The multiplication is an attempt to factor in
+ % the fact that each character comparison is in a loop, and thus takes
+ % more than one instruction.
+ Cost = 1 + 2 * string.length(String)
+ ;
+ Tag = shared_with_reserved_addresses_tag(RAs, SubTag),
+ % You need to rule out all reserved addresses before testing SubTag.
+ Cost = 2 * list.length(RAs) + estimate_switch_tag_test_cost(SubTag)
;
- unexpected(this_file, "dense_switch.type_range: invalid enum type?")
+ ( Tag = no_tag
+ ; Tag = pred_closure_tag(_, _, _)
+ ; Tag = type_ctor_info_tag(_, _, _)
+ ; Tag = base_typeclass_info_tag(_, _, _)
+ ; Tag = tabling_info_tag(_, _)
+ ; Tag = deep_profiling_proc_layout_tag(_, _)
+ ; Tag = table_io_decl_tag(_, _)
),
+ unexpected(this_file, "estimate_switch_tag_test_cost: non-switch tag")
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff for dense switches.
+%
+
+type_range(ModuleInfo, TypeCat, Type, Min, Max, NumValues) :-
+ (
+ TypeCat = type_cat_char,
+ % XXX The following code uses the host's character size, not the
+ % target's, so it won't work if cross-compiling to a machine with
+ % a different character size. Note also that some code in both
+ % dense_switch.m and in lookup_switch.m assumes that
+ % char.min_char_value is 0.
+ char.min_char_value(Min),
+ char.max_char_value(Max)
+ ;
+ TypeCat = type_cat_enum,
+ Min = 0,
+ type_to_ctor_det(Type, TypeCtor),
module_info_get_type_table(ModuleInfo, TypeTable),
map.lookup(TypeTable, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
(
- TypeBody = hlds_du_type(_, ConsTable, _, _, _, _, _),
+ TypeBody = hlds_du_type(_, ConsTable, _, _, _, _, _, _),
map.count(ConsTable, TypeRange),
- MaxEnum = TypeRange - 1
+ Max = TypeRange - 1
;
( TypeBody = hlds_eqv_type(_)
; TypeBody = hlds_foreign_type(_)
@@ -323,24 +436,138 @@
; TypeBody = hlds_abstract_type(_)
),
unexpected(this_file, "type_range: enum type is not d.u. type?")
- ).
+ )
+ ),
+ NumValues = Max - Min + 1.
switch_density(NumCases, Range) = Density :-
Density = (NumCases * 100) // Range.
%-----------------------------------------------------------------------------%
+%
+% Stuff for string hash switches.
+%
-get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap) :-
- ( type_to_ctor_and_args(Type, TypeCtorPrime, _) ->
- TypeCtor = TypeCtorPrime
+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),
+ RepresentCase(TaggedCase, CaseRep, !StateA, !StateB, !StateC),
+ TaggedCase = tagged_case(MainTaggedConsId, OtherTaggedConsIds, _Goal),
+ TaggedConsIds = [MainTaggedConsId | OtherTaggedConsIds],
+ list.foldl(string_hash_cons_id(CaseRep, HashMask), TaggedConsIds,
+ !HashMap).
+
+:- pred string_hash_cons_id(CaseRep::in, int::in, tagged_cons_id::in,
+ map(int, assoc_list(string, CaseRep))::in,
+ map(int, assoc_list(string, CaseRep))::out) is det.
+
+string_hash_cons_id(CaseRep, HashMask, TaggedConsId, !HashMap) :-
+ TaggedConsId = tagged_cons_id(_ConsId, Tag),
+ ( Tag = string_tag(StringPrime) ->
+ String = StringPrime
;
- unexpected(this_file, "unknown type in get_ptag_counts")
+ unexpected(this_file, "string_hash_cases: non-string case?")
),
+ string.hash(String, StringHashVal),
+ HashVal = StringHashVal /\ HashMask,
+ ( map.search(!.HashMap, HashVal, OldStringCaseReps) ->
+ svmap.det_update(HashVal, [String - CaseRep | OldStringCaseReps],
+ !HashMap)
+ ;
+ 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, _).
+
+:- pred calc_string_hash_slots_1(
+ assoc_list(int, assoc_list(string, CaseRep))::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).
+
+:- pred calc_string_hash_slots_2(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_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),
+ StringCaseRep = String - CaseRep,
+ NewSlot = string_hash_slot(-1, String, CaseRep),
+ ( map.contains(!.SlotMap, HashVal) ->
+ follow_hash_chain(!.SlotMap, HashVal, ChainEnd),
+ next_free_hash_slot(!.SlotMap, HashMap, !LastUsed),
+ map.lookup(!.SlotMap, ChainEnd, ChainEndSlot0),
+ ChainEndSlot0 = string_hash_slot(_, PrevString, PrevCaseRep),
+ ChainEndSlot = string_hash_slot(!.LastUsed, PrevString, PrevCaseRep),
+ svmap.det_update(ChainEnd, ChainEndSlot, !SlotMap),
+ svmap.det_insert(!.LastUsed, NewSlot, !SlotMap)
+ ;
+ svmap.det_insert(HashVal, NewSlot, !SlotMap)
+ ).
+
+:- 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, _, _)),
+ (
+ NextSlot >= 0,
+ map.contains(Map, NextSlot)
+ ->
+ follow_hash_chain(Map, NextSlot, LastSlot)
+ ;
+ LastSlot = Slot
+ ).
+
+ % next_free_hash_slot(M, H_M, LastUsed, FreeSlot):
+ %
+ % Find the next available slot FreeSlot in the hash table which is not
+ % already used (contained in M) and which is not going to be used a
+ % primary slot (contained in H_M), starting at the slot after LastUsed.
+ %
+:- pred next_free_hash_slot(map(int, string_hash_slot(CaseRep))::in,
+ map(int, assoc_list(string, CaseRep))::in, int::in, int::out) is det.
+
+next_free_hash_slot(Map, H_Map, LastUsed, FreeSlot) :-
+ NextSlot = LastUsed + 1,
+ (
+ \+ map.contains(Map, NextSlot),
+ \+ map.contains(H_Map, NextSlot)
+ ->
+ FreeSlot = NextSlot
+ ;
+ next_free_hash_slot(Map, H_Map, NextSlot, FreeSlot)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff for tag switches.
+%
+
+get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap) :-
+ type_to_ctor_det(Type, TypeCtor),
module_info_get_type_table(ModuleInfo, TypeTable),
map.lookup(TypeTable, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
(
- TypeBody = hlds_du_type(_, ConsTable, _, _, _, _, _),
+ TypeBody = hlds_du_type(_, ConsTable, _, _, _, _, _, _),
map.to_assoc_list(ConsTable, ConsList),
assoc_list.values(ConsList, TagList)
;
@@ -426,10 +653,21 @@
%-----------------------------------------------------------------------------%
-group_cases_by_ptag([], !PtagCaseMap).
-group_cases_by_ptag([Case0 | Cases0], !PtagCaseMap) :-
- Case0 = extended_case(_Priority, Tag, ConsId, Goal),
- ConsIdGoal = stag_goal(ConsId, Goal),
+group_cases_by_ptag([], _, !StateA, !StateB, !StateC, !PtagCaseMap).
+group_cases_by_ptag([TaggedCase | TaggedCases], RepresentCase,
+ !StateA, !StateB, !StateC, !PtagCaseMap) :-
+ TaggedCase = tagged_case(MainTaggedConsId, OtherConsIds, _Goal),
+ RepresentCase(TaggedCase, CaseRep, !StateA, !StateB, !StateC),
+ group_case_by_ptag(CaseRep, MainTaggedConsId, !PtagCaseMap),
+ list.foldl(group_case_by_ptag(CaseRep), OtherConsIds, !PtagCaseMap),
+ group_cases_by_ptag(TaggedCases, RepresentCase, !StateA, !StateB, !StateC,
+ !PtagCaseMap).
+
+:- pred group_case_by_ptag(CaseRep::in, tagged_cons_id::in,
+ ptag_case_map(CaseRep)::in, ptag_case_map(CaseRep)::out) is det.
+
+group_case_by_ptag(CaseRep, TaggedConsId, !PtagCaseMap) :-
+ TaggedConsId = tagged_cons_id(_ConsId, Tag),
(
( Tag = single_functor_tag, Primary = 0
; Tag = unshared_tag(Primary)
@@ -438,7 +676,7 @@
unexpected(this_file, "unshared tag is shared")
;
map.init(StagGoalMap0),
- map.det_insert(StagGoalMap0, -1, ConsIdGoal, StagGoalMap),
+ map.det_insert(StagGoalMap0, -1, CaseRep, StagGoalMap),
svmap.det_insert(Primary, ptag_case(sectag_none, StagGoalMap),
!PtagCaseMap)
)
@@ -448,12 +686,12 @@
Group = ptag_case(StagLoc, StagGoalMap0),
expect(unify(StagLoc, sectag_remote), this_file,
"remote tag is shared with non-remote"),
- map.det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
+ map.det_insert(StagGoalMap0, Secondary, CaseRep, StagGoalMap),
svmap.det_update(Primary, ptag_case(sectag_remote, StagGoalMap),
!PtagCaseMap)
;
map.init(StagGoalMap0),
- map.det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
+ map.det_insert(StagGoalMap0, Secondary, CaseRep, StagGoalMap),
svmap.det_insert(Primary, ptag_case(sectag_remote, StagGoalMap),
!PtagCaseMap)
)
@@ -463,12 +701,12 @@
Group = ptag_case(StagLoc, StagGoalMap0),
expect(unify(StagLoc, sectag_local), this_file,
"local tag is shared with non-local"),
- map.det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
+ map.det_insert(StagGoalMap0, Secondary, CaseRep, StagGoalMap),
svmap.det_update(Primary, ptag_case(sectag_local, StagGoalMap),
!PtagCaseMap)
;
map.init(StagGoalMap0),
- map.det_insert(StagGoalMap0, Secondary, ConsIdGoal, StagGoalMap),
+ map.det_insert(StagGoalMap0, Secondary, CaseRep, StagGoalMap),
svmap.det_insert(Primary, ptag_case(sectag_local, StagGoalMap),
!PtagCaseMap)
)
@@ -487,9 +725,8 @@
; Tag = reserved_address_tag(_)
; Tag = shared_with_reserved_addresses_tag(_, _)
),
- unexpected(this_file, "non-du tag in group_cases_by_ptag")
- ),
- group_cases_by_ptag(Cases0, !PtagCaseMap).
+ unexpected(this_file, "non-du tag in group_case_by_ptag")
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.142
diff -u -b -r1.142 table_gen.m
--- compiler/table_gen.m 5 Dec 2007 05:07:38 -0000 1.142
+++ compiler/table_gen.m 7 Dec 2007 01:48:21 -0000
@@ -755,8 +755,8 @@
TB = mercury_table_builtin_module,
SwitchArms = [
- case(cons(qualified(TB, "loop_active"), 0), ActiveGoal),
- case(cons(qualified(TB, "loop_inactive"), 0), InactiveGoal)
+ case(cons(qualified(TB, "loop_active"), 0), [], ActiveGoal),
+ case(cons(qualified(TB, "loop_inactive"), 0), [], InactiveGoal)
],
SwitchExpr = switch(StatusVar, cannot_fail, SwitchArms),
set.insert_list(InactiveNonLocals, [StatusVar, TableTipVar],
@@ -956,9 +956,12 @@
TB = mercury_table_builtin_module,
SwitchArms = [
- case(cons(qualified(TB, "memo_det_active"), 0), ActiveGoal),
- case(cons(qualified(TB, "memo_det_inactive"), 0), InactiveGoal),
- case(cons(qualified(TB, "memo_det_succeeded"), 0), SucceededGoal)
+ case(cons(qualified(TB, "memo_det_active"), 0), [],
+ ActiveGoal),
+ case(cons(qualified(TB, "memo_det_inactive"), 0), [],
+ InactiveGoal),
+ case(cons(qualified(TB, "memo_det_succeeded"), 0), [],
+ SucceededGoal)
]
;
CodeModel = model_semi,
@@ -994,10 +997,14 @@
TB = mercury_table_builtin_module,
SwitchArms = [
- case(cons(qualified(TB, "memo_semi_active"), 0), ActiveGoal),
- case(cons(qualified(TB, "memo_semi_inactive"), 0), InactiveGoal),
- case(cons(qualified(TB, "memo_semi_succeeded"), 0), SucceededGoal),
- case(cons(qualified(TB, "memo_semi_failed"), 0), FailedGoal)
+ case(cons(qualified(TB, "memo_semi_active"), 0), [],
+ ActiveGoal),
+ case(cons(qualified(TB, "memo_semi_inactive"), 0), [],
+ InactiveGoal),
+ case(cons(qualified(TB, "memo_semi_succeeded"), 0), [],
+ SucceededGoal),
+ case(cons(qualified(TB, "memo_semi_failed"), 0), [],
+ FailedGoal)
]
),
@@ -1112,10 +1119,14 @@
TB = mercury_table_builtin_module,
SwitchArms = [
- case(cons(qualified(TB, "memo_non_active"), 0), InfiniteRecursionGoal),
- case(cons(qualified(TB, "memo_non_inactive"), 0), InactiveGoal),
- case(cons(qualified(TB, "memo_non_incomplete"), 0), NeedMinModelGoal),
- case(cons(qualified(TB, "memo_non_complete"), 0), RestoreAllAnswerGoal)
+ case(cons(qualified(TB, "memo_non_active"), 0), [],
+ InfiniteRecursionGoal),
+ case(cons(qualified(TB, "memo_non_inactive"), 0), [],
+ InactiveGoal),
+ case(cons(qualified(TB, "memo_non_incomplete"), 0), [],
+ NeedMinModelGoal),
+ case(cons(qualified(TB, "memo_non_complete"), 0), [],
+ RestoreAllAnswerGoal)
],
SwitchExpr = switch(StatusVar, cannot_fail, SwitchArms),
@@ -1508,9 +1519,12 @@
TB = mercury_table_builtin_module,
SwitchArms = [
- case(cons(qualified(TB, "mm_inactive"), 0), InactiveGoal),
- case(cons(qualified(TB, "mm_complete"), 0), RestoreAllAnswerGoal),
- case(cons(qualified(TB, "mm_active"), 0), SuspendGoal)
+ case(cons(qualified(TB, "mm_inactive"), 0), [],
+ InactiveGoal),
+ case(cons(qualified(TB, "mm_complete"), 0), [],
+ RestoreAllAnswerGoal),
+ case(cons(qualified(TB, "mm_active"), 0), [],
+ SuspendGoal)
],
SwitchExpr = switch(StatusVar, cannot_fail, SwitchArms),
goal_info_add_feature(feature_hide_debug_event,
Index: compiler/tabling_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tabling_analysis.m,v
retrieving revision 1.10
diff -u -b -r1.10 tabling_analysis.m
--- compiler/tabling_analysis.m 23 Nov 2007 07:35:27 -0000 1.10
+++ compiler/tabling_analysis.m 23 Nov 2007 08:52:33 -0000
@@ -363,7 +363,7 @@
Goals = [If, Then, Else]
;
Goal = switch(_, _, Cases),
- Goals = list.map((func(case(_, CaseGoal)) = CaseGoal), Cases)
+ Goals = list.map((func(case(_, _, CaseGoal)) = CaseGoal), Cases)
),
check_goals_for_mm_tabling(SCC, VarTypes, Goals, Result,
MaybeAnalysisStatus, !ModuleInfo, !IO).
@@ -707,9 +707,9 @@
io::di, io::uo) is det.
annotate_case(VarTypes, !Case, Status, !ModuleInfo, !IO) :-
- !.Case = case(ConsId, Goal0),
+ !.Case = case(MainConsId, OtherConsIds, Goal0),
annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo, !IO),
- !:Case = case(ConsId, Goal).
+ !:Case = case(MainConsId, OtherConsIds, Goal).
:- pred annotate_call(pred_proc_id::in, prog_vars::in, vartypes::in,
mm_tabling_status::out, module_info::in, module_info::out, io::di, io::uo)
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.80
diff -u -b -r1.80 tag_switch.m
--- compiler/tag_switch.m 23 Nov 2007 07:35:27 -0000 1.80
+++ compiler/tag_switch.m 14 Dec 2007 05:30:07 -0000
@@ -16,7 +16,6 @@
:- module ll_backend.tag_switch.
:- interface.
-:- import_module backend_libs.switch_util.
:- import_module hlds.code_model.
:- import_module hlds.hlds_goal.
:- import_module ll_backend.code_info.
@@ -29,8 +28,8 @@
% Generate intelligent indexing code for tag based switches.
%
-:- pred generate_tag_switch(list(extended_case)::in, prog_var::in,
- code_model::in, can_fail::in, hlds_goal_info::in, label::in,
+:- pred generate_tag_switch(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, code_tree::out,
code_info::in, code_info::out) is det.
@@ -41,6 +40,7 @@
:- import_module backend_libs.builtin_ops.
:- import_module backend_libs.rtti.
+:- import_module backend_libs.switch_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_llds.
:- import_module hlds.hlds_out.
@@ -50,6 +50,7 @@
:- import_module libs.options.
:- import_module libs.tree.
:- import_module ll_backend.code_gen.
+:- import_module ll_backend.switch_case.
:- import_module ll_backend.trace_gen.
:- import_module parse_tree.prog_data.
@@ -59,6 +60,7 @@
:- import_module maybe.
:- import_module pair.
:- import_module string.
+:- import_module svmap.
%-----------------------------------------------------------------------------%
@@ -125,16 +127,17 @@
% Note that for a det switch with two tag values, try-me-else chains
% and try chains are equivalent.
%
- % Which method is best depends on the number of possible tag values,
- % on the costs of taken/untaken branches and table lookups on the given
- % architecture, and on the frequency with which the various
- % alternatives are taken.
- %
- % While the first two are in principle known at compile time,
- % the third is not. Nevertheless, for switches on primary tags
- % we can use the heuristic that the more secondary tags assigned to
- % a primary tag, the more likely that the switch variable will have
- % that primary tag at runtime.
+ % Which method is best depends
+ % - on the number of possible tag values,
+ % - on the costs of taken/untaken branches and table lookups on the given
+ % architecture, and
+ % - on the frequency with which the various alternatives are taken.
+ %
+ % While the first two are in principle known at compile time, the third
+ % is not (at least not without feedback from a profiler). Nevertheless,
+ % for switches on primary tags we can use the heuristic that the more
+ % secondary tags assigned to a primary tag, the more likely that the
+ % switch variable will have that primary tag at runtime.
%
% Try chains are good for switches with small numbers of alternatives
% on architectures where untaken branches are cheaper than taken
@@ -159,7 +162,7 @@
% expected cost of a jump table lookup and dispatch.
% For try-me-else chains, we want tag1 to be the most frequent case,
- % tag 2 the next most frequent case, etc.
+ % tag2 the next most frequent case, etc.
%
% For det try chains, we want the last tag value to be the most
% frequent case, since it can be reached without taken jumps.
@@ -191,19 +194,42 @@
; jump_table
; binary_search.
-generate_tag_switch(Cases, Var, CodeModel, CanFail, SwitchGoalInfo, EndLabel,
- !MaybeEnd, Code, !CI) :-
+%-----------------------------------------------------------------------------%
+
+generate_tag_switch(TaggedCases, VarRval, VarType, VarName, CodeModel, CanFail,
+ SwitchGoalInfo, EndLabel, !MaybeEnd, Code, !CI) :-
+
+ % We get registers for holding the primary and (if needed) the secondary
+ % tag. The tags needed only by the switch, and no other code gets control
+ % between producing the tag values and all their uses, so we can release
+ % the registers for use by the code of the various cases.
+ %
+ % We forgo using the primary tag register if the primary tag is needed
+ % only once, or if the "register" we get is likely to be slower than
+ % recomputing the tag from scratch.
+ %
+ % We need to get and release the registers 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.
+ acquire_reg(reg_r, PtagReg, !CI),
+ acquire_reg(reg_r, StagReg, !CI),
+ release_reg(PtagReg, !CI),
+ release_reg(StagReg, !CI),
+
% Group the cases based on primary tag value and find out how many
% constructors share each primary tag value.
-
get_module_info(!.CI, ModuleInfo),
- get_proc_info(!.CI, ProcInfo),
- proc_info_get_vartypes(ProcInfo, VarTypes),
- map.lookup(VarTypes, Var, Type),
- switch_util.get_ptag_counts(Type, ModuleInfo, MaxPrimary, PtagCountMap),
+ get_ptag_counts(VarType, ModuleInfo, MaxPrimary, PtagCountMap),
map.to_assoc_list(PtagCountMap, PtagCountList),
+ remember_position(!.CI, BranchStart),
+ Params = represent_params(VarName, SwitchGoalInfo, CodeModel, BranchStart,
+ EndLabel),
+ map.init(CaseLabelMap0),
map.init(PtagCaseMap0),
- switch_util.group_cases_by_ptag(Cases, PtagCaseMap0, PtagCaseMap),
+ group_cases_by_ptag(TaggedCases,
+ represent_tagged_case_for_llds(Params),
+ CaseLabelMap0, CaseLabelMap1, !MaybeEnd, !CI,
+ PtagCaseMap0, PtagCaseMap),
map.count(PtagCaseMap, PtagsUsed),
get_globals(!.CI, Globals),
@@ -220,19 +246,6 @@
PrimaryMethod = try_me_else_chain
),
- % We get a register for holding the tag. The tag is needed only
- % by the switch, and no other code gets control between producing
- % the tag value and all uses of it, so we can release the register
- % for use by the code of the various cases.
-
- % We forgo using the register if the primary tag is needed only once,
- % or if the "register" we get is likely to be slower than
- % recomputing the tag from scratch.
-
- produce_variable_in_reg(Var, VarCode, VarLval, !CI),
- VarRval = lval(VarLval),
- acquire_reg(reg_r, PtagReg, !CI),
- release_reg(PtagReg, !CI),
(
PrimaryMethod \= jump_table,
PtagsUsed >= 2,
@@ -257,232 +270,258 @@
PtagRval = unop(tag, VarRval)
),
- % We generate FailCode and EndCode here because the last case within
- % a primary tag may not be the last case overall.
-
- get_next_label(FailLabel, !CI),
- FailLabelCode = node([
- llds_instr(label(FailLabel), "switch has failed")
- ]),
+ % We generate EndCode (and if needed, FailCode) here because the last
+ % case within a primary tag may not be the last case overall.
+ EndCode = node([llds_instr(label(EndLabel), "end of tag switch")]),
(
CanFail = cannot_fail,
- FailCode = node([
- llds_instr(goto(do_not_reached), "oh-oh, det switch failed")
- ])
+ MaybeFailLabel = no,
+ FailCode = empty
;
CanFail = can_fail,
- generate_failure(FailCode, !CI)
+ get_next_label(FailLabel, !CI),
+ MaybeFailLabel = yes(FailLabel),
+ FailLabelCode = node([
+ llds_instr(label(FailLabel), "switch has failed")
+ ]),
+ % 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(FailureCode, !CI),
+ FailCode = tree(FailLabelCode, FailureCode)
),
- LabelledFailCode = tree(FailLabelCode, FailCode),
-
- EndCode = node([llds_instr(label(EndLabel), "end of tag switch")]),
(
PrimaryMethod = binary_search,
- switch_util.order_ptags_by_value(0, MaxPrimary, PtagCaseMap,
- PtagCaseList),
+ order_ptags_by_value(0, MaxPrimary, PtagCaseMap, PtagCaseList),
generate_primary_binary_search(PtagCaseList, 0, MaxPrimary, PtagRval,
- VarRval, CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
- PtagCountMap, !MaybeEnd, CasesCode, !CI)
+ StagReg, VarRval, MaybeFailLabel, PtagCountMap, CasesCode,
+ CaseLabelMap1, CaseLabelMap, !CI)
;
PrimaryMethod = jump_table,
- switch_util.order_ptags_by_value(0, MaxPrimary, PtagCaseMap,
- PtagCaseList),
- generate_primary_jump_table(PtagCaseList, 0, MaxPrimary, VarRval,
- CodeModel, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
- !MaybeEnd, Labels, TableCode, !CI),
+ order_ptags_by_value(0, MaxPrimary, PtagCaseMap, PtagCaseList),
+ generate_primary_jump_table(PtagCaseList, 0, MaxPrimary, StagReg,
+ VarRval, MaybeFailLabel, PtagCountMap, Targets, TableCode,
+ CaseLabelMap1, CaseLabelMap, !CI),
SwitchCode = node([
- llds_instr(computed_goto(PtagRval, Labels),
+ llds_instr(computed_goto(PtagRval, Targets),
"switch on primary tag")
]),
CasesCode = tree(SwitchCode, TableCode)
;
PrimaryMethod = try_chain,
- switch_util.order_ptags_by_count(PtagCountList, PtagCaseMap,
- PtagCaseList0),
+ order_ptags_by_count(PtagCountList, PtagCaseMap, PtagCaseList0),
(
CanFail = cannot_fail,
PtagCaseList0 = [MostFreqCase | OtherCases]
->
- list.append(OtherCases, [MostFreqCase], PtagCaseList)
+ PtagCaseList = OtherCases ++ [MostFreqCase]
;
PtagCaseList = PtagCaseList0
),
- generate_primary_try_chain(PtagCaseList, PtagRval, VarRval, CodeModel,
- CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
- empty, empty, !MaybeEnd, CasesCode, !CI)
+ generate_primary_try_chain(PtagCaseList, PtagRval, StagReg, VarRval,
+ MaybeFailLabel, PtagCountMap, empty, empty, CasesCode,
+ CaseLabelMap1, CaseLabelMap, !CI)
;
PrimaryMethod = try_me_else_chain,
- switch_util.order_ptags_by_count(PtagCountList, PtagCaseMap,
- PtagCaseList),
- generate_primary_try_me_else_chain(PtagCaseList, PtagRval, VarRval,
- CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
- PtagCountMap, !MaybeEnd, CasesCode, !CI)
+ order_ptags_by_count(PtagCountList, PtagCaseMap, PtagCaseList),
+ generate_primary_try_me_else_chain(PtagCaseList, PtagRval, StagReg,
+ VarRval, MaybeFailLabel, PtagCountMap, CasesCode,
+ CaseLabelMap1, CaseLabelMap, !CI)
),
- Code = tree_list([VarCode, PtagCode, CasesCode, LabelledFailCode,
+ map.foldl(add_remaining_case, CaseLabelMap, empty, RemainingCasesCode),
+ Code = tree_list([PtagCode, CasesCode, RemainingCasesCode, FailCode,
EndCode]).
%-----------------------------------------------------------------------------%
% Generate a switch on a primary tag value using a try-me-else chain.
%
-:- pred generate_primary_try_me_else_chain(ptag_case_list::in,
- rval::in, rval::in, code_model::in, can_fail::in, hlds_goal_info::in,
- label::in, label::in, ptag_count_map::in,
- branch_end::in, branch_end::out, code_tree::out,
+:- pred generate_primary_try_me_else_chain(ptag_case_list(label)::in,
+ rval::in, lval::in, rval::in, maybe(label)::in,
+ ptag_count_map::in, code_tree::out,
+ case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_primary_try_me_else_chain([], _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+generate_primary_try_me_else_chain([], _, _, _, _, _, _,
+ !CaseLabelMap, !CI) :-
unexpected(this_file, "generate_primary_try_me_else_chain: empty switch").
-generate_primary_try_me_else_chain([PtagGroup | PtagGroups], TagRval, VarRval,
- CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
- !MaybeEnd, Code, !CI) :-
- PtagGroup = Primary - ptag_case(StagLoc, StagGoalMap),
+generate_primary_try_me_else_chain([PtagGroup | PtagGroups], PtagRval, StagReg,
+ VarRval, MaybeFailLabel, PtagCountMap, Code, !CaseLabelMap, !CI) :-
+ PtagGroup = Primary - PtagCase,
+ PtagCase = ptag_case(StagLoc, StagGoalMap),
map.lookup(PtagCountMap, Primary, CountInfo),
- CountInfo = StagLoc1 - MaxSecondary,
- expect(unify(StagLoc, StagLoc1), this_file,
+ CountInfo = StagLocPrime - MaxSecondary,
+ expect(unify(StagLoc, StagLocPrime), this_file,
"generate_primary_try_me_else_chain: secondary tag locations differ"),
(
- ( PtagGroups = [_ | _]
- ; CanFail = can_fail
- )
- ->
- remember_position(!.CI, BranchStart),
- get_next_label(ElseLabel, !CI),
- TestRval = binop(ne, TagRval,
- unop(mktag, const(llconst_int(Primary)))),
- TestCode = node([
- llds_instr(if_val(TestRval, code_label(ElseLabel)),
- "test primary tag only")
- ]),
- generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc,
- VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
- TagCode, !CI),
- ElseCode = node([
- llds_instr(label(ElseLabel), "handle next primary tag")
- ]),
- ThisTagCode = tree_list([TestCode, TagCode, ElseCode]),
- (
PtagGroups = [_ | _],
- reset_to_position(BranchStart, !CI),
- generate_primary_try_me_else_chain(PtagGroups, TagRval, VarRval,
- CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
- PtagCountMap, !MaybeEnd, OtherTagsCode, !CI),
+ generate_primary_try_me_else_chain_case(PtagRval, StagReg, Primary,
+ PtagCase, MaxSecondary, VarRval, MaybeFailLabel, ThisTagCode,
+ !CaseLabelMap, !CI),
+ generate_primary_try_me_else_chain(PtagGroups, PtagRval, StagReg,
+ VarRval, MaybeFailLabel, PtagCountMap, OtherTagsCode,
+ !CaseLabelMap, !CI),
Code = tree(ThisTagCode, OtherTagsCode)
;
PtagGroups = [],
- % FailLabel ought to be the next label anyway,
- % so this goto will be optimized away (unless the
- % layout of the failcode in the caller changes).
+ (
+ MaybeFailLabel = yes(FailLabel),
+ generate_primary_try_me_else_chain_case(PtagRval, StagReg, Primary,
+ PtagCase, MaxSecondary, VarRval, MaybeFailLabel, ThisTagCode,
+ !CaseLabelMap, !CI),
+ % FailLabel ought to be the next label anyway, so this goto
+ % will be optimized away (unless the layout of the failcode
+ % in the caller changes).
FailCode = node([
llds_instr(goto(code_label(FailLabel)),
"primary tag with no code to handle it")
]),
Code = tree(ThisTagCode, FailCode)
- )
;
- generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc,
- VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
- Code, !CI)
+ MaybeFailLabel = no,
+ generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
+ StagReg, StagLoc, VarRval, MaybeFailLabel, Code,
+ !CaseLabelMap, !CI)
+ )
).
+:- pred generate_primary_try_me_else_chain_case(rval::in, lval::in, int::in,
+ ptag_case(label)::in, int::in, rval::in, maybe(label)::in,
+ code_tree::out,
+ case_label_map::in, case_label_map::out,
+ code_info::in, code_info::out) is det.
+
+generate_primary_try_me_else_chain_case(PtagRval, StagReg, Primary, PtagCase,
+ MaxSecondary, VarRval, MaybeFailLabel, Code, !CaseLabelMap, !CI) :-
+ get_next_label(ElseLabel, !CI),
+ TestRval = binop(ne, PtagRval,
+ unop(mktag, const(llconst_int(Primary)))),
+ TestCode = node([
+ llds_instr(if_val(TestRval, code_label(ElseLabel)),
+ "test primary tag only")
+ ]),
+ PtagCase = ptag_case(StagLoc, StagGoalMap),
+ generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
+ StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
+ !CaseLabelMap, !CI),
+ ElseCode = node([
+ llds_instr(label(ElseLabel), "handle next primary tag")
+ ]),
+ Code = tree_list([TestCode, TagCode, ElseCode]).
+
%-----------------------------------------------------------------------------%
% Generate a switch on a primary tag value using a try chain.
%
-:- pred generate_primary_try_chain(ptag_case_list::in,
- rval::in, rval::in, code_model::in, can_fail::in, hlds_goal_info::in,
- label::in, label::in, ptag_count_map::in, code_tree::in, code_tree::in,
- branch_end::in, branch_end::out, code_tree::out,
+:- pred generate_primary_try_chain(ptag_case_list(label)::in,
+ rval::in, lval::in, rval::in, maybe(label)::in,
+ ptag_count_map::in, code_tree::in, code_tree::in, code_tree::out,
+ case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_primary_try_chain([], _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+generate_primary_try_chain([], _, _, _, _, _, _, _, _, !CaseLabelMap, !CI) :-
unexpected(this_file, "empty list in generate_primary_try_chain").
-generate_primary_try_chain([PtagGroup | PtagGroups], TagRval, VarRval,
- CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
- PrevTests0, PrevCases0, !MaybeEnd, Code, !CI) :-
- PtagGroup = Primary - ptag_case(StagLoc, StagGoalMap),
+generate_primary_try_chain([PtagGroup | PtagGroups], PtagRval, StagReg,
+ VarRval, MaybeFailLabel, PtagCountMap, PrevTestsCode0, PrevCasesCode0,
+ Code, !CaseLabelMap, !CI) :-
+ PtagGroup = Primary - PtagCase,
+ PtagCase = ptag_case(StagLoc, StagGoalMap),
map.lookup(PtagCountMap, Primary, CountInfo),
- CountInfo = StagLoc1 - MaxSecondary,
- expect(unify(StagLoc, StagLoc1), this_file,
+ CountInfo = StagLocPrime - MaxSecondary,
+ expect(unify(StagLoc, StagLocPrime), this_file,
"secondary tag locations differ in generate_primary_try_chain"),
(
- ( PtagGroups = [_ | _]
- ; CanFail = can_fail
- )
- ->
- remember_position(!.CI, BranchStart),
- get_next_label(ThisPtagLabel, !CI),
- TestRval = binop(eq, TagRval,
- unop(mktag, const(llconst_int(Primary)))),
- TestCode = node([
- llds_instr(if_val(TestRval, code_label(ThisPtagLabel)),
- "test primary tag only")
- ]),
- LabelCode = node([
- llds_instr(label(ThisPtagLabel), "this primary tag")
- ]),
- generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc,
- VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
- TagCode, !CI),
- PrevTests = tree(PrevTests0, TestCode),
- PrevCases = tree(tree(LabelCode, TagCode), PrevCases0),
- (
PtagGroups = [_ | _],
- reset_to_position(BranchStart, !CI),
- generate_primary_try_chain(PtagGroups, TagRval, VarRval, CodeModel,
- CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
- PrevTests, PrevCases, !MaybeEnd, Code, !CI)
+ generate_primary_try_chain_case(PtagRval, StagReg, Primary,
+ PtagCase, MaxSecondary, VarRval, MaybeFailLabel,
+ PrevTestsCode0, PrevTestsCode1, PrevCasesCode0, PrevCasesCode1,
+ !CaseLabelMap, !CI),
+ generate_primary_try_chain(PtagGroups, PtagRval, StagReg, VarRval,
+ MaybeFailLabel, PtagCountMap, PrevTestsCode1, PrevCasesCode1,
+ Code, !CaseLabelMap, !CI)
;
PtagGroups = [],
+ (
+ MaybeFailLabel = yes(FailLabel),
+ generate_primary_try_chain_case(PtagRval, StagReg, Primary,
+ PtagCase, MaxSecondary, VarRval, MaybeFailLabel,
+ PrevTestsCode0, PrevTestsCode1, PrevCasesCode0, PrevCasesCode1,
+ !CaseLabelMap, !CI),
FailCode = node([
llds_instr(goto(code_label(FailLabel)),
"primary tag with no code to handle it")
]),
- Code = tree(PrevTests, tree(FailCode, PrevCases))
- )
+ Code = tree_list([PrevTestsCode1, FailCode, PrevCasesCode1])
;
- Comment = node([
- llds_instr(comment("fallthrough to last tag value"), "")
- ]),
- generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc,
- VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
- TagCode, !CI),
- Code = tree_list([PrevTests0, Comment, TagCode, PrevCases0])
+ MaybeFailLabel = no,
+ Comment = "fallthrough to last primary tag value: " ++
+ string.int_to_string(Primary),
+ CommentCode = node([
+ llds_instr(comment(Comment), "")
+ ]),
+ generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
+ StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
+ !CaseLabelMap, !CI),
+ Code = tree_list([PrevTestsCode0, CommentCode,
+ TagCode, PrevCasesCode0])
+ )
).
+:- pred generate_primary_try_chain_case(rval::in, lval::in, int::in,
+ ptag_case(label)::in, int::in, rval::in, maybe(label)::in,
+ code_tree::in, code_tree::out, code_tree::in, code_tree::out,
+ case_label_map::in, case_label_map::out,
+ code_info::in, code_info::out) is det.
+
+generate_primary_try_chain_case(PtagRval, StagReg, Primary, PtagCase,
+ MaxSecondary, VarRval, MaybeFailLabel,
+ PrevTestsCode0, PrevTestsCode, PrevCasesCode0, PrevCasesCode,
+ !CaseLabelMap, !CI) :-
+ get_next_label(ThisPtagLabel, !CI),
+ TestRval = binop(eq, PtagRval,
+ unop(mktag, const(llconst_int(Primary)))),
+ TestCode = node([
+ llds_instr(if_val(TestRval, code_label(ThisPtagLabel)),
+ "test primary tag only")
+ ]),
+ Comment = "primary tag value: " ++ string.int_to_string(Primary),
+ LabelCode = node([
+ llds_instr(label(ThisPtagLabel), Comment)
+ ]),
+ PtagCase = ptag_case(StagLoc, StagGoalMap),
+ generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary,
+ StagReg, StagLoc, VarRval, MaybeFailLabel, TagCode,
+ !CaseLabelMap, !CI),
+ PrevTestsCode = tree(PrevTestsCode0, TestCode),
+ PrevCasesCode = tree_list([LabelCode, TagCode, PrevCasesCode0]).
+
%-----------------------------------------------------------------------------%
% Generate the cases for a primary tag using a dense jump table
% that has an entry for all possible primary tag values.
%
-:- pred generate_primary_jump_table(ptag_case_list::in, int::in,
- int::in, rval::in, code_model::in, hlds_goal_info::in,
- label::in, label::in, ptag_count_map::in,
- branch_end::in, branch_end::out, list(label)::out, code_tree::out,
+:- pred generate_primary_jump_table(ptag_case_list(label)::in, int::in,
+ int::in, lval::in, rval::in, maybe(label)::in, ptag_count_map::in,
+ list(maybe(label))::out, code_tree::out,
+ case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_primary_jump_table(PtagGroups, CurPrimary, MaxPrimary, VarRval,
- CodeModel, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
- !MaybeEnd, Labels, Code, !CI) :-
+generate_primary_jump_table(PtagGroups, CurPrimary, MaxPrimary, StagReg,
+ VarRval, MaybeFailLabel, PtagCountMap, Targets, Code,
+ !CaseLabelMap, !CI) :-
( CurPrimary > MaxPrimary ->
- (
- PtagGroups = []
- ;
- PtagGroups = [_ | _],
- unexpected(this_file,
- "generate_primary_jump_table: " ++
- "caselist not empty when reaching limiting primary tag")
- ),
- Labels = [],
+ expect(unify(PtagGroups, []), this_file,
+ "generate_primary_jump_table: PtagGroups != [] when Cur > Max"),
+ Targets = [],
Code = empty
;
NextPrimary = CurPrimary + 1,
- ( PtagGroups = [CurPrimary - PrimaryInfo | PtagGroups1] ->
+ ( PtagGroups = [CurPrimary - PrimaryInfo | PtagGroupsTail] ->
PrimaryInfo = ptag_case(StagLoc, StagGoalMap),
map.lookup(PtagCountMap, CurPrimary, CountInfo),
- CountInfo = StagLoc1 - MaxSecondary,
- expect(unify(StagLoc, StagLoc1), this_file,
+ CountInfo = StagLocPrime - MaxSecondary,
+ expect(unify(StagLoc, StagLocPrime), this_file,
"secondary tag locations differ " ++
"in generate_primary_jump_table"),
get_next_label(NewLabel, !CI),
@@ -490,29 +529,20 @@
llds_instr(label(NewLabel),
"start of a case in primary tag switch")
]),
- (
- PtagGroups1 = [],
- generate_primary_tag_code(StagGoalMap, CurPrimary,
- MaxSecondary, StagLoc, VarRval, CodeModel, SwitchGoalInfo,
- EndLabel, FailLabel, !MaybeEnd, ThisTagCode, !CI)
- ;
- PtagGroups1 = [_ | _],
- remember_position(!.CI, BranchStart),
- generate_primary_tag_code(StagGoalMap, CurPrimary,
- MaxSecondary, StagLoc, VarRval, CodeModel, SwitchGoalInfo,
- EndLabel, FailLabel, !MaybeEnd, ThisTagCode, !CI),
- reset_to_position(BranchStart, !CI)
- ),
- generate_primary_jump_table(PtagGroups1, NextPrimary, MaxPrimary,
- VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
- PtagCountMap, !MaybeEnd, OtherLabels, OtherCode, !CI),
- Labels = [NewLabel | OtherLabels],
- Code = tree_list([LabelCode, ThisTagCode, OtherCode])
+ generate_primary_tag_code(StagGoalMap, CurPrimary, MaxSecondary,
+ StagReg, StagLoc, VarRval, MaybeFailLabel, ThisTagCode,
+ !CaseLabelMap, !CI),
+ generate_primary_jump_table(PtagGroupsTail, NextPrimary,
+ MaxPrimary, StagReg, VarRval, MaybeFailLabel, PtagCountMap,
+ TailTargets, TailCode, !CaseLabelMap, !CI),
+ Targets = [yes(NewLabel) | TailTargets],
+ Code = tree_list([LabelCode, ThisTagCode, TailCode])
;
generate_primary_jump_table(PtagGroups, NextPrimary, MaxPrimary,
- VarRval, CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
- PtagCountMap, !MaybeEnd, OtherLabels, Code, !CI),
- Labels = [FailLabel | OtherLabels]
+ StagReg, VarRval, MaybeFailLabel, PtagCountMap,
+ TailTargets, TailCode, !CaseLabelMap, !CI),
+ Targets = [MaybeFailLabel | TailTargets],
+ Code = TailCode
)
).
@@ -522,27 +552,28 @@
% This invocation looks after primary tag values in the range
% MinPtag to MaxPtag (including both boundary values).
%
-:- pred generate_primary_binary_search(ptag_case_list::in, int::in,
- int::in, rval::in, rval::in, code_model::in, can_fail::in,
- hlds_goal_info::in, label::in, label::in, ptag_count_map::in,
- branch_end::in, branch_end::out, code_tree::out,
+:- pred generate_primary_binary_search(ptag_case_list(label)::in, int::in,
+ int::in, rval::in, lval::in, rval::in, maybe(label)::in,
+ ptag_count_map::in, code_tree::out,
+ case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_primary_binary_search(PtagGroups, MinPtag, MaxPtag, PtagRval, VarRval,
- CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel, PtagCountMap,
- !MaybeEnd, Code, !CI) :-
+generate_primary_binary_search(PtagGroups, MinPtag, MaxPtag, PtagRval, StagReg,
+ VarRval, MaybeFailLabel, PtagCountMap, Code, !CaseLabelMap, !CI) :-
( MinPtag = MaxPtag ->
CurPrimary = MinPtag,
(
PtagGroups = [],
% There is no code for this tag.
(
- CanFail = can_fail,
+ MaybeFailLabel = yes(FailLabel),
string.int_to_string(CurPrimary, PtagStr),
- string.append("no code for ptag ", PtagStr, Comment),
+ Comment = "no code for ptag " ++ PtagStr,
Code = node([llds_instr(goto(code_label(FailLabel)), Comment)])
;
- CanFail = cannot_fail,
+ MaybeFailLabel = no,
+ % The switch is cannot_fail, which means this case cannot
+ % happen.
Code = empty
)
;
@@ -551,13 +582,12 @@
"generate_primary_binary_search: cur_primary mismatch"),
PrimaryInfo = ptag_case(StagLoc, StagGoalMap),
map.lookup(PtagCountMap, CurPrimary, CountInfo),
- CountInfo = StagLoc1 - MaxSecondary,
- expect(unify(StagLoc, StagLoc1), this_file,
- "secondary tag locations differ " ++
- "in generate_primary_jump_table"),
+ CountInfo = StagLocPrime - MaxSecondary,
+ expect(unify(StagLoc, StagLocPrime), this_file,
+ "generate_primary_jump_table: secondary tag locations differ"),
generate_primary_tag_code(StagGoalMap, CurPrimary, MaxSecondary,
- StagLoc, VarRval, CodeModel, SwitchGoalInfo,
- EndLabel, FailLabel, !MaybeEnd, Code, !CI)
+ StagReg, StagLoc, VarRval, MaybeFailLabel, Code,
+ !CaseLabelMap, !CI)
;
PtagGroups = [_, _ | _],
unexpected(this_file,
@@ -576,10 +606,10 @@
string.int_to_string(LowRangeEnd, LowEndStr),
string.int_to_string(HighRangeStart, HighStartStr),
string.int_to_string(MaxPtag, HighEndStr),
- IfComment = "fallthrough for ptags " ++ LowStartStr ++
- " to " ++ LowEndStr,
- LabelComment = "code for ptags " ++ HighStartStr ++
- " to " ++ HighEndStr,
+ IfComment = "fallthrough for ptags " ++
+ LowStartStr ++ " to " ++ LowEndStr,
+ LabelComment = "code for ptags " ++
+ HighStartStr ++ " to " ++ HighEndStr,
LowRangeEndConst = const(llconst_int(LowRangeEnd)),
TestRval = binop(int_gt, PtagRval, LowRangeEndConst),
IfCode = node([
@@ -587,15 +617,12 @@
]),
LabelCode = node([llds_instr(label(NewLabel), LabelComment)]),
- remember_position(!.CI, BranchStart),
generate_primary_binary_search(LowGroups, MinPtag, LowRangeEnd,
- PtagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo,
- EndLabel, FailLabel, PtagCountMap, !MaybeEnd, LowRangeCode, !CI),
- reset_to_position(BranchStart, !CI),
+ PtagRval, StagReg, VarRval, MaybeFailLabel, PtagCountMap,
+ LowRangeCode, !CaseLabelMap, !CI),
generate_primary_binary_search(HighGroups, HighRangeStart, MaxPtag,
- PtagRval, VarRval, CodeModel, CanFail, SwitchGoalInfo,
- EndLabel, FailLabel, PtagCountMap, !MaybeEnd, HighRangeCode, !CI),
-
+ PtagRval, StagReg, VarRval, MaybeFailLabel, PtagCountMap,
+ HighRangeCode, !CaseLabelMap, !CI),
Code = tree_list([IfCode, LowRangeCode, LabelCode, HighRangeCode])
).
@@ -605,14 +632,13 @@
% If this primary tag has secondary tags, decide whether we should
% use a jump table to implement the secondary switch.
%
-:- pred generate_primary_tag_code(stag_goal_map::in, tag_bits::in,
- int::in, sectag_locn::in, rval::in, code_model::in, hlds_goal_info::in,
- label::in, label::in, branch_end::in, branch_end::out, code_tree::out,
+:- pred generate_primary_tag_code(stag_goal_map(label)::in, tag_bits::in,
+ int::in, lval::in, sectag_locn::in, rval::in, maybe(label)::in,
+ code_tree::out, case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagLoc, Rval,
- CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd, Code,
- !CI) :-
+generate_primary_tag_code(StagGoalMap, Primary, MaxSecondary, StagReg, StagLoc,
+ Rval, MaybeFailLabel, Code, !CaseLabelMap, !CI) :-
map.to_assoc_list(StagGoalMap, StagGoalList),
(
StagLoc = sectag_none,
@@ -622,20 +648,8 @@
unexpected(this_file, "no goal for non-shared tag")
;
StagGoalList = [StagGoal],
- ( StagGoal = -1 - stag_goal(ConsId, Goal) ->
- Comment = "case " ++ cons_id_to_string(ConsId),
- CommentCode = node([llds_instr(comment(Comment), "")]),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo,
- TraceCode, !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- goal_info_get_store_map(SwitchGoalInfo, StoreMap),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- GotoCode = node([
- llds_instr(goto(code_label(EndLabel)),
- "skip to end of primary tag switch")
- ]),
- Code = tree_list([CommentCode, TraceCode, GoalCode, SaveCode,
- GotoCode])
+ ( StagGoal = -1 - CaseLabel ->
+ generate_case_code_or_jump(CaseLabel, Code, !CaseLabelMap)
;
unexpected(this_file, "badly formed goal for non-shared tag")
)
@@ -676,8 +690,6 @@
Comment = "compute local sec tag to switch on"
),
- acquire_reg(reg_r, StagReg, !CI),
- release_reg(StagReg, !CI),
(
SecondaryMethod \= jump_table,
MaxSecondary >= 2,
@@ -701,41 +713,42 @@
StagRval = OrigStagRval
),
(
+ MaybeFailLabel = yes(FailLabel),
+ (
list.length(StagGoalList, StagGoalCount),
FullGoalCount = MaxSecondary + 1,
FullGoalCount = StagGoalCount
->
- CanFail = cannot_fail
+ MaybeSecFailLabel = no
;
- CanFail = can_fail
+ MaybeSecFailLabel = yes(FailLabel)
+ )
+ ;
+ MaybeFailLabel = no,
+ MaybeSecFailLabel = no
),
(
SecondaryMethod = jump_table,
generate_secondary_jump_table(StagGoalList, 0, MaxSecondary,
- CodeModel, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
- Labels, CasesCode, !CI),
- SwitchCode = node([
- llds_instr(computed_goto(StagRval, Labels),
+ MaybeSecFailLabel, Targets),
+ Code = node([
+ llds_instr(computed_goto(StagRval, Targets),
"switch on secondary tag")
- ]),
- Code = tree(SwitchCode, CasesCode)
+ ])
;
SecondaryMethod = binary_search,
generate_secondary_binary_search(StagGoalList, 0, MaxSecondary,
- StagRval, CodeModel, CanFail, SwitchGoalInfo,
- EndLabel, FailLabel, !MaybeEnd, Code, !CI)
+ StagRval, MaybeSecFailLabel, Code, !CaseLabelMap, !CI)
;
SecondaryMethod = try_chain,
- generate_secondary_try_chain(StagGoalList, StagRval, CodeModel,
- CanFail, SwitchGoalInfo, EndLabel, FailLabel, empty, empty,
- !MaybeEnd, Codes, !CI),
+ generate_secondary_try_chain(StagGoalList, StagRval,
+ MaybeSecFailLabel, empty, Codes, !CaseLabelMap),
Code = tree(StagCode, Codes)
;
SecondaryMethod = try_me_else_chain,
generate_secondary_try_me_else_chain(StagGoalList, StagRval,
- CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
- !MaybeEnd, Codes, !CI),
+ MaybeSecFailLabel, Codes, !CaseLabelMap, !CI),
Code = tree(StagCode, Codes)
)
).
@@ -744,26 +757,49 @@
% Generate a switch on a secondary tag value using a try-me-else chain.
%
-:- pred generate_secondary_try_me_else_chain(stag_goal_list::in,
- rval::in, code_model::in, can_fail::in, hlds_goal_info::in,
- label::in, label::in, branch_end::in, branch_end::out, code_tree::out,
+:- pred generate_secondary_try_me_else_chain(stag_goal_list(label)::in,
+ rval::in, maybe(label)::in, code_tree::out,
+ case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
-generate_secondary_try_me_else_chain([], _, _, _, _, _, _, _, _, _, !CI) :-
+generate_secondary_try_me_else_chain([], _, _, _, !CaseLabelMap, !CI) :-
unexpected(this_file,
"generate_secondary_try_me_else_chain: empty switch").
-generate_secondary_try_me_else_chain([Case0 | Cases0], StagRval, CodeModel,
- CanFail, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd, Code, !CI) :-
- Case0 = Secondary - stag_goal(ConsId, Goal),
- Comment = "case " ++ cons_id_to_string(ConsId),
- CommentCode = node([llds_instr(comment(Comment), "")]),
- goal_info_get_store_map(SwitchGoalInfo, StoreMap),
+generate_secondary_try_me_else_chain([Case | Cases], StagRval,
+ MaybeFailLabel, Code, !CaseLabelMap, !CI) :-
+ Case = Secondary - CaseLabel,
+ (
+ Cases = [_ | _],
+ generate_secondary_try_me_else_chain_case(CaseLabel, StagRval,
+ Secondary, ThisCode, !CaseLabelMap, !CI),
+ generate_secondary_try_me_else_chain(Cases, StagRval,
+ MaybeFailLabel, OtherCode, !CaseLabelMap, !CI),
+ Code = tree(ThisCode, OtherCode)
+ ;
+ Cases = [],
(
- ( Cases0 = [_ | _]
- ; CanFail = can_fail
+ MaybeFailLabel = yes(FailLabel),
+ generate_secondary_try_me_else_chain_case(CaseLabel, StagRval,
+ Secondary, ThisCode, !CaseLabelMap, !CI),
+ FailCode = node([
+ llds_instr(goto(code_label(FailLabel)),
+ "secondary tag does not match")
+ ]),
+ Code = tree(ThisCode, FailCode)
+ ;
+ MaybeFailLabel = no,
+ generate_case_code_or_jump(CaseLabel, Code, !CaseLabelMap)
)
- ->
- remember_position(!.CI, BranchStart),
+ ).
+
+:- pred generate_secondary_try_me_else_chain_case(label::in, rval::in, int::in,
+ code_tree::out, case_label_map::in, case_label_map::out,
+ code_info::in, code_info::out) is det.
+
+generate_secondary_try_me_else_chain_case(CaseLabel, StagRval, Secondary,
+ Code, !CaseLabelMap, !CI) :-
+ generate_case_code_or_jump(CaseLabel, CaseCode, !CaseLabelMap),
+ % XXX Optimize what we generate when CaseCode = goto(CaseLabel).
get_next_label(ElseLabel, !CI),
TestCode = node([
llds_instr(
@@ -771,172 +807,87 @@
code_label(ElseLabel)),
"test remote sec tag only")
]),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- GotoLabelCode = node([
- llds_instr(goto(code_label(EndLabel)),
- "skip to end of secondary tag switch"),
+ ElseLabelCode = node([
llds_instr(label(ElseLabel), "handle next secondary tag")
]),
- ThisCode = tree_list([TestCode, CommentCode, TraceCode, GoalCode,
- SaveCode, GotoLabelCode]),
- (
- Cases0 = [_ | _],
- reset_to_position(BranchStart, !CI),
- generate_secondary_try_me_else_chain(Cases0, StagRval, CodeModel,
- CanFail, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
- OtherCode, !CI),
- Code = tree(ThisCode, OtherCode)
- ;
- Cases0 = [],
- FailCode = node([
- llds_instr(goto(code_label(FailLabel)),
- "secondary tag does not match")
- ]),
- Code = tree(ThisCode, FailCode)
- )
- ;
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- GotoCode = node([
- llds_instr(goto(code_label(EndLabel)),
- "skip to end of secondary tag switch")
- ]),
- Code = tree_list([CommentCode, TraceCode, GoalCode, SaveCode,
- GotoCode])
- ).
+ Code = tree_list([TestCode, CaseCode, ElseLabelCode]).
%-----------------------------------------------------------------------------%
% Generate a switch on a secondary tag value using a try chain.
%
-:- pred generate_secondary_try_chain(stag_goal_list::in, rval::in,
- code_model::in, can_fail::in, hlds_goal_info::in, label::in, label::in,
- code_tree::in, code_tree::in, branch_end::in, branch_end::out,
- code_tree::out, code_info::in, code_info::out) is det.
+:- pred generate_secondary_try_chain(stag_goal_list(label)::in, rval::in,
+ maybe(label)::in, code_tree::in, code_tree::out,
+ case_label_map::in, case_label_map::out) is det.
-generate_secondary_try_chain([], _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+generate_secondary_try_chain([], _, _, _, _, !CaseLabelMap) :-
unexpected(this_file, "generate_secondary_try_chain: empty switch").
-generate_secondary_try_chain([Case0 | Cases0], StagRval, CodeModel, CanFail,
- SwitchGoalInfo, EndLabel, FailLabel, PrevTests0, PrevCases0, !MaybeEnd,
- Code, !CI) :-
- Case0 = Secondary - stag_goal(ConsId, Goal),
- Comment = "case " ++ cons_id_to_string(ConsId),
- goal_info_get_store_map(SwitchGoalInfo, StoreMap),
- (
- ( Cases0 = [_ | _]
- ; CanFail = can_fail
- )
- ->
- remember_position(!.CI, BranchStart),
- get_next_label(ThisStagLabel, !CI),
- TestCode = node([
- llds_instr(
- if_val(binop(eq, StagRval, const(llconst_int(Secondary))),
- code_label(ThisStagLabel)),
- "test remote sec tag only for " ++ Comment)
- ]),
- LabelCode = node([
- llds_instr(label(ThisStagLabel),
- "handle next secondary tag for " ++ Comment)
- ]),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- GotoCode = node([
- llds_instr(goto(code_label(EndLabel)),
- "skip to end of secondary tag switch")
- ]),
- ThisCode = tree_list([LabelCode, TraceCode, GoalCode, SaveCode,
- GotoCode]),
- PrevTests = tree(PrevTests0, TestCode),
- PrevCases = tree(ThisCode, PrevCases0),
- (
- Cases0 = [_ | _],
- reset_to_position(BranchStart, !CI),
- generate_secondary_try_chain(Cases0, StagRval, CodeModel, CanFail,
- SwitchGoalInfo, EndLabel, FailLabel, PrevTests, PrevCases,
- !MaybeEnd, Code, !CI)
- ;
- Cases0 = [],
+generate_secondary_try_chain([Case | Cases], StagRval, MaybeFailLabel,
+ PrevTestsCode0, Code, !CaseLabelMap) :-
+ Case = Secondary - CaseLabel,
+ (
+ Cases = [_ | _],
+ generate_secondary_try_chain_case(CaseLabel, StagRval, Secondary,
+ PrevTestsCode0, PrevTestsCode1, !.CaseLabelMap),
+ generate_secondary_try_chain(Cases, StagRval,
+ MaybeFailLabel, PrevTestsCode1, Code, !CaseLabelMap)
+ ;
+ Cases = [],
+ (
+ MaybeFailLabel = yes(FailLabel),
+ generate_secondary_try_chain_case(CaseLabel, StagRval, Secondary,
+ PrevTestsCode0, PrevTestsCode1, !.CaseLabelMap),
FailCode = node([
llds_instr(goto(code_label(FailLabel)),
"secondary tag with no code to handle it")
]),
- Code = tree(PrevTests, tree(FailCode, PrevCases))
- )
+ Code = tree(PrevTestsCode1, FailCode)
;
- CommentCode = node([llds_instr(comment(Comment), "")]),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- GotoCode = node([
- llds_instr(goto(code_label(EndLabel)),
- "skip to end of secondary tag switch")
- ]),
- Code = tree_list([PrevTests0, CommentCode, TraceCode, GoalCode,
- SaveCode, GotoCode, PrevCases0])
+ MaybeFailLabel = no,
+ generate_case_code_or_jump(CaseLabel, ThisCode, !CaseLabelMap),
+ Code = tree(PrevTestsCode0, ThisCode)
+ )
).
+:- pred generate_secondary_try_chain_case(label::in, rval::in, int::in,
+ code_tree::in, code_tree::out, case_label_map::in) is det.
+
+generate_secondary_try_chain_case(CaseLabel, StagRval, Secondary,
+ PrevTestsCode0, PrevTestsCode, CaseLabelMap) :-
+ map.lookup(CaseLabelMap, CaseLabel, CaseInfo0),
+ CaseInfo0 = case_label_info(Comment, _CaseCode, _CaseGenerated),
+ TestCode = node([
+ llds_instr(
+ if_val(binop(eq, StagRval, const(llconst_int(Secondary))),
+ code_label(CaseLabel)),
+ "test remote sec tag only for " ++ Comment)
+ ]),
+ PrevTestsCode = tree(PrevTestsCode0, TestCode).
+
%-----------------------------------------------------------------------------%
% Generate the cases for a primary tag using a dense jump table
% that has an entry for all possible secondary tag values.
%
-:- pred generate_secondary_jump_table(stag_goal_list::in, int::in,
- int::in, code_model::in, hlds_goal_info::in, label::in, label::in,
- branch_end::in, branch_end::out, list(label)::out, code_tree::out,
- code_info::in, code_info::out) is det.
+:- pred generate_secondary_jump_table(stag_goal_list(label)::in, int::in,
+ int::in, maybe(label)::in, list(maybe(label))::out) is det.
-generate_secondary_jump_table(CaseList, CurSecondary, MaxSecondary, CodeModel,
- SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd, Labels, Code, !CI) :-
+generate_secondary_jump_table(CaseList, CurSecondary, MaxSecondary,
+ MaybeFailLabel, Targets) :-
( CurSecondary > MaxSecondary ->
expect(unify(CaseList, []), this_file,
"caselist not empty when reaching limiting secondary tag"),
- Labels = [],
- Code = empty
+ Targets = []
;
NextSecondary = CurSecondary + 1,
- ( CaseList = [CurSecondary - stag_goal(ConsId, Goal) | CaseList1] ->
- Comment = "case " ++ cons_id_to_string(ConsId),
- get_next_label(NewLabel, !CI),
- LabelCode = node([
- llds_instr(label(NewLabel),
- "start of " ++ Comment ++ " in secondary tag switch")
- ]),
- remember_position(!.CI, BranchStart),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- goal_info_get_store_map(SwitchGoalInfo, StoreMap),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- (
- CaseList1 = []
- ;
- CaseList1 = [_ | _],
- reset_to_position(BranchStart, !CI)
- ),
- GotoCode = node([
- llds_instr(goto(code_label(EndLabel)),
- "branch to end of tag switch")
- ]),
- generate_secondary_jump_table(CaseList1, NextSecondary,
- MaxSecondary, CodeModel, SwitchGoalInfo, EndLabel, FailLabel,
- !MaybeEnd, OtherLabels, OtherCode, !CI),
- Labels = [NewLabel | OtherLabels],
- Code = tree_list([LabelCode, TraceCode, GoalCode, SaveCode,
- GotoCode, OtherCode])
- ;
- generate_secondary_jump_table(CaseList,
- NextSecondary, MaxSecondary, CodeModel, SwitchGoalInfo,
- EndLabel, FailLabel, !MaybeEnd, OtherLabels, Code, !CI),
- Labels = [FailLabel | OtherLabels]
+ ( CaseList = [CurSecondary - CaseLabel | CaseListTail] ->
+ generate_secondary_jump_table(CaseListTail, NextSecondary,
+ MaxSecondary, MaybeFailLabel, OtherTargets),
+ Targets = [yes(CaseLabel) | OtherTargets]
+ ;
+ generate_secondary_jump_table(CaseList, NextSecondary,
+ MaxSecondary, MaybeFailLabel, OtherTargets),
+ Targets = [MaybeFailLabel | OtherTargets]
)
).
@@ -946,41 +897,32 @@
% This invocation looks after secondary tag values in the range
% MinPtag to MaxPtag (including both boundary values).
%
-:- pred generate_secondary_binary_search(stag_goal_list::in,
- int::in, int::in, rval::in, code_model::in, can_fail::in,
- hlds_goal_info::in, label::in, label::in,
- branch_end::in, branch_end::out, code_tree::out,
+:- pred generate_secondary_binary_search(stag_goal_list(label)::in,
+ int::in, int::in, rval::in, maybe(label)::in, code_tree::out,
+ case_label_map::in, case_label_map::out,
code_info::in, code_info::out) is det.
generate_secondary_binary_search(StagGoals, MinStag, MaxStag, StagRval,
- CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel, !MaybeEnd,
- Code, !CI) :-
+ MaybeFailLabel, Code, !CaseLabelMap, !CI) :-
( MinStag = MaxStag ->
CurSec = MinStag,
(
StagGoals = [],
% There is no code for this tag.
(
- CanFail = can_fail,
+ MaybeFailLabel = yes(FailLabel),
string.int_to_string(CurSec, StagStr),
- string.append("no code for ptag ", StagStr, Comment),
+ Comment = "no code for ptag " ++ StagStr,
Code = node([llds_instr(goto(code_label(FailLabel)), Comment)])
;
- CanFail = cannot_fail,
+ MaybeFailLabel = no,
Code = empty
)
;
- StagGoals = [CurSecPrime - stag_goal(ConsId, Goal)],
- Comment = "case " ++ cons_id_to_string(ConsId),
- CommentCode = node([llds_instr(comment(Comment), "")]),
+ StagGoals = [CurSecPrime - CaseLabel],
expect(unify(CurSec, CurSecPrime), this_file,
"generate_secondary_binary_search: cur_secondary mismatch"),
- maybe_generate_internal_event_code(Goal, SwitchGoalInfo, TraceCode,
- !CI),
- code_gen.generate_goal(CodeModel, Goal, GoalCode, !CI),
- goal_info_get_store_map(SwitchGoalInfo, StoreMap),
- generate_branch_end(StoreMap, !MaybeEnd, SaveCode, !CI),
- Code = tree_list([CommentCode, TraceCode, GoalCode, SaveCode])
+ generate_case_code_or_jump(CaseLabel, Code, !CaseLabelMap)
;
StagGoals = [_, _ | _],
unexpected(this_file,
@@ -1000,10 +942,10 @@
string.int_to_string(LowRangeEnd, LowEndStr),
string.int_to_string(HighRangeStart, HighStartStr),
string.int_to_string(MaxStag, HighEndStr),
- string.append_list(["fallthrough for stags ",
- LowStartStr, " to ", LowEndStr], IfComment),
- string.append_list(["code for stags ", HighStartStr,
- " to ", HighEndStr], LabelComment),
+ IfComment = "fallthrough for stags " ++
+ LowStartStr ++ " to " ++ LowEndStr,
+ LabelComment = "code for stags " ++
+ HighStartStr ++ " to " ++ HighEndStr,
LowRangeEndConst = const(llconst_int(LowRangeEnd)),
TestRval = binop(int_gt, StagRval, LowRangeEndConst),
IfCode = node([
@@ -1011,14 +953,10 @@
]),
LabelCode = node([llds_instr(label(NewLabel), LabelComment)]),
- remember_position(!.CI, BranchStart),
generate_secondary_binary_search(LowGoals, MinStag, LowRangeEnd,
- StagRval, CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
- !MaybeEnd, LowRangeCode, !CI),
- reset_to_position(BranchStart, !CI),
+ StagRval, MaybeFailLabel, LowRangeCode, !CaseLabelMap, !CI),
generate_secondary_binary_search(HighGoals, HighRangeStart, MaxStag,
- StagRval, CodeModel, CanFail, SwitchGoalInfo, EndLabel, FailLabel,
- !MaybeEnd, HighRangeCode, !CI),
+ StagRval, MaybeFailLabel, HighRangeCode, !CaseLabelMap, !CI),
Code = tree_list([IfCode, LowRangeCode, LabelCode, HighRangeCode])
).
Index: compiler/term_constr_build.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_constr_build.m,v
retrieving revision 1.18
diff -u -b -r1.18 term_constr_build.m
--- compiler/term_constr_build.m 7 Aug 2007 07:10:06 -0000 1.18
+++ compiler/term_constr_build.m 13 Dec 2007 12:53:45 -0000
@@ -677,11 +677,10 @@
% With switches we need to consider the constraints on the variable
% being switched on as well as those from the body of each case.
%
- % For each case we check if the there is a deconstruction
- % unification involving the switch variable. If there is no such
- % unification then the constraint for the case will not include a
- % constraint on the size of the switch-var. In that case we add an
- % appropriate constraint.
+ % For each case, we check if there is a deconstruction unification
+ % involving the switch variable. If there is no such unification then
+ % the constraint for the case will not include a constraint on the size
+ % of the switched-on var. In that case we add an appropriate constraint.
%
% We add the extra constraint by creating a new primitive abstract
% goal and conjoining that to the rest.
@@ -691,31 +690,34 @@
traversal_info::out) is det.
build_abstract_switch_acc(_, [], !AbstractGoals, !Info).
-build_abstract_switch_acc(SwitchProgVar, [case(ConsId, Goal) | Cases],
- !AbstractGoals, !Info) :-
+build_abstract_switch_acc(SwitchProgVar, [Case | Cases], !AbstractGoals,
+ !Info) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
build_abstract_goal(Goal, AbstractGoal0, !Info),
- %
- % We now need to check that constraints on the switch var are
- % included. They will *not* have been included if the case did not
- % contain a unification deconstructing that variable. They are of
- % course in the HLDS, just not stored in a way we can derive them
- % from the goal in the normal fashion unless there is actually a
- % deconstruction unification present.
- %
- ( detect_switch_var(Goal, SwitchProgVar, ConsId) ->
+
+ % We now need to check that constraints on the switch var are included.
+ % They will *not* have been included if the case did not contain a
+ % unification deconstructing that variable (which it can't contain if the
+ % switch arm is for several cons_ids). They are of course in the HLDS,
+ % just not stored in a way we can derive them from the goal in the normal
+ % fashion unless there is actually a deconstruction unification present.
+
+ (
+ OtherConsIds = [],
+ detect_switch_var(Goal, SwitchProgVar, MainConsId)
+ ->
AbstractGoal = AbstractGoal0
;
TypeMap = !.Info ^ types,
SizeVarMap = !.Info ^ var_map,
SwitchVarType = TypeMap ^ det_elem(SwitchProgVar),
SwitchSizeVar = prog_var_to_size_var(SizeVarMap, SwitchProgVar),
- ( type_to_ctor_and_args(SwitchVarType, TypeCtor, _) ->
- Size = functor_lower_bound(!.Info ^ norm, TypeCtor, ConsId,
- !.Info ^ module_info)
+ type_to_ctor_and_args_det(SwitchVarType, TypeCtor, _),
+ Size = functor_lower_bound(!.Info ^ norm, TypeCtor, MainConsId,
+ !.Info ^ module_info),
+ ( set.member(SwitchSizeVar, !.Info ^ zeros) ->
+ ExtraConstr = []
;
- unexpected(this_file, "variable type in detect_switch_var.")
- ),
- ( not set.member(SwitchSizeVar, !.Info ^ zeros) ->
SwitchVarConst = rat(Size),
SwitchVarConstr =
( Size = 0 ->
@@ -726,8 +728,6 @@
SwitchVarConst)
),
ExtraConstr = [SwitchVarConstr]
- ;
- ExtraConstr = []
),
ExtraPoly = polyhedron.from_constraints(ExtraConstr),
ExtraGoal = term_primitive(ExtraPoly, [], []),
@@ -739,12 +739,17 @@
:- pred detect_switch_var(hlds_goal::in, prog_var::in, cons_id::in) is semidet.
detect_switch_var(hlds_goal(unify(_, _, _, Kind, _), _), SwitchVar, ConsId) :-
- ( Kind = deconstruct(SwitchVar, ConsId, _, _, _, _) ->
- true
- ; Kind = complicated_unify(_, _, _) ->
+ (
+ Kind = deconstruct(SwitchVar, ConsId, _, _, _, _)
+ ;
+ Kind = complicated_unify(_, _, _),
unexpected(this_file,
"complicated_unify/3 goal during termination analysis.")
;
+ ( Kind = construct(_, _, _, _, _, _, _)
+ ; Kind = assign(_, _)
+ ; Kind = simple_test(_, _)
+ ),
fail
).
detect_switch_var(hlds_goal(shorthand(_), _), _, _) :-
@@ -1096,7 +1101,7 @@
Type = Info ^ types ^ det_elem(Var),
prog_type.type_to_ctor_and_args(Type, TypeCtor, _),
ModuleInfo = Info ^ module_info,
- type_util.type_constructors(Type, ModuleInfo, Constructors0),
+ type_util.type_constructors(ModuleInfo, Type, Constructors0),
( if ConsId = cons(ConsName0, ConsArity0)
then ConsName = ConsName0, ConsArity = ConsArity0
else unexpected(this_file,
Index: compiler/term_norm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_norm.m,v
retrieving revision 1.26
diff -u -b -r1.26 term_norm.m
--- compiler/term_norm.m 25 Sep 2007 04:56:42 -0000 1.26
+++ compiler/term_norm.m 25 Nov 2007 12:05:32 -0000
@@ -147,7 +147,7 @@
find_weights_for_type(TypeCtor - TypeDefn, !Weights) :-
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
(
- TypeBody = hlds_du_type(Constructors, _, _, _, _, _, _),
+ TypeBody = hlds_du_type(Constructors, _, _, _, _, _, _, _),
hlds_data.get_type_defn_tparams(TypeDefn, TypeParams),
list.foldl(find_weights_for_cons(TypeCtor, TypeParams),
Constructors, !Weights)
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.37
diff -u -b -r1.37 term_pass1.m
--- compiler/term_pass1.m 27 Aug 2007 06:22:15 -0000 1.37
+++ compiler/term_pass1.m 23 Nov 2007 08:46:14 -0000
@@ -399,7 +399,7 @@
termination_error_contexts::in, termination_error_contexts::out,
module_info::in, module_info::out, io::di, io::uo) is det.
-check_cases_non_term_calls(PPId, VarTypes, case(_, Goal), !Errors,
+check_cases_non_term_calls(PPId, VarTypes, case(_, _, Goal), !Errors,
!ModuleInfo, !IO) :-
check_goal_non_term_calls(PPId, VarTypes, Goal, !Errors, !ModuleInfo, !IO).
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.57
diff -u -b -r1.57 term_traversal.m
--- compiler/term_traversal.m 23 Nov 2007 07:35:28 -0000 1.57
+++ compiler/term_traversal.m 23 Nov 2007 08:46:06 -0000
@@ -384,7 +384,7 @@
traverse_switch([], _, _, ok(Empty, []), !ModuleInfo, !IO) :-
set.init(Empty).
-traverse_switch([case(_, Goal) | Cases], Params, !Info, !ModuleInfo, !IO) :-
+traverse_switch([case(_, _, Goal) | Cases], Params, !Info, !ModuleInfo, !IO) :-
traverse_goal(Goal, Params, !.Info, GoalInfo, !ModuleInfo, !IO),
traverse_switch(Cases, Params, !.Info, CasesInfo, !ModuleInfo, !IO),
combine_paths(GoalInfo, CasesInfo, Params, !:Info).
Index: compiler/trailing_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trailing_analysis.m,v
retrieving revision 1.28
diff -u -b -r1.28 trailing_analysis.m
--- compiler/trailing_analysis.m 23 Nov 2007 07:35:29 -0000 1.28
+++ compiler/trailing_analysis.m 23 Nov 2007 08:45:51 -0000
@@ -465,7 +465,7 @@
check_goal_for_trail_mods_2(SCC, VarTypes, GoalExpr, _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
GoalExpr = switch(_, _, Cases),
- CaseGoals = list.map((func(case(_, CaseGoal)) = CaseGoal), Cases),
+ CaseGoals = list.map((func(case(_, _, CaseGoal)) = CaseGoal), Cases),
check_goals_for_trail_mods(SCC, VarTypes, CaseGoals,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO).
check_goal_for_trail_mods_2(SCC, VarTypes, GoalExpr, _,
@@ -1023,9 +1023,9 @@
io::di, io::uo) is det.
annotate_case(VarTypes, !Case, Status, !ModuleInfo, !IO) :-
- !.Case = case(ConsId, Goal0),
+ !.Case = case(MainConsId, OtherConsIds, Goal0),
annotate_goal(VarTypes, Goal0, Goal, Status, !ModuleInfo, !IO),
- !:Case = case(ConsId, Goal).
+ !:Case = case(MainConsId, OtherConsIds, Goal).
%----------------------------------------------------------------------------%
%
Index: compiler/transform_llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/transform_llds.m,v
retrieving revision 1.32
diff -u -b -r1.32 transform_llds.m
--- compiler/transform_llds.m 19 Jan 2007 07:04:33 -0000 1.32
+++ compiler/transform_llds.m 14 Dec 2007 05:21:11 -0000
@@ -46,6 +46,7 @@
:- import_module counter.
:- import_module int.
:- import_module list.
+:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module string.
@@ -171,12 +172,12 @@
transform_instructions([Instr0 | Instrs0], Instrs, !C, ProcLabel, MaxSize) :-
transform_instructions(Instrs0, InstrsTail, !C, ProcLabel, MaxSize),
(
- Instr0 = llds_instr(computed_goto(Rval, Labels), Comment),
- list.length(Labels, NumLabels),
- NumLabels > MaxSize
+ Instr0 = llds_instr(computed_goto(Rval, Targets), Comment),
+ list.length(Targets, NumTargets),
+ NumTargets > MaxSize
->
- split_computed_goto(Rval, Labels, Comment, InstrsHead, !C,
- MaxSize, NumLabels, ProcLabel),
+ split_computed_goto(Rval, Targets, Comment, InstrsHead, !C,
+ MaxSize, NumTargets, ProcLabel),
list.append(InstrsHead, InstrsTail, Instrs)
;
Instrs = [Instr0 | InstrsTail]
@@ -188,20 +189,20 @@
% in half as many times as necessary to bring the jump table size
% below MaxSize, doing a binary search on the way.
%
-:- pred split_computed_goto(rval::in, list(label)::in, string::in,
+:- pred split_computed_goto(rval::in, list(maybe(label))::in, string::in,
list(instruction)::out, counter::in, counter::out, int::in, int::in,
proc_label::in) is det.
-split_computed_goto(Rval, Labels, Comment, Instrs, !C, MaxSize, NumLabels,
+split_computed_goto(Rval, Targets, Comment, Instrs, !C, MaxSize, NumTargets,
ProcLabel) :-
- ( NumLabels =< MaxSize ->
- Instrs = [llds_instr(computed_goto(Rval, Labels), Comment)]
+ ( NumTargets =< MaxSize ->
+ Instrs = [llds_instr(computed_goto(Rval, Targets), Comment)]
;
counter.allocate(LabelNum, !C),
- Mid = NumLabels // 2,
- ( list.split_list(Mid, Labels, StartPrime, EndPrime) ->
- Start = StartPrime,
- End = EndPrime
+ Mid = NumTargets // 2,
+ ( list.split_list(Mid, Targets, StartTargetsPrime, EndTargetsPrime) ->
+ StartTargets = StartTargetsPrime,
+ EndTargets = EndTargetsPrime
;
unexpected(this_file, "split_computed_goto: list.split_list")
),
@@ -212,10 +213,10 @@
IfInstr = llds_instr(if_val(Test, ElseAddr), "binary search"),
ElseInstr = llds_instr(label(internal_label(LabelNum, ProcLabel)), ""),
- split_computed_goto(Rval, Start, Comment ++ " then",
+ split_computed_goto(Rval, StartTargets, Comment ++ " then",
ThenInstrs, !C, MaxSize, Mid, ProcLabel),
- split_computed_goto(Index, End, Comment ++ " else",
- ElseInstrs, !C, MaxSize, NumLabels - Mid, ProcLabel),
+ split_computed_goto(Index, EndTargets, Comment ++ " else",
+ ElseInstrs, !C, MaxSize, NumTargets - Mid, ProcLabel),
Instrs = [IfInstr | ThenInstrs] ++ [ElseInstr | ElseInstrs]
).
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.42
diff -u -b -r1.42 tupling.m
--- compiler/tupling.m 23 Nov 2007 07:35:29 -0000 1.42
+++ compiler/tupling.m 23 Nov 2007 08:45:21 -0000
@@ -1299,7 +1299,7 @@
count_load_stores_in_cases([], _CountInfo, !CountState).
count_load_stores_in_cases([Case | Cases], CountInfo, !CountState) :-
- Case = case(_ConsId, Goal),
+ Case = case(_MainConsId, _OtherConsIds, Goal),
GoalInfo = Goal ^ hlds_goal_info,
goal_info_get_resume_point(GoalInfo, ResumePoint),
(
@@ -1825,10 +1825,10 @@
fix_calls_in_cases([], [], !VarSet, !VarTypes, !RttiVarMaps, _).
fix_calls_in_cases([Case0 | Cases0], [Case | Cases], !VarSet, !VarTypes,
!RttiVarMaps, TransformMap) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, !RttiVarMaps,
TransformMap),
- Case = case(Functor, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
fix_calls_in_cases(Cases0, Cases, !VarSet, !VarTypes,
!RttiVarMaps, TransformMap).
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.94
diff -u -b -r1.94 type_ctor_info.m
--- compiler/type_ctor_info.m 23 Nov 2007 07:35:29 -0000 1.94
+++ compiler/type_ctor_info.m 25 Nov 2007 11:46:51 -0000
@@ -360,8 +360,9 @@
UnivTvars, ExistTvars, MaybePseudoTypeInfo),
Details = eqv(MaybePseudoTypeInfo)
;
- TypeBody = hlds_du_type(Ctors, ConsTagMap, EnumDummy,
- MaybeUserEqComp, ReservedTag, ReservedAddr, _),
+ TypeBody = hlds_du_type(Ctors, ConsTagMap, _CheaperTagTest,
+ EnumDummy, MaybeUserEqComp, ReservedTag, ReservedAddr,
+ _IsForeignType),
(
MaybeUserEqComp = yes(_),
EqualityAxioms = user_defined
@@ -400,7 +401,7 @@
some [!Flags] (
!:Flags = set.init,
(
- TypeBody = hlds_du_type(_, _, _, _, BodyReservedTag, _, _),
+ TypeBody = hlds_du_type(_, _, _, _, _, BodyReservedTag, _, _),
svset.insert(kind_of_du_flag, !Flags),
(
BodyReservedTag = uses_reserved_tag,
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.186
diff -u -b -r1.186 type_util.m
--- compiler/type_util.m 23 Nov 2007 07:35:29 -0000 1.186
+++ compiler/type_util.m 13 Dec 2007 12:58:51 -0000
@@ -164,7 +164,7 @@
% If the type is a du type or a tuple type, return the list of its
% constructors.
%
-:- pred type_constructors(mer_type::in, module_info::in,
+:- pred type_constructors(module_info::in, mer_type::in,
list(constructor)::out) is semidet.
% Given a type on which it is possible to have a complete switch,
@@ -175,8 +175,8 @@
% and equivalence types will have been expanded out by the time
% we consider switches.)
%
-:- pred switch_type_num_functors(module_info::in, mer_type::in,
- int::out) is semidet.
+:- pred switch_type_num_functors(module_info::in, mer_type::in, int::out)
+ is semidet.
% Work out the types of the arguments of a functor, given the cons_id
% and type of the functor. Aborts if the functor is existentially typed.
@@ -395,7 +395,7 @@
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
- TypeBody = hlds_du_type(_, _, _, _, _, _, _),
+ TypeBody = hlds_du_type(_, _, _, _, _, _, _, _),
(
TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody),
have_foreign_type_for_backend(Target, ForeignTypeBody, yes)
@@ -463,7 +463,7 @@
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
- TypeBody = hlds_du_type(_, _, _, _, _, _, _),
+ TypeBody = hlds_du_type(_, _, _, _, _, _, _, _),
(
TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody),
have_foreign_type_for_backend(Target, ForeignTypeBody, yes)
@@ -473,7 +473,7 @@
;
TypeBody ^ du_type_usereq = no,
% type_constructors does substitution of types variables.
- type_constructors(Type, ModuleInfo, Ctors),
+ type_constructors(ModuleInfo, Type, Ctors),
list.foldl(ctor_definitely_has_no_user_defined_eq_pred(ModuleInfo),
Ctors, !SeenTypes)
)
@@ -573,8 +573,8 @@
is_solver_type(ModuleInfo, Type)
).
-is_existq_type(Module, Type) :-
- type_constructors(Type, Module, Constructors),
+is_existq_type(ModuleInfo, Type) :-
+ type_constructors(ModuleInfo, Type, Constructors),
some [Constructor] (
list.member(Constructor, Constructors),
Constructor ^ cons_exist = [_ | _]
@@ -609,7 +609,7 @@
; Name = "typeclass_info"
; Name = "base_typeclass_info"
),
- \+ ( Body = hlds_du_type(_, _, _, _, _, _, yes(_))
+ \+ ( Body = hlds_du_type(_, _, _, _, _, _, _, yes(_))
; Body = hlds_foreign_type(_)
; Body = hlds_solver_type(_, _)
).
@@ -737,7 +737,7 @@
%-----------------------------------------------------------------------------%
-type_constructors(Type, ModuleInfo, Constructors) :-
+type_constructors(ModuleInfo, Type, Constructors) :-
type_to_ctor_and_args(Type, TypeCtor, TypeArgs),
( type_ctor_is_tuple(TypeCtor) ->
% Tuples are never existentially typed.
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.185
diff -u -b -r1.185 unify_gen.m
--- compiler/unify_gen.m 26 Nov 2007 05:13:22 -0000 1.185
+++ compiler/unify_gen.m 12 Dec 2007 01:30:35 -0000
@@ -22,11 +22,14 @@
:- interface.
:- import_module hlds.code_model.
+:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module ll_backend.code_info.
:- import_module ll_backend.llds.
:- import_module parse_tree.prog_data.
+:- import_module list.
+
%---------------------------------------------------------------------------%
:- type test_sense
@@ -36,8 +39,14 @@
:- pred generate_unification(code_model::in, unification::in,
hlds_goal_info::in, code_tree::out, code_info::in, code_info::out) is det.
-:- pred generate_tag_test(prog_var::in, cons_id::in, test_sense::in,
- label::out, code_tree::out, code_info::in, code_info::out) is det.
+:- pred generate_tag_test(prog_var::in, cons_id::in,
+ maybe_cheaper_tag_test::in, test_sense::in, label::out, code_tree::out,
+ code_info::in, code_info::out) is det.
+
+:- pred generate_raw_tag_test_case(rval::in, mer_type::in, string::in,
+ tagged_cons_id::in, list(tagged_cons_id)::in, maybe_cheaper_tag_test::in,
+ test_sense::in, label::out, code_tree::out, code_info::in, code_info::out)
+ is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -50,7 +59,6 @@
:- import_module backend_libs.type_class_info.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
-:- import_module hlds.hlds_data.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_pred.
@@ -71,7 +79,6 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
-:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
@@ -193,58 +200,95 @@
%---------------------------------------------------------------------------%
-generate_tag_test(Var, ConsId, Sense, ElseLab, Code, !CI) :-
- produce_variable(Var, VarCode, Rval, !CI),
+generate_raw_tag_test_case(VarRval, VarType, VarName,
+ MainTaggedConsId, OtherTaggedConsIds, CheaperTagTest,
+ Sense, ElseLabel, Code, !CI) :-
+ (
+ OtherTaggedConsIds = [],
+ MainTaggedConsId = tagged_cons_id(MainConsId, MainConsTag),
+ generate_raw_tag_test(VarRval, VarType, VarName,
+ MainConsId, yes(MainConsTag), CheaperTagTest, Sense, ElseLabel,
+ Code, !CI)
+ ;
+ OtherTaggedConsIds = [_ | _],
+ % The cheaper tag test optimization doesn't apply.
+ project_cons_name_and_tag(MainTaggedConsId, MainConsName, MainConsTag),
+ list.map2(project_cons_name_and_tag, OtherTaggedConsIds,
+ OtherConsNames, OtherConsTags),
+ Comment = branch_sense_comment(Sense) ++
+ case_comment(VarName, MainConsName, OtherConsNames),
+ raw_tag_test(VarRval, MainConsTag, MainTagTestRval),
+ list.map(raw_tag_test(VarRval), OtherConsTags, OtherTagTestRvals),
+ disjoin_tag_tests(MainTagTestRval, OtherTagTestRvals, TestRval),
+ get_next_label(ElseLabel, !CI),
+ (
+ Sense = branch_on_success,
+ TheRval = TestRval
+ ;
+ Sense = branch_on_failure,
+ code_util.neg_rval(TestRval, TheRval)
+ ),
+ Code = node([
+ llds_instr(if_val(TheRval, code_label(ElseLabel)), Comment)
+ ])
+ ).
+
+:- pred disjoin_tag_tests(rval::in, list(rval)::in, rval::out) is det.
+
+disjoin_tag_tests(CurTestRval, OtherTestRvals, TestRval) :-
+ (
+ OtherTestRvals = [],
+ TestRval = CurTestRval
+ ;
+ OtherTestRvals = [HeadTestRval | TailTestRvals],
+ NextTestRval = binop(logical_or, CurTestRval, HeadTestRval),
+ disjoin_tag_tests(NextTestRval, TailTestRvals, TestRval)
+ ).
+
+%---------------------------------------------------------------------------%
+
+generate_tag_test(Var, ConsId, CheaperTagTest, Sense, ElseLabel, Code, !CI) :-
+ produce_variable(Var, VarCode, VarRval, !CI),
+ VarType = variable_type(!.CI, Var),
+ VarName = variable_name(!.CI, Var),
+ generate_raw_tag_test(VarRval, VarType, VarName, ConsId, no,
+ CheaperTagTest, Sense, ElseLabel, TestCode, !CI),
+ Code = tree(VarCode, TestCode).
+
+:- pred generate_raw_tag_test(rval::in, mer_type::in, string::in,
+ cons_id::in, maybe(cons_tag)::in,
+ maybe_cheaper_tag_test::in, test_sense::in, label::out, code_tree::out,
+ code_info::in, code_info::out) is det.
+
+generate_raw_tag_test(VarRval, VarType, VarName, ConsId, MaybeConsTag,
+ CheaperTagTest, Sense, ElseLabel, Code, !CI) :-
+ ConsIdName = hlds_out.cons_id_to_string(ConsId),
% As an optimization, for data types with exactly two alternatives,
% one of which is a constant, we make sure that we test against the
% constant (negating the result of the test, if needed),
% since a test against a constant is cheaper than a tag test.
(
- ConsId = cons(_, Arity),
- Arity > 0
- ->
- Type = variable_type(!.CI, Var),
- TypeDefn = lookup_type_defn(!.CI, Type),
- hlds_data.get_type_defn_body(TypeDefn, TypeBody),
- ( ConsTable = TypeBody ^ du_type_cons_tag_values ->
- map.to_assoc_list(ConsTable, ConsList),
- (
- ConsList = [ConsId - _, OtherConsId - _],
- OtherConsId = cons(_, 0)
+ CheaperTagTest = cheaper_tag_test(ExpensiveConsId, _ExpensiveConsTag,
+ _CheapConsId, CheapConsTag),
+ ConsId = ExpensiveConsId
->
- Reverse = yes(OtherConsId)
- ;
- ConsList = [OtherConsId - _, ConsId - _],
- OtherConsId = cons(_, 0)
- ->
- Reverse = yes(OtherConsId)
- ;
- Reverse = no
- )
- ;
- Reverse = no
- )
+ Comment = branch_sense_comment(Sense) ++ VarName ++
+ " has functor " ++ ConsIdName ++ " (inverted test)",
+ raw_tag_test(VarRval, CheapConsTag, NegTestRval),
+ code_util.neg_rval(NegTestRval, TestRval)
;
- Reverse = no
- ),
- VarName = variable_to_string(!.CI, Var),
- ConsIdName = hlds_out.cons_id_to_string(ConsId),
- Comment0 = "checking that " ++ VarName ++ " has functor " ++ ConsIdName,
+ Comment = branch_sense_comment(Sense) ++ VarName ++
+ " has functor " ++ ConsIdName,
(
- Reverse = no,
- Comment = Comment0,
- CommentCode = node([llds_instr(comment(Comment), "")]),
- Tag = cons_id_to_tag_for_var(!.CI, Var, ConsId),
- generate_tag_test_rval_2(Tag, Rval, TestRval)
+ MaybeConsTag = yes(ConsTag)
+ % Our caller has already computed ConsTag.
;
- Reverse = yes(TestConsId),
- Comment = Comment0 ++ " (inverted test)",
- CommentCode = node([llds_instr(comment(Comment), "")]),
- Tag = cons_id_to_tag_for_var(!.CI, Var, TestConsId),
- generate_tag_test_rval_2(Tag, Rval, NegTestRval),
- code_util.neg_rval(NegTestRval, TestRval)
+ MaybeConsTag = no,
+ ConsTag = cons_id_to_tag_for_type(!.CI, VarType, ConsId)
+ ),
+ raw_tag_test(VarRval, ConsTag, TestRval)
),
- get_next_label(ElseLab, !CI),
+ get_next_label(ElseLabel, !CI),
(
Sense = branch_on_success,
TheRval = TestRval
@@ -252,25 +296,22 @@
Sense = branch_on_failure,
code_util.neg_rval(TestRval, TheRval)
),
- TestCode = node([
- llds_instr(if_val(TheRval, code_label(ElseLab)), "tag test")
- ]),
- Code = tree_list([VarCode, CommentCode, TestCode]).
+ Code = node([
+ llds_instr(if_val(TheRval, code_label(ElseLabel)), Comment)
+ ]).
-%---------------------------------------------------------------------------%
+:- func branch_sense_comment(test_sense) = string.
-:- pred generate_tag_test_rval(prog_var::in, cons_id::in,
- rval::out, code_tree::out, code_info::in, code_info::out) is det.
+branch_sense_comment(branch_on_success) =
+ "branch away if ".
+branch_sense_comment(branch_on_failure) =
+ "branch away unless ".
-generate_tag_test_rval(Var, ConsId, TestRval, Code, !CI) :-
- produce_variable(Var, Code, Rval, !CI),
- Tag = cons_id_to_tag_for_var(!.CI, Var, ConsId),
- generate_tag_test_rval_2(Tag, Rval, TestRval).
+%---------------------------------------------------------------------------%
-:- pred generate_tag_test_rval_2(cons_tag::in, rval::in, rval::out)
- is det.
+:- pred raw_tag_test(rval::in, cons_tag::in, rval::out) is det.
-generate_tag_test_rval_2(ConsTag, Rval, TestRval) :-
+raw_tag_test(Rval, ConsTag, TestRval) :-
(
ConsTag = string_tag(String),
TestRval = binop(str_eq, Rval, const(llconst_string(String)))
@@ -338,11 +379,11 @@
% We first check that the Rval doesn't match any of the ReservedAddrs,
% and then check that it matches ThisTag.
CheckReservedAddrs = (func(RA, InnerTestRval0) = InnerTestRval :-
- generate_tag_test_rval_2(reserved_address_tag(RA), Rval, EqualRA),
+ raw_tag_test(Rval, reserved_address_tag(RA), EqualRA),
InnerTestRval = binop(logical_and,
unop(logical_not, EqualRA), InnerTestRval0)
),
- generate_tag_test_rval_2(ThisTag, Rval, MatchesThisTag),
+ raw_tag_test(Rval, ThisTag, MatchesThisTag),
TestRval = list.foldr(CheckReservedAddrs, ReservedAddrs,
MatchesThisTag)
).
@@ -1026,12 +1067,15 @@
code_info::in, code_info::out) is det.
generate_semi_deconstruction(Var, Tag, Args, Modes, Code, !CI) :-
- generate_tag_test(Var, Tag, branch_on_success, SuccLab, TagTestCode, !CI),
+ VarType = variable_type(!.CI, Var),
+ CheaperTagTest = lookup_cheaper_tag_test(!.CI, VarType),
+ generate_tag_test(Var, Tag, CheaperTagTest, branch_on_success, SuccLabel,
+ TagTestCode, !CI),
remember_position(!.CI, AfterUnify),
generate_failure(FailCode, !CI),
reset_to_position(AfterUnify, !CI),
generate_det_deconstruction(Var, Tag, Args, Modes, DeconsCode, !CI),
- SuccessLabelCode = node([llds_instr(label(SuccLab), "")]),
+ SuccessLabelCode = node([llds_instr(label(SuccLabel), "")]),
Code = tree_list([TagTestCode, FailCode, SuccessLabelCode, DeconsCode]).
%---------------------------------------------------------------------------%
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.196
diff -u -b -r1.196 unify_proc.m
--- compiler/unify_proc.m 23 Nov 2007 07:35:31 -0000 1.196
+++ compiler/unify_proc.m 25 Nov 2007 11:48:55 -0000
@@ -552,8 +552,8 @@
ReservedTag = does_not_use_reserved_tag,
ReservedAddr = does_not_use_reserved_address,
IsForeign = no,
- TypeBody = hlds_du_type([Ctor], ConsTagValues, IsEnum, UnifyPred,
- ReservedTag, ReservedAddr, IsForeign),
+ TypeBody = hlds_du_type([Ctor], ConsTagValues, no_cheaper_tag_test,
+ IsEnum, UnifyPred, ReservedTag, ReservedAddr, IsForeign),
construct_type(TypeCtor, TupleArgTypes, Type),
term.context_init(Context)
@@ -759,7 +759,7 @@
Goal = hlds_goal(Call, GoalInfo),
quantify_clause_body([X], Goal, Context, Clause, !Info)
;
- ( TypeBody = hlds_du_type(_, _, _, _, _, _, _)
+ ( TypeBody = hlds_du_type(_, _, _, _, _, _, _, _)
; TypeBody = hlds_foreign_type(_)
; TypeBody = hlds_abstract_type(_)
),
@@ -788,7 +788,7 @@
Clause, !Info)
;
(
- TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _, _),
+ TypeBody = hlds_du_type(Ctors, _, _, EnumDummy, _, _, _, _),
(
( EnumDummy = is_mercury_enum
; EnumDummy = is_foreign_enum(_)
@@ -1000,7 +1000,7 @@
"trying to create index proc for non-canonical type")
;
(
- TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _, _),
+ TypeBody = hlds_du_type(Ctors, _, _, EnumDummy, _, _, _, _),
(
% For enum types, the generated comparison predicate performs
% an integer comparison, and does not call the type's index
@@ -1066,7 +1066,7 @@
Res, X, Y, Context, Clause, !Info)
;
(
- TypeBody = hlds_du_type(Ctors0, _, EnumDummy, _, _, _, _),
+ TypeBody = hlds_du_type(Ctors0, _, _, EnumDummy, _, _, _, _),
(
( EnumDummy = is_mercury_enum
; EnumDummy = is_foreign_enum(_)
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.124
diff -u -b -r1.124 unique_modes.m
--- compiler/unique_modes.m 23 Nov 2007 07:35:32 -0000 1.124
+++ compiler/unique_modes.m 23 Nov 2007 16:58:30 -0000
@@ -815,16 +815,15 @@
unique_modes_check_case_list([], _Var, [], [], !ModeInfo, !IO).
unique_modes_check_case_list([Case0 | Cases0], Var, [Case | Cases],
[InstMap | InstMaps], !ModeInfo, !IO) :-
- Case0 = case(ConsId, Goal0),
- Case = case(ConsId, Goal),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
mode_info_get_instmap(!.ModeInfo, InstMap0),
% If you modify this code, you may also need to modify
% unique_modecheck_clause_switch or the code that calls it.
- % Record the fact that Var was bound to ConsId in the instmap before
- % processing this case.
- modecheck_functor_test(Var, ConsId, !ModeInfo),
+ % Update the instmap to reflect the binding of Var to MainConsId or
+ % one of the OtherConsIds before processing this case.
+ modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo),
mode_info_get_instmap(!.ModeInfo, InstMap1),
( instmap.is_reachable(InstMap1) ->
@@ -838,6 +837,7 @@
mode_info_get_instmap(!.ModeInfo, InstMap),
fixup_switch_var(Var, InstMap0, InstMap, Goal1, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
mode_info_set_instmap(InstMap0, !ModeInfo),
unique_modes_check_case_list(Cases0, Var, Cases, InstMaps, !ModeInfo, !IO).
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.45
diff -u -b -r1.45 unneeded_code.m
--- compiler/unneeded_code.m 23 Nov 2007 07:35:32 -0000 1.45
+++ compiler/unneeded_code.m 23 Nov 2007 08:44:45 -0000
@@ -667,7 +667,7 @@
;
GoalExpr0 = switch(SwitchVar, CanFail, Cases0),
(
- Cases0 = [case(_, hlds_goal(_, FirstCaseGoalInfo)) | _],
+ Cases0 = [case(_, _, hlds_goal(_, FirstCaseGoalInfo)) | _],
FirstCaseGoalPath = goal_info_get_goal_path(FirstCaseGoalInfo),
cord.get_last(FirstCaseGoalPath, FirstCaseLastStep),
FirstCaseLastStep = step_switch(_, MaybeNumAltPrime)
@@ -813,13 +813,14 @@
process_cases([], [], _, _, _, _, _, _, _, _, _,
!WhereNeededMap, !RefinedGoals, !Changed).
-process_cases([case(Var, Goal0) | Cases0], [case(Var, Goal) | Cases],
- BranchPoint, BranchNum, InitInstMap, FinalInstMap, VarTypes,
- ModuleInfo, Options, CurrentPath, StartWhereNeededMap,
- !WhereNeededMap, !RefinedGoals, !Changed) :-
+process_cases([Case0 | Cases0], [Case | Cases], BranchPoint, BranchNum,
+ InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, CurrentPath,
+ StartWhereNeededMap, !WhereNeededMap, !RefinedGoals, !Changed) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
process_goal(Goal0, Goal, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
Options, StartWhereNeededMap, WhereNeededMapFirst, !RefinedGoals,
!Changed),
+ Case = case(MainConsId, OtherConsIds, Goal),
map.to_assoc_list(WhereNeededMapFirst, WhereNeededList),
add_alt_start(WhereNeededList, BranchPoint, BranchNum, CurrentPath,
!WhereNeededMap),
@@ -1006,8 +1007,9 @@
goal_path::in, int::in) is det.
refine_cases([], [], !RefinedGoals, _, _).
-refine_cases([case(Var, Goal0) | Cases0], [case(Var, Goal) | Cases],
- !RefinedGoals, GoalPath, BranchNum) :-
+refine_cases([Case0 | Cases0], [Case | Cases], !RefinedGoals, GoalPath,
+ BranchNum) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
refine_goal(Goal0, Goal1, !RefinedGoals),
( map.search(!.RefinedGoals, GoalPath - BranchNum, ToInsertGoals) ->
insert_refine_goals(ToInsertGoals, Goal1, Goal),
@@ -1015,6 +1017,7 @@
;
Goal = Goal1
),
+ Case = case(MainConsId, OtherConsIds, Goal),
refine_cases(Cases0, Cases, !RefinedGoals, GoalPath, BranchNum + 1).
:- pred refine_disj(list(hlds_goal)::in, list(hlds_goal)::out,
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.28
diff -u -b -r1.28 untupling.m
--- compiler/untupling.m 7 Aug 2007 07:10:09 -0000 1.28
+++ compiler/untupling.m 23 Nov 2007 08:40:55 -0000
@@ -626,10 +626,10 @@
fix_calls_in_cases([], [], !VarSet, !VarTypes, _, _).
fix_calls_in_cases([Case0 | Cases0], [Case | Cases], !VarSet, !VarTypes,
TransformMap, ModuleInfo) :-
- Case0 = case(Functor, Goal0),
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes,
TransformMap, ModuleInfo),
- Case = case(Functor, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
fix_calls_in_cases(Cases0, Cases, !VarSet, !VarTypes,
TransformMap, ModuleInfo).
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.146
diff -u -b -r1.146 unused_args.m
--- compiler/unused_args.m 19 Nov 2007 06:11:17 -0000 1.146
+++ compiler/unused_args.m 23 Nov 2007 08:42:33 -0000
@@ -839,7 +839,7 @@
:- pred list_case_to_list_goal(list(case)::in, list(hlds_goal)::out) is det.
list_case_to_list_goal([], []).
-list_case_to_list_goal([case(_, Goal) | Cases], [Goal | Goals]) :-
+list_case_to_list_goal([case(_, _, Goal) | Cases], [Goal | Goals]) :-
list_case_to_list_goal(Cases, Goals).
:- pred traverse_list_of_goals(traverse_info::in, list(hlds_goal)::in,
@@ -1601,9 +1601,10 @@
fixup_info::in, fixup_info::out, bool::in, bool::out) is det.
fixup_cases([], [], !Info, !Changed).
-fixup_cases([case(ConsId, Goal0) | Cases0], [case(ConsId, Goal) | Cases],
- !Info, !Changed) :-
+fixup_cases([Case0 | Cases0], [Case | Cases], !Info, !Changed) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
fixup_goal(Goal0, Goal, !Info, LocalChanged),
+ Case = case(MainConsId, OtherConsIds, Goal),
(
LocalChanged = yes,
!:Changed = yes
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.11
diff -u -b -r1.11 unused_imports.m
--- compiler/unused_imports.m 25 Sep 2007 04:56:43 -0000 1.11
+++ compiler/unused_imports.m 25 Nov 2007 11:49:03 -0000
@@ -195,7 +195,7 @@
( status_defined_in_this_module(ImportStatus) = yes ->
Visibility = item_visibility(ImportStatus),
(
- TypeBody = hlds_du_type(Ctors, _, _, _, _, _, _),
+ TypeBody = hlds_du_type(Ctors, _, _, _, _, _, _, _),
list.foldl(ctor_used_modules(Visibility), Ctors, !UsedModules)
;
TypeBody = hlds_eqv_type(EqvType),
@@ -407,11 +407,7 @@
hlds_goal_expr_used_modules(disj(Goals), !UsedModules) :-
list.foldl(hlds_goal_used_modules, Goals, !UsedModules).
hlds_goal_expr_used_modules(switch(_, _, Cases), !UsedModules) :-
- list.foldl(
- (pred(case(ConsId, Goal)::in, !.M::in, !:M::out) is det :-
- cons_id_used_modules(visibility_private, ConsId, !M),
- hlds_goal_used_modules(Goal, !M)
- ), Cases, !UsedModules).
+ list.foldl(case_used_modules, Cases, !UsedModules).
hlds_goal_expr_used_modules(negation(Goal), !UsedModules) :-
hlds_goal_used_modules(Goal, !UsedModules).
hlds_goal_expr_used_modules(scope(_, Goal), !UsedModules) :-
@@ -425,6 +421,16 @@
hlds_goal_used_modules(GoalA, !UsedModules),
hlds_goal_used_modules(GoalB, !UsedModules).
+:- pred case_used_modules(case::in, used_modules::in, used_modules::out)
+ is det.
+
+case_used_modules(Case, !UsedModules) :-
+ Case = case(MainConsId, OtherConsIds, Goal),
+ cons_id_used_modules(visibility_private, MainConsId, !UsedModules),
+ list.foldl(cons_id_used_modules(visibility_private), OtherConsIds,
+ !UsedModules),
+ hlds_goal_used_modules(Goal, !UsedModules).
+
:- pred unify_rhs_used_modules(unify_rhs::in,
used_modules::in, used_modules::out) is det.
Index: compiler/xml_documentation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/xml_documentation.m,v
retrieving revision 1.18
diff -u -b -r1.18 xml_documentation.m
--- compiler/xml_documentation.m 23 Nov 2007 07:35:33 -0000 1.18
+++ compiler/xml_documentation.m 25 Nov 2007 11:49:14 -0000
@@ -373,7 +373,7 @@
:- func type_xml_tag(hlds_type_body) = string.
-type_xml_tag(hlds_du_type(_, _, _, _, _, _, _)) = "du_type".
+type_xml_tag(hlds_du_type(_, _, _, _, _, _, _, _)) = "du_type".
type_xml_tag(hlds_eqv_type(_)) = "eqv_type".
type_xml_tag(hlds_foreign_type(_)) = "foreign_type".
type_xml_tag(hlds_solver_type(_, _)) = "solver_type".
@@ -387,7 +387,7 @@
:- func type_body(comments, tvarset, hlds_type_body) = list(xml).
-type_body(C, TVarset, hlds_du_type(Ctors, _, _, _, _, _, _)) =
+type_body(C, TVarset, hlds_du_type(Ctors, _, _, _, _, _, _, _)) =
[xml_list("constructors", constructor(C, TVarset), Ctors)].
type_body(_, TVarset, hlds_eqv_type(Type)) =
[elem("equivalent_type", [], [mer_type(TVarset, Type)])].
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.130
diff -u -b -r1.130 compiler_design.html
--- compiler/notes/compiler_design.html 25 Jun 2007 00:58:13 -0000 1.130
+++ compiler/notes/compiler_design.html 11 Dec 2007 17:03:17 -0000
@@ -1242,6 +1242,7 @@
<li> lookup_switch.m
<li> string_switch.m
<li> tag_switch.m
+ <li> switch_case.m
<li> switch_util.m -- this is in the backend_libs.m
package, since it is also used by MLDS back-end
</ul>
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
Index: deep_profiler/mdprof_procrep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/mdprof_procrep.m,v
retrieving revision 1.1
diff -u -b -r1.1 mdprof_procrep.m
--- deep_profiler/mdprof_procrep.m 12 Sep 2007 06:21:10 -0000 1.1
+++ deep_profiler/mdprof_procrep.m 26 Nov 2007 01:50:24 -0000
@@ -236,12 +236,20 @@
indent(Indent, !IO),
io.write_string(";\n", !IO)
),
- CaseRep = case_rep(ConsIdRep, Arity, GoalRep),
- indent(Indent + 1, !IO),
- io.format("%% case %s/%d\n", [s(ConsIdRep), i(Arity)], !IO),
+ CaseRep = case_rep(MainConsIdArityRep, OtherConsIdArityRep, GoalRep),
+ print_cons_id_and_arity(Indent + 1, MainConsIdArityRep, !IO),
+ list.foldl(print_cons_id_and_arity(Indent + 1), OtherConsIdArityRep, !IO),
print_goal(Indent + 1, GoalRep, !IO),
print_switch(Indent, CaseReps, yes, !IO).
+:- pred print_cons_id_and_arity(int::in, cons_id_arity_rep::in,
+ io::di, io::uo) is det.
+
+print_cons_id_and_arity(Indent, ConsIdArityRep, !IO) :-
+ ConsIdArityRep = cons_id_arity_rep(ConsIdRep, Arity),
+ indent(Indent + 1, !IO),
+ io.format("%% case %s/%d\n", [s(ConsIdRep), i(Arity)], !IO).
+
%-----------------------------------------------------------------------------%
:- pred print_atomic_goal(int::in, atomic_goal_rep::in, io::di, io::uo) is det.
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/string.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.268
diff -u -b -r1.268 string.m
--- library/string.m 23 Nov 2007 07:35:58 -0000 1.268
+++ library/string.m 23 Nov 2007 15:45:14 -0000
@@ -4577,6 +4577,7 @@
split_at_string(0, length(Needle), Needle, Total).
:- func split_at_string(int, int, string, string) = list(string).
+
split_at_string(StartAt, NeedleLen, Needle, Total) = Out :-
( sub_string_search_start(Total, Needle, StartAt, NeedlePos) ->
BeforeNeedle = substring(Total, StartAt, NeedlePos-StartAt),
@@ -4741,12 +4742,11 @@
:- mode value_to_revstrings_prio(in, in, in, in, in, out) is cc_multi.
value_to_revstrings_prio(NonCanon, OpsTable, Priority, X, !Rs) :-
- %
% We need to special-case the builtin types:
% int, char, float, string
% type_info, univ, c_pointer, array
% and private_builtin.type_info
- %
+
( dynamic_cast(X, String) ->
add_revstring(term_io.quoted_string(String), !Rs)
; dynamic_cast(X, Char) ->
@@ -4840,22 +4840,29 @@
->
add_revstring("[]", !Rs)
;
- Functor = "{}",
- Args = [BracedTerm]
+ Functor = "{}"
->
+ (
+ Args = [],
+ add_revstring("{}", !Rs)
+ ;
+ Args = [BracedTerm],
add_revstring("{ ", !Rs),
- value_to_revstrings(NonCanon, OpsTable, univ_value(BracedTerm), !Rs),
+ value_to_revstrings(NonCanon, OpsTable, univ_value(BracedTerm),
+ !Rs),
add_revstring(" }", !Rs)
;
- Functor = "{}",
- Args = [BracedHead | BracedTail]
- ->
+ Args = [BracedHead | BracedTail],
+ BracedTail = [_ | _],
add_revstring("{", !Rs),
arg_to_revstrings(NonCanon, OpsTable, BracedHead, !Rs),
term_args_to_revstrings(NonCanon, OpsTable, BracedTail, !Rs),
add_revstring("}", !Rs)
+ )
;
- Args = [PrefixArg],
+ Args = [Arg]
+ ->
+ (
ops.lookup_prefix_op(OpsTable, Functor, OpPriority, OpAssoc)
->
maybe_add_revstring("(", Priority, OpPriority, !Rs),
@@ -4863,21 +4870,26 @@
add_revstring(" ", !Rs),
adjust_priority(OpPriority, OpAssoc, NewPriority),
value_to_revstrings_prio(NonCanon, OpsTable, NewPriority,
- univ_value(PrefixArg), !Rs),
+ univ_value(Arg), !Rs),
maybe_add_revstring(")", Priority, OpPriority, !Rs)
;
- Args = [PostfixArg],
ops.lookup_postfix_op(OpsTable, Functor, OpPriority, OpAssoc)
->
maybe_add_revstring("(", Priority, OpPriority, !Rs),
adjust_priority(OpPriority, OpAssoc, NewPriority),
value_to_revstrings_prio(NonCanon, OpsTable, NewPriority,
- univ_value(PostfixArg), !Rs),
+ univ_value(Arg), !Rs),
add_revstring(" ", !Rs),
add_revstring(term_io.quoted_atom(Functor), !Rs),
maybe_add_revstring(")", Priority, OpPriority, !Rs)
;
- Args = [Arg1, Arg2],
+ plain_term_to_revstrings(NonCanon, OpsTable, Priority,
+ Functor, Args, !Rs)
+ )
+ ;
+ Args = [Arg1, Arg2]
+ ->
+ (
ops.lookup_infix_op(OpsTable, Functor, OpPriority,
LeftAssoc, RightAssoc)
->
@@ -4897,7 +4909,6 @@
univ_value(Arg2), !Rs),
maybe_add_revstring(")", Priority, OpPriority, !Rs)
;
- Args = [Arg1, Arg2],
ops.lookup_binary_prefix_op(OpsTable, Functor,
OpPriority, FirstAssoc, SecondAssoc)
->
@@ -4913,6 +4924,26 @@
univ_value(Arg2), !Rs),
maybe_add_revstring(")", Priority, OpPriority, !Rs)
;
+ plain_term_to_revstrings(NonCanon, OpsTable, Priority,
+ Functor, Args, !Rs)
+ )
+ ;
+ plain_term_to_revstrings(NonCanon, OpsTable, Priority, Functor, Args,
+ !Rs)
+ ).
+
+:- pred plain_term_to_revstrings(noncanon_handling, ops.table,
+ ops.priority, string, list(univ), revstrings, revstrings).
+:- mode plain_term_to_revstrings(in(do_not_allow), in, in, in, in, in, out)
+ is det.
+:- mode plain_term_to_revstrings(in(canonicalize), in, in, in, in, in, out)
+ is det.
+:- mode plain_term_to_revstrings(in(include_details_cc), in, in, in, in,
+ in, out) is cc_multi.
+:- mode plain_term_to_revstrings(in, in, in, in, in, in, out)
+ is cc_multi.
+
+plain_term_to_revstrings(NonCanon, OpsTable, Priority, Functor, Args, !Rs) :-
(
Args = [],
ops.lookup_op(OpsTable, Functor),
@@ -4936,7 +4967,6 @@
add_revstring(")", !Rs)
;
Args = []
- )
).
:- pred maybe_add_revstring(string::in, ops.priority::in, ops.priority::in,
cvs diff: Diffing mdbcomp
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.27
diff -u -b -r1.27 program_representation.m
--- mdbcomp/program_representation.m 12 Nov 2007 03:52:48 -0000 1.27
+++ mdbcomp/program_representation.m 23 Nov 2007 10:52:47 -0000
@@ -151,9 +151,12 @@
:- type case_rep
---> case_rep(
- cons_id_rep, % The function symbol unified with the
- % switched-on in this switch arm.
- int, % The arity of the function symbol.
+ cons_id_arity_rep, % The name and arity of the first
+ % function symbol for which this switch arm
+ % is applicable.
+ list(cons_id_arity_rep),
+ % The names and arities of any other
+ % function symbols for this switch arm.
goal_rep % The code of the switch arm.
).
@@ -233,6 +236,12 @@
:- type var_rep == int.
+:- type cons_id_arity_rep
+ ---> cons_id_arity_rep(
+ cons_id_rep,
+ int
+ ).
+
:- type cons_id_rep == string.
:- type detism_rep
@@ -1113,10 +1122,12 @@
read_cases_2(VarNumRep, ByteCode, StringTable, Info, N, Cases, !Pos) :-
( N > 0 ->
- read_cons_id(ByteCode, StringTable, ConsId, !Pos),
- read_short(ByteCode, ConsIdArity, !Pos),
+ read_cons_id_arity(ByteCode, StringTable, MainConsId, !Pos),
+ read_length(ByteCode, NumOtherConsIds, !Pos),
+ read_n_cons_id_arities(ByteCode, StringTable, NumOtherConsIds,
+ OtherConsIds, !Pos),
read_goal(VarNumRep, ByteCode, StringTable, Info, Goal, !Pos),
- Head = case_rep(ConsId, ConsIdArity, Goal),
+ Head = case_rep(MainConsId, OtherConsIds, Goal),
read_cases_2(VarNumRep, ByteCode, StringTable, Info, N - 1, Tail,
!Pos),
Cases = [Head | Tail]
@@ -1124,6 +1135,26 @@
Cases = []
).
+:- pred read_cons_id_arity(bytecode::in, string_table::in,
+ cons_id_arity_rep::out, int::in, int::out) is semidet.
+
+read_cons_id_arity(ByteCode, StringTable, ConsId, !Pos) :-
+ read_cons_id(ByteCode, StringTable, ConsIdFunctor, !Pos),
+ read_short(ByteCode, ConsIdArity, !Pos),
+ ConsId = cons_id_arity_rep(ConsIdFunctor, ConsIdArity).
+
+:- pred read_n_cons_id_arities(bytecode::in, string_table::in, int::in,
+ list(cons_id_arity_rep)::out, int::in, int::out) is semidet.
+
+read_n_cons_id_arities(ByteCode, StringTable, N, ConsIds, !Pos) :-
+ ( N > 0 ->
+ read_cons_id_arity(ByteCode, StringTable, Head, !Pos),
+ read_n_cons_id_arities(ByteCode, StringTable, N - 1, Tail, !Pos),
+ ConsIds = [Head | Tail]
+ ;
+ ConsIds = []
+ ).
+
:- pred read_vars(var_num_rep::in, bytecode::in, list(var_rep)::out,
int::in, int::out) is semidet.
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/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/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/binary
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/binary,v
retrieving revision 1.28
diff -u -b -r1.28 binary
--- tools/binary 24 Oct 2007 09:21:19 -0000 1.28
+++ tools/binary 12 Dec 2007 05:18:53 -0000
@@ -102,9 +102,23 @@
dependency_only="-d" ;;
-D|--dir)
- alldirs="$2"; shift ;;
+ if test "$alldirs" = ""
+ then
+ alldirs="$2"; shift
+ else
+ echo "You can specify only one directory." 1>&2
+ exit 1
+ fi
+ ;;
-D*)
- alldirs="` expr $1 : '-d\(.*\)' `"; ;;
+ if test "$alldirs" = ""
+ then
+ alldirs="` expr $1 : '-d\(.*\)' `"
+ else
+ echo "You can specify only one directory." 1>&2
+ exit 1
+ fi
+ ;;
-f|--file)
allmodules="$allmodules $2"; shift ;;
@@ -502,6 +516,13 @@
exit 1
fi
else
+ for subdir in library mdbcomp analysis compiler
+ do
+ echo linking stage2/$subdir from stage2.ok/$subdir 1>&2
+ cp stage2.ok/$subdir/*.[co] stage2/$subdir
+ cp stage2.ok/$subdir/*.pic_o stage2/$subdir
+ done
+
testeddir=$alldirs
if test ! -d stage2/$testeddir
then
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