[m-rev.] for review: speed up erlang unifications/comparisons
Peter Wang
wangp at students.csse.unimelb.edu.au
Fri Jun 29 11:10:32 AEST 2007
Estimated hours taken: 25
Branches: main
Use Erlang comparison operators to compare compound (non-atomic) data values
when possible, which is a lot more efficient than using the comparison
predicates generated by Mercury. However, we can only do this if we know at
the call site that the values being compared don't have user-defined
equality/comparison predicates.
Also, we have to accept that Erlang won't order functors according to the order
they appear in the type definition. The comparison predicates we generate must
match the order which would be given by Erlang. (This was already a bug
before this change.)
In the implementation, we introduce two builtin predicates in private_builtin:
builtin_compound_eq and builtin_compound_lt. During simplifcation, we replace
applicable unifications by calls to builtin_compound_eq, and applicable calls
to builtin.compare by if-then-elses using builtin_compound_eq and
builtin_compound_lt. The calls to builtin_compound_eq and builtin_compound_lt
are translated into builtin operators compound_eq and compound_lt, which
eventually become =:= and < in the Erlang output.
With this change the Mercury compiler is ~35% faster when running as Erlang
bytecode (but still ~200x slower than asm_fast.gc).
library/private_builtin.m:
Add declarations for builtin_compound_eq and builtin_compound_lt.
library/Mercury.options:
Set --allow-stubs and --no-halt-at-warn for private_builtin.m until the
addition of the new builtins bootstraps.
mdbcomp/program_representation.m:
Mark builtin_compound_eq and builtin_compare_lt as polymorphic
predicates which don't take type_info arguments.
compiler/add_pred.m:
Don't add the following clauses when compiling private_builtin.m.
The bodies would be expanded out to use the compound_eq and compound_lt
builtins, but only the Erlang backend can support those.
builtin_compound_eq(X, Y) :- builtin_compound_eq(X, Y).
builtin_compound_lt(X, Y) :- builtin_compound_lt(X, Y).
compiler/builtin_ops.m:
Add the builtins compound_eq and compound_lt and their translations.
compiler/bytecode.m:
compiler/llds.m:
compiler/llds_to_x86_64.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
Conform to additions of compound_eq, compound_lt.
compiler/erl_call_gen.m:
XXX
compiler/options.m:
Add internal options --can-compare-compound-values and
--lexically-order-constructors.
compiler/handle_options.m:
Make --target erlang imply --can-compare-compound-values and
--lexically-order-constructors.
compiler/simplify.m:
If --can-compare-compound-values is set, transform applicable
unifications and comparisons using builtin_compound_eq and
builtin_compound_lt, as above.
Move a check for simplify_do_const_prop deeper in, otherwise
simplify_library_call would only be called if
--optimise-constant-propagation is set. simplify_library_call is where
we transform builtin.compare calls to use builtin_compound_{eq,lt}.
Add builtin_compound_eq and builtin_compound_lt as predicates which
simplify may introduce calls to, to prevent them being removed by dead
proc elimination.
compiler/unify_proc.m:
If --lexically-order-constructors is enabled, sort data constructors in
the same order as Erlang before generating comparison predicates.
Otherwise comparisons using the Erlang builtins and comparisons using
the generated comparison predicates would give different results.
compiler/type_util.m:
Add a predicate type_definitely_has_no_user_defined_equality_pred which
succeeds iff the given type has no user-defined equality or comparison
predicates.
Conform to change in foreign.m.
compiler/foreign.m:
Change the semidet function
`foreign_type_body_has_user_defined_eq_comp_pred' to a predicate.
compiler/post_term_analysis.m:
Conform to change in foreign.m.
compiler/prog_type.m:
Fix a comment.
Index: compiler/add_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pred.m,v
retrieving revision 1.30
diff -u -r1.30 add_pred.m
--- compiler/add_pred.m 17 May 2007 03:52:39 -0000 1.30
+++ compiler/add_pred.m 29 Jun 2007 00:43:42 -0000
@@ -216,7 +216,7 @@
:- pred add_builtin(pred_id::in, list(mer_type)::in,
pred_info::in, pred_info::out) is det.
- % For a builtin predicate, say foo/2, we add a clause
+ % For most builtin predicates, say foo/2, we add a clause
%
% foo(H1, H2) :- foo(H1, H2).
%
@@ -225,6 +225,8 @@
% for generating this forwarding code stub is so that things work correctly
% if you take the address of the predicate.
%
+ % A few builtins are treated specially.
+ %
add_builtin(PredId, Types, !PredInfo) :-
Module = pred_info_module(!.PredInfo),
Name = pred_info_name(!.PredInfo),
@@ -241,7 +243,10 @@
goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
(
Module = mercury_private_builtin_module,
- Name = "store_at_ref"
+ ( Name = "store_at_ref"
+ ; Name = "builtin_compound_eq"
+ ; Name = "builtin_compound_lt"
+ )
->
GoalExpr = conj(plain_conj, []),
ExtraVars = [],
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.27
diff -u -r1.27 builtin_ops.m
--- compiler/builtin_ops.m 27 Sep 2006 06:16:47 -0000 1.27
+++ compiler/builtin_ops.m 29 Jun 2007 00:43:42 -0000
@@ -83,7 +83,12 @@
; float_lt
; float_gt
; float_le
- ; float_ge.
+ ; float_ge
+
+ ; compound_eq
+ ; compound_lt.
+ % Comparisons on values of non-atomic types. This is likely to be
+ % supported only on very high-level back-ends.
% For the MLDS back-end, we need to know the element type for each
% array_index operation.
@@ -191,6 +196,11 @@
builtin_translation("private_builtin", "builtin_int_lt", 0, [X, Y],
test(binary(int_lt, leaf(X), leaf(Y)))).
+builtin_translation("private_builtin", "builtin_compound_eq", 0, [X, Y],
+ test(binary(compound_eq, leaf(X), leaf(Y)))).
+builtin_translation("private_builtin", "builtin_compound_lt", 0, [X, Y],
+ test(binary(compound_lt, leaf(X), leaf(Y)))).
+
builtin_translation("term_size_prof_builtin", "term_size_plus", 0, [X, Y, Z],
assign(Z, binary(int_add, leaf(X), leaf(Y)))).
Index: compiler/bytecode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode.m,v
retrieving revision 1.71
diff -u -r1.71 bytecode.m
--- compiler/bytecode.m 2 Oct 2006 05:21:08 -0000 1.71
+++ compiler/bytecode.m 29 Jun 2007 00:43:42 -0000
@@ -1056,6 +1056,8 @@
binop_code(float_ge, 34).
binop_code(body, 35).
binop_code(unsigned_le, 36).
+binop_code(compound_eq, 37).
+binop_code(compound_lt, 38).
:- pred binop_debug(binary_op::in, string::out) is det.
@@ -1096,6 +1098,8 @@
binop_debug(float_ge, "float_ge").
binop_debug(body, "body").
binop_debug(unsigned_le, "unsigned_le").
+binop_debug(compound_eq, "compound_eq").
+binop_debug(compound_lt, "compound_lt").
:- pred unop_code(unary_op::in, int::out) is det.
Index: compiler/erl_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_call_gen.m,v
retrieving revision 1.7
diff -u -r1.7 erl_call_gen.m
--- compiler/erl_call_gen.m 14 Jun 2007 01:50:28 -0000 1.7
+++ compiler/erl_call_gen.m 29 Jun 2007 00:43:42 -0000
@@ -530,6 +530,8 @@
std_binop_to_elds(float_gt, elds.(>)).
std_binop_to_elds(float_le, elds.(=<)).
std_binop_to_elds(float_ge, elds.(>=)).
+std_binop_to_elds(compound_eq, elds.(=:=)).
+std_binop_to_elds(compound_lt, elds.(<)).
%-----------------------------------------------------------------------------%
%
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.71
diff -u -r1.71 foreign.m
--- compiler/foreign.m 7 May 2007 05:21:30 -0000 1.71
+++ compiler/foreign.m 29 Jun 2007 00:43:42 -0000
@@ -63,8 +63,8 @@
% Does the implementation of the given foreign type body on
% the current backend use a user-defined comparison predicate.
%
-:- func foreign_type_body_has_user_defined_eq_comp_pred(module_info,
- foreign_type_body) = unify_compare is semidet.
+:- pred foreign_type_body_has_user_defined_eq_comp_pred(module_info::in,
+ foreign_type_body::in, unify_compare::out) is semidet.
% Find the current target backend from the module_info, and given
% a foreign_type_body, return the name of the foreign language type
@@ -579,8 +579,8 @@
ExportType = mercury(Type)
).
-foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo, Body) =
- UserEqComp :-
+foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo, Body,
+ UserEqComp) :-
foreign_type_body_to_exported_type(ModuleInfo, Body, _,
MaybeUserEqComp, _),
MaybeUserEqComp = yes(UserEqComp).
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.303
diff -u -r1.303 handle_options.m
--- compiler/handle_options.m 25 Jun 2007 00:58:11 -0000 1.303
+++ compiler/handle_options.m 29 Jun 2007 00:43:42 -0000
@@ -632,6 +632,9 @@
% because GC is handled automatically by the Erlang
% implementation.
% - delay-partial-instantiations
+ % - no-can-compare-constants-as-ints
+ % - can-compare-compound-values
+ % - lexically-compare-constructors
(
Target = target_erlang,
@@ -642,6 +645,12 @@
globals.set_option(reclaim_heap_on_semidet_failure, bool(no),
!Globals),
globals.set_option(delay_partial_instantiations, bool(yes),
+ !Globals),
+ globals.set_option(can_compare_constants_as_ints, bool(no),
+ !Globals),
+ globals.set_option(can_compare_compound_values, bool(yes),
+ !Globals),
+ globals.set_option(lexically_order_constructors, bool(yes),
!Globals)
;
( Target = target_c
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.347
diff -u -r1.347 llds.m
--- compiler/llds.m 18 Mar 2007 23:34:53 -0000 1.347
+++ compiler/llds.m 29 Jun 2007 00:43:42 -0000
@@ -1280,6 +1280,8 @@
binop_return_type(float_le, bool).
binop_return_type(float_ge, bool).
binop_return_type(body, word).
+binop_return_type(compound_eq, bool).
+binop_return_type(compound_lt, bool).
register_type(reg_r, word).
register_type(reg_f, float).
Index: compiler/llds_to_x86_64.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_to_x86_64.m,v
retrieving revision 1.3
diff -u -r1.3 llds_to_x86_64.m
--- compiler/llds_to_x86_64.m 18 Mar 2007 23:34:54 -0000 1.3
+++ compiler/llds_to_x86_64.m 29 Jun 2007 00:43:42 -0000
@@ -935,6 +935,8 @@
binop_instr(float_gt, _, _, [x86_64_comment("<<float_gt>>")]).
binop_instr(float_le, _, _, [x86_64_comment("<<float_le>>")]).
binop_instr(float_ge, _, _, [x86_64_comment("<<float_ge>>")]).
+binop_instr(compound_eq, _, _, [x86_64_comment("<<compound_eq>>")]).
+binop_instr(compound_lt, _, _, [x86_64_comment("<<compound_lt>>")]).
% Get a string representation of code address types.
%
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.130
diff -u -r1.130 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 18 Mar 2007 23:34:54 -0000 1.130
+++ compiler/mlds_to_gcc.m 29 Jun 2007 00:43:43 -0000
@@ -3623,6 +3623,8 @@
convert_binary_op(float_gt, gcc__gt_expr, gcc__boolean_type_node).
convert_binary_op(float_le, gcc__le_expr, gcc__boolean_type_node).
convert_binary_op(float_ge, gcc__ge_expr, gcc__boolean_type_node).
+convert_binary_op(compound_eq, _, _) :- unexpected(this_file, "compound_eq").
+convert_binary_op(compound_lt, _, _) :- unexpected(this_file, "compound_lt").
:- pred build_call(gcc__func_decl::in, list(mlds_rval)::in, defn_info::in,
gcc__expr::out, io__state::di, io__state::uo) is det.
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.184
diff -u -r1.184 mlds_to_il.m
--- compiler/mlds_to_il.m 20 Jun 2007 03:15:56 -0000 1.184
+++ compiler/mlds_to_il.m 29 Jun 2007 00:43:43 -0000
@@ -2790,6 +2790,11 @@
binaryop_to_il(float_le, node([cgt(signed), ldc(int32, i(0)), ceq]), !Info).
binaryop_to_il(float_ge, node([clt(signed), ldc(int32, i(0)), ceq]), !Info).
+binaryop_to_il(compound_eq, _, !Info) :-
+ unexpected(this_file, "binop: compound_eq").
+binaryop_to_il(compound_lt, _, !Info) :-
+ unexpected(this_file, "binop: compound_lt").
+
%-----------------------------------------------------------------------------%
%
% Generate code for conditional statements
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.569
diff -u -r1.569 options.m
--- compiler/options.m 25 Jun 2007 00:58:12 -0000 1.569
+++ compiler/options.m 29 Jun 2007 00:43:43 -0000
@@ -406,6 +406,16 @@
% constant, can be done by casting them both to integers and
% comparing the integers for equality.
+ ; can_compare_compound_values
+ % Should be set to yes if the target back end supports comparison
+ % of non-atomic values with builtin operators.
+
+ ; lexically_order_constructors
+ % Should be set to yes if we need to order functors
+ % lexically when generating comparison predicates,
+ % e.g. to match the natural order that functors will be compared
+ % on the backend.
+
; mutable_always_boxed
; delay_partial_instantiations
@@ -1157,6 +1167,8 @@
trace_stack_layout - bool(no),
body_typeinfo_liveness - bool(no),
can_compare_constants_as_ints - bool(no),
+ can_compare_compound_values - bool(no),
+ lexically_order_constructors - bool(no),
mutable_always_boxed - bool(yes),
delay_partial_instantiations - bool(no),
special_preds - bool(yes),
@@ -1924,6 +1936,9 @@
long_option("trace-stack-layout", trace_stack_layout).
long_option("body-typeinfo-liveness", body_typeinfo_liveness).
long_option("can-compare-constants-as-ints", can_compare_constants_as_ints).
+long_option("can-compare-compound-values", can_compare_compound_values).
+long_option("lexically-order-constructors",
+ lexically_order_constructors).
long_option("mutable-always-boxed", mutable_always_boxed).
long_option("delay-partial-instantiations", delay_partial_instantiations).
long_option("special-preds", special_preds).
@@ -3971,6 +3986,16 @@
% For documentation, see the comment in the type declaration.
% This is a developer only option.
+% "--can-compare-compound-values"
+% "(This option is not for general use.)",
+% For documentation, see the comment in the type declaration.
+
+ % This is a developer only option.
+% "--lexically-order-constructors"
+% "(This option is not for general use.)",
+% For documentation, see the comment in the type declaration.
+
+ % This is a developer only option.
% "--mutable-always-boxed",
% "(This option is not for general use.)",
% For documentation, see the comment in the type declaration.
Index: compiler/post_term_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_term_analysis.m,v
retrieving revision 1.15
diff -u -r1.15 post_term_analysis.m
--- compiler/post_term_analysis.m 13 Apr 2007 04:56:40 -0000 1.15
+++ compiler/post_term_analysis.m 29 Jun 2007 00:43:43 -0000
@@ -214,8 +214,8 @@
TypeBody = hlds_du_type(_, _, _, yes(UnifyCompare), _, _).
get_user_unify_compare(ModuleInfo, TypeBody, UnifyCompare) :-
TypeBody = hlds_foreign_type(ForeignTypeBody),
- UnifyCompare = foreign_type_body_has_user_defined_eq_comp_pred(
- ModuleInfo, ForeignTypeBody).
+ foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo,
+ ForeignTypeBody, UnifyCompare).
get_user_unify_compare(_ModuleInfo, TypeBody, UnifyCompare) :-
TypeBody = hlds_solver_type(_, yes(UnifyCompare)).
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.34
diff -u -r1.34 prog_type.m
--- compiler/prog_type.m 13 Apr 2007 04:56:40 -0000 1.34
+++ compiler/prog_type.m 29 Jun 2007 00:43:43 -0000
@@ -117,7 +117,7 @@
list(mer_type)::out) is det.
% Given a non-variable type, return its type_ctor and argument types.
- % Fail if the type is a variable.
+ % Abort if the type is a variable.
%
:- pred type_to_ctor_det(mer_type::in, type_ctor::out) is det.
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.212
diff -u -r1.212 simplify.m
--- compiler/simplify.m 14 Jun 2007 01:50:28 -0000 1.212
+++ compiler/simplify.m 29 Jun 2007 00:43:43 -0000
@@ -1593,9 +1593,12 @@
proc_id_to_int(ProcId, CallModeNum),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, cross_compiling, CrossCompiling),
+ globals.lookup_bool_option(Globals, can_compare_compound_values,
+ CanCompareCompoundValues),
ArgVars = list.map(foreign_arg_var, Args0),
simplify_library_call(CallModuleName, CallPredName, CallModeNum,
- CrossCompiling, ArgVars, GoalExprPrime, !GoalInfo, !Info)
+ CrossCompiling, CanCompareCompoundValues, ArgVars, GoalExprPrime,
+ !GoalInfo, !Info)
->
GoalExpr = GoalExprPrime,
simplify_info_set_requantify(!Info)
@@ -1904,7 +1907,6 @@
% Try to evaluate the call at compile-time.
(
simplify_info_get_module_info(!.Info, ModuleInfo2),
- simplify_do_const_prop(!.Info),
!.GoalExpr = plain_call(CallPredId, CallProcId, CallArgs, _, _, _),
module_info_pred_info(ModuleInfo2, CallPredId, CallPredInfo),
CallModuleSymName = pred_info_module(CallPredInfo),
@@ -1916,6 +1918,7 @@
CallPredName = pred_info_name(CallPredInfo),
proc_id_to_int(CallProcId, CallModeNum),
(
+ simplify_do_const_prop(!.Info),
const_prop.evaluate_call(CallModuleName, CallPredName, CallModeNum,
CallArgs, VarTypes, Instmap0, ModuleInfo2, GoalExprPrime,
!GoalInfo)
@@ -1926,8 +1929,11 @@
module_info_get_globals(ModuleInfo2, Globals),
globals.lookup_bool_option(Globals, cross_compiling,
CrossCompiling),
+ globals.lookup_bool_option(Globals, can_compare_compound_values,
+ CanCompareCompoundValues),
simplify_library_call(CallModuleName, CallPredName, CallModeNum,
- CrossCompiling, CallArgs, GoalExprPrime, !GoalInfo, !Info)
+ CrossCompiling, CanCompareCompoundValues, CallArgs,
+ GoalExprPrime, !GoalInfo, !Info)
->
!:GoalExpr = GoalExprPrime,
simplify_info_set_requantify(!Info)
@@ -1938,7 +1944,7 @@
true
).
- % simplify_det_call(ModuleName, ProcName, ModeNum, CrossCompiling,
+ % simplify_library_call(ModuleName, ProcName, ModeNum, CrossCompiling,
% Args, GoalExpr, !GoalInfo, !Info):
%
% This attempts to simplify a call to
@@ -1951,12 +1957,47 @@
% get here.
%
:- pred simplify_library_call(string::in, string::in, int::in, bool::in,
- list(prog_var)::in, hlds_goal_expr::out,
+ bool::in, list(prog_var)::in, hlds_goal_expr::out,
hlds_goal_info::in, hlds_goal_info::out,
simplify_info::in, simplify_info::out) is semidet.
-simplify_library_call("int", PredName, _ModeNum, CrossCompiling, Args,
- GoalExpr, !GoalInfo, !Info) :-
+simplify_library_call("builtin", "compare", _ModeNum, _CrossCompiling,
+ CanCompareCompoundValues, Args, GoalExpr, !GoalInfo, !Info) :-
+ % On the Erlang backend, it is faster for us to use builtin comparison
+ % operators on high level data structures than to deconstruct the data
+ % structure and compare the atomic constituents. We can only do this on
+ % values of types which we know not to have user-defined equality
+ % predicates.
+ %
+ CanCompareCompoundValues = yes,
+ list.reverse(Args, [Y, X, Res | _]),
+ simplify_info_get_module_info(!.Info, ModuleInfo),
+ simplify_info_get_var_types(!.Info, VarTypes),
+ map.lookup(VarTypes, Y, Type),
+ type_definitely_has_no_user_defined_equality_pred(ModuleInfo, Type),
+
+ goal_info_get_context(!.GoalInfo, Context),
+ goal_util.generate_simple_call(mercury_private_builtin_module,
+ "builtin_compound_eq", pf_predicate, only_mode, detism_semi, purity_pure,
+ [X, Y], [], [], ModuleInfo, Context, CondEq),
+ goal_util.generate_simple_call(mercury_private_builtin_module,
+ "builtin_compound_lt", pf_predicate, only_mode, detism_semi, purity_pure,
+ [X, Y], [], [], ModuleInfo, Context, CondLt),
+
+ Builtin = mercury_public_builtin_module,
+ make_const_construction(Res, cons(qualified(Builtin, "="), 0), ReturnEq),
+ make_const_construction(Res, cons(qualified(Builtin, "<"), 0), ReturnLt),
+ make_const_construction(Res, cons(qualified(Builtin, ">"), 0), ReturnGt),
+
+ NonLocals = set.from_list([Res, X, Y]),
+ goal_info_set_nonlocals(NonLocals, !GoalInfo),
+
+ GoalExpr = if_then_else([], CondEq, ReturnEq, Rest),
+ Rest = hlds_goal(if_then_else([], CondLt, ReturnLt, ReturnGt), !.GoalInfo).
+
+simplify_library_call("int", PredName, _ModeNum, CrossCompiling,
+ _CanCompareCompoundValues, Args, GoalExpr, !GoalInfo, !Info) :-
+ simplify_do_const_prop(!.Info),
CrossCompiling = no,
(
PredName = "quot_bits_per_int",
@@ -2047,6 +2088,8 @@
% For some reason, the compiler records the original arity of
% int.unchecked_quotient as 3, not 2. Don't check the arities
% until this is fixed.
+simplify_may_introduce_calls("private_builtin", "builtin_compound_eq", _).
+simplify_may_introduce_calls("private_builtin", "builtin_compound_lt", _).
simplify_may_introduce_calls("int", "unchecked_quotient", _).
simplify_may_introduce_calls("int", "unchecked_rem", _).
simplify_may_introduce_calls("int", "*", _).
@@ -2098,6 +2141,8 @@
ProcId),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, special_preds, SpecialPreds),
+ globals.lookup_bool_option(Globals, can_compare_compound_values,
+ CanCompareCompoundValues),
(
hlds_pred.in_in_unification_proc_id(ProcId),
(
@@ -2123,6 +2168,18 @@
call_generic_unify(TypeInfoVar, XVar, YVar, ModuleInfo, !.Info,
Context, GoalInfo0, Call)
;
+ % On the Erlang backend, it is faster for us to use builtin
+ % comparison operators on high level data structures than to
+ % deconstruct the data structure and compare the atomic
+ % constituents. We can only do this on values of types which we
+ % know not to have user-defined equality predicates.
+ hlds_pred.in_in_unification_proc_id(ProcId),
+ CanCompareCompoundValues = yes,
+ type_definitely_has_no_user_defined_equality_pred(ModuleInfo, Type)
+ ->
+ ExtraGoals = [],
+ call_builtin_compound_eq(XVar, YVar, ModuleInfo, GoalInfo0, Call)
+ ;
% Convert other complicated unifications into calls to
% specific unification predicates, inserting extra typeinfo
% arguments if necessary.
@@ -2173,6 +2230,17 @@
set.insert_list(NonLocals0, TypeInfoVars, NonLocals),
goal_info_set_nonlocals(NonLocals, GoalInfo0, CallGoalInfo).
+:- pred call_builtin_compound_eq(prog_var::in, prog_var::in, module_info::in,
+ hlds_goal_info::in, hlds_goal::out) is det.
+
+call_builtin_compound_eq(XVar, YVar, ModuleInfo, GoalInfo, Call) :-
+ goal_info_get_context(GoalInfo, Context),
+ goal_util.generate_simple_call(mercury_private_builtin_module,
+ "builtin_compound_eq", pf_predicate, only_mode, detism_semi,
+ purity_pure, [XVar, YVar], [], [], ModuleInfo, Context, Call).
+
+%-----------------------------------------------------------------------------%
+
:- pred make_type_info_vars(list(mer_type)::in, list(prog_var)::out,
list(hlds_goal)::out, simplify_info::in, simplify_info::out) is det.
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.176
diff -u -r1.176 type_util.m
--- compiler/type_util.m 13 Apr 2007 04:56:41 -0000 1.176
+++ compiler/type_util.m 29 Jun 2007 00:43:43 -0000
@@ -73,6 +73,16 @@
:- pred type_body_has_user_defined_equality_pred(module_info::in,
hlds_type_body::in, unify_compare::out) is semidet.
+ % Succeed iff the principal type constructor of the specified type and none
+ % of its arguments are known not to have user-defined equality or
+ % comparison predicates.
+ %
+ % If the type is a type variable, or is abstract, etc. make the
+ % conservative approximation and fail.
+ %
+:- pred type_definitely_has_no_user_defined_equality_pred(module_info::in,
+ mer_type::in) is semidet.
+
% Succeed iff the principal type constructor for the given type
% is a solver type.
%
@@ -373,19 +383,67 @@
TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody),
have_foreign_type_for_backend(Target, ForeignTypeBody, yes)
->
- UserEqComp = foreign_type_body_has_user_defined_eq_comp_pred(
- ModuleInfo, ForeignTypeBody)
+ foreign_type_body_has_user_defined_eq_comp_pred(
+ ModuleInfo, ForeignTypeBody, UserEqComp)
;
TypeBody ^ du_type_usereq = yes(UserEqComp)
)
;
TypeBody = hlds_foreign_type(ForeignTypeBody),
- UserEqComp = foreign_type_body_has_user_defined_eq_comp_pred(
- ModuleInfo, ForeignTypeBody)
+ foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo,
+ ForeignTypeBody, UserEqComp)
;
TypeBody = hlds_solver_type(_SolverTypeDetails, yes(UserEqComp))
).
+type_definitely_has_no_user_defined_equality_pred(ModuleInfo, Type) :-
+ type_to_type_defn_body(ModuleInfo, Type, TypeBody),
+ type_body_definitely_has_no_user_defined_equality_pred(ModuleInfo,
+ TypeBody),
+ type_to_ctor_and_args_det(Type, _, Args),
+ all [Arg] (
+ list.member(Arg, Args)
+ =>
+ type_definitely_has_no_user_defined_equality_pred(ModuleInfo, Arg)
+ ).
+
+:- pred type_body_definitely_has_no_user_defined_equality_pred(module_info::in,
+ hlds_type_body::in) is semidet.
+
+type_body_definitely_has_no_user_defined_equality_pred(ModuleInfo, TypeBody) :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.get_target(Globals, Target),
+ (
+ TypeBody = hlds_du_type(Ctors, _, _, _, _, _),
+ (
+ TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody),
+ have_foreign_type_for_backend(Target, ForeignTypeBody, yes)
+ ->
+ not foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo,
+ ForeignTypeBody, _)
+ ;
+ TypeBody ^ du_type_usereq = no,
+ % There must not be any existentially quantified type variables.
+ all [Ctor] (
+ list.member(Ctor, Ctors)
+ =>
+ Ctor = ctor([], _, _, _, _)
+ )
+ )
+ ;
+ TypeBody = hlds_eqv_type(EqvType),
+ type_definitely_has_no_user_defined_equality_pred(ModuleInfo, EqvType)
+ ;
+ TypeBody = hlds_foreign_type(ForeignTypeBody),
+ not foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo,
+ ForeignTypeBody, _)
+ ;
+ TypeBody = hlds_solver_type(_, no)
+ ;
+ TypeBody = hlds_abstract_type(_),
+ fail
+ ).
+
type_is_solver_type(ModuleInfo, Type) :-
type_to_type_defn_body(ModuleInfo, Type, TypeBody),
(
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.187
diff -u -r1.187 unify_proc.m
--- compiler/unify_proc.m 28 May 2007 01:06:22 -0000 1.187
+++ compiler/unify_proc.m 29 Jun 2007 00:43:43 -0000
@@ -1042,7 +1042,7 @@
Res, X, Y, Context, Clause, !Info)
;
(
- TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _),
+ TypeBody = hlds_du_type(Ctors0, _, EnumDummy, _, _, _),
(
EnumDummy = is_enum,
generate_enum_compare_proc_body(Res, X, Y, Context, Clause,
@@ -1053,6 +1053,16 @@
!Info)
;
EnumDummy = not_enum_or_dummy,
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals,
+ lexically_order_constructors, LexicalOrder),
+ (
+ LexicalOrder = yes,
+ list.sort(compare_ctors_lexically, Ctors0, Ctors)
+ ;
+ LexicalOrder = no,
+ Ctors = Ctors0
+ ),
generate_du_compare_proc_body(Type, Ctors, Res, X, Y,
Context, Clause, !Info)
)
@@ -1087,6 +1097,31 @@
)
).
+ % This should only used for the Erlang backend right now. We follow the
+ % Erlang order that tuples of smaller arity always precede tuples of larger
+ % arity.
+ %
+:- pred compare_ctors_lexically(constructor::in, constructor::in,
+ comparison_result::out) is det.
+
+compare_ctors_lexically(A, B, Res) :-
+ list.length(A ^ cons_args, ArityA),
+ list.length(B ^ cons_args, ArityB),
+ compare(ArityRes, ArityA, ArityB),
+ (
+ ArityRes = (=),
+ % XXX this assumes the string ordering used by the Mercury compiler is
+ % the same as that of the target language compiler
+ NameA = unqualify_name(A ^ cons_name),
+ NameB = unqualify_name(B ^ cons_name),
+ compare(Res, NameA, NameB)
+ ;
+ ( ArityRes = (<)
+ ; ArityRes = (>)
+ ),
+ Res = ArityRes
+ ).
+
:- pred generate_enum_compare_proc_body(prog_var::in,
prog_var::in, prog_var::in, prog_context::in, clause::out,
unify_proc_info::in, unify_proc_info::out) is det.
Index: library/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/Mercury.options,v
retrieving revision 1.25
diff -u -r1.25 Mercury.options
--- library/Mercury.options 12 Jun 2007 06:53:58 -0000 1.25
+++ library/Mercury.options 29 Jun 2007 00:43:43 -0000
@@ -70,3 +70,7 @@
#
MCFLAGS-thread += --no-local-thread-engine-base
MCFLAGS-thread.semaphore += --no-local-thread-engine-base
+
+# Ignore warnings about missing clauses for builtin_compare_eq,
+# builtin_compare_lt until the compiler knows these are builtins.
+MCFLAGS-private_builtin += --allow-stubs --no-halt-at-warn
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.170
diff -u -r1.170 private_builtin.m
--- library/private_builtin.m 18 Jun 2007 04:41:27 -0000 1.170
+++ library/private_builtin.m 29 Jun 2007 00:43:43 -0000
@@ -89,6 +89,13 @@
%
:- pred builtin_int_gt(int::in, int::in) is semidet.
+ % These should never be called -- the compiler replaces calls to these
+ % predicates with inline code. These predicates are declared not to take
+ % type_infos.
+ %
+:- pred builtin_compound_eq(T::in, T::in) is semidet.
+:- pred builtin_compound_lt(T::in, T::in) is semidet.
+
% A "typed" version of unify/2 -- i.e. one that can handle arguments
% of different types. It first unifies their types, and then if
% the types are equal it unifies the values.
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.20
diff -u -r1.20 program_representation.m
--- mdbcomp/program_representation.m 19 Apr 2007 04:24:51 -0000 1.20
+++ mdbcomp/program_representation.m 29 Jun 2007 00:43:43 -0000
@@ -346,7 +346,7 @@
% Some predicates that operate on polymorphic values do not need
% the type_infos describing the types bound to the variables.
% It is of course faster not to pass type_infos to such predicates
- % (especially since may also be able to avoid constructing those
+ % (especially since we may also be able to avoid constructing those
% type_infos), and it can also be easier for a compiler module
% (e.g. common.m, size_prof.m) that generates calls to such predicates
% not to have to create those type_infos.
@@ -616,6 +616,8 @@
"type_info_from_typeclass_info", 3).
no_type_info_builtin_2(private_builtin,
"unconstrained_type_info_from_typeclass_info", 3).
+no_type_info_builtin_2(private_builtin, "builtin_compound_eq", 2).
+no_type_info_builtin_2(private_builtin, "builtin_compound_lt", 2).
no_type_info_builtin_2(table_builtin, "table_restore_any_answer", 3).
no_type_info_builtin_2(table_builtin, "table_lookup_insert_enum", 4).
no_type_info_builtin_2(table_builtin, "table_lookup_insert_typeinfo", 3).
--------------------------------------------------------------------------
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