[m-rev.] diff: make default equality/comparison for solver types throw an exception
Julien Fischer
juliensf at csse.unimelb.edu.au
Fri Feb 1 16:43:55 AEDT 2008
(This has already been reviewed in-person by Ralph.)
Estimated hours taken: 3
Branches: main
Make the generated equality/comparison predicates for solver types that lack
user-defined equality or comparison predicates throw an exception rather than
treat the values as C pointers.
Document this in the reference manual.
doc/reference_manual.texi:
Document what happens if the user does not specify an equality or
comparison predicate in a solver type definition.
compiler/unify_proc.m:
For solver types without user-defined equality or comparison
predicates generate equality or comparison predicate that throw
an exception rather than treating the values as C pointers.
library/private_builtin.m:
Add some predicate for use by the above.
XXX type name lookups in RTTI don't seem to work properly
with solver types (or at least they have some rather
unexpected results - Mantis bug #40.)
tests/hard_coded/Mmakefile:
tests/hard_coded/solver_default_eq_cmp.{m,exp}
Test the behaviour of equality and comparison for solver
types without user-defined equality and comparison.
Julien.
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.199
diff -u -r1.199 unify_proc.m
--- compiler/unify_proc.m 29 Jan 2008 04:59:45 -0000 1.199
+++ compiler/unify_proc.m 1 Feb 2008 05:31:16 -0000
@@ -816,10 +816,7 @@
)
;
TypeBody = hlds_solver_type(_, _),
- % If no user defined equality predicate is given,
- % we treat solver types as if they were an equivalent
- % to the builtin type c_pointer.
- generate_eqv_unify_proc_body(c_pointer_type, X, Y, Context,
+ generate_default_solver_type_unify_proc_body(X, Y, Context,
Clause, !Info)
;
TypeBody = hlds_foreign_type(_),
@@ -1108,7 +1105,7 @@
Context, Clause, !Info)
;
TypeBody = hlds_solver_type(_, _),
- generate_eqv_compare_proc_body(c_pointer_type, Res, X, Y,
+ generate_default_solver_type_compare_proc_body(Res, X, Y,
Context, Clause, !Info)
;
TypeBody = hlds_abstract_type(_),
@@ -1236,6 +1233,25 @@
),
build_call(Name, ArgVars, Context, CompareGoal, !Info),
quantify_clause_body(ArgVars, CompareGoal, Context, Clause, !Info).
+
+:- pred generate_default_solver_type_unify_proc_body(prog_var::in,
+ prog_var::in, prog_context::in, clause::out,
+ unify_proc_info::in, unify_proc_info::out) is det.
+
+generate_default_solver_type_unify_proc_body(X, Y, Context, Clause, !Info) :-
+ ArgVars = [X, Y],
+ build_call("builtin_unify_solver_type", ArgVars, Context, Goal, !Info),
+ quantify_clause_body(ArgVars, Goal, Context, Clause, !Info).
+
+:- pred generate_default_solver_type_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.
+
+generate_default_solver_type_compare_proc_body(Res, X, Y, Context, Clause,
+ !Info) :-
+ ArgVars = [Res, X, Y],
+ build_call("builtin_compare_solver_type", ArgVars, Context, Goal, !Info),
+ quantify_clause_body(ArgVars, Goal, Context, Clause, !Info).
:- pred generate_user_defined_compare_proc_body(unify_compare::in,
prog_var::in, prog_var::in, prog_var::in, prog_context::in, clause::out,
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.421
diff -u -r1.421 reference_manual.texi
--- doc/reference_manual.texi 30 Jan 2008 06:20:10 -0000 1.421
+++ doc/reference_manual.texi 1 Feb 2008 05:31:16 -0000
@@ -2398,6 +2398,14 @@
specified, @code{equality_pred} and @code{comparison_pred} are also
exported from the same module.
+If @code{equality_pred} is not specified then the compiler will
+generate an equality predicate that throws an exception of type
+ at samp{exception.software_error/0} when called.
+
+Likewise, if @code{comparison_pred} is not specified then the compiler
+will generate a comparison predicate that throws an exception of
+type @samp{exception.software_error/0} when called.
+
If provided, any mutable declarations given for the @code{constraint_store}
attribute are equivalent to separate mutable declarations; their association
with the solver type is for the purposes of documentation. That is,
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.174
diff -u -r1.174 private_builtin.m
--- library/private_builtin.m 4 Dec 2007 13:50:59 -0000 1.174
+++ library/private_builtin.m 1 Feb 2008 05:31:16 -0000
@@ -73,7 +73,15 @@
% (types for which there is a `where equality is ...' declaration).
%
:- pred builtin_compare_non_canonical_type(comparison_result::uo,
- T::in, T::in) is det.
+ T::in, T::in) is det.
+
+ % The following predicates are used for unify/2 (compare/3) on
+ % solver types when the equality (comparison) attribute is omitted
+ % from the solver type definition.
+ %
+:- pred builtin_unify_solver_type(T::in, T::in) is semidet.
+:- pred builtin_compare_solver_type(comparison_result::uo,
+ T::in, T::in) is det.
% Compare_error is used in the code generated for compare/3 preds.
%
@@ -264,7 +272,7 @@
:- pragma no_inline(builtin_compare_non_canonical_type/3).
builtin_compare_non_canonical_type(Res, X, _Y) :-
- % suppress determinism warning
+ % Suppress determinism warning.
( semidet_succeed ->
Message = "call to compare/3 for non-canonical type `"
++ type_name(type_of(X)) ++ "'",
@@ -274,6 +282,38 @@
Res = (<)
).
+:- pragma no_inline(builtin_unify_solver_type/2).
+builtin_unify_solver_type(_X, _Y) :-
+ % Suppress determinism warning.
+ ( semidet_succeed ->
+ % XXX ideally we should use the commented out code but looking up
+ % the name of the solver type in RTTI currently gives us the name of
+ % the representation type - reporting the name of the latter is likely
+ % to be confusing since representation types will nearly always have
+ % equality defined on them.
+ %Message = "call to unify/2 for solver type `"
+ % ++ type_name(type_of(X)) ++ "'",
+ Message = "call to generated unify/2 for solver type",
+ error(Message)
+ ;
+ % This is never executed.
+ semidet_fail
+ ).
+
+:- pragma no_inline(builtin_compare_solver_type/3).
+builtin_compare_solver_type(Res, _X, _Y) :-
+ % Suppress determinism warning.
+ ( semidet_succeed ->
+ % XXX see the comment above regarding RTTI.
+ %Message = "call to compare/3 for solver type `"
+ % ++ type_name(type_of(X)) ++ "'",
+ Message = "call to generated compare/3 for solver type",
+ error(Message)
+ ;
+ % This is never executed.
+ Res = (<)
+ ).
+
:- pragma no_inline(compare_error/0).
compare_error :-
error("internal error in compare/3").
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.339
diff -u -r1.339 Mmakefile
--- tests/hard_coded/Mmakefile 16 Jan 2008 08:34:54 -0000 1.339
+++ tests/hard_coded/Mmakefile 1 Feb 2008 05:31:17 -0000
@@ -484,6 +484,7 @@
mutable_excp \
null_char \
io_globals_deadlock \
+ solver_default_eq_cmp \
test_array2d \
test_injection \
user_defined_equality \
Index: tests/hard_coded/solver_default_eq_cmp.exp
===================================================================
RCS file: tests/hard_coded/solver_default_eq_cmp.exp
diff -N tests/hard_coded/solver_default_eq_cmp.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/solver_default_eq_cmp.exp 1 Feb 2008 05:31:17 -0000
@@ -0,0 +1,2 @@
+Checking equality predicate: call to generated unify/2 for solver type
+Checking comparison predicate: call to generated compare/3 for solver type
Index: tests/hard_coded/solver_default_eq_cmp.m
===================================================================
RCS file: tests/hard_coded/solver_default_eq_cmp.m
diff -N tests/hard_coded/solver_default_eq_cmp.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/solver_default_eq_cmp.m 1 Feb 2008 05:31:17 -0000
@@ -0,0 +1,96 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
+%
+% Check the generated equality/comparison predicates for solver types
+% where they are not specified in the solver type definition.
+
+:- module solver_default_eq_cmp.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module exception.
+:- import_module string.
+:- import_module univ.
+:- import_module unit.
+
+main(!IO) :-
+ io.write_string("Checking equality predicate: ", !IO),
+ try_io(test_eq, EqResult, !IO),
+ (
+ EqResult = succeeded(_),
+ io.write_string("equality predicate not called", !IO)
+ ;
+ EqResult = exception(EqExcp),
+ ( univ_to_type(EqExcp, software_error(EqErr)) ->
+ io.write_string(EqErr ++ "\n", !IO)
+ ;
+ io.write_string("unknown exception thrown\n", !IO)
+ )
+ ),
+ io.write_string("Checking comparison predicate: ", !IO),
+ try_io(test_cmp, CmpResult, !IO),
+ (
+ CmpResult = succeeded(_),
+ io.write_string("comparison predicate not called", !IO)
+ ;
+ CmpResult = exception(CmpExcp),
+ ( univ_to_type(CmpExcp, software_error(CmpErr)) ->
+ io.write_string(CmpErr ++ "\n", !IO)
+ ;
+ io.write_string("unknown exception thrown\n", !IO)
+ )
+ ).
+
+:- pred test_eq(unit::out, io::di, io::uo) is det.
+
+test_eq(unit, !IO) :-
+ new_foo(300, X),
+ new_foo(400, Y),
+ write_solver_type_eq(X, Y, !IO).
+
+:- pragma no_inline(write_solver_type_eq/4).
+:- pred write_solver_type_eq(T::ia, T::ia, io::di, io::uo) is det.
+
+write_solver_type_eq(X, Y, !IO) :-
+ promise_pure ( if X = Y
+ then io.write_string("Same\n", !IO)
+ else io.write_string("Different\n", !IO)
+ ).
+
+:- pred test_cmp(unit::out, io::di, io::uo) is det.
+
+test_cmp(unit, !IO) :-
+ new_foo(300, X),
+ new_foo(400, Y),
+ write_solver_type_cmp(X, Y, !IO).
+
+:- pred write_solver_type_cmp(T::ia, T::ia, io::di, io::uo) is det.
+
+write_solver_type_cmp(X0, Y0, !IO) :-
+ X = unsafe_cast_any_to_ground(X0),
+ Y = unsafe_cast_any_to_ground(Y0),
+ compare(Res, X, Y),
+ io.write(Res, !IO).
+
+:- solver type foo
+ where representation is int.
+
+:- pred new_foo(int::in, foo::oa) is det.
+
+new_foo(X, Y) :-
+ promise_pure (
+ impure Y = 'representation to any foo/0'(X)
+ ).
+
+%---------------------------------------------------------------------------%
+:- end_module solver_default_eq_cmp.
+%---------------------------------------------------------------------------%
--------------------------------------------------------------------------
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