[m-rev.] For review: add support for constraint_store solver type attribute
Ralph Becket
rafe at cs.mu.OZ.AU
Tue Nov 22 18:14:43 AEDT 2005
Estimated hours taken: 3
Branches: main
Add support for `constraint_store is mutable(...)' or
`constraint_store is [mutable(...), ...]' attributes on solver type
definitions.
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/module_qual.m:
compiler/prog_data.m:
The solver_type_details structure now contains the list of
mutable declatations given in the constraint_store attribute
(empty if this attribute was not provided).
compiler/make_hlds_passes.m:
Process the constraint_store mutable items for solver types.
compiler/mercury_to_mercury.m:
Output the constraint_store attribute value for solver types
if present.
compiler/prog_io.m:
Parse the new attribute.
doc/reference_manual.texi:
Document the addition of constraint_store solver type attributes.
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.55
diff -u -r1.55 equiv_type.m
--- compiler/equiv_type.m 17 Nov 2005 15:57:09 -0000 1.55
+++ compiler/equiv_type.m 21 Nov 2005 06:28:14 -0000
@@ -451,12 +451,12 @@
solver_type(SolverTypeDetails, MaybeUserEqComp),
ContainsCirc, !VarSet, !Info) :-
SolverTypeDetails0 = solver_type_details(RepresentationType0, InitPred,
- GroundInst, AnyInst),
+ GroundInst, AnyInst, MutableItems),
replace_in_type_2(EqvMap, [TypeCtor],
RepresentationType0, RepresentationType,
_, ContainsCirc, !VarSet, !Info),
SolverTypeDetails = solver_type_details(RepresentationType, InitPred,
- GroundInst, AnyInst).
+ GroundInst, AnyInst, MutableItems).
%-----------------------------------------------------------------------------%
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.24
diff -u -r1.24 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 17 Nov 2005 15:57:09 -0000 1.24
+++ compiler/equiv_type_hlds.m 21 Nov 2005 06:55:57 -0000
@@ -155,11 +155,11 @@
;
Body0 = solver_type(SolverTypeDetails0, UserEq),
SolverTypeDetails0 = solver_type_details(RepnType0, InitPred,
- GroundInst, AnyInst),
+ GroundInst, AnyInst, MutableItems),
equiv_type__replace_in_type(EqvMap, RepnType0, RepnType, _,
TVarSet0, TVarSet, EquivTypeInfo0, EquivTypeInfo),
SolverTypeDetails = solver_type_details(RepnType, InitPred,
- GroundInst, AnyInst),
+ GroundInst, AnyInst, MutableItems),
Body = solver_type(SolverTypeDetails, UserEq)
;
Body0 = abstract_type(_),
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.22
diff -u -r1.22 make_hlds_passes.m
--- compiler/make_hlds_passes.m 11 Nov 2005 05:06:49 -0000 1.22
+++ compiler/make_hlds_passes.m 22 Nov 2005 05:53:34 -0000
@@ -332,7 +332,9 @@
TypeDefn = solver_type(SolverTypeDetails, _MaybeUserEqComp)
->
add_solver_type_decl_items(TVarSet, SymName, TypeParams,
- SolverTypeDetails, Context, !Status, !ModuleInfo, !IO)
+ SolverTypeDetails, Context, !Status, !ModuleInfo, !IO),
+ add_solver_type_mutable_items_pass_1(SolverTypeDetails ^ mutable_items,
+ Context, !Status, !ModuleInfo, !IO)
;
true
).
@@ -496,6 +498,18 @@
true
).
+
+:- pred add_solver_type_mutable_items_pass_1(list(item)::in, prog_context::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+add_solver_type_mutable_items_pass_1([], _Context, !Status, !ModuleInfo, !IO).
+add_solver_type_mutable_items_pass_1([Item | Items], Context, !Status,
+ !ModuleInfo, !IO) :-
+ add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, _, !IO),
+ add_solver_type_mutable_items_pass_1(Items, Context, !Status, !ModuleInfo,
+ !IO).
+
%-----------------------------------------------------------------------------%
:- pred add_item_decl_pass_2(item::in, prog_context::in, item_status::in,
@@ -512,7 +526,16 @@
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
Item = type_defn(VarSet, Name, Args, TypeDefn, Cond),
module_add_type_defn(VarSet, Name, Args, TypeDefn, Cond, Context,
- !.Status, !ModuleInfo, !IO).
+ !.Status, !ModuleInfo, !IO),
+ (
+ TypeDefn = solver_type(SolverTypeDetails, _MaybeUserEqComp)
+ ->
+ add_solver_type_mutable_items_pass_2(SolverTypeDetails ^ mutable_items,
+ Context, !Status, !ModuleInfo, !IO)
+ ;
+ true
+ ).
+
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
Item = pragma(Origin, Pragma),
add_pragma(Origin, Pragma, Context, !Status, !ModuleInfo, !IO).
@@ -655,6 +678,18 @@
true
).
+
+:- pred add_solver_type_mutable_items_pass_2(list(item)::in, prog_context::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+add_solver_type_mutable_items_pass_2([], _Context, !Status, !ModuleInfo, !IO).
+add_solver_type_mutable_items_pass_2([Item | Items], Context, !Status,
+ !ModuleInfo, !IO) :-
+ add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO),
+ add_solver_type_mutable_items_pass_2(Items, Context, !Status, !ModuleInfo,
+ !IO).
+
% Check to see if there is a valid foreign_name attribute for this
% backend. If so, use it as the name of the global variable in
% the target code, otherwise take the Mercury name for the mutable
@@ -771,6 +806,8 @@
status_defined_in_this_module(!.Status, yes)
->
add_solver_type_clause_items(SymName, TypeParams, SolverTypeDetails,
+ !Status, Context, !ModuleInfo, !QualInfo, !IO),
+ add_solver_type_mutable_items_clauses(SolverTypeDetails^mutable_items,
!Status, Context, !ModuleInfo, !QualInfo, !IO)
;
true
@@ -1249,6 +1286,20 @@
true
).
+
+:- pred add_solver_type_mutable_items_clauses(list(item)::in,
+ import_status::in, import_status::out, prog_context::in,
+ module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io::di, io::uo) is det.
+
+add_solver_type_mutable_items_clauses([], !Status, _Context,
+ !ModuleInfo, !QualInfo, !IO).
+add_solver_type_mutable_items_clauses([Item | Items], !Status, Context,
+ !ModuleInfo, !QualInfo, !IO) :-
+ add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !IO),
+ add_solver_type_mutable_items_clauses(Items, !Status, Context,
+ !ModuleInfo, !QualInfo, !IO).
+
% If a module_defn updates the import_status, return the new status
% and whether uses of the following items must be module qualified,
% otherwise fail.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.274
diff -u -r1.274 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 8 Nov 2005 08:14:52 -0000 1.274
+++ compiler/mercury_to_mercury.m 21 Nov 2005 06:39:54 -0000
@@ -1797,8 +1797,8 @@
solver_type_details::in, io::di, io::uo) is det.
mercury_output_solver_type_details(TVarSet,
- solver_type_details(RepresentationType, InitPred, GroundInst, AnyInst),
- !IO) :-
+ solver_type_details(RepresentationType, InitPred, GroundInst, AnyInst,
+ MutableItems), !IO) :-
io__write_string("representation is ", !IO),
mercury_output_type(TVarSet, no, RepresentationType, !IO),
io__write_string(",\n\t\tinitialisation is ", !IO),
@@ -1807,7 +1807,22 @@
io__write_string(",\n\t\tground is ", !IO),
mercury_output_inst(GroundInst, EmptyInstVarSet, !IO),
io__write_string(",\n\t\tany is ", !IO),
- mercury_output_inst(AnyInst, EmptyInstVarSet, !IO).
+ mercury_output_inst(AnyInst, EmptyInstVarSet, !IO),
+ (
+ MutableItems = []
+ ;
+ MutableItems = [_ | _],
+ io__write_string(",\n\t\tconstraint_store is [\n\t\t\t", !IO),
+ io__write_list(MutableItems, ",\n\t\t\t", mercury_output_item_2,
+ !IO),
+ io__write_string("\n\t\t]", !IO)
+ ).
+
+:- pred mercury_output_item_2(item::in, io::di, io::uo) is det.
+
+mercury_output_item_2(Item, !IO) :-
+ term__context_init(DummyContext),
+ mercury_output_item(Item, DummyContext, !IO).
:- pred mercury_output_ctors(list(constructor)::in, tvarset::in,
io::di, io::uo) is det.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.119
diff -u -r1.119 module_qual.m
--- compiler/module_qual.m 8 Nov 2005 08:14:53 -0000 1.119
+++ compiler/module_qual.m 21 Nov 2005 06:40:29 -0000
@@ -792,12 +792,12 @@
solver_type(SolverTypeDetails, MaybeUserEqComp),
!Info, !IO) :-
SolverTypeDetails0 = solver_type_details(RepnType0, InitPred,
- GroundInst0, AnyInst0),
+ GroundInst0, AnyInst0, MutableItems),
qualify_type(RepnType0, RepnType, !Info, !IO),
qualify_inst(GroundInst0, GroundInst, !Info, !IO),
qualify_inst(AnyInst0, AnyInst, !Info, !IO),
SolverTypeDetails = solver_type_details(RepnType, InitPred,
- GroundInst, AnyInst).
+ GroundInst, AnyInst, MutableItems).
:- pred qualify_constructors(list(constructor)::in, list(constructor)::out,
mq_info::in, mq_info::out, io::di, io::uo) is det.
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.148
diff -u -r1.148 prog_data.m
--- compiler/prog_data.m 17 Nov 2005 04:38:44 -0000 1.148
+++ compiler/prog_data.m 21 Nov 2005 05:07:18 -0000
@@ -1557,13 +1557,16 @@
% initialisation is <<init pred name>>,
% ground is <<ground inst>>,
% any is <<any inst>>,
+ % constraint_store is <<mutable(...) or [mutable(...), ...]>>
%
:- type solver_type_details
---> solver_type_details(
representation_type :: mer_type,
init_pred :: init_pred,
ground_inst :: mer_inst,
- any_inst :: mer_inst
+ any_inst :: mer_inst,
+ mutable_items :: list(item)
).
% An init_pred specifies the name of an impure user-defined predicate
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.257
diff -u -r1.257 prog_io.m
--- compiler/prog_io.m 28 Oct 2005 02:10:29 -0000 1.257
+++ compiler/prog_io.m 21 Nov 2005 06:53:31 -0000
@@ -2024,6 +2024,9 @@
parse_where_attribute(parse_where_is("any",
parse_where_inst_is(ModuleName)),
AnyIsResult, !MaybeTerm),
+ parse_where_attribute(parse_where_is("constraint_store",
+ parse_where_mutable_is(ModuleName)),
+ CStoreIsResult, !MaybeTerm),
parse_where_attribute(parse_where_is("equality",
parse_where_pred_is(ModuleName)),
EqualityIsResult, !MaybeTerm),
@@ -2040,6 +2043,7 @@
InitialisationIsResult,
GroundIsResult,
AnyIsResult,
+ CStoreIsResult,
EqualityIsResult,
ComparisonIsResult,
WhereEndResult,
@@ -2154,6 +2158,43 @@
parse_where_type_is(_ModuleName, Term) = Result :-
prog_io_util__parse_type(Term, Result).
+:- func parse_where_mutable_is(module_name, term) = maybe1(list(item)).
+
+parse_where_mutable_is(ModuleName, Term) = Result :-
+ (
+ Term = term__functor(term__atom("mutable"), _Args, _Ctxt)
+ ->
+ parse_mutable_decl_term(ModuleName, Term, Result0),
+ (
+ Result0 = ok(Mutable),
+ Result = ok([Mutable])
+ ;
+ Result0 = error(Err, Trm),
+ Result = error(Err, Trm)
+ )
+ ;
+ list_term_to_term_list(Term, Terms)
+ ->
+ map_parser(parse_mutable_decl_term(ModuleName), Terms, Result)
+ ;
+ Result = error("expected a mutable declaration or a list of " ++
+ "mutable declarations", Term)
+ ).
+
+:- pred parse_mutable_decl_term(module_name::in, term::in, maybe1(item)::out)
+ is det.
+
+parse_mutable_decl_term(ModuleName, Term, Result) :-
+ (
+ Term = term__functor(term__atom("mutable"), Args, _Ctxt),
+ varset__init(VarSet),
+ parse_mutable_decl(ModuleName, VarSet, Args, Result0)
+ ->
+ Result = Result0
+ ;
+ Result = error("expected a mutable declaration", Term)
+ ).
+
:- pred parse_where_end(maybe(term)::in, maybe1(maybe(unit))::out) is det.
parse_where_end(no, ok(yes(unit))).
@@ -2167,6 +2208,7 @@
maybe1(maybe(init_pred)),
maybe1(maybe(mer_inst)),
maybe1(maybe(mer_inst)),
+ maybe1(maybe(list(item))),
maybe1(maybe(equality_pred)),
maybe1(maybe(comparison_pred)),
maybe1(maybe(unit)),
@@ -2180,6 +2222,7 @@
InitialisationIsResult,
GroundIsResult,
AnyIsResult,
+ CStoreIsResult,
EqualityIsResult,
ComparisonIsResult,
WhereEndResult,
@@ -2213,6 +2256,10 @@
->
Result = error(String, Term)
;
+ CStoreIsResult = error(String, Term)
+ ->
+ Result = error(String, Term)
+ ;
WhereEndResult = error(String, Term)
->
Result = error(String, Term)
@@ -2227,7 +2274,8 @@
GroundIsResult = ok(no),
AnyIsResult = ok(no),
EqualityIsResult = ok(no),
- ComparisonIsResult = ok(no)
+ ComparisonIsResult = ok(no),
+ CStoreIsResult = ok(no)
->
Result = ok(no, yes(abstract_noncanonical_type(IsSolverType)))
;
@@ -2243,7 +2291,8 @@
GroundIsResult = ok(MaybeGroundInst),
AnyIsResult = ok(MaybeAnyInst),
EqualityIsResult = ok(MaybeEqPred),
- ComparisonIsResult = ok(MaybeCmpPred)
+ ComparisonIsResult = ok(MaybeCmpPred),
+ CStoreIsResult = ok(MaybeMutableItems)
->
(
MaybeGroundInst = yes(GroundInst)
@@ -2257,8 +2306,14 @@
MaybeAnyInst = no,
AnyInst = ground_inst
),
+ (
+ MaybeMutableItems = yes(MutableItems)
+ ;
+ MaybeMutableItems = no,
+ MutableItems = []
+ ),
MaybeSolverTypeDetails = yes(solver_type_details(
- RepnType, InitPred, GroundInst, AnyInst)),
+ RepnType, InitPred, GroundInst, AnyInst, MutableItems)),
(
MaybeEqPred = no,
MaybeCmpPred = no
@@ -2290,6 +2345,7 @@
; InitialisationIsResult = ok(yes(_))
; GroundIsResult = ok(yes(_))
; AnyIsResult = ok(yes(_))
+ ; CStoreIsResult = ok(yes(_))
)
->
Result = error("solver type attribute given for " ++
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.338
diff -u -r1.338 reference_manual.texi
--- doc/reference_manual.texi 18 Nov 2005 06:13:38 -0000 1.338
+++ doc/reference_manual.texi 22 Nov 2005 07:07:57 -0000
@@ -2226,19 +2226,24 @@
@example
:- solver type solver_type
- where representation is representation_type,
- initialisation is initialisation_pred,
- ground is ground_inst,
- any is any_inst,
- equality is equality_pred,
- comparison is comparison_pred.
+ where representation is representation_type,
+ initialisation is initialisation_pred,
+ ground is ground_inst,
+ any is any_inst,
+ constraint_store is mutable_decls,
+ equality is equality_pred,
+ comparison is comparison_pred.
@end example
The @samp{representation} and @samp{initialisation} attributes are mandatory
(@samp{initialization} is allowed as a synonym for @samp{initialisation}),
- at samp{ground_inst} and @samp{any_inst} default to @samp{ground}, the equality
-and comparison attributes are optional (although a solver type without equality
-would not be very useful), and attributes must appear in the order shown.
+ at samp{ground_inst} and @samp{any_inst} default to @samp{ground},
+ at samp{mutable_decls} is either a single mutable declaration
+(@pxref{Module-local mutable variables})
+or a comma separated list of mutable declarations in brackets,
+the equality and comparison attributes are optional (although a solver type
+without equality would not be very useful), and attributes must appear in the
+order shown.
The @code{representation_type} is the type used to implement the
@code{solver_type}. A two-tier scheme of this kind is necessary for a
--------------------------------------------------------------------------
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