[m-rev.] for review: feature set pragmas
Julien Fischer
juliensf at csse.unimelb.edu.au
Fri Nov 30 14:58:43 AEDT 2007
For review by anyone.
Estimated hours taken: 8
Branches: main
Add a new pragma that allows dependencies on optional features of the
compilation model to be checked by the compiler. The new pragma
has the form
:- pragma require_feature_set(<list_of_features>).
where <list_of_features> is a list of optional compilation model features
whose presence is required by the module containing the pragma.
For example,
:- pragma require_feature_set([trailing, double_prec_float, memo]).
asserts that the module requires trailing, double precision floats and
memoisation. The compiler will emit an error message if these features
are not available in the current compilation grade. This is particularly
helpful in cases like memoisation and parallel conjunction that are ignored
by default in grades that do not support them.
Fix a bug where we where not emitting a warning about memo and loopcheck
pragmas being ignored in grades that use --highlevel-data.
compiler/prog_item.m:
Represent require_feature_set pragmas in the parse tree.
compiler/prog_data.m:
Add a type that represents optional features of the compilation
model whose presence is required.
compiler/prog_io_pragma.m:
Parse the new pragma.
Turn an if-then-else into a switch.
compiler/add_pragma.m:
Process require_feature_set pragmas and emit error messages
concerning required features that are not supported by the
compilation grade.
compiler/globals.m:
Add three predicates that check whether tabling, threads and
parallel conjunctions are support by the current grade respectively.
(Some of this code used to be in table_gen.m and dep_par_conj.m
and has been moved here since it now called from more than one place).
Fix a bug where we were not emitting a message about memo
and loopcheck pragmas being ignored in grades where --highlevel-data
was enabled.
compiler/make_hlds_passes.m:
compiler/mercury_to_mercury.m:
Handle require_feature_set pragmas.
compiler/module_qual.m:
compiler/recompilation.version.m:
compiler/dep_par_conj.m:
compiler/table_gen.m:
Conform to the above change.
doc/reference_manual.texi:
Document the new pragma.
tests/invalid/Mmakefile:
tests/invalid/Mercury.options:
tests/invalid/conflicting_fs.{m,err_exp}
tests/invalid/test_feature_set.{m,err_exp}:
Test the new pragma.
Julien.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.73
diff -u -r1.73 add_pragma.m
--- compiler/add_pragma.m 23 Nov 2007 07:34:53 -0000 1.73
+++ compiler/add_pragma.m 30 Nov 2007 03:29:28 -0000
@@ -380,6 +380,10 @@
add_pred_marker("mode_check_clauses", Name, Arity, ImportStatus,
Context, marker_user_marked_no_inline, [marker_user_marked_inline],
!ModuleInfo, !Specs)
+ ;
+ Pragma = pragma_require_feature_set(FeatureSet),
+ check_required_feature_set(FeatureSet, ImportStatus, Context,
+ !ModuleInfo, !Specs)
).
add_pragma_foreign_export(Origin, Lang, Name, PredOrFunc, Modes,
@@ -3719,6 +3723,135 @@
merge_common_inst_vars(A, A, A).
%----------------------------------------------------------------------------%
+%
+% Code for checking required feature set pragmas
+%
+
+:- pred check_required_feature_set(set(required_feature)::in,
+ import_status::in, prog_context::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+check_required_feature_set(FeatureSet, ImportStatus, Context, !ModuleInfo,
+ !Specs) :-
+ module_info_get_globals(!.ModuleInfo, Globals),
+ set.fold(check_required_feature(Globals, ImportStatus, Context),
+ FeatureSet, !Specs).
+
+:- pred check_required_feature(globals::in, import_status::in,
+ prog_context::in, required_feature::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+check_required_feature(Globals, _ImportStatus, Context, Feature, !Specs) :-
+ (
+ Feature = reqf_concurrency,
+ current_grade_supports_concurrency(Globals, IsConcurrencySupported),
+ (
+ IsConcurrencySupported = no,
+ Pieces = [
+ words("Error: this module must be compiled in a grade that"),
+ words("supports concurrent execution.")
+ ],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ IsConcurrencySupported = yes
+ )
+ ;
+ Feature = reqf_single_prec_float,
+ globals.lookup_bool_option(Globals, single_prec_float,
+ SinglePrecFloat),
+ (
+ SinglePrecFloat = no,
+ Pieces = [
+ words("Error: this module must be compiled in a grade that"),
+ words("uses single precision floats.")
+ ],
+ VerbosePieces = [
+ words("Grades that use single precision floats contain the"),
+ words("grade modifier"), quote("spf"), suffix(".")
+ ],
+ Msg = simple_msg(Context,
+ [always(Pieces), verbose_only(VerbosePieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ SinglePrecFloat = yes
+ )
+ ;
+ Feature = reqf_double_prec_float,
+ globals.lookup_bool_option(Globals, single_prec_float,
+ SinglePrecFloat),
+ (
+ SinglePrecFloat = yes,
+ Pieces = [
+ words("Error: this module must be compiled in a grade that"),
+ words("uses double precision floats.")
+ ],
+ VerbosePieces = [
+ words("Grades that use double precision floats do not"),
+ words("contain the grade modifier"), quote("spf"), suffix(".")
+ ],
+ Msg = simple_msg(Context,
+ [always(Pieces), verbose_only(VerbosePieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ SinglePrecFloat = no
+ )
+ ;
+ Feature = reqf_memo,
+ current_grade_supports_tabling(Globals, IsTablingSupported),
+ (
+ IsTablingSupported = no,
+ Pieces = [
+ words("Error: this module must be compiled in a grade that"),
+ words("supports memoisation.")
+ ],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ IsTablingSupported = yes
+ )
+ ;
+ Feature = reqf_parallel_conj,
+ current_grade_supports_par_conj(Globals, IsParConjSupported),
+ (
+ IsParConjSupported = no,
+ Pieces = [
+ words("Error: this module must be compiled in a grade that"),
+ words("supports executing conjuntions in parallel.")
+ ],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ IsParConjSupported = yes
+ )
+ ;
+ Feature = reqf_trailing,
+ globals.lookup_bool_option(Globals, use_trail, UseTrail),
+ (
+ UseTrail = no,
+ Pieces = [
+ words("Error: this module must be compiled in a grade that"),
+ words("supports trailing.")
+ ],
+ VerbosePieces = [
+ words("Grades that support trailing contain the"),
+ words("grade modifier"), quote("tr"), suffix(".")
+ ],
+ Msg = simple_msg(Context,
+ [always(Pieces), verbose_only(VerbosePieces)]),
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ !:Specs = [Spec | !.Specs]
+ ;
+ UseTrail = yes
+ )
+ ).
+
+%----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/dep_par_conj.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.22
diff -u -r1.22 dep_par_conj.m
--- compiler/dep_par_conj.m 23 Nov 2007 07:34:59 -0000 1.22
+++ compiler/dep_par_conj.m 29 Nov 2007 05:53:10 -0000
@@ -194,21 +194,11 @@
add_pending_par_procs(DoneParProcs, PendingProcs,
ModuleInfo0, !ModuleInfo, !IO).
- % Parallel conjunctions only supported on lowlevel C parallel grades.
- % They are not (currently) supported if trailing is enabled.
- %
:- pred handle_par_conj(module_info::in) is semidet.
handle_par_conj(ModuleInfo) :-
module_info_get_globals(ModuleInfo, Globals),
- globals.get_target(Globals, Target),
- globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
- globals.lookup_bool_option(Globals, parallel, Parallel),
- globals.lookup_bool_option(Globals, use_trail, UseTrail),
- Target = target_c,
- HighLevelCode = no,
- Parallel = yes,
- UseTrail = no.
+ current_grade_supports_par_conj(Globals, yes).
%-----------------------------------------------------------------------------%
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.85
diff -u -r1.85 globals.m
--- compiler/globals.m 14 Nov 2007 03:45:10 -0000 1.85
+++ compiler/globals.m 30 Nov 2007 03:46:31 -0000
@@ -200,6 +200,21 @@
%
:- pred imported_is_constant(bool::in, bool::in, bool::out) is det.
+ % Check that the current grade supports tabling.
+ %
+:- pred current_grade_supports_tabling(globals::in, bool::out) is det.
+
+ % Check that code compiled in the current grade can execute
+ % conjunctions in parallel.
+ %
+:- pred current_grade_supports_par_conj(globals::in, bool::out) is det.
+
+ % Check that code compiled in the current grade supports concurrent
+ % execution, i.e. that spawn/3 will create a new thread instead of
+ % aborting execution.
+ %
+:- pred current_grade_supports_concurrency(globals::in, bool::out) is det.
+
%-----------------------------------------------------------------------------%
%
% Access predicates for storing a `globals' structure in the io.state
@@ -501,6 +516,68 @@
getopt_io.lookup_bool_option(OptionTable, asm_labels, AsmLabels),
imported_is_constant(NonLocalGotos, AsmLabels, IsConst).
+current_grade_supports_tabling(Globals, TablingSupported) :-
+ globals.get_target(Globals, Target),
+ globals.get_gc_method(Globals, GC_Method),
+ globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
+ (
+ Target = target_c,
+ GC_Method \= gc_accurate,
+ HighLevelData = no
+ ->
+ TablingSupported = yes
+ ;
+ TablingSupported = no
+ ).
+
+ % Parallel conjunctions only supported on lowlevel C parallel grades.
+ % They are not (currently) supported if trailing is enabled.
+ %
+current_grade_supports_par_conj(Globals, ParConjSupported) :-
+ globals.get_target(Globals, Target),
+ globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+ globals.lookup_bool_option(Globals, parallel, Parallel),
+ globals.lookup_bool_option(Globals, use_trail, UseTrail),
+ (
+ Target = target_c,
+ HighLevelCode = no,
+ Parallel = yes,
+ UseTrail = no
+ ->
+ ParConjSupported = yes
+ ;
+ ParConjSupported = no
+ ).
+
+current_grade_supports_concurrency(Globals, ThreadsSupported) :-
+ globals.get_target(Globals, Target),
+ (
+ Target = target_c,
+ globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+ % In high-level C grades we only support threads in .par grades.
+ (
+ HighLevelCode = no,
+ ThreadsSupported = yes
+ ;
+ HighLevelCode = yes,
+ globals.lookup_bool_option(Globals, parallel, Parallel),
+ ThreadsSupported = Parallel
+ )
+ ;
+ ( Target = target_erlang
+ ; Target = target_il
+ ),
+ ThreadsSupported = yes
+ ;
+ % Threads are not yet supported in the Java or x86_64 backends.
+ % XXX I'm not sure what their status in the gcc backend is.
+ ( Target = target_java
+ ; Target = target_asm
+ ; Target = target_x86_64
+ ),
+ ThreadsSupported = no
+ ).
+
want_return_var_layouts(Globals, WantReturnLayouts) :-
% We need to generate layout info for call return labels
% if we are using accurate gc or if the user wants uplevel printing.
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.74
diff -u -r1.74 make_hlds_passes.m
--- compiler/make_hlds_passes.m 22 Oct 2007 05:10:33 -0000 1.74
+++ compiler/make_hlds_passes.m 28 Nov 2007 13:54:30 -0000
@@ -1114,6 +1114,7 @@
; Pragma = pragma_terminates(_, _)
; Pragma = pragma_trailing_info(_, _, _, _, _)
; Pragma = pragma_unused_args(_, _, _, _, _)
+ ; Pragma = pragma_require_feature_set(_)
)
).
add_item_clause(item_promise(PromiseType, Goal, VarSet, UnivVars),
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.322
diff -u -r1.322 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 23 Nov 2007 07:35:11 -0000 1.322
+++ compiler/mercury_to_mercury.m 29 Nov 2007 01:23:31 -0000
@@ -769,6 +769,9 @@
Pragma = pragma_mode_check_clauses(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, pf_predicate,
"mode_check_clauses", no, !IO)
+ ;
+ Pragma = pragma_require_feature_set(Features),
+ mercury_output_pragma_require_feature_set(Features, !IO)
).
mercury_output_item(_, item_promise(PromiseType, Goal0, VarSet, UnivVars), _,
@@ -3760,6 +3763,33 @@
%-----------------------------------------------------------------------------%
+:- pred mercury_output_pragma_require_feature_set(set(required_feature)::in,
+ U::di, U::uo) is det <= output(U).
+
+mercury_output_pragma_require_feature_set(Features0, !U) :-
+ Features = set.to_sorted_list(Features0),
+ add_string(":- pragma require_feature_set(", !U),
+ add_list(Features, ",", mercury_format_required_feature, !U),
+ add_string(").\n", !U).
+
+:- pred mercury_format_required_feature(required_feature::in, U::di, U::uo)
+ is det <= output(U).
+
+mercury_format_required_feature(reqf_concurrency, !U) :-
+ add_string("concurrency", !U).
+mercury_format_required_feature(reqf_single_prec_float, !U) :-
+ add_string("single_prec_float", !U).
+mercury_format_required_feature(reqf_double_prec_float, !U) :-
+ add_string("double_prec_float", !U).
+mercury_format_required_feature(reqf_memo, !U) :-
+ add_string("memo", !U).
+mercury_format_required_feature(reqf_parallel_conj, !U) :-
+ add_string("parallel_conj", !U).
+mercury_format_required_feature(reqf_trailing, !U) :-
+ add_string("trailing", !U).
+
+%-----------------------------------------------------------------------------%
+
mercury_output_newline(Indent, !IO) :-
io.write_char('\n', !IO),
mercury_format_tabs(Indent, !IO).
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.160
diff -u -r1.160 module_qual.m
--- compiler/module_qual.m 23 Nov 2007 07:35:17 -0000 1.160
+++ compiler/module_qual.m 29 Nov 2007 01:25:14 -0000
@@ -1266,6 +1266,7 @@
qualify_pragma(X @ pragma_does_not_terminate(_, _), X, !Info, !Specs).
qualify_pragma(X @ pragma_check_termination(_, _), X, !Info, !Specs).
qualify_pragma(X @ pragma_mode_check_clauses(_, _), X, !Info, !Specs).
+qualify_pragma(X @ pragma_require_feature_set(_), X, !Info, !Specs).
:- pred qualify_pragma_vars(list(pragma_var)::in, list(pragma_var)::out,
mq_info::in, mq_info::out,
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.441
diff -u -r1.441 modules.m
--- compiler/modules.m 3 Oct 2007 12:11:54 -0000 1.441
+++ compiler/modules.m 29 Nov 2007 02:28:07 -0000
@@ -2286,6 +2286,7 @@
pragma_allowed_in_interface(pragma_structure_sharing(_, _, _, _, _, _), yes).
pragma_allowed_in_interface(pragma_structure_reuse(_, _, _, _, _, _), yes).
pragma_allowed_in_interface(pragma_mode_check_clauses(_, _), yes).
+pragma_allowed_in_interface(pragma_require_feature_set(_), no).
check_for_no_exports(Items, ModuleName, !IO) :-
globals.io_lookup_bool_option(warn_nothing_exported, ExportWarning, !IO),
@@ -7993,6 +7994,7 @@
; Pragma = pragma_structure_reuse(_, _, _, _, _, _), Reorderable = yes
; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _), Reorderable = yes
; Pragma = pragma_unused_args(_, _, _, _, _), Reorderable = yes
+ ; Pragma = pragma_require_feature_set(_), Reorderable = yes
).
reorderable_item(item_type_defn(_, _, _, _, _)) = yes.
reorderable_item(item_inst_defn(_, _, _, _, _)) = yes.
@@ -8079,6 +8081,7 @@
; Pragma = pragma_mm_tabling_info(_, _, _, _, _), Reorderable = yes
; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _), Reorderable = yes
; Pragma = pragma_unused_args(_, _, _, _, _), Reorderable = yes
+ ; Pragma = pragma_require_feature_set(_), Reorderable = yes
).
chunkable_item(item_type_defn(_, _, _, _, _)) = yes.
chunkable_item(item_inst_defn(_, _, _, _, _)) = yes.
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.199
diff -u -r1.199 prog_data.m
--- compiler/prog_data.m 23 Nov 2007 07:35:21 -0000 1.199
+++ compiler/prog_data.m 28 Nov 2007 06:52:42 -0000
@@ -626,6 +626,19 @@
%-----------------------------------------------------------------------------%
%
+% Stuff for the `require_feature_set' pragma
+%
+
+:- type required_feature
+ ---> reqf_concurrency
+ ; reqf_single_prec_float
+ ; reqf_double_prec_float
+ ; reqf_memo
+ ; reqf_parallel_conj
+ ; reqf_trailing.
+
+%-----------------------------------------------------------------------------%
+%
% Type classes
%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.129
diff -u -r1.129 prog_io_pragma.m
--- compiler/prog_io_pragma.m 16 Nov 2007 03:44:52 -0000 1.129
+++ compiler/prog_io_pragma.m 29 Nov 2007 02:32:33 -0000
@@ -1122,6 +1122,47 @@
parse_simple_pragma(ModuleName, "mode_check_clauses", MakePragma,
PragmaTerms, ErrorTerm, Result).
+parse_pragma_type(_ModuleName, "require_feature_set", PragmaTerms, ErrorTerm,
+ _VarSet, Result) :-
+ ( PragmaTerms = [FeatureListTerm] ->
+ convert_maybe_list(FeatureListTerm, parse_required_feature,
+ "not a feature", MaybeFeatureList),
+ (
+ MaybeFeatureList = ok1(FeatureList),
+ ConflictingFeatures = [
+ reqf_single_prec_float - reqf_double_prec_float,
+ reqf_parallel_conj - reqf_trailing
+ ],
+ (
+ list.member(ConflictA - ConflictB, ConflictingFeatures),
+ list.member(ConflictA, FeatureList),
+ list.member(ConflictB, FeatureList)
+ ->
+ Msg = "conflicting features in feature set",
+ Result = error1([Msg - FeatureListTerm])
+ ;
+ (
+ FeatureList = [],
+ Item = item_nothing(no)
+ ;
+ FeatureList = [_ | _],
+ FeatureSet = set.from_list(FeatureList),
+ Pragma = pragma_require_feature_set(FeatureSet),
+ Item = item_pragma(user, Pragma)
+ ),
+ Result = ok1(Item)
+ )
+ ;
+ MaybeFeatureList = error1(Errors),
+ Result = error1(Errors)
+ )
+ ;
+ Msg = "syntax error in `:- pragma require_feature_set' declaration",
+ Result = error1([Msg - ErrorTerm])
+ ).
+
+%----------------------------------------------------------------------------%
+
:- pred parse_foreign_decl_is_local(term::in, foreign_decl_is_local::out)
is semidet.
@@ -1672,7 +1713,7 @@
PredAndArityTerm, PredAndArityTerm, NameArityResult),
(
NameArityResult = ok2(PredName, Arity),
- call(MakePragma, PredName, Arity, Pragma),
+ MakePragma(PredName, Arity, Pragma),
Result = ok1(item_pragma(user, Pragma))
;
NameArityResult = error2(Errors),
@@ -2454,9 +2495,11 @@
(
PredAndModesResult = ok2(PredName - PredOrFunc, Modes),
list.length(Modes, Arity0),
- ( PredOrFunc = pf_function ->
+ (
+ PredOrFunc = pf_function,
Arity = Arity0 - 1
;
+ PredOrFunc = pf_predicate,
Arity = Arity0
),
Result = ok1(arity_or_modes(PredName, Arity, yes(PredOrFunc),
@@ -2549,7 +2592,7 @@
Functor = term.atom("[|]"),
Args = [Term, RestTerm]
->
- ( call(Pred, Term, Element) ->
+ ( Pred(Term, Element) ->
convert_list(RestTerm, Pred, UnrecognizedMsg, RestResult),
(
RestResult = ok1(List0),
@@ -2589,7 +2632,7 @@
Functor = term.atom("[|]"),
Args = [Term, RestTerm]
->
- ( call(Pred, Term, ElementResult) ->
+ ( Pred(Term, ElementResult) ->
(
ElementResult = ok1(Element),
convert_maybe_list(RestTerm, Pred, UnrecognizedMsg,
@@ -2686,6 +2729,26 @@
%-----------------------------------------------------------------------------%
+:- pred parse_required_feature(term::in,
+ maybe1(required_feature)::out) is semidet.
+
+parse_required_feature(ReqFeatureTerm, Result) :-
+ ReqFeatureTerm = term.functor(term.atom(Functor), [], _),
+ string_to_required_feature(Functor, ReqFeature),
+ Result = ok1(ReqFeature).
+
+:- pred string_to_required_feature(string::in, required_feature::out)
+ is semidet.
+
+string_to_required_feature("concurrency", reqf_concurrency).
+string_to_required_feature("single_prec_float", reqf_single_prec_float).
+string_to_required_feature("double_prec_float", reqf_double_prec_float).
+string_to_required_feature("memo", reqf_memo).
+string_to_required_feature("parallel_conj", reqf_parallel_conj).
+string_to_required_feature("trailing", reqf_trailing).
+
+%-----------------------------------------------------------------------------%
+
:- func this_file = string.
this_file = "prog_io_pragma.m".
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.29
diff -u -r1.29 prog_item.m
--- compiler/prog_item.m 20 Aug 2007 03:36:04 -0000 1.29
+++ compiler/prog_item.m 28 Nov 2007 07:29:36 -0000
@@ -662,7 +662,7 @@
reuse_headvars :: prog_vars,
reuse_headvartypes :: list(mer_type),
reuse_description :: maybe(structure_reuse_domain)
- ).
+ )
% After reuse analysis, the compiler generates structure reuse
% pragmas to be stored in and read from optimization interface
% files.
@@ -672,6 +672,10 @@
% The last sym_name (reuse_optimised_name) stores the name of the
% optimised version of the exported predicate.
+ ; pragma_require_feature_set(
+ rfs_feature_set :: set(required_feature)
+ ).
+
:- inst pragma_type_spec == bound(pragma_type_spec(ground, ground, ground,
ground, ground, ground, ground, ground)).
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.60
diff -u -r1.60 recompilation.version.m
--- compiler/recompilation.version.m 20 Aug 2007 03:36:05 -0000 1.60
+++ compiler/recompilation.version.m 29 Nov 2007 01:35:10 -0000
@@ -622,6 +622,7 @@
is_pred_pragma(pragma_does_not_terminate(Name, Arity), yes(no - Name / Arity)).
is_pred_pragma(pragma_check_termination(Name, Arity), yes(no - Name / Arity)).
is_pred_pragma(pragma_mode_check_clauses(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(pragma_require_feature_set(_), no).
% XXX This is a bit brittle (need to be careful with term.contexts).
% For example, it won't work for clauses.
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.141
diff -u -r1.141 table_gen.m
--- compiler/table_gen.m 23 Nov 2007 07:35:26 -0000 1.141
+++ compiler/table_gen.m 29 Nov 2007 05:09:27 -0000
@@ -328,12 +328,13 @@
table_gen_transform_proc_if_possible(EvalMethod, PredId, ProcId,
!ProcInfo, !PredInfo, !ModuleInfo, !GenMap, !Specs) :-
module_info_get_globals(!.ModuleInfo, Globals),
- globals.get_target(Globals, Target),
- globals.get_gc_method(Globals, GC_Method),
- ( Target = target_c, GC_Method \= gc_accurate ->
+ current_grade_supports_tabling(Globals, IsTablingSupported),
+ (
+ IsTablingSupported = yes,
table_gen_transform_proc(EvalMethod, PredId, ProcId,
!ProcInfo, !PredInfo, !ModuleInfo, !GenMap)
;
+ IsTablingSupported = no,
pred_info_get_context(!.PredInfo, Context),
ProcPieces = describe_one_proc_name(!.ModuleInfo,
should_module_qualify, proc(PredId, ProcId)),
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.413
diff -u -r1.413 reference_manual.texi
--- doc/reference_manual.texi 16 Nov 2007 03:44:53 -0000 1.413
+++ doc/reference_manual.texi 30 Nov 2007 03:15:52 -0000
@@ -9957,6 +9957,9 @@
calculated results and detecting or avoiding
certain kinds of infinite loops.
* Termination analysis:: Support for automatic proofs of termination.
+* Feature sets:: Support for checking that optional features of
+ the implementation are supported at compile
+ time.
@end menu
@c XXX The `reserved tag' pragma is not documented because it is intended to
@@ -10420,6 +10423,73 @@
@c The compiler includes a structure reuse analysis system.
@c
+ at node Feature sets
+ at section Feature sets
+
+The University of Melbourne Mercury implementation supports a number
+of optional compilation model features,
+such as @ref{Trailing} or @ref{Tabled evaluation},
+Feature sets allow the programmer to assert that a module requires
+the presence of one or more optional features in the compilation model.
+These assertions can be made use a @samp{pragma require_feature_set}
+declaration.
+
+The @samp{require_feature_set} pragma declaration has the following form:
+ at example
+:- pragma require_feature_set(@var{Features}).
+ at end example
+
+where @samp{Features} is a (possibly empty) list of features.
+
+The supported features are:
+ at table @asis
+
+ at item @samp{concurrency}
+This specifies that the compilation model must
+support concurrent execution of multiple threads.
+
+ at item @samp{single_prec_float}
+This specifies that the compilation model must use
+single precision floats.
+This feature cannot be specified together with the @samp{double_prec_float}
+feature.
+
+ at item @samp{double_prec_float},
+This feature specifies that the compilation model must use double precision
+floats.
+This feature cannot be specified together with the @samp{single_prec_float}
+feature.
+
+ at item @samp{memo}
+This feature specifies that the compilation model must support memoisation
+(see @ref{Tabled evaluation}).
+
+ at item @samp{parallel_conj}
+This feature specifies that the compilation model must suppport
+parallel execution of conjunctions.
+This feature cannot be specified together with the @samp{trailing}
+feature.
+
+ at item @samp{trailing}
+This feature specifies that the compilation model must support
+trailing, see @ref{Trailing}.
+This feature cannot be specified together with the @samp{parallel_conj}
+feature.
+
+ at end table
+
+When a module containing a @samp{pragma require_feature_set} declaration
+is compiled, the implementation checks to see that the specified features
+are supported by the compilation model.
+It emits an error if they are not.
+
+A @samp{pragma require_feature_set} may only occur in the implementation
+section of a module.
+
+If a module contains multiple @samp{pragma require_feature_set} declarations
+then the implementation should emit an error if any of them specifies a
+feature that is not supported by the compilation model.
+
@node Bibliography
@chapter Bibliography
Index: tests/invalid/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mercury.options,v
retrieving revision 1.28
diff -u -r1.28 Mercury.options
--- tests/invalid/Mercury.options 14 Nov 2007 04:00:06 -0000 1.28
+++ tests/invalid/Mercury.options 30 Nov 2007 03:32:17 -0000
@@ -129,6 +129,9 @@
MCFLAGS-polymorphic_unification = --verbose-error-messages
MCFLAGS-predmode = --verbose-error-messages
MCFLAGS-prog_io_erroneous = --verbose-error-messages
+# We compile test_feature_set in hl.gc because that grade is incompatible
+# with the features in the test require_feature_set pragma.
+MCFLAGS-test_feature_set = --grade hl.gc --verbose-error-messages
MCFLAGS-tricky_assert1 = --verbose-error-messages
MCFLAGS-typeclass_constraint_extra_var = --verbose-error-messages
MCFLAGS-typeclass_missing_det_3 = --verbose-error-messages
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.226
diff -u -r1.226 Mmakefile
--- tests/invalid/Mmakefile 14 Nov 2007 04:00:06 -0000 1.226
+++ tests/invalid/Mmakefile 30 Nov 2007 03:30:27 -0000
@@ -62,6 +62,7 @@
circ_type5 \
complex_constraint_err \
conflicting_tabling_pragmas \
+ conflicting_fs \
constrained_poly_insts \
constructor_warning \
cyclic_typeclass \
@@ -180,6 +181,7 @@
state_vars_test5 \
tc_err1 \
tc_err2 \
+ test_feature_set \
test_may_duplicate \
tricky_assert1 \
type_inf_loop \
Index: tests/invalid/conflicting_fs.err_exp
===================================================================
RCS file: tests/invalid/conflicting_fs.err_exp
diff -N tests/invalid/conflicting_fs.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/conflicting_fs.err_exp 30 Nov 2007 03:22:37 -0000
@@ -0,0 +1,2 @@
+conflicting_fs.m:008: Error: conflicting features in feature set: [single_prec_float, double_prec_float].
+conflicting_fs.m:009: Error: conflicting features in feature set: [trailing, parallel_conj].
Index: tests/invalid/conflicting_fs.m
===================================================================
RCS file: tests/invalid/conflicting_fs.m
diff -N tests/invalid/conflicting_fs.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/conflicting_fs.m 30 Nov 2007 03:22:37 -0000
@@ -0,0 +1,9 @@
+:- module conflicting_fs.
+:- interface.
+
+:- type foo ---> foo.
+
+:- implementation.
+
+:- pragma require_feature_set([single_prec_float, double_prec_float]).
+:- pragma require_feature_set([trailing, parallel_conj]).
Index: tests/invalid/test_feature_set.err_exp
===================================================================
RCS file: tests/invalid/test_feature_set.err_exp
diff -N tests/invalid/test_feature_set.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/test_feature_set.err_exp 30 Nov 2007 03:29:58 -0000
@@ -0,0 +1,12 @@
+test_feature_set.m:008: Error: this module must be compiled in a grade that
+test_feature_set.m:008: supports concurrent execution.
+test_feature_set.m:008: Error: this module must be compiled in a grade that
+test_feature_set.m:008: supports memoisation.
+test_feature_set.m:008: Error: this module must be compiled in a grade that
+test_feature_set.m:008: supports trailing.
+test_feature_set.m:008: Grades that support trailing contain the grade
+test_feature_set.m:008: modifier `tr'.
+test_feature_set.m:008: Error: this module must be compiled in a grade that
+test_feature_set.m:008: uses single precision floats.
+test_feature_set.m:008: Grades that use single precision floats contain the
+test_feature_set.m:008: grade modifier `spf'.
Index: tests/invalid/test_feature_set.m
===================================================================
RCS file: tests/invalid/test_feature_set.m
diff -N tests/invalid/test_feature_set.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/test_feature_set.m 30 Nov 2007 03:29:58 -0000
@@ -0,0 +1,8 @@
+:- module test_feature_set.
+:- interface.
+
+:- type foo ---> foo.
+
+:- implementation.
+
+:- pragma require_feature_set([trailing, single_prec_float, concurrency, memo]).
--------------------------------------------------------------------------
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