[m-rev.] diff: prog_io_sym_name and prog_io_mutable
Zoltan Somogyi
zs at csse.unimelb.edu.au
Tue Dec 2 15:29:54 AEDT 2008
Continue the breakup of the monster module prog_io.m.
compiler/prog_io.m:
compiler/prog_io_mutable.m:
compiler/prog_io_sym_name.m:
Move the code in prog_io.m for dealing with declarations for mutables
and for parsing symbol names and specifiers into two new modules.
compiler/parse_tree.m:
compiler/notes/compiler_design.html:
Add the new modules.
compiler/*.m:
Import prog_io_sym_name instead of (or, in a couple of cases, as well
as) prog_io.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/analysis.file.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/analysis.file.m,v
retrieving revision 1.9
diff -u -b -r1.9 analysis.file.m
--- compiler/analysis.file.m 29 Aug 2008 00:51:15 -0000 1.9
+++ compiler/analysis.file.m 1 Dec 2008 13:45:26 -0000
@@ -116,7 +116,7 @@
:- import_module libs.pickle.
:- import_module parse_tree.
:- import_module parse_tree.module_cmds. % XXX unwanted dependency
-:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_out.
%-----------------------------------------------------------------------------%
Index: compiler/field_access.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/field_access.m,v
retrieving revision 1.13
diff -u -b -r1.13 field_access.m
--- compiler/field_access.m 16 Jul 2008 03:30:26 -0000 1.13
+++ compiler/field_access.m 1 Dec 2008 13:45:57 -0000
@@ -107,7 +107,7 @@
:- import_module hlds.make_hlds.superhomogeneous.
:- import_module libs.compiler_util.
:- import_module parse_tree.mercury_to_mercury.
-:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module bool.
:- import_module int.
Index: compiler/make.module_dep_file.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.module_dep_file.m,v
retrieving revision 1.37
diff -u -b -r1.37 make.module_dep_file.m
--- compiler/make.module_dep_file.m 5 Sep 2008 03:57:36 -0000 1.37
+++ compiler/make.module_dep_file.m 1 Dec 2008 13:47:26 -0000
@@ -49,6 +49,7 @@
:- import_module parse_tree.read_modules.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_out.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.168
diff -u -b -r1.168 module_qual.m
--- compiler/module_qual.m 28 Jul 2008 08:34:17 -0000 1.168
+++ compiler/module_qual.m 1 Dec 2008 13:47:49 -0000
@@ -131,7 +131,7 @@
:- import_module libs.compiler_util.
:- import_module libs.options.
:- import_module parse_tree.module_imports.
-:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
Index: compiler/parse_tree.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/parse_tree.m,v
retrieving revision 1.18
diff -u -b -r1.18 parse_tree.m
--- compiler/parse_tree.m 21 Jul 2008 03:10:12 -0000 1.18
+++ compiler/parse_tree.m 1 Dec 2008 14:13:10 -0000
@@ -30,7 +30,9 @@
:- include_module prog_io.
:- include_module prog_io_dcg.
:- include_module prog_io_goal.
+ :- include_module prog_io_mutable.
:- include_module prog_io_pragma.
+ :- include_module prog_io_sym_name.
:- include_module prog_io_typeclass.
:- include_module prog_io_util.
Index: compiler/prog_ctgc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_ctgc.m,v
retrieving revision 1.21
diff -u -b -r1.21 prog_ctgc.m
--- compiler/prog_ctgc.m 16 Jul 2008 03:30:29 -0000 1.21
+++ compiler/prog_ctgc.m 1 Dec 2008 13:48:22 -0000
@@ -173,7 +173,7 @@
:- import_module libs.compiler_util.
:- import_module parse_tree.mercury_to_mercury.
-:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_io_util.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.294
diff -u -b -r1.294 prog_io.m
--- compiler/prog_io.m 28 Jul 2008 08:34:18 -0000 1.294
+++ compiler/prog_io.m 1 Dec 2008 14:50:04 -0000
@@ -182,64 +182,6 @@
%-----------------------------------------------------------------------------%
-% A QualifiedTerm is one of
-% Name(Args)
-% Module.Name(Args)
-% (or if Args is empty, one of
-% Name
-% Module.Name)
-% where Module is a SymName. For backwards compatibility, we allow `__'
-% as an alternative to `.'.
-
- % Sym_name_and_args takes a term and returns a sym_name that is its
- % top function symbol, and a list of its argument terms. It fails
- % if the input is not valid syntax for a QualifiedTerm.
- %
-:- pred sym_name_and_args(term(T)::in, sym_name::out, list(term(T))::out)
- is semidet.
-
- % parse_qualified_term(Term, _ContainingTerm, VarSet, ContextPieces,
- % Result):
- %
- % Parse Term into a sym_name that is its top function symbol and a
- % list of its argument terms, and if successful return them in Result.
- % (parse_qualified_term thus does the same job as sym_name_and_args
- % if it succeeds.) However, in case it does not succced,
- % parse_qualified_term also takes as input Varset (from which the variables
- % in Term are taken), the term containing Term, and a format_component
- % list describing the context from which it was called, e.g.
- % "In clause head:". XXX Currently, _ContainingTerm isn't used;
- % maybe it should be deleted.
- %
- % Note: parse_qualified_term is used for places where a symbol is _used_,
- % where no default module name exists for the sym_name. For places
- % where a symbol is _defined_, use parse_implicitly_qualified_term.
- %
- % If you care only about the case where Result = ok2(SymName, Args),
- % use sym_name_and_args.
- %
-:- pred parse_qualified_term(term(T)::in, term(T)::in, varset::in,
- list(format_component)::in, maybe_functor(T)::out) is det.
-
- % parse_implicitly_qualified_term(ModuleName, Term, _ContainingTerm,
- % VarSet, ContextPieces, Result):
- %
- % Parse Term into a sym_name that is its top function symbol and a
- % list of its argument terms, and if successful return them in Result.
- % This predicate thus does almost the same job as the predicate
- % parse_implicitly_qualified_term above, the difference being that
- % that if the sym_name is qualified, then we check whether it is qualified
- % with ModuleName, and if it isn't qualified, then we qualify it with
- % Modulename (unless ModuleName is root_module_name). This is the
- % right thing to do for clause heads, which is the intended job of
- % parse_implicitly_qualified_term.
- %
-:- pred parse_implicitly_qualified_term(module_name::in, term(T)::in,
- term(T)::in, varset::in, list(format_component)::in, maybe_functor(T)::out)
- is det.
-
-%-----------------------------------------------------------------------------%
-
% Replace all occurrences of inst_var(I) with
% constrained_inst_var(I, ground(shared, none)).
%
@@ -272,7 +214,9 @@
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_io_dcg.
:- import_module parse_tree.prog_io_goal.
+:- import_module parse_tree.prog_io_mutable.
:- import_module parse_tree.prog_io_pragma.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_io_typeclass.
:- import_module parse_tree.prog_io_util.
:- import_module parse_tree.prog_mode.
@@ -483,20 +427,21 @@
:- pred search_for_module_source_2(list(dir_name)::in, module_name::in,
module_name::in, maybe_error(file_name)::out, io::di, io::uo) is det.
-search_for_module_source_2(Dirs, ModuleName, PartialModuleName, Result, !IO) :-
+search_for_module_source_2(Dirs, ModuleName, PartialModuleName, MaybeFileName,
+ !IO) :-
module_name_to_file_name(PartialModuleName, ".m", do_not_create_dirs,
FileName, !IO),
- search_for_file(Dirs, FileName, Result0, !IO),
+ search_for_file(Dirs, FileName, MaybeFileName0, !IO),
(
- Result0 = ok(_),
- Result = Result0
+ MaybeFileName0 = ok(_),
+ MaybeFileName = MaybeFileName0
;
- Result0 = error(_),
+ MaybeFileName0 = error(_),
( PartialModuleName1 = drop_one_qualifier(PartialModuleName) ->
search_for_module_source_2(Dirs, ModuleName, PartialModuleName1,
- Result, !IO)
+ MaybeFileName, !IO)
;
- Result = error(find_source_error(ModuleName, Dirs, no))
+ MaybeFileName = error(find_source_error(ModuleName, Dirs, no))
)
).
@@ -1581,7 +1526,7 @@
ModuleName, VarSet, MaybeWhereTerm),
% The code to process `where' attributes will return an error
% if solver attributes are given for a non-solver type. Because
- % this is a du type, if the unification with WhereResult succeeds
+ % this is a du type, if the unification with MaybeWhere succeeds
% then _NoSolverTypeDetails is guaranteed to be `no'.
(
MaybeTypeCtorAndArgs = ok2(Name, Params),
@@ -1780,24 +1725,25 @@
term, list(term)) = maybe1(list(constructor_arg)).
convert_constructor_arg_list_2(ModuleName, VarSet, MaybeFieldName,
- TypeTerm, Terms) = Result :-
+ TypeTerm, Terms) = MaybeArgs :-
ContextPieces = [words("In type definition:")],
- parse_type(TypeTerm, VarSet, ContextPieces, TypeResult),
+ parse_type(TypeTerm, VarSet, ContextPieces, MaybeType),
(
- TypeResult = ok1(Type),
+ MaybeType = ok1(Type),
Context = get_term_context(TypeTerm),
Arg = ctor_arg(MaybeFieldName, Type, Context),
- Result0 = convert_constructor_arg_list(ModuleName, VarSet, Terms),
+ MaybeTailArgs =
+ convert_constructor_arg_list(ModuleName, VarSet, Terms),
(
- Result0 = error1(Specs),
- Result = error1(Specs)
+ MaybeTailArgs = error1(Specs),
+ MaybeArgs = error1(Specs)
;
- Result0 = ok1(Args),
- Result = ok1([Arg | Args])
+ MaybeTailArgs = ok1(Args),
+ MaybeArgs = ok1([Arg | Args])
)
;
- TypeResult = error1(Specs),
- Result = error1(Specs)
+ MaybeType = error1(Specs),
+ MaybeArgs = error1(Specs)
).
:- pred process_du_ctors(list(type_param)::in, varset::in, term::in,
@@ -2282,30 +2228,31 @@
:- func parse_where_pred_is(module_name, varset, term) = maybe1(sym_name).
-parse_where_pred_is(ModuleName, VarSet, Term) = Result :-
- parse_implicitly_qualified_symbol_name(ModuleName, VarSet, Term, Result).
+parse_where_pred_is(ModuleName, VarSet, Term) = MaybeSymName :-
+ parse_implicitly_qualified_symbol_name(ModuleName, VarSet, Term,
+ MaybeSymName).
:- func parse_where_inst_is(module_name, term) = maybe1(mer_inst).
-parse_where_inst_is(_ModuleName, Term) = Result :-
+parse_where_inst_is(_ModuleName, Term) = MaybeInst :-
(
convert_inst(no_allow_constrained_inst_var, Term, Inst),
not inst_contains_unconstrained_var(Inst)
->
- Result = ok1(Inst)
+ MaybeInst = ok1(Inst)
;
Pieces = [words("Error: expected a ground, unconstrained inst."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_term_context(Term), [always(Pieces)])]),
- Result = error1([Spec])
+ MaybeInst = error1([Spec])
).
:- func parse_where_type_is(module_name, varset, term) = maybe1(mer_type).
-parse_where_type_is(_ModuleName, VarSet, Term) = Result :-
+parse_where_type_is(_ModuleName, VarSet, Term) = MaybeType :-
% XXX We should pass meaningful ContextPieces.
ContextPieces = [],
- parse_type(Term, VarSet, ContextPieces, Result).
+ parse_type(Term, VarSet, ContextPieces, MaybeType).
:- func parse_where_mutable_is(module_name, term) = maybe1(list(item)).
@@ -3503,8 +3450,8 @@
->
parse_class_and_inst_constraints(ModuleName, VarSet, ConstraintsTerm,
MaybeHeadConstraints),
- % there may be more constraints of the same type --
- % collect them all and combine them
+ % There may be more constraints of the same type;
+ % collect them all and combine them.
get_constraints(QuantType, ModuleName, VarSet, !Attributes,
MaybeTailConstraints),
(
@@ -3570,311 +3517,6 @@
%-----------------------------------------------------------------------------%
-:- pred parse_initialise_decl(module_name::in, varset::in, term::in,
- prog_context::in, int::in, maybe1(item)::out) is det.
-
-parse_initialise_decl(_ModuleName, VarSet, Term, Context, SeqNum, MaybeItem) :-
- parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier),
- (
- MaybeSymNameSpecifier = error1(Specs),
- MaybeItem = error1(Specs)
- ;
- MaybeSymNameSpecifier = ok1(SymNameSpecifier),
- (
- SymNameSpecifier = name(_),
- TermStr = describe_error_term(VarSet, Term),
- Pieces = [words("Error:"), quote("initialise"),
- words("declaration"), words("requires arity, found"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- ;
- SymNameSpecifier = name_arity(SymName, Arity),
- (
- ( Arity = 0 ; Arity = 2 )
- ->
- ItemInitialise = item_initialise_info(user, SymName, Arity,
- Context, SeqNum),
- Item = item_initialise(ItemInitialise),
- MaybeItem = ok1(Item)
- ;
- TermStr = describe_error_term(VarSet, Term),
- Pieces = [words("Error:"), quote("initialise"),
- words("declaration specifies a predicate"),
- words("whose arity is not zero or two:"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- )
- )
- ).
-
-%-----------------------------------------------------------------------------%
-
-:- pred parse_finalise_decl(module_name::in, varset::in, term::in,
- prog_context::in, int::in, maybe1(item)::out) is det.
-
-parse_finalise_decl(_ModuleName, VarSet, Term, Context, SeqNum, MaybeItem) :-
- parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier),
- (
- MaybeSymNameSpecifier = error1(Specs),
- MaybeItem = error1(Specs)
- ;
- MaybeSymNameSpecifier = ok1(SymNameSpecifier),
- (
- SymNameSpecifier = name(_),
- TermStr = describe_error_term(VarSet, Term),
- Pieces = [words("Error:"), quote("finalise"),
- words("declaration"), words("requires arity, found"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- ;
- SymNameSpecifier = name_arity(SymName, Arity),
- (
- ( Arity = 0 ; Arity = 2 )
- ->
- ItemFinalise = item_finalise_info(user, SymName, Arity,
- Context, SeqNum),
- Item = item_finalise(ItemFinalise),
- MaybeItem = ok1(Item)
- ;
- TermStr = describe_error_term(VarSet, Term),
- Pieces = [words("Error:"), quote("finalise"),
- words("declaration specifies a predicate"),
- words("whose arity is not zero or two:"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeItem = error1([Spec])
- )
- )
- ).
-
-%-----------------------------------------------------------------------------%
-%
-% Mutable declarations
-%
-% See prog_mutable.m for implementation details.
-%
-
-:- pred parse_mutable_decl(module_name::in, varset::in, list(term)::in,
- prog_context::in, int::in, maybe1(item)::out) is semidet.
-
-parse_mutable_decl(_ModuleName, VarSet, Terms, Context, SeqNum, MaybeItem) :-
- Terms = [NameTerm, TypeTerm, ValueTerm, InstTerm | OptMutAttrsTerm],
- parse_mutable_name(NameTerm, MaybeName),
- parse_mutable_type(VarSet, TypeTerm, MaybeType),
- term.coerce(ValueTerm, Value),
- varset.coerce(VarSet, ProgVarSet),
- parse_mutable_inst(VarSet, InstTerm, MaybeInst),
-
- % The list of attributes is optional.
- (
- OptMutAttrsTerm = [],
- MaybeMutAttrs = ok1(default_mutable_attributes)
- ;
- OptMutAttrsTerm = [MutAttrsTerm],
- parse_mutable_attrs(VarSet, MutAttrsTerm, MaybeMutAttrs)
- ),
- (
- MaybeName = ok1(Name),
- MaybeType = ok1(Type),
- MaybeInst = ok1(Inst),
- MaybeMutAttrs = ok1(MutAttrs)
- ->
- % We *must* attach the varset to the mutable item because if the
- % initial value is non-ground, then the initial value will be a
- % variable and the mutable initialisation predicate will contain
- % references to it. Ignoring the varset may lead to later compiler
- % passes attempting to reuse this variable when fresh variables are
- % allocated.
- ItemMutable = item_mutable_info(Name, Type, Value, Inst, MutAttrs,
- ProgVarSet, Context, SeqNum),
- Item = item_mutable(ItemMutable),
- MaybeItem = ok1(Item)
- ;
- Specs = get_any_errors1(MaybeName) ++ get_any_errors1(MaybeType) ++
- get_any_errors1(MaybeInst) ++ get_any_errors1(MaybeMutAttrs),
- MaybeItem = error1(Specs)
- ).
-
-:- pred parse_mutable_name(term::in, maybe1(string)::out) is det.
-
-parse_mutable_name(NameTerm, MaybeName) :-
- ( NameTerm = term.functor(atom(Name), [], _) ->
- MaybeName = ok1(Name)
- ;
- Pieces = [words("Error: invalid mutable name."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(NameTerm), [always(Pieces)])]),
- MaybeName = error1([Spec])
- ).
-
-:- pred parse_mutable_type(varset::in, term::in, maybe1(mer_type)::out) is det.
-
-parse_mutable_type(VarSet, TypeTerm, MaybeType) :-
- ( term.contains_var(TypeTerm, _) ->
- TypeTermStr = describe_error_term(VarSet, TypeTerm),
- Pieces = [words("Error: the type in a mutable declaration"),
- words("cannot contain variables:"),
- words(TypeTermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(TypeTerm), [always(Pieces)])]),
- MaybeType = error1([Spec])
- ;
- ContextPieces = [],
- parse_type(TypeTerm, VarSet, ContextPieces, MaybeType)
- ).
-
-:- pred parse_mutable_inst(varset::in, term::in, maybe1(mer_inst)::out) is det.
-
-parse_mutable_inst(VarSet, InstTerm, MaybeInst) :-
- ( term.contains_var(InstTerm, _) ->
- InstTermStr = describe_error_term(VarSet, InstTerm),
- Pieces = [words("Error: the inst in a mutable declaration"),
- words("cannot contain variables:"),
- words(InstTermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(InstTerm), [always(Pieces)])]),
- MaybeInst = error1([Spec])
- ; convert_inst(no_allow_constrained_inst_var, InstTerm, Inst) ->
- MaybeInst = ok1(Inst)
- ;
- Pieces = [words("Error: invalid inst in mutable declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(InstTerm), [always(Pieces)])]),
- MaybeInst = error1([Spec])
- ).
-
-:- type collected_mutable_attribute
- ---> mutable_attr_trailed(mutable_trailed)
- ; mutable_attr_foreign_name(foreign_name)
- ; mutable_attr_attach_to_io_state(bool)
- ; mutable_attr_constant(bool)
- ; mutable_attr_thread_local(mutable_thread_local).
-
-:- pred parse_mutable_attrs(varset::in, term::in,
- maybe1(mutable_var_attributes)::out) is det.
-
-parse_mutable_attrs(VarSet, MutAttrsTerm, MaybeMutAttrs) :-
- Attributes0 = default_mutable_attributes,
- ConflictingAttributes = [
- mutable_attr_trailed(mutable_trailed) -
- mutable_attr_trailed(mutable_untrailed),
- mutable_attr_trailed(mutable_trailed) -
- mutable_attr_thread_local(mutable_thread_local),
- mutable_attr_constant(yes) - mutable_attr_trailed(mutable_trailed),
- mutable_attr_constant(yes) - mutable_attr_attach_to_io_state(yes),
- mutable_attr_constant(yes) -
- mutable_attr_thread_local(mutable_thread_local)
- ],
- (
- list_term_to_term_list(MutAttrsTerm, MutAttrTerms),
- map_parser(parse_mutable_attr, MutAttrTerms, MaybeAttrList),
- MaybeAttrList = ok1(CollectedMutAttrs)
- ->
- % We check for trailed/untrailed, constant/trailed,
- % trailed/thread_local, constant/attach_to_io_state,
- % constant/thread_local conflicts here and deal with conflicting
- % foreign_name attributes in make_hlds_passes.m.
- (
- list.member(Conflict1 - Conflict2, ConflictingAttributes),
- list.member(Conflict1, CollectedMutAttrs),
- list.member(Conflict2, CollectedMutAttrs)
- ->
- % XXX Should generate more specific error message.
- MutAttrsStr = mercury_term_to_string(VarSet, no, MutAttrsTerm),
- Pieces = [words("Error: conflicting attributes"),
- words("in attribute list:"), nl,
- words(MutAttrsStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(MutAttrsTerm),
- [always(Pieces)])]),
- MaybeMutAttrs = error1([Spec])
- ;
- list.foldl(process_mutable_attribute, CollectedMutAttrs,
- Attributes0, Attributes),
- MaybeMutAttrs = ok1(Attributes)
- )
- ;
- MutAttrsStr = mercury_term_to_string(VarSet, no, MutAttrsTerm),
- Pieces = [words("Error: malformed attribute list"),
- words("in mutable declaration:"),
- words(MutAttrsStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(MutAttrsTerm), [always(Pieces)])]),
- MaybeMutAttrs = error1([Spec])
- ).
-
-:- pred process_mutable_attribute(collected_mutable_attribute::in,
- mutable_var_attributes::in, mutable_var_attributes::out) is det.
-
-process_mutable_attribute(mutable_attr_trailed(Trailed), !Attributes) :-
- set_mutable_var_trailed(Trailed, !Attributes).
-process_mutable_attribute(mutable_attr_foreign_name(ForeignName),
- !Attributes) :-
- set_mutable_add_foreign_name(ForeignName, !Attributes).
-process_mutable_attribute(mutable_attr_attach_to_io_state(AttachToIOState),
- !Attributes) :-
- set_mutable_var_attach_to_io_state(AttachToIOState, !Attributes).
-process_mutable_attribute(mutable_attr_constant(Constant), !Attributes) :-
- set_mutable_var_constant(Constant, !Attributes),
- (
- Constant = yes,
- set_mutable_var_trailed(mutable_untrailed, !Attributes),
- set_mutable_var_attach_to_io_state(no, !Attributes)
- ;
- Constant = no
- ).
-process_mutable_attribute(mutable_attr_thread_local(ThrLocal), !Attributes) :-
- set_mutable_var_thread_local(ThrLocal, !Attributes).
-
-:- pred parse_mutable_attr(term::in,
- maybe1(collected_mutable_attribute)::out) is det.
-
-parse_mutable_attr(MutAttrTerm, MutAttrResult) :-
- (
- MutAttrTerm = term.functor(term.atom(String), [], _),
- (
- String = "untrailed",
- MutAttr = mutable_attr_trailed(mutable_untrailed)
- ;
- String = "trailed",
- MutAttr = mutable_attr_trailed(mutable_trailed)
- ;
- String = "attach_to_io_state",
- MutAttr = mutable_attr_attach_to_io_state(yes)
- ;
- String = "constant",
- MutAttr = mutable_attr_constant(yes)
- ;
- String = "thread_local",
- MutAttr = mutable_attr_thread_local(mutable_thread_local)
- )
- ->
- MutAttrResult = ok1(MutAttr)
- ;
- MutAttrTerm = term.functor(term.atom("foreign_name"), Args, _),
- Args = [LangTerm, ForeignNameTerm],
- parse_foreign_language(LangTerm, Lang),
- ForeignNameTerm = term.functor(term.string(ForeignName), [], _)
- ->
- MutAttr = mutable_attr_foreign_name(foreign_name(Lang, ForeignName)),
- MutAttrResult = ok1(MutAttr)
- ;
- Pieces = [words("Error: unrecognised attribute"),
- words("in mutable declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(MutAttrTerm), [always(Pieces)])]),
- MutAttrResult = error1([Spec])
- ).
-
-%-----------------------------------------------------------------------------%
-
% parse_condition_suffix(Term, BeforeCondTerm, Condition):
%
% Bind Condition to a representation of the 'where' condition of Term,
@@ -4287,250 +3929,6 @@
%-----------------------------------------------------------------------------%
- % A SymbolNameSpecifier is one of
- % SymbolName
- % SymbolName/Arity
- % Matches only symbols of the specified arity.
- %
-:- pred parse_symbol_name_specifier(varset::in, term::in,
- maybe1(sym_name_specifier)::out) is det.
-
-parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier) :-
- root_module_name(DefaultModule),
- parse_implicitly_qualified_symbol_name_specifier(DefaultModule, VarSet,
- Term, MaybeSymNameSpecifier).
-
-:- pred parse_implicitly_qualified_symbol_name_specifier(module_name::in,
- varset::in, term::in, maybe1(sym_name_specifier)::out) is det.
-
-parse_implicitly_qualified_symbol_name_specifier(DefaultModule, VarSet, Term,
- MaybeSymNameSpecifier) :-
- ( Term = term.functor(term.atom("/"), [NameTerm, ArityTerm], _) ->
- ( ArityTerm = term.functor(term.integer(Arity), [], _) ->
- ( Arity >= 0 ->
- parse_implicitly_qualified_symbol_name(DefaultModule, VarSet,
- NameTerm, MaybeName),
- process_maybe1(make_name_arity_specifier(Arity),
- MaybeName, MaybeSymNameSpecifier)
- ;
- Pieces = [words("Error: arity in symbol name specifier"),
- words("must be a non-negative integer."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeSymNameSpecifier = error1([Spec])
- )
- ;
- Pieces = [words("Error: arity in symbol name specifier"),
- words("must be an integer."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeSymNameSpecifier = error1([Spec])
- )
- ;
- parse_implicitly_qualified_symbol_name(DefaultModule, VarSet, Term,
- MaybeSymbolName),
- process_maybe1(make_name_specifier, MaybeSymbolName,
- MaybeSymNameSpecifier)
- ).
-
-%-----------------------------------------------------------------------------%
-
- % A SymbolName is one of
- % Name
- % Matches symbols with the specified name in the
- % current namespace.
- % Module.Name
- % Matches symbols with the specified name exported
- % by the specified module (where Module is itself a SymbolName).
- %
- % We also allow the syntax `Module__Name' as an alternative
- % for `Module.Name'.
- %
-:- pred parse_symbol_name(varset(T)::in, term(T)::in, maybe1(sym_name)::out)
- is det.
-
-parse_symbol_name(VarSet, Term, MaybeSymName) :-
- (
- Term = term.functor(term.atom(FunctorName), [ModuleTerm, NameTerm],
- TermContext),
- ( FunctorName = ":"
- ; FunctorName = "."
- )
- ->
- ( NameTerm = term.functor(term.atom(Name), [], _) ->
- parse_symbol_name(VarSet, ModuleTerm, MaybeModule),
- (
- MaybeModule = ok1(Module),
- MaybeSymName = ok1(qualified(Module, Name))
- ;
- MaybeModule = error1(_ModuleResultSpecs),
- % XXX We should say "module name" OR "identifier", not both.
- Pieces = [words("Error: module name identifier"),
- words("expected before"), quote(FunctorName),
- words("in qualified symbol name."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(TermContext, [always(Pieces)])]),
- % XXX Should we include _ModuleResultSpecs?
- MaybeSymName = error1([Spec])
- )
- ;
- Pieces = [words("Error: identifier expected after"),
- quote(FunctorName), words("in qualified symbol name."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(TermContext, [always(Pieces)])]),
- MaybeSymName = error1([Spec])
- )
- ;
- ( Term = term.functor(term.atom(Name), [], _) ->
- SymName = string_to_sym_name_sep(Name, "__"),
- MaybeSymName = ok1(SymName)
- ;
- TermStr = describe_error_term(VarSet, Term),
- Pieces = [words("Error: symbol name expected at"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeSymName = error1([Spec])
- )
- ).
-
-:- pred parse_implicitly_qualified_symbol_name(module_name::in, varset::in,
- term::in, maybe1(sym_name)::out) is det.
-
-parse_implicitly_qualified_symbol_name(DefaultModName, VarSet, Term,
- MaybeSymName) :-
- parse_symbol_name(VarSet, Term, MaybeSymName0),
- (
- MaybeSymName0 = ok1(SymName),
- (
- root_module_name(DefaultModName)
- ->
- MaybeSymName = MaybeSymName0
- ;
- SymName = qualified(ModName, _),
- \+ match_sym_name(ModName, DefaultModName)
- ->
- Pieces = [words("Error: module qualifier in definition"),
- words("does not match preceding"), quote(":- module"),
- words("declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeSymName = error1([Spec])
-
- ;
- UnqualName = unqualify_name(SymName),
- MaybeSymName = ok1(qualified(DefaultModName, UnqualName))
- )
- ;
- MaybeSymName0 = error1(_),
- MaybeSymName = MaybeSymName0
- ).
-
-%-----------------------------------------------------------------------------%
-
-parse_implicitly_qualified_term(DefaultModuleName, Term, ContainingTerm,
- VarSet, ContextPieces, MaybeSymNameAndArgs) :-
- parse_qualified_term(Term, ContainingTerm, VarSet, ContextPieces,
- MaybeSymNameAndArgs0),
- (
- MaybeSymNameAndArgs0 = ok2(SymName, Args),
- (
- root_module_name(DefaultModuleName)
- ->
- MaybeSymNameAndArgs = MaybeSymNameAndArgs0
- ;
- SymName = qualified(ModuleName, _),
- \+ match_sym_name(ModuleName, DefaultModuleName)
- ->
- Pieces = [words("Error: module qualifier in definition"),
- words("does not match preceding"), quote(":- module"),
- words("declaration."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeSymNameAndArgs = error2([Spec])
- ;
- UnqualName = unqualify_name(SymName),
- QualSymName = qualified(DefaultModuleName, UnqualName),
- MaybeSymNameAndArgs = ok2(QualSymName, Args)
- )
- ;
- MaybeSymNameAndArgs0 = error2(_),
- MaybeSymNameAndArgs = MaybeSymNameAndArgs0
- ).
-
-sym_name_and_args(Term, SymName, Args) :-
- % The values of VarSet and ContextPieces do not matter here, since
- % we succeed only if they aren't used.
- VarSet = varset.init,
- ContextPieces = [],
- parse_qualified_term(Term, Term, VarSet, ContextPieces,
- ok2(SymName, Args)).
-
-parse_qualified_term(Term, _ContainingTerm, VarSet, ContextPieces,
- MaybeSymNameAndArgs) :-
- % XXX We should delete the _ContainingTerm argument.
- (
- Term = term.functor(Functor, FunctorArgs, TermContext),
- Functor = term.atom("."),
- FunctorArgs = [ModuleTerm, NameArgsTerm]
- ->
- ( NameArgsTerm = term.functor(term.atom(Name), Args, _) ->
- varset.coerce(VarSet, GenericVarSet),
- parse_symbol_name(GenericVarSet, ModuleTerm, MaybeModule),
- (
- MaybeModule = ok1(Module),
- MaybeSymNameAndArgs = ok2(qualified(Module, Name), Args)
- ;
- MaybeModule = error1(_),
- ModuleTermStr = describe_error_term(GenericVarSet, ModuleTerm),
- % XXX We should say "module name" OR "identifier", not both.
- Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Error: module name identifier expected before '.'"),
- words("in qualified symbol name, not"),
- words(ModuleTermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(TermContext, [always(Pieces)])]),
- MaybeSymNameAndArgs = error2([Spec])
- )
- ;
- varset.coerce(VarSet, GenericVarSet),
- TermStr = describe_error_term(GenericVarSet, Term),
- Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Error: identifier expected after '.'"),
- words("in qualified symbol name, not"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(TermContext, [always(Pieces)])]),
- MaybeSymNameAndArgs = error2([Spec])
- )
- ;
- varset.coerce(VarSet, GenericVarSet),
- ( Term = term.functor(term.atom(Name), Args, _) ->
- SymName = string_to_sym_name_sep(Name, "__"),
- MaybeSymNameAndArgs = ok2(SymName, Args)
- ;
- TermStr = describe_error_term(GenericVarSet, Term),
- Pieces = ContextPieces ++ [lower_case_next_if_not_first,
- words("Error: atom expected at"),
- words(TermStr), suffix("."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(Term), [always(Pieces)])]),
- MaybeSymNameAndArgs = error2([Spec])
- )
- ).
-
-%-----------------------------------------------------------------------------%
-
- % We use the empty module name ('') as the "root" module name; when adding
- % default module qualifiers in parse_implicitly_qualified_{term,symbol},
- % if the default module is the root module then we don't add any qualifier.
- %
-:- pred root_module_name(module_name::out) is det.
-
-root_module_name(unqualified("")).
-
-%-----------------------------------------------------------------------------%
-
:- pred get_is_solver_type(is_solver_type::out,
decl_attrs::in, decl_attrs::out) is det.
@@ -4594,17 +3992,6 @@
%-----------------------------------------------------------------------------%
-:- pred make_name_arity_specifier(arity::in, sym_name::in,
- sym_name_specifier::out) is det.
-
-make_name_arity_specifier(Arity, Name, name_arity(Name, Arity)).
-
-:- pred make_name_specifier(sym_name::in, sym_name_specifier::out) is det.
-
-make_name_specifier(Name, name(Name)).
-
-%-----------------------------------------------------------------------------%
-
:- pred make_module_defn(maker(list(module_specifier), module_defn)::maker,
prog_context::in, int::in, list(module_specifier)::in, item::out) is det.
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.45
diff -u -b -r1.45 prog_io_dcg.m
--- compiler/prog_io_dcg.m 28 Jul 2008 08:34:18 -0000 1.45
+++ compiler/prog_io_dcg.m 1 Dec 2008 13:50:43 -0000
@@ -50,8 +50,8 @@
:- implementation.
-:- import_module parse_tree.prog_io.
:- import_module parse_tree.prog_io_goal.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_util.
:- import_module parse_tree.prog_out.
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.56
diff -u -b -r1.56 prog_io_goal.m
--- compiler/prog_io_goal.m 24 Jul 2008 06:20:32 -0000 1.56
+++ compiler/prog_io_goal.m 1 Dec 2008 13:51:39 -0000
@@ -93,6 +93,7 @@
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_io_util.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
Index: compiler/prog_io_mutable.m
===================================================================
RCS file: compiler/prog_io_mutable.m
diff -N compiler/prog_io_mutable.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/prog_io_mutable.m 1 Dec 2008 14:05:08 -0000
@@ -0,0 +1,331 @@
+%-----------------------------------------------------------------------------e
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------e
+% Copyright (C) 2008 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.
+%-----------------------------------------------------------------------------%
+%
+% File: prog_io_mutable.m.
+%
+% This module defines predicates for parsing the parts of Mercury programs
+% relating to initialise, finalise and mutable declarations.
+
+:- module parse_tree.prog_io_mutable.
+
+:- interface.
+
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_io_util.
+:- import_module parse_tree.prog_item.
+
+:- import_module list.
+:- import_module term.
+:- import_module varset.
+
+:- pred parse_initialise_decl(module_name::in, varset::in, term::in,
+ prog_context::in, int::in, maybe1(item)::out) is det.
+
+:- pred parse_finalise_decl(module_name::in, varset::in, term::in,
+ prog_context::in, int::in, maybe1(item)::out) is det.
+
+:- pred parse_mutable_decl(module_name::in, varset::in, list(term)::in,
+ prog_context::in, int::in, maybe1(item)::out) is semidet.
+
+%-----------------------------------------------------------------------------e
+
+:- implementation.
+
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.prog_io_pragma.
+:- import_module parse_tree.prog_io_sym_name.
+
+:- import_module bool.
+:- import_module pair.
+
+%-----------------------------------------------------------------------------e
+
+parse_initialise_decl(_ModuleName, VarSet, Term, Context, SeqNum, MaybeItem) :-
+ parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier),
+ (
+ MaybeSymNameSpecifier = error1(Specs),
+ MaybeItem = error1(Specs)
+ ;
+ MaybeSymNameSpecifier = ok1(SymNameSpecifier),
+ (
+ SymNameSpecifier = name(_),
+ TermStr = describe_error_term(VarSet, Term),
+ Pieces = [words("Error:"), quote("initialise"),
+ words("declaration"), words("requires arity, found"),
+ words(TermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeItem = error1([Spec])
+ ;
+ SymNameSpecifier = name_arity(SymName, Arity),
+ ( ( Arity = 0 ; Arity = 2 ) ->
+ ItemInitialise = item_initialise_info(user, SymName, Arity,
+ Context, SeqNum),
+ Item = item_initialise(ItemInitialise),
+ MaybeItem = ok1(Item)
+ ;
+ TermStr = describe_error_term(VarSet, Term),
+ Pieces = [words("Error:"), quote("initialise"),
+ words("declaration specifies a predicate"),
+ words("whose arity is not zero or two:"),
+ words(TermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeItem = error1([Spec])
+ )
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+parse_finalise_decl(_ModuleName, VarSet, Term, Context, SeqNum, MaybeItem) :-
+ parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier),
+ (
+ MaybeSymNameSpecifier = error1(Specs),
+ MaybeItem = error1(Specs)
+ ;
+ MaybeSymNameSpecifier = ok1(SymNameSpecifier),
+ (
+ SymNameSpecifier = name(_),
+ TermStr = describe_error_term(VarSet, Term),
+ Pieces = [words("Error:"), quote("finalise"),
+ words("declaration"), words("requires arity, found"),
+ words(TermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeItem = error1([Spec])
+ ;
+ SymNameSpecifier = name_arity(SymName, Arity),
+ ( ( Arity = 0 ; Arity = 2 ) ->
+ ItemFinalise = item_finalise_info(user, SymName, Arity,
+ Context, SeqNum),
+ Item = item_finalise(ItemFinalise),
+ MaybeItem = ok1(Item)
+ ;
+ TermStr = describe_error_term(VarSet, Term),
+ Pieces = [words("Error:"), quote("finalise"),
+ words("declaration specifies a predicate"),
+ words("whose arity is not zero or two:"),
+ words(TermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeItem = error1([Spec])
+ )
+ )
+ ).
+
+parse_mutable_decl(_ModuleName, VarSet, Terms, Context, SeqNum, MaybeItem) :-
+ Terms = [NameTerm, TypeTerm, ValueTerm, InstTerm | OptMutAttrsTerm],
+ parse_mutable_name(NameTerm, MaybeName),
+ parse_mutable_type(VarSet, TypeTerm, MaybeType),
+ term.coerce(ValueTerm, Value),
+ varset.coerce(VarSet, ProgVarSet),
+ parse_mutable_inst(VarSet, InstTerm, MaybeInst),
+
+ % The list of attributes is optional.
+ (
+ OptMutAttrsTerm = [],
+ MaybeMutAttrs = ok1(default_mutable_attributes)
+ ;
+ OptMutAttrsTerm = [MutAttrsTerm],
+ parse_mutable_attrs(VarSet, MutAttrsTerm, MaybeMutAttrs)
+ ),
+ (
+ MaybeName = ok1(Name),
+ MaybeType = ok1(Type),
+ MaybeInst = ok1(Inst),
+ MaybeMutAttrs = ok1(MutAttrs)
+ ->
+ % We *must* attach the varset to the mutable item because if the
+ % initial value is non-ground, then the initial value will be a
+ % variable and the mutable initialisation predicate will contain
+ % references to it. Ignoring the varset may lead to later compiler
+ % passes attempting to reuse this variable when fresh variables are
+ % allocated.
+ ItemMutable = item_mutable_info(Name, Type, Value, Inst, MutAttrs,
+ ProgVarSet, Context, SeqNum),
+ Item = item_mutable(ItemMutable),
+ MaybeItem = ok1(Item)
+ ;
+ Specs = get_any_errors1(MaybeName) ++ get_any_errors1(MaybeType) ++
+ get_any_errors1(MaybeInst) ++ get_any_errors1(MaybeMutAttrs),
+ MaybeItem = error1(Specs)
+ ).
+
+:- pred parse_mutable_name(term::in, maybe1(string)::out) is det.
+
+parse_mutable_name(NameTerm, MaybeName) :-
+ ( NameTerm = term.functor(atom(Name), [], _) ->
+ MaybeName = ok1(Name)
+ ;
+ Pieces = [words("Error: invalid mutable name."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(NameTerm), [always(Pieces)])]),
+ MaybeName = error1([Spec])
+ ).
+
+:- pred parse_mutable_type(varset::in, term::in, maybe1(mer_type)::out) is det.
+
+parse_mutable_type(VarSet, TypeTerm, MaybeType) :-
+ ( term.contains_var(TypeTerm, _) ->
+ TypeTermStr = describe_error_term(VarSet, TypeTerm),
+ Pieces = [words("Error: the type in a mutable declaration"),
+ words("cannot contain variables:"),
+ words(TypeTermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(TypeTerm), [always(Pieces)])]),
+ MaybeType = error1([Spec])
+ ;
+ ContextPieces = [],
+ parse_type(TypeTerm, VarSet, ContextPieces, MaybeType)
+ ).
+
+:- pred parse_mutable_inst(varset::in, term::in, maybe1(mer_inst)::out) is det.
+
+parse_mutable_inst(VarSet, InstTerm, MaybeInst) :-
+ ( term.contains_var(InstTerm, _) ->
+ InstTermStr = describe_error_term(VarSet, InstTerm),
+ Pieces = [words("Error: the inst in a mutable declaration"),
+ words("cannot contain variables:"),
+ words(InstTermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(InstTerm), [always(Pieces)])]),
+ MaybeInst = error1([Spec])
+ ; convert_inst(no_allow_constrained_inst_var, InstTerm, Inst) ->
+ MaybeInst = ok1(Inst)
+ ;
+ Pieces = [words("Error: invalid inst in mutable declaration."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(InstTerm), [always(Pieces)])]),
+ MaybeInst = error1([Spec])
+ ).
+
+:- type collected_mutable_attribute
+ ---> mutable_attr_trailed(mutable_trailed)
+ ; mutable_attr_foreign_name(foreign_name)
+ ; mutable_attr_attach_to_io_state(bool)
+ ; mutable_attr_constant(bool)
+ ; mutable_attr_thread_local(mutable_thread_local).
+
+:- pred parse_mutable_attrs(varset::in, term::in,
+ maybe1(mutable_var_attributes)::out) is det.
+
+parse_mutable_attrs(VarSet, MutAttrsTerm, MaybeMutAttrs) :-
+ Attributes0 = default_mutable_attributes,
+ ConflictingAttributes = [
+ mutable_attr_trailed(mutable_trailed) -
+ mutable_attr_trailed(mutable_untrailed),
+ mutable_attr_trailed(mutable_trailed) -
+ mutable_attr_thread_local(mutable_thread_local),
+ mutable_attr_constant(yes) - mutable_attr_trailed(mutable_trailed),
+ mutable_attr_constant(yes) - mutable_attr_attach_to_io_state(yes),
+ mutable_attr_constant(yes) -
+ mutable_attr_thread_local(mutable_thread_local)
+ ],
+ (
+ list_term_to_term_list(MutAttrsTerm, MutAttrTerms),
+ map_parser(parse_mutable_attr, MutAttrTerms, MaybeAttrList),
+ MaybeAttrList = ok1(CollectedMutAttrs)
+ ->
+ % We check for trailed/untrailed, constant/trailed,
+ % trailed/thread_local, constant/attach_to_io_state,
+ % constant/thread_local conflicts here and deal with conflicting
+ % foreign_name attributes in make_hlds_passes.m.
+ (
+ list.member(Conflict1 - Conflict2, ConflictingAttributes),
+ list.member(Conflict1, CollectedMutAttrs),
+ list.member(Conflict2, CollectedMutAttrs)
+ ->
+ % XXX Should generate more specific error message.
+ MutAttrsStr = mercury_term_to_string(VarSet, no, MutAttrsTerm),
+ Pieces = [words("Error: conflicting attributes"),
+ words("in attribute list:"), nl,
+ words(MutAttrsStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(MutAttrsTerm),
+ [always(Pieces)])]),
+ MaybeMutAttrs = error1([Spec])
+ ;
+ list.foldl(process_mutable_attribute, CollectedMutAttrs,
+ Attributes0, Attributes),
+ MaybeMutAttrs = ok1(Attributes)
+ )
+ ;
+ MutAttrsStr = mercury_term_to_string(VarSet, no, MutAttrsTerm),
+ Pieces = [words("Error: malformed attribute list"),
+ words("in mutable declaration:"),
+ words(MutAttrsStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(MutAttrsTerm), [always(Pieces)])]),
+ MaybeMutAttrs = error1([Spec])
+ ).
+
+:- pred process_mutable_attribute(collected_mutable_attribute::in,
+ mutable_var_attributes::in, mutable_var_attributes::out) is det.
+
+process_mutable_attribute(mutable_attr_trailed(Trailed), !Attributes) :-
+ set_mutable_var_trailed(Trailed, !Attributes).
+process_mutable_attribute(mutable_attr_foreign_name(ForeignName),
+ !Attributes) :-
+ set_mutable_add_foreign_name(ForeignName, !Attributes).
+process_mutable_attribute(mutable_attr_attach_to_io_state(AttachToIOState),
+ !Attributes) :-
+ set_mutable_var_attach_to_io_state(AttachToIOState, !Attributes).
+process_mutable_attribute(mutable_attr_constant(Constant), !Attributes) :-
+ set_mutable_var_constant(Constant, !Attributes),
+ (
+ Constant = yes,
+ set_mutable_var_trailed(mutable_untrailed, !Attributes),
+ set_mutable_var_attach_to_io_state(no, !Attributes)
+ ;
+ Constant = no
+ ).
+process_mutable_attribute(mutable_attr_thread_local(ThrLocal), !Attributes) :-
+ set_mutable_var_thread_local(ThrLocal, !Attributes).
+
+:- pred parse_mutable_attr(term::in,
+ maybe1(collected_mutable_attribute)::out) is det.
+
+parse_mutable_attr(MutAttrTerm, MutAttrResult) :-
+ (
+ MutAttrTerm = term.functor(term.atom(String), [], _),
+ (
+ String = "untrailed",
+ MutAttr = mutable_attr_trailed(mutable_untrailed)
+ ;
+ String = "trailed",
+ MutAttr = mutable_attr_trailed(mutable_trailed)
+ ;
+ String = "attach_to_io_state",
+ MutAttr = mutable_attr_attach_to_io_state(yes)
+ ;
+ String = "constant",
+ MutAttr = mutable_attr_constant(yes)
+ ;
+ String = "thread_local",
+ MutAttr = mutable_attr_thread_local(mutable_thread_local)
+ )
+ ->
+ MutAttrResult = ok1(MutAttr)
+ ;
+ MutAttrTerm = term.functor(term.atom("foreign_name"), Args, _),
+ Args = [LangTerm, ForeignNameTerm],
+ parse_foreign_language(LangTerm, Lang),
+ ForeignNameTerm = term.functor(term.string(ForeignName), [], _)
+ ->
+ MutAttr = mutable_attr_foreign_name(foreign_name(Lang, ForeignName)),
+ MutAttrResult = ok1(MutAttr)
+ ;
+ Pieces = [words("Error: unrecognised attribute"),
+ words("in mutable declaration."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(MutAttrTerm), [always(Pieces)])]),
+ MutAttrResult = error1([Spec])
+ ).
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.136
diff -u -b -r1.136 prog_io_pragma.m
--- compiler/prog_io_pragma.m 28 Jul 2008 08:34:19 -0000 1.136
+++ compiler/prog_io_pragma.m 1 Dec 2008 13:52:39 -0000
@@ -49,6 +49,7 @@
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_ctgc.
:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
Index: compiler/prog_io_sym_name.m
===================================================================
RCS file: compiler/prog_io_sym_name.m
diff -N compiler/prog_io_sym_name.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/prog_io_sym_name.m 1 Dec 2008 14:54:42 -0000
@@ -0,0 +1,336 @@
+%-----------------------------------------------------------------------------e
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------e
+% Copyright (C) 2008 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.
+%-----------------------------------------------------------------------------%
+
+:- module parse_tree.prog_io_sym_name.
+:- interface.
+
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_io_util.
+
+:- import_module list.
+:- import_module term.
+:- import_module varset.
+
+% A QualifiedTerm is one of
+% Name(Args)
+% Module.Name(Args)
+% (or if Args is empty, one of
+% Name
+% Module.Name)
+% where Module is a SymName. For backwards compatibility, we allow `__'
+% as an alternative to `.'.
+
+ % Sym_name_and_args takes a term and returns a sym_name that is its
+ % top function symbol, and a list of its argument terms. It fails
+ % if the input is not valid syntax for a QualifiedTerm.
+ %
+:- pred sym_name_and_args(term(T)::in, sym_name::out, list(term(T))::out)
+ is semidet.
+
+ % parse_qualified_term(Term, _ContainingTerm, VarSet, ContextPieces,
+ % Result):
+ %
+ % Parse Term into a sym_name that is its top function symbol and a
+ % list of its argument terms, and if successful return them in Result.
+ % (parse_qualified_term thus does the same job as sym_name_and_args
+ % if it succeeds.) However, in case it does not succced,
+ % parse_qualified_term also takes as input Varset (from which the variables
+ % in Term are taken), the term containing Term, and a format_component
+ % list describing the context from which it was called, e.g.
+ % "In clause head:". XXX Currently, _ContainingTerm isn't used;
+ % maybe it should be deleted.
+ %
+ % Note: parse_qualified_term is used for places where a symbol is _used_,
+ % where no default module name exists for the sym_name. For places
+ % where a symbol is _defined_, use parse_implicitly_qualified_term.
+ %
+ % If you care only about the case where Result = ok2(SymName, Args),
+ % use sym_name_and_args.
+ %
+:- pred parse_qualified_term(term(T)::in, term(T)::in, varset::in,
+ list(format_component)::in, maybe_functor(T)::out) is det.
+
+ % parse_implicitly_qualified_term(ModuleName, Term, _ContainingTerm,
+ % VarSet, ContextPieces, Result):
+ %
+ % Parse Term into a sym_name that is its top function symbol and a
+ % list of its argument terms, and if successful return them in Result.
+ % This predicate thus does almost the same job as the predicate
+ % parse_implicitly_qualified_term above, the difference being that
+ % that if the sym_name is qualified, then we check whether it is qualified
+ % with ModuleName, and if it isn't qualified, then we qualify it with
+ % Modulename (unless ModuleName is root_module_name). This is the
+ % right thing to do for clause heads, which is the intended job of
+ % parse_implicitly_qualified_term.
+ %
+:- pred parse_implicitly_qualified_term(module_name::in, term(T)::in,
+ term(T)::in, varset::in, list(format_component)::in, maybe_functor(T)::out)
+ is det.
+
+ % A SymbolName is one of
+ % Name
+ % Matches symbols with the specified name in the
+ % current namespace.
+ % Module.Name
+ % Matches symbols with the specified name exported
+ % by the specified module (where Module is itself a SymbolName).
+ %
+ % We also allow the syntax `Module__Name' as an alternative
+ % for `Module.Name'.
+ %
+:- pred parse_symbol_name(varset(T)::in, term(T)::in, maybe1(sym_name)::out)
+ is det.
+
+:- pred parse_implicitly_qualified_symbol_name(module_name::in, varset::in,
+ term::in, maybe1(sym_name)::out) is det.
+
+ % A SymbolNameSpecifier is one of
+ % SymbolName
+ % SymbolName/Arity
+ % Matches only symbols of the specified arity.
+ %
+:- pred parse_symbol_name_specifier(varset::in, term::in,
+ maybe1(sym_name_specifier)::out) is det.
+
+:- pred parse_implicitly_qualified_symbol_name_specifier(module_name::in,
+ varset::in, term::in, maybe1(sym_name_specifier)::out) is det.
+
+ % We use the empty module name ('') as the "root" module name; when adding
+ % default module qualifiers in parse_implicitly_qualified_{term,symbol},
+ % if the default module is the root module then we don't add any qualifier.
+ %
+:- pred root_module_name(module_name::out) is det.
+
+%-----------------------------------------------------------------------------e
+
+:- implementation.
+
+:- import_module parse_tree.mercury_to_mercury.
+
+:- import_module int.
+
+sym_name_and_args(Term, SymName, Args) :-
+ % The values of VarSet and ContextPieces do not matter here, since
+ % we succeed only if they aren't used.
+ VarSet = varset.init,
+ ContextPieces = [],
+ parse_qualified_term(Term, Term, VarSet, ContextPieces,
+ ok2(SymName, Args)).
+
+parse_qualified_term(Term, _ContainingTerm, VarSet, ContextPieces,
+ MaybeSymNameAndArgs) :-
+ % XXX We should delete the _ContainingTerm argument.
+ (
+ Term = term.functor(Functor, FunctorArgs, TermContext),
+ Functor = term.atom("."),
+ FunctorArgs = [ModuleTerm, NameArgsTerm]
+ ->
+ ( NameArgsTerm = term.functor(term.atom(Name), Args, _) ->
+ varset.coerce(VarSet, GenericVarSet),
+ parse_symbol_name(GenericVarSet, ModuleTerm, MaybeModule),
+ (
+ MaybeModule = ok1(Module),
+ MaybeSymNameAndArgs = ok2(qualified(Module, Name), Args)
+ ;
+ MaybeModule = error1(_),
+ ModuleTermStr = describe_error_term(GenericVarSet, ModuleTerm),
+ % XXX We should say "module name" OR "identifier", not both.
+ Pieces = ContextPieces ++ [lower_case_next_if_not_first,
+ words("Error: module name identifier expected before '.'"),
+ words("in qualified symbol name, not"),
+ words(ModuleTermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(TermContext, [always(Pieces)])]),
+ MaybeSymNameAndArgs = error2([Spec])
+ )
+ ;
+ varset.coerce(VarSet, GenericVarSet),
+ TermStr = describe_error_term(GenericVarSet, Term),
+ Pieces = ContextPieces ++ [lower_case_next_if_not_first,
+ words("Error: identifier expected after '.'"),
+ words("in qualified symbol name, not"),
+ words(TermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(TermContext, [always(Pieces)])]),
+ MaybeSymNameAndArgs = error2([Spec])
+ )
+ ;
+ varset.coerce(VarSet, GenericVarSet),
+ ( Term = term.functor(term.atom(Name), Args, _) ->
+ SymName = string_to_sym_name_sep(Name, "__"),
+ MaybeSymNameAndArgs = ok2(SymName, Args)
+ ;
+ TermStr = describe_error_term(GenericVarSet, Term),
+ Pieces = ContextPieces ++ [lower_case_next_if_not_first,
+ words("Error: atom expected at"),
+ words(TermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeSymNameAndArgs = error2([Spec])
+ )
+ ).
+
+parse_implicitly_qualified_term(DefaultModuleName, Term, ContainingTerm,
+ VarSet, ContextPieces, MaybeSymNameAndArgs) :-
+ parse_qualified_term(Term, ContainingTerm, VarSet, ContextPieces,
+ MaybeSymNameAndArgs0),
+ (
+ MaybeSymNameAndArgs0 = ok2(SymName, Args),
+ (
+ root_module_name(DefaultModuleName)
+ ->
+ MaybeSymNameAndArgs = MaybeSymNameAndArgs0
+ ;
+ SymName = qualified(ModuleName, _),
+ \+ match_sym_name(ModuleName, DefaultModuleName)
+ ->
+ Pieces = [words("Error: module qualifier in definition"),
+ words("does not match preceding"), quote(":- module"),
+ words("declaration."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeSymNameAndArgs = error2([Spec])
+ ;
+ UnqualName = unqualify_name(SymName),
+ QualSymName = qualified(DefaultModuleName, UnqualName),
+ MaybeSymNameAndArgs = ok2(QualSymName, Args)
+ )
+ ;
+ MaybeSymNameAndArgs0 = error2(_),
+ MaybeSymNameAndArgs = MaybeSymNameAndArgs0
+ ).
+
+%-----------------------------------------------------------------------------e
+
+parse_symbol_name(VarSet, Term, MaybeSymName) :-
+ (
+ Term = term.functor(term.atom(FunctorName), [ModuleTerm, NameTerm],
+ TermContext),
+ ( FunctorName = ":"
+ ; FunctorName = "."
+ )
+ ->
+ ( NameTerm = term.functor(term.atom(Name), [], _) ->
+ parse_symbol_name(VarSet, ModuleTerm, MaybeModule),
+ (
+ MaybeModule = ok1(Module),
+ MaybeSymName = ok1(qualified(Module, Name))
+ ;
+ MaybeModule = error1(_ModuleResultSpecs),
+ % XXX We should say "module name" OR "identifier", not both.
+ Pieces = [words("Error: module name identifier"),
+ words("expected before"), quote(FunctorName),
+ words("in qualified symbol name."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(TermContext, [always(Pieces)])]),
+ % XXX Should we include _ModuleResultSpecs?
+ MaybeSymName = error1([Spec])
+ )
+ ;
+ Pieces = [words("Error: identifier expected after"),
+ quote(FunctorName), words("in qualified symbol name."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(TermContext, [always(Pieces)])]),
+ MaybeSymName = error1([Spec])
+ )
+ ;
+ ( Term = term.functor(term.atom(Name), [], _) ->
+ SymName = string_to_sym_name_sep(Name, "__"),
+ MaybeSymName = ok1(SymName)
+ ;
+ TermStr = describe_error_term(VarSet, Term),
+ Pieces = [words("Error: symbol name expected at"),
+ words(TermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeSymName = error1([Spec])
+ )
+ ).
+
+parse_implicitly_qualified_symbol_name(DefaultModuleName, VarSet, Term,
+ MaybeSymName) :-
+ parse_symbol_name(VarSet, Term, MaybeSymName0),
+ (
+ MaybeSymName0 = ok1(SymName),
+ (
+ root_module_name(DefaultModuleName)
+ ->
+ MaybeSymName = MaybeSymName0
+ ;
+ SymName = qualified(ModuleName, _),
+ \+ match_sym_name(ModuleName, DefaultModuleName)
+ ->
+ Pieces = [words("Error: module qualifier in definition"),
+ words("does not match preceding"), quote(":- module"),
+ words("declaration."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeSymName = error1([Spec])
+ ;
+ UnqualName = unqualify_name(SymName),
+ MaybeSymName = ok1(qualified(DefaultModuleName, UnqualName))
+ )
+ ;
+ MaybeSymName0 = error1(_),
+ MaybeSymName = MaybeSymName0
+ ).
+
+%-----------------------------------------------------------------------------e
+
+parse_symbol_name_specifier(VarSet, Term, MaybeSymNameSpecifier) :-
+ root_module_name(DefaultModule),
+ parse_implicitly_qualified_symbol_name_specifier(DefaultModule, VarSet,
+ Term, MaybeSymNameSpecifier).
+
+parse_implicitly_qualified_symbol_name_specifier(DefaultModule, VarSet, Term,
+ MaybeSymNameSpecifier) :-
+ ( Term = term.functor(term.atom("/"), [NameTerm, ArityTerm], _) ->
+ ( ArityTerm = term.functor(term.integer(Arity), [], _) ->
+ ( Arity >= 0 ->
+ parse_implicitly_qualified_symbol_name(DefaultModule, VarSet,
+ NameTerm, MaybeName),
+ (
+ MaybeName = error1(Specs),
+ MaybeSymNameSpecifier = error1(Specs)
+ ;
+ MaybeName = ok1(Name),
+ MaybeSymNameSpecifier = ok1(name_arity(Name, Arity))
+ )
+ ;
+ Pieces = [words("Error: arity in symbol name specifier"),
+ words("must be a non-negative integer."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeSymNameSpecifier = error1([Spec])
+ )
+ ;
+ Pieces = [words("Error: arity in symbol name specifier"),
+ words("must be an integer."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(Term), [always(Pieces)])]),
+ MaybeSymNameSpecifier = error1([Spec])
+ )
+ ;
+ parse_implicitly_qualified_symbol_name(DefaultModule, VarSet, Term,
+ MaybeSymbolName),
+ (
+ MaybeSymbolName = error1(Specs),
+ MaybeSymNameSpecifier = error1(Specs)
+ ;
+ MaybeSymbolName = ok1(SymbolName),
+ MaybeSymNameSpecifier = ok1(name(SymbolName))
+ )
+ ).
+
+%-----------------------------------------------------------------------------e
+
+root_module_name(unqualified("")).
+
+%-----------------------------------------------------------------------------e
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.63
diff -u -b -r1.63 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 28 Jul 2008 08:34:19 -0000 1.63
+++ compiler/prog_io_typeclass.m 1 Dec 2008 13:53:25 -0000
@@ -62,6 +62,7 @@
:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.63
diff -u -b -r1.63 prog_io_util.m
--- compiler/prog_io_util.m 24 Jul 2008 06:20:32 -0000 1.63
+++ compiler/prog_io_util.m 1 Dec 2008 14:47:16 -0000
@@ -186,7 +186,7 @@
:- import_module libs.compiler_util.
:- import_module parse_tree.mercury_to_mercury.
-:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.45
diff -u -b -r1.45 recompilation.check.m
--- compiler/recompilation.check.m 28 Jul 2008 08:34:19 -0000 1.45
+++ compiler/recompilation.check.m 1 Dec 2008 13:55:43 -0000
@@ -72,9 +72,10 @@
:- import_module parse_tree.file_names.
:- import_module parse_tree.module_cmds.
:- import_module parse_tree.module_imports.
-:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_io_util.
+:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
:- import_module recompilation.usage.
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.65
diff -u -b -r1.65 recompilation.version.m
--- compiler/recompilation.version.m 28 Jul 2008 08:34:19 -0000 1.65
+++ compiler/recompilation.version.m 1 Dec 2008 13:54:37 -0000
@@ -50,7 +50,7 @@
:- import_module libs.compiler_util.
:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
-:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_subst.
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.30
diff -u -b -r1.30 superhomogeneous.m
--- compiler/superhomogeneous.m 16 Jul 2008 03:30:31 -0000 1.30
+++ compiler/superhomogeneous.m 1 Dec 2008 13:46:31 -0000
@@ -121,7 +121,7 @@
:- import_module libs.compiler_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.module_qual.
-:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_io_sym_name.
:- import_module parse_tree.prog_io_dcg.
:- import_module parse_tree.prog_io_goal.
:- import_module parse_tree.prog_io_util.
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.138
diff -u -b -r1.138 compiler_design.html
--- compiler/notes/compiler_design.html 28 Nov 2008 06:37:04 -0000 1.138
+++ compiler/notes/compiler_design.html 1 Dec 2008 15:27:38 -0000
@@ -268,8 +268,10 @@
clauses using Definite Clause Grammar notation), prog_io_goal.m (which
handles goals), prog_io_pragma.m (which handles pragma declarations),
prog_io_typeclass.m (which handles typeclass and instance
- declarations) and prog_io_util.m (which defines predicates and types
- needed by the other prog_io*.m modules.
+ declarations), prog_io_mutable.m (which handles initialize, finalize
+ and mutable declarations), prog_io_sym_name.m (which handles parsing
+ symbol names and specifiers) and prog_io_util.m (which defines
+ types and predicates needed by the other prog_io*.m modules.
<p>
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list