[m-rev.] for review: error messages for mutables
Julien Fischer
juliensf at cs.mu.OZ.AU
Sun Sep 11 16:48:37 AEST 2005
For review by Ralph.
Estimated hours taken: 12
Branches: main
Improve the error checking for mutable declarations.
Fix a bug with solver types and sub-modules reported by Peter Hawkins.
Workaround a bug with mutable declarations and sub-modules. Currently,
the compiler aborts if there is a mutable declaration in the parent module.
With this change mutable declarations will not be visible in child modules.
XXX This is not correct since they should be visible, but this can be fixed
as a separate change.
compiler/prog_data.m:
Extend the item_origin type with information about what
source-to-source transformations are responsible for compiler
introduced items. We need this information for error checking mutable
declarations. It also provides an additional layer of sanity checking
in the parse tree.
Add origin fields to the clause and initialise items, since they can
both now be introduced by source-to-source transformations.
compiler/prog_io.m:
compiler/prog_io_dcg.m:
compiler/prog_io_typeclass.m:
Conform to the above change.
compiler/make_hlds_passes.m:
Don't issue spurious errors about initialise declarations that were
introduced by the transformation for mutable declarations. Abort if
invalid initialise declarations were introduced by other compiler
passes since this indicates a bug in the compiler.
Check if mutable declarations occur in the interface of a module and
emit an error if they do.
Don't generate initialise items and foreign code from a mutable
declaration unless we are in the defining module for the mutable
declaration.
Don't generate foreign_procs for solver types *unless* we are in the
defining module. Doing otherwise breaks the compiler when using
solver types and sub-modules.
Fix the formatting of an error message concerning initialise decls.
s/foreign_code/foreign_proc/ in a spot.
compiler/add_solver.m:
compiler/mercury_to_mercury.m:
compiler/recompilation.check.m:
compiler/recompilation.version.m:
compiler/add_class.m:
compiler/add_pragma.m:
compiler/state_var.m:
Conform to the above changes.
compiler/modules.m:
Handle mutable declarations in private interfaces.
Clean up some code related to foreign_import_module decls.
Conform to the changes in prog_data.m.
compiler/prog_util.m:
Shift the functions for mutable access predicates and variables to
this module. The code that generates interface files also needs to be
able to access them.
compiler/module_qual.m:
Conform to the above changes.
Fix a bug where the context in the mq_info structure was not being
updated. This caused error messages for mutable declarations that
contain undefined types or insts to have the wrong context.
compiler/hlds_data.m:
Fix a typo.
vim/syntax.m:
Highlight `mutable' and `untrailed' appropriately.
tests/hard_coded/sub-modules/Mmakefile:
tests/hard_coded/sub-modules/ts.m:
tests/hard_coded/sub-modules/ts.tsub.m:
tests/hard_coded/sub-modules/ts.exp:
Add Peter Hawkin's test case for the bug with solver
types and sub-modules.
tests/invalid/Mmakefile:
tests/invalid/bad_mutable.m:
tests/invalid/bad_mutable.err_exp:
Add a test for the various sorts of errors that can occur with mutable
declarations.
Julien.
Index: compiler/add_class.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_class.m,v
retrieving revision 1.2
diff -u -r1.2 add_class.m
--- compiler/add_class.m 30 Aug 2005 04:11:45 -0000 1.2
+++ compiler/add_class.m 6 Sep 2005 07:12:02 -0000
@@ -496,7 +496,7 @@
produce_instance_method_clause(PredOrFunc, Context, Status, InstanceClause,
!ModuleInfo, !QualInfo, !ClausesInfo, !IO) :-
(
- InstanceClause = clause(CVarSet, PredOrFunc, PredName,
+ InstanceClause = clause(_Origin, CVarSet, PredOrFunc, PredName,
HeadTerms0, Body)
->
( illegal_state_var_func_result(PredOrFunc, HeadTerms0, StateVar) ->
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.5
diff -u -r1.5 add_pragma.m
--- compiler/add_pragma.m 5 Sep 2005 03:45:54 -0000 1.5
+++ compiler/add_pragma.m 11 Sep 2005 06:12:52 -0000
@@ -166,7 +166,7 @@
% We don't report this as an error as it just clutters up
% the compiler output - the *real* error is whatever caused
% the compiler to create this pragma.
- Origin = compiler
+ Origin = compiler(_)
)
;
Allowed = yes
@@ -387,7 +387,13 @@
"`:- pragma export' declaration", !IO),
module_info_incr_errors(!ModuleInfo)
;
- Origin = compiler
+ Origin = compiler(Details),
+ (
+ ( Details = initialise_decl ; Details = mutable_decl )
+ ;
+ ( Details = solver_type ; Details = foreign_imports ),
+ unexpected(this_file, "Bad introduced export pragma.")
+ )
)
)
; (
@@ -396,7 +402,13 @@
"`:- pragma export' declaration", !IO),
module_info_incr_errors(!ModuleInfo)
;
- Origin = compiler
+ Origin = compiler(Details),
+ (
+ ( Details = initialise_decl ; Details = mutable_decl )
+ ;
+ ( Details = solver_type ; Details = foreign_imports ),
+ unexpected(this_file, "Bad introduced export pragma.")
+ )
)
).
@@ -2098,3 +2110,13 @@
mode_get_insts_semidet(ModuleInfo, Mode1, Inst1, Inst2),
mode_get_insts_semidet(ModuleInfo, Mode2, Inst1, Inst2),
mode_list_matches(Modes1, Modes2, ModuleInfo).
+
+%----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "add_pragma.m".
+
+%----------------------------------------------------------------------------%
+:- end_module add_pragma.
+%----------------------------------------------------------------------------%
Index: compiler/add_solver.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_solver.m,v
retrieving revision 1.2
diff -u -r1.2 add_solver.m
--- compiler/add_solver.m 5 Sep 2005 03:45:54 -0000 1.2
+++ compiler/add_solver.m 5 Sep 2005 14:25:51 -0000
@@ -207,7 +207,7 @@
VarSet,
Impl
),
- ToGroundRepnItem = pragma(compiler, ToGroundRepnForeignProc),
+ ToGroundRepnItem = pragma(compiler(solver_type), ToGroundRepnForeignProc),
add_item_clause(ToGroundRepnItem, !Status, Context, !ModuleInfo, !QualInfo,
!IO),
@@ -225,7 +225,7 @@
VarSet,
Impl
),
- ToAnyRepnItem = pragma(compiler, ToAnyRepnForeignProc),
+ ToAnyRepnItem = pragma(compiler(solver_type), ToAnyRepnForeignProc),
add_item_clause(ToAnyRepnItem, !Status, Context, !ModuleInfo, !QualInfo,
!IO),
@@ -243,7 +243,8 @@
VarSet,
Impl
),
- FromGroundRepnItem = pragma(compiler, FromGroundRepnForeignProc),
+ FromGroundRepnItem = pragma(compiler(solver_type),
+ FromGroundRepnForeignProc),
add_item_clause(FromGroundRepnItem, !Status, Context, !ModuleInfo,
!QualInfo, !IO),
@@ -261,6 +262,6 @@
VarSet,
Impl
),
- FromAnyRepnItem = pragma(compiler, FromAnyRepnForeignProc),
+ FromAnyRepnItem = pragma(compiler(solver_type), FromAnyRepnForeignProc),
add_item_clause(FromAnyRepnItem, !Status, Context, !ModuleInfo, !QualInfo,
!IO).
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.94
diff -u -r1.94 hlds_data.m
--- compiler/hlds_data.m 23 Apr 2005 06:29:46 -0000 1.94
+++ compiler/hlds_data.m 7 Sep 2005 05:05:14 -0000
@@ -240,7 +240,7 @@
; base_typeclass_info_constant(module_name, class_id, string)
% This is how we refer to base_typeclass_info structures
% represented as global data. The first argument is the
- % name of the module containing the instance declration,
+ % name of the module containing the instance declaration,
% the second is the class name and arity, while the
% third is the string which uniquely identifies the
% instance declaration (it is made from the type of
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.6
diff -u -r1.6 make_hlds_passes.m
--- compiler/make_hlds_passes.m 5 Sep 2005 03:45:55 -0000 1.6
+++ compiler/make_hlds_passes.m 11 Sep 2005 06:13:43 -0000
@@ -22,6 +22,8 @@
:- import_module list.
:- import_module term.
+%-----------------------------------------------------------------------------%
+
% When adding an item to the HLDS we need to know both its
% import_status and whether uses of it must be module qualified.
:- type item_status
@@ -90,6 +92,9 @@
import_status::in, prog_context::in, module_info::in,
io::di, io::uo) is det.
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module check_hlds__clause_to_proc.
@@ -126,6 +131,8 @@
:- import_module string.
:- import_module varset.
+%-----------------------------------------------------------------------------%
+
do_parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, ModuleInfo,
QualInfo, InvalidTypes, InvalidModes, !IO) :-
some [!Module] (
@@ -300,7 +307,8 @@
item_status::in, item_status::out, module_info::in, module_info::out,
bool::out, io::di, io::uo) is det.
-add_item_decl_pass_1(clause(_, _, _, _, _), _, !Status, !ModuleInfo, no, !IO).
+add_item_decl_pass_1(clause(_, _, _, _, _, _), _, !Status, !ModuleInfo, no,
+ !IO).
% Skip clauses.
add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !IO) :-
% If this is a solver type then we need to also add the declarations
@@ -431,37 +439,49 @@
Item = instance(_, _, _, _, _,_).
add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !IO) :-
% We add initialise declarations on the second pass.
- Item = initialise(_).
+ Item = initialise(_, _).
add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !IO) :-
% We add the initialise decl and the foreign_decl on the second pass and
- % the foreign_code clauses on the third pass.
+ % the foreign_proc clauses on the third pass.
Item = mutable(Name, Type, _InitValue, Inst, _Attrs),
- module_info_name(!.ModuleInfo, ModuleName),
- VarSet = varset__init,
- InstVarSet = varset__init,
- ExistQVars = [],
- Constraints = constraints([], []),
- IOType = term__functor(term__atom("."), [
- term__functor(term__atom("io"), [], Context),
- term__functor(term__atom("state"), [], Context)], Context),
- GetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
- mutable_get_pred_sym_name(ModuleName, Name),
- [type_and_mode(Type, out_mode(Inst))],
- no /* with_type */, no /* with_inst */, yes(det),
- true /* condition */, (semipure), Constraints),
- add_item_decl_pass_1(GetPredDecl, Context, !Status, !ModuleInfo, _, !IO),
- SetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
- mutable_set_pred_sym_name(ModuleName, Name),
- [type_and_mode(Type, in_mode(Inst))],
- no /* with_type */, no /* with_inst */, yes(det),
- true /* condition */, (impure), Constraints),
- add_item_decl_pass_1(SetPredDecl, Context, !Status, !ModuleInfo, _, !IO),
- InitPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
- mutable_init_pred_sym_name(ModuleName, Name),
- [type_and_mode(IOType, di_mode), type_and_mode(IOType, uo_mode)],
- no /* with_type */, no /* with_inst */, yes(det),
- true /* condition */, (pure), Constraints),
- add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _, !IO).
+ !.Status = item_status(ImportStatus, _),
+ %
+ % XXX This does not work correctly with submodules. The mutable
+ % access predicates should be visible in any child modules.
+ %
+ ( status_defined_in_this_module(ImportStatus, yes) ->
+ module_info_name(!.ModuleInfo, ModuleName),
+ VarSet = varset__init,
+ InstVarSet = varset__init,
+ ExistQVars = [],
+ Constraints = constraints([], []),
+ IOType = term__functor(term__atom("."), [
+ term__functor(term__atom("io"), [], Context),
+ term__functor(term__atom("state"), [], Context)], Context),
+ GetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
+ mutable_get_pred_sym_name(ModuleName, Name),
+ [type_and_mode(Type, out_mode(Inst))],
+ no /* with_type */, no /* with_inst */, yes(det),
+ true /* condition */, (semipure), Constraints),
+ add_item_decl_pass_1(GetPredDecl, Context, !Status, !ModuleInfo, _,
+ !IO),
+ SetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
+ mutable_set_pred_sym_name(ModuleName, Name),
+ [type_and_mode(Type, in_mode(Inst))],
+ no /* with_type */, no /* with_inst */, yes(det),
+ true /* condition */, (impure), Constraints),
+ add_item_decl_pass_1(SetPredDecl, Context, !Status, !ModuleInfo, _,
+ !IO),
+ InitPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
+ mutable_init_pred_sym_name(ModuleName, Name),
+ [type_and_mode(IOType, di_mode), type_and_mode(IOType, uo_mode)],
+ no /* with_type */, no /* with_inst */, yes(det),
+ true /* condition */, (pure), Constraints),
+ add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _,
+ !IO)
+ ;
+ true
+ ).
%-----------------------------------------------------------------------------%
@@ -512,7 +532,7 @@
add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !IO) :-
Item = promise(_, _, _, _).
add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !IO) :-
- Item = clause(_, _, _, _, _).
+ Item = clause(_, _, _, _, _, _).
add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !IO) :-
Item = inst_defn(_, _, _, _, _).
add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !IO) :-
@@ -535,11 +555,26 @@
module_add_instance_defn(InstanceModuleName, Constraints, Name, Types,
Body, VarSet, BodyStatus, Context, !ModuleInfo, !IO).
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
- Item = initialise(SymName),
+ Item = initialise(Origin, SymName),
!.Status = item_status(ImportStatus, _),
( ImportStatus = exported ->
- error_is_exported(Context, "`initialise' declaration", !IO),
- module_info_incr_errors(!ModuleInfo)
+ (
+ Origin = user,
+ error_is_exported(Context, "`initialise' declaration", !IO),
+ module_info_incr_errors(!ModuleInfo)
+ ;
+ Origin = compiler(Details),
+ (
+ % Ignore the error if this initialise declaration was
+ % introduced because of a mutable declaration.
+ Details = mutable_decl
+ ;
+ ( Details = initialise_decl
+ ; Details = solver_type
+ ; Details = foreign_imports),
+ unexpected(this_file, "Bad introduced intialise declaration.")
+ )
+ )
;
true
),
@@ -553,19 +588,39 @@
%
module_info_new_user_init_pred(SymName, CName, !ModuleInfo),
PragmaExportItem =
- pragma(compiler,
+ pragma(compiler(initialise_decl),
export(SymName, predicate, [di_mode, uo_mode], CName)),
add_item_decl_pass_2(PragmaExportItem, Context, !Status, !ModuleInfo, !IO).
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
Item = mutable(Name, _Type, _InitTerm, _Inst, _MutAttrs),
- module_info_name(!.ModuleInfo, ModuleName),
- InitDecl = initialise(mutable_init_pred_sym_name(ModuleName, Name)),
- add_item_decl_pass_2(InitDecl, Context, !Status, !ModuleInfo, !IO),
- ForeignDecl = pragma(compiler, foreign_decl(c, foreign_decl_is_local,
- "MR_Word " ++ mutable_c_var_name(Name) ++ ";")),
- add_item_decl_pass_2(ForeignDecl, Context, !Status, !ModuleInfo, !IO).
-
-
+ !.Status = item_status(ImportStatus, _),
+ ( ImportStatus = exported ->
+ error_is_exported(Context, "`mutable' declaration", !IO),
+ module_info_incr_errors(!ModuleInfo)
+ ;
+ true
+ ),
+ %
+ % We don't implement the `mutable' declaration unless it is defined in
+ % this module. Not having this check means that we might end up up
+ % duplicating the definition of the global variable in any submodules.
+ %
+ ( status_defined_in_this_module(ImportStatus, yes) ->
+ module_info_name(!.ModuleInfo, ModuleName),
+ InitDecl = initialise(compiler(mutable_decl),
+ mutable_init_pred_sym_name(ModuleName, Name)),
+ add_item_decl_pass_2(InitDecl, Context, !Status, !ModuleInfo, !IO),
+ %
+ % XXX We don't currently support languages other than C.
+ %
+ ForeignDecl = pragma(compiler(mutable_decl),
+ foreign_decl(c, foreign_decl_is_local,
+ "MR_Word " ++ mutable_c_var_name(Name) ++ ";")),
+ add_item_decl_pass_2(ForeignDecl, Context, !Status, !ModuleInfo, !IO)
+ ;
+ true
+ ).
+
% XXX We should probably mangle Name for safety...
%
:- func mutable_get_pred_sym_name(sym_name, string) = sym_name.
@@ -590,18 +645,34 @@
%-----------------------------------------------------------------------------%
add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !IO) :-
- Item = clause(VarSet, PredOrFunc, PredName, Args, Body),
+ Item = clause(Origin, VarSet, PredOrFunc, PredName, Args, Body),
( !.Status = exported ->
- list.length(Args, Arity),
- %
- % There is no point printing out the qualified name since that
- % information is already in the context.
- %
- unqualify_name(PredName, UnqualifiedPredName),
- ClauseId = simple_call_id_to_string(PredOrFunc,
- unqualified(UnqualifiedPredName) / Arity),
- error_is_exported(Context, "clause for " ++ ClauseId, !IO),
- module_info_incr_errors(!ModuleInfo)
+ (
+ Origin = user,
+ list.length(Args, Arity),
+ %
+ % There is no point printing out the qualified name since that
+ % information is already in the context.
+ %
+ unqualify_name(PredName, UnqualifiedPredName),
+ ClauseId = simple_call_id_to_string(PredOrFunc,
+ unqualified(UnqualifiedPredName) / Arity),
+ io.write_string("Clause for ", !IO),
+ io.write(Item, !IO),
+ io.nl(!IO),
+ error_is_exported(Context, "clause for " ++ ClauseId, !IO),
+ module_info_incr_errors(!ModuleInfo)
+ ;
+ Origin = compiler(Details),
+ (
+ % Ignore clauses that are introduced as a result of
+ % `intialise' or `mutable' declarations.
+ ( Details = initialise_decl ; Details = mutable_decl )
+ ;
+ ( Details = solver_type ; Details = foreign_imports ),
+ unexpected(this_file, "Bad introduced clauses.")
+ )
+ )
;
true
),
@@ -613,9 +684,11 @@
Item = type_defn(_TVarSet, SymName, TypeParams, TypeDefn, _Cond),
% If this is a solver type then we need to also add clauses
% the compiler generated inst cast predicate (the declaration
- % for which was added in pass 1).
+ % for which was added in pass 1). We should only add the clauses
+ % if this is the module in which the solver type was defined though.
(
- TypeDefn = solver_type(SolverTypeDetails, _MaybeUserEqComp)
+ TypeDefn = solver_type(SolverTypeDetails, _MaybeUserEqComp),
+ status_defined_in_this_module(!.Status, yes)
->
add_solver_type_clause_items(SymName, TypeParams, SolverTypeDetails,
!Status, Context, !ModuleInfo, !QualInfo, !IO)
@@ -716,7 +789,7 @@
;
add_pragma_type_spec(Pragma, Context, !ModuleInfo, !QualInfo, !IO)
)
- ;
+ ;
Pragma = termination_info(PredOrFunc, SymName, ModeList,
MaybeArgSizeInfo, MaybeTerminationInfo)
->
@@ -773,8 +846,8 @@
!QualInfo, !IO).
add_item_clause(instance(_, _, _, _, _, _), !Status, _, !ModuleInfo, !QualInfo,
!IO).
-add_item_clause(initialise(SymName), !Status, Context, !ModuleInfo, !QualInfo,
- !IO) :-
+add_item_clause(initialise(Origin, SymName), !Status, Context, !ModuleInfo,
+ !QualInfo, !IO) :-
module_info_get_predicate_table(!.ModuleInfo, PredTable),
(
predicate_table_search_pred_sym_arity(PredTable,
@@ -802,16 +875,29 @@
module_info_user_init_pred_c_name(!.ModuleInfo, SymName,
CName),
PragmaExportItem =
- pragma(compiler,
+ pragma(compiler(initialise_decl),
export(SymName, predicate, [di_mode, uo_mode], CName)),
add_item_clause(PragmaExportItem, !Status, Context,
!ModuleInfo, !QualInfo, !IO)
;
- write_error_pieces(Context, 0, [words("Error:"),
- sym_name_and_arity(SymName/2),
- words(" used in initialise declaration does not have " ++
- "signature `pred(io::di, io::uo) is det'")], !IO),
- module_info_incr_errors(!ModuleInfo)
+ (
+ Origin = user,
+ write_error_pieces(Context, 0,
+ [
+ words("Error:"),
+ sym_name_and_arity(SymName/2),
+ words("used in initialise declaration does not"),
+ words("signature"),
+ fixed("`pred(io::di, io::uo) is det'")
+ ], !IO),
+ module_info_incr_errors(!ModuleInfo)
+ ;
+ % If this error, or the two below, occur because of
+ % initialise declaration introduced by the compiler
+ % then that means there is a bug in the compiler.
+ Origin = compiler(_),
+ unexpected(this_file, "Bad introduced intialise declaration.")
+ )
)
;
write_error_pieces(Context, 0, [words("Error:"),
@@ -829,48 +915,58 @@
).
add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !IO) :-
Item = mutable(Name, _Type, InitTerm, Inst, MutAttrs),
- module_info_name(!.ModuleInfo, ModuleName),
- varset__new_named_var(varset__init, "X", X, VarSet),
- Attrs0 = default_attributes(c),
- set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs1),
- (
- list__member(thread_safe, MutAttrs)
- ->
- set_thread_safe(thread_safe, Attrs1, Attrs)
- ;
- Attrs = Attrs1
- ),
- add_item_clause(initialise(mutable_init_pred_sym_name(ModuleName, Name)),
- !Status, Context, !ModuleInfo, !QualInfo, !IO),
- InitClause = clause(VarSet, predicate,
- mutable_init_pred_sym_name(ModuleName, Name),
- [term__variable(X), term__variable(X)],
- promise_purity(dont_make_implicit_promises, (pure),
- call(mutable_set_pred_sym_name(ModuleName, Name),
- [InitTerm], (impure)) - Context
- ) - Context),
- add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo, !IO),
- set_purity((semipure), Attrs, GetAttrs),
- GetClause = pragma(compiler, foreign_proc(GetAttrs,
- mutable_get_pred_sym_name(ModuleName, Name), predicate,
- [pragma_var(X, "X", out_mode(Inst))], VarSet,
- ordinary("X = " ++ mutable_c_var_name(Name) ++ ";",
- yes(Context)))),
- add_item_clause(GetClause, !Status, Context, !ModuleInfo, !QualInfo, !IO),
- (
- list__member(untrailed, MutAttrs)
- ->
- TrailCode = ""
+ ( status_defined_in_this_module(!.Status, yes) ->
+ module_info_name(!.ModuleInfo, ModuleName),
+ varset__new_named_var(varset__init, "X", X, VarSet),
+ Attrs0 = default_attributes(c),
+ set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs1),
+ (
+ list__member(thread_safe, MutAttrs)
+ ->
+ set_thread_safe(thread_safe, Attrs1, Attrs)
+ ;
+ Attrs = Attrs1
+ ),
+ add_item_clause(initialise(compiler(initialise_decl),
+ mutable_init_pred_sym_name(ModuleName, Name)),
+ !Status, Context, !ModuleInfo, !QualInfo, !IO),
+ InitClause = clause(compiler(initialise_decl), VarSet, predicate,
+ mutable_init_pred_sym_name(ModuleName, Name),
+ [term__variable(X), term__variable(X)],
+ promise_purity(dont_make_implicit_promises, (pure),
+ call(mutable_set_pred_sym_name(ModuleName, Name),
+ [InitTerm], (impure)) - Context
+ ) - Context),
+ add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !IO),
+ set_purity((semipure), Attrs, GetAttrs),
+ GetClause = pragma(compiler(initialise_decl), foreign_proc(GetAttrs,
+ mutable_get_pred_sym_name(ModuleName, Name), predicate,
+ [pragma_var(X, "X", out_mode(Inst))], VarSet,
+ ordinary("X = " ++ mutable_c_var_name(Name) ++ ";",
+ yes(Context)))),
+ add_item_clause(GetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !IO),
+ (
+ list__member(untrailed, MutAttrs)
+ ->
+ TrailCode = ""
+ ;
+ TrailCode =
+ "MR_trail_current_value(&" ++
+ mutable_c_var_name(Name) ++
+ ");\n"
+ ),
+ SetClause = pragma(compiler(initialise_decl), foreign_proc(Attrs,
+ mutable_set_pred_sym_name(ModuleName, Name), predicate,
+ [pragma_var(X, "X", in_mode(Inst))], VarSet,
+ ordinary(TrailCode ++ mutable_c_var_name(Name) ++ " = X;",
+ yes(Context)))),
+ add_item_clause(SetClause, !Status, Context, !ModuleInfo, !QualInfo,
+ !IO)
;
- TrailCode =
- "MR_trail_current_value(&" ++ mutable_c_var_name(Name) ++ ");\n"
- ),
- SetClause = pragma(compiler, foreign_proc(Attrs,
- mutable_set_pred_sym_name(ModuleName, Name), predicate,
- [pragma_var(X, "X", in_mode(Inst))], VarSet,
- ordinary(TrailCode ++ mutable_c_var_name(Name) ++ " = X;",
- yes(Context)))),
- add_item_clause(SetClause, !Status, Context, !ModuleInfo, !QualInfo, !IO).
+ true
+ ).
% If a module_defn updates the import_status, return the new status
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.266
diff -u -r1.266 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 5 Sep 2005 03:45:55 -0000 1.266
+++ compiler/mercury_to_mercury.m 6 Sep 2005 07:02:11 -0000
@@ -526,7 +526,7 @@
maybe_output_line_number(Context, !IO),
mercury_output_module_defn(VarSet, ModuleDefn, Context, !IO).
mercury_output_item(UnqualifiedItemNames,
- clause(VarSet, PredOrFunc, PredName0, Args, Body), Context, !IO) :-
+ clause(_, VarSet, PredOrFunc, PredName0, Args, Body), Context, !IO) :-
maybe_unqualify_sym_name(UnqualifiedItemNames, PredName0, PredName),
maybe_output_line_number(Context, !IO),
(
@@ -760,7 +760,7 @@
io__write_string("\n]", !IO)
),
io__write_string(".\n", !IO).
-mercury_output_item(_, initialise(PredSymName), _, !IO) :-
+mercury_output_item(_, initialise(_, PredSymName), _, !IO) :-
io__write_string(":- initialise ", !IO),
mercury_output_sym_name(PredSymName, !IO),
io__write_string(".\n", !IO).
@@ -879,7 +879,7 @@
io::di, io::uo) is det.
output_instance_method_clause(Name1, Context, Item, !IO) :-
- ( Item = clause(VarSet, PredOrFunc, _PredName, HeadTerms, Body) ->
+ ( Item = clause(_, VarSet, PredOrFunc, _PredName, HeadTerms, Body) ->
(
PredOrFunc = predicate,
mercury_output_pred_clause(VarSet, Name1, HeadTerms, Body, Context,
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.111
diff -u -r1.111 module_qual.m
--- compiler/module_qual.m 5 Sep 2005 03:45:56 -0000 1.111
+++ compiler/module_qual.m 7 Sep 2005 05:34:22 -0000
@@ -261,7 +261,7 @@
:- pred collect_mq_info_2(item::in, mq_info::in, mq_info::out) is det.
-collect_mq_info_2(clause(_, _, _, _, _), !Info).
+collect_mq_info_2(clause(_, _, _, _, _, _), !Info).
collect_mq_info_2(type_defn(_, SymName, Params, _, _), !Info) :-
% This item is not visible in the current module.
( mq_info_get_import_status(!.Info, abstract_imported) ->
@@ -334,7 +334,7 @@
mq_info_set_classes(Classes, !Info)
).
collect_mq_info_2(instance(_, _, _, _, _, _), !Info).
-collect_mq_info_2(initialise(_), !Info).
+collect_mq_info_2(initialise(_, _), !Info).
collect_mq_info_2(mutable(_, _, _, _, _), !Info).
:- pred collect_mq_info_qualified_symname(sym_name::in,
@@ -620,7 +620,8 @@
:- pred module_qualify_item(item_and_context::in, item_and_context::out,
mq_info::in, mq_info::out, bool::out, io::di, io::uo) is det.
-module_qualify_item(Clause @ (clause(_,_,_,_,_) - _), Clause, !Info, yes, !IO).
+module_qualify_item(Clause @ (clause(_,_,_,_,_,_) - _), Clause, !Info, yes,
+ !IO).
module_qualify_item(
type_defn(TVarSet, SymName, Params, TypeDefn0, C) - Context,
@@ -719,14 +720,15 @@
qualify_instance_body(Name, Body0, Body).
module_qualify_item(
- initialise(PredSymName) - Context,
- initialise(PredSymName) - Context,
+ initialise(Origin, PredSymName) - Context,
+ initialise(Origin, PredSymName) - Context,
!Info, yes, !IO).
module_qualify_item(
mutable(Name, Type0, InitTerm, Inst0, Attrs) - Context,
mutable(Name, Type, InitTerm, Inst, Attrs) - Context,
!Info, yes, !IO) :-
+ mq_info_set_error_context(mutable(Name) - Context, !Info),
qualify_type(Type0, Type, !Info, !IO),
qualify_inst(Inst0, Inst, !Info, !IO).
@@ -1357,7 +1359,8 @@
; clause_mode_annotation
; type_qual
; class(id)
- ; instance(id).
+ ; instance(id)
+ ; mutable(string).
:- func id_to_sym_name_and_arity(id) = sym_name_and_arity.
@@ -1479,6 +1482,13 @@
[words("declaration of typeclass"), wrap_id(Id)].
mq_error_context_to_pieces(instance(Id)) =
[words("declaration of instance of typeclass"), wrap_id(Id)].
+mq_error_context_to_pieces(mutable(Name)) =
+ [
+ words("declaration for mutable "),
+ prefix("`"),
+ words(Name),
+ suffix("'")
+ ].
:- pred id_type_to_string(id_type::in, string::out) is det.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.339
diff -u -r1.339 modules.m
--- compiler/modules.m 5 Sep 2005 03:45:56 -0000 1.339
+++ compiler/modules.m 7 Sep 2005 07:36:18 -0000
@@ -793,8 +793,9 @@
:- import_module parse_tree__prog_foreign.
:- import_module parse_tree__prog_io_util.
:- import_module parse_tree__prog_out.
-:- import_module parse_tree__prog_util.
+:- import_module parse_tree__prog_mode.
:- import_module parse_tree__prog_type.
+:- import_module parse_tree__prog_util.
:- import_module parse_tree__source_file_map.
:- import_module recompilation__version.
@@ -1280,6 +1281,10 @@
% Write out the `.int0' file.
%
strip_imported_items(Items2, [], Items3),
+ %
+ % We need to pass in ModuleName because mutable declarations
+ % get converted into declarations for their access predicates.
+ %
strip_clauses_from_interface(Items3, Items4),
MakeAbs = (pred(Item0::in, Item::out) is det :-
Item0 = Item1 - Context,
@@ -1946,7 +1951,7 @@
check_for_clauses_in_interface([ItemAndContext0 | Items0], Items, !IO) :-
ItemAndContext0 = Item0 - Context,
(
- Item0 = clause(_, _, _, _, _)
+ Item0 = clause(_, _, _, _, _, _)
->
prog_out__write_context(Context, !IO),
report_warning("Warning: clause in module interface.\n", !IO),
@@ -1975,17 +1980,21 @@
% should always be grouped together with the clauses and should not appear
% in private interfaces.
%
+ % XXX The current treatment of mutable variables is to allow them in
+ % private interfaces. It may be better to just put the predicate and mode
+ % declarations for the access predicates in private interfaces.
+ %
:- pred strip_clauses_from_interface(item_list::in, item_list::out) is det.
strip_clauses_from_interface(Items0, Items) :-
split_clauses_and_decls(Items0, _Clauses, Items).
-:- pred split_clauses_and_decls(item_list::in, item_list::out, item_list::out)
- is det.
+:- pred split_clauses_and_decls(item_list::in,
+ item_list::out, item_list::out) is det.
split_clauses_and_decls([], [], []).
-split_clauses_and_decls([ItemAndContext0 | Items0], ClauseItems,
- InterfaceItems) :-
+split_clauses_and_decls([ItemAndContext0 | Items0],
+ ClauseItems, InterfaceItems) :-
ItemAndContext0 = Item0 - _Context,
(
( Item0 = module_defn(_, interface)
@@ -1995,16 +2004,16 @@
split_clauses_and_decls(Items0, ClauseItems, InterfaceItems)
;
(
- Item0 = clause(_,_,_,_,_)
+ Item0 = clause(_,_,_,_,_,_)
;
Item0 = pragma(_, Pragma),
pragma_allowed_in_interface(Pragma, no)
;
- Item0 = initialise(_)
+ Item0 = initialise(_, _)
)
- ->
- split_clauses_and_decls(Items0, ClauseItems1, InterfaceItems),
- ClauseItems = [ItemAndContext0 | ClauseItems1]
+ ->
+ split_clauses_and_decls( Items0, ClauseItems1, InterfaceItems),
+ ClauseItems = [ItemAndContext0 | ClauseItems1]
;
split_clauses_and_decls(Items0, ClauseItems, InterfaceItems1),
InterfaceItems = [ItemAndContext0 | InterfaceItems1]
@@ -7116,10 +7125,13 @@
maybe_add_foreign_import_module(ModuleName, Items0, Items) :-
get_foreign_self_imports(Items0, Langs),
- Imports = list__map(
- (func(Lang) = pragma(compiler, foreign_import_module(Lang, ModuleName))
- - term__context_init),
- Langs),
+ MakeForeignImport = (func(Lang) = ImportItem :-
+ Origin = compiler(foreign_imports),
+ Pragma = foreign_import_module(Lang, ModuleName),
+ Context = term.context_init,
+ ImportItem = pragma(Origin, Pragma) - Context
+ ),
+ Imports = list.map(MakeForeignImport, Langs),
Items = Imports ++ Items0.
:- pred get_foreign_self_imports(item_list::in, list(foreign_language)::out)
@@ -7263,7 +7275,7 @@
% Could this item use items from imported modules.
:- func item_needs_imports(item) = bool.
-item_needs_imports(clause(_, _, _, _, _)) = yes.
+item_needs_imports(clause(_, _, _, _, _, _)) = yes.
item_needs_imports(Item @ type_defn(_, _, _, _, _)) =
( Item ^ td_ctor_defn = abstract_type(_) -> no ; yes ).
item_needs_imports(inst_defn(_, _, _, _, _)) = yes.
@@ -7288,7 +7300,7 @@
).
item_needs_imports(instance(_, _, _, _, _, _)) = yes.
item_needs_imports(promise(_, _, _, _)) = yes.
-item_needs_imports(initialise(_)) = yes.
+item_needs_imports(initialise(_, _)) = yes.
item_needs_imports(mutable(_, _, _, _, _)) = yes.
item_needs_imports(nothing(_)) = no.
@@ -7630,11 +7642,11 @@
reorderable_item(promise(_, _, _, _)) = yes.
reorderable_item(typeclass(_, _, _, _, _, _)) = yes.
reorderable_item(instance(_, _, _, _, _, _)) = yes.
-reorderable_item(clause(_, _, _, _, _)) = no.
+reorderable_item(clause(_, _, _, _, _, _)) = no.
reorderable_item(nothing(_)) = no.
reorderable_item(pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _)) = no.
reorderable_item(pred_or_func_mode(_, _, _, _, _, _, _)) = no.
-reorderable_item(initialise(_)) = no.
+reorderable_item(initialise(_, _)) = no.
reorderable_item(mutable(_, _, _, _, _)) = no.
:- pred is_chunkable(item_and_context::in) is semidet.
@@ -7719,8 +7731,8 @@
chunkable_item(promise(_, _, _, _)) = yes.
chunkable_item(typeclass(_, _, _, _, _, _)) = yes.
chunkable_item(instance(_, _, _, _, _, _)) = yes.
-chunkable_item(clause(_, _, _, _, _)) = yes.
-chunkable_item(initialise(_)) = yes.
+chunkable_item(clause(_, _, _, _, _, _)) = yes.
+chunkable_item(initialise(_, _)) = yes.
chunkable_item(mutable(_, _, _, _, _)) = no.
chunkable_item(nothing(_)) = yes.
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.135
diff -u -r1.135 prog_data.m
--- compiler/prog_data.m 5 Sep 2005 03:45:57 -0000 1.135
+++ compiler/prog_data.m 6 Sep 2005 06:54:19 -0000
@@ -52,14 +52,38 @@
% compiler as part of a source-to-source transformation, e.g.
% the initialise declarations.
%
-:- type item_origin ---> user ; compiler.
+:- type item_origin ---> user ; compiler(item_compiler_origin).
-:- type item_list == list(item_and_context).
+ % For items introduced by the compiler, why were they
+ % introduced?
+ %
+:- type item_compiler_origin
+ ---> initialise_decl
+ % The item was introduced by the transformation
+ % for `:- initialise' decls. This should only
+ % apply to export pragms.
+
+ ; mutable_decl
+ % The item was introduced by the transformation
+ % for `:- mutable' decls. This should only apply
+ % to `:- initialise' decls and export pragmas.
+
+ ; solver_type
+ % Solver types cause the compiler to create
+ % foreign procs for the init and representation
+ % functions.
+
+ ; foreign_imports.
+ % The compiler sometimes needs to insert additional
+ % foreign_import pragmas. XXX Why?
+
+:- type item_list == list(item_and_context).
-:- type item_and_context == pair(item, prog_context).
+:- type item_and_context == pair(item, prog_context).
:- type item
---> clause(
+ cl_origin :: item_origin,
cl_varset :: prog_varset,
cl_pred_or_func :: pred_or_func,
cl_predname :: sym_name,
@@ -171,7 +195,7 @@
)
% :- initialise(pred_name).
- ; initialise(sym_name)
+ ; initialise(item_origin, sym_name)
% :- mutable(var_name, type, inst, value, attrs).
; mutable(
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.246
diff -u -r1.246 prog_io.m
--- compiler/prog_io.m 5 Sep 2005 03:45:57 -0000 1.246
+++ compiler/prog_io.m 6 Sep 2005 07:06:18 -0000
@@ -1055,7 +1055,7 @@
maybe1(item)::out) is det.
process_pred_clause(ok(Name, Args0), VarSet, Body,
- ok(clause(VarSet, predicate, Name, Args, Body))) :-
+ ok(clause(user, VarSet, predicate, Name, Args, Body))) :-
list__map(term__coerce, Args0, Args).
process_pred_clause(error(ErrMessage, Term0), _, _, error(ErrMessage, Term)) :-
term__coerce(Term0, Term).
@@ -1064,7 +1064,7 @@
goal::in, maybe1(item)::out) is det.
process_func_clause(ok(Name, Args0), Result0, VarSet, Body,
- ok(clause(VarSet, function, Name, Args, Body))) :-
+ ok(clause(user, VarSet, function, Name, Args, Body))) :-
list__append(Args0, [Result0], Args1),
list__map(term__coerce, Args1, Args).
process_func_clause(error(ErrMessage, Term0), _, _, _,
@@ -1787,13 +1787,13 @@
MaybeSymNameSpecifier = ok(SymNameSpecifier),
(
SymNameSpecifier = name(SymName),
- Result = ok(initialise(SymName))
+ Result = ok(initialise(user, SymName))
;
SymNameSpecifier = name_arity(SymName, Arity),
(
Arity = 2
->
- Result = ok(initialise(SymName))
+ Result = ok(initialise(user, SymName))
;
Result = error("an initialise " ++
"declaration can only apply to " ++
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.29
diff -u -r1.29 prog_io_dcg.m
--- compiler/prog_io_dcg.m 26 Apr 2005 07:37:59 -0000 1.29
+++ compiler/prog_io_dcg.m 6 Sep 2005 07:06:43 -0000
@@ -539,7 +539,7 @@
prog_var::in, goal::in, maybe1(item)::out) is det.
process_dcg_clause(ok(Name, Args0), VarSet, Var0, Var, Body,
- ok(clause(VarSet, predicate, Name, Args, Body))) :-
+ ok(clause(user, VarSet, predicate, Name, Args, Body))) :-
list__map(term__coerce, Args0, Args1),
list__append(Args1, [term__variable(Var0), term__variable(Var)], Args).
process_dcg_clause(error(Message, Term), _, _, _, _, error(Message, Term)).
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.40
diff -u -r1.40 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 5 Sep 2005 02:29:55 -0000 1.40
+++ compiler/prog_io_typeclass.m 6 Sep 2005 07:07:25 -0000
@@ -805,7 +805,7 @@
parse_item(DefaultModuleName, VarSet, MethodTerm, Result0),
(
Result0 = ok(Item, Context),
- Item = clause(_VarNames, PredOrFunc,
+ Item = clause(_Origin, _VarNames, PredOrFunc,
ClassMethodName, HeadArgs,
_ClauseBody)
->
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.17
diff -u -r1.17 recompilation.check.m
--- compiler/recompilation.check.m 5 Sep 2005 03:45:58 -0000 1.17
+++ compiler/recompilation.check.m 6 Sep 2005 07:07:50 -0000
@@ -892,7 +892,7 @@
item_version_numbers::in, item_and_context::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
-check_for_ambiguities(_, _, _, clause(_, _, _, _, _) - _, !Info) :-
+check_for_ambiguities(_, _, _, clause(_, _, _, _, _, _) - _, !Info) :-
error("check_for_ambiguities: clause").
check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
type_defn(_, Name, Params, Body, _) - _, !Info) :-
@@ -956,7 +956,7 @@
check_for_ambiguities(_, _, _, promise(_, _, _, _) - _, !Info).
check_for_ambiguities(_, _, _, module_defn(_, _) - _, !Info).
check_for_ambiguities(_, _, _, instance(_, _, _, _, _, _) - _, !Info).
-check_for_ambiguities(_, _, _, initialise(_) - _, !Info).
+check_for_ambiguities(_, _, _, initialise(_, _) - _, !Info).
check_for_ambiguities(_, _, _, mutable(_, _, _, _, _) - _, !Info).
check_for_ambiguities(_, _, _, nothing(_) - _, !Info).
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.23
diff -u -r1.23 recompilation.version.m
--- compiler/recompilation.version.m 5 Sep 2005 03:45:58 -0000 1.23
+++ compiler/recompilation.version.m 6 Sep 2005 07:08:42 -0000
@@ -522,7 +522,7 @@
:- pred item_to_item_id_2(item::in, maybe(item_id)::out) is det.
-item_to_item_id_2(clause(_, _, _, _, _), no).
+item_to_item_id_2(clause(_, _, _, _, _, _), no).
item_to_item_id_2(type_defn(_, Name, Params, _, _),
yes(item_id((type), Name - Arity))) :-
list__length(Params, Arity).
@@ -576,7 +576,7 @@
% qualifier on an instance declaration is the module containing
% the class, not the module containing the instance).
item_to_item_id_2(instance(_, _, _, _, _, _), no).
-item_to_item_id_2(initialise(_), no).
+item_to_item_id_2(initialise(_, _), no).
item_to_item_id_2(mutable(_, _, _, _, _), no).
item_to_item_id_2(nothing(_), no).
@@ -695,8 +695,8 @@
% XXX Need to compare the goals properly in clauses and assertions.
% That's not necessary at the moment because smart recompilation
% doesn't work with inter-module optimization yet.
-item_is_unchanged(clause(_VarSet, PorF, SymName, Args, Goal), Item2) =
- ( Item2 = clause(_, PorF, SymName, Args, Goal) -> yes ; no ).
+item_is_unchanged(clause(_, _VarSet, PorF, SymName, Args, Goal), Item2) =
+ ( Item2 = clause(_, _, PorF, SymName, Args, Goal) -> yes ; no ).
item_is_unchanged(promise(PromiseType, Goal, _, UnivVars), Item2) =
( Item2 = promise(PromiseType, Goal, _, UnivVars) -> yes ; no ).
@@ -735,8 +735,8 @@
Result = no
).
item_is_unchanged(nothing(A), Item2) = ( Item2 = nothing(A) -> yes ; no ).
-item_is_unchanged(initialise(A), Item2) =
- ( Item2 = initialise(A) -> yes ; no ).
+item_is_unchanged(initialise(O, A), Item2) =
+ ( Item2 = initialise(O, A) -> yes ; no ).
item_is_unchanged(mutable(A, B, C, D, E), Item2) =
( Item2 = mutable(A, B, C, D, E) -> yes ; no ).
Index: compiler/state_var.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/state_var.m,v
retrieving revision 1.4
diff -u -r1.4 state_var.m
--- compiler/state_var.m 30 Aug 2005 04:11:59 -0000 1.4
+++ compiler/state_var.m 6 Sep 2005 07:22:47 -0000
@@ -970,7 +970,7 @@
Cs = list__map(expand_item_bsvs, Cs0),
% Note that the condition should always succeed...
%
- ( Cs = [clause(_, _, _, Args, _) | _] ->
+ ( Cs = [clause(_, _, _, _, Args, _) | _] ->
adjust_func_arity(PredOrFunc, Arity, list__length(Args))
;
Arity = Arity0
@@ -982,9 +982,9 @@
:- func expand_item_bsvs(item) = item.
expand_item_bsvs(Item) =
- ( Item = clause(VarSet, PredOrFunc, SymName, Args, Body) ->
- clause(VarSet, PredOrFunc, SymName, expand_bang_state_var_args(Args),
- Body)
+ ( Item = clause(Origin, VarSet, PredOrFunc, SymName, Args, Body) ->
+ clause(Origin, VarSet, PredOrFunc, SymName,
+ expand_bang_state_var_args(Args), Body)
;
Item
).
Index: extras/graphics/mercury_glut/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/mercury_glut/Mmakefile,v
retrieving revision 1.1
diff -u -r1.1 Mmakefile
--- extras/graphics/mercury_glut/Mmakefile 17 May 2004 08:28:51 -0000 1.1
+++ extras/graphics/mercury_glut/Mmakefile 31 Aug 2005 08:47:15 -0000
@@ -13,7 +13,7 @@
# The following libraries are for X on Linux (Debian) using Mesa.
# Libaries required by X windows.
-X_LIBS = -lX11 -lXext -lXmu -lXt -lXi -lSM -lICE -L/usr/X11R6/lib
+X_LIBS = -lX11 -lXext -lXt -lXi -lSM -lICE -L/usr/X11R6/lib
# Libraries required by OpenGL.
GL_LIBS = -lGL -LGL
Index: extras/graphics/mercury_glut/glut.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/mercury_glut/glut.m,v
retrieving revision 1.5
diff -u -r1.5 glut.m
--- extras/graphics/mercury_glut/glut.m 8 Aug 2005 07:13:21 -0000 1.5
+++ extras/graphics/mercury_glut/glut.m 31 Aug 2005 06:55:20 -0000
@@ -37,11 +37,6 @@
%
% Initialisation.
%
- % Initialise the GLUT library.
- % You must call this before calling any other GLUT procedures.
- % The program will abort if there is an error.
- %
-:- pred glut.init(io::di, io::uo) is det.
:- type display_mode
---> rgba
@@ -151,17 +146,20 @@
:- import_module map.
:- import_module require.
+:- initialise glut.init/2.
+
:- pragma foreign_decl("C",
"
#if defined(__APPLE__) && defined(__MACH__)
#include <GLUT/glut.h>
#else
#include <GL/glut.h>
-
#endif
").
%-----------------------------------------------------------------------------%
+
+:- pred glut.init(io::di, io::uo) is det.
:- pragma foreign_proc("C",
glut.init(IO0::di, IO::uo),
Index: extras/graphics/mercury_opengl/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/mercury_opengl/Mmakefile,v
retrieving revision 1.5
diff -u -r1.5 Mmakefile
--- extras/graphics/mercury_opengl/Mmakefile 1 Dec 2004 01:45:30 -0000 1.5
+++ extras/graphics/mercury_opengl/Mmakefile 31 Aug 2005 08:47:35 -0000
@@ -11,7 +11,7 @@
# Specify what libraries we need to link against for OpenGL on this system.
# (The following works on Debian with mesa as the OpenGL implementation).
-GL_LIBS = -lGL -lGLU -L/usr/X11R6/lib -lX11 -lXi -lXmu -lXt -lICE -lXext -lSM
+GL_LIBS = -lGL -lGLU -L/usr/X11R6/lib -lX11 -lXi -lXt -lICE -lXext -lSM
# Don't issue a warning because mercury_opengl doesn't export anything.
MCFLAGS-mercury_opengl = --no-warn-nothing-exported
Index: extras/graphics/samples/gears/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/samples/gears/Mmakefile,v
retrieving revision 1.1
diff -u -r1.1 Mmakefile
--- extras/graphics/samples/gears/Mmakefile 14 Jun 2004 11:34:06 -0000 1.1
+++ extras/graphics/samples/gears/Mmakefile 31 Aug 2005 06:37:03 -0000
@@ -8,7 +8,7 @@
MGNUCFLAGS = --pic-reg -I$(MERCURY_OPENGL_DIR) -I$(MERCURY_GLUT_DIR)
EXTRA_MLFLAGS = -shared
-EXTRA_MLLIBS = -lGLU -lglut -lGL -L/usr/X11R6/lib -lX11 -lXext -lXmu -lXi \
+EXTRA_MLLIBS = -lGLU -lglut -lGL -L/usr/X11R6/lib -lX11 -lXext -lXi \
-lpthread -ldl -lm
VPATH = $(MERCURY_OPENGL_DIR):$(MERCURY_GLUT_DIR):$(MMAKE_VPATH)
Index: extras/graphics/samples/gears/gears.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/samples/gears/gears.m,v
retrieving revision 1.3
diff -u -r1.3 gears.m
--- extras/graphics/samples/gears/gears.m 29 Jun 2005 05:21:44 -0000 1.3
+++ extras/graphics/samples/gears/gears.m 5 Sep 2005 15:57:15 -0000
@@ -41,6 +41,36 @@
:- import_module string.
%-----------------------------------------------------------------------------%
+%
+% Mutable state
+%
+
+:- mutable(gear_one, int, 0, ground, [thread_safe, untrailed]).
+:- mutable(gear_two, int, 0, ground, [thread_safe, untrailed]).
+:- mutable(gear_three, int, 0, ground, [thread_safe, untrailed]).
+:- mutable(angle, float, 0.0, ground, [thread_safe, untrailed]).
+:- mutable(count, int, 0, ground, [thread_safe, untrailed]).
+:- mutable(limit, int, 0, ground, [thread_safe, untrailed]).
+:- mutable(frames, int, 0, ground, [thread_safe, untrailed]).
+:- mutable(t0, int, 0, ground, [thread_safe, untrailed]).
+:- mutable(view_rot_x, float, 20.0, ground, [thread_safe, untrailed]).
+:- mutable(view_rot_y, float, 30.0, ground, [thread_safe, untrailed]).
+:- mutable(view_rot_z, float, 0.0, ground, [thread_safe, untrailed]).
+
+%
+% XXX Until we can automatically generate a pure inteface for mutable
+% variables.
+%
+
+:- pred get_gear_one(int::out, io::di, io::uo) is det.
+
+get_gear_one(GearOne, !IO) :- promise_pure ( impure get_gear_one(GearOne) ).
+
+:- pred set_gear_one(int::in, io::di, io::uo) is det.
+
+set_gear_one(GearOne, !IO) :- promise_pure ( impure set_gear_one(GearOne) ).
+
+%-----------------------------------------------------------------------------%
main(!IO) :-
io.command_line_arguments(Args, !IO),
@@ -63,7 +93,6 @@
:- pred gears.main_2(int::in, io::di, io::uo) is det.
gears.main_2(Limit, !IO) :-
- glut.init(!IO),
glut.init_display_mode([rgba, depth, double], !IO),
glut.window.create("Gears", !IO),
Index: extras/graphics/samples/maze/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/samples/maze/Mmakefile,v
retrieving revision 1.7
diff -u -r1.7 Mmakefile
--- extras/graphics/samples/maze/Mmakefile 20 Jan 2005 04:50:22 -0000 1.7
+++ extras/graphics/samples/maze/Mmakefile 31 Aug 2005 06:35:51 -0000
@@ -9,7 +9,7 @@
MGNUCFLAGS = --pic-reg -I$(MERCURY_OPENGL_DIR) -I$(MERCURY_GLUT_DIR)
EXTRA_MLFLAGS = -shared
-EXTRA_MLLIBS = -lGLU -lglut -lGL -L/usr/X11R6/lib -lX11 -lXext -lXmu -lXi \
+EXTRA_MLLIBS = -lGLU -lglut -lGL -L/usr/X11R6/lib -lX11 -lXext -lXi \
-lpthread -ldl -lm
VPATH = $(MERCURY_OPENGL_DIR):$(MERCURY_GLUT_DIR):$(MMAKE_VPATH)
Index: extras/graphics/samples/maze/maze.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/samples/maze/maze.m,v
retrieving revision 1.5
diff -u -r1.5 maze.m
--- extras/graphics/samples/maze/maze.m 29 Jun 2005 05:21:45 -0000 1.5
+++ extras/graphics/samples/maze/maze.m 31 Aug 2005 06:35:35 -0000
@@ -117,7 +117,6 @@
:- pred maze.main_2(maze::in, io::di, io::uo) is det.
maze.main_2(Maze, !IO) :-
- glut.init(!IO),
glut.init_display_mode([double, rgba], !IO),
glut.init_window_size(300, 300, !IO),
glut.window.create("Maze", !IO),
Index: tests/hard_coded/sub-modules/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/Mmakefile,v
retrieving revision 1.10
diff -u -r1.10 Mmakefile
--- tests/hard_coded/sub-modules/Mmakefile 31 Aug 2005 04:28:23 -0000 1.10
+++ tests/hard_coded/sub-modules/Mmakefile 11 Sep 2005 06:17:13 -0000
@@ -26,7 +26,8 @@
nested3 \
class \
nested_intermod_main \
- initialise_parent
+ initialise_parent \
+ ts
# We currently don't do any testing in grade java on this directory.
ifneq "$(findstring java,$(GRADE))" ""
Index: tests/hard_coded/sub-modules/ts.exp
===================================================================
RCS file: tests/hard_coded/sub-modules/ts.exp
diff -N tests/hard_coded/sub-modules/ts.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/ts.exp 7 Sep 2005 07:56:52 -0000
@@ -0,0 +1 @@
+hello
Index: tests/hard_coded/sub-modules/ts.m
===================================================================
RCS file: tests/hard_coded/sub-modules/ts.m
diff -N tests/hard_coded/sub-modules/ts.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/ts.m 7 Sep 2005 07:54:47 -0000
@@ -0,0 +1,21 @@
+% This test case exposes a bug in the interaction of solver types and
+% sub-modules in rotd-2005-09-06 and before. The problem was that the
+% sub-modules were reading in the solver type declarations from the .int0 files
+% and adding the foreign_procs for the representation and intialisation
+% functions.
+% (The test case is from Peter Hawkins.)
+:- module ts.
+:- interface.
+:- include_module tsub.
+:- import_module io.
+:- pred main(io.state::di, io.state::uo) is det.
+:- implementation.
+
+:- import_module int, exception.
+:- solver type st where representation is int,
+ initialisation is init_int.
+
+:- pred init_int(st::oa) is erroneous.
+init_int(_A) :- throw("stop").
+
+main(!IO) :- print("hello\n", !IO).
Index: tests/hard_coded/sub-modules/ts.tsub.m
===================================================================
RCS file: tests/hard_coded/sub-modules/ts.tsub.m
diff -N tests/hard_coded/sub-modules/ts.tsub.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/ts.tsub.m 7 Sep 2005 07:49:13 -0000
@@ -0,0 +1,6 @@
+:- module tsub.
+:- interface.
+:- pred foo(st::ia) is det.
+:- implementation.
+
+foo(_).
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.174
diff -u -r1.174 Mmakefile
--- tests/invalid/Mmakefile 5 Sep 2005 03:45:59 -0000 1.174
+++ tests/invalid/Mmakefile 7 Sep 2005 06:05:11 -0000
@@ -37,6 +37,7 @@
any_mode \
any_should_not_match_bound \
assert_in_interface \
+ bad_mutable \
bad_initialise_decl \
bad_instance \
bigtest \
Index: tests/invalid/bad_mutable.err_exp
===================================================================
RCS file: tests/invalid/bad_mutable.err_exp
diff -N tests/invalid/bad_mutable.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/bad_mutable.err_exp 7 Sep 2005 06:04:25 -0000
@@ -0,0 +1,8 @@
+bad_mutable.m:015: Error: unrecognised attribute in mutable declaration: bad_attrib.
+bad_mutable.m:017: Error: the type in a mutable declaration cannot contain variables: list(_1).
+bad_mutable.m:011: In declaration for mutable `not_a_type':
+bad_mutable.m:011: error: undefined type `no_type'/0.
+bad_mutable.m:013: In declaration for mutable `not_an_inst':
+bad_mutable.m:013: error: undefined inst `special_ground'/0.
+bad_mutable.m:005: Error: `mutable' declaration in module interface.
+For more information, try recompiling with `-E'.
Index: tests/invalid/bad_mutable.m
===================================================================
RCS file: tests/invalid/bad_mutable.m
diff -N tests/invalid/bad_mutable.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/bad_mutable.m 7 Sep 2005 05:17:30 -0000
@@ -0,0 +1,17 @@
+:- module bad_mutable.
+
+:- interface.
+
+:- mutable(in_interface, int, 0, ground, [untrailed, thread_safe]).
+
+:- implementation.
+
+:- type list(T) ---> [] ; [ T | list(T) ].
+
+:- mutable(not_a_type, no_type, 0, ground, [untrailed, thread_safe]).
+
+:- mutable(not_an_inst, int, 0, special_ground, [untrailed, thread_safe]).
+
+:- mutable(bad_attribute, int, 0, ground, [untrailed, thread_safe, bad_attrib]).
+
+:- mutable(poly_type, list(T), [], ground, [untrailed, thread_safe]).
Index: vim/syntax/mercury.vim
===================================================================
RCS file: /home/mercury1/repository/mercury/vim/syntax/mercury.vim,v
retrieving revision 1.14
diff -u -r1.14 mercury.vim
--- vim/syntax/mercury.vim 31 Aug 2005 04:29:12 -0000 1.14
+++ vim/syntax/mercury.vim 5 Sep 2005 15:53:15 -0000
@@ -34,7 +34,7 @@
endif
syn keyword mercuryKeyword module use_module import_module
syn keyword mercuryKeyword include_module end_module
-syn keyword mercuryKeyword initialise
+syn keyword mercuryKeyword initialise mutable
syn keyword mercuryKeyword interface implementation
syn keyword mercuryKeyword pred mode func type inst solver
syn keyword mercuryKeyword is semidet det nondet multi erroneous failure
@@ -51,7 +51,7 @@
syn keyword mercuryCInterface may_call_mercury will_not_call_mercury
syn keyword mercuryCInterface thread_safe not_thread_safe maybe_thread_safe
syn keyword mercuryCInterface promise_pure promise_semipure
-syn keyword mercuryCInterface tabled_for_io local
+syn keyword mercuryCInterface tabled_for_io local untrailed
syn keyword mercuryCInterface can_pass_as_mercury_type stable
syn keyword mercuryCInterface will_not_throw_exception
syn keyword mercuryCInterface export import
--------------------------------------------------------------------------
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