[m-rev.] Extended the promise_<purity> scopes

Ralph Becket rafe at cs.mu.OZ.AU
Tue Apr 26 13:32:05 AEST 2005


Estimated hours taken: 2
Branches: main

Extend the promise_<purity> scopes.

compiler/hlds_goal.m:
	Added some comment lines to the scope_reaon documentation to
	make it clear to which constructor each comment pertains.

compiler/prog_io_goal.m:
compiler/purity.m:
library/ops.m:
	Added promise_impure as a scope.

	Added promise_{pure,semipure,impure}_implicit scopes.  These are
	identical to promise_{pure,semipure,impure} respectively, except that
	purity annotations on goals within the scope are optional.

	Purity warnings are no longer issued if the scope body has a lesser
	impurity than the promised purity.  To make this work, I've added a
	field `implicit_purity' to the purity_info constructor, which is either
	`make_implicit_promises' or `dont_make_implicit_promises'.  If the
	latter, then purity errors and warnings are suppressed.

tests/hard_coded/Mmakefile:
tests/hard_coded/test_promise_impure_implicit.m:
tests/hard_coded/test_promise_impure_implicit.exp:
	Added a test case.

Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.128
diff -u -r1.128 hlds_goal.m
--- compiler/hlds_goal.m	24 Mar 2005 05:34:03 -0000	1.128
+++ compiler/hlds_goal.m	22 Apr 2005 03:50:05 -0000
@@ -207,7 +207,7 @@
 		% preserves this fact.
 
 	--->	exist_quant(list(prog_var))
-
+		%
 		% Even though the code inside the scope may have multiple
 		% solutions, the creater of the scope (which may be the user
 		% or a compiler pass) promises that all these solutions are
@@ -227,7 +227,7 @@
 		% If it is not valid, the compiler must emit an error message.
 
 	;	promise_equivalent_solutions(list(prog_var))
-
+		%
 		% The goal inside the scope implements an interface of the
 		% specified purity, even if its implementation uses less pure
 		% components.
@@ -239,7 +239,7 @@
 		% annotations on the goals inside the scope.
 
 	;	promise_purity(implicit_purity_promise, purity)
-
+		%
 		% This scope exists to delimit a piece of code
 		% with at_most_many components but with no outputs,
 		% whose overall determinism is thus at_most_one,
@@ -251,7 +251,7 @@
 		% succeed at most once even if the inner goal is impure.
 
 	;	commit(force_pruning)
-
+		%
 		% The scope exists to prevent other compiler passes from
 		% arbitrarily moving computations in or out of the scope.
 		% This kind of scope can only be introduced by program
@@ -272,7 +272,7 @@
 		% the inner or the outer goal, or about pruning.
 
 	;	barrier(removable)
-
+		%
 		% The goal inside the scope, which should be a conjunction,
 		% results from the conversion of one ground term to
 		% superhomogeneous form. The variable specifies what the
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.33
diff -u -r1.33 prog_io_goal.m
--- compiler/prog_io_goal.m	14 Apr 2005 06:51:01 -0000	1.33
+++ compiler/prog_io_goal.m	22 Apr 2005 07:47:31 -0000
@@ -273,6 +273,18 @@
 	parse_goal(A0, A, !V),
 	GoalExpr = promise_purity(dont_make_implicit_promises, impure, A).
 
