[m-rev.] for review: where safe_equality is ...

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon May 12 22:54:37 AEST 2003
Previous message: [m-rev.] trivial diff: fix tests/tabling/tc_loop failure
Next message: [m-rev.] for review: where safe_equality is ...
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
For review by Fergus or Simon. Any opinions on whether this capability should
be documented and made available to users? I would vote yes.

Zoltan.

A step towards replacing hand-written unify and compare predicates for builtin
types with foreign type definitions with "where equality is ..., comparison is
..." annotations. The foreign_proc's implementing those unify and compare
predicates are as safe as compiler-generated predicates.

compiler/prog_data.m:
	Associate with user-defined equality predicates a boolean that says
	whether they are safe to treat the same as compiler-generated
	unification predicates.

compiler/prog_io.m:
	Parse "where safe_equality is ..." as "where equality is ...", but
	also set the safe flag.

compiler/det_analysis.m:
	Put unifications over types with user-defined equality into committed
	choice contexts only if the equality predicate wasn't declared safe.

compiler/hlds_out.m:
compiler/mercury_to_mercury.m:
compiler/intermod.m:
compiler/unify_proc.m:
	Conform to the changes above.

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/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.160
diff -u -r1.160 det_analysis.m
--- compiler/det_analysis.m	15 Mar 2003 03:08:44 -0000	1.160
+++ compiler/det_analysis.m	11 May 2003 17:33:18 -0000
@@ -972,7 +972,7 @@
 		det_get_proc_info(DetInfo, ProcInfo),
 		proc_info_vartypes(ProcInfo, VarTypes),
 		map__lookup(VarTypes, Var, Type),
-		det_type_has_user_defined_equality_pred(DetInfo, Type)
+		det_type_has_unsafe_user_defined_equality_pred(DetInfo, Type)
 	->
 		( CanFail = can_fail ->
 			proc_info_varset(ProcInfo, VarSet),
@@ -997,15 +997,18 @@
 
 % return true iff there was a `where equality is <predname>' declaration
 % for the specified type.
-:- pred det_type_has_user_defined_equality_pred(det_info::in,
-		(type)::in) is semidet.
-det_type_has_user_defined_equality_pred(DetInfo, Type) :-
+:- pred det_type_has_unsafe_user_defined_equality_pred(det_info::in,
+	(type)::in) is semidet.
+
+det_type_has_unsafe_user_defined_equality_pred(DetInfo, Type) :-
 	det_info_get_module_info(DetInfo, ModuleInfo),
-	type_has_user_defined_equality_pred(ModuleInfo, Type, _).
+	type_has_user_defined_equality_pred(ModuleInfo, Type, UnifyCompare),
+	UnifyCompare = unify_compare(yes(equality_pred(no, _)), _).
 
 % return yes iff the results of the specified unification might depend on
 % the concrete representation of the abstract values involved.
 :- pred det_infer_unify_examines_rep(unification::in, bool::out) is det.
+
 det_infer_unify_examines_rep(assign(_, _), no).
 det_infer_unify_examines_rep(construct(_, _, _, _, _, _, _), no).
 det_infer_unify_examines_rep(deconstruct(_, _, _, _, _, _), yes).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.306
diff -u -r1.306 hlds_out.m
--- compiler/hlds_out.m	10 May 2003 05:03:51 -0000	1.306
+++ compiler/hlds_out.m	11 May 2003 17:24:13 -0000
@@ -2972,8 +2972,14 @@
 		io__write_string("\n"),
 		hlds_out__write_indent(Indent + 1),
 		io__write_string("where "),
-		( { MaybeEq = yes(Eq) } ->
-			io__write_string("equality is "),
+		( { MaybeEq = yes(equality_pred(Safe, Eq)) } ->
+			(
+				{ Safe = yes },
+				io__write_string("safe_equality is ")
+			;
+				{ Safe = no },
+				io__write_string("equality is ")
+			),
 			prog_out__write_sym_name(Eq),
 			( { MaybeCompare = yes(_) } ->
 				io__write_string(", ")
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.139
diff -u -r1.139 intermod.m
--- compiler/intermod.m	8 May 2003 03:39:54 -0000	1.139
+++ compiler/intermod.m	11 May 2003 17:32:58 -0000
@@ -1101,24 +1101,37 @@
 	type_ctor::in, maybe(unify_compare)::in, maybe(unify_compare)::out,
 	intermod_info::in, intermod_info::out) is det.
 
-intermod__resolve_unify_compare_overloading(_, _, no, no, Info, Info).
+intermod__resolve_unify_compare_overloading(_, _, no, no, !Info).
 intermod__resolve_unify_compare_overloading(ModuleInfo, TypeCtor,
 		yes(unify_compare(MaybeUserEq0, MaybeUserCompare0)),
 		yes(unify_compare(MaybeUserEq, MaybeUserCompare)),
-		Info0, Info) :-
-	intermod__resolve_user_special_pred_overloading(ModuleInfo,
-		unify, TypeCtor, MaybeUserEq0, MaybeUserEq, Info0, Info1),
-	intermod__resolve_user_special_pred_overloading(ModuleInfo,
-		compare, TypeCtor, MaybeUserCompare0, MaybeUserCompare,
-		Info1, Info).
+		!Info) :-
+	(
+		MaybeUserEq0 = no,
+		MaybeUserEq = no
+	;
+		MaybeUserEq0 = yes(equality_pred(Safe, UserEq0)),
+		intermod__resolve_user_special_pred_overloading(ModuleInfo,
+			unify, TypeCtor, UserEq0, UserEq, !Info),
+		MaybeUserEq = yes(equality_pred(Safe, UserEq))
+	),
+	(
+		MaybeUserCompare0 = no,
+		MaybeUserCompare = no
+	;
+		MaybeUserCompare0 = yes(UserCompare0),
+		intermod__resolve_user_special_pred_overloading(ModuleInfo,
+			compare, TypeCtor, UserCompare0, UserCompare,
+			!Info),
+		MaybeUserCompare = yes(UserCompare)
+	).
 
 :- pred intermod__resolve_user_special_pred_overloading(module_info::in,
-	special_pred_id::in, type_ctor::in, maybe(sym_name)::in,
-	maybe(sym_name)::out, intermod_info::in, intermod_info::out) is det.
+	special_pred_id::in, type_ctor::in, sym_name::in,
+	sym_name::out, intermod_info::in, intermod_info::out) is det.
 
-intermod__resolve_user_special_pred_overloading(_, _, _, no, no, Info, Info).
 intermod__resolve_user_special_pred_overloading(ModuleInfo, SpecialId,
-		TypeCtor, yes(Pred0), yes(Pred), Info0, Info) :-
+		TypeCtor, Pred0, Pred, Info0, Info) :-
 	module_info_get_special_pred_map(ModuleInfo, SpecialPreds),
 	map__lookup(SpecialPreds, SpecialId - TypeCtor, UnifyPredId),
 	module_info_pred_info(ModuleInfo, UnifyPredId, UnifyPredInfo),
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.227
diff -u -r1.227 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	15 Mar 2003 03:08:58 -0000	1.227
+++ compiler/mercury_to_mercury.m	11 May 2003 17:11:46 -0000
@@ -1774,8 +1774,14 @@
 mercury_output_equality_compare_preds(
 		yes(unify_compare(MaybeEqualityPred, MaybeComparisonPred))) -->
 	io__write_string("where "),
-	( { MaybeEqualityPred = yes(EqualityPredName) } ->
-		io__write_string("equality is "),
+	( { MaybeEqualityPred = yes(equality_pred(Safe, EqualityPredName)) } ->
+		(
+			{ Safe = yes },
+			io__write_string("safe_equality is ")
+		;
+			{ Safe = no },
+			io__write_string("equality is ")
+		),
 		mercury_output_bracketed_sym_name(EqualityPredName),
 		( { MaybeComparisonPred = yes(_) } ->
 			io__write_string(", ")
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.93
diff -u -r1.93 prog_data.m
--- compiler/prog_data.m	8 May 2003 03:39:56 -0000	1.93
+++ compiler/prog_data.m	11 May 2003 16:19:33 -0000
@@ -904,7 +904,12 @@
 	% An equality_pred specifies the name of a user-defined predicate
 	% used for equality on a type.  See the chapter on them in the
 	% Mercury Language Reference Manual.
-:- type equality_pred	==	sym_name.
+:- type equality_pred	--->
+	equality_pred(
+		bool,		% yes: if this unify is allowed to fail
+				% and does not need to be put in a cc context.
+		sym_name
+	).
 
 	 % The name of a user-defined comparison predicate.
 :- type comparison_pred	==	sym_name.
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.219
diff -u -r1.219 prog_io.m
--- compiler/prog_io.m	15 Mar 2003 03:09:07 -0000	1.219
+++ compiler/prog_io.m	11 May 2003 17:23:40 -0000
@@ -1652,15 +1652,13 @@
 	->
 		Body = Body1,
 		( 
-			parse_equality_or_comparison_pred_term("equality",
-				EqCompTerm, PredName)
+			parse_equality_pred_term(EqCompTerm, Safe, PredName)
 		->
 			parse_symbol_name(PredName, MaybeEqComp0),
-			process_maybe1(make_equality, MaybeEqComp0,
+			process_maybe1(make_equality(Safe), MaybeEqComp0,
 				MaybeEqComp)
 		;
-			parse_equality_or_comparison_pred_term("comparison",
-				EqCompTerm, PredName)
+			parse_comparison_pred_term(EqCompTerm, PredName)
 		->
 			parse_symbol_name(PredName, MaybeEqComp0),
 			process_maybe1(make_comparison, MaybeEqComp0,
@@ -1668,10 +1666,8 @@
 		;
 			EqCompTerm = term__functor(term__atom(","),
 					[EqTerm, CompTerm], _),
-			parse_equality_or_comparison_pred_term("equality",
-				EqTerm, EqPredNameTerm),
-			parse_equality_or_comparison_pred_term("comparison",
-				CompTerm, CompPredNameTerm)
+			parse_equality_pred_term(EqTerm, Safe, EqPredNameTerm),
+			parse_comparison_pred_term(CompTerm, CompPredNameTerm)
 		->
 			parse_symbol_name(EqPredNameTerm, EqPredNameResult),
 			parse_symbol_name(CompPredNameTerm,
@@ -1679,9 +1675,9 @@
 			(
 				EqPredNameResult = ok(EqPredName),
 				CompPredNameResult = ok(CompPredName),
-				MaybeEqComp = ok(yes(
-					unify_compare(yes(EqPredName),
-						yes(CompPredName))))
+				MaybeEqComp = ok(yes(unify_compare(
+					yes(equality_pred(Safe, EqPredName)),
+					yes(CompPredName))))
 			;
 				EqPredNameResult = ok(_),
 				CompPredNameResult = error(M, T),
@@ -1699,17 +1695,34 @@
 		MaybeEqComp = ok(no)
 	).
 
-:- pred parse_equality_or_comparison_pred_term(string::in, term::in,
-		term::out) is semidet.
+:- pred parse_equality_pred_term(term::in, bool::out, term::out) is semidet.
 
-parse_equality_or_comparison_pred_term(EqOrComp, Term, PredNameTerm) :-
-	Term = term__functor(term__atom("is"),
-		[term__functor(term__atom(EqOrComp), [], _), PredNameTerm], _).
+parse_equality_pred_term(Term, Safe, PredNameTerm) :-
+	Term = term__functor(term__atom("is"), [SubTerm1, SubTerm2], _),
+	( SubTerm1 = term__functor(term__atom("equality"), [], _) ->
+		Safe = no,
+		SubTerm2 = PredNameTerm
+	; SubTerm1 = term__functor(term__atom("safe_equality"), [], _) ->
+		Safe = yes,
+		SubTerm2 = PredNameTerm
+	;
+		fail
+	).
+
+:- pred parse_comparison_pred_term(term::in, term::out) is semidet.
 
-:- pred make_equality(sym_name::in, maybe(unify_compare)::out) is det.
-make_equality(Pred, yes(unify_compare(yes(Pred), no))).
+parse_comparison_pred_term(Term, PredNameTerm) :-
+	Term = term__functor(term__atom("is"), [SubTerm1, SubTerm2], _),
+	SubTerm1 = term__functor(term__atom("comparison"), [], _),
+	SubTerm2 = PredNameTerm.
+
+:- pred make_equality(bool::in, sym_name::in, maybe(unify_compare)::out) is det.
+
+make_equality(Safe, Pred,
+	yes(unify_compare(yes(equality_pred(Safe, Pred)), no))).
 
 :- pred make_comparison(sym_name::in, maybe(unify_compare)::out) is det.
+
 make_comparison(Pred, yes(unify_compare(no, yes(Pred)))).
 
 	% get_determinism(Term0, Term, Determinism) binds Determinism
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.119
diff -u -r1.119 unify_proc.m
--- compiler/unify_proc.m	31 Mar 2003 09:25:06 -0000	1.119
+++ compiler/unify_proc.m	11 May 2003 17:15:20 -0000
@@ -776,7 +776,7 @@
 		Context, Clauses) -->
 	{ UserEqCompare = unify_compare(MaybeUnify, MaybeCompare) },
 	(
-		{ MaybeUnify = yes(UnifyPredName) }
+		{ MaybeUnify = yes(equality_pred(_, UnifyPredName)) }
 	->
 		%
 		% Just generate a call to the specified predicate,
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
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/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/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/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
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/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/stream
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 extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
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/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/recompilation
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 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:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
Previous message: [m-rev.] trivial diff: fix tests/tabling/tc_loop failure
Next message: [m-rev.] for review: where safe_equality is ...
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the reviews mailing list