[m-rev.] for review: fix `:- mutable' decls and sub-modules
Julien Fischer
juliensf at cs.mu.OZ.AU
Thu Sep 15 15:26:28 AEST 2005
For review by Ralph.
Estimated hours taken: 10
Branches: main
Fix the problems with mutable declarations and sub-modules by making
sure that the relevant information is written out in the private interface
files.
Fix a bug where mutable variables were not being initialised with their
declared intial value. The problem was that the compiler was optimizing away
the body of the automatically generated predicate that was setting the initial
value. We now make such predicates impure to prevent this.
In order to support the above, accept `:- intialise' declarations that specify
impure predicates, provided that the declaration in question was generated by the
compiler. It is still an error for the user to specify such declarations.
Fix some other problems with the code that handles mutable declarations.
compiler/modules.m:
Do not write `:- mutable' declarations out to private interface
files, instead write out the predicate and mode declarations for
the access predicates.
Order the items in private interface files.
Remove some old XXX comments about mutables that are no longer
relevant.
compiler/make_hlds_passes.m:
Don't add the export pragmas for initialise declarations during pass
2. For some reason we were doing this during pass 2 and again during
pass 3.
Make the intialise predicates for mutable variables impure in order to
prevent the compiler from optimizing them away
Fix origin fields that were being set incorrectly during the mutable
transformation.
compiler/prog_mutable.m:
New module. Shift some code from make_hlds_passes to here, since
modules.m also needs access to it.
compiler/parse_tree.m:
Include the new module.
compiler/notes/compiler_design.html:
Mention the new module.
tests/hard_coded/sub-modules/Mmakefile:
tests/hard_coded/sub-modules/mutable_parent.m:
tests/hard_coded/sub-modules/mutable_child.m:
tests/hard_coded/sub-modules/mutable_grandchild.m:
tests/hard_coded/sub-modules/mutable_parent.exp:
Test case for mutables and sub-modules.
Julien.
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.9
diff -u -r1.9 make_hlds_passes.m
--- compiler/make_hlds_passes.m 12 Sep 2005 05:24:12 -0000 1.9
+++ compiler/make_hlds_passes.m 15 Sep 2005 04:56:02 -0000
@@ -118,6 +118,7 @@
:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_mode.
+:- import_module parse_tree__prog_mutable.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_type.
:- import_module parse_tree__prog_util.
@@ -285,7 +286,10 @@
% and update functions are sensible.
%
% Check that predicates listed in `:- initialise' declarations
- % exist and have the right signature.
+ % exist and have the right signature, introduce pragma export
+ % declarations for them and record their exported name in the
+ % module_info so that we can tell the code generator to call
+ % it at initialisation time.
%
:- pred add_item_list_clauses(item_list::in, import_status::in,
module_info::in, module_info::out, qual_info::in, qual_info::out,
@@ -445,36 +449,17 @@
% the foreign_proc clauses on the third pass.
Item = mutable(Name, Type, _InitValue, Inst, _Attrs),
!.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 = defined(qualified(unqualified("io"), "state"),[], star),
- 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),
+ GetPredDecl = prog_mutable.get_pred_decl(ModuleName, Name,
+ Type, Inst),
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),
+ SetPredDecl = prog_mutable.set_pred_decl(ModuleName, Name,
+ Type, Inst),
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),
+ InitPredDecl = prog_mutable.init_pred_decl(ModuleName, Name),
add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _,
!IO)
;
@@ -552,47 +537,9 @@
),
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(Origin, SymName),
- !.Status = item_status(ImportStatus, _),
- ( ImportStatus = exported ->
- (
- 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,
- unexpected(this_file, "Bad introduced intialise declaration.")
- ;
- Details = solver_type,
- unexpected(this_file, "Bad introduced intialise declaration.")
- ;
- Details = foreign_imports,
- unexpected(this_file, "Bad introduced intialise declaration.")
- )
- )
- ;
- true
- ),
- %
- % To handle a `:- initialise initpred.' declaration we need to
- % (1) construct a new C function name, CName, to use to export initpred,
- % (2) add `:- pragma export(initpred(di, uo), CName).',
- % (3) record the initpred/cname pair in the ModuleInfo so that
- % code generation can ensure cname is called during module
- % initialisation.
- %
- module_info_new_user_init_pred(SymName, CName, !ModuleInfo),
- PragmaExportItem =
- 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) :-
+ % These are processed during pass 3.
+ Item = initialise(_, _).
add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !IO) :-
Item = mutable(Name, _Type, _InitTerm, _Inst, _MutAttrs),
!.Status = item_status(ImportStatus, _),
@@ -608,10 +555,6 @@
% 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.
%
@@ -622,27 +565,6 @@
;
true
).
-
- % XXX We should probably mangle Name for safety...
- %
-:- func mutable_get_pred_sym_name(sym_name, string) = sym_name.
-
-mutable_get_pred_sym_name(ModuleName, Name) =
- qualified(ModuleName, "get_" ++ Name).
-
-:- func mutable_set_pred_sym_name(sym_name, string) = sym_name.
-
-mutable_set_pred_sym_name(ModuleName, Name) =
- qualified(ModuleName, "set_" ++ Name).
-
-:- func mutable_init_pred_sym_name(sym_name, string) = sym_name.
-
-mutable_init_pred_sym_name(ModuleName, Name) =
- qualified(ModuleName, "initialise_mutable_" ++ Name).
-
-:- func mutable_c_var_name(string) = string.
-
-mutable_c_var_name(Name) = "mutable_variable_" ++ Name.
%-----------------------------------------------------------------------------%
@@ -850,8 +772,15 @@
!QualInfo, !IO).
add_item_clause(instance(_, _, _, _, _, _), !Status, _, !ModuleInfo, !QualInfo,
!IO).
-add_item_clause(initialise(Origin, SymName), !Status, Context, !ModuleInfo,
+add_item_clause(initialise(user, SymName), !Status, Context, !ModuleInfo,
!QualInfo, !IO) :-
+ %
+ % To handle a `:- initialise initpred.' declaration we need to:
+ % (1) construct a new C function name, CName, to use to export initpred,
+ % (2) add `:- pragma export(initpred(di, uo), CName).',
+ % (3) record the initpred/cname pair in the ModuleInfo so that
+ % code generation can ensure cname is called during module initialisation.
+ %
module_info_get_predicate_table(!.ModuleInfo, PredTable),
(
predicate_table_search_pred_sym_arity(PredTable,
@@ -876,32 +805,22 @@
MaybeDetism = yes(Detism),
( Detism = det ; Detism = cc_multidet )
->
- module_info_user_init_pred_c_name(!.ModuleInfo, SymName,
- CName),
+ module_info_new_user_init_pred(SymName, CName, !ModuleInfo),
PragmaExportItem =
pragma(compiler(initialise_decl),
export(SymName, predicate, [di_mode, uo_mode], CName)),
add_item_clause(PragmaExportItem, !Status, Context,
!ModuleInfo, !QualInfo, !IO)
;
- (
- Origin = user,
- write_error_pieces(Context, 0,
- [
- words("Error:"),
- sym_name_and_arity(SymName/2),
- words("used in initialise declaration does not"),
- words("have 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:"),
+ sym_name_and_arity(SymName/2),
+ words("used in initialise declaration does not"),
+ words("have signature"),
+ fixed("`pred(io::di, io::uo) is det'")
+ ], !IO),
+ module_info_incr_errors(!ModuleInfo)
)
;
write_error_pieces(Context, 0, [words("Error:"),
@@ -917,6 +836,26 @@
"not have a corresponding pred declaration.")], !IO),
module_info_incr_errors(!ModuleInfo)
).
+add_item_clause(initialise(compiler(Details), SymName), !Status, Context,
+ !ModuleInfo, !QualInfo, !IO) :-
+ %
+ % The compiler introduces initialise declarations that call
+ % impure predicates as part of the source-to-source transformation
+ % for mutable variables. These predicates *must* be impure in order
+ % to prevent the compiler optimizing them away. We only allow
+ % the compiler to introduce impure initialisers - it is an error
+ % for the user to do so.
+ %
+ ( Details = mutable_decl ->
+ module_info_new_user_init_pred(SymName, CName, !ModuleInfo),
+ PragmaExportItem =
+ pragma(compiler(mutable_decl),
+ export(SymName, predicate, [], CName)),
+ add_item_clause(PragmaExportItem, !Status, Context,
+ !ModuleInfo, !QualInfo, !IO)
+ ;
+ unexpected(this_file, "Bad introduced initialise declaration.")
+ ).
add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !IO) :-
Item = mutable(Name, _Type, InitTerm, Inst, MutAttrs),
( status_defined_in_this_module(!.Status, yes) ->
@@ -931,20 +870,17 @@
;
Attrs = Attrs1
),
- add_item_clause(initialise(compiler(initialise_decl),
+ add_item_clause(initialise(compiler(mutable_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),
+ InitClause = clause(compiler(mutable_decl), varset.init, predicate,
+ mutable_init_pred_sym_name(ModuleName, Name), [],
+ call(mutable_set_pred_sym_name(ModuleName, Name),
+ [InitTerm], (impure)) - Context),
add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
!IO),
set_purity((semipure), Attrs, GetAttrs),
- GetClause = pragma(compiler(initialise_decl), foreign_proc(GetAttrs,
+ GetClause = pragma(compiler(mutable_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) ++ ";",
@@ -961,7 +897,7 @@
mutable_c_var_name(Name) ++
");\n"
),
- SetClause = pragma(compiler(initialise_decl), foreign_proc(Attrs,
+ SetClause = pragma(compiler(mutable_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;",
@@ -972,7 +908,6 @@
true
).
-
% 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/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.342
diff -u -r1.342 modules.m
--- compiler/modules.m 14 Sep 2005 05:26:39 -0000 1.342
+++ compiler/modules.m 15 Sep 2005 05:10:20 -0000
@@ -794,6 +794,7 @@
:- import_module parse_tree__prog_io_util.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_mode.
+:- import_module parse_tree__prog_mutable.
:- import_module parse_tree__prog_type.
:- import_module parse_tree__prog_util.
:- import_module parse_tree__source_file_map.
@@ -1249,10 +1250,14 @@
file_is_arch_or_grade_dependent_2("_init.$O").
%-----------------------------------------------------------------------------%
+%
+% Private interfaces (.int0 files)
+%
- % Read in the .int3 files that the current module depends on,
- % and use these to qualify all the declarations
- % as much as possible. Then write out the .int0 file.
+ % Read in the .int3 files that the current module depends on, and use
+ % these to qualify all the declarations as much as possible. Then write
+ % out the .int0 file.
+ %
make_private_interface(SourceFileName, SourceFileModuleName, ModuleName,
MaybeTimestamp, Items0, !IO) :-
grab_unqual_imported_modules(SourceFileName, SourceFileModuleName,
@@ -1281,11 +1286,9 @@
% 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),
+ handle_mutables_in_private_interface(ModuleName,
+ Items4, Items5),
MakeAbs = (pred(Item0::in, Item::out) is det :-
Item0 = Item1 - Context,
( make_abstract_instance(Item1, Item2) ->
@@ -1294,7 +1297,8 @@
Item = Item0
)
),
- list__map(MakeAbs, Items4, Items),
+ list__map(MakeAbs, Items5, Items6),
+ order_items(Items6, Items),
write_interface_file(SourceFileName, ModuleName,
".int0", MaybeTimestamp,
[make_pseudo_decl(interface) | Items], !IO),
@@ -1302,9 +1306,38 @@
)
).
+ % Expand any mutable declarations in the item list into the type and mode
+ % declarations for their access predicates. Only these components of a
+ % mutable declaration should be written to a private interface file.
+ %
+:- pred handle_mutables_in_private_interface(module_name::in,
+ item_list::in, item_list::out) is det.
+
+ handle_mutables_in_private_interface(ModuleName, !Items) :-
+ list.foldl(handle_mutable_in_private_interface(ModuleName), !.Items,
+ [], !:Items).
+
+:- pred handle_mutable_in_private_interface(module_name::in,
+ item_and_context::in, item_list::in, item_list::out) is det.
+
+handle_mutable_in_private_interface(ModuleName, Item - Context, !Items) :-
+ ( Item = mutable(MutableName, Type, _Value, Inst, _Attrs) ->
+ GetPredDecl = prog_mutable.get_pred_decl(ModuleName, MutableName,
+ Type, Inst),
+ list.cons(GetPredDecl - Context, !Items),
+ SetPredDecl = prog_mutable.set_pred_decl(ModuleName, MutableName,
+ Type, Inst),
+ list.cons(SetPredDecl - Context, !Items)
+ ;
+ list.cons(Item - Context, !Items)
+ ).
+
+%-----------------------------------------------------------------------------%
+
% Read in the .int3 files that the current module depends on,
% and use these to qualify all items in the interface as much as
% possible. Then write out the .int and .int2 files.
+ %
make_interface(SourceFileName, SourceFileModuleName, ModuleName,
MaybeTimestamp, Items0, !IO) :-
some [!InterfaceItems] (
@@ -1980,10 +2013,6 @@
% 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) :-
@@ -2012,7 +2041,7 @@
Item0 = initialise(_, _)
)
->
- split_clauses_and_decls( Items0, ClauseItems1, InterfaceItems),
+ split_clauses_and_decls(Items0, ClauseItems1, InterfaceItems),
ClauseItems = [ItemAndContext0 | ClauseItems1]
;
split_clauses_and_decls(Items0, ClauseItems, InterfaceItems1),
@@ -2408,12 +2437,13 @@
init_module_imports(SourceFileName, SourceFileModuleName, ModuleName,
Items0, PublicChildren, NestedChildren, FactDeps,
MaybeTimestamps, !:Module),
-
+
% If this module has any separately-compiled sub-modules,
% then we need to make everything in the implementation
% of this module exported_to_submodules. We do that by
% splitting out the implementation declarations and putting
% them in a special `:- private_interface' section.
+ %
get_children(Items0, Children),
(
Children = [],
Index: compiler/parse_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/parse_tree.m,v
retrieving revision 1.10
diff -u -r1.10 parse_tree.m
--- compiler/parse_tree.m 21 Mar 2005 04:45:49 -0000 1.10
+++ compiler/parse_tree.m 14 Sep 2005 16:01:58 -0000
@@ -36,6 +36,7 @@
% Utility routines.
:- include_module prog_foreign.
:- include_module prog_mode.
+:- include_module prog_mutable.
:- include_module prog_util.
:- include_module prog_type.
:- include_module error_util.
Index: compiler/prog_mutable.m
===================================================================
RCS file: compiler/prog_mutable.m
diff -N compiler/prog_mutable.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/prog_mutable.m 15 Sep 2005 04:47:30 -0000
@@ -0,0 +1,98 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Main authors: rafe, juliensf
+%
+% Utility predicates for dealing with mutable declarations.
+%
+%-----------------------------------------------------------------------------%
+
+:- module parse_tree.prog_mutable.
+
+:- interface.
+
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.prog_data.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+:- func prog_mutable.get_pred_decl(module_name, string, (type), (inst))
+ = item.
+
+:- func prog_mutable.set_pred_decl(module_name, string, (type), (inst))
+ = item.
+
+:- func prog_mutable.init_pred_decl(module_name, string) = item.
+
+ % XXX We should probably mangle Name for safety...
+ %
+:- func mutable_get_pred_sym_name(sym_name, string) = sym_name.
+
+:- func mutable_set_pred_sym_name(sym_name, string) = sym_name.
+
+:- func mutable_init_pred_sym_name(sym_name, string) = sym_name.
+
+:- func mutable_c_var_name(string) = string.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module parse_tree.prog_mode.
+:- import_module list.
+:- import_module std_util.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
+ VarSet = varset__init,
+ InstVarSet = varset__init,
+ ExistQVars = [],
+ Constraints = constraints([], []),
+ 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).
+
+set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
+ VarSet = varset__init,
+ InstVarSet = varset__init,
+ ExistQVars = [],
+ Constraints = constraints([], []),
+ 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).
+
+init_pred_decl(ModuleName, Name) = InitPredDecl :-
+ VarSet = varset__init,
+ InstVarSet = varset__init,
+ ExistQVars = [],
+ Constraints = constraints([], []),
+ InitPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars,
+ predicate, mutable_init_pred_sym_name(ModuleName, Name),
+ [], no /* with_type */, no /* with_inst */, yes(det),
+ true /* condition */, (impure), Constraints).
+
+mutable_get_pred_sym_name(ModuleName, Name) =
+ qualified(ModuleName, "get_" ++ Name).
+
+mutable_set_pred_sym_name(ModuleName, Name) =
+ qualified(ModuleName, "set_" ++ Name).
+
+mutable_init_pred_sym_name(ModuleName, Name) =
+ qualified(ModuleName, "initialise_mutable_" ++ Name).
+
+mutable_c_var_name(Name) = "mutable_variable_" ++ Name.
+
+%-----------------------------------------------------------------------------%
+:- end_module prog_mutable.
+%-----------------------------------------------------------------------------%
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.105
diff -u -r1.105 compiler_design.html
--- compiler/notes/compiler_design.html 13 Sep 2005 04:56:17 -0000 1.105
+++ compiler/notes/compiler_design.html 15 Sep 2005 05:07:45 -0000
@@ -279,7 +279,8 @@
predicates for manipulating the parse tree, prog_mode contains utility
predicates for manipulating insts and modes, prog_type contains utility
predicates for manipulating types, prog_foreign contains utility
- predicates for manipulating foreign code, while error_util.m contains
+ predicates for manipulating foreign code, prog_mutable contains utility
+ predicates for manipulating mutable variables, while error_util.m contains
predicates for printing nicely formatting error messages.
<li><p> imports and exports are handled at this point (modules.m)
Index: tests/hard_coded/sub-modules/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/sub-modules/Mmakefile,v
retrieving revision 1.11
diff -u -r1.11 Mmakefile
--- tests/hard_coded/sub-modules/Mmakefile 12 Sep 2005 03:05:49 -0000 1.11
+++ tests/hard_coded/sub-modules/Mmakefile 14 Sep 2005 15:52:34 -0000
@@ -27,7 +27,8 @@
class \
nested_intermod_main \
initialise_parent \
- ts
+ ts \
+ mutable_parent
# We currently don't do any testing in grade java on this directory.
ifneq "$(findstring java,$(GRADE))" ""
Index: tests/hard_coded/sub-modules/mutable_child.m
===================================================================
RCS file: tests/hard_coded/sub-modules/mutable_child.m
diff -N tests/hard_coded/sub-modules/mutable_child.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/mutable_child.m 14 Sep 2005 15:52:03 -0000
@@ -0,0 +1,24 @@
+:- module mutable_parent.mutable_child.
+
+:- interface.
+
+:- pred run_child(io::di, io::uo) is det.
+
+:- include_module mutable_grandchild.
+
+:- implementation.
+
+:- mutable(child_global, int, 200, ground, [untrailed, thread_safe]).
+
+run_child(!IO) :-
+ io.write_string("In child ...\n", !IO),
+ promise_pure (
+ semipure get_parent_global(ParentGlobal),
+ semipure get_child_global(ChildGlobal)
+ ),
+ io.format(" parent_global = %d\n", [i(ParentGlobal)], !IO),
+ io.format(" child_global = %d\n", [i(ChildGlobal)], !IO),
+ promise_pure (
+ impure set_parent_global(ParentGlobal + 1),
+ impure set_child_global(ChildGlobal + 1)
+ ).
Index: tests/hard_coded/sub-modules/mutable_grandchild.m
===================================================================
RCS file: tests/hard_coded/sub-modules/mutable_grandchild.m
diff -N tests/hard_coded/sub-modules/mutable_grandchild.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/mutable_grandchild.m 14 Sep 2005 15:52:03 -0000
@@ -0,0 +1,23 @@
+:- module mutable_parent.mutable_child.mutable_grandchild.
+
+:- interface.
+
+:- pred run_grandchild(io::di, io::uo) is det.
+
+:- implementation.
+
+:- mutable(grandchild_global, int, 300, ground, [untrailed, thread_safe]).
+
+run_grandchild(!IO) :-
+ io.write_string("In grandchild ...\n", !IO),
+ promise_pure (
+ semipure get_parent_global(ParentGlobal),
+ semipure get_child_global(ChildGlobal),
+ semipure get_grandchild_global(GrandChildGlobal)
+ ),
+ io.format(" parent_global = %d\n", [i(ParentGlobal)], !IO),
+ io.format(" child_global = %d\n", [i(ChildGlobal)], !IO),
+ io.format(" grandchild_global = %d\n", [i(GrandChildGlobal)], !IO),
+ promise_pure (
+ impure set_parent_global(ParentGlobal + 1)
+ ).
Index: tests/hard_coded/sub-modules/mutable_parent.exp
===================================================================
RCS file: tests/hard_coded/sub-modules/mutable_parent.exp
diff -N tests/hard_coded/sub-modules/mutable_parent.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/mutable_parent.exp 14 Sep 2005 15:52:03 -0000
@@ -0,0 +1,11 @@
+In parent ...
+ parent_global = 100
+In child ...
+ parent_global = 101
+ child_global = 200
+In grandchild ...
+ parent_global = 102
+ child_global = 201
+ grandchild_global = 300
+Back in parent ...
+ parent_global = 103
Index: tests/hard_coded/sub-modules/mutable_parent.m
===================================================================
RCS file: tests/hard_coded/sub-modules/mutable_parent.m
diff -N tests/hard_coded/sub-modules/mutable_parent.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/sub-modules/mutable_parent.m 14 Sep 2005 15:52:03 -0000
@@ -0,0 +1,42 @@
+:- module mutable_parent.
+
+:- interface.
+
+:- import_module io.
+
+:- include_module mutable_child.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+:- import_module mutable_parent.mutable_child.
+:- import_module mutable_parent.mutable_child.mutable_grandchild.
+
+:- mutable(parent_global, int, 100, ground, [untrailed, thread_safe]).
+
+main(!IO) :-
+ mutable_parent.run_parent(!IO),
+ mutable_parent.mutable_child.run_child(!IO),
+ mutable_parent.mutable_child.mutable_grandchild.run_grandchild(!IO),
+ io.write_string("Back in parent ...\n", !IO),
+ promise_pure (
+ semipure get_parent_global(ParentGlobal)
+ ),
+ io.format(" parent_global = %d\n", [i(ParentGlobal)], !IO).
+
+:- pred run_parent(io::di, io::uo) is det.
+
+run_parent(!IO) :-
+ io.write_string("In parent ...\n", !IO),
+ promise_pure (
+ semipure get_parent_global(X)
+ ),
+ io.format(" parent_global = %d\n", [i(X)], !IO),
+ promise_pure (
+ impure set_parent_global(X + 1)
+ ).
--------------------------------------------------------------------------
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