+parse_goal_2("promise_pure_implicit", [A0], GoalExpr, !V):-
+	parse_goal(A0, A, !V),
+	GoalExpr = promise_purity(make_implicit_promises, pure, A).
+
+parse_goal_2("promise_semipure_implicit", [A0], GoalExpr, !V):-
+	parse_goal(A0, A, !V),
+	GoalExpr = promise_purity(make_implicit_promises, semipure, A).
+
+parse_goal_2("promise_impure_implicit", [A0], GoalExpr, !V):-
+	parse_goal(A0, A, !V),
+	GoalExpr = promise_purity(make_implicit_promises, impure, A).
+
 	% The following is a temporary hack to handle `is' in
 	% the parser - we ought to handle it in the code generation -
 	% but then `is/2' itself is a bit of a hack
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.73
diff -u -r1.73 purity.m
--- compiler/purity.m	24 Mar 2005 05:34:14 -0000	1.73
+++ compiler/purity.m	22 Apr 2005 08:26:26 -0000
@@ -337,12 +337,13 @@
 	clauses_info_varset(ClausesInfo0, VarSet0),
 	RunPostTypecheck = yes,
 	PurityInfo0 = purity_info(ModuleInfo, RunPostTypecheck,
-		!.PredInfo, VarTypes0, VarSet0, []),
+		!.PredInfo, VarTypes0, VarSet0, [],
+		dont_make_implicit_promises),
 	pred_info_get_goal_type(!.PredInfo, GoalType),
 	compute_purity(GoalType, Clauses0, Clauses, ProcIds, pure, Purity,
 		PurityInfo0, PurityInfo),
 	PurityInfo = purity_info(_, _, !:PredInfo,
-		VarTypes, VarSet, RevMessages),
+		VarTypes, VarSet, RevMessages, _),
 	clauses_info_set_vartypes(VarTypes, ClausesInfo0, ClausesInfo1),
 	clauses_info_set_varset(VarSet, ClausesInfo1, ClausesInfo2),
 	Messages = list__reverse(RevMessages),
@@ -388,9 +389,10 @@
 	proc_info_varset(ProcInfo0, VarSet0),
 	RunPostTypeCheck = no,
 	PurityInfo0 = purity_info(ModuleInfo, RunPostTypeCheck,
-		!.PredInfo, VarTypes0, VarSet0, []),
+		!.PredInfo, VarTypes0, VarSet0, [],
+		dont_make_implicit_promises),
 	compute_goal_purity(Goal0, Goal, Bodypurity, PurityInfo0, PurityInfo),
-	PurityInfo = purity_info(_, _, !:PredInfo, VarTypes, VarSet, _),
+	PurityInfo = purity_info(_, _, !:PredInfo, VarTypes, VarSet, _, _),
 	proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
 	proc_info_set_vartypes(VarTypes, ProcInfo1, ProcInfo2),
 	proc_info_set_varset(VarSet, ProcInfo2, ProcInfo),
@@ -669,26 +671,33 @@
 	).
 compute_expr_purity(scope(Reason, Goal0), scope(Reason, Goal),
 		_, Purity, !Info) :-
-	compute_goal_purity(Goal0, Goal, Purity0, !Info),
 	(
 		Reason = exist_quant(_),
-		Purity = Purity0
+		compute_goal_purity(Goal0, Goal, Purity, !Info)
 	;
-			% XXX Use Implicit when checking Goal0
-		Reason = promise_purity(_Implicit, PromisedPurity),
-		Purity = best_purity(Purity0, PromisedPurity)
+		Reason = promise_purity(Implicit, PromisedPurity),
+		ImplicitPurity0 = !.Info ^ implicit_purity,
+		(
+			Implicit = make_implicit_promises,
+			!:Info = !.Info ^ implicit_purity := Implicit
+		;
+			Implicit = dont_make_implicit_promises
+		),
+		compute_goal_purity(Goal0, Goal, _, !Info),
+		!:Info = !.Info ^ implicit_purity := ImplicitPurity0,
+		Purity = PromisedPurity
 	;
 		Reason = promise_equivalent_solutions(_),
-		Purity = Purity0
+		compute_goal_purity(Goal0, Goal, Purity, !Info)
 	;
 		Reason = commit(_),
-		Purity = Purity0
+		compute_goal_purity(Goal0, Goal, Purity, !Info)
 	;
 		Reason = barrier(_),
-		Purity = Purity0
+		compute_goal_purity(Goal0, Goal, Purity, !Info)
 	;
 		Reason = from_ground_term(_),
-		Purity = Purity0
+		compute_goal_purity(Goal0, Goal, Purity, !Info)
 	).
 compute_expr_purity(if_then_else(Vars, Cond0, Then0, Else0),
 		if_then_else(Vars, Cond, Then, Else), _, Purity, !Info) :-
@@ -769,7 +778,10 @@
 
 	% Check for a bogus purity annotation on the unification
 	infer_goal_info_purity(GoalInfo, DeclaredPurity),
-	( DeclaredPurity \= pure ->
+	(
+		DeclaredPurity \= pure,
+		!.Info ^ implicit_purity = dont_make_implicit_promises
+	->
 		goal_info_get_context(GoalInfo, Context),
 		Message = impure_unification_expr_error(Context,
 			DeclaredPurity),
@@ -881,9 +893,16 @@
 		!Info) :-
 	ModuleInfo = !.Info ^ module_info,
 	PredInfo = !.Info ^ pred_info,
+	ImplicitPurity = !.Info ^ implicit_purity,
 	module_info_pred_info(ModuleInfo, PredId, CalleePredInfo),
 	pred_info_get_purity(CalleePredInfo, ActualPurity),
 	(
+		% If implicit_purity = make_implicit_promises then
+		% we don't report purity errors or warnings.
+		ImplicitPurity = make_implicit_promises
+	->
+		true
+	;
 		% The purity of the callee should match the
 		% purity declared at the call
 		ActualPurity = DeclaredPurity
@@ -1262,7 +1281,12 @@
 			pred_info		:: pred_info,
 			vartypes		:: vartypes,
 			varset			:: prog_varset,
-			messages		:: post_typecheck_messages
+			messages		:: post_typecheck_messages,
+			implicit_purity		:: implicit_purity_promise
+				% If this is make_implicit_promises then purity
+				% annotations are optional in the current scope
+				% and purity warnings/errors should not be
+				% generated.
 		).
 
 :- pred purity_info_add_message(post_typecheck_message::in,
Index: library/ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/ops.m,v
retrieving revision 1.49
diff -u -r1.49 ops.m
--- library/ops.m	24 Mar 2005 05:34:27 -0000	1.49
+++ library/ops.m	22 Apr 2005 07:46:32 -0000
@@ -333,6 +333,9 @@
 ops__op_table("promise_pure", before, fx, 950).	% Mercury extension
 ops__op_table("promise_impure", before, fx, 950).	% Mercury extension
 ops__op_table("promise_semipure", before, fx, 950).	% Mercury extension
+ops__op_table("promise_pure_implicit", before, fx, 950).    % Mercury extension
+ops__op_table("promise_impure_implicit", before, fx, 950).  % Mercury extension
+ops__op_table("promise_semipure_implicit", before, fx, 950).% Mercury extension
 ops__op_table("promise_equivalent_solutions", before, fxy, 950).
 						% Mercury extension
 ops__op_table("some", before, fxy, 950).	% Mercury/NU-Prolog extension
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.254
diff -u -r1.254 Mmakefile
--- tests/hard_coded/Mmakefile	14 Apr 2005 06:51:02 -0000	1.254
+++ tests/hard_coded/Mmakefile	26 Apr 2005 03:18:06 -0000
@@ -173,6 +173,7 @@
 	test_bitset \
 	test_cord \
 	test_imported_no_tag \
+	test_promise_impure_implicit \
 	time_test \
 	tim_qual1 \
 	transform_value \
Index: tests/hard_coded/test_promise_impure_implicit.exp
===================================================================
RCS file: tests/hard_coded/test_promise_impure_implicit.exp
diff -N tests/hard_coded/test_promise_impure_implicit.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/test_promise_impure_implicit.exp	26 Apr 2005 03:17:25 -0000
@@ -0,0 +1 @@
+Hello, World!
Index: tests/hard_coded/test_promise_impure_implicit.m
===================================================================
RCS file: tests/hard_coded/test_promise_impure_implicit.m
diff -N tests/hard_coded/test_promise_impure_implicit.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/test_promise_impure_implicit.m	26 Apr 2005 03:17:47 -0000
@@ -0,0 +1,40 @@
+%-----------------------------------------------------------------------------%
+% test_promise_impure_implicit.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Tue Apr 26 13:14:12 EST 2005
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+%-----------------------------------------------------------------------------%
+
+:- module test_promise_impure_implicit.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- pred main(io :: di, io :: uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    promise_pure_implicit (
+        X = some_impure_string,
+        io.print(X, !IO)
+    ).
+
+:- impure func some_impure_string = string.
+
+some_impure_string = X :-
+    promise_impure (
+        X = "Hello, World!\n"
+    ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list