[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