[m-dev.] for review: specializing comparisons
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Nov 6 15:06:04 AEDT 2000
On 01-Nov-2000, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > compiler/unify_proc.m:
> > Generate specialized comparison predicates for types with less than
> > four functors. This should speed up comparisons on such types, and
> > since we can generate a dummy index predicate for such types, should
> > not increase code size much, or at all. (Avoiding the generation of
> > index predicates altogether for such types would be much harder
> > to arrange.)
>
> That change looks fine. But it would be interesting to know
> what effect it had on code size and speed.
To answer that question, I made the max number of function symbols for which
we specialize comparison procedures controllable by an option. The results
were quite messy: the optimal value of the parameter depends strongly on
the optimization levels. Here are the results from benchmarking from a set
of 16 compilers I built over the weekend. (The MCFLAGS specify how the compiler
was built, not the flags it is given for compiling make_hlds.m for the test.)
EXTRA_MCFLAGS = -O1 --compare-specialization 0
mercury_compile.01 44.87
EXTRA_MCFLAGS = -O1 --compare-specialization 1
mercury_compile.02 42.75
EXTRA_MCFLAGS = -O1 --compare-specialization 2
mercury_compile.03 43.04
EXTRA_MCFLAGS = -O1 --compare-specialization 3
mercury_compile.04 43.05
EXTRA_MCFLAGS = -O2 --compare-specialization 0
mercury_compile.05 36.46
EXTRA_MCFLAGS = -O2 --compare-specialization 1
mercury_compile.06 36.82
EXTRA_MCFLAGS = -O2 --compare-specialization 2
mercury_compile.07 36.18
EXTRA_MCFLAGS = -O2 --compare-specialization 3
mercury_compile.08 36.21
EXTRA_MCFLAGS = -O3 --compare-specialization 0
mercury_compile.09 36.01
EXTRA_MCFLAGS = -O3 --compare-specialization 1
mercury_compile.10 35.89
EXTRA_MCFLAGS = -O3 --compare-specialization 2
mercury_compile.11 35.80
EXTRA_MCFLAGS = -O3 --compare-specialization 3
mercury_compile.12 35.72
EXTRA_MCFLAGS = -O5 --compare-specialization 0
mercury_compile.13 35.49
EXTRA_MCFLAGS = -O5 --compare-specialization 1
mercury_compile.14 35.65
EXTRA_MCFLAGS = -O5 --compare-specialization 2
mercury_compile.15 35.47
EXTRA_MCFLAGS = -O5 --compare-specialization 3
mercury_compile.16 35.50
For -O3 and -O4, all four results are within measurement error. For -O1,
--compare-specialization 1 is the best, while for -O2, it is the worst.
For code size, more specialization is definitely better:
6110924 91184 47004 6249112 5f5a98 compare_spec.01
6066508 91184 47004 6204696 5ead18 compare_spec.02
6052044 91184 47004 6190232 5e7498 compare_spec.03
6045932 91184 47004 6184120 5e5cb8 compare_spec.04
5832172 99632 47004 5978808 5b3ab8 compare_spec.05
5815468 99632 47004 5962104 5af978 compare_spec.06
5800140 99632 47004 5946776 5abd98 compare_spec.07
5789836 99632 47004 5936472 5a9558 compare_spec.08
5869900 99760 47004 6016664 5bce98 compare_spec.09
5849996 99760 47004 5996760 5b80d8 compare_spec.10
5834636 99760 47004 5981400 5b44d8 compare_spec.11
5824300 99760 47004 5971064 5b1c78 compare_spec.12
6000332 105712 47004 6153048 5de358 compare_spec.13
5983084 105712 47004 6135800 5d9ff8 compare_spec.14
5965772 105712 47004 6118488 5d5c58 compare_spec.15
5954700 105712 47004 6107416 5d3118 compare_spec.16
I will commit the change with the value of --compare-specialization being set
by default to 1, which corresponds to the current hardwired behavior.
For completeness, the updated diff follows. All that changes is the
introduction of the option.
I left the option undocumented, since similar implementor-only options (e.g.
max-jump-table-size) are also undocumented.
Zoltan.
cvs diff: Diffing .
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/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.95
diff -u -b -r1.95 handle_options.m
--- compiler/handle_options.m 2000/10/22 07:27:18 1.95
+++ compiler/handle_options.m 2000/11/03 08:51:20
@@ -45,7 +45,7 @@
:- implementation.
-:- import_module options, globals, prog_io_util, trace_params.
+:- import_module options, globals, prog_io_util, trace_params, unify_proc.
:- import_module char, int, string, map, set, getopt, library.
handle_options(MaybeError, Args, Link) -->
@@ -320,6 +320,16 @@
% --split-c-files implies --procs-per-c-function 1
option_implies(split_c_files, procs_per_c_function, int(1)),
+
+ % make_hlds contains an optimization which requires the value of the
+ % compare_specialization option to accurately specify the max number
+ % of constructors in a type whose comparison procedure is specialized
+ % and which therefore don't need index functions.
+ globals__io_lookup_int_option(compare_specialization, CompareSpec0),
+ { int__min(unify_proc__max_exploited_compare_spec_value,
+ CompareSpec0, CompareSpec) },
+ globals__io_set_option(compare_specialization, int(CompareSpec)),
+
% Minimal model tabling is not compatible with trailing;
% see the comment in runtime/mercury_tabling.c.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.357
diff -u -b -r1.357 make_hlds.m
--- compiler/make_hlds.m 2000/11/01 05:11:58 1.357
+++ compiler/make_hlds.m 2000/11/03 08:58:11
@@ -2943,7 +2943,11 @@
UserDefinedEquality),
IsEnum = no,
UserDefinedEquality = no,
- Ctors = [_, _|_]
+ module_info_globals(Module0, Globals),
+ globals__lookup_int_option(Globals,
+ compare_specialization, CompareSpec),
+ list__length(Ctors, CtorCount),
+ CtorCount > CompareSpec
->
SpecialPredIds = [index, compare]
;
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.296
diff -u -b -r1.296 options.m
--- compiler/options.m 2000/11/03 06:12:20 1.296
+++ compiler/options.m 2000/11/03 08:58:15
@@ -271,6 +271,7 @@
; c_flag_to_name_object_file
; object_file_extension
; max_jump_table_size
+ ; compare_specialization
; fact_table_max_array_size
% maximum number of elements in a single
% fact table data array
@@ -628,6 +629,7 @@
% above default with a value determined
% at configuration time
max_jump_table_size - int(0),
+ compare_specialization - int(1),
% 0 indicates any size.
fact_table_max_array_size - int(1024),
fact_table_hash_percent_full - int(90),
@@ -1002,6 +1004,7 @@
long_option("c-flag-to-name-object-file", c_flag_to_name_object_file).
long_option("object-file-extension", object_file_extension).
long_option("max-jump-table-size", max_jump_table_size).
+long_option("compare-specialization", compare_specialization).
long_option("fact-table-max-array-size",fact_table_max_array_size).
long_option("fact-table-hash-percent-full",
fact_table_hash_percent_full).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.90
diff -u -b -r1.90 unify_proc.m
--- compiler/unify_proc.m 2000/10/13 13:56:01 1.90
+++ compiler/unify_proc.m 2000/11/03 08:48:26
@@ -56,26 +56,24 @@
% Initialize the proc_requests table.
-:- pred unify_proc__init_requests(proc_requests).
-:- mode unify_proc__init_requests(out) is det.
+:- pred unify_proc__init_requests(proc_requests::out) is det.
% Add a new request for a unification procedure to the
% proc_requests table.
-:- pred unify_proc__request_unify(unify_proc_id, inst_varset,
- determinism, prog_context, module_info, module_info).
-:- mode unify_proc__request_unify(in, in, in, in, in, out) is det.
-
- % Add a new request for a procedure (not necessarily a unification)
- % to the request queue. Return the procedure's newly allocated
- % proc_id. (This is used by unique_modes.m.)
-
-:- pred unify_proc__request_proc(pred_id, list(mode), inst_varset,
- maybe(list(is_live)), maybe(determinism), prog_context,
- module_info, proc_id, module_info).
-:- mode unify_proc__request_proc(in, in, in, in, in, in, in, out, out) is det.
+:- pred unify_proc__request_unify(unify_proc_id::in, inst_varset::in,
+ determinism::in, prog_context::in, module_info::in, module_info::out)
+ is det.
+
+% Add a new request for a procedure (not necessarily a unification)
+% to the request queue. Return the procedure's newly allocated
+% proc_id. (This is used by unique_modes.m.)
+
+:- pred unify_proc__request_proc(pred_id::in, list(mode)::in, inst_varset::in,
+maybe(list(is_live))::in, maybe(determinism)::in, prog_context::in,
+module_info::in, proc_id::out, module_info::out) is det.
- % unify_proc__add_lazily_generated_unify_pred(TypeId,
+% unify_proc__add_lazily_generated_unify_pred(TypeId,
% UnifyPredId_for_Type, ModuleInfo0, ModuleInfo).
%
% For most imported unification procedures, we delay
@@ -84,19 +82,15 @@
% is a complicated unification involving the type.
% This predicate is exported for use by higher_order.m
% when it is specializing calls to unify/2.
-:- pred unify_proc__add_lazily_generated_unify_pred(type_id,
- pred_id, module_info, module_info).
-:- mode unify_proc__add_lazily_generated_unify_pred(in,
- out, in, out) is det.
+:- pred unify_proc__add_lazily_generated_unify_pred(type_id::in,
+ pred_id::out, module_info::in, module_info::out) is det.
% unify_proc__add_lazily_generated_compare_pred_decl(TypeId,
% ComparePredId_for_Type, ModuleInfo0, ModuleInfo).
%
% Add declarations, but not clauses, for a compare or index predicate.
-:- pred unify_proc__add_lazily_generated_compare_pred_decl(type_id,
- pred_id, module_info, module_info).
-:- mode unify_proc__add_lazily_generated_compare_pred_decl(in,
- out, in, out) is det.
+:- pred unify_proc__add_lazily_generated_compare_pred_decl(type_id::in,
+ pred_id::out, module_info::in, module_info::out) is det.
% Do mode analysis of the queued procedures.
% If the first argument is `unique_mode_check',
@@ -106,24 +100,28 @@
% procedure bodies before unique mode analysis, so that
% we can restore them before doing the next analysis pass.
-:- pred modecheck_queued_procs(how_to_check_goal, pred_table, module_info,
- pred_table, module_info, bool,
- io__state, io__state).
-:- mode modecheck_queued_procs(in, in, in, out, out, out, di, uo) is det.
+:- pred modecheck_queued_procs(how_to_check_goal::in,
+ pred_table::in, module_info::in, pred_table::out, module_info::out,
+ bool::out, io__state::di, io__state::uo) is det.
% Given the type and mode of a unification, look up the
% mode number for the unification proc.
-:- pred unify_proc__lookup_mode_num(module_info, type_id, uni_mode,
- determinism, proc_id).
-:- mode unify_proc__lookup_mode_num(in, in, in, in, out) is det.
+:- pred unify_proc__lookup_mode_num(module_info::in, type_id::in, uni_mode::in,
+ determinism::in, proc_id::out) is det.
% Generate the clauses for one of the compiler-generated
% special predicates (compare/3, index/3, unify, etc.)
+
+:- pred unify_proc__generate_clause_info(special_pred_id::in, (type)::in,
+ hlds_type_body::in, prog_context::in, module_info::in,
+ clauses_info::out) is det.
+
+ % This number gives the maximum number of constructors in a type
+ % whose compare procedure can be specialized, and whose compare
+ % procedure therefore does need an index procedure on that type.
-:- pred unify_proc__generate_clause_info(special_pred_id, type,
- hlds_type_body, prog_context, module_info, clauses_info).
-:- mode unify_proc__generate_clause_info(in, in, in, in, in, out) is det.
+:- func unify_proc__max_exploited_compare_spec_value = int.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -397,8 +395,7 @@
:- mode queued_proc_progress_message(in, in, in, di, uo) is det.
queued_proc_progress_message(PredProcId, HowToCheckGoal, ModuleInfo) -->
- globals__io_lookup_bool_option(very_verbose,
- VeryVerbose),
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose),
( { VeryVerbose = yes } ->
%
% print progress message
@@ -893,33 +890,31 @@
%-----------------------------------------------------------------------------%
-/*
- For a type such as
-
- type t(X) ---> a ; b(int) ; c(X); d(int, X, t)
-
- we want to generate code
-
- eq(H1, H2) :-
- (
- H1 = a,
- H2 = a
- ;
- H1 = b(X1),
- H2 = b(X2),
- X1 = X2,
- ;
- H1 = c(Y1),
- H2 = c(Y2),
- Y1 = Y2,
- ;
- H1 = d(A1, B1, C1),
- H2 = c(A2, B2, C2),
- A1 = A2,
- B1 = B2,
- C1 = C2
- ).
-*/
+% For a type such as
+%
+% type t(X) ---> a ; b(int) ; c(X); d(int, X, t)
+%
+% we want to generate code
+%
+% eq(H1, H2) :-
+% (
+% H1 = a,
+% H2 = a
+% ;
+% H1 = b(X1),
+% H2 = b(X2),
+% X1 = X2,
+% ;
+% H1 = c(Y1),
+% H2 = c(Y2),
+% Y1 = Y2,
+% ;
+% H1 = d(A1, B1, C1),
+% H2 = c(A2, B2, C2),
+% A1 = A2,
+% B1 = B2,
+% C1 = C2
+% ).
:- pred unify_proc__generate_du_unify_clauses(list(constructor), prog_var,
prog_var, prog_context, list(clause),
@@ -952,26 +947,24 @@
unify_proc__generate_du_unify_clauses(Ctors, H1, H2, Context, Clauses).
%-----------------------------------------------------------------------------%
-
-/*
- For a type such as
-
- :- type foo ---> f ; g(a, b, c) ; h(foo).
- we want to generate code
-
- index(X, Index) :-
- (
- X = f,
- Index = 0
- ;
- X = g(_, _, _),
- Index = 1
- ;
- X = h(_),
- Index = 2
- ).
-*/
+% For a type such as
+%
+% :- type foo ---> f ; g(a, b, c) ; h(foo).
+%
+% we want to generate code
+%
+% index(X, Index) :-
+% (
+% X = f,
+% Index = 0
+% ;
+% X = g(_, _, _),
+% Index = 1
+% ;
+% X = h(_),
+% Index = 2
+% ).
:- pred unify_proc__generate_du_index_clauses(list(constructor), prog_var,
prog_var, prog_context, int, list(clause),
@@ -994,8 +987,7 @@
UnifyIndex_Goal) },
{ GoalList = [UnifyX_Goal, UnifyIndex_Goal] },
{ goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context,
- GoalInfo) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ conj_list_to_goal(GoalList, GoalInfo, Goal) },
unify_proc__quantify_clause_body([X, Index], Goal, Context, Clause),
{ N1 is N + 1 },
@@ -1003,58 +995,227 @@
Clauses).
%-----------------------------------------------------------------------------%
-
-/* For a type such as
- :- type foo ---> f ; g(a) ; h(b, foo).
-
- we want to generate code
+:- pred unify_proc__generate_du_compare_clauses((type)::in,
+ list(constructor)::in, prog_var::in, prog_var::in, prog_var::in,
+ prog_context::in, list(clause)::out,
+ unify_proc_info::in, unify_proc_info::out) is det.
- compare(Res, X, Y) :-
- __Index__(X, X_Index), % Call_X_Index
- __Index__(Y, Y_Index), % Call_Y_Index
- ( X_Index < Y_Index -> % Call_Less_Than
- Res = (<) % Return_Less_Than
- ; X_Index > Y_Index -> % Call_Greater_Than
- Res = (>) % Return_Greater_Than
- ;
- % This disjunction is generated by
- % unify_proc__generate_compare_cases, below.
+unify_proc__generate_du_compare_clauses(Type, Ctors, Res, H1, H2,
+ Context, Clauses) -->
(
- X = f, Y = f,
- R = (=)
+ { Ctors = [] },
+ { error("compare for type with no functors") }
+ ;
+ { Ctors = [Ctor] },
+ unify_proc__info_get_module_info(ModuleInfo),
+ { module_info_globals(ModuleInfo, Globals) },
+ { globals__lookup_int_option(Globals, compare_specialization,
+ CompareSpec) },
+ ( { CompareSpec >= 1 } ->
+ unify_proc__generate_du_one_compare_clause(
+ Ctor, Res, H1, H2,
+ Context, Clauses)
;
- X = g(X1), Y = g(Y1),
- compare(R, X1, Y1)
+ unify_proc__generate_du_general_compare_clauses(Type,
+ Ctors, Res, H1, H2, Context, Clauses)
+ )
;
- X = h(X1, X2), Y = h(Y1, Y2),
- ( compare(R1, X1, Y1), R1 \= (=) ->
- R = R1
+ { Ctors = [Ctor1, Ctor2] },
+ unify_proc__info_get_module_info(ModuleInfo),
+ { module_info_globals(ModuleInfo, Globals) },
+ { globals__lookup_int_option(Globals, compare_specialization,
+ CompareSpec) },
+ ( { CompareSpec >= 2 } ->
+ unify_proc__generate_du_two_compare_clauses(
+ Ctor1, Ctor2, Res, H1, H2,
+ Context, Clauses)
;
- compare(R, X2, Y2)
+ unify_proc__generate_du_general_compare_clauses(Type,
+ Ctors, Res, H1, H2, Context, Clauses)
)
+ ;
+ { Ctors = [Ctor1, Ctor2, Ctor3] },
+ unify_proc__info_get_module_info(ModuleInfo),
+ { module_info_globals(ModuleInfo, Globals) },
+ { globals__lookup_int_option(Globals, compare_specialization,
+ CompareSpec) },
+ ( { CompareSpec >= 3 } ->
+ unify_proc__generate_du_three_compare_clauses(
+ Ctor1, Ctor2, Ctor3, Res, H1, H2,
+ Context, Clauses)
+ ;
+ unify_proc__generate_du_general_compare_clauses(Type,
+ Ctors, Res, H1, H2, Context, Clauses)
)
- ->
- Res = R % Return_R
;
- compare_error % Abort
+ { Ctors = [_, _, _, _ | _] },
+ unify_proc__generate_du_general_compare_clauses(Type,
+ Ctors, Res, H1, H2, Context, Clauses)
).
-*/
-:- pred unify_proc__generate_du_compare_clauses((type)::in,
+unify_proc__max_exploited_compare_spec_value = 3.
+
+%-----------------------------------------------------------------------------%
+
+% For a du type with one function symbol, such as
+%
+% :- type foo ---> f(a, b, c)
+%
+% we want to generate code
+%
+% compare(Res, X, Y) :-
+% X = f(X1, X2, X3), Y = f(Y1, Y2, Y3),
+% ( compare(R1, X1, Y1), R1 \= (=) ->
+% R = R1
+% ; compare(R2, X2, Y2), R2 \= (=) ->
+% R = R2
+% ;
+% compare(R, X3, Y3)
+% ).
+
+:- pred unify_proc__generate_du_one_compare_clause(constructor::in,
+ prog_var::in, prog_var::in, prog_var::in,
+ prog_context::in, list(clause)::out,
+ unify_proc_info::in, unify_proc_info::out) is det.
+
+unify_proc__generate_du_one_compare_clause(Ctor, R, X, Y, Context, Clauses) -->
+ unify_proc__generate_compare_case(Ctor, R, X, Y, Context, Goal),
+ { HeadVars = [R, X, Y] },
+ unify_proc__quantify_clauses_body(HeadVars, Goal, Context, Clauses).
+
+%-----------------------------------------------------------------------------%
+
+% For a du type with two or three function symbols, such as
+%
+% :- type foo ---> f(a) ; g(a, b, c)
+%
+% we want to generate code such as
+%
+% compare(Res, X, Y) :-
+% (
+% X = f(X1),
+% Y = f(Y1),
+% compare(R, X1, Y1)
+% ;
+% X = f(_),
+% Y = g(_, _, _),
+% R = (<)
+% ;
+% X = g(_, _, _),
+% Y = f(_),
+% R = (>)
+% ;
+% X = g(X1, X2, X3),
+% Y = g(Y1, Y2, Y3),
+% ( compare(R1, X1, Y1), R1 \= (=) ->
+% R = R1
+% ; compare(R2, X2, Y2), R2 \= (=) ->
+% R = R2
+% ;
+% compare(R, X3, Y3)
+% )
+% ).
+
+:- pred unify_proc__generate_du_two_compare_clauses(
+ constructor::in, constructor::in, prog_var::in, prog_var::in,
+ prog_var::in, prog_context::in, list(clause)::out,
+ unify_proc_info::in, unify_proc_info::out) is det.
+
+unify_proc__generate_du_two_compare_clauses(Ctor1, Ctor2, R, X, Y,
+ Context, Clauses) -->
+ unify_proc__generate_compare_case(Ctor1, R, X, Y, Context, Case11),
+ unify_proc__generate_compare_case(Ctor2, R, X, Y, Context, Case22),
+ unify_proc__generate_asymmetric_compare_case(Ctor1, Ctor2, "<",
+ R, X, Y, Context, Case12),
+ unify_proc__generate_asymmetric_compare_case(Ctor2, Ctor1, ">",
+ R, X, Y, Context, Case21),
+
+ { goal_info_init(GoalInfo0) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
+ { map__init(Empty) },
+ { Goal = disj([Case11, Case12, Case21, Case22], Empty) - GoalInfo },
+ { HeadVars = [R, X, Y] },
+ unify_proc__quantify_clauses_body(HeadVars, Goal, Context, Clauses).
+
+:- pred unify_proc__generate_du_three_compare_clauses(
+ constructor::in, constructor::in, constructor::in,
+ prog_var::in, prog_var::in, prog_var::in, prog_context::in,
+ list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
+
+unify_proc__generate_du_three_compare_clauses(Ctor1, Ctor2, Ctor3, R, X, Y,
+ Context, Clauses) -->
+ unify_proc__generate_compare_case(Ctor1, R, X, Y, Context, Case11),
+ unify_proc__generate_compare_case(Ctor2, R, X, Y, Context, Case22),
+ unify_proc__generate_compare_case(Ctor3, R, X, Y, Context, Case33),
+ unify_proc__generate_asymmetric_compare_case(Ctor1, Ctor2, "<",
+ R, X, Y, Context, Case12),
+ unify_proc__generate_asymmetric_compare_case(Ctor1, Ctor3, "<",
+ R, X, Y, Context, Case13),
+ unify_proc__generate_asymmetric_compare_case(Ctor2, Ctor3, "<",
+ R, X, Y, Context, Case23),
+ unify_proc__generate_asymmetric_compare_case(Ctor2, Ctor1, ">",
+ R, X, Y, Context, Case21),
+ unify_proc__generate_asymmetric_compare_case(Ctor3, Ctor1, ">",
+ R, X, Y, Context, Case31),
+ unify_proc__generate_asymmetric_compare_case(Ctor3, Ctor2, ">",
+ R, X, Y, Context, Case32),
+
+ { goal_info_init(GoalInfo0) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
+ { map__init(Empty) },
+ { Goal = disj([Case11, Case12, Case13, Case21, Case22, Case23,
+ Case31, Case32, Case33], Empty) - GoalInfo },
+ { HeadVars = [R, X, Y] },
+ unify_proc__quantify_clauses_body(HeadVars, Goal, Context, Clauses).
+
+%-----------------------------------------------------------------------------%
+
+% For a du type with four or more function symbols, such as
+%
+% :- type foo ---> f ; g(a) ; h(b, foo).
+%
+% we want to generate code
+%
+% compare(Res, X, Y) :-
+% __Index__(X, X_Index), % Call_X_Index
+% __Index__(Y, Y_Index), % Call_Y_Index
+% ( X_Index < Y_Index -> % Call_Less_Than
+% Res = (<) % Return_Less_Than
+% ; X_Index > Y_Index -> % Call_Greater_Than
+% Res = (>) % Return_Greater_Than
+% ;
+% % This disjunction is generated by
+% % unify_proc__generate_compare_cases, below.
+% (
+% X = f, Y = f,
+% R = (=)
+% ;
+% X = g(X1), Y = g(Y1),
+% compare(R, X1, Y1)
+% ;
+% X = h(X1, X2), Y = h(Y1, Y2),
+% ( compare(R1, X1, Y1), R1 \= (=) ->
+% R = R1
+% ;
+% compare(R, X2, Y2)
+% )
+% )
+% ->
+% Res = R % Return_R
+% ;
+% compare_error % Abort
+% ).
+
+:- pred unify_proc__generate_du_general_compare_clauses((type)::in,
list(constructor)::in, prog_var::in, prog_var::in, prog_var::in,
prog_context::in, list(clause)::out,
unify_proc_info::in, unify_proc_info::out) is det.
-unify_proc__generate_du_compare_clauses(Type, Ctors, Res, X, Y, Context,
- [Clause]) -->
- ( { Ctors = [SingleCtor] } ->
- unify_proc__generate_compare_case(SingleCtor, Res, X, Y,
- Context, Goal)
- ;
+unify_proc__generate_du_general_compare_clauses(Type, Ctors, Res, X, Y,
+ Context, [Clause]) -->
unify_proc__generate_du_compare_clauses_2(Type, Ctors, Res,
- X, Y, Context, Goal)
- ),
+ X, Y, Context, Goal),
{ HeadVars = [Res, X, Y] },
unify_proc__quantify_clause_body(HeadVars, Goal, Context, Clause).
@@ -1119,31 +1280,29 @@
) - GoalInfo, Empty
) - GoalInfo
]) - GoalInfo }.
-
-/*
- unify_proc__generate_compare_cases: for a type such as
- :- type foo ---> f ; g(a) ; h(b, foo).
-
- we want to generate code
- (
- X = f, % UnifyX_Goal
- Y = f, % UnifyY_Goal
- R = (=) % CompareArgs_Goal
- ;
- X = g(X1),
- Y = g(Y1),
- compare(R, X1, Y1)
- ;
- X = h(X1, X2),
- Y = h(Y1, Y2),
- ( compare(R1, X1, Y1), R1 \= (=) ->
- R = R1
- ;
- compare(R, X2, Y2)
- )
- )
-*/
+% unify_proc__generate_compare_cases: for a type such as
+%
+% :- type foo ---> f ; g(a) ; h(b, foo).
+%
+% we want to generate code
+% (
+% X = f, % UnifyX_Goal
+% Y = f, % UnifyY_Goal
+% R = (=) % CompareArgs_Goal
+% ;
+% X = g(X1),
+% Y = g(Y1),
+% compare(R, X1, Y1)
+% ;
+% X = h(X1, X2),
+% Y = h(Y1, Y2),
+% ( compare(R1, X1, Y1), R1 \= (=) ->
+% R = R1
+% ;
+% compare(R, X2, Y2)
+% )
+% )
:- pred unify_proc__generate_compare_cases(list(constructor), prog_var,
prog_var, prog_var, prog_context, list(hlds_goal),
@@ -1179,35 +1338,62 @@
R, Context, CompareArgs_Goal),
{ GoalList = [UnifyX_Goal, UnifyY_Goal, CompareArgs_Goal] },
{ goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context,
- GoalInfo) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ conj_list_to_goal(GoalList, GoalInfo, Case) }.
-
-/* unify_proc__compare_args: for a constructor such as
- h(list(int), foo, string)
-
- we want to generate code
-
- (
- compare(R1, X1, Y1), % Do_Comparison
- R1 \= (=) % Check_Not_Equal
- ->
- R = R1 % Return_R1
- ;
- compare(R2, X2, Y2),
- R2 \= (=)
- ->
- R = R2
- ;
- compare(R, X3, Y3) % Return_Comparison
- )
-
- For a constructor with no arguments, we want to generate code
+:- pred unify_proc__generate_asymmetric_compare_case(constructor::in,
+ constructor::in, string::in, prog_var::in, prog_var::in, prog_var::in,
+ prog_context::in, hlds_goal::out,
+ unify_proc_info::in, unify_proc_info::out) is det.
- R = (=) % Return_Equal
+unify_proc__generate_asymmetric_compare_case(Ctor1, Ctor2, CompareOp, R, X, Y,
+ Context, Case) -->
+ { Ctor1 = ctor(ExistQTVars1, _Constraints1, FunctorName1, ArgTypes1) },
+ { Ctor2 = ctor(ExistQTVars2, _Constraints2, FunctorName2, ArgTypes2) },
+ { list__length(ArgTypes1, FunctorArity1) },
+ { list__length(ArgTypes2, FunctorArity2) },
+ { FunctorConsId1 = cons(FunctorName1, FunctorArity1) },
+ { FunctorConsId2 = cons(FunctorName2, FunctorArity2) },
+ unify_proc__make_fresh_vars(ArgTypes1, ExistQTVars1, Vars1),
+ unify_proc__make_fresh_vars(ArgTypes2, ExistQTVars2, Vars2),
+ { create_atomic_unification(
+ X, functor(FunctorConsId1, Vars1), Context, explicit, [],
+ UnifyX_Goal) },
+ { create_atomic_unification(
+ Y, functor(FunctorConsId2, Vars2), Context, explicit, [],
+ UnifyY_Goal) },
+ { create_atomic_unification(
+ R, functor(cons(unqualified(CompareOp), 0), []),
+ Context, explicit, [],
+ ReturnResult) },
+ { GoalList = [UnifyX_Goal, UnifyY_Goal, ReturnResult] },
+ { goal_info_init(GoalInfo0) },
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
+ { conj_list_to_goal(GoalList, GoalInfo, Case) }.
-*/
+% unify_proc__compare_args: for a constructor such as
+%
+% h(list(int), foo, string)
+%
+% we want to generate code
+%
+% (
+% compare(R1, X1, Y1), % Do_Comparison
+% R1 \= (=) % Check_Not_Equal
+% ->
+% R = R1 % Return_R1
+% ;
+% compare(R2, X2, Y2),
+% R2 \= (=)
+% ->
+% R = R2
+% ;
+% compare(R, X3, Y3) % Return_Comparison
+% )
+%
+% For a constructor with no arguments, we want to generate code
+%
+% R = (=) % Return_Equal
:- pred unify_proc__compare_args(list(constructor_arg), existq_tvars,
list(prog_var), list(prog_var), prog_var, prog_context,
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
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/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
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/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
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/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing library
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/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
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 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/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.99
diff -u -b -r1.99 Mmakefile
--- tests/hard_coded/Mmakefile 2000/11/05 02:09:52 1.99
+++ tests/hard_coded/Mmakefile 2000/11/06 03:52:27
@@ -15,12 +15,13 @@
boyer \
c_write_string \
cc_and_non_cc_test \
- cc_nondet_disj \
cc_multi_bug \
+ cc_nondet_disj \
checked_nondet_tailcall \
closure_extension \
common_type_cast \
compare_spec \
+ comparison \
construct \
curry \
curry2 \
@@ -33,14 +34,14 @@
division_test \
dupcall_types_bug \
elim_special_pred \
+ eqv_type_bug \
+ erroneous_liveness \
+ error_func \
existential_bound_tvar \
existential_float \
existential_reordering \
existential_type_switch_opt \
existential_types_test \
- eqv_type_bug \
- error_func \
- erroneous_liveness \
expand \
export_test \
factt \
@@ -66,8 +67,8 @@
ho_univ_to_type \
impossible_unify \
impure_prune \
- integer_test \
inline_nondet_pragma_c \
+ integer_test \
merge_and_remove_dups \
minint_bug \
mode_choice \
@@ -79,9 +80,9 @@
nondet_ctrl_vn \
nullary_ho_func \
pragma_c_code \
- pragma_inline \
- pragma_import \
pragma_export \
+ pragma_import \
+ pragma_inline \
qual_adv_test \
qual_basic_test \
qual_is_test \
@@ -107,10 +108,11 @@
term_io_test \
test_imported_no_tag \
tim_qual1 \
- type_qual \
- type_to_term_bug \
tuple_test \
+ tuple_test \
+ type_qual \
type_spec_modes \
+ type_to_term_bug \
user_defined_equality \
user_defined_equality2 \
write \
Index: tests/hard_coded/comparison.exp
===================================================================
RCS file: comparison.exp
diff -N comparison.exp
--- /dev/null Wed Jul 26 16:10:00 2000
+++ comparison.exp Sun Oct 22 18:32:47 2000
@@ -0,0 +1,24 @@
+a1(10, 20) < a1(10, 21)
+a1(10, 20) = a1(10, 20)
+a1(10, 20) > a1(9, 20)
+a2(10, 20) > a2(10, 19)
+a2(10, 20) = a2(10, 20)
+a2(10, 20) < a2(11, 20)
+a2(10, 20) < b2(10)
+b2(30) > a2(50, 40)
+b2(30) > b2(29)
+b2(30) = b2(30)
+b2(30) < b2(31)
+a3(10, 20) > a3(10, 19)
+a3(10, 20) = a3(10, 20)
+a3(10, 20) < a3(11, 20)
+a3(10, 20) < b3(10)
+a3(10, 20) < c3
+b3(30) > a3(50, 40)
+b3(30) > b3(29)
+b3(30) = b3(30)
+b3(30) < b3(31)
+b3(30) < c3
+c3 > a3(50, 40)
+c3 > b3(50)
+c3 = c3
Index: tests/hard_coded/comparison.m
===================================================================
RCS file: comparison.m
diff -N comparison.m
--- /dev/null Wed Jul 26 16:10:00 2000
+++ comparison.m Sun Oct 22 15:04:53 2000
@@ -0,0 +1,68 @@
+% This is a test to check the correctness of the way we handle specialized
+% comparison predicates for types with three or fewer function symbols.
+
+:- module comparison.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module list, std_util, exception.
+
+:- type t1 ---> a1(int, int).
+
+:- type t2 ---> a2(int, int) ; b2(int).
+
+:- type t3 ---> a3(int, int) ; b3(int) ; c3.
+
+main -->
+ perform_comparison_test(a1(10, 20), a1(10, 21)),
+ perform_comparison_test(a1(10, 20), a1(10, 20)),
+ perform_comparison_test(a1(10, 20), a1( 9, 20)),
+
+ perform_comparison_test(a2(10, 20), a2(10, 19)),
+ perform_comparison_test(a2(10, 20), a2(10, 20)),
+ perform_comparison_test(a2(10, 20), a2(11, 20)),
+ perform_comparison_test(a2(10, 20), b2(10)),
+
+ perform_comparison_test(b2(30), a2(50, 40)),
+ perform_comparison_test(b2(30), b2(29)),
+ perform_comparison_test(b2(30), b2(30)),
+ perform_comparison_test(b2(30), b2(31)),
+
+ perform_comparison_test(a3(10, 20), a3(10, 19)),
+ perform_comparison_test(a3(10, 20), a3(10, 20)),
+ perform_comparison_test(a3(10, 20), a3(11, 20)),
+ perform_comparison_test(a3(10, 20), b3(10)),
+ perform_comparison_test(a3(10, 20), c3),
+
+ perform_comparison_test(b3(30), a3(50, 40)),
+ perform_comparison_test(b3(30), b3(29)),
+ perform_comparison_test(b3(30), b3(30)),
+ perform_comparison_test(b3(30), b3(31)),
+ perform_comparison_test(b3(30), c3),
+
+ perform_comparison_test(c3, a3(50, 40)),
+ perform_comparison_test(c3, b3(50)),
+ perform_comparison_test(c3, c3).
+
+:- pred perform_comparison_test(T::in, T::in, io__state::di, io__state::uo)
+ is det.
+
+perform_comparison_test(X, Y) -->
+ { compare(R, X, Y) },
+ io__write(X),
+ (
+ { R = (<) },
+ io__write_string(" < ")
+ ;
+ { R = (=) },
+ io__write_string(" = ")
+ ;
+ { R = (>) },
+ io__write_string(" > ")
+ ),
+ io__write(Y),
+ io__write_string("\n").
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/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing trial
cvs diff: in directory trial:
cvs [diff aborted]: there is no version here; do 'cvs checkout' first
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list