[m-rev.] for review: allow promise_pure and promise_semipure attributes
Tyson Dowd
trd at cs.mu.OZ.AU
Wed Nov 14 15:03:12 AEDT 2001
Hi,
Here's the first part of making foreign_proc impure by default.
===================================================================
Estimated hours taken: 6
Branches: main
Accept promise_pure and promise_semipure as foreign proc attributes.
Make changes required to make pragma foreign_proc impure by default,
but leave the actual default setting commented out for now.
(next step is to fix the purity of the preds/funcs in the library).
compiler/prog_data.m:
Add purity to the pragma_foreign_proc_attributes.
We keep the default purity pure, but we have a commented out
default of impure that can be switched on later.
compiler/prog_io_pragma.m:
Parse the new promise_pure and promise_semipure declarations.
Add a promise_pure for :- pragma c_code and :- pragma import so
that it is backwards compatible.
Improve the code used to process the list of attributes.
compiler/purity.m:
Mark the code that needs to be removed once we have bootstrapped
this change and fixed the library.
Calculate expression purity from foreign_proc from the
attributes rather than looking up the declared purity.
doc/reference_manual.texi:
Document the new syntax, and add commented out comments to
indicate the intended change to make the default purity for
foreign_proc pure.
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.71
diff -u -r1.71 prog_data.m
--- compiler/prog_data.m 6 Nov 2001 15:21:09 -0000 1.71
+++ compiler/prog_data.m 7 Nov 2001 01:05:53 -0000
@@ -538,6 +538,9 @@
:- pred thread_safe(pragma_foreign_proc_attributes, thread_safe).
:- mode thread_safe(in, out) is det.
+:- pred purity(pragma_foreign_proc_attributes, purity).
+:- mode purity(in, out) is det.
+
:- pred set_thread_safe(pragma_foreign_proc_attributes, thread_safe,
pragma_foreign_proc_attributes).
:- mode set_thread_safe(in, in, out) is det.
@@ -556,6 +559,9 @@
pragma_foreign_proc_attributes).
:- mode set_tabled_for_io(in, in, out) is det.
+:- pred set_purity(pragma_foreign_proc_attributes, purity,
+ pragma_foreign_proc_attributes).
+:- mode set_purity(in, in, out) is det.
:- pred add_extra_attribute(pragma_foreign_proc_attributes,
pragma_foreign_proc_extra_attribute,
@@ -998,6 +1004,7 @@
:- implementation.
:- import_module string.
+:- import_module purity.
:- type pragma_foreign_proc_attributes
---> attributes(
@@ -1005,14 +1012,20 @@
may_call_mercury :: may_call_mercury,
thread_safe :: thread_safe,
tabled_for_io :: tabled_for_io,
+ purity :: purity,
extra_attributes ::
list(pragma_foreign_proc_extra_attribute)
).
+ % XXX we define Purity as being "pure" by default, but we should
+ % change this to "impure" once the promise_pure syntax is available
+ % and all the uses of foreign_proc in the library have the appropriate
+ % promises on them.
default_attributes(Language,
attributes(Language, may_call_mercury, not_thread_safe,
- not_tabled_for_io, [])).
+ not_tabled_for_io, pure, [])). % delete me and
+% not_tabled_for_io, impure, [])). % uncomment me soon!
may_call_mercury(Attrs, Attrs ^ may_call_mercury).
@@ -1022,6 +1035,8 @@
tabled_for_io(Attrs, Attrs ^ tabled_for_io).
+purity(Attrs, Attrs ^ purity).
+
set_may_call_mercury(Attrs0, MayCallMercury, Attrs) :-
Attrs = Attrs0 ^ may_call_mercury := MayCallMercury.
@@ -1034,12 +1049,15 @@
set_tabled_for_io(Attrs0, TabledForIo, Attrs) :-
Attrs = Attrs0 ^ tabled_for_io := TabledForIo.
+set_purity(Attrs0, Purity, Attrs) :-
+ Attrs = Attrs0 ^ purity := Purity.
+
attributes_to_strings(Attrs, StringList) :-
% We ignore Lang because it isn't an attribute that you can put
% in the attribute list -- the foreign language specifier string
% is at the start of the pragma.
Attrs = attributes(_Lang, MayCallMercury, ThreadSafe, TabledForIO,
- ExtraAttributes),
+ Purity, ExtraAttributes),
(
MayCallMercury = may_call_mercury,
MayCallMercuryStr = "may_call_mercury"
@@ -1061,7 +1079,18 @@
TabledForIO = not_tabled_for_io,
TabledForIOStr = "not_tabled_for_io"
),
- StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr] ++
+ (
+ Purity = pure,
+ PurityStr = "promise_pure"
+ ;
+ Purity = (semipure),
+ PurityStr = "promise_semipure"
+ ;
+ Purity = (impure),
+ PurityStr = ""
+ ),
+ StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr,
+ PurityStr] ++
list__map(extra_attribute_to_string, ExtraAttributes).
add_extra_attribute(Attributes0, NewAttribute,
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.36
diff -u -r1.36 prog_io_pragma.m
--- compiler/prog_io_pragma.m 6 Nov 2001 15:21:10 -0000 1.36
+++ compiler/prog_io_pragma.m 12 Nov 2001 08:27:24 -0000
@@ -306,7 +306,7 @@
PTerms6 = [PredAndVarsTerm, FlagsTerm,
FieldsTerm, FirstTerm, LaterTerm, SharedTerm],
parse_pragma_foreign_proc_attributes_term(
- ForeignLanguage, FlagsTerm, MaybeFlags),
+ ForeignLanguage, Pragma, FlagsTerm, MaybeFlags),
( MaybeFlags = ok(Flags) ->
( parse_pragma_keyword("local_vars", FieldsTerm, Fields,
FieldsContext) ->
@@ -385,14 +385,14 @@
CodeTerm = term__functor(term__string(Code), [], Context)
->
parse_pragma_foreign_proc_attributes_term(
- ForeignLanguage, FlagsTerm, MaybeFlags),
+ ForeignLanguage, Pragma, FlagsTerm, MaybeFlags),
(
MaybeFlags = ok(Flags),
parse_pragma_foreign_code(ModuleName, Flags,
PredAndVarsTerm, ordinary(Code, yes(Context)),
VarSet, Res),
parse_pragma_foreign_proc_attributes_term(
- ForeignLanguage, PredAndVarsTerm,
+ ForeignLanguage, Pragma, PredAndVarsTerm,
MaybeFlags2),
(
MaybeFlags2 = ok(Flags)
@@ -525,7 +525,7 @@
PTerms6 = [PredAndVarsTerm, FlagsTerm,
FieldsTerm, FirstTerm, LaterTerm, SharedTerm],
parse_pragma_foreign_proc_attributes_term(
- ForeignLanguage, FlagsTerm, MaybeFlags),
+ ForeignLanguage, Pragma, FlagsTerm, MaybeFlags),
( MaybeFlags = ok(Flags) ->
( parse_pragma_keyword("local_vars", FieldsTerm, Fields,
FieldsContext) ->
@@ -604,7 +604,7 @@
CodeTerm = term__functor(term__string(Code), [], Context)
->
parse_pragma_foreign_proc_attributes_term(ForeignLanguage,
- FlagsTerm, MaybeFlags),
+ Pragma, FlagsTerm, MaybeFlags),
(
MaybeFlags = ok(Flags),
parse_pragma_foreign_code(ModuleName, Flags,
@@ -613,7 +613,8 @@
;
MaybeFlags = error(FlagsErr, FlagsErrTerm),
parse_pragma_foreign_proc_attributes_term(
- ForeignLanguage, PredAndVarsTerm, MaybeFlags2),
+ ForeignLanguage, Pragma, PredAndVarsTerm,
+ MaybeFlags2),
(
MaybeFlags2 = ok(Flags),
% XXX we should issue a warning; this syntax is
@@ -730,7 +731,7 @@
(
PragmaTerms = [PredAndModesTerm, FlagsTerm, FunctionTerm],
parse_pragma_foreign_proc_attributes_term(ForeignLanguage,
- FlagsTerm, MaybeFlags),
+ "import", FlagsTerm, MaybeFlags),
(
MaybeFlags = error(FlagError, ErrorTerm),
FlagsResult = error("invalid second argument in `:- pragma import/3' declaration : " ++ FlagError, ErrorTerm)
@@ -1216,23 +1217,32 @@
---> may_call_mercury(may_call_mercury)
; thread_safe(thread_safe)
; tabled_for_io(tabled_for_io)
+ ; purity(purity)
; aliasing
; max_stack_size(int).
-:- pred parse_pragma_foreign_proc_attributes_term(foreign_language, term,
- maybe1(pragma_foreign_proc_attributes)).
-:- mode parse_pragma_foreign_proc_attributes_term(in, in, out) is det.
+:- pred parse_pragma_foreign_proc_attributes_term(foreign_language, string,
+ term, maybe1(pragma_foreign_proc_attributes)).
+:- mode parse_pragma_foreign_proc_attributes_term(in, in, in, out) is det.
-parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Term,
+parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Pragma, Term,
MaybeAttributes) :-
default_attributes(ForeignLanguage, Attributes0),
+ ( ( Pragma = "c_code" ; Pragma = "import" ) ->
+ set_purity(Attributes0, pure, Attributes1)
+ ;
+ Attributes1 = Attributes0
+ ),
ConflictingAttributes = [
may_call_mercury(will_not_call_mercury) -
may_call_mercury(may_call_mercury),
thread_safe(thread_safe) -
thread_safe(not_thread_safe),
tabled_for_io(tabled_for_io) -
- tabled_for_io(not_tabled_for_io)
+ tabled_for_io(not_tabled_for_io),
+ purity(pure) - purity(impure),
+ purity(pure) - purity(semipure),
+ purity(semipure) - purity(impure)
],
(
parse_pragma_foreign_proc_attributes_term0(Term, AttrList)
@@ -1245,43 +1255,11 @@
->
MaybeAttributes = error("conflicting attributes in attribute list", Term)
;
- (
- list__member(may_call_mercury(
- will_not_call_mercury), AttrList)
- ->
- set_may_call_mercury(Attributes0,
- will_not_call_mercury, Attributes1)
- ;
- Attributes1 = Attributes0
- ),
- (
- list__member(thread_safe(thread_safe),
- AttrList)
- ->
- set_thread_safe(Attributes1, thread_safe,
- Attributes2)
- ;
- Attributes2 = Attributes1
- ),
- (
- list__member(tabled_for_io(tabled_for_io),
- AttrList)
- ->
- set_tabled_for_io(Attributes2, tabled_for_io,
- Attributes3)
- ;
- Attributes3 = Attributes2
- ),
- ExtraAttrs = list__filter_map(
- attribute_to_extra_attribute, AttrList),
list__foldl(
- (pred(EAttr::in, Attrs0::in,
- Attrs::out) is det :-
- add_extra_attribute(Attrs0, EAttr,
- Attrs)),
- ExtraAttrs, Attributes3, Attributes),
- MaybeAttributes = check_required_attributes(
- ForeignLanguage, Attributes, Term)
+ process_attribute,
+ AttrList, Attributes1, Attributes),
+ MaybeAttributes = check_required_attributes(
+ ForeignLanguage, Attributes, Term)
)
;
ErrMsg = "expecting a foreign proc attribute or list of attributes",
@@ -1289,6 +1267,27 @@
).
+ % Update the pragma_foreign_proc_attributes according to the given
+ % collected_pragma_foreign_proc_attribute.
+:- pred process_attribute(collected_pragma_foreign_proc_attribute::in,
+ pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_attributes::out) is det.
+
+process_attribute(may_call_mercury(MayCallMercury), Attrs0, Attrs) :-
+ set_may_call_mercury(Attrs0, MayCallMercury, Attrs).
+process_attribute(thread_safe(ThreadSafe), Attrs0, Attrs) :-
+ set_thread_safe(Attrs0, ThreadSafe, Attrs).
+process_attribute(tabled_for_io(TabledForIO), Attrs0, Attrs) :-
+ set_tabled_for_io(Attrs0, TabledForIO, Attrs).
+process_attribute(purity(Pure), Attrs0, Attrs) :-
+ set_purity(Attrs0, Pure, Attrs).
+process_attribute(max_stack_size(Size), Attrs0, Attrs) :-
+ add_extra_attribute(Attrs0, max_stack_size(Size), Attrs).
+
+ % Aliasing is currently ignored in the main branch compiler.
+process_attribute(aliasing, Attrs, Attrs).
+
+
% Check whether all the required attributes have been set for
% a particular language
:- func check_required_attributes(foreign_language,
@@ -1309,12 +1308,6 @@
Res = ok(Attrs)
).
-:- func attribute_to_extra_attribute(collected_pragma_foreign_proc_attribute)
- = pragma_foreign_proc_extra_attribute is semidet.
-
-attribute_to_extra_attribute(max_stack_size(Size)) = max_stack_size(Size).
-
-
:- pred parse_pragma_foreign_proc_attributes_term0(term,
list(collected_pragma_foreign_proc_attribute)).
:- mode parse_pragma_foreign_proc_attributes_term0(in, out) is semidet.
@@ -1351,6 +1344,8 @@
Flag = aliasing
; parse_max_stack_size(Term, Size) ->
Flag = max_stack_size(Size)
+ ; parse_purity_promise(Term, Purity) ->
+ Flag = purity(Purity)
;
fail
).
@@ -1401,6 +1396,12 @@
term__atom("max_stack_size"), [SizeTerm], _), Size) :-
SizeTerm = term__functor(term__integer(Size), [], _).
+:- pred parse_purity_promise(term::in, purity::out) is semidet.
+
+parse_purity_promise(term__functor(term__atom("promise_pure"), [], _),
+ (pure)).
+parse_purity_promise(term__functor(term__atom("promise_semipure"), [], _),
+ (semipure)).
% parse a pragma foreign_code declaration
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.37
diff -u -r1.37 purity.m
--- compiler/purity.m 10 Aug 2001 08:29:30 -0000 1.37
+++ compiler/purity.m 2 Nov 2001 04:12:56 -0000
@@ -431,12 +431,14 @@
puritycheck_pred(PredId, PredInfo0, PredInfo, ModuleInfo, NumErrors) -->
{ pred_info_get_purity(PredInfo0, DeclPurity) } ,
{ pred_info_get_promised_purity(PredInfo0, PromisedPurity) },
+ % XXX we should remove this test when we have bootstrapped
+ % the changes requires to make foreign_proc impure by default
( { pred_info_get_goal_type(PredInfo0, pragmas) } ->
{ WorstPurity = (impure) },
{ IsPragmaCCode = yes },
% This is where we assume pragma foreign_proc is
% pure.
- { Purity = pure },
+ { Purity = (pure) },
{ PredInfo = PredInfo0 },
{ NumErrors0 = 0 }
;
@@ -785,11 +787,8 @@
{ worst_purity(Purity1, Purity2, Purity12) },
{ worst_purity(Purity12, Purity3, Purity) }.
compute_expr_purity(Ccode, Ccode, _, _, Purity) -->
- { Ccode = foreign_proc(_,PredId,_,_,_,_,_) },
- ModuleInfo =^ module_info,
- { module_info_preds(ModuleInfo, Preds) },
- { map__lookup(Preds, PredId, CalledPredInfo) },
- { pred_info_get_purity(CalledPredInfo, Purity) }.
+ { Ccode = foreign_proc(Attributes,_,_,_,_,_,_) },
+ { purity(Attributes, Purity) }.
compute_expr_purity(shorthand(_), _, _, _, _) -->
% these should have been expanded out by now
{ error("compute_expr_purity: unexpected shorthand") }.
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.224
diff -u -r1.224 reference_manual.texi
--- doc/reference_manual.texi 12 Nov 2001 11:08:13 -0000 1.224
+++ doc/reference_manual.texi 13 Nov 2001 08:38:02 -0000
@@ -4831,6 +4831,13 @@
corresponding to their Mercury types, as determined by language and
implementation specific rules.
+ at c All @samp{foreign_proc} implementations are assumed to be impure.
+ at c If they are actually pure or semipure, they must be explicitly
+ at c promised as such by the user (either by using foreign language
+ at c attributes specified below, or a promise_pure or promise_semipure pragma
+ at c as specificed in the ``Purity'' chapter of the Mercury Language
+ at c Reference Manual).
+
Additional restrictions on the foreign language interface code
depend on the foreign language and compilation options.
For more information, including the list of supported foreign languages and
@@ -4889,15 +4896,16 @@
@table @asis
- at item @samp{may_call_mercury}/@samp{will_not_call_mercury}
-This attribute declares whether or not execution inside this foreign
-language code may call back into Mercury or not. The default, in case
-neither is specified, is @samp{may_call_mercury}.
-Specifying @samp{will_not_call_mercury} may allow the compiler to
-generate more efficient code.
-If you specify @samp{will_not_call_mercury},
-but the foreign language code @emph{does} invoke Mercury code, then the
-behaviour is undefined.
+ at item @samp{promise_pure}/@samp{promise_semipure}
+This attribute promises that the purity of the given predicate or
+function definition is pure or semipure.
+It is equivalent to a corresponding @samp{pragma promise_pure}
+or at samp{pragma promise_semipure} declaration (see the ``Purity'' chapter
+of the Mercury Language Reference Manual for further details).
+If omitted, the default purity will be used instead (pure, but this is
+expected to change to impure).
+ at c If omitted, the clause specified by the @samp{foreign_proc} is
+ at c assumed to be impure.
@item @samp{thread_safe}/@samp{not_thread_safe}
This attribute declares whether or not it is safe for multiple threads
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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