[m-rev.] for review: restructuring parse tree items
Zoltan Somogyi
zs at csse.unimelb.edu.au
Tue Feb 12 14:11:30 AEDT 2008
For review by Julien, who is familiar with the basic idea.
The diff is long, but most of it is qute straightforward.
Zoltan.
A first step towards rationalizing the parse tree representation of the
program. This step moves the information specific to each kind of item
into a structure specific to that kind of item.
In the short term, this allows us to express some old invisible invariants
as types. For example, we used to store general items in method definitions;
we now store clause-specific data there. This allows us to simplify some code
and eliminate some old "can't fail" tests.
In the longer term, this change will allow us to replace the old list of items
representation of the parse tree with a more structured representation,
which aggregates each kind of item differently. For example, we could
keep clause items in a list, but map module imports to the contexts
of their :- import_module items, which would allow us to detect duplicate
imports. We could also change the current three pass structure of the
parse tree to HLDS conversion step, where each pass processes *all* items,
to a much more flexible structure where each pass processes processes
only what it needs to process, new passes could be added much more simply,
and in fact the whole notion of a "pass" could be eliminated.
In a bunch of places, factor out some common code.
compiler/prog_item.m:
Make the change to the item type as above.
Rename the old item_pred_or_func as item_pred_decl (it already had
a field to indicate predicate or function) and item_pred_or_func_mode
as item_mode_decl. These names are much more consistent with the
other item names.
Eliminate the item_and_context type by moving the context into
the items themselves. In code that cares about contexts, this
makes it easier to match up each item with its context. In code
that doesn't care about contexts, this avoids the extra code
that would be required to discard the item_and_context wrapper.
compiler/prog_data.m:
Store item_clause_infos instead of items in method definitions.
compiler/prog_io.m:
compiler/prog_io_dcg.m:
compiler/prog_io_pragma.m:
compiler/prog_io_typeclass.m:
Construct the new item structure when creating the parse tree.
Instead of constructing items and later attaching the context to them,
pass the context down, since we now need to include them in items.
Some old code was assuming that term.variables had no contexts;
update such code.
In prog_io_pragma.m, replace a single predicate that parsed all kinds
of pragmas, which spanned more than one thousand lines and whose
clauses had been interspersed with the clauses of other predicates,
with a predicate whose only job is to select which of a bunch of
pragma-type-specific parse predicates to invoke. Each of these
pragma-type-specific parse predicates corresponds to one of the
clauses of the old predicate. In that form, the predicates can be
declared det, even though the predicate as a whole is semidet
(since not all pragma names are valid). This actually exposed
an old bug; the case MaybeAttributes = error1(_) was not handled
in foreign_export_enum pragmas.
To make the diff easier to check, I left the predicates in the
original order of the clauses, even though that order does not
make sense (it does not group related pragmas together). I did
leave an XXX comment about this. The matter will be addressed
in a later diff. (A similar problem occurs in some of the other
modules in which I broke up very large predicates.)
compiler/prog_io_util.m:
Remove some stuff that the new item structure makes unnecessary.
compiler/make_hlds_passes.m:
compiler/add_class.m:
compiler/add_mode.m:
compiler/add_pragma.m:
compiler/add_solver.m:
Conform to the new item structure when converting it to HLDS.
Break up excessively large predicates.
compiler/prog_foreign.m:
Provide a function to return all supported foreign languages,
instead of requiring callers to call solutions to compute this list.
compiler/mercury_to_mercury.m:
Print out the new item structure.
Break up excessively large predicates.
Rename some predicates to avoid name collisions.
compiler/equiv_type.m:
compiler/hlds_module.m:
compiler/intermod.m:
compiler/make.module_dep_file.m:
compiler/mercury_compile.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/prog_mutable.m:
compiler/recompilation.check.m:
compiler/recompilation.version.m:
compiler/state_var.m:
compiler/trans_opt.m:
Operate on the new item structure. Factor out code (usually tests)
where the new item structure makes this possible and desirable.
Turn if-then-elses into switches where this is desirable.
Build up large terms from named pieces instead of all at once.
Break up excessively large predicates.
In equiv_type.m, rename a predicate to clarify its function,
and add an XXX about a possible improvement in abstraction.
In modules.m, simplify the interface between some predicates
and their callers, turn some predicates into functions, and
make some code return error specifications instead of doing
raw printing of error messages. Note that this module still
has plenty of scope for improvement (I marked some with XXXs),
but that is for a later date.
In some cases, mark potential bugs with XXXs.
compiler/equiv_type_hlds.m:
Conform to the change in equiv_type.m.
library/term.m:
compiler/recompilation.check.m:
Move the function for getting the context out of a term from
recompilation.check.m to term.m, so it can be used from other modules.
(Also, adding such a function to the standard library is long overdue.)
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/add_class.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_class.m,v
retrieving revision 1.28
diff -u -b -r1.28 add_class.m
--- compiler/add_class.m 21 May 2007 04:22:49 -0000 1.28
+++ compiler/add_class.m 9 Feb 2008 04:22:46 -0000
@@ -22,10 +22,8 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_class_defn(list(prog_constraint)::in,
- list(prog_fundep)::in, sym_name::in, list(tvar)::in, class_interface::in,
- tvarset::in, prog_context::in, item_status::in,
- module_info::in, module_info::out,
+:- pred module_add_class_defn(item_typeclass_info::in,
+ item_status::in, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred module_add_instance_defn(module_name::in, list(prog_constraint)::in,
@@ -75,8 +73,9 @@
:- import_module string.
:- import_module varset.
-module_add_class_defn(Constraints, FunDeps, Name, Vars, Interface, VarSet,
- Context, Status, !ModuleInfo, !Specs) :-
+module_add_class_defn(ItemTypeClassInfo, Status, !ModuleInfo, !Specs) :-
+ ItemTypeClassInfo = item_typeclass_info(Constraints, FunDeps, Name, Vars,
+ Interface, VarSet, Context),
module_info_get_class_table(!.ModuleInfo, Classes0),
list.length(Vars, ClassArity),
ClassId = class_id(Name, ClassArity),
@@ -568,7 +567,6 @@
!:Specs = [Spec | !.Specs]
).
- %
% Do two hlds_instance_defn refer to the same type?
% eg "instance tc(f(T))" compares equal to "instance tc(f(U))"
%
@@ -647,17 +645,19 @@
).
:- pred produce_instance_method_clause(pred_or_func::in,
- prog_context::in, import_status::in, item::in,
+ prog_context::in, import_status::in, item_clause_info::in,
module_info::in, module_info::out, qual_info::in, qual_info::out,
clauses_info::in, clauses_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
produce_instance_method_clause(PredOrFunc, Context, Status, InstanceClause,
!ModuleInfo, !QualInfo, !ClausesInfo, !Specs) :-
- (
- InstanceClause = item_clause(_Origin, CVarSet, PredOrFunc, PredName,
- HeadTerms0, Body)
- ->
+ InstanceClause = item_clause_info(_Origin, CVarSet, ClausePredOrFunc,
+ PredName, HeadTerms0, Body, _ClauseContext),
+ % XXX Can this ever fail? If yes, we should generate an error message
+ % instead of aborting.
+ expect(unify(PredOrFunc, ClausePredOrFunc), this_file,
+ "produce_instance_method_clause: PredOrFunc mismatch"),
( illegal_state_var_func_result(PredOrFunc, HeadTerms0, StateVar) ->
report_illegal_func_svar_result(Context, CVarSet, StateVar, !Specs)
;
@@ -684,9 +684,6 @@
% Warn about variables with overlapping scopes.
warn_overlap(Warnings, VarSet, SimpleCallId, !Specs)
- )
- ;
- unexpected(this_file, "produce_clause: invalid instance item")
).
:- pred pred_method_with_no_modes_error(pred_info::in,
Index: compiler/add_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_mode.m,v
retrieving revision 1.13
diff -u -b -r1.13 add_mode.m
--- compiler/add_mode.m 1 Dec 2006 15:03:48 -0000 1.13
+++ compiler/add_mode.m 7 Feb 2008 15:10:06 -0000
@@ -17,21 +17,17 @@
:- import_module hlds.hlds_module.
:- import_module hlds.make_hlds.make_hlds_passes.
-:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
-:- import_module parse_tree.prog_data.
:- import_module bool.
:- import_module list.
-:- pred module_add_inst_defn(inst_varset::in, sym_name::in, list(inst_var)::in,
- inst_defn::in, condition::in, prog_context::in, item_status::in,
- module_info::in, module_info::out, bool::out,
+:- pred module_add_inst_defn(item_inst_defn_info::in, bool::out,
+ item_status::in, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-:- pred module_add_mode_defn(inst_varset::in, sym_name::in, list(inst_var)::in,
- mode_defn::in, condition::in, prog_context::in, item_status::in,
- module_info::in, module_info::out, bool::out,
+:- pred module_add_mode_defn(item_mode_defn_info::in, bool::out,
+ item_status::in, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
%----------------------------------------------------------------------------%
@@ -49,18 +45,21 @@
%----------------------------------------------------------------------------%
-module_add_inst_defn(VarSet, Name, Args, InstDefn, Cond, Context,
- item_status(Status, _NeedQual), !ModuleInfo, InvalidMode, !Specs) :-
+module_add_inst_defn(ItemInstDefnInfo, InvalidMode, ItemStatus, !ModuleInfo,
+ !Specs) :-
+ ItemStatus = item_status(Status, _NeedQual),
+ ItemInstDefnInfo = item_inst_defn_info(VarSet, Name, Params, InstDefn,
+ Cond, Context),
% Add the definition of this inst to the HLDS inst table.
module_info_get_inst_table(!.ModuleInfo, InstTable0),
inst_table_get_user_insts(InstTable0, Insts0),
- insts_add(VarSet, Name, Args, InstDefn, Cond, Context, Status,
+ insts_add(VarSet, Name, Params, InstDefn, Cond, Context, Status,
Insts0, Insts, !Specs),
inst_table_set_user_insts(Insts, InstTable0, InstTable),
module_info_set_inst_table(InstTable, !ModuleInfo),
% Check if the inst is infinitely recursive (at the top level).
- Arity = list.length(Args),
+ Arity = list.length(Params),
InstId = inst_id(Name, Arity),
TestArgs = list.duplicate(Arity, not_reached),
check_for_cyclic_inst(Insts, InstId, InstId, TestArgs, [], Context,
@@ -78,10 +77,8 @@
!Specs) :-
list.length(Args, Arity),
InstId = inst_id(Name, Arity),
- (
I = hlds_inst_defn(VarSet, Args, eqv_inst(Body), Context, Status),
- user_inst_table_insert(InstId, I, !Insts)
- ->
+ ( user_inst_table_insert(InstId, I, !Insts) ->
true
;
% If abstract insts are implemented, this will need to change
@@ -129,8 +126,11 @@
%-----------------------------------------------------------------------------%
-module_add_mode_defn(VarSet, Name, Params, ModeDefn, Cond, Context,
- item_status(Status, _NeedQual), !ModuleInfo, InvalidMode, !Specs) :-
+module_add_mode_defn(ItemModeDefnInfo, InvalidMode, ItemStatus, !ModuleInfo,
+ !Specs) :-
+ ItemModeDefnInfo = item_mode_defn_info(VarSet, Name, Params, ModeDefn,
+ Cond, Context),
+ ItemStatus = item_status(Status, _NeedQual),
module_info_get_mode_table(!.ModuleInfo, Modes0),
modes_add(VarSet, Name, Params, ModeDefn, Cond, Context, Status,
Modes0, Modes, InvalidMode, !Specs),
@@ -145,10 +145,8 @@
!Modes, InvalidMode, !Specs) :-
list.length(Args, Arity),
ModeId = mode_id(Name, Arity),
- (
I = hlds_mode_defn(VarSet, Args, eqv_mode(Body), Context, Status),
- mode_table_insert(ModeId, I, !Modes)
- ->
+ ( mode_table_insert(ModeId, I, !Modes) ->
true
;
mode_table_get_mode_defns(!.Modes, ModeDefns),
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.80
diff -u -b -r1.80 add_pragma.m
--- compiler/add_pragma.m 11 Feb 2008 21:25:49 -0000 1.80
+++ compiler/add_pragma.m 12 Feb 2008 01:20:43 -0000
@@ -17,6 +17,7 @@
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_item.
:- import_module assoc_list.
:- import_module list.
@@ -24,7 +25,7 @@
%-----------------------------------------------------------------------------%
-:- pred add_pragma(item_origin::in, pragma_type::in, prog_context::in,
+:- pred add_pragma(item_pragma_info::in,
item_status::in, item_status::out, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
@@ -101,8 +102,8 @@
:- pred module_add_pragma_tabled(eval_method::in, sym_name::in, int::in,
maybe(pred_or_func)::in, maybe(list(mer_mode))::in,
- maybe(table_attributes)::in, import_status::in, import_status::out,
- prog_context::in, module_info::in, module_info::out,
+ maybe(table_attributes)::in, prog_context::in,
+ import_status::in, import_status::out, module_info::in, module_info::out,
qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
@@ -195,10 +196,11 @@
%-----------------------------------------------------------------------------%
-add_pragma(Origin, Pragma, Context, !Status, !ModuleInfo, !Specs) :-
+add_pragma(ItemPragma, !Status, !ModuleInfo, !Specs) :-
+ ItemPragma = item_pragma_info(Origin, Pragma, Context),
% Check for invalid pragmas in the `interface' section.
!.Status = item_status(ImportStatus, _),
- pragma_allowed_in_interface(Pragma, Allowed),
+ Allowed = pragma_allowed_in_interface(Pragma),
(
Allowed = no,
(
@@ -2372,7 +2374,7 @@
%-----------------------------------------------------------------------------%
module_add_pragma_tabled(EvalMethod, PredName, Arity, MaybePredOrFunc,
- MaybeModes, MaybeAttributes, !Status, Context, !ModuleInfo,
+ MaybeModes, MaybeAttributes, Context, !Status, !ModuleInfo,
!QualInfo, !Specs) :-
module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
EvalMethodStr = eval_method_to_string(EvalMethod),
@@ -2771,12 +2773,14 @@
WithInst = no,
Condition = cond_true,
Origin = compiler(pragma_memo_attribute),
- StatsPredDecl = item_pred_or_func(Origin, VarSet0, InstVarSet, ExistQVars,
- pf_predicate, StatsPredSymName, ArgDecls, WithType, WithInst,
- yes(detism_det), Condition, purity_pure, Constraints),
+ StatsPredDecl = item_pred_decl_info(Origin, VarSet0, InstVarSet,
+ ExistQVars, pf_predicate, StatsPredSymName, ArgDecls,
+ WithType, WithInst, yes(detism_det), Condition, purity_pure,
+ Constraints, Context),
+ StatsPredDeclItem = item_pred_decl(StatsPredDecl),
ItemStatus0 = item_status(!.Status, may_be_unqualified),
- add_item_decl_pass_1(StatsPredDecl, Context, ItemStatus0, _,
- !ModuleInfo, _, !Specs),
+ add_item_decl_pass_1(StatsPredDeclItem, _, ItemStatus0, _,
+ !ModuleInfo, !Specs),
some [!Attrs, !VarSet] (
!:Attrs = default_attributes(lang_c),
@@ -2796,15 +2800,16 @@
Global = table_info_c_global_var_name(!.ModuleInfo, SimpleCallId,
ProcId),
- StatsPredClause = item_pragma(compiler(pragma_memo_attribute),
- pragma_foreign_proc(!.Attrs, StatsPredSymName, pf_predicate,
- [Arg1, Arg2, Arg3], !.VarSet, InstVarSet,
- fc_impl_ordinary(
- "MR_get_tabling_stats(&" ++ Global ++ ", &Stats);",
- yes(Context))))
+ StatsCode = "MR_get_tabling_stats(&" ++ Global ++ ", &Stats);",
+ StatsImpl = fc_impl_ordinary(StatsCode, yes(Context)),
+ StatsPragma = pragma_foreign_proc(!.Attrs, StatsPredSymName,
+ pf_predicate, [Arg1, Arg2, Arg3], !.VarSet, InstVarSet, StatsImpl),
+ StatsPragmaInfo = item_pragma_info(compiler(pragma_memo_attribute),
+ StatsPragma, Context),
+ StatsImplItem = item_pragma(StatsPragmaInfo)
),
- add_item_clause(StatsPredClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs).
+ % XXX Instead of calling add_item_pass_3, we should call what *it* calls.
+ add_item_pass_3(StatsImplItem, !Status, !ModuleInfo, !QualInfo, !Specs).
:- pred create_tabling_reset_pred(proc_id::in, prog_context::in,
simple_call_id::in, bool::in, proc_table::in, proc_table::out,
@@ -2828,12 +2833,14 @@
WithInst = no,
Condition = cond_true,
Origin = compiler(pragma_memo_attribute),
- ResetPredDecl = item_pred_or_func(Origin, VarSet0, InstVarSet, ExistQVars,
- pf_predicate, ResetPredSymName, ArgDecls, WithType, WithInst,
- yes(detism_det), Condition, purity_pure, Constraints),
+ ResetPredDecl = item_pred_decl_info(Origin, VarSet0, InstVarSet,
+ ExistQVars, pf_predicate, ResetPredSymName, ArgDecls,
+ WithType, WithInst, yes(detism_det), Condition, purity_pure,
+ Constraints, Context),
+ ResetPredDeclItem = item_pred_decl(ResetPredDecl),
ItemStatus0 = item_status(!.Status, may_be_unqualified),
- add_item_decl_pass_1(ResetPredDecl, Context, ItemStatus0, _,
- !ModuleInfo, _, !Specs),
+ add_item_decl_pass_1(ResetPredDeclItem, _, ItemStatus0, _,
+ !ModuleInfo, !Specs),
some [!Attrs, !VarSet] (
!:Attrs = default_attributes(lang_c),
@@ -2848,15 +2855,16 @@
Global = table_info_c_global_var_name(!.ModuleInfo, SimpleCallId,
ProcId),
- ResetPredClause = item_pragma(compiler(pragma_memo_attribute),
- pragma_foreign_proc(!.Attrs, ResetPredSymName, pf_predicate,
- [Arg1, Arg2], !.VarSet, InstVarSet,
- fc_impl_ordinary(
- Global ++ ".MR_pt_tablenode.MR_integer = 0;",
- yes(Context))))
+ ResetCode = Global ++ ".MR_pt_tablenode.MR_integer = 0;",
+ ResetImpl = fc_impl_ordinary(ResetCode, yes(Context)),
+ ResetPragma = pragma_foreign_proc(!.Attrs, ResetPredSymName,
+ pf_predicate, [Arg1, Arg2], !.VarSet, InstVarSet, ResetImpl),
+ ResetPragmaInfo = item_pragma_info(compiler(pragma_memo_attribute),
+ ResetPragma, Context),
+ ResetImplItem = item_pragma(ResetPragmaInfo)
),
- add_item_clause(ResetPredClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs).
+ % XXX Instead of calling add_item_pass_3, we should call what *it* calls.
+ add_item_pass_3(ResetImplItem, !Status, !ModuleInfo, !QualInfo, !Specs).
:- func tabling_stats_pred_name(simple_call_id, proc_id, bool) = sym_name.
Index: compiler/add_solver.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_solver.m,v
retrieving revision 1.20
diff -u -b -r1.20 add_solver.m
--- compiler/add_solver.m 19 Jan 2007 07:04:07 -0000 1.20
+++ compiler/add_solver.m 9 Feb 2008 04:29:36 -0000
@@ -47,8 +47,8 @@
list(error_spec)::in, list(error_spec)::out) is det.
:- pred add_solver_type_clause_items(sym_name::in, list(type_param)::in,
- solver_type_details::in, import_status::in, import_status::out,
- prog_context::in, module_info::in, module_info::out,
+ solver_type_details::in, prog_context::in,
+ import_status::in, import_status::out, module_info::in, module_info::out,
qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
@@ -181,7 +181,7 @@
qualified(ModuleNames, Prefix ++ Name ++ "/" ++ int_to_string(Arity)).
add_solver_type_clause_items(TypeSymName, TypeParams, SolverTypeDetails,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
Arity = length(TypeParams),
AnyInst = SolverTypeDetails ^ any_inst,
@@ -226,10 +226,11 @@
InstVarSet,
Impl
),
- ToGroundRepnItem = item_pragma(compiler(solver_type),
- ToGroundRepnForeignProc),
- add_item_clause(ToGroundRepnItem, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ ToGroundRepnItemPragma = item_pragma_info(compiler(solver_type),
+ ToGroundRepnForeignProc, Context),
+ ToGroundRepnItem = item_pragma(ToGroundRepnItemPragma),
+ add_item_pass_3(ToGroundRepnItem, !Status, !ModuleInfo,
+ !QualInfo, !Specs),
% The `func(in(any)) = out(<i_any>) is det' mode.
%
@@ -247,9 +248,11 @@
InstVarSet,
Impl
),
- ToAnyRepnItem = item_pragma(compiler(solver_type), ToAnyRepnForeignProc),
- add_item_clause(ToAnyRepnItem, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ ToAnyRepnItemPragma = item_pragma_info(compiler(solver_type),
+ ToAnyRepnForeignProc, Context),
+ ToAnyRepnItem = item_pragma(ToAnyRepnItemPragma),
+ add_item_pass_3(ToAnyRepnItem, !Status, !ModuleInfo,
+ !QualInfo, !Specs),
% The `func(in(<i_ground>)) = out is det' mode.
%
@@ -267,9 +270,10 @@
InstVarSet,
Impl
),
- FromGroundRepnItem = item_pragma(compiler(solver_type),
- FromGroundRepnForeignProc),
- add_item_clause(FromGroundRepnItem, !Status, Context, !ModuleInfo,
+ FromGroundRepnItemPragma = item_pragma_info(compiler(solver_type),
+ FromGroundRepnForeignProc, Context),
+ FromGroundRepnItem = item_pragma(FromGroundRepnItemPragma),
+ add_item_pass_3(FromGroundRepnItem, !Status, !ModuleInfo,
!QualInfo, !Specs),
% The `func(in(<i_any>)) = out(any) is det' mode.
@@ -288,10 +292,11 @@
InstVarSet,
Impl
),
- FromAnyRepnItem = item_pragma(compiler(solver_type),
- FromAnyRepnForeignProc),
- add_item_clause(FromAnyRepnItem, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs).
+ FromAnyRepnItemPragma = item_pragma_info(compiler(solver_type),
+ FromAnyRepnForeignProc, Context),
+ FromAnyRepnItem = item_pragma(FromAnyRepnItemPragma),
+ add_item_pass_3(FromAnyRepnItem, !Status, !ModuleInfo,
+ !QualInfo, !Specs).
%-----------------------------------------------------------------------------%
:- end_module add_solver.
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.79
diff -u -b -r1.79 equiv_type.m
--- compiler/equiv_type.m 19 Jan 2007 07:04:11 -0000 1.79
+++ compiler/equiv_type.m 6 Feb 2008 05:44:30 -0000
@@ -49,8 +49,7 @@
% while processing each item are recorded in the recompilation_info,
% for use by smart recompilation.
%
-:- pred expand_eqv_types(module_name::in,
- list(item_and_context)::in, list(item_and_context)::out,
+:- pred expand_eqv_types(module_name::in, list(item)::in, list(item)::out,
event_spec_map::in, event_spec_map::out,
eqv_map::out, used_modules::out,
maybe(recompilation_info)::in, maybe(recompilation_info)::out,
@@ -89,21 +88,21 @@
:- type eqv_map == map(type_ctor, eqv_type_body).
+% XXX Should we make equiv_type_info abstract?
:- type equiv_type_info == maybe(expanded_item_set).
:- type expanded_item_set.
- % For smart recompilation we need to record which items were
- % expanded in each declaration. Any items which depend on
- % that declaration also depend on the expanded items.
+ % For smart recompilation we need to record which items were expanded
+ % in each declaration. Any items which depend on that declaration also
+ % depend on the expanded items.
%
-:- pred maybe_record_expanded_items(module_name::in,
- sym_name::in, maybe(recompilation_info)::in, equiv_type_info::out) is det.
+:- pred maybe_start_recording_expanded_items(module_name::in, sym_name::in,
+ maybe(recompilation_info)::in, equiv_type_info::out) is det.
% Record all the expanded items in the recompilation_info.
%
-:- pred finish_recording_expanded_items(item_id::in,
- equiv_type_info::in, maybe(recompilation_info)::in,
- maybe(recompilation_info)::out) is det.
+:- pred finish_recording_expanded_items(item_id::in, equiv_type_info::in,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -169,50 +168,54 @@
---> type_decl
; mode_decl.
-:- pred build_eqv_map(list(item_and_context)::in,
+:- pred build_eqv_map(list(item)::in,
eqv_map::in, eqv_map::out, eqv_inst_map::in, eqv_inst_map::out) is det.
build_eqv_map([], !EqvMap, !EqvInstMap).
-build_eqv_map([ItemAndContext | Items0], !EqvMap, !EqvInstMap) :-
- ItemAndContext = item_and_context(Item, _Context),
+build_eqv_map([Item | Items], !EqvMap, !EqvInstMap) :-
(
- Item = item_module_defn(_, md_abstract_imported)
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ModuleDefn = md_abstract_imported
->
- skip_abstract_imported_items(Items0, Items)
+ skip_abstract_imported_items(Items, AfterSkipItems),
+ build_eqv_map(AfterSkipItems, !EqvMap, !EqvInstMap)
;
- Item = item_type_defn(VarSet, Name, Args, parse_tree_eqv_type(Body), _)
+ (
+ Item = item_type_defn(ItemTypeDefn),
+ ItemTypeDefn = item_type_defn_info(VarSet, Name, Args,
+ parse_tree_eqv_type(Body), _, _)
->
- Items = Items0,
list.length(Args, Arity),
TypeCtor = type_ctor(Name, Arity),
svmap.set(TypeCtor, eqv_type_body(VarSet, Args, Body), !EqvMap)
;
- Item = item_inst_defn(VarSet, Name, Args, eqv_inst(Body), _)
+ Item = item_inst_defn(ItemInstDefn),
+ ItemInstDefn = item_inst_defn_info(VarSet, Name, Args,
+ eqv_inst(Body), _, _)
->
- Items = Items0,
list.length(Args, Arity),
InstId = inst_id(Name, Arity),
svmap.set(InstId, eqv_inst_body(VarSet, Args, Body), !EqvInstMap)
;
- Items = Items0
+ true
),
- build_eqv_map(Items, !EqvMap, !EqvInstMap).
+ build_eqv_map(Items, !EqvMap, !EqvInstMap)
+ ).
-:- pred skip_abstract_imported_items(list(item_and_context)::in,
- list(item_and_context)::out) is det.
+:- pred skip_abstract_imported_items(list(item)::in, list(item)::out) is det.
skip_abstract_imported_items([], []).
-skip_abstract_imported_items([ItemAndContext0 | ItemAndContexts0],
- ItemAndContexts) :-
- ItemAndContext0 = item_and_context(Item0, _Context),
- (
- Item0 = item_module_defn(_, Defn),
- is_section_defn(Defn) = yes,
- Defn \= md_abstract_imported
+skip_abstract_imported_items([Item0 | Items0], Items) :-
+ (
+ Item0 = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ is_section_defn(ModuleDefn) = yes,
+ ModuleDefn \= md_abstract_imported
->
- ItemAndContexts = ItemAndContexts0
+ Items = Items0
;
- skip_abstract_imported_items(ItemAndContexts0, ItemAndContexts)
+ skip_abstract_imported_items(Items0, Items)
).
:- func is_section_defn(module_defn) = bool.
@@ -240,20 +243,20 @@
% on <foo>s.
%
:- pred replace_in_item_list(module_name::in, eqv_type_location::in,
- list(item_and_context)::in, eqv_map::in, eqv_inst_map::in,
- list(item_and_context)::in, list(item_and_context)::out,
+ list(item)::in, eqv_map::in, eqv_inst_map::in,
+ list(item)::in, list(item)::out,
maybe(recompilation_info)::in, maybe(recompilation_info)::out,
used_modules::in, used_modules::out,
list(error_spec)::in, list(error_spec)::out) is det.
replace_in_item_list(_, _, [], _, _, !Items, !RecompInfo, !UsedModules,
!Specs).
-replace_in_item_list(ModuleName, Location0,
- [ItemAndContext0 | ItemAndContexts0], EqvMap, EqvInstMap,
- !ReplItems, !RecompInfo, !UsedModules, !Specs) :-
- ItemAndContext0 = item_and_context(Item0, Context),
- ( Item0 = item_module_defn(_, ModuleDefn) ->
- ( ModuleDefn = md_interface,
+replace_in_item_list(ModuleName, Location0, [Item0 | Items0],
+ EqvMap, EqvInstMap, !ReplItems, !RecompInfo, !UsedModules, !Specs) :-
+ ( Item0 = item_module_defn(ItemModuleDefn) ->
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ (
+ ModuleDefn = md_interface,
Location = eqv_type_in_interface
;
( ModuleDefn = md_implementation
@@ -286,38 +289,92 @@
;
Location = Location0
),
- (
- replace_in_item(ModuleName, Location, Item0, Context, EqvMap,
- EqvInstMap, Item, !RecompInfo, !UsedModules, ItemSpecs)
- ->
- ItemAndContext = item_and_context(Item, Context),
+ replace_in_item(ModuleName, Location, EqvMap, EqvInstMap,
+ Item0, Item, !RecompInfo, !UsedModules, ItemSpecs),
% Discard the item if there were any errors.
(
ItemSpecs = [],
- !:ReplItems = [ItemAndContext | !.ReplItems]
+ !:ReplItems = [Item | !.ReplItems]
;
ItemSpecs = [_ | _]
),
- !:Specs = ItemSpecs ++ !.Specs
+ !:Specs = ItemSpecs ++ !.Specs,
+ replace_in_item_list(ModuleName, Location, Items0,
+ EqvMap, EqvInstMap, !ReplItems, !RecompInfo, !UsedModules, !Specs).
+
+:- pred replace_in_item(module_name::in, eqv_type_location::in,
+ eqv_map::in, eqv_inst_map::in, item::in,item::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out, list(error_spec)::out) is det.
+
+replace_in_item(ModuleName, Location, EqvMap, EqvInstMap,
+ Item0, Item, !RecompInfo, !UsedModules, Specs) :-
+ (
+ Item0 = item_type_defn(ItemTypeDefn0),
+ replace_in_type_defn_info(ModuleName, Location, EqvMap, EqvInstMap,
+ ItemTypeDefn0, ItemTypeDefn, !RecompInfo, !UsedModules, Specs),
+ Item = item_type_defn(ItemTypeDefn)
+ ;
+ Item0 = item_pred_decl(ItemPredDecl0),
+ replace_in_pred_decl_info(ModuleName, Location, EqvMap, EqvInstMap,
+ ItemPredDecl0, ItemPredDecl, !RecompInfo, !UsedModules, Specs),
+ Item = item_pred_decl(ItemPredDecl)
+ ;
+ Item0 = item_mode_decl(ItemModeDecl0),
+ replace_in_mode_decl_info(ModuleName, Location, EqvMap, EqvInstMap,
+ ItemModeDecl0, ItemModeDecl, !RecompInfo, !UsedModules, Specs),
+ Item = item_mode_decl(ItemModeDecl)
+ ;
+ Item0 = item_pragma(ItemPragma0),
+ replace_in_pragma_info(ModuleName, Location, EqvMap, EqvInstMap,
+ ItemPragma0, ItemPragma, !RecompInfo, !UsedModules, Specs),
+ Item = item_pragma(ItemPragma)
+ ;
+ Item0 = item_typeclass(ItemTypeClass0),
+ replace_in_typeclass_info(ModuleName, Location, EqvMap, EqvInstMap,
+ ItemTypeClass0, ItemTypeClass, !RecompInfo, !UsedModules, Specs),
+ Item = item_typeclass(ItemTypeClass)
+ ;
+ Item0 = item_instance(ItemInstance0),
+ replace_in_instance_info(ModuleName, Location, EqvMap, EqvInstMap,
+ ItemInstance0, ItemInstance, !RecompInfo, !UsedModules, Specs),
+ Item = item_instance(ItemInstance)
+ ;
+ Item0 = item_mutable(ItemMutable0),
+ replace_in_mutable_info(ModuleName, Location, EqvMap, EqvInstMap,
+ ItemMutable0, ItemMutable, !RecompInfo, !UsedModules, Specs),
+ Item = item_mutable(ItemMutable)
+ ;
+ Item0 = item_mode_defn(_),
+ % XXX zs: This seems to be a bug. Mode definitions contain insts,
+ % we should see if they need expansion.
+ Item = Item0,
+ Specs = []
;
- ItemAndContext = ItemAndContext0,
- !:ReplItems = [ItemAndContext | !.ReplItems]
+ ( Item0 = item_module_defn(_)
+ ; Item0 = item_clause(_)
+ ; Item0 = item_inst_defn(_)
+ ; Item0 = item_promise(_)
+ ; Item0 = item_initialise(_)
+ ; Item0 = item_finalise(_)
+ ; Item0 = item_nothing(_)
),
- replace_in_item_list(ModuleName, Location, ItemAndContexts0,
- EqvMap, EqvInstMap, !ReplItems, !RecompInfo, !UsedModules, !Specs).
+ Item = Item0,
+ Specs = []
+ ).
-:- pred replace_in_item(module_name::in, eqv_type_location::in, item::in,
- prog_context::in, eqv_map::in, eqv_inst_map::in, item::out,
+:- pred replace_in_type_defn_info(module_name::in, eqv_type_location::in,
+ eqv_map::in, eqv_inst_map::in,
+ item_type_defn_info::in, item_type_defn_info::out,
maybe(recompilation_info)::in, maybe(recompilation_info)::out,
- used_modules::in, used_modules::out, list(error_spec)::out) is semidet.
+ used_modules::in, used_modules::out, list(error_spec)::out) is det.
-replace_in_item(ModuleName, Location,
- item_type_defn(VarSet0, SymName, TArgs, TypeDefn0, Cond),
- Context, EqvMap, _EqvInstMap,
- item_type_defn(VarSet, SymName, TArgs, TypeDefn, Cond),
- !RecompInfo, !UsedModules, Specs) :-
+replace_in_type_defn_info(ModuleName, Location, EqvMap, _EqvInstMap,
+ Info0, Info, !RecompInfo, !UsedModules, Specs) :-
+ Info0 = item_type_defn_info(VarSet0, SymName, TArgs, TypeDefn0, Cond,
+ Context),
list.length(TArgs, Arity),
- maybe_record_expanded_items(ModuleName, SymName, !.RecompInfo,
+ maybe_start_recording_expanded_items(ModuleName, SymName, !.RecompInfo,
UsedTypeCtors0),
replace_in_type_defn(Location, EqvMap, type_ctor(SymName, Arity),
TypeDefn0, TypeDefn, ContainsCirc, VarSet0, VarSet,
@@ -331,49 +388,56 @@
Spec = error_spec(severity_error, phase_expand_types, [Msg]),
Specs = [Spec]
;
- unexpected(this_file, "replace_in_item: invalid item")
+ unexpected(this_file, "replace_in_type_defn: invalid item")
)
;
ContainsCirc = no,
Specs = []
),
ItemId = item_id(type_body_item, item_name(SymName, Arity)),
- finish_recording_expanded_items(ItemId, UsedTypeCtors, !RecompInfo).
+ finish_recording_expanded_items(ItemId, UsedTypeCtors, !RecompInfo),
+ Info = item_type_defn_info(VarSet, SymName, TArgs, TypeDefn, Cond,
+ Context).
+
+:- pred replace_in_pred_decl_info(module_name::in, eqv_type_location::in,
+ eqv_map::in, eqv_inst_map::in,
+ item_pred_decl_info::in, item_pred_decl_info::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out, list(error_spec)::out) is det.
-replace_in_item(ModuleName, Location,
- item_pred_or_func(Origin, TypeVarSet0, InstVarSet, ExistQVars,
+replace_in_pred_decl_info(ModuleName, Location, EqvMap, EqvInstMap,
+ Info0, Info, !RecompInfo, !UsedModules, Specs) :-
+ Info0 = item_pred_decl_info(Origin, TypeVarSet0, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes0, MaybeWithType0,
- MaybeWithInst0, Det0, Cond, Purity, ClassContext0),
- Context, EqvMap, EqvInstMap,
- item_pred_or_func(Origin, TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, MaybeWithType,
- MaybeWithInst, Det, Cond, Purity, ClassContext),
- !RecompInfo, !UsedModules, Specs) :-
- maybe_record_expanded_items(ModuleName, PredName, !.RecompInfo,
+ MaybeWithInst0, Det0, Cond, Purity, ClassContext0, Context),
+ maybe_start_recording_expanded_items(ModuleName, PredName, !.RecompInfo,
ExpandedItems0),
-
replace_in_pred_type(Location, PredName, PredOrFunc, Context, EqvMap,
EqvInstMap, ClassContext0, ClassContext,
TypesAndModes0, TypesAndModes, TypeVarSet0, TypeVarSet,
MaybeWithType0, MaybeWithType, MaybeWithInst0, MaybeWithInst,
Det0, Det, ExpandedItems0, ExpandedItems, !UsedModules, Specs),
-
ItemType = pred_or_func_to_item_type(PredOrFunc),
list.length(TypesAndModes, Arity),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
ItemId = item_id(ItemType, item_name(PredName, OrigArity)),
- finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo).
+ finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo),
+ Info = item_pred_decl_info(Origin, TypeVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, PredName, TypesAndModes, MaybeWithType,
+ MaybeWithInst, Det, Cond, Purity, ClassContext, Context).
-replace_in_item(ModuleName, Location,
- item_pred_or_func_mode(InstVarSet, MaybePredOrFunc0, PredName,
- Modes0, WithInst0, Det0, Cond),
- Context, _EqvMap, EqvInstMap,
- item_pred_or_func_mode(InstVarSet, MaybePredOrFunc, PredName,
- Modes, WithInst, Det, Cond),
- !RecompInfo, !UsedModules, Specs) :-
- maybe_record_expanded_items(ModuleName, PredName, !.RecompInfo,
- ExpandedItems0),
+:- pred replace_in_mode_decl_info(module_name::in, eqv_type_location::in,
+ eqv_map::in, eqv_inst_map::in,
+ item_mode_decl_info::in, item_mode_decl_info::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out, list(error_spec)::out) is det.
+replace_in_mode_decl_info(ModuleName, Location, _EqvMap, EqvInstMap,
+ Info0, Info, !RecompInfo, !UsedModules, Specs) :-
+ Info0 = item_mode_decl_info(InstVarSet, MaybePredOrFunc0, PredName,
+ Modes0, WithInst0, Det0, Cond, Context),
+ maybe_start_recording_expanded_items(ModuleName, PredName, !.RecompInfo,
+ ExpandedItems0),
replace_in_pred_mode(Location, PredName, length(Modes0), Context,
mode_decl, EqvInstMap, ExtraModes, MaybePredOrFunc0, MaybePredOrFunc,
WithInst0, WithInst, Det0, Det,
@@ -394,17 +458,22 @@
finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo)
;
MaybePredOrFunc = no
- ).
+ ),
+ Info = item_mode_decl_info(InstVarSet, MaybePredOrFunc, PredName,
+ Modes, WithInst, Det, Cond, Context).
-replace_in_item(ModuleName, Location,
- item_typeclass(Constraints0, FunDeps, ClassName, Vars,
- ClassInterface0, VarSet0),
- _Context, EqvMap, EqvInstMap,
- item_typeclass(Constraints, FunDeps, ClassName, Vars,
- ClassInterface, VarSet),
- !RecompInfo, !UsedModules, Specs) :-
+:- pred replace_in_typeclass_info(module_name::in, eqv_type_location::in,
+ eqv_map::in, eqv_inst_map::in,
+ item_typeclass_info::in, item_typeclass_info::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out, list(error_spec)::out) is det.
+
+replace_in_typeclass_info(ModuleName, Location, EqvMap, EqvInstMap,
+ Info0, Info, !RecompInfo, !UsedModules, Specs) :-
+ Info0 = item_typeclass_info(Constraints0, FunDeps, ClassName, Vars,
+ ClassInterface0, VarSet0, Context),
list.length(Vars, Arity),
- maybe_record_expanded_items(ModuleName, ClassName, !.RecompInfo,
+ maybe_start_recording_expanded_items(ModuleName, ClassName, !.RecompInfo,
ExpandedItems0),
replace_in_prog_constraint_list(Location, EqvMap,
Constraints0, Constraints, VarSet0, VarSet,
@@ -421,18 +490,23 @@
ClassInterface = class_interface_concrete(Methods)
),
ItemId = item_id(typeclass_item, item_name(ClassName, Arity)),
- finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo).
+ finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo),
+ Info = item_typeclass_info(Constraints, FunDeps, ClassName, Vars,
+ ClassInterface, VarSet, Context).
-replace_in_item(ModuleName, Location,
- item_instance(Constraints0, ClassName, Ts0, InstanceBody, VarSet0,
- ModName),
- _Context, EqvMap, _EqvInstMap,
- item_instance(Constraints, ClassName, Ts, InstanceBody, VarSet,
- ModName),
- !RecompInfo, !UsedModules, []) :-
+:- pred replace_in_instance_info(module_name::in, eqv_type_location::in,
+ eqv_map::in, eqv_inst_map::in,
+ item_instance_info::in, item_instance_info::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out, list(error_spec)::out) is det.
+
+replace_in_instance_info(ModuleName, Location, EqvMap, _EqvInstMap,
+ Info0, Info, !RecompInfo, !UsedModules, []) :-
+ Info0 = item_instance_info(Constraints0, ClassName, Ts0, InstanceBody,
+ VarSet0, ContainingModuleName, Context),
(
( !.RecompInfo = no
- ; ModName = ModuleName
+ ; ContainingModuleName = ModuleName
)
->
UsedTypeCtors0 = no
@@ -446,15 +520,22 @@
VarSet1, VarSet, UsedTypeCtors1, UsedTypeCtors, !UsedModules),
list.length(Ts0, Arity),
ItemId = item_id(typeclass_item, item_name(ClassName, Arity)),
- finish_recording_expanded_items(ItemId, UsedTypeCtors, !RecompInfo).
+ finish_recording_expanded_items(ItemId, UsedTypeCtors, !RecompInfo),
+ Info = item_instance_info(Constraints, ClassName, Ts, InstanceBody,
+ VarSet, ContainingModuleName, Context).
+
+:- pred replace_in_pragma_info(module_name::in, eqv_type_location::in,
+ eqv_map::in, eqv_inst_map::in,
+ item_pragma_info::in, item_pragma_info::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out, list(error_spec)::out) is det.
-replace_in_item(ModuleName, Location,
- item_pragma(Origin, pragma_type_spec(PredName, NewName, Arity, PorF,
- Modes, Subst0, VarSet0, ItemIds0)),
- _Context, EqvMap, _EqvInstMap,
- item_pragma(Origin, pragma_type_spec(PredName, NewName, Arity, PorF,
- Modes, Subst, VarSet, ItemIds)),
- !RecompInfo, !UsedModules, []) :-
+replace_in_pragma_info(ModuleName, Location, EqvMap, _EqvInstMap,
+ Info0, Info, !RecompInfo, !UsedModules, []) :-
+ Info0 = item_pragma_info(Origin, Pragma0, Context),
+ (
+ Pragma0 = pragma_type_spec(PredName, NewName, Arity,
+ PorF, Modes, Subst0, VarSet0, ItemIds0),
(
( !.RecompInfo = no
; PredName = qualified(ModuleName, _)
@@ -471,17 +552,14 @@
ItemIds = ItemIds0
;
ExpandedItems = yes(_ - ItemIds)
- ).
-
-replace_in_item(ModuleName, Location,
- item_pragma(Origin, pragma_foreign_proc(Attrs0, PName, PredOrFunc,
- ProcVars, ProcVarset, ProcInstVarset, ProcImpl)),
- _Context, EqvMap, _EqvInstMap,
- item_pragma(Origin, pragma_foreign_proc(Attrs, PName, PredOrFunc,
- ProcVars, ProcVarset, ProcInstVarset, ProcImpl)),
- !RecompInfo, !UsedModules, []) :-
+ ),
+ Pragma = pragma_type_spec(PredName, NewName, Arity,
+ PorF, Modes, Subst, VarSet, ItemIds)
+ ;
+ Pragma0 = pragma_foreign_proc(Attrs0, PName, PredOrFunc,
+ ProcVars, ProcVarset, ProcInstVarset, ProcImpl),
some [!EquivTypeInfo] (
- maybe_record_expanded_items(ModuleName, PName,
+ maybe_start_recording_expanded_items(ModuleName, PName,
!.RecompInfo, !:EquivTypeInfo),
UserSharing0 = get_user_annotated_sharing(Attrs0),
(
@@ -502,16 +580,59 @@
),
ItemId = item_id(foreign_proc_item, item_name(PName,
list.length(ProcVars))),
- finish_recording_expanded_items(ItemId, !.EquivTypeInfo, !RecompInfo)
- ).
+ finish_recording_expanded_items(ItemId, !.EquivTypeInfo,
+ !RecompInfo)
+ ),
+ Pragma = pragma_foreign_proc(Attrs, PName, PredOrFunc,
+ ProcVars, ProcVarset, ProcInstVarset, ProcImpl)
+ ;
+ ( Pragma0 = pragma_check_termination(_, _)
+ ; Pragma0 = pragma_does_not_terminate(_, _)
+ ; Pragma0 = pragma_exceptions(_, _, _, _, _)
+ ; Pragma0 = pragma_fact_table(_, _, _)
+ ; Pragma0 = pragma_foreign_code(_, _)
+ ; Pragma0 = pragma_foreign_decl(_, _, _)
+ ; Pragma0 = pragma_foreign_enum(_, _, _, _)
+ ; Pragma0 = pragma_foreign_export(_, _, _, _, _)
+ ; Pragma0 = pragma_foreign_export_enum(_, _, _, _, _)
+ ; Pragma0 = pragma_foreign_import_module(_, _)
+ ; Pragma0 = pragma_import(_, _, _, _, _)
+ ; Pragma0 = pragma_inline(_, _)
+ ; Pragma0 = pragma_mm_tabling_info(_, _, _, _, _)
+ ; Pragma0 = pragma_mode_check_clauses(_, _)
+ ; Pragma0 = pragma_no_inline(_, _)
+ ; Pragma0 = pragma_obsolete(_, _)
+ ; Pragma0 = pragma_promise_equivalent_clauses(_, _)
+ ; Pragma0 = pragma_promise_pure(_, _)
+ ; Pragma0 = pragma_promise_semipure(_, _)
+ ; Pragma0 = pragma_require_feature_set(_)
+ ; Pragma0 = pragma_reserve_tag(_, _)
+ ; Pragma0 = pragma_source_file(_)
+ ; Pragma0 = pragma_structure_reuse(_, _, _, _, _, _)
+ ; Pragma0 = pragma_structure_sharing(_, _, _, _, _, _)
+ ; Pragma0 = pragma_tabled(_, _, _, _, _, _)
+ ; Pragma0 = pragma_terminates(_, _)
+ ; Pragma0 = pragma_termination2_info(_, _, _, _, _, _)
+ ; Pragma0 = pragma_termination_info(_, _, _, _, _)
+ ; Pragma0 = pragma_trailing_info(_, _, _, _, _)
+ ; Pragma0 = prog_item.pragma_unused_args(_, _, _, _, _)
+ ),
+ Pragma = Pragma0
+ ),
+ Info = item_pragma_info(Origin, Pragma, Context).
-replace_in_item(ModuleName, Location,
- item_mutable(MutName, Type0, InitValue, Inst0, Attrs, Varset),
- _Context, EqvMap, EqvInstMap,
- item_mutable(MutName, Type, InitValue, Inst, Attrs, Varset),
- !RecompInfo, !UsedModules, []) :-
+:- pred replace_in_mutable_info(module_name::in, eqv_type_location::in,
+ eqv_map::in, eqv_inst_map::in,
+ item_mutable_info::in, item_mutable_info::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out, list(error_spec)::out) is det.
+
+replace_in_mutable_info(ModuleName, Location, EqvMap, EqvInstMap,
+ Info0, Info, !RecompInfo, !UsedModules, []) :-
+ Info0 = item_mutable_info(MutName, Type0, InitValue, Inst0, Attrs, Varset,
+ Context),
QualName = qualified(ModuleName, MutName),
- maybe_record_expanded_items(ModuleName, QualName, !.RecompInfo,
+ maybe_start_recording_expanded_items(ModuleName, QualName, !.RecompInfo,
ExpandedItems0),
TVarSet0 = varset.init,
replace_in_type_location(Location, EqvMap, Type0, Type, _TypeChanged,
@@ -519,7 +640,9 @@
replace_in_inst(Location, Inst0, EqvInstMap, Inst,
ExpandedItems1, ExpandedItems, !UsedModules),
ItemId = item_id(mutable_item, item_name(QualName, 0)),
- finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo).
+ finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo),
+ Info = item_mutable_info(MutName, Type, InitValue, Inst, Attrs, Varset,
+ Context).
:- pred replace_in_event_spec_list(
assoc_list(string, event_spec)::in, assoc_list(string, event_spec)::out,
@@ -590,7 +713,7 @@
:- pred replace_in_type_defn(eqv_type_location::in, eqv_map::in, type_ctor::in,
type_defn::in, type_defn::out, bool::out, tvarset::in, tvarset::out,
equiv_type_info::in, equiv_type_info::out,
- used_modules::in, used_modules::out) is semidet.
+ used_modules::in, used_modules::out) is det.
replace_in_type_defn(Location, EqvMap, TypeCtor, TypeDefn0, TypeDefn,
ContainsCirc, !VarSet, !EquivTypeInfo, !UsedModules) :-
@@ -616,6 +739,12 @@
SolverDetails = solver_type_details(RepresentationType, InitPred,
GroundInst, AnyInst, MutableItems),
TypeDefn = parse_tree_solver_type(SolverDetails, MaybeUserEqComp)
+ ;
+ ( TypeDefn0 = parse_tree_abstract_type(_)
+ ; TypeDefn0 = parse_tree_foreign_type(_, _, _)
+ ),
+ TypeDefn = TypeDefn0,
+ ContainsCirc = no
).
%-----------------------------------------------------------------------------%
@@ -1329,8 +1458,8 @@
:- type expanded_item_set == pair(module_name, set(item_id)).
-maybe_record_expanded_items(_, _, no, no).
-maybe_record_expanded_items(ModuleName, SymName, yes(_), MaybeInfo) :-
+maybe_start_recording_expanded_items(_, _, no, no).
+maybe_start_recording_expanded_items(ModuleName, SymName, yes(_), MaybeInfo) :-
( SymName = qualified(ModuleName, _) ->
MaybeInfo = no
;
@@ -1344,16 +1473,17 @@
map_maybe(record_expanded_item_2(Item), !EquivTypeInfo).
:- pred record_expanded_item_2(item_id::in,
- pair(module_name, set(item_id))::in,
- pair(module_name, set(item_id))::out) is det.
+ expanded_item_set::in, expanded_item_set::out) is det.
-record_expanded_item_2(ItemId, ModuleName - Items0, ModuleName - Items) :-
+record_expanded_item_2(ItemId, ExpandedItemSet0, ExpandedItemSet) :-
+ ExpandedItemSet0 = ModuleName - Items0,
ItemId = item_id(_, ItemName),
( ItemName = item_name(qualified(ModuleName, _), _) ->
% We don't need to record local types.
- Items = Items0
+ ExpandedItemSet = ExpandedItemSet0
;
- Items = set.insert(Items0, ItemId)
+ set.insert(Items0, ItemId, Items),
+ ExpandedItemSet = ModuleName - Items
).
finish_recording_expanded_items(_, no, no, no).
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.49
diff -u -b -r1.49 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 11 Feb 2008 21:25:52 -0000 1.49
+++ compiler/equiv_type_hlds.m 12 Feb 2008 01:20:44 -0000
@@ -145,7 +145,7 @@
hlds_data.get_type_defn_body(!.Defn, Body0),
TypeCtor = type_ctor(TypeCtorSymName, _TypeCtorArity),
TypeCtorItem = type_ctor_to_item_name(TypeCtor),
- equiv_type.maybe_record_expanded_items(ModuleName, TypeCtorSymName,
+ maybe_start_recording_expanded_items(ModuleName, TypeCtorSymName,
!.MaybeRecompInfo, EquivTypeInfo0),
(
Body0 = hlds_du_type(Ctors0, _, _, _, _, _, _, _),
@@ -301,7 +301,7 @@
MaybeRecompInfo0),
PredName = pred_info_name(!.PredInfo),
- equiv_type.maybe_record_expanded_items(ModuleName,
+ maybe_start_recording_expanded_items(ModuleName,
qualified(ModuleName, PredName), MaybeRecompInfo0,
!:EquivTypeInfo),
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.155
diff -u -b -r1.155 hlds_module.m
--- compiler/hlds_module.m 7 Sep 2007 15:08:17 -0000 1.155
+++ compiler/hlds_module.m 6 Feb 2008 04:03:43 -0000
@@ -229,11 +229,11 @@
%
% Create an empty module_info for a given module name (and the
- % global options). The item_list is passed so that we can call
+ % global options). The item list is passed so that we can call
% get_implicit_dependencies to figure out whether to import
% `table_builtin', but the items are not inserted into the module_info.
%
-:- pred module_info_init(module_name::in, item_list::in, globals::in,
+:- pred module_info_init(module_name::in, list(item)::in, globals::in,
partial_qualifier_info::in, maybe(recompilation_info)::in,
module_info::out) is det.
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.228
diff -u -b -r1.228 intermod.m
--- compiler/intermod.m 11 Feb 2008 21:25:57 -0000 1.228
+++ compiler/intermod.m 12 Feb 2008 01:20:45 -0000
@@ -1287,9 +1287,10 @@
Body = hlds_solver_type(SolverTypeDetails, MaybeUserEqComp),
TypeBody = parse_tree_solver_type(SolverTypeDetails, MaybeUserEqComp)
),
- mercury_output_item(
- item_type_defn(VarSet, Name, Args, TypeBody, cond_true),
- Context, !IO),
+ MainItemTypeDefn = item_type_defn_info(VarSet, Name, Args, TypeBody,
+ cond_true, Context),
+ MainItem = item_type_defn(MainItemTypeDefn),
+ mercury_output_item(MainItem, !IO),
(
( Body = hlds_foreign_type(ForeignTypeBody)
; Body ^ du_type_is_foreign_type = yes(ForeignTypeBody)
@@ -1301,12 +1302,12 @@
MaybeIL = yes(DataIL),
DataIL = foreign_type_lang_data(ILForeignType, ILMaybeUserEqComp,
AssertionsIL),
- mercury_output_item(
- item_type_defn(VarSet, Name, Args,
+ ILItemTypeDefn = item_type_defn_info(VarSet, Name, Args,
parse_tree_foreign_type(il(ILForeignType),
ILMaybeUserEqComp, AssertionsIL),
- cond_true),
- Context, !IO)
+ cond_true, Context),
+ ILItem = item_type_defn(ILItemTypeDefn),
+ mercury_output_item(ILItem, !IO)
;
MaybeIL = no
),
@@ -1314,12 +1315,12 @@
MaybeC = yes(DataC),
DataC = foreign_type_lang_data(CForeignType,
CMaybeUserEqComp, AssertionsC),
- mercury_output_item(
- item_type_defn(VarSet, Name, Args,
+ CItemTypeDefn = item_type_defn_info(VarSet, Name, Args,
parse_tree_foreign_type(c(CForeignType),
CMaybeUserEqComp, AssertionsC),
- cond_true),
- Context, !IO)
+ cond_true, Context),
+ CItem = item_type_defn(CItemTypeDefn),
+ mercury_output_item(CItem, !IO)
;
MaybeC = no
),
@@ -1327,12 +1328,12 @@
MaybeJava = yes(DataJava),
DataJava = foreign_type_lang_data(JavaForeignType,
JavaMaybeUserEqComp, AssertionsJava),
- mercury_output_item(
- item_type_defn(VarSet, Name, Args,
+ JavaItemTypeDefn = item_type_defn_info(VarSet, Name, Args,
parse_tree_foreign_type(java(JavaForeignType),
JavaMaybeUserEqComp, AssertionsJava),
- cond_true),
- Context, !IO)
+ cond_true, Context),
+ JavaItem = item_type_defn(JavaItemTypeDefn),
+ mercury_output_item(JavaItem, !IO)
;
MaybeJava = no
),
@@ -1340,12 +1341,12 @@
MaybeErlang = yes(DataErlang),
DataErlang = foreign_type_lang_data(ErlangForeignType,
ErlangMaybeUserEqComp, AssertionsErlang),
- mercury_output_item(
- item_type_defn(VarSet, Name, Args,
+ ErlangItemTypeDefn = item_type_defn_info(VarSet, Name, Args,
parse_tree_foreign_type(erlang(ErlangForeignType),
ErlangMaybeUserEqComp, AssertionsErlang),
- cond_true),
- Context, !IO)
+ cond_true, Context),
+ ErlangItem = item_type_defn(ErlangItemTypeDefn),
+ mercury_output_item(ErlangItem, !IO)
;
MaybeErlang = no
)
@@ -1357,8 +1358,10 @@
ReservedTag = uses_reserved_tag
->
% The pragma_origin doesn't matter here.
- mercury_output_item(item_pragma(user, pragma_reserve_tag(Name, Arity)),
- Context, !IO)
+ ReserveItemPragma = item_pragma_info(user,
+ pragma_reserve_tag(Name, Arity), Context),
+ ReserveItem = item_pragma(ReserveItemPragma),
+ mercury_output_item(ReserveItem, !IO)
;
true
),
@@ -1369,8 +1372,9 @@
map.foldl(gather_foreign_enum_value_pair, ConsTagVals, [],
ForeignEnumVals),
Pragma = pragma_foreign_enum(Lang, Name, Arity, ForeignEnumVals),
- Item = item_pragma(user, Pragma),
- mercury_output_item(Item, Context, !IO)
+ ForeignItemPragma = item_pragma_info(user, Pragma, Context),
+ ForeignItem = item_pragma(ForeignItemPragma),
+ mercury_output_item(ForeignItem, !IO)
;
true
).
@@ -1411,9 +1415,10 @@
SymName = qualified(ModuleName, _),
import_status_to_write(ImportStatus)
->
- mercury_output_item(
- item_mode_defn(Varset, SymName, Args, eqv_mode(Mode), cond_true),
- Context, !IO)
+ ItemModeDefn = item_mode_defn_info(Varset, SymName, Args,
+ eqv_mode(Mode), cond_true, Context),
+ Item = item_mode_defn(ItemModeDefn),
+ mercury_output_item(Item, !IO)
;
true
).
@@ -1444,8 +1449,10 @@
Body = abstract_inst,
InstBody = abstract_inst
),
- mercury_output_item(item_inst_defn(Varset, SymName, Args, InstBody,
- cond_true), Context, !IO)
+ ItemInstDefn = item_inst_defn_info(Varset, SymName, Args, InstBody,
+ cond_true, Context),
+ Item = item_inst_defn(ItemInstDefn),
+ mercury_output_item(Item, !IO)
;
true
).
@@ -1470,9 +1477,10 @@
import_status_to_write(ImportStatus)
->
FunDeps = list.map(unmake_hlds_class_fundep(TVars), HLDSFunDeps),
- Item = item_typeclass(Constraints, FunDeps, QualifiedClassName, TVars,
- Interface, TVarSet),
- mercury_output_item(Item, Context, !IO)
+ ItemTypeClass = item_typeclass_info(Constraints, FunDeps,
+ QualifiedClassName, TVars, Interface, TVarSet, Context),
+ Item = item_typeclass(ItemTypeClass),
+ mercury_output_item(Item, !IO)
;
true
).
@@ -1506,9 +1514,10 @@
InstanceDefn = hlds_instance_defn(ModuleName, _, Context, Constraints,
Types, Body, _, TVarSet, _),
ClassId = class_id(ClassName, _),
- Item = item_instance(Constraints, ClassName, Types, Body, TVarSet,
- ModuleName),
- mercury_output_item(Item, Context, !IO).
+ ItemInstance = item_instance_info(Constraints, ClassName, Types, Body,
+ TVarSet, ModuleName, Context),
+ Item = item_instance(ItemInstance),
+ mercury_output_item(Item, !IO).
% We need to write all the declarations for local predicates so
% the procedure labels for the C code are calculated correctly.
@@ -2261,9 +2270,10 @@
UnusedArgs = yes,
read_optimization_interfaces(no, ModuleName, [ModuleName],
set.init, [], LocalItems, no, UAError, !IO),
- IsPragmaUnusedArgs = (pred(ItemAndContext::in) is semidet :-
- ItemAndContext = item_and_context(item_pragma(_, PragmaType), _),
- PragmaType = pragma_unused_args(_,_,_,_,_)
+ IsPragmaUnusedArgs = (pred(Item::in) is semidet :-
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ Pragma = pragma_unused_args(_,_,_,_,_)
),
list.filter(IsPragmaUnusedArgs, LocalItems, PragmaItems),
@@ -2322,7 +2332,7 @@
:- pred read_optimization_interfaces(bool::in, module_name::in,
list(module_name)::in, set(module_name)::in,
- item_list::in, item_list::out, bool::in, bool::out,
+ list(item)::in, list(item)::out, bool::in, bool::out,
io::di, io::uo) is det.
read_optimization_interfaces(_, _, [], _, !Items, !Error, !IO).
Index: compiler/make.module_dep_file.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.module_dep_file.m,v
retrieving revision 1.31
diff -u -b -r1.31 make.module_dep_file.m
--- compiler/make.module_dep_file.m 23 Nov 2007 07:35:10 -0000 1.31
+++ compiler/make.module_dep_file.m 8 Feb 2008 16:41:12 -0000
@@ -631,7 +631,7 @@
).
:- pred make_short_interfaces(io.output_stream::in, file_name::in,
- assoc_list(module_name, item_list)::in, list(string)::in, bool::out,
+ assoc_list(module_name, list(item))::in, list(string)::in, bool::out,
make_info::in, make_info::out, io::di, io::uo) is det.
make_short_interfaces(ErrorStream, SourceFileName, SubModuleList, _, Succeeded,
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.75
diff -u -b -r1.75 make_hlds_passes.m
--- compiler/make_hlds_passes.m 5 Dec 2007 05:07:33 -0000 1.75
+++ compiler/make_hlds_passes.m 8 Feb 2008 16:39:55 -0000
@@ -48,13 +48,12 @@
% The bool records whether any cyclic insts or modes were detected.
%
-:- pred add_item_decl_pass_1(item::in, prog_context::in,
+:- pred add_item_decl_pass_1(item::in, bool::out,
item_status::in, item_status::out, module_info::in, module_info::out,
- bool::out, list(error_spec)::in, list(error_spec)::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-:- pred add_item_clause(item::in, import_status::in, import_status::out,
- prog_context::in, module_info::in, module_info::out,
- qual_info::in, qual_info::out,
+:- pred add_item_pass_3(item::in, import_status::in, import_status::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
:- pred add_stratified_pred(string::in, sym_name::in, arity::in,
@@ -194,7 +193,7 @@
!IO),
maybe_report_stats(Statistics, !IO),
init_qual_info(MQInfo0, EqvMap, QualInfo0),
- add_item_list_clauses(Items, status_local, !ModuleInfo,
+ add_item_list_pass_3(Items, status_local, !ModuleInfo,
QualInfo0, QualInfo, !Specs),
qual_info_get_mq_info(QualInfo, MQInfo),
@@ -244,19 +243,17 @@
% The `InvalidModes' bool records whether we detected
% any cyclic insts or modes.
%
-:- pred add_item_list_decls_pass_1(item_list::in, item_status::in,
+:- pred add_item_list_decls_pass_1(list(item)::in, item_status::in,
module_info::in, module_info::out, bool::in, bool::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_item_list_decls_pass_1([], _, !ModuleInfo, !InvalidModes, !Specs).
-add_item_list_decls_pass_1([ItemAndContext | ItemAndContexts], !.Status,
- !ModuleInfo, !InvalidModes, !Specs) :-
- ItemAndContext = item_and_context(Item, Context),
- add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo,
- NewInvalidModes, !Specs),
+add_item_list_decls_pass_1([Item | Items], !.Status, !ModuleInfo,
+ !InvalidModes, !Specs) :-
+ add_item_decl_pass_1(Item, NewInvalidModes, !Status, !ModuleInfo, !Specs),
!:InvalidModes = bool.or(!.InvalidModes, NewInvalidModes),
- add_item_list_decls_pass_1(ItemAndContexts, !.Status,
- !ModuleInfo, !InvalidModes, !Specs).
+ add_item_list_decls_pass_1(Items, !.Status, !ModuleInfo, !InvalidModes,
+ !Specs).
% pass 2:
% Add the type definitions and pragmas one by one to the module,
@@ -275,16 +272,14 @@
% processed all the mode declarations, since otherwise we can't be
% sure that there isn't a mode declaration for the function.
%
-:- pred add_item_list_decls_pass_2(item_list::in, item_status::in,
+:- pred add_item_list_decls_pass_2(list(item)::in, item_status::in,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_item_list_decls_pass_2([], _, !ModuleInfo, !Specs).
-add_item_list_decls_pass_2([ItemAndContext | ItemAndContexts], !.Status,
- !ModuleInfo, !Specs) :-
- ItemAndContext = item_and_context(Item, Context),
- add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs),
- add_item_list_decls_pass_2(ItemAndContexts, !.Status, !ModuleInfo, !Specs).
+add_item_list_decls_pass_2([Item | Items], !.Status, !ModuleInfo, !Specs) :-
+ add_item_decl_pass_2(Item, !Status, !ModuleInfo, !Specs),
+ add_item_list_decls_pass_2(Items, !.Status, !ModuleInfo, !Specs).
% pass 3:
% Add the clauses one by one to the module.
@@ -298,25 +293,75 @@
% name in the module_info so that we can generate code to call it at
% initialisation/finalisation time.
%
-:- pred add_item_list_clauses(item_list::in, import_status::in,
+:- pred add_item_list_pass_3(list(item)::in, import_status::in,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_item_list_clauses([], _Status, !ModuleInfo, !QualInfo, !Specs).
-add_item_list_clauses([ItemAndContext | ItemAndContexts], Status0,
- !ModuleInfo, !QualInfo, !Specs) :-
- ItemAndContext = item_and_context(Item, Context),
- add_item_clause(Item, Status0, Status1, Context,
- !ModuleInfo, !QualInfo, !Specs),
- add_item_list_clauses(ItemAndContexts, Status1,
- !ModuleInfo, !QualInfo, !Specs).
+add_item_list_pass_3([], _Status, !ModuleInfo, !QualInfo, !Specs).
+add_item_list_pass_3([Item | Items], Status0, !ModuleInfo, !QualInfo,
+ !Specs) :-
+ add_item_pass_3(Item, Status0, Status1, !ModuleInfo, !QualInfo, !Specs),
+ add_item_list_pass_3(Items, Status1, !ModuleInfo, !QualInfo, !Specs).
%-----------------------------------------------------------------------------%
-add_item_decl_pass_1(item_clause(_, _, _, _, _, _), _, !Status, !ModuleInfo,
- no, !Specs).
- % Skip clauses.
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !Specs) :-
+add_item_decl_pass_1(Item, FoundError, !Status, !ModuleInfo, !Specs) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ add_pass_1_module_defn(ItemModuleDefn, !Status, !ModuleInfo, !Specs),
+ FoundError = no
+ ;
+ Item = item_type_defn(ItemTypeDefnInfo),
+ add_pass_1_type_defn(ItemTypeDefnInfo, !Status, !ModuleInfo, !Specs),
+ FoundError = no
+ ;
+ Item = item_inst_defn(ItemInstDefnInfo),
+ module_add_inst_defn(ItemInstDefnInfo, FoundError,
+ !.Status, !ModuleInfo, !Specs)
+ ;
+ Item = item_mode_defn(ItemModeDefnInfo),
+ module_add_mode_defn(ItemModeDefnInfo, FoundError,
+ !.Status, !ModuleInfo, !Specs)
+ ;
+ Item = item_pred_decl(ItemPredDecl),
+ add_pass_1_pred_decl(ItemPredDecl, !.Status, !ModuleInfo, !Specs),
+ FoundError = no
+ ;
+ Item = item_mode_decl(ItemModeDecl),
+ add_pass_1_mode_decl(ItemModeDecl, !.Status, !ModuleInfo, !Specs),
+ FoundError = no
+ ;
+ Item = item_typeclass(ItemTypeClass),
+ module_add_class_defn(ItemTypeClass, !.Status, !ModuleInfo, !Specs),
+ FoundError = no
+ ;
+ Item = item_mutable(ItemMutable),
+ add_pass_1_mutable(ItemMutable, !.Status, !ModuleInfo, !Specs),
+ FoundError = no
+ ;
+ ( Item = item_clause(_)
+ ; Item = item_pragma(_)
+ ; Item = item_promise(_)
+ ; Item = item_instance(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_nothing(_)
+ ),
+ % These will be processed only in later passes.
+ %
+ % We don't want to add clauses or pragma foreign_procs before we add
+ % the declarations of the predicates they implement.
+ %
+ % We don't want to add instance declarations before the typeclass
+ % declaration it implements.
+ FoundError = no
+ ).
+
+:- pred add_pass_1_type_defn(item_type_defn_info::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_1_type_defn(ItemTypeDefnInfo, !Status, !ModuleInfo, !Specs) :-
% If this is a solver type then we need to also add the declarations
% for the compiler generated construction function and deconstruction
% predicate for the special constrained data constructor.
@@ -326,36 +371,30 @@
% Before switch detection, we turn calls to these functions/predicates
% into ordinary constructions/deconstructions, but preserve the
% corresponding impurity annotations.
- Item = item_type_defn(TVarSet, SymName, TypeParams, TypeDefn, _Cond),
+ ItemTypeDefnInfo = item_type_defn_info(TVarSet, SymName, TypeParams,
+ TypeDefn, _Cond, Context),
( TypeDefn = parse_tree_solver_type(SolverTypeDetails, _MaybeUserEqComp) ->
add_solver_type_decl_items(TVarSet, SymName, TypeParams,
SolverTypeDetails, Context, !Status, !ModuleInfo, !Specs),
add_solver_type_mutable_items_pass_1(SolverTypeDetails ^ mutable_items,
- Context, !Status, !ModuleInfo, !Specs)
+ !Status, !ModuleInfo, !Specs)
;
true
).
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, InvalidMode,
- !Specs) :-
- Item = item_inst_defn(VarSet, Name, Params, InstDefn, Cond),
- module_add_inst_defn(VarSet, Name, Params, InstDefn, Cond, Context,
- !.Status, !ModuleInfo, InvalidMode, !Specs).
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, InvalidMode,
- !Specs) :-
- Item = item_mode_defn(VarSet, Name, Params, ModeDefn, Cond),
- module_add_mode_defn(VarSet, Name, Params, ModeDefn,
- Cond, Context, !.Status, !ModuleInfo, InvalidMode, !Specs).
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !Specs) :-
- Item = item_pred_or_func(Origin, TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, _WithType, _WithInst, MaybeDet,
- _Cond, Purity, ClassContext),
+
+:- pred add_pass_1_pred_decl(item_pred_decl_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_1_pred_decl(ItemPredDecl, Status, !ModuleInfo, !Specs) :-
+ ItemPredDecl = item_pred_decl_info(Origin, TypeVarSet, InstVarSet,
+ ExistQVars, PredOrFunc, PredName, TypesAndModes, _WithType, _WithInst,
+ MaybeDet, _Cond, Purity, ClassContext, Context),
init_markers(Markers0),
- %
+
% If this predicate was added as a result of the mutable transformation
% then mark this predicate as a mutable access pred. We do this
- % so that we can tell optimizations, like inlining, to treat it
- % specially.
- %
+ % so that we can tell optimizations, like inlining, to treat it specially.
(
Origin = compiler(Reason),
(
@@ -376,13 +415,18 @@
),
module_add_pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes, MaybeDet, Purity, ClassContext,
- Markers, Context, !.Status, _, !ModuleInfo, !Specs).
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !Specs) :-
- Item = item_pred_or_func_mode(VarSet, MaybePredOrFunc, PredName, Modes,
- _WithInst, MaybeDet, _Cond),
+ Markers, Context, Status, _, !ModuleInfo, !Specs).
+
+:- pred add_pass_1_mode_decl(item_mode_decl_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_1_mode_decl(ItemModeDecl, Status, !ModuleInfo, !Specs) :-
+ ItemModeDecl = item_mode_decl_info(VarSet, MaybePredOrFunc, PredName,
+ Modes, _WithInst, MaybeDet, _Cond, Context),
(
MaybePredOrFunc = yes(PredOrFunc),
- !.Status = item_status(ImportStatus, _),
+ Status = item_status(ImportStatus, _),
IsClassMethod = no,
module_add_mode(VarSet, PredName, Modes, MaybeDet, ImportStatus,
Context, PredOrFunc, IsClassMethod, _, !ModuleInfo, !Specs)
@@ -390,15 +434,16 @@
MaybePredOrFunc = no,
% equiv_type.m should have either set the pred_or_func
% or removed the item from the list.
- unexpected(this_file, "add_item_decl_pass_1: " ++
- "no pred_or_func on mode declaration")
+ unexpected(this_file,
+ "add_pass_1_mode_decl: no pred_or_func on mode declaration")
).
-add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !Specs) :-
- Item = item_pragma(_, _).
-add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !Specs) :-
- Item = item_promise(_, _, _, _).
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !Specs) :-
- Item = item_module_defn(_VarSet, ModuleDefn),
+
+:- pred add_pass_1_module_defn(item_module_defn_info::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_1_module_defn(ItemModuleDefn, !Status, !ModuleInfo, !Specs) :-
+ ItemModuleDefn = item_module_defn_info(_VarSet, ModuleDefn, Context),
( module_defn_update_import_status(ModuleDefn, StatusPrime) ->
!:Status = StatusPrime
; ModuleDefn = md_import(list_module(Specifiers)) ->
@@ -447,27 +492,17 @@
Spec = error_spec(severity_warning, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs]
).
-add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !Specs) :-
- Item = item_nothing(_).
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !Specs) :-
- Item = item_typeclass(Constraints, FunDeps, Name, Vars, Interface, VarSet),
- module_add_class_defn(Constraints, FunDeps, Name, Vars, Interface,
- VarSet, Context, !.Status, !ModuleInfo, !Specs).
-add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !Specs) :-
- % We add instance declarations on the second pass so that we don't add
- % an instance declaration before its class declaration.
- Item = item_instance(_, _, _, _, _,_).
-add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !Specs) :-
- % We add initialise declarations on the third pass.
- Item = item_initialise(_, _, _).
-add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, no, !Specs) :-
- % We add finalise declarations on the third pass.
- Item = item_finalise(_, _, _).
-add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, no, !Specs) :-
+
+:- pred add_pass_1_mutable(item_mutable_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_1_mutable(Item, Status, !ModuleInfo, !Specs) :-
% We add the initialise decl and the foreign_decl on the second pass and
% the foreign_proc clauses on the third pass.
- Item = item_mutable(Name, Type, _InitValue, Inst, MutAttrs, _MutVarset),
- !.Status = item_status(ImportStatus, _),
+ Item = item_mutable_info(Name, Type, _InitValue, Inst, MutAttrs,
+ _MutVarset, Context),
+ Status = item_status(ImportStatus, _),
DefinedThisModule = status_defined_in_this_module(ImportStatus),
(
DefinedThisModule = yes,
@@ -498,9 +533,9 @@
),
% Create the mutable initialisation predicate.
- InitPredDecl = mutable_init_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(InitPredDecl, Context, !Status, !ModuleInfo, _,
- !Specs),
+ InitPredDeclItem = mutable_init_pred_decl(ModuleName, Name, Context),
+ add_item_decl_pass_1(InitPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs),
IsConstant = mutable_var_constant(MutAttrs),
(
@@ -510,9 +545,10 @@
% by the mutable initialisation predicate.
(
WantPreInitDecl = yes,
- PreInitPredDecl = mutable_pre_init_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(PreInitPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs)
+ PreInitPredDeclItem = mutable_pre_init_pred_decl(ModuleName,
+ Name, Context),
+ add_item_decl_pass_1(PreInitPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs)
;
WantPreInitDecl = no
),
@@ -520,20 +556,20 @@
% Create the primitive access and locking predicates.
(
WantUnsafeAccessAndLockDecls = yes,
- LockPredDecl = lock_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(LockPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnlockPredDecl = unlock_pred_decl(ModuleName, Name),
- add_item_decl_pass_1(UnlockPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnsafeGetPredDecl = unsafe_get_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(UnsafeGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- UnsafeSetPredDecl = unsafe_set_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(UnsafeSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs)
+ LockPredDeclItem = lock_pred_decl(ModuleName, Name, Context),
+ UnlockPredDecl = unlock_pred_decl(ModuleName, Name, Context),
+ add_item_decl_pass_1(LockPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs),
+ add_item_decl_pass_1(UnlockPredDecl, _, Status, _,
+ !ModuleInfo, !Specs),
+ UnsafeGetPredDeclItem = unsafe_get_pred_decl(ModuleName, Name,
+ Type, Inst, Context),
+ UnsafeSetPredDeclItem = unsafe_set_pred_decl(ModuleName, Name,
+ Type, Inst, Context),
+ add_item_decl_pass_1(UnsafeGetPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs),
+ add_item_decl_pass_1(UnsafeSetPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs)
;
WantUnsafeAccessAndLockDecls = no
),
@@ -541,24 +577,28 @@
% Create the standard, non-pure access predicates. These are
% always created for non-constant mutables, even if the
% `attach_to_io_state' attribute has been specified.
- StdGetPredDecl = std_get_pred_decl(ModuleName, Name, Type, Inst),
- add_item_decl_pass_1(StdGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- StdSetPredDecl = std_set_pred_decl(ModuleName, Name, Type, Inst),
- add_item_decl_pass_1(StdSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
+ StdGetPredDeclItem = std_get_pred_decl(ModuleName, Name,
+ Type, Inst, Context),
+ StdSetPredDeclItem = std_set_pred_decl(ModuleName, Name,
+ Type, Inst, Context),
+ add_item_decl_pass_1(StdGetPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs),
+ add_item_decl_pass_1(StdSetPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs),
% If requested, create the pure access predicates using
% the I/O state as well.
CreateIOInterface = mutable_var_attach_to_io_state(MutAttrs),
(
CreateIOInterface = yes,
- IOGetPredDecl = io_get_pred_decl(ModuleName, Name, Type, Inst),
- add_item_decl_pass_1(IOGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- IOSetPredDecl = io_set_pred_decl(ModuleName, Name, Type, Inst),
- add_item_decl_pass_1(IOSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs)
+ IOGetPredDeclItem = io_get_pred_decl(ModuleName, Name,
+ Type, Inst, Context),
+ IOSetPredDeclItem = io_set_pred_decl(ModuleName, Name,
+ Type, Inst, Context),
+ add_item_decl_pass_1(IOGetPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs),
+ add_item_decl_pass_1(IOSetPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs)
;
CreateIOInterface = no
)
@@ -568,30 +608,28 @@
% We create the "get" access predicate, which is pure since
% it always returns the same value, but we must also create
% a secret "set" predicate for use by the initialization code.
- ConstantGetPredDecl = constant_get_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(ConstantGetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs),
- ConstantSetPredDecl = constant_set_pred_decl(ModuleName, Name,
- Type, Inst),
- add_item_decl_pass_1(ConstantSetPredDecl, Context, !Status,
- !ModuleInfo, _, !Specs)
+ ConstantGetPredDeclItem = constant_get_pred_decl(ModuleName, Name,
+ Type, Inst, Context),
+ ConstantSetPredDeclItem = constant_set_pred_decl(ModuleName, Name,
+ Type, Inst, Context),
+ add_item_decl_pass_1(ConstantGetPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs),
+ add_item_decl_pass_1(ConstantSetPredDeclItem, _, Status, _,
+ !ModuleInfo, !Specs)
)
;
DefinedThisModule = no
).
-:- pred add_solver_type_mutable_items_pass_1(list(item)::in, prog_context::in,
+:- pred add_solver_type_mutable_items_pass_1(list(item)::in,
item_status::in, item_status::out, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_solver_type_mutable_items_pass_1([], _Context, !Status, !ModuleInfo,
- !Specs).
-add_solver_type_mutable_items_pass_1([Item | Items], Context, !Status,
+add_solver_type_mutable_items_pass_1([], !Status, !ModuleInfo, !Specs).
+add_solver_type_mutable_items_pass_1([Item | Items], !Status,
!ModuleInfo, !Specs) :-
- add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, _, !Specs),
- add_solver_type_mutable_items_pass_1(Items, Context, !Status, !ModuleInfo,
- !Specs).
+ add_item_decl_pass_1(Item, _, !Status, !ModuleInfo, !Specs),
+ add_solver_type_mutable_items_pass_1(Items, !Status, !ModuleInfo, !Specs).
:- pred add_module_specifiers(list(module_specifier)::in, import_status::in,
module_info::in, module_info::out) is det.
@@ -612,38 +650,77 @@
%-----------------------------------------------------------------------------%
-:- pred add_item_decl_pass_2(item::in, prog_context::in, item_status::in,
- item_status::out, module_info::in, module_info::out,
+:- pred add_item_decl_pass_2(item::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_item_decl_pass_2(Item, _Context, !Status, !ModuleInfo, !Specs) :-
- Item = item_module_defn(_VarSet, ModuleDefn),
- ( module_defn_update_import_status(ModuleDefn, StatusPrime) ->
- !:Status = StatusPrime
+add_item_decl_pass_2(Item, !Status, !ModuleInfo, !Specs) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ( module_defn_update_import_status(ModuleDefn, NewStatus) ->
+ !:Status = NewStatus
;
true
+ )
+ ;
+ Item = item_type_defn(ItemTypeDefn),
+ add_pass_2_type_defn(ItemTypeDefn, !.Status, !ModuleInfo, !Specs)
+ ;
+ Item = item_pred_decl(ItemPredDecl),
+ add_pass_2_pred_decl(ItemPredDecl, !.Status, !ModuleInfo, !Specs)
+ ;
+ Item = item_pragma(ItemPragma),
+ add_pragma(ItemPragma, !Status, !ModuleInfo, !Specs)
+ ;
+ Item = item_instance(ItemInstance),
+ add_pass_2_instance(ItemInstance, !.Status, !ModuleInfo, !Specs)
+ ;
+ Item = item_initialise(ItemInitialise),
+ add_pass_2_initialise(ItemInitialise, !.Status, !ModuleInfo, !Specs)
+ ;
+ Item = item_finalise(ItemFinalise),
+ add_pass_2_finalise(ItemFinalise, !.Status, !ModuleInfo, !Specs)
+ ;
+ Item = item_mutable(ItemMutable),
+ add_pass_2_mutable(ItemMutable, !.Status, !ModuleInfo, !Specs)
+ ;
+ ( Item = item_clause(_)
+ ; Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_promise(_)
+ ; Item = item_typeclass(_)
+ ; Item = item_nothing(_)
+ )
+ % Do nothing in pass 2 for these kinds of items.
).
-add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs) :-
- Item = item_type_defn(VarSet, Name, Args, TypeDefn, Cond),
+
+:- pred add_pass_2_type_defn(item_type_defn_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_2_type_defn(ItemTypeDefn, Status, !ModuleInfo, !Specs) :-
+ ItemTypeDefn = item_type_defn_info(VarSet, Name, Args, TypeDefn, Cond,
+ Context),
module_add_type_defn(VarSet, Name, Args, TypeDefn, Cond, Context,
- !.Status, !ModuleInfo, !Specs),
+ Status, !ModuleInfo, !Specs),
( TypeDefn = parse_tree_solver_type(SolverTypeDetails, _MaybeUserEqComp) ->
add_solver_type_mutable_items_pass_2(SolverTypeDetails ^ mutable_items,
- Context, !Status, !ModuleInfo, !Specs)
+ Status, _, !ModuleInfo, !Specs)
;
true
).
-add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs) :-
- Item = item_pragma(Origin, Pragma),
- add_pragma(Origin, Pragma, Context, !Status, !ModuleInfo, !Specs).
-add_item_decl_pass_2(Item, _Context, !Status, !ModuleInfo, !Specs) :-
- Item = item_pred_or_func(_Origin, _TypeVarSet, _InstVarSet, _ExistQVars,
- PredOrFunc, SymName, TypesAndModes, _WithType, _WithInst,
- _MaybeDet, _Cond, _Purity, _ClassContext),
- %
+:- pred add_pass_2_pred_decl(item_pred_decl_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_2_pred_decl(ItemPredDecl, _Status, !ModuleInfo, !Specs) :-
+ ItemPredDecl = item_pred_decl_info(_Origin, _TypeVarSet, _InstVarSet,
+ _ExistQVars, PredOrFunc, SymName, TypesAndModes, _WithType, _WithInst,
+ _MaybeDet, _Cond, _Purity, _ClassContext, _Context),
% Add default modes for function declarations, if necessary.
- %
(
PredOrFunc = pf_predicate
;
@@ -663,24 +740,15 @@
unexpected(this_file, "can't find func declaration")
)
).
-add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !Specs) :-
- Item = item_promise(_, _, _, _).
-add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !Specs) :-
- Item = item_clause(_, _, _, _, _, _).
-add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !Specs) :-
- Item = item_inst_defn(_, _, _, _, _).
-add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !Specs) :-
- Item = item_mode_defn(_, _, _, _, _).
-add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !Specs) :-
- Item = item_pred_or_func_mode(_, _, _, _, _, _, _).
-add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !Specs) :-
- Item = item_nothing(_).
-add_item_decl_pass_2(Item, _, !Status, !ModuleInfo, !Specs) :-
- Item = item_typeclass(_, _, _, _, _, _).
-add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs) :-
- Item = item_instance(Constraints, Name, Types, Body, VarSet,
- InstanceModuleName),
- !.Status = item_status(ImportStatus, _),
+
+:- pred add_pass_2_instance(item_instance_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_2_instance(ItemInstance, Status, !ModuleInfo, !Specs) :-
+ ItemInstance = item_instance_info(Constraints, Name, Types, Body, VarSet,
+ InstanceModuleName, Context),
+ Status = item_status(ImportStatus, _),
(
Body = instance_body_abstract,
make_status_abstract(ImportStatus, BodyStatus)
@@ -690,11 +758,16 @@
),
module_add_instance_defn(InstanceModuleName, Constraints, Name, Types,
Body, VarSet, BodyStatus, Context, !ModuleInfo, !Specs).
-add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs) :-
+
+:- pred add_pass_2_initialise(item_initialise_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_2_initialise(ItemInitialise, Status, !ModuleInfo, !Specs) :-
% These are processed properly during pass 3, we just do some
% error checking at this point.
- Item = item_initialise(Origin, _, _),
- !.Status = item_status(ImportStatus, _),
+ ItemInitialise = item_initialise_info(Origin, _, _, Context),
+ Status = item_status(ImportStatus, _),
( ImportStatus = status_exported ->
(
Origin = user,
@@ -718,11 +791,16 @@
;
true
).
-add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs) :-
+
+:- pred add_pass_2_finalise(item_finalise_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_2_finalise(ItemFinalise, Status, !ModuleInfo, !Specs) :-
% There are processed properly during pass 3, we just do some error
% checking at this point.
- Item = item_finalise(Origin, _, _),
- !.Status = item_status(ImportStatus, _),
+ ItemFinalise = item_finalise_info(Origin, _, _, Context),
+ Status = item_status(ImportStatus, _),
( ImportStatus = status_exported ->
(
Origin = user,
@@ -736,19 +814,25 @@
;
true
).
-add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs) :-
- Item = item_mutable(Name, _Type, _InitTerm, Inst, MutAttrs, _MutVarset),
- !.Status = item_status(ImportStatus, _),
+
+:- pred add_pass_2_mutable(item_mutable_info::in,
+ item_status::in, module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_2_mutable(ItemMutable, Status, !ModuleInfo, !Specs) :-
+ ItemMutable = item_mutable_info(Name, _Type, _InitTerm, Inst,
+ MutAttrs, _MutVarset, Context),
+ Status = item_status(ImportStatus, _),
( ImportStatus = status_exported ->
error_is_exported(Context, "`mutable' declaration", !Specs)
;
true
),
- %
+
% We don't implement the `mutable' declaration unless it is defined in
% this module. Not having this check means that we might end up up
% duplicating the definition of the global variable in any submodules.
- %
+
DefinedThisModule = status_defined_in_this_module(ImportStatus),
(
DefinedThisModule = yes,
@@ -790,8 +874,10 @@
IOStateInterface = yes,
SetPredName = mutable_set_pred_sym_name(ModuleName, Name),
IOSetPromisePurePragma = pragma_promise_pure(SetPredName, 3),
- add_pragma(compiler(mutable_decl), IOSetPromisePurePragma,
- Context, !Status, !ModuleInfo, !Specs)
+ IOSetPromisePureItemPragma = item_pragma_info(
+ compiler(mutable_decl), IOSetPromisePurePragma, Context),
+ add_pragma(IOSetPromisePureItemPragma, Status, _,
+ !ModuleInfo, !Specs)
;
IOStateInterface = no
)
@@ -809,10 +895,9 @@
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs]
),
- %
+
% Check that the inst in the mutable declaration is a valid inst for a
% mutable declaration.
- %
( is_valid_mutable_inst(!.ModuleInfo, Inst) ->
true
;
@@ -827,7 +912,7 @@
quote(InstStr),
words("is not a valid inst for a mutable declaration.")
],
- % XXX we could provide more information about exactly *why* the
+ % XXX We could provide more information about exactly *why* the
% inst was not valid here as well.
InvalidInstMsg = simple_msg(Context, [always(InvalidInstPieces)]),
InvalidInstSpec = error_spec(severity_error,
@@ -838,17 +923,15 @@
DefinedThisModule = no
).
-:- pred add_solver_type_mutable_items_pass_2(list(item)::in, prog_context::in,
+:- pred add_solver_type_mutable_items_pass_2(list(item)::in,
item_status::in, item_status::out, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_solver_type_mutable_items_pass_2([], _Context, !Status,
- !ModuleInfo, !Specs).
-add_solver_type_mutable_items_pass_2([Item | Items], Context, !Status,
- !ModuleInfo, !Specs) :-
- add_item_decl_pass_2(Item, Context, !Status, !ModuleInfo, !Specs),
- add_solver_type_mutable_items_pass_2(Items, Context, !Status,
- !ModuleInfo, !Specs).
+add_solver_type_mutable_items_pass_2([], !Status, !ModuleInfo, !Specs).
+add_solver_type_mutable_items_pass_2([Item | Items], !Status, !ModuleInfo,
+ !Specs) :-
+ add_item_decl_pass_2(Item, !Status, !ModuleInfo, !Specs),
+ add_solver_type_mutable_items_pass_2(Items, !Status, !ModuleInfo, !Specs).
% Check to see if there is a valid foreign_name attribute for this backend.
% If so, use it as the name of the global variable in the target code,
@@ -902,9 +985,61 @@
%-----------------------------------------------------------------------------%
-add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_clause(Origin, VarSet, PredOrFunc, PredName, Args, Body),
- ( !.Status = status_exported ->
+add_item_pass_3(Item, !Status, !ModuleInfo, !QualInfo, !Specs) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ add_pass_3_module_defn(ItemModuleDefn, !Status, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ Item = item_clause(ItemClause),
+ add_pass_3_clause(ItemClause, !.Status, !ModuleInfo, !QualInfo, !Specs)
+ ;
+ Item = item_type_defn(ItemTypeDefn),
+ add_pass_3_type_defn(ItemTypeDefn, !.Status, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ Item = item_pred_decl(ItemPredDecl),
+ add_pass_3_pred_decl(ItemPredDecl, !.Status, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ Item = item_pragma(ItemPragma),
+ add_pass_3_pragma(ItemPragma, !Status, !ModuleInfo, !QualInfo, !Specs)
+ ;
+ Item = item_promise(ItemPromise),
+ add_pass_3_promise(ItemPromise, !.Status, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ Item = item_initialise(ItemInitialise),
+ add_pass_3_initialise(ItemInitialise, !.Status, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ Item = item_finalise(ItemFinalise),
+ add_pass_3_finalise(ItemFinalise, !.Status, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ Item = item_mutable(ItemMutable),
+ add_pass_3_mutable(ItemMutable, !.Status, !ModuleInfo, !QualInfo,
+ !Specs)
+ ;
+ ( Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_typeclass(_)
+ ; Item = item_instance(_)
+ ; Item = item_nothing(_)
+ )
+ % Do nothing.
+ ).
+
+:- pred add_pass_3_clause(item_clause_info::in,
+ import_status::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_clause(ItemClause, Status, !ModuleInfo, !QualInfo, !Specs) :-
+ ItemClause = item_clause_info(Origin, VarSet, PredOrFunc,
+ PredName, Args, Body, Context),
+ ( Status = status_exported ->
(
Origin = user,
list.length(Args, Arity),
@@ -937,47 +1072,61 @@
true
),
% At this stage we only need know that it's not a promise declaration.
- module_add_clause(VarSet, PredOrFunc, PredName, Args, Body, !.Status,
+ module_add_clause(VarSet, PredOrFunc, PredName, Args, Body, Status,
Context, goal_type_none, !ModuleInfo, !QualInfo, !Specs).
-add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_type_defn(_TVarSet, SymName, TypeParams, TypeDefn, _Cond),
- % If this is a solver type then we need to also add clauses
- % the compiler generated inst cast predicate (the declaration
- % for which was added in pass 1). We should only add the clauses
- % if this is the module in which the solver type was defined though.
+
+:- pred add_pass_3_type_defn(item_type_defn_info::in,
+ import_status::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_type_defn(ItemTypeDefn, Status, !ModuleInfo, !QualInfo, !Specs) :-
+ ItemTypeDefn = item_type_defn_info(_TVarSet, SymName, TypeParams, TypeDefn,
+ _Cond, Context),
+ % If this is a solver type, then we need to also add the clauses for
+ % the compiler generated inst cast predicate (the declaration for which
+ % was added in pass 1). We should only add the clauses if this is the
+ % module in which the solver type was defined though.
(
TypeDefn = parse_tree_solver_type(SolverTypeDetails, _MaybeUserEqComp),
- status_defined_in_this_module(!.Status) = yes
+ status_defined_in_this_module(Status) = yes
->
add_solver_type_clause_items(SymName, TypeParams, SolverTypeDetails,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs),
+ Context, Status, _, !ModuleInfo, !QualInfo, !Specs),
MutableItems = SolverTypeDetails ^ mutable_items,
- add_solver_type_mutable_items_clauses(MutableItems,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ add_solver_type_mutable_items_clauses(MutableItems, Status, _,
+ !ModuleInfo, !QualInfo, !Specs)
;
true
).
-add_item_clause(Item, !Status, _, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_inst_defn(_, _, _, _, _).
-add_item_clause(Item, !Status, _, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_mode_defn(_, _, _, _, _).
-add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_pred_or_func(_, _, _, _, PredOrFunc, SymName, TypesAndModes,
- _WithType, _WithInst, _, _, _, _),
+
+:- pred add_pass_3_pred_decl(item_pred_decl_info::in,
+ import_status::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_pred_decl(ItemPredDecl, Status, !ModuleInfo, !QualInfo, !Specs) :-
+ ItemPredDecl = item_pred_decl_info(_, _, _, _, PredOrFunc, SymName,
+ TypesAndModes, _WithType, _WithInst, _, _, _, _, Context),
(
PredOrFunc = pf_predicate
;
PredOrFunc = pf_function,
list.length(TypesAndModes, PredArity),
adjust_func_arity(pf_function, FuncArity, PredArity),
- maybe_check_field_access_function(SymName, FuncArity, !.Status,
+ maybe_check_field_access_function(SymName, FuncArity, Status,
Context, !.ModuleInfo, !Specs)
).
-add_item_clause(Item, !Status, _, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_pred_or_func_mode(_, _, _, _, _, _, _).
-add_item_clause(Item, !Status, _, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_module_defn(_, Defn),
- ( Defn = md_version_numbers(ModuleName, ModuleVersionNumbers) ->
+
+:- pred add_pass_3_module_defn(item_module_defn_info::in,
+ import_status::in, import_status::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_module_defn(ItemModuleDefn, !Status, !ModuleInfo, !QualInfo,
+ !Specs) :-
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ( ModuleDefn = md_version_numbers(ModuleName, ModuleVersionNumbers) ->
% Record the version numbers for each imported module
% if smart recompilation is enabled.
RecordPred = (pred(RecompInfo0::in, RecompInfo::out) is det :-
@@ -985,7 +1134,7 @@
map.elem(ModuleName) := ModuleVersionNumbers
),
apply_to_recompilation_info(RecordPred, !QualInfo)
- ; module_defn_update_import_status(Defn, ItemStatus1) ->
+ ; module_defn_update_import_status(ModuleDefn, ItemStatus1) ->
ItemStatus1 = item_status(!:Status, NeedQual),
qual_info_get_mq_info(!.QualInfo, MQInfo0),
mq_info_set_need_qual_flag(NeedQual, MQInfo0, MQInfo),
@@ -993,8 +1142,14 @@
;
true
).
-add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_pragma(Origin, Pragma),
+
+:- pred add_pass_3_pragma(item_pragma_info::in,
+ import_status::in, import_status::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_pragma(ItemPragma, !Status, !ModuleInfo, !QualInfo, !Specs) :-
+ ItemPragma = item_pragma_info(Origin, Pragma, Context),
(
Pragma = pragma_foreign_proc(Attributes, Pred, PredOrFunc,
Vars, ProgVarSet, InstVarSet, PragmaImpl),
@@ -1018,7 +1173,7 @@
(
TypeLayout = yes,
module_add_pragma_tabled(Type, Name, Arity, PredOrFunc, MaybeModes,
- MaybeAttributes, !Status, Context, !ModuleInfo, !QualInfo,
+ MaybeAttributes, Context, !Status, !ModuleInfo, !QualInfo,
!Specs)
;
TypeLayout = no,
@@ -1117,8 +1272,15 @@
; Pragma = pragma_require_feature_set(_)
)
).
-add_item_clause(item_promise(PromiseType, Goal, VarSet, UnivVars),
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+
+:- pred add_pass_3_promise(item_promise_info::in,
+ import_status::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_promise(ItemPromise, Status, !ModuleInfo, !QualInfo, !Specs) :-
+ ItemPromise = item_promise_info(PromiseType, Goal, VarSet, UnivVars,
+ Context),
% If the outermost universally quantified variables are placed in the head
% of the dummy predicate, the typechecker will avoid warning about unbound
% type variables as this implicitly adds a universal quantification of the
@@ -1136,14 +1298,18 @@
),
% Add as dummy predicate.
add_promise_clause(PromiseType, HeadVars, VarSet, Goal, Context,
- !.Status, !ModuleInfo, !QualInfo, !Specs).
-add_item_clause(item_nothing(_), !Status, _, !ModuleInfo, !QualInfo, !Specs).
-add_item_clause(item_typeclass(_, _, _, _, _, _), !Status, _, !ModuleInfo,
- !QualInfo, !Specs).
-add_item_clause(item_instance(_, _, _, _, _, _), !Status, _, !ModuleInfo,
- !QualInfo, !Specs).
-add_item_clause(item_initialise(user, SymName, Arity), !Status, Context,
- !ModuleInfo, !QualInfo, !Specs) :-
+ Status, !ModuleInfo, !QualInfo, !Specs).
+
+:- pred add_pass_3_initialise(item_initialise_info::in,
+ import_status::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_initialise(ItemInitialise, Status, !ModuleInfo, !QualInfo,
+ !Specs) :-
+ ItemInitialise = item_initialise_info(Origin, SymName, Arity, Context),
+ Origin = user,
+
% To handle a `:- initialise initpred.' declaration for C backends we need
% to:
% (1) construct a new C function name, CName, to use to export initpred,
@@ -1170,7 +1336,8 @@
type_is_io_state(Arg1Type),
type_is_io_state(Arg2Type),
list.member(ProcInfo, ProcInfos),
- proc_info_get_maybe_declared_argmodes(ProcInfo, MaybeHeadModes),
+ proc_info_get_maybe_declared_argmodes(ProcInfo,
+ MaybeHeadModes),
MaybeHeadModes = yes(HeadModes),
HeadModes = [ di_mode, uo_mode ],
proc_info_get_declared_determinism(ProcInfo, MaybeDetism),
@@ -1181,31 +1348,34 @@
->
module_info_new_user_init_pred(SymName, Arity, CName,
!ModuleInfo),
- PragmaExportItem =
- item_pragma(compiler(initialise_decl),
- pragma_foreign_export(ExportLang, SymName,
- pf_predicate, [di_mode, uo_mode], CName)),
- add_item_clause(PragmaExportItem, !Status, Context,
+ ExportPragma = pragma_foreign_export(ExportLang, SymName,
+ pf_predicate, [di_mode, uo_mode], CName),
+ ExportItemPragma = item_pragma_info(compiler(initialise_decl),
+ ExportPragma, Context),
+ ExportItem = item_pragma(ExportItemPragma),
+ add_item_pass_3(ExportItem, Status, _,
!ModuleInfo, !QualInfo, !Specs)
;
ArgTypes = [],
list.member(ProcInfo, ProcInfos),
- proc_info_get_maybe_declared_argmodes(ProcInfo, MaybeHeadModes),
+ proc_info_get_maybe_declared_argmodes(ProcInfo,
+ MaybeHeadModes),
MaybeHeadModes = yes(HeadModes),
HeadModes = [],
proc_info_get_declared_determinism(ProcInfo, MaybeDetism),
MaybeDetism = yes(Detism),
- ( Detism = detism_det; Detism = detism_cc_multi ),
+ ( Detism = detism_det ; Detism = detism_cc_multi ),
pred_info_get_purity(PredInfo, Purity),
Purity = purity_impure
->
module_info_new_user_init_pred(SymName, Arity, CName,
!ModuleInfo),
- PragmaExportedItem =
- item_pragma(compiler(initialise_decl),
- pragma_foreign_export(ExportLang, SymName,
- pf_predicate, [], CName)),
- add_item_clause(PragmaExportedItem, !Status, Context,
+ ExportPragma = pragma_foreign_export(ExportLang, SymName,
+ pf_predicate, [], CName),
+ ExportItemPragma = item_pragma_info(compiler(initialise_decl),
+ ExportPragma, Context),
+ ExportItem = item_pragma(ExportItemPragma),
+ add_item_pass_3(ExportItem, Status, _,
!ModuleInfo, !QualInfo, !Specs)
;
Pieces = [words("Error:"), sym_name_and_arity(SymName/Arity),
@@ -1233,8 +1403,11 @@
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs]
).
-add_item_clause(item_initialise(compiler(Details), SymName, Arity),
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+add_pass_3_initialise(ItemInitialise, Status, !ModuleInfo, !QualInfo,
+ !Specs) :-
+ ItemInitialise = item_initialise_info(Origin, SymName, Arity, Context),
+ Origin = compiler(Details),
+
% 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
@@ -1244,11 +1417,12 @@
Details = mutable_decl,
module_info_new_user_init_pred(SymName, Arity, CName, !ModuleInfo),
ExportLang = lang_c, % XXX Implement for other backends.
- PragmaExportItem =
- item_pragma(compiler(mutable_decl),
- pragma_foreign_export(ExportLang, SymName, pf_predicate, [],
- CName)),
- add_item_clause(PragmaExportItem, !Status, Context,
+ ExportPragma = pragma_foreign_export(ExportLang, SymName, pf_predicate,
+ [], CName),
+ ExportItemPragma = item_pragma_info(compiler(mutable_decl),
+ ExportPragma, Context),
+ ExportItem = item_pragma(ExportItemPragma),
+ add_item_pass_3(ExportItem, Status, _,
!ModuleInfo, !QualInfo, !Specs)
;
( Details = initialise_decl
@@ -1259,8 +1433,15 @@
),
unexpected(this_file, "Bad introduced initialise declaration.")
).
-add_item_clause(item_finalise(Origin, SymName, Arity),
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+
+:- pred add_pass_3_finalise(item_finalise_info::in,
+ import_status::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_finalise(ItemFinalise, Status, !ModuleInfo, !QualInfo, !Specs) :-
+ ItemFinalise = item_finalise_info(Origin, SymName, Arity, Context),
+
% To handle a `:- finalise finalpred.' declaration for C backends we need
% to:
% (1) construct a new C function name, CName, to use to export finalpred,
@@ -1296,7 +1477,8 @@
type_is_io_state(Arg1Type),
type_is_io_state(Arg2Type),
list.member(ProcInfo, ProcInfos),
- proc_info_get_maybe_declared_argmodes(ProcInfo, MaybeHeadModes),
+ proc_info_get_maybe_declared_argmodes(ProcInfo,
+ MaybeHeadModes),
MaybeHeadModes = yes(HeadModes),
HeadModes = [ di_mode, uo_mode ],
proc_info_get_declared_determinism(ProcInfo, MaybeDetism),
@@ -1307,16 +1489,18 @@
->
module_info_new_user_final_pred(SymName, Arity, CName,
!ModuleInfo),
- PragmaExportItem =
- item_pragma(compiler(finalise_decl),
- pragma_foreign_export(ExportLang, SymName,
- pf_predicate, [di_mode, uo_mode], CName)),
- add_item_clause(PragmaExportItem, !Status, Context,
+ ExportPragma = pragma_foreign_export(ExportLang, SymName,
+ pf_predicate, [di_mode, uo_mode], CName),
+ ExportItemPragma = item_pragma_info(compiler(finalise_decl),
+ ExportPragma, Context),
+ ExportItem = item_pragma(ExportItemPragma),
+ add_item_pass_3(ExportItem, Status, _,
!ModuleInfo, !QualInfo, !Specs)
;
ArgTypes = [],
list.member(ProcInfo, ProcInfos),
- proc_info_get_maybe_declared_argmodes(ProcInfo, MaybeHeadModes),
+ proc_info_get_maybe_declared_argmodes(ProcInfo,
+ MaybeHeadModes),
MaybeHeadModes = yes(HeadModes),
HeadModes = [],
proc_info_get_declared_determinism(ProcInfo, MaybeDetism),
@@ -1327,14 +1511,14 @@
->
module_info_new_user_final_pred(SymName, Arity, CName,
!ModuleInfo),
- PragmaExportItem =
- item_pragma(compiler(finalise_decl),
- pragma_foreign_export(ExportLang, SymName,
- pf_predicate, [], CName)),
- add_item_clause(PragmaExportItem, !Status, Context,
+ ExportPragma = pragma_foreign_export(ExportLang, SymName,
+ pf_predicate, [], CName),
+ ExportItemPragma = item_pragma_info(compiler(finalise_decl),
+ ExportPragma, Context),
+ ExportItem = item_pragma(ExportItemPragma),
+ add_item_pass_3(ExportItem, Status, _,
!ModuleInfo, !QualInfo, !Specs)
;
-
Pieces = [words("Error:"), sym_name_and_arity(SymName/Arity),
words("used in finalise declaration"),
words("has invalid signature."), nl],
@@ -1368,14 +1552,20 @@
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs]
).
-add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- Item = item_mutable(MercuryMutableName, Type, _InitTerm, _Inst,
- MutAttrs, _MutVarset),
+
+:- pred add_pass_3_mutable(item_mutable_info::in,
+ import_status::in, module_info::in, module_info::out,
+ qual_info::in, qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_pass_3_mutable(ItemMutable, Status, !ModuleInfo, !QualInfo, !Specs) :-
+ ItemMutable = item_mutable_info(MercuryMutableName, Type, _InitTerm, _Inst,
+ MutAttrs, _MutVarset, Context),
% The transformation here is documented in the comments at the
% beginning of prog_mutable.m.
- DefinedThisModule = status_defined_in_this_module(!.Status),
+ DefinedThisModule = status_defined_in_this_module(Status),
(
DefinedThisModule = yes,
module_info_get_name(!.ModuleInfo, ModuleName),
@@ -1400,8 +1590,8 @@
IsThreadLocal, Context, !ModuleInfo, !QualInfo, !Specs),
% Add all the predicates related to mutables.
- add_c_mutable_preds(Item, TargetMutableName,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ add_c_mutable_preds(ItemMutable, TargetMutableName,
+ Status, _, !ModuleInfo, !QualInfo, !Specs)
;
CompilationTarget = target_erlang,
@@ -1411,8 +1601,8 @@
TargetMutableName, !Specs),
% Add all the predicates related to mutables.
- add_erlang_mutable_preds(Item, TargetMutableName,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ add_erlang_mutable_preds(ItemMutable, TargetMutableName,
+ Status, _, !ModuleInfo, !QualInfo, !Specs)
;
( CompilationTarget = target_il
; CompilationTarget = target_java
@@ -1468,24 +1658,22 @@
% in pass 2 because the target-language-specific type name depends on
% whether there are any foreign_type declarations for Type.
get_c_mutable_global_foreign_decl_defn(!.ModuleInfo, Type,
- TargetMutableName, IsConstant, IsThreadLocal,
+ TargetMutableName, IsConstant, IsThreadLocal, Context,
ForeignDecl, ForeignDefn),
ItemStatus0 = item_status(status_local, may_be_unqualified),
- add_item_decl_pass_2(ForeignDecl, Context, ItemStatus0, _,
- !ModuleInfo, !Specs),
- add_item_decl_pass_2(ForeignDefn, Context, ItemStatus0, _,
- !ModuleInfo, !Specs).
+ add_item_decl_pass_2(ForeignDecl, ItemStatus0, _, !ModuleInfo, !Specs),
+ add_item_decl_pass_2(ForeignDefn, ItemStatus0, _, !ModuleInfo, !Specs).
% Create the C foreign_decl for the mutable.
% The bool argument says whether the mutable is a constant mutable
% or not.
%
:- pred get_c_mutable_global_foreign_decl_defn(module_info::in, mer_type::in,
- string::in, bool::in, mutable_thread_local::in, item::out, item::out)
- is det.
+ string::in, bool::in, mutable_thread_local::in, prog_context::in,
+ item::out, item::out) is det.
get_c_mutable_global_foreign_decl_defn(ModuleInfo, Type, TargetMutableName,
- IsConstant, IsThreadLocal, Decl, Defn) :-
+ IsConstant, IsThreadLocal, Context, DeclItem, DefnItem) :-
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
(
@@ -1494,16 +1682,13 @@
ModuleInfo, Type)
;
IsThreadLocal = mutable_thread_local,
- %
% For thread-local mutables, the variable holds an index into an
% array.
- %
TypeName = "MR_Unsigned"
),
- %
+
% Constant mutables do not require mutexes as their values are never
% updated. Thread-local mutables do not require mutexes either.
- %
(
( IsConstant = yes
; IsThreadLocal = mutable_thread_local
@@ -1528,13 +1713,18 @@
DeclBody = string.append_list([
"extern ", TypeName, " ", TargetMutableName, ";\n" | LockDecl]),
- Decl = item_pragma(compiler(mutable_decl),
- pragma_foreign_decl(lang_c, foreign_decl_is_exported, DeclBody)),
+ DeclPragma =
+ pragma_foreign_decl(lang_c, foreign_decl_is_exported, DeclBody),
+ DeclItemPragma = item_pragma_info(compiler(mutable_decl), DeclPragma,
+ Context),
+ DeclItem = item_pragma(DeclItemPragma),
DefnBody = string.append_list([
TypeName, " ", TargetMutableName, ";\n" | LockDefn]),
- Defn = item_pragma(compiler(mutable_decl),
- pragma_foreign_code(lang_c, DefnBody)).
+ DefnPragma = pragma_foreign_code(lang_c, DefnBody),
+ DefnItemPragma = item_pragma_info(compiler(mutable_decl), DefnPragma,
+ Context),
+ DefnItem = item_pragma(DefnItemPragma).
:- func global_foreign_type_name(bool, foreign_language, module_info,
mer_type) = string.
@@ -1545,16 +1735,16 @@
%-----------------------------------------------------------------------------%
-:- pred add_c_mutable_preds(item::in(item_mutable), string::in,
- import_status::in, import_status::out, prog_context::in,
+:- pred add_c_mutable_preds(item_mutable_info::in, string::in,
+ import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_c_mutable_preds(Item, TargetMutableName,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+add_c_mutable_preds(ItemMutableInfo, TargetMutableName, !Status, !ModuleInfo,
+ !QualInfo, !Specs) :-
module_info_get_name(!.ModuleInfo, ModuleName),
- Item = item_mutable(MercuryMutableName, Type, InitTerm, Inst,
- MutAttrs, MutVarset),
+ ItemMutableInfo = item_mutable_info(MercuryMutableName, Type, InitTerm,
+ Inst, MutAttrs, MutVarset, Context),
IsConstant = mutable_var_constant(MutAttrs),
IsThreadLocal = mutable_var_thread_local(MutAttrs),
@@ -1579,7 +1769,7 @@
MercuryMutableName),
add_c_constant_mutable_access_preds(TargetMutableName,
ModuleName, MercuryMutableName, Attrs, Inst, BoxPolicy,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs)
;
IsConstant = no,
InitSetPredName = mutable_set_pred_sym_name(ModuleName,
@@ -1588,26 +1778,26 @@
!.ModuleInfo, Type),
add_c_mutable_primitive_preds(TargetMutableName, ModuleName,
MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs),
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs),
add_c_mutable_user_access_preds(ModuleName, MercuryMutableName,
- MutAttrs, !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ MutAttrs, Context, !Status, !ModuleInfo, !QualInfo, !Specs)
),
add_c_mutable_initialisation(IsConstant, IsThreadLocal,
TargetMutableName, ModuleName, MercuryMutableName, MutVarset,
InitSetPredName, InitTerm, Attrs,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs).
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs).
% Add the access predicates for constant mutables.
%
:- pred add_c_constant_mutable_access_preds(string::in, module_name::in,
string::in, pragma_foreign_proc_attributes::in, mer_inst::in,
- box_policy::in, import_status::in, import_status::out, prog_context::in,
+ box_policy::in, prog_context::in, import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_c_constant_mutable_access_preds(TargetMutableName,
- ModuleName, MutableName, Attrs, Inst, BoxPolicy,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ ModuleName, MutableName, Attrs, Inst, BoxPolicy, Context,
+ !Status, !ModuleInfo, !QualInfo, !Specs) :-
varset.new_named_var(varset.init, "X", X, ProgVarSet),
InstVarSet = varset.init,
set_purity(purity_pure, Attrs, ConstantGetAttrs0),
@@ -1621,10 +1811,10 @@
InstVarSet,
fc_impl_ordinary("X = " ++ TargetMutableName ++ ";", yes(Context))
),
- ConstantGetClause = item_pragma(compiler(mutable_decl),
- ConstantGetForeignProc),
- add_item_clause(ConstantGetClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs),
+ ConstantGetItemPragma = item_pragma_info(compiler(mutable_decl),
+ ConstantGetForeignProc, Context),
+ ConstantGetItem = item_pragma(ConstantGetItemPragma),
+ add_item_pass_3(ConstantGetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
% NOTE: we don't need to trail the set action, since it is executed
% only once at initialization time.
@@ -1637,24 +1827,24 @@
InstVarSet,
fc_impl_ordinary(TargetMutableName ++ " = X;", yes(Context))
),
- ConstantSetClause = item_pragma(compiler(mutable_decl),
- ConstantSetForeignProc),
- add_item_clause(ConstantSetClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs).
+ ConstantSetItemPragma = item_pragma_info(compiler(mutable_decl),
+ ConstantSetForeignProc, Context),
+ ConstantSetItem = item_pragma(ConstantSetItemPragma),
+ add_item_pass_3(ConstantSetItem, !Status, !ModuleInfo, !QualInfo, !Specs).
% Add the foreign clauses for the mutable's primitive access and
% locking predicates.
%
:- pred add_c_mutable_primitive_preds(string::in, module_name::in, string::in,
mutable_var_attributes::in, pragma_foreign_proc_attributes::in,
- mer_inst::in, box_policy::in, string::in,
- import_status::in, import_status::out, prog_context::in,
+ mer_inst::in, box_policy::in, string::in, prog_context::in,
+ import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_c_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
IsThreadLocal = mutable_var_thread_local(MutAttrs),
set_thread_safe(proc_thread_safe, Attrs, LockAndUnlockAttrs),
@@ -1683,9 +1873,10 @@
varset.init, % Inst varset.
fc_impl_ordinary(LockForeignProcBody, yes(Context))
),
- LockClause = item_pragma(compiler(mutable_decl), LockForeignProc),
- add_item_clause(LockClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ LockItemPragma = item_pragma_info(compiler(mutable_decl),
+ LockForeignProc, Context),
+ LockItem = item_pragma(LockItemPragma),
+ add_item_pass_3(LockItem, !Status, !ModuleInfo, !QualInfo, !Specs),
% Construct the unlock predicate.
% XXX as above regarding the second argument to MR_UNLOCK.
@@ -1710,9 +1901,10 @@
varset.init, % Inst varset.
fc_impl_ordinary(UnlockForeignProcBody, yes(Context))
),
- UnlockClause = item_pragma(compiler(mutable_decl), UnlockForeignProc),
- add_item_clause(UnlockClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ UnlockItemPragma = item_pragma_info(compiler(mutable_decl),
+ UnlockForeignProc, Context),
+ UnlockItem = item_pragma(UnlockItemPragma),
+ add_item_pass_3(UnlockItem, !Status, !ModuleInfo, !QualInfo, !Specs),
% Construct the semipure unsafe_get_predicate.
@@ -1735,10 +1927,10 @@
varset.init, % Inst varset.
fc_impl_ordinary(UnsafeGetCode, yes(Context))
),
- UnsafeGetClause = item_pragma(compiler(mutable_decl),
- UnsafeGetForeignProc),
- add_item_clause(UnsafeGetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ UnsafeGetItemPragma = item_pragma_info(compiler(mutable_decl),
+ UnsafeGetForeignProc, Context),
+ UnsafeGetItem = item_pragma(UnsafeGetItemPragma),
+ add_item_pass_3(UnsafeGetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
% Construct the impure unsafe_set_predicate.
@@ -1786,23 +1978,23 @@
varset.init, % Inst varset.
fc_impl_ordinary(TrailCode ++ SetCode, yes(Context))
),
- UnsafeSetClause = item_pragma(compiler(mutable_decl),
- UnsafeSetForeignProc),
- add_item_clause(UnsafeSetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs).
+ UnsafeSetItemPragma = item_pragma_info(compiler(mutable_decl),
+ UnsafeSetForeignProc, Context),
+ UnsafeSetItem = item_pragma(UnsafeSetItemPragma),
+ add_item_pass_3(UnsafeSetItem, !Status, !ModuleInfo, !QualInfo, !Specs).
% Add the access predicates for a non-constant mutable.
% If the mutable has the `attach_to_io_state' attribute then add the
% versions of the access preds that take the I/O state as well.
%
:- pred add_c_mutable_user_access_preds(module_name::in, string::in,
- mutable_var_attributes::in,
- import_status::in, import_status::out, prog_context::in,
+ mutable_var_attributes::in, prog_context::in,
+ import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_c_mutable_user_access_preds(ModuleName, MutableName, MutAttrs,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+add_c_mutable_user_access_preds(ModuleName, MutableName, MutAttrs, Context,
+ !Status, !ModuleInfo, !QualInfo, !Specs) :-
varset.new_named_var(varset.init, "X", X, ProgVarSet0),
LockPredName = mutable_lock_pred_sym_name(ModuleName, MutableName),
UnlockPredName = mutable_unlock_pred_sym_name(ModuleName, MutableName),
@@ -1810,9 +2002,8 @@
GetPredName = mutable_get_pred_sym_name(ModuleName, MutableName),
CallLock = call_expr(LockPredName, [], purity_impure) - Context,
CallUnlock = call_expr(UnlockPredName, [], purity_impure) - Context,
- %
+
% Construct the semipure get predicate.
- %
UnsafeGetPredName = mutable_unsafe_get_pred_sym_name(ModuleName,
MutableName),
UnsafeGetCallArgs = [variable(X, Context)],
@@ -1824,20 +2015,19 @@
StdGetBody = promise_purity_expr(dont_make_implicit_promises,
purity_semipure, GetBody) - Context,
- StdGetClause = item_clause(
+ StdGetItemClause = item_clause_info(
compiler(mutable_decl),
ProgVarSet0,
pf_predicate,
GetPredName,
[variable(X, context_init)],
- StdGetBody
+ StdGetBody,
+ Context
),
+ StdSetItem = item_clause(StdSetItemClause),
+ add_item_pass_3(StdGetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
- add_item_clause(StdGetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
- %
% Construct the impure set predicate.
- %
UnsafeSetPredName = mutable_unsafe_set_pred_sym_name(ModuleName,
MutableName),
UnsafeSetCallArgs = [variable(X, context_init)],
@@ -1847,17 +2037,17 @@
StdSetBody = goal_list_to_conj(Context,
[CallLock, StdSetCallUnsafeSet, CallUnlock]),
- StdSetClause = item_clause(
+ StdSetItemClause = item_clause_info(
compiler(mutable_decl),
ProgVarSet0,
pf_predicate,
SetPredName,
[variable(X, context_init)],
- StdSetBody
+ StdSetBody,
+ Context
),
-
- add_item_clause(StdSetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ StdGetItem = item_clause(StdGetItemClause),
+ add_item_pass_3(StdSetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
IOStateInterface = mutable_var_attach_to_io_state(MutAttrs),
(
@@ -1865,42 +2055,41 @@
varset.new_named_var(ProgVarSet0, "IO", IO, ProgVarSet),
% Construct the pure get predicate.
- %
IOGetBody = promise_purity_expr(dont_make_implicit_promises,
purity_pure, GetBody) - Context,
Ctxt = context_init,
- IOGetClause = item_clause(
+ IOGetItemClause = item_clause_info(
compiler(mutable_decl),
ProgVarSet,
pf_predicate,
GetPredName,
[variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
- IOGetBody
+ IOGetBody,
+ Context
),
-
- add_item_clause(IOGetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ IOGetItem = item_clause(IOGetItemClause),
+ add_item_pass_3(IOGetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
% Construct the pure set predicate.
%
% We just use the body of impure version and attach a promise_pure
% pragma to the predicate. (The purity pragma was added during
% stage 2.)
- %
+
IOSetBody = StdSetBody,
- IOSetClause = item_clause(
+ IOSetItemClause = item_clause_info(
compiler(mutable_decl),
ProgVarSet,
pf_predicate,
SetPredName,
[variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
- IOSetBody
+ IOSetBody,
+ Context
),
-
- add_item_clause(IOSetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs)
+ IOSetItem = item_clause(IOSetItemClause),
+ add_item_pass_3(IOSetItem, !Status, !ModuleInfo, !QualInfo, !Specs)
;
IOStateInterface = no
).
@@ -1910,24 +2099,24 @@
:- pred add_c_mutable_initialisation(bool::in, mutable_thread_local::in,
string::in, module_name::in, string::in, prog_varset::in,
sym_name::in, prog_term::in, pragma_foreign_proc_attributes::in,
- import_status::in, import_status::out, prog_context::in,
+ prog_context::in, import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_c_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
ModuleName, MutableName, MutVarset, InitSetPredName, InitTerm, Attrs,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- InitPredName = mutable_init_pred_sym_name(ModuleName, MutableName),
- %
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
% Add the `:- initialise' declaration for the mutable initialisation
% predicate.
- %
- add_item_clause(item_initialise(compiler(mutable_decl),
- InitPredName, 0 /* Arity */),
- !Status, Context, !ModuleInfo, !QualInfo, !Specs),
- %
+ InitPredName = mutable_init_pred_sym_name(ModuleName, MutableName),
+ InitPredArity = 0,
+
+ InitItemInitialise = item_initialise_info(compiler(mutable_decl),
+ InitPredName, InitPredArity, Context),
+ InitItem = item_initialise(InitItemInitialise),
+ add_item_pass_3(InitItem, !Status, !ModuleInfo, !QualInfo, !Specs),
+
% Add the clause for the mutable initialisation predicate.
- %
(
IsConstant = yes,
InitClauseExpr =
@@ -1962,10 +2151,11 @@
varset.init, % InstVarSet
fc_impl_ordinary(PreInitCode, yes(Context))
),
- PreInitClause = item_pragma(compiler(mutable_decl),
- PreInitForeignProc),
- add_item_clause(PreInitClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs),
+ PreInitItemPragma = item_pragma_info(compiler(mutable_decl),
+ PreInitForeignProc, Context),
+ PreInitItem = item_pragma(PreInitItemPragma),
+ add_item_pass_3(PreInitItem, !Status, !ModuleInfo, !QualInfo,
+ !Specs),
CallPreInitExpr =
call_expr(PreInitPredName, [], purity_impure) - Context,
@@ -1975,35 +2165,35 @@
InitClauseExpr = conj_expr(CallPreInitExpr, CallSetPredExpr)
- Context
),
- %
+
% See the comments for prog_io.parse_mutable_decl for the reason
% why we _must_ use MutVarset here.
- %
- InitClause = item_clause(compiler(mutable_decl),
+ PredItemClause = item_clause_info(compiler(mutable_decl),
MutVarset,
pf_predicate,
InitPredName,
[],
- InitClauseExpr
+ InitClauseExpr,
+ Context
),
- add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs).
+ PredItem = item_clause(PredItemClause),
+ add_item_pass_3(PredItem, !Status, !ModuleInfo, !QualInfo, !Specs).
%-----------------------------------------------------------------------------%
%
% Erlang mutables
%
-:- pred add_erlang_mutable_preds(item::in(item_mutable), string::in,
- import_status::in, import_status::out, prog_context::in,
+:- pred add_erlang_mutable_preds(item_mutable_info::in, string::in,
+ import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_erlang_mutable_preds(Item, TargetMutableName,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+add_erlang_mutable_preds(ItemMutable, TargetMutableName,
+ !Status, !ModuleInfo, !QualInfo, !Specs) :-
module_info_get_name(!.ModuleInfo, ModuleName),
- Item = item_mutable(MutableName, _Type, InitTerm, Inst,
- MutAttrs, MutVarset),
+ ItemMutable = item_mutable_info(MutableName, _Type, InitTerm, Inst,
+ MutAttrs, MutVarset, Context),
IsConstant = mutable_var_constant(MutAttrs),
(
IsConstant = yes,
@@ -2011,30 +2201,30 @@
MutableName),
add_erlang_constant_mutable_access_preds(TargetMutableName,
ModuleName, MutableName, Inst,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs)
;
IsConstant = no,
InitSetPredName = mutable_set_pred_sym_name(ModuleName,
MutableName),
add_erlang_mutable_user_access_preds(TargetMutableName,
ModuleName, MutableName, MutAttrs, Inst,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs)
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs)
),
add_erlang_mutable_initialisation(ModuleName, MutableName,
MutVarset, InitSetPredName, InitTerm,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs).
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs).
% Add the access predicates for constant mutables.
%
:- pred add_erlang_constant_mutable_access_preds(string::in,
- module_name::in, string::in, mer_inst::in,
- import_status::in, import_status::out, prog_context::in,
+ module_name::in, string::in, mer_inst::in, prog_context::in,
+ import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_erlang_constant_mutable_access_preds(TargetMutableName,
ModuleName, MutableName, Inst,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
varset.new_named_var(varset.init, "X", X, ProgVarSet),
InstVarSet = varset.init,
Attrs = default_attributes(lang_erlang),
@@ -2052,10 +2242,10 @@
InstVarSet,
fc_impl_ordinary(GetCode, yes(Context))
),
- ConstantGetClause = item_pragma(compiler(mutable_decl),
- ConstantGetForeignProc),
- add_item_clause(ConstantGetClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs),
+ ConstantGetItemPragma = item_pragma_info(compiler(mutable_decl),
+ ConstantGetForeignProc, Context),
+ ConstantGetItem = item_pragma(ConstantGetItemPragma),
+ add_item_pass_3(ConstantGetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
% Secret setter.
SetCode = erlang_mutable_set_code(TargetMutableName),
@@ -2067,10 +2257,10 @@
InstVarSet,
fc_impl_ordinary(SetCode, yes(Context))
),
- ConstantSetClause = item_pragma(compiler(mutable_decl),
- ConstantSetForeignProc),
- add_item_clause(ConstantSetClause, !Status, Context, !ModuleInfo,
- !QualInfo, !Specs).
+ ConstantSetItemPragma = item_pragma_info(compiler(mutable_decl),
+ ConstantSetForeignProc, Context),
+ ConstantSetItem = item_pragma(ConstantSetItemPragma),
+ add_item_pass_3(ConstantSetItem, !Status, !ModuleInfo, !QualInfo, !Specs).
% Add the access predicates for a non-constant mutable.
% If the mutable has the `attach_to_io_state' attribute then add the
@@ -2078,20 +2268,18 @@
%
:- pred add_erlang_mutable_user_access_preds(string::in,
module_name::in, string::in, mutable_var_attributes::in, mer_inst::in,
- import_status::in, import_status::out, prog_context::in,
+ prog_context::in, import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_erlang_mutable_user_access_preds(TargetMutableName,
- ModuleName, MutableName, MutAttrs, Inst,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
+ ModuleName, MutableName, MutAttrs, Inst, Context,
+ !Status, !ModuleInfo, !QualInfo, !Specs) :-
IsThreadLocal = mutable_var_thread_local(MutAttrs),
Attrs = default_attributes(lang_erlang),
varset.new_named_var(varset.init, "X", X, ProgVarSet0),
- %
% Construct the semipure get predicate.
- %
set_purity(purity_semipure, Attrs, GetAttrs0),
set_thread_safe(proc_thread_safe, GetAttrs0, GetAttrs),
(
@@ -2115,13 +2303,12 @@
varset.init, % Inst varset.
fc_impl_ordinary(GetCode, yes(Context))
),
- GetClause = item_pragma(compiler(mutable_decl), GetForeignProc),
- add_item_clause(GetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ GetItemPragma = item_pragma_info(compiler(mutable_decl), GetForeignProc,
+ Context),
+ GetItem = item_pragma(GetItemPragma),
+ add_item_pass_3(GetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
- %
% Construct the impure set predicate.
- %
set_purity(purity_impure, Attrs, SetAttrs0),
set_thread_safe(proc_thread_safe, SetAttrs0, SetAttrs),
(
@@ -2142,9 +2329,10 @@
varset.init, % Inst varset.
fc_impl_ordinary(SetCode, yes(Context))
),
- SetClause = item_pragma(compiler(mutable_decl), SetForeignProc),
- add_item_clause(SetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ SetItemPragma = item_pragma_info(compiler(mutable_decl), SetForeignProc,
+ Context),
+ SetItem = item_pragma(SetItemPragma),
+ add_item_pass_3(SetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
IOStateInterface = mutable_var_attach_to_io_state(MutAttrs),
(
@@ -2160,37 +2348,36 @@
IOGetBody = promise_purity_expr(dont_make_implicit_promises,
purity_pure, CallSemipureGet) - Context,
- IOGetClause = item_clause(
+ IOGetItemClause = item_clause_info(
compiler(mutable_decl),
ProgVarSet,
pf_predicate,
GetPredName,
[variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
- IOGetBody
+ IOGetBody,
+ Context
),
-
- add_item_clause(IOGetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs),
+ IOGetItem = item_clause(IOGetItemClause),
+ add_item_pass_3(IOGetItem, !Status, !ModuleInfo, !QualInfo, !Specs),
% Construct the pure set predicate.
%
% We just call the impure version and attach a promise_pure
% pragma to the predicate. (The purity pragma was added during
% stage 2.)
- %
CallImpureSet = call_expr(SetPredName, [variable(X, Context)],
purity_impure) - Context,
- IOSetClause = item_clause(
+ IOSetItemClause = item_clause_info(
compiler(mutable_decl),
ProgVarSet,
pf_predicate,
SetPredName,
[variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
- CallImpureSet
+ CallImpureSet,
+ Context
),
-
- add_item_clause(IOSetClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs)
+ IOSetItem = item_clause(IOSetItemClause),
+ add_item_pass_3(IOSetItem, !Status, !ModuleInfo, !QualInfo, !Specs)
;
IOStateInterface = no
).
@@ -2216,51 +2403,51 @@
% Add the code required to initialise a mutable.
%
:- pred add_erlang_mutable_initialisation(module_name::in, string::in,
- prog_varset::in, sym_name::in, prog_term::in,
- import_status::in, import_status::out, prog_context::in,
+ prog_varset::in, sym_name::in, prog_term::in, prog_context::in,
+ import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
add_erlang_mutable_initialisation(ModuleName, MutableName,
MutVarset, InitSetPredName, InitTerm,
- !Status, Context, !ModuleInfo, !QualInfo, !Specs) :-
- %
+ Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
% Add the `:- initialise' declaration for the mutable initialisation
% predicate.
- %
InitPredName = mutable_init_pred_sym_name(ModuleName, MutableName),
- add_item_clause(item_initialise(compiler(mutable_decl),
- InitPredName, 0 /* Arity */),
- !Status, Context, !ModuleInfo, !QualInfo, !Specs),
- %
+ InitPredArity = 0,
+ InitItemInitialise = item_initialise_info(compiler(mutable_decl),
+ InitPredName, InitPredArity, Context),
+ InitItem = item_initialise(InitItemInitialise),
+ add_item_pass_3(InitItem, !Status, !ModuleInfo, !QualInfo, !Specs),
+
% Add the clause for the mutable initialisation predicate.
%
% See the comments for prog_io.parse_mutable_decl for the reason
% why we _must_ use MutVarset here.
- %
- InitClause = item_clause(compiler(mutable_decl),
+ PredItemClause = item_clause_info(compiler(mutable_decl),
MutVarset,
pf_predicate,
InitPredName,
[],
- call_expr(InitSetPredName, [InitTerm], purity_impure) - Context
+ call_expr(InitSetPredName, [InitTerm], purity_impure) - Context,
+ Context
),
- add_item_clause(InitClause, !Status, Context, !ModuleInfo, !QualInfo,
- !Specs).
+ PredItem = item_clause(PredItemClause),
+ add_item_pass_3(PredItem, !Status, !ModuleInfo, !QualInfo, !Specs).
%-----------------------------------------------------------------------------%
:- pred add_solver_type_mutable_items_clauses(list(item)::in,
- import_status::in, import_status::out, prog_context::in,
+ import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_solver_type_mutable_items_clauses([], !Status, _Context,
+add_solver_type_mutable_items_clauses([], !Status,
!ModuleInfo, !QualInfo, !Specs).
-add_solver_type_mutable_items_clauses([Item | Items], !Status, Context,
+add_solver_type_mutable_items_clauses([Item | Items], !Status,
!ModuleInfo, !QualInfo, !Specs) :-
- add_item_clause(Item, !Status, Context, !ModuleInfo, !QualInfo, !Specs),
- add_solver_type_mutable_items_clauses(Items, !Status, Context,
+ add_item_pass_3(Item, !Status, !ModuleInfo, !QualInfo, !Specs),
+ add_solver_type_mutable_items_clauses(Items, !Status,
!ModuleInfo, !QualInfo, !Specs).
%-----------------------------------------------------------------------------%
@@ -2312,7 +2499,7 @@
%
% promise.lineno_filename(A, B, R) :-
% ( R = A + B <=> R = B + A ).
- %
+
module_info_get_name(!.ModuleInfo, ModuleName),
module_add_clause(VarSet, pf_predicate, qualified(ModuleName, Name),
HeadVars, Goal, Status, Context, goal_type_promise(PromiseType),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.460
diff -u -b -r1.460 mercury_compile.m
--- compiler/mercury_compile.m 29 Jan 2008 03:17:38 -0000 1.460
+++ compiler/mercury_compile.m 8 Feb 2008 17:41:46 -0000
@@ -957,7 +957,7 @@
file_or_module_to_module_name(module(ModuleName)) = ModuleName.
:- pred read_module_or_file(file_or_module::in, bool::in, module_name::out,
- file_name::out, maybe(timestamp)::out, item_list::out,
+ file_name::out, maybe(timestamp)::out, list(item)::out,
module_error::out, read_modules::in, read_modules::out,
io::di, io::uo) is det.
@@ -1185,10 +1185,10 @@
:- pred apply_process_module(
pred(file_name, module_name, maybe(timestamp),
- pair(module_name, item_list), io, io)::
+ pair(module_name, list(item)), io, io)::
in(pred(in, in, in, in, di, uo) is det),
file_name::in, module_name::in, maybe(timestamp)::in,
- pair(module_name, item_list)::in, io::di, io::uo) is det.
+ pair(module_name, list(item))::in, io::di, io::uo) is det.
apply_process_module(ProcessModule, FileName, ModuleName, MaybeTimestamp,
SubModule, !IO) :-
@@ -1283,7 +1283,7 @@
:- pred compile_all_submodules(string::in, module_name::in,
list(module_name)::in, maybe(timestamp)::in, read_modules::in,
find_timestamp_file_names::in(find_timestamp_file_names),
- list(pair(module_name, item_list))::in, list(string)::out,
+ list(pair(module_name, list(item)))::in, list(string)::out,
list(string)::out, io::di, io::uo) is det.
compile_all_submodules(FileName, SourceFileModuleName, NestedSubModules,
@@ -1296,7 +1296,7 @@
list.condense(FactTableObjFileLists, FactTableObjFiles).
:- pred make_interface(file_name::in, module_name::in, maybe(timestamp)::in,
- pair(module_name, item_list)::in, io::di, io::uo) is det.
+ pair(module_name, list(item))::in, io::di, io::uo) is det.
make_interface(SourceFileName, SourceFileModuleName, MaybeTimestamp,
ModuleName - Items, !IO) :-
@@ -1304,14 +1304,14 @@
ModuleName, MaybeTimestamp, Items, !IO).
:- pred make_short_interface(file_name::in, module_name::in,
- maybe(timestamp)::in, pair(module_name, item_list)::in,
+ maybe(timestamp)::in, pair(module_name, list(item))::in,
io::di, io::uo) is det.
make_short_interface(SourceFileName, _, _, ModuleName - Items, !IO) :-
make_short_interface(SourceFileName, ModuleName, Items, !IO).
:- pred make_private_interface(file_name::in, module_name::in,
- maybe(timestamp)::in, pair(module_name, item_list)::in,
+ maybe(timestamp)::in, pair(module_name, list(item))::in,
io::di, io::uo) is det.
make_private_interface(SourceFileName, SourceFileModuleName,
@@ -1324,7 +1324,7 @@
halt_at_module_error(_, fatal_module_errors).
halt_at_module_error(HaltSyntax, some_module_errors) :- HaltSyntax = yes.
-:- pred module_to_link(pair(module_name, item_list)::in, string::out) is det.
+:- pred module_to_link(pair(module_name, list(item))::in, string::out) is det.
module_to_link(ModuleName - _Items, ModuleToLink) :-
module_name_to_file_name(ModuleName, ModuleToLink).
@@ -1474,7 +1474,7 @@
:- pred compile(file_name::in, module_name::in, list(module_name)::in,
maybe(timestamp)::in, read_modules::in,
find_timestamp_file_names::in(find_timestamp_file_names),
- pair(module_name, item_list)::in, list(string)::out,
+ pair(module_name, list(item))::in, list(string)::out,
io::di, io::uo) is det.
compile(SourceFileName, SourceFileModuleName, NestedSubModules0,
@@ -1907,7 +1907,7 @@
HLDS1 = HLDS0
).
-:- pred invoke_module_qualify_items(item_list::in, item_list::out,
+:- pred invoke_module_qualify_items(list(item)::in, list(item)::out,
event_spec_map::in, event_spec_map::out,
module_name::in, string::in, bool::in, bool::in, mq_info::out,
bool::out, bool::out, io::di, io::uo) is det.
@@ -2008,7 +2008,7 @@
bool.or(Error1, Error2, Error).
:- pred expand_equiv_types(module_name::in, bool::in, bool::in,
- item_list::in, item_list::out, event_spec_map::in, event_spec_map::out,
+ list(item)::in, list(item)::out, event_spec_map::in, event_spec_map::out,
eqv_map::out, used_modules::out,
maybe(recompilation_info)::in, maybe(recompilation_info)::out,
list(error_spec)::out, io::di, io::uo) is det.
@@ -2024,7 +2024,7 @@
maybe_write_string(Verbose, " done.\n", !IO),
maybe_report_stats(Stats, !IO).
-:- pred make_hlds(module_name::in, item_list::in, event_set::in,
+:- pred make_hlds(module_name::in, list(item)::in, event_set::in,
mq_info::in, eqv_map::in, used_modules::in, bool::in, bool::in,
module_info::out, make_hlds_qual_info::out,
bool::out, bool::out, bool::out, io::di, io::uo) is det.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.325
diff -u -b -r1.325 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 25 Jan 2008 04:03:58 -0000 1.325
+++ compiler/mercury_to_mercury.m 8 Feb 2008 17:26:46 -0000
@@ -71,11 +71,11 @@
% Convert_to_mercury(ModuleName, OutputFileName, Items).
%
:- pred convert_to_mercury(module_name::in, string::in,
- list(item_and_context)::in, io::di, io::uo) is det.
+ list(item)::in, io::di, io::uo) is det.
% Output the specified item, followed by ".\n".
%
-:- pred mercury_output_item(item::in, prog_context::in, io::di, io::uo) is det.
+:- pred mercury_output_item(item::in, io::di, io::uo) is det.
% Output a `:- pred' declaration, making sure that the variable
% number appears in variable names if the boolean argument
@@ -464,33 +464,87 @@
% Output the declarations one by one.
%
-:- pred mercury_output_item_list(bool::in, list(item_and_context)::in,
+:- pred mercury_output_item_list(bool::in, list(item)::in,
io::di, io::uo) is det.
mercury_output_item_list(_, [], !IO).
-mercury_output_item_list(UnqualifiedItemNames,
- [ItemAndContext | ItemAndContexts], !IO) :-
- ItemAndContext = item_and_context(Item, Context),
- mercury_output_item(UnqualifiedItemNames, Item, Context, !IO),
- mercury_output_item_list(UnqualifiedItemNames, ItemAndContexts, !IO).
+mercury_output_item_list(UnqualifiedItemNames, [Item | Items], !IO) :-
+ mercury_output_item_2(UnqualifiedItemNames, Item, !IO),
+ mercury_output_item_list(UnqualifiedItemNames, Items, !IO).
%-----------------------------------------------------------------------------%
-mercury_output_item(Item, Context, !IO) :-
+mercury_output_item(Item, !IO) :-
UnqualifiedItemNames = no,
- mercury_output_item(UnqualifiedItemNames, Item, Context, !IO).
+ mercury_output_item_2(UnqualifiedItemNames, Item, !IO).
-:- pred mercury_output_item(bool::in, item::in, prog_context::in,
+:- pred mercury_output_item_2(bool::in, item::in, io::di, io::uo) is det.
+
+mercury_output_item_2(UnqualifiedItemNames, Item, !IO) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ mercury_output_item_module_defn(UnqualifiedItemNames, ItemModuleDefn,
+ !IO)
+ ;
+ Item = item_clause(ItemClause),
+ mercury_output_item_clause(UnqualifiedItemNames, ItemClause, !IO)
+ ;
+ Item = item_type_defn(ItemTypeDefn),
+ mercury_output_item_type_defn(UnqualifiedItemNames, ItemTypeDefn, !IO)
+ ;
+ Item = item_inst_defn(ItemInstDefn),
+ mercury_output_item_inst_defn(UnqualifiedItemNames, ItemInstDefn, !IO)
+ ;
+ Item = item_mode_defn(ItemModeDefn),
+ mercury_output_item_mode_defn(UnqualifiedItemNames, ItemModeDefn, !IO)
+ ;
+ Item = item_pred_decl(ItemPredDecl),
+ mercury_output_item_pred_decl(UnqualifiedItemNames, ItemPredDecl, !IO)
+ ;
+ Item = item_mode_decl(ItemModeDecl),
+ mercury_output_item_mode_decl(UnqualifiedItemNames, ItemModeDecl, !IO)
+ ;
+ Item = item_pragma(ItemPragma),
+ mercury_output_item_pragma(UnqualifiedItemNames, ItemPragma, !IO)
+ ;
+ Item = item_promise(ItemPromise),
+ mercury_output_item_promise(UnqualifiedItemNames, ItemPromise, !IO)
+ ;
+ Item = item_typeclass(ItemTypeClass),
+ mercury_output_item_typeclass(UnqualifiedItemNames, ItemTypeClass, !IO)
+ ;
+ Item = item_instance(ItemInstance),
+ mercury_output_item_instance(UnqualifiedItemNames, ItemInstance, !IO)
+ ;
+ Item = item_initialise(ItemInitialise),
+ mercury_output_item_initialise(UnqualifiedItemNames, ItemInitialise,
+ !IO)
+ ;
+ Item = item_finalise(ItemFinalise),
+ mercury_output_item_finalise(UnqualifiedItemNames, ItemFinalise, !IO)
+ ;
+ Item = item_mutable(ItemMutable),
+ mercury_output_item_mutable(UnqualifiedItemNames, ItemMutable, !IO)
+ ;
+ Item = item_nothing(_ItemNothing)
+ ).
+
+:- pred mercury_output_item_type_defn(bool::in, item_type_defn_info::in,
io::di, io::uo) is det.
-mercury_output_item(UnqualifiedItemNames,
- item_type_defn(VarSet, Name0, Args, TypeDefn, _Cond),
- Context, !IO) :-
+mercury_output_item_type_defn(UnqualifiedItemNames, ItemTypeDefn, !IO) :-
+ ItemTypeDefn = item_type_defn_info(VarSet, Name0, Args, TypeDefn, _Cond,
+ Context),
maybe_unqualify_sym_name(UnqualifiedItemNames, Name0, Name),
maybe_output_line_number(Context, !IO),
mercury_output_type_defn(VarSet, Name, Args, TypeDefn, Context, !IO).
-mercury_output_item(UnqualifiedItemNames,
- item_inst_defn(VarSet, Name0, Args, InstDefn, _Cond), Context, !IO) :-
+
+:- pred mercury_output_item_inst_defn(bool::in, item_inst_defn_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_inst_defn(UnqualifiedItemNames, ItemInstDefn, !IO) :-
+ ItemInstDefn = item_inst_defn_info(VarSet, Name0, Args, InstDefn, _Cond,
+ Context),
maybe_unqualify_sym_name(UnqualifiedItemNames, Name0, Name1),
% If the unqualified name is a builtin inst, then output the qualified
% name. This prevents the compiler giving an error about redefining
@@ -502,16 +556,24 @@
),
maybe_output_line_number(Context, !IO),
mercury_output_inst_defn(VarSet, Name, Args, InstDefn, Context, !IO).
-mercury_output_item(UnqualifiedItemNames,
- item_mode_defn(VarSet, Name0, Args, ModeDefn, _Cond), Context, !IO) :-
+
+:- pred mercury_output_item_mode_defn(bool::in, item_mode_defn_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_mode_defn(UnqualifiedItemNames, ItemModeDefn, !IO) :-
+ ItemModeDefn = item_mode_defn_info(VarSet, Name0, Args, ModeDefn, _Cond,
+ Context),
maybe_unqualify_sym_name(UnqualifiedItemNames, Name0, Name),
maybe_output_line_number(Context, !IO),
mercury_format_mode_defn(VarSet, Name, Args, ModeDefn, Context, !IO).
-mercury_output_item(UnqualifiedItemNames,
- item_pred_or_func(_Origin, TypeVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName0, TypesAndModes, WithType, WithInst, Det,
- _Cond, Purity, ClassContext),
- Context, !IO) :-
+
+:- pred mercury_output_item_pred_decl(bool::in, item_pred_decl_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_pred_decl(UnqualifiedItemNames, ItemPredDecl, !IO) :-
+ ItemPredDecl = item_pred_decl_info(_Origin, TypeVarSet, InstVarSet,
+ ExistQVars, PredOrFunc, PredName0, TypesAndModes, WithType, WithInst,
+ Det, _Cond, Purity, ClassContext, Context),
maybe_unqualify_sym_name(UnqualifiedItemNames, PredName0, PredName),
maybe_output_line_number(Context, !IO),
(
@@ -531,10 +593,13 @@
ExistQVars, PredName, TypesAndModes, WithType, WithInst, Det,
Purity, ClassContext, Context, ":- ", ".\n", ".\n", !IO)
).
-mercury_output_item(UnqualifiedItemNames,
- item_pred_or_func_mode(VarSet, PredOrFunc, PredName0, Modes, WithInst,
- MaybeDet, _Cond),
- Context, !IO) :-
+
+:- pred mercury_output_item_mode_decl(bool::in, item_mode_decl_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_mode_decl(UnqualifiedItemNames, ItemModeDecl, !IO) :-
+ ItemModeDecl = item_mode_decl_info(VarSet, PredOrFunc, PredName0, Modes,
+ WithInst, MaybeDet, _Cond, Context),
maybe_unqualify_sym_name(UnqualifiedItemNames, PredName0, PredName),
maybe_output_line_number(Context, !IO),
(
@@ -550,12 +615,21 @@
mercury_output_pred_mode_decl(VarSet, PredName, Modes, WithInst,
MaybeDet, Context, !IO)
).
-mercury_output_item(_, item_module_defn(VarSet, ModuleDefn), Context, !IO) :-
+
+:- pred mercury_output_item_module_defn(bool::in, item_module_defn_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_module_defn(_, ItemModuleDefn, !IO) :-
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
maybe_output_line_number(Context, !IO),
mercury_output_module_defn(VarSet, ModuleDefn, Context, !IO).
-mercury_output_item(UnqualifiedItemNames,
- item_clause(_, VarSet, PredOrFunc, PredName0, Args, Body), Context,
- !IO) :-
+
+:- pred mercury_output_item_clause(bool::in, item_clause_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_clause(UnqualifiedItemNames, ItemClause, !IO) :-
+ ItemClause = item_clause_info(_, VarSet, PredOrFunc, PredName0, Args,
+ Body, Context),
maybe_unqualify_sym_name(UnqualifiedItemNames, PredName0, PredName),
maybe_output_line_number(Context, !IO),
(
@@ -568,8 +642,12 @@
Context, !IO)
),
io.write_string(".\n", !IO).
-mercury_output_item(_UnqualifiedItemNames, item_pragma(_, Pragma), Context,
- !IO) :-
+
+:- pred mercury_output_item_pragma(bool::in, item_pragma_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_pragma(_UnqualifiedItemNames, ItemPragma, !IO) :-
+ ItemPragma = item_pragma_info(_, Pragma, Context),
maybe_output_line_number(Context, !IO),
(
Pragma = pragma_source_file(SourceFile),
@@ -774,8 +852,12 @@
mercury_output_pragma_require_feature_set(Features, !IO)
).
-mercury_output_item(_, item_promise(PromiseType, Goal0, VarSet, UnivVars), _,
- !IO) :-
+:- pred mercury_output_item_promise(bool::in, item_promise_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_promise(_, ItemPromise, !IO) :-
+ ItemPromise = item_promise_info(PromiseType, Goal0, VarSet, UnivVars,
+ _Context),
Indent = 1,
(
PromiseType = promise_type_true,
@@ -785,8 +867,8 @@
io.write_string(":- promise ", !IO),
(
UnivVars = [_ | _],
- Goal0 = _GoalExpr - Context,
- Goal = all_expr(UnivVars, Goal0) - Context
+ Goal0 = _GoalExpr - GoalContext,
+ Goal = all_expr(UnivVars, Goal0) - GoalContext
;
UnivVars = [],
Goal = Goal0
@@ -810,9 +892,13 @@
mercury_output_newline(Indent, !IO),
mercury_output_goal(Goal, VarSet, Indent, !IO),
io.write_string(".\n", !IO).
-mercury_output_item(_, item_nothing(_), _, !IO).
-mercury_output_item(UnqualifiedItemNames, item_typeclass(Constraints,
- FunDeps, ClassName0, Vars, Interface, VarSet), _, !IO) :-
+
+:- pred mercury_output_item_typeclass(bool::in, item_typeclass_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_typeclass(UnqualifiedItemNames, ItemTypeClass, !IO) :-
+ ItemTypeClass = item_typeclass_info(Constraints, FunDeps, ClassName0,
+ Vars, Interface, VarSet, _Context),
maybe_unqualify_sym_name(UnqualifiedItemNames, ClassName0, ClassName),
io.write_string(":- typeclass ", !IO),
@@ -838,11 +924,16 @@
output_class_methods(Methods, !IO),
io.write_string("\n].\n", !IO)
).
-mercury_output_item(_, item_instance(Constraints, ClassName, Types, Body,
- VarSet, _InstanceModuleName), _, !IO) :-
+
+:- pred mercury_output_item_instance(bool::in, item_instance_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_instance(_, ItemInstance, !IO) :-
+ ItemInstance = item_instance_info(Constraints, ClassName, Types, Body,
+ VarSet, _InstanceModuleName, _),
io.write_string(":- instance ", !IO),
- % We put an extra set of brackets around the class name in
- % case the name is an operator.
+ % We put an extra set of brackets around the class name in case
+ % the name is an operator.
io.write_char('(', !IO),
mercury_output_sym_name(ClassName, !IO),
io.write_char('(', !IO),
@@ -861,29 +952,43 @@
io.write_string("\n]", !IO)
),
io.write_string(".\n", !IO).
-mercury_output_item(_, item_initialise(_, PredSymName, Arity), _, !IO) :-
+
+:- pred mercury_output_item_initialise(bool::in, item_initialise_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_initialise(_, ItemInitialise, !IO) :-
+ ItemInitialise = item_initialise_info(_, PredSymName, Arity, _),
io.write_string(":- initialise ", !IO),
mercury_output_sym_name(PredSymName, !IO),
io.write_string("/", !IO),
io.write_int(Arity, !IO),
io.write_string(".\n", !IO).
-mercury_output_item(_, item_finalise(_, PredSymName, Arity), _, !IO) :-
+
+:- pred mercury_output_item_finalise(bool::in, item_finalise_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_finalise(_, ItemFinalise, !IO) :-
+ ItemFinalise = item_finalise_info(_, PredSymName, Arity, _),
io.write_string(":- finalise ", !IO),
mercury_output_sym_name(PredSymName, !IO),
io.write_string("/", !IO),
io.write_int(Arity, !IO),
io.write_string(".\n", !IO).
-mercury_output_item(_, Mutable, _, !IO) :-
- Mutable = item_mutable(Name, Type, InitTerm, Inst, Attrs, MutVarset),
+
+:- pred mercury_output_item_mutable(bool::in, item_mutable_info::in,
+ io::di, io::uo) is det.
+
+mercury_output_item_mutable(_, ItemMutable, !IO) :-
+ ItemMutable = item_mutable_info(Name, Type, InitTerm, Inst, Attrs,
+ MutVarset, _Context),
io.write_string(":- mutable(", !IO),
io.write_string(Name, !IO),
io.write_string(", ", !IO),
mercury_output_type(varset.init, no, Type, !IO),
io.write_string(", ", !IO),
- %
+
% See the comments for prog_io.read_mutable_decl for the reason we
% _must_ use MutVarset here.
- %
mercury_output_term(MutVarset, no, InitTerm, !IO),
io.write_string(", ", !IO),
mercury_output_inst(Inst, varset.init, !IO),
@@ -956,7 +1061,7 @@
:- pred output_instance_method(instance_method::in, io::di, io::uo) is det.
output_instance_method(Method, !IO) :-
- Method = instance_method(PredOrFunc, Name1, Defn, Arity, Context),
+ Method = instance_method(PredOrFunc, Name1, Defn, Arity, _Context),
(
Defn = instance_proc_def_name(Name2),
io.write_char('\t', !IO),
@@ -977,15 +1082,16 @@
% XXX should we output the term contexts?
io.write_string("\t(", !IO),
io.write_list(ItemList, "),\n\t(",
- output_instance_method_clause(Name1, Context), !IO),
+ output_instance_method_clause(Name1), !IO),
io.write_string(")", !IO)
).
-:- pred output_instance_method_clause(sym_name::in, prog_context::in, item::in,
+:- pred output_instance_method_clause(sym_name::in, item_clause_info::in,
io::di, io::uo) is det.
-output_instance_method_clause(Name1, Context, Item, !IO) :-
- ( Item = item_clause(_, VarSet, PredOrFunc, _PredName, HeadTerms, Body) ->
+output_instance_method_clause(Name1, ItemClause, !IO) :-
+ ItemClause = item_clause_info(_, VarSet, PredOrFunc, _PredName,
+ HeadTerms, Body, Context),
(
PredOrFunc = pf_predicate,
mercury_output_pred_clause(VarSet, Name1, HeadTerms, Body, Context,
@@ -995,9 +1101,6 @@
pred_args_to_func_args(HeadTerms, ArgTerms, ResultTerm),
mercury_output_func_clause(VarSet, Name1, ArgTerms, ResultTerm,
Body, Context, !IO)
- )
- ;
- unexpected(this_file, "invalid instance method item")
).
%-----------------------------------------------------------------------------%
@@ -1975,17 +2078,11 @@
;
MutableItems = [_ | _],
io.write_string(",\n\t\tconstraint_store is [\n\t\t\t", !IO),
- io.write_list(MutableItems, ",\n\t\t\t", mercury_output_item_2,
+ io.write_list(MutableItems, ",\n\t\t\t", mercury_output_item,
!IO),
io.write_string("\n\t\t]", !IO)
).
-:- pred mercury_output_item_2(item::in, io::di, io::uo) is det.
-
-mercury_output_item_2(Item, !IO) :-
- term.context_init(DummyContext),
- mercury_output_item(Item, DummyContext, !IO).
-
:- pred mercury_output_ctors(list(constructor)::in, tvarset::in,
io::di, io::uo) is det.
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.162
diff -u -b -r1.162 module_qual.m
--- compiler/module_qual.m 22 Jan 2008 15:06:14 -0000 1.162
+++ compiler/module_qual.m 8 Feb 2008 17:22:33 -0000
@@ -50,7 +50,7 @@
%
% Errors in EventSpecMap0 will be reported as being for EventSpecFileName.
%
-:- pred module_qualify_items(item_list::in, item_list::out,
+:- pred module_qualify_items(list(item)::in, list(item)::out,
event_spec_map::in, event_spec_map::out, globals::in,
module_name::in, maybe(string)::in, string::in, mq_info::out,
bool::out, bool::out, list(error_spec)::in, list(error_spec)::out) is det.
@@ -257,24 +257,29 @@
% inst ids, all module synonym definitions, and the names of all
% modules imported in the interface.
%
-:- pred collect_mq_info(item_list::in, mq_info::in, mq_info::out) is det.
+:- pred collect_mq_info(list(item)::in, mq_info::in, mq_info::out) is det.
collect_mq_info([], !Info).
-collect_mq_info([ItemAndContext | ItemAndContexts], !Info) :-
- ItemAndContext = item_and_context(Item, _Context),
- ( Item = item_module_defn(_, md_transitively_imported) ->
+collect_mq_info([Item | Items], !Info) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ModuleDefn = md_transitively_imported
+ ->
% Don't process the transitively imported items (from `.int2' files).
% They can't be used in the current module.
true
;
collect_mq_info_item(Item, !Info),
- collect_mq_info(ItemAndContexts, !Info)
+ collect_mq_info(Items, !Info)
).
:- pred collect_mq_info_item(item::in, mq_info::in, mq_info::out) is det.
-collect_mq_info_item(item_clause(_, _, _, _, _, _), !Info).
-collect_mq_info_item(item_type_defn(_, SymName, Params, _, _), !Info) :-
+collect_mq_info_item(Item, !Info) :-
+ (
+ Item = item_type_defn(ItemTypeDefn),
+ ItemTypeDefn = item_type_defn_info(_, SymName, Params, _, _, _),
( mq_info_get_import_status(!.Info, mq_status_abstract_imported) ->
% This item is not visible in the current module.
true
@@ -288,8 +293,10 @@
ImplTypes0, ImplTypes),
mq_info_set_types(Types, !Info),
mq_info_set_impl_types(ImplTypes, !Info)
- ).
-collect_mq_info_item(item_inst_defn(_, SymName, Params, _, _), !Info) :-
+ )
+ ;
+ Item = item_inst_defn(ItemInstDefn),
+ ItemInstDefn = item_inst_defn_info(_, SymName, Params, _, _, _),
( mq_info_get_import_status(!.Info, mq_status_abstract_imported) ->
% This item is not visible in the current module.
true
@@ -299,8 +306,10 @@
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
id_set_insert(NeedQualifier, mq_id(SymName, Arity), Insts0, Insts),
mq_info_set_insts(Insts, !Info)
- ).
-collect_mq_info_item(item_mode_defn(_, SymName, Params, _, _), !Info) :-
+ )
+ ;
+ Item = item_mode_defn(ItemModeDefn),
+ ItemModeDefn = item_mode_defn_info(_, SymName, Params, _, _, _),
( mq_info_get_import_status(!.Info, mq_status_abstract_imported) ->
% This item is not visible in the current module.
true
@@ -310,29 +319,30 @@
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
id_set_insert(NeedQualifier, mq_id(SymName, Arity), Modes0, Modes),
mq_info_set_modes(Modes, !Info)
- ).
-collect_mq_info_item(item_module_defn(_, ModuleDefn), !Info) :-
- process_module_defn(ModuleDefn, !Info).
-collect_mq_info_item(item_pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _, _),
- !Info).
-collect_mq_info_item(item_pred_or_func_mode(_, _, _, _, _, _, _), !Info).
-collect_mq_info_item(item_pragma(_, _), !Info).
-collect_mq_info_item(item_promise(_PromiseType, Goal, _ProgVarSet, _UnivVars),
- !Info) :-
+ )
+ ;
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ process_module_defn(ModuleDefn, !Info)
+ ;
+ Item = item_promise(ItemPromise),
+ ItemPromise = item_promise_info(_PromiseType, Goal, _ProgVarSet,
+ _UnivVars, _Context),
process_assert(Goal, SymNames, Success),
(
Success = yes,
list.foldl(collect_mq_info_qualified_symname, SymNames, !Info)
;
- % Any unqualified symbol in the promise might come from *any* of the
- % imported modules. There's no way for us to tell which ones.
+ % Any unqualified symbol in the promise might come from *any* of
+ % the imported modules. There's no way for us to tell which ones.
% So we conservatively assume that it uses all of them.
Success = no,
set.init(UnusedInterfaceModules),
mq_info_set_unused_interface_modules(UnusedInterfaceModules, !Info)
- ).
-collect_mq_info_item(item_nothing(_), !Info).
-collect_mq_info_item(item_typeclass(_, _, SymName, Params, _, _), !Info) :-
+ )
+ ;
+ Item = item_typeclass(ItemTypeClass),
+ ItemTypeClass = item_typeclass_info(_, _, SymName, Params, _, _, _),
( mq_info_get_import_status(!.Info, mq_status_abstract_imported) ->
% This item is not visible in the current module.
true
@@ -340,13 +350,23 @@
list.length(Params, Arity),
mq_info_get_classes(!.Info, Classes0),
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
- id_set_insert(NeedQualifier, mq_id(SymName, Arity), Classes0, Classes),
+ id_set_insert(NeedQualifier, mq_id(SymName, Arity),
+ Classes0, Classes),
mq_info_set_classes(Classes, !Info)
+ )
+ ;
+ ( Item = item_clause(_)
+ ; Item = item_pred_decl(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_pragma(_)
+ ; Item = item_instance(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_mutable(_)
+ ; Item = item_nothing(_)
+ )
+ % Do nothing.
).
-collect_mq_info_item(item_instance(_, _, _, _, _, _), !Info).
-collect_mq_info_item(item_initialise(_, _, _), !Info).
-collect_mq_info_item(item_finalise(_, _, _), !Info).
-collect_mq_info_item(item_mutable(_, _, _, _, _, _), !Info).
:- pred collect_mq_info_qualified_symname(sym_name::in,
mq_info::in, mq_info::out) is det.
@@ -628,67 +648,79 @@
% is reached, since imported declarations should already be
% module qualified.
%
-:- pred do_module_qualify_items(item_list::in, item_list::out,
+:- pred do_module_qualify_items(list(item)::in, list(item)::out,
mq_info::in, mq_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
do_module_qualify_items([], [], !Info, !Specs).
-do_module_qualify_items([ItemAndContext0 | ItemAndContexts0],
- [ItemAndContext | ItemAndContexts], !Info, !Specs) :-
- ItemAndContext0 = item_and_context(Item0, Context),
- module_qualify_item(Item0, Item, Context, Continue, !Info, !Specs),
- ItemAndContext = item_and_context(Item, Context),
+do_module_qualify_items([Item0 | Items0], [Item | Items], !Info, !Specs) :-
+ module_qualify_item(Item0, Item, Continue, !Info, !Specs),
(
Continue = yes,
- do_module_qualify_items(ItemAndContexts0, ItemAndContexts,
- !Info, !Specs)
+ do_module_qualify_items(Items0, Items, !Info, !Specs)
;
Continue = no,
- ItemAndContexts = ItemAndContexts0
+ Items = Items0
).
% Call predicates to qualify a single item.
%
-:- pred module_qualify_item(item::in, item::out, prog_context::in, bool::out,
+:- pred module_qualify_item(item::in, item::out, bool::out,
mq_info::in, mq_info::out, list(error_spec)::in, list(error_spec)::out)
is det.
-module_qualify_item(Item0, Item, Context, Continue, !Info, !Specs) :-
+module_qualify_item(Item0, Item, Continue, !Info, !Specs) :-
(
- Item0 = item_clause(_,_,_,_,_,_),
+ Item0 = item_clause(_),
Item = Item0,
Continue = yes
;
- Item0 = item_type_defn(TVarSet, SymName, Params, TypeDefn0, C),
+ Item0 = item_type_defn(ItemTypeDefn0),
+ ItemTypeDefn0 = item_type_defn_info(TVarSet, SymName, Params,
+ TypeDefn0, C, Context),
list.length(Params, Arity),
mq_info_set_error_context(mqec_type(mq_id(SymName, Arity)) - Context,
!Info),
qualify_type_defn(TypeDefn0, TypeDefn, !Info, !Specs),
- Item = item_type_defn(TVarSet, SymName, Params, TypeDefn, C),
+ ItemTypeDefn = item_type_defn_info(TVarSet, SymName, Params,
+ TypeDefn, C, Context),
+ Item = item_type_defn(ItemTypeDefn),
Continue = yes
;
- Item0 = item_inst_defn(A, SymName, Params, InstDefn0, C),
+ Item0 = item_inst_defn(ItemInstDefn0),
+ ItemInstDefn0 = item_inst_defn_info(A, SymName, Params, InstDefn0, C,
+ Context),
list.length(Params, Arity),
mq_info_set_error_context(mqec_inst(mq_id(SymName, Arity)) - Context,
!Info),
qualify_inst_defn(InstDefn0, InstDefn, !Info, !Specs),
- Item = item_inst_defn(A, SymName, Params, InstDefn, C),
+ ItemInstDefn = item_inst_defn_info(A, SymName, Params, InstDefn, C,
+ Context),
+ Item = item_inst_defn(ItemInstDefn),
Continue = yes
;
- Item0 = item_mode_defn(A, SymName, Params, ModeDefn0, C),
+ Item0 = item_mode_defn(ItemModeDefn0),
+ ItemModeDefn0 = item_mode_defn_info(A, SymName, Params, ModeDefn0, C,
+ Context),
list.length(Params, Arity),
mq_info_set_error_context(mqec_mode(mq_id(SymName, Arity)) - Context,
!Info),
qualify_mode_defn(ModeDefn0, ModeDefn, !Info, !Specs),
- Item = item_mode_defn(A, SymName, Params, ModeDefn, C),
+ ItemModeDefn = item_mode_defn_info(A, SymName, Params, ModeDefn, C,
+ Context),
+ Item = item_mode_defn(ItemModeDefn),
Continue = yes
;
- Item0 = item_module_defn(A, ModuleDefn),
+ Item0 = item_module_defn(ItemModuleDefn0),
+ ItemModuleDefn0 = item_module_defn_info(A, ModuleDefn, Context),
update_import_status(ModuleDefn, !Info, Continue),
- Item = item_module_defn(A, ModuleDefn)
+ ItemModuleDefn = item_module_defn_info(A, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn)
;
- Item0 = item_pred_or_func(Origin, A, IVs, B, PredOrFunc, SymName,
- TypesAndModes0, WithType0, WithInst0, C, D, E, Constraints0),
+ Item0 = item_pred_decl(ItemPredDecl0),
+ ItemPredDecl0 = item_pred_decl_info(Origin, A, IVs, B, PredOrFunc,
+ SymName, TypesAndModes0, WithType0, WithInst0, C, D, E,
+ Constraints0, Context),
list.length(TypesAndModes0, Arity),
mq_info_set_error_context(
mqec_pred_or_func(PredOrFunc, mq_id(SymName, Arity)) - Context,
@@ -697,12 +729,15 @@
qualify_prog_constraints(Constraints0, Constraints, !Info, !Specs),
map_fold2_maybe(qualify_type, WithType0, WithType, !Info, !Specs),
map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !Specs),
- Item = item_pred_or_func(Origin, A, IVs, B, PredOrFunc, SymName,
- TypesAndModes, WithType, WithInst, C, D, E, Constraints),
+ ItemPredDecl = item_pred_decl_info(Origin, A, IVs, B, PredOrFunc,
+ SymName, TypesAndModes, WithType, WithInst, C, D, E,
+ Constraints, Context),
+ Item = item_pred_decl(ItemPredDecl),
Continue = yes
;
- Item0 = item_pred_or_func_mode(A, PredOrFunc, SymName, Modes0,
- WithInst0, C, D),
+ Item0 = item_mode_decl(ItemModeDecl0),
+ ItemModeDecl0 = item_mode_decl_info(A, PredOrFunc, SymName, Modes0,
+ WithInst0, C, D, Context),
list.length(Modes0, Arity),
mq_info_set_error_context(
mqec_pred_or_func_mode(PredOrFunc, mq_id(SymName, Arity))
@@ -710,17 +745,20 @@
!Info),
qualify_mode_list(Modes0, Modes, !Info, !Specs),
map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !Specs),
- Item = item_pred_or_func_mode(A, PredOrFunc, SymName, Modes,
- WithInst, C, D),
+ ItemModeDecl = item_mode_decl_info(A, PredOrFunc, SymName, Modes,
+ WithInst, C, D, Context),
+ Item = item_mode_decl(ItemModeDecl),
Continue = yes
;
- Item0 = item_pragma(Origin, Pragma0),
+ Item0 = item_pragma(ItemPragma0),
+ ItemPragma0 = item_pragma_info(Origin, Pragma0, Context),
mq_info_set_error_context(mqec_pragma - Context, !Info),
qualify_pragma(Pragma0, Pragma, !Info, !Specs),
- Item = item_pragma(Origin, Pragma),
+ ItemPragma = item_pragma_info(Origin, Pragma, Context),
+ Item = item_pragma(ItemPragma),
Continue = yes
;
- Item0 = item_promise(_T, _G, _V, _U),
+ Item0 = item_promise(_),
Item = Item0,
Continue = yes
;
@@ -728,8 +766,9 @@
Item = Item0,
Continue = yes
;
- Item0 = item_typeclass(Constraints0, FunDeps, Name, Vars, Interface0,
- VarSet),
+ Item0 = item_typeclass(ItemTypeClass0),
+ ItemTypeClass0 = item_typeclass_info(Constraints0, FunDeps,
+ Name, Vars, Interface0, VarSet, Context),
list.length(Vars, Arity),
mq_info_set_error_context(mqec_class(mq_id(Name, Arity)) - Context,
!Info),
@@ -742,12 +781,14 @@
qualify_class_interface(Methods0, Methods, !Info, !Specs),
Interface = class_interface_concrete(Methods)
),
- Item = item_typeclass(Constraints, FunDeps, Name, Vars, Interface,
- VarSet),
+ ItemTypeClass = item_typeclass_info(Constraints, FunDeps,
+ Name, Vars, Interface, VarSet, Context),
+ Item = item_typeclass(ItemTypeClass),
Continue = yes
;
- Item0 = item_instance(Constraints0, Name0, Types0, Body0, VarSet,
- ModName),
+ Item0 = item_instance(ItemInstance0),
+ ItemInstance0 = item_instance_info(Constraints0, Name0, Types0,
+ Body0, VarSet, ModName, Context),
list.length(Types0, Arity),
Id = mq_id(Name0, Arity),
mq_info_set_error_context(mqec_instance(Id) - Context, !Info),
@@ -758,22 +799,28 @@
qualify_class_name(Id, mq_id(Name, _), !Info, !Specs),
qualify_type_list(Types0, Types, !Info, !Specs),
qualify_instance_body(Name, Body0, Body),
- Item = item_instance(Constraints, Name, Types, Body, VarSet, ModName),
+ ItemInstance = item_instance_info(Constraints, Name, Types,
+ Body, VarSet, ModName, Context),
+ Item = item_instance(ItemInstance),
Continue = yes
;
- Item0 = item_initialise(_Origin, _PredSymName, _Arity),
+ Item0 = item_initialise(_),
Item = Item0,
Continue = yes
;
- Item0 = item_finalise(_Origin, _PredSymName, _Arity),
+ Item0 = item_finalise(_O),
Item = Item0,
Continue = yes
;
- Item0 = item_mutable(Name, Type0, InitTerm, Inst0, Attrs, Varset),
+ Item0 = item_mutable(ItemMutable0),
+ ItemMutable0 = item_mutable_info(Name, Type0, InitTerm, Inst0,
+ Attrs, Varset, Context),
mq_info_set_error_context(mqec_mutable(Name) - Context, !Info),
qualify_type(Type0, Type, !Info, !Specs),
qualify_inst(Inst0, Inst, !Info, !Specs),
- Item = item_mutable(Name, Type, InitTerm, Inst, Attrs, Varset),
+ ItemMutable = item_mutable_info(Name, Type, InitTerm, Inst,
+ Attrs, Varset, Context),
+ Item = item_mutable(ItemMutable),
Continue = yes
).
@@ -1749,7 +1796,7 @@
% Access and initialisation predicates.
%
-:- pred init_mq_info(item_list::in, globals::in, bool::in, module_name::in,
+:- pred init_mq_info(list(item)::in, globals::in, bool::in, module_name::in,
mq_info::out) is det.
init_mq_info(Items, Globals, ReportErrors, ModuleName, Info) :-
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.443
diff -u -b -r1.443 modules.m
--- compiler/modules.m 31 Dec 2007 10:03:51 -0000 1.443
+++ compiler/modules.m 11 Feb 2008 14:42:57 -0000
@@ -164,7 +164,7 @@
% a module given the file name, use `read_mod_from_file'.
%
:- pred read_mod(module_name::in, string::in, string::in, bool::in, bool::in,
- item_list::out, module_error::out, file_name::out,
+ list(item)::out, module_error::out, file_name::out,
maybe(timestamp)::out, io::di, io::uo) is det.
% read_mod_if_changed(ModuleName, Extension, Descr, Search,
@@ -180,13 +180,13 @@
% will be `no'.
%
:- pred read_mod_if_changed(module_name::in, string::in, string::in, bool::in,
- timestamp::in, item_list::out, module_error::out, file_name::out,
+ timestamp::in, list(item)::out, module_error::out, file_name::out,
maybe(timestamp)::out, io::di, io::uo) is det.
% Similar to read_mod, but doesn't return error messages.
%
:- pred read_mod_ignore_errors(module_name::in, string::in, string::in,
- bool::in, bool::in, item_list::out, module_error::out, file_name::out,
+ bool::in, bool::in, list(item)::out, module_error::out, file_name::out,
maybe(timestamp)::out, io::di, io::uo) is det.
% read_mod_from_file(SourceFileName, Extension, Descr, Search,
@@ -204,7 +204,7 @@
% module given the module name, use `read_mod'.
%
:- pred read_mod_from_file(file_name::in, string::in, string::in, bool::in,
- bool::in, item_list::out, module_error::out, module_name::out,
+ bool::in, list(item)::out, module_error::out, module_name::out,
maybe(timestamp)::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -219,7 +219,7 @@
% section; it is used when compiling sub-modules.)
%
:- pred make_private_interface(file_name::in, module_name::in, module_name::in,
- maybe(timestamp)::in, item_list::in, io::di, io::uo) is det.
+ maybe(timestamp)::in, list(item)::in, io::di, io::uo) is det.
% make_interface(SourceFileName, SourceFileModuleName,
% ModuleName, MaybeTimestamp, Items):
@@ -229,11 +229,11 @@
% and short (`.int2') interface files for the module.
%
:- pred make_interface(file_name::in, module_name::in, module_name::in,
- maybe(timestamp)::in, item_list::in, io::di, io::uo) is det.
+ maybe(timestamp)::in, list(item)::in, io::di, io::uo) is det.
% Output the unqualified short interface file to <module>.int3.
%
-:- pred make_short_interface(file_name::in, module_name::in, item_list::in,
+:- pred make_short_interface(file_name::in, module_name::in, list(item)::in,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -309,7 +309,7 @@
contains_foreign_export :: contains_foreign_export,
% The contents of the module and its imports.
- items :: item_list,
+ items :: list(item),
% Whether an error has been encountered when reading in
% this module.
@@ -354,7 +354,7 @@
:- type read_module
---> read_module(
module_timestamp,
- item_list,
+ list(item),
module_error,
file_name
).
@@ -365,7 +365,7 @@
% Check whether a file was read during recompilation checking.
%
:- pred find_read_module(read_modules::in, module_name::in, string::in,
- bool::in, item_list::out, maybe(timestamp)::out, module_error::out,
+ bool::in, list(item)::out, maybe(timestamp)::out, module_error::out,
file_name::out) is semidet.
%-----------------------------------------------------------------------------%
@@ -379,10 +379,10 @@
is det.
:- pred module_imports_get_impl_deps(module_imports::in,
list(module_name)::out) is det.
-:- pred module_imports_get_items(module_imports::in, item_list::out) is det.
+:- pred module_imports_get_items(module_imports::in, list(item)::out) is det.
:- pred module_imports_get_error(module_imports::in, module_error::out) is det.
-:- pred module_imports_set_items(item_list::in,
+:- pred module_imports_set_items(list(item)::in,
module_imports::in, module_imports::out) is det.
:- pred module_imports_set_error(module_error::in,
module_imports::in, module_imports::out) is det.
@@ -404,11 +404,11 @@
%-----------------------------------------------------------------------------%
- % Make an item_and_context for a module declaration or pseudo-declaration
+ % Make an item for a module declaration or pseudo-declaration
% such as `:- imported' (which is inserted by the compiler, but can't be
% used in user code).
%
-:- func make_pseudo_decl(module_defn) = item_and_context.
+:- func make_pseudo_decl(module_defn) = item.
% append_pseudo_decl(PseudoDecl, Module0, Module):
%
@@ -424,16 +424,16 @@
% (this will usually be an item which sets the import status).
% Replace all occurrences of `:- implementation' with ImpStatusItem.
%
-:- pred replace_section_decls(item_and_context::in, item_and_context::in,
- item_list::in, item_list::out) is det.
+:- pred replace_section_decls(item::in, item::in,
+ list(item)::in, list(item)::out) is det.
% Remove all the imported items the list.
%
-:- pred strip_imported_items(item_list::in, item_list::out) is det.
+:- pred strip_imported_items(list(item)::in, list(item)::out) is det.
%-----------------------------------------------------------------------------%
-:- type module_list == assoc_list(module_name, item_list).
+:- type module_list == assoc_list(module_name, list(item)).
% Given a module (well, a list of items), split it into its constituent
% sub-modules, in top-down order.
@@ -444,8 +444,8 @@
% - check for non-abstract typeclass instance declarations in module
% interfaces.
%
-:- pred split_into_submodules(module_name::in, item_list::in, module_list::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+:- pred split_into_submodules(module_name::in, list(item)::in,
+ module_list::out, list(error_spec)::in, list(error_spec)::out) is det.
%-----------------------------------------------------------------------------%
@@ -465,7 +465,7 @@
%
:- pred grab_imported_modules(file_name::in, module_name::in, module_name::in,
list(module_name)::in, read_modules::in, maybe(timestamp)::in,
- item_list::in, module_imports::out, module_error::out,
+ list(item)::in, module_imports::out, module_error::out,
io::di, io::uo) is det.
% grab_unqual_imported_modules(SourceFileName, SourceFileModuleName,
@@ -478,7 +478,7 @@
% fields of the module_imports structure.
%
:- pred grab_unqual_imported_modules(file_name::in, module_name::in,
- module_name::in, item_list::in, module_imports::out, module_error::out,
+ module_name::in, list(item)::in, module_imports::out, module_error::out,
io::di, io::uo) is det.
% process_module_private_interfaces(Ancestors,
@@ -489,7 +489,7 @@
% lists.
%
:- pred process_module_private_interfaces(read_modules::in,
- list(module_name)::in, item_and_context::in, item_and_context::in,
+ list(module_name)::in, item::in, item::in,
list(module_name)::in, list(module_name)::out,
list(module_name)::in, list(module_name)::out,
module_imports::in, module_imports::out, io::di, io::uo) is det.
@@ -508,8 +508,7 @@
% should set the import_status of the following items.
%
:- pred process_module_long_interfaces(read_modules::in, need_qualifier::in,
- list(module_name)::in, string::in,
- item_and_context::in, item_and_context::in,
+ list(module_name)::in, string::in, item::in, item::in,
list(module_name)::in, list(module_name)::out,
list(module_name)::in, list(module_name)::out,
module_imports::in, module_imports::out, io::di, io::uo) is det.
@@ -528,8 +527,7 @@
% the import_status of the following items.
%
:- pred process_module_short_interfaces_transitively(read_modules::in,
- list(module_name)::in, string::in,
- item_and_context::in, item_and_context::in,
+ list(module_name)::in, string::in, item::in, item::in,
list(module_name)::in, list(module_name)::out,
module_imports::in, module_imports::out, io::di, io::uo) is det.
@@ -546,8 +544,7 @@
% which should set the import_status of the following items.
%
:- pred process_module_short_interfaces_and_impls_transitively(
- read_modules::in, list(module_name)::in, string::in,
- item_and_context::in, item_and_context::in,
+ read_modules::in, list(module_name)::in, string::in, item::in, item::in,
module_imports::in, module_imports::out, io::di, io::uo) is det.
% process_module_short_interfaces(ReadModules,
@@ -565,8 +562,7 @@
% the import_status of the following items.
%
:- pred process_module_short_interfaces(read_modules::in,
- list(module_name)::in, string::in, item_and_context::in,
- item_and_context::in,
+ list(module_name)::in, string::in, item::in, item::in,
list(module_name)::in, list(module_name)::out,
list(module_name)::in, list(module_name)::out,
module_imports::in, module_imports::out, io::di, io::uo) is det.
@@ -654,7 +650,7 @@
% (see get_children/2). You may also need to consider indirect
% dependencies.
%
-:- pred get_dependencies(item_list::in, list(module_name)::out,
+:- pred get_dependencies(list(item)::in, list(module_name)::out,
list(module_name)::out) is det.
% get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps):
@@ -666,7 +662,7 @@
% the list which should be automatically implicitly imported as if via
% `:- use_module'.
%
-:- pred get_implicit_dependencies(item_list::in, globals::in,
+:- pred get_implicit_dependencies(list(item)::in, globals::in,
list(module_name)::out, list(module_name)::out) is det.
% get_ancestors(ModuleName) = ParentDeps:
@@ -682,7 +678,7 @@
%
:- pred init_dependencies(file_name::in, module_name::in,
list(module_name)::in, module_error::in, globals::in,
- pair(module_name, item_list)::in, module_imports::out) is det.
+ pair(module_name, list(item))::in, module_imports::out) is det.
%-----------------------------------------------------------------------------%
@@ -741,14 +737,14 @@
% Check whether a particular `pragma' declaration is allowed
% in the interface section of a module.
%
-:- pred pragma_allowed_in_interface(pragma_type::in, bool::out) is det.
+:- func pragma_allowed_in_interface(pragma_type) = bool.
% Given a module name and a list of the items in that module,
% this procedure checks if the module doesn't export anything,
% and if so, and --warn-nothing-exported is set, it reports
% a warning.
%
-:- pred check_for_no_exports(item_list::in, module_name::in,
+:- pred check_for_no_exports(list(item)::in, module_name::in,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -1336,10 +1332,10 @@
% the structure of lists of items that represent private
% interfaces.
- strip_imported_items(Items2, [], Items3),
+ strip_imported_items(Items2, Items3),
strip_clauses_from_interface(Items3, Items4),
handle_mutables_in_private_interface(ModuleName, Items4, Items5),
- Items6 = list.map(make_item_and_context_abstract, Items5),
+ list.map(make_any_instances_abstract, Items5, Items6),
list.reverse(Items6, Items),
write_interface_file(SourceFileName, ModuleName,
".int0", MaybeTimestamp,
@@ -1348,14 +1344,14 @@
)
).
-:- func make_item_and_context_abstract(item_and_context) = item_and_context.
+:- pred make_any_instances_abstract(item::in, item::out) is det.
-make_item_and_context_abstract(ItemAndContext0) = ItemAndContext :-
- ItemAndContext0 = item_and_context(Item0, Context),
- ( make_abstract_instance(Item0, Item) ->
- ItemAndContext = item_and_context(Item, Context)
+make_any_instances_abstract(Item0, Item) :-
+ ( Item0 = item_instance(InstanceInfo0) ->
+ InstanceInfo = make_instance_abstract(InstanceInfo0),
+ Item = item_instance(InstanceInfo)
;
- ItemAndContext = ItemAndContext0
+ Item = Item0
).
% Expand any mutable declarations in the item list into the pred and mode
@@ -1363,50 +1359,51 @@
% 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.
+ list(item)::in, list(item)::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.
+ item::in, list(item)::in, list(item)::out) is det.
-handle_mutable_in_private_interface(ModuleName, ItemAndContext, !Items) :-
- ItemAndContext = item_and_context(Item, Context),
- ( Item = item_mutable(MutableName, Type, _Value, Inst, Attrs, _Varset) ->
+handle_mutable_in_private_interface(ModuleName, Item, !Items) :-
+ ( Item = item_mutable(ItemMutable) ->
+ ItemMutable = item_mutable_info(MutableName, Type, _Value, Inst, Attrs,
+ _Varset, Context),
ConstantInterface = mutable_var_constant(Attrs),
(
ConstantInterface = yes,
- ConstantGetPredDecl =
- constant_get_pred_decl(ModuleName, MutableName, Type, Inst),
- list.cons(item_and_context(ConstantGetPredDecl, Context), !Items),
- ConstantSetPredDecl =
- constant_set_pred_decl(ModuleName, MutableName, Type, Inst),
- list.cons(item_and_context(ConstantSetPredDecl, Context), !Items)
+ ConstantGetPredDeclItem = constant_get_pred_decl(ModuleName,
+ MutableName, Type, Inst, Context),
+ ConstantSetPredDeclItem = constant_set_pred_decl(ModuleName,
+ MutableName, Type, Inst, Context),
+ list.cons(ConstantGetPredDeclItem, !Items),
+ list.cons(ConstantSetPredDeclItem, !Items)
;
ConstantInterface = no,
- StdGetPredDecl =
- std_get_pred_decl(ModuleName, MutableName, Type, Inst),
- list.cons(item_and_context(StdGetPredDecl, Context), !Items),
- StdSetPredDecl =
- std_set_pred_decl(ModuleName, MutableName, Type, Inst),
- list.cons(item_and_context(StdSetPredDecl, Context), !Items),
+ StdGetPredDeclItem = std_get_pred_decl(ModuleName,
+ MutableName, Type, Inst, Context),
+ StdSetPredDeclItem = std_set_pred_decl(ModuleName,
+ MutableName, Type, Inst, Context),
+ list.cons(StdGetPredDeclItem, !Items),
+ list.cons(StdSetPredDeclItem, !Items),
IOStateInterface = mutable_var_attach_to_io_state(Attrs),
(
IOStateInterface = yes,
- PureGetPredDecl =
- io_get_pred_decl(ModuleName, MutableName, Type, Inst),
- list.cons(item_and_context(PureGetPredDecl, Context), !Items),
- PureSetPredDecl =
- io_set_pred_decl(ModuleName, MutableName, Type, Inst),
- list.cons(item_and_context(PureSetPredDecl, Context), !Items)
+ PureGetPredDeclItem = io_get_pred_decl(ModuleName,
+ MutableName, Type, Inst, Context),
+ PureSetPredDeclItem = io_set_pred_decl(ModuleName,
+ MutableName, Type, Inst, Context),
+ list.cons(PureGetPredDeclItem, !Items),
+ list.cons(PureSetPredDeclItem, !Items)
;
IOStateInterface = no
)
)
;
- list.cons(ItemAndContext, !Items)
+ list.cons(Item, !Items)
).
%-----------------------------------------------------------------------------%
@@ -1444,9 +1441,8 @@
% We want to finish writing the interface file (and keep
% the exit status at zero) if we found some warnings.
globals.io_set_option(halt_at_warn, bool(no), !IO),
- sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, Globals, 0, _NumWarnings,
- 0, NumErrors, !IO),
+ write_error_specs(Specs, Globals, 0, _NumWarnings, 0, NumErrors,
+ !IO),
( NumErrors > 0 ->
module_name_to_file_name(ModuleName, ".int", no, IntFileName,
!IO),
@@ -1458,10 +1454,14 @@
% check for some warnings, and then write out the `.int'
% and `int2' files and touch the `.date' file.
- strip_imported_items(!.InterfaceItems, [], !:InterfaceItems),
+ strip_imported_items(!InterfaceItems),
strip_assertions(!InterfaceItems),
strip_unnecessary_impl_defns(!InterfaceItems),
- check_for_clauses_in_interface(!InterfaceItems, !IO),
+ check_for_clauses_in_interface(!InterfaceItems, [],
+ InterfaceSpecs),
+ % XXX _NumErrors
+ write_error_specs( InterfaceSpecs, Globals,
+ 0, _NumWarnings2, 0, _NumErrors2, !IO),
check_int_for_no_exports(!.InterfaceItems, ModuleName, !IO),
order_items(!InterfaceItems),
write_interface_file(SourceFileName, ModuleName, ".int",
@@ -1479,64 +1479,93 @@
% This qualifies everything as much as it can given the information
% in the current module and writes out the .int3 file.
+ some [!Specs] (
+ !:Specs = [],
get_interface(ModuleName, no, Items0, InterfaceItems0),
% Assertions are also stripped since they should only be written
% to .opt files.
strip_assertions(InterfaceItems0, InterfaceItems1),
- check_for_clauses_in_interface(InterfaceItems1, InterfaceItems, !IO),
+ check_for_clauses_in_interface(InterfaceItems1, InterfaceItems,
+ !Specs),
get_short_interface(InterfaceItems, int3, ShortInterfaceItems0),
globals.io_get_globals(Globals, !IO),
module_qualify_items(ShortInterfaceItems0, ShortInterfaceItems,
- map.init, _, Globals, ModuleName, no, "", _, _, _, [], Specs),
- sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
+ map.init, _, Globals, ModuleName, no, "", _, _, _, !Specs),
+ % XXX _NumErrors
+ write_error_specs(!.Specs, Globals, 0, _NumWarnings, 0, _NumErrors,
!IO),
% XXX why do we do this even if there are some errors?
write_interface_file(SourceFileName, ModuleName, ".int3",
no, ShortInterfaceItems, !IO),
- touch_interface_datestamp(ModuleName, ".date3", !IO).
+ touch_interface_datestamp(ModuleName, ".date3", !IO)
+ ).
%-----------------------------------------------------------------------------%
strip_imported_items(Items0, Items) :-
- strip_imported_items(Items0, [], Items).
+ strip_imported_items_2(Items0, [], RevItems),
+ list.reverse(RevItems, Items).
-:- pred strip_imported_items(item_list::in, item_list::in, item_list::out)
+:- pred strip_imported_items_2(list(item)::in, list(item)::in, list(item)::out)
is det.
-strip_imported_items([], !Items) :-
- list.reverse(!Items).
-strip_imported_items([item_and_context(Item, Context) | Rest], !Items) :-
- ( Item = item_module_defn(_, md_imported(_)) ->
- list.reverse(!Items)
- ; Item = item_module_defn(_, md_used(_)) ->
- list.reverse(!Items)
- ; Item = item_module_defn(_, md_abstract_imported) ->
- list.reverse(!Items)
+strip_imported_items_2([], !RevItems).
+strip_imported_items_2([Item | Items], !RevItems) :-
+ ( Item = item_module_defn(ItemModuleDefn) ->
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ (
+ ( ModuleDefn = md_imported(_)
+ ; ModuleDefn = md_used(_)
+ ; ModuleDefn = md_abstract_imported
+ )
+ % The lack of a recursive call here effectively deletes both
+ % Item and everything in Items from the list.
;
- strip_imported_items(Rest,
- [item_and_context(Item, Context) | !.Items], !:Items)
+ % XXX Some of these should probably cause an error message.
+ ( ModuleDefn = md_module(_)
+ ; ModuleDefn = md_end_module(_)
+ ; ModuleDefn = md_interface
+ ; ModuleDefn = md_implementation
+ ; ModuleDefn = md_private_interface
+ ; ModuleDefn = md_opt_imported
+ ; ModuleDefn = md_transitively_imported
+ ; ModuleDefn = md_external(_, _)
+ ; ModuleDefn = md_export(_)
+ ; ModuleDefn = md_import(_)
+ ; ModuleDefn = md_use(_)
+ ; ModuleDefn = md_include_module(_)
+ ; ModuleDefn = md_version_numbers(_, _)
+ ),
+ !:RevItems = [Item | !.RevItems],
+ strip_imported_items_2(Items, !RevItems)
+ )
+ ;
+ !:RevItems = [Item | !.RevItems],
+ strip_imported_items_2(Items, !RevItems)
).
-:- pred strip_assertions(item_list::in, item_list::out) is det.
+:- pred strip_assertions(list(item)::in, list(item)::out) is det.
strip_assertions([], []).
-strip_assertions([item_and_context(Item, Context) | Rest], Items) :-
- ( Item = item_promise(promise_type_true, _, _, _) ->
- strip_assertions(Rest, Items)
+strip_assertions([Head | Tail], Items) :-
+ (
+ Head = item_promise(ItemPromise),
+ ItemPromise = item_promise_info(promise_type_true, _, _, _, _)
+ ->
+ strip_assertions(Tail, Items)
;
- strip_assertions(Rest, Items0),
- Items = [item_and_context(Item, Context) | Items0]
+ strip_assertions(Tail, ItemsTail),
+ Items = [Head | ItemsTail]
).
%-----------------------------------------------------------------------------%
-:- pred strip_unnecessary_impl_defns(item_list::in, item_list::out) is det.
+:- pred strip_unnecessary_impl_defns(list(item)::in, list(item)::out) is det.
strip_unnecessary_impl_defns(Items0, Items) :-
some [!IntTypesMap, !ImplTypesMap, !ImplItems] (
- gather_type_defns(no, Items0, [], IntItems0, [], !:ImplItems,
- map.init, !:IntTypesMap, map.init, !:ImplTypesMap),
+ gather_type_defns(Items0, IntItems0, !:ImplItems,
+ !:IntTypesMap, !:ImplTypesMap),
% Work out which module imports in the implementation section of
% the interface are required by the definitions of equivalence
@@ -1581,8 +1610,9 @@
!ImplTypesMap),
AddProjectedItem =
- (pred((_ - Item)::in, !.ImplItems::in, !:ImplItems::out)
+ (pred((_ - ItemTypeDefn)::in, !.ImplItems::in, !:ImplItems::out)
is det :-
+ Item = item_type_defn(ItemTypeDefn),
!:ImplItems = [Item | !.ImplItems]
),
AddProjectedItems =
@@ -1612,21 +1642,18 @@
)
).
-:- inst item_context(I) == bound(item_and_context(I, ground)).
-
-:- inst one_module_spec == bound(list_module(bound([ground | bound([])]))).
-:- inst import_item == bound(item_module_defn(ground,
- bound(md_import(one_module_spec)))).
-:- inst use_item == bound(item_module_defn(ground,
- bound(md_use(one_module_spec)))).
-:- inst type_defn_item == bound(item_type_defn(ground, ground, ground,
- ground, ground)).
+:- type module_specifier_in_defn
+ ---> module_specifier_in_defn(
+ prog_varset,
+ prog_context,
+ module_specifier
+ ).
-:- pred standardize_impl_items(item_list::in, item_list::out) is det.
+:- pred standardize_impl_items(list(item)::in, list(item)::out) is det.
standardize_impl_items(Items0, Items) :-
do_standardize_impl_items(Items0, no, Unexpected, [], RevRemainderItems,
- [], ImportItems, [], UseItems, [], TypeDefnItems),
+ [], ImportModuleSpecs, [], UseModuleSpecs, [], TypeDefnInfos),
(
Unexpected = yes,
unexpected(this_file, "standardize_impl_items: unexpected items")
@@ -1636,38 +1663,59 @@
;
Unexpected = no,
list.reverse(RevRemainderItems, RemainderItems),
+ ImportItems = list.map(wrap_import_module_spec, ImportModuleSpecs),
+ UseItems = list.map(wrap_use_module_spec, UseModuleSpecs),
+ TypeDefnItems = list.map(wrap_type_defn_item, TypeDefnInfos),
list.condense([ImportItems, UseItems, TypeDefnItems, RemainderItems],
Items)
).
-:- pred do_standardize_impl_items(item_list::in, bool::in, bool::out,
- item_list::in, item_list::out,
- item_list::in(list_skel(item_context(import_item))),
- item_list::out(list_skel(item_context(import_item))),
- item_list::in(list_skel(item_context(use_item))),
- item_list::out(list_skel(item_context(use_item))),
- item_list::in(list_skel(item_context(type_defn_item))),
- item_list::out(list_skel(item_context(type_defn_item))))
- is det.
+:- func wrap_type_defn_item(item_type_defn_info) = item.
+
+wrap_type_defn_item(ItemTypeDefn) = item_type_defn(ItemTypeDefn).
+
+:- func wrap_import_module_spec(module_specifier_in_defn) = item.
+
+wrap_import_module_spec(ModuleSpecInDefn) = Item :-
+ ModuleSpecInDefn = module_specifier_in_defn(VarSet, Context, ModuleSpec),
+ ImportModules = list_module([ModuleSpec]),
+ ModuleDefn = md_import(ImportModules),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn).
+
+:- func wrap_use_module_spec(module_specifier_in_defn) = item.
+
+wrap_use_module_spec(ModuleSpecInDefn) = Item :-
+ ModuleSpecInDefn = module_specifier_in_defn(VarSet, Context, ModuleSpec),
+ ImportModules = list_module([ModuleSpec]),
+ ModuleDefn = md_use(ImportModules),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn).
+
+:- pred do_standardize_impl_items(list(item)::in, bool::in, bool::out,
+ list(item)::in, list(item)::out,
+ list(module_specifier_in_defn)::in, list(module_specifier_in_defn)::out,
+ list(module_specifier_in_defn)::in, list(module_specifier_in_defn)::out,
+ list(item_type_defn_info)::in, list(item_type_defn_info)::out) is det.
do_standardize_impl_items([], !Unexpected, !RevRemainderItems,
- !ImportItems, !UseItems, !TypeDefnItems).
-do_standardize_impl_items([ItemAndContext | ItemAndContexts], !Unexpected,
- !RevRemainderItems, !ImportItems, !UseItems, !TypeDefnItems) :-
- ItemAndContext = item_and_context(Item, Context),
- ( Item = item_module_defn(_VarSet, ModuleDefn) ->
+ !ImportSpecs, !UseSpecs, !TypeDefns).
+do_standardize_impl_items([Item | Items], !Unexpected,
+ !RevRemainderItems, !ImportSpecs, !UseSpecs, !TypeDefns) :-
+ ( Item = item_module_defn(ItemModuleDefn) ->
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
(
ModuleDefn = md_import(ImportModules),
- ( ImportModules = list_module([_ImportModule]) ->
- insert_import_module(Context, Item, !ImportItems)
+ ( ImportModules = list_module([ModuleSpec]) ->
+ insert_module_spec(VarSet, Context, ModuleSpec, !ImportSpecs)
;
unexpected(this_file,
"do_standardize_impl_items: non-singleton-module import")
)
;
ModuleDefn = md_use(UseModules),
- ( UseModules = list_module([_UseModule]) ->
- insert_use_module(Context, Item, !UseItems)
+ ( UseModules = list_module([ModuleSpec]) ->
+ insert_module_spec(VarSet, Context, ModuleSpec, !UseSpecs)
;
unexpected(this_file,
"do_standardize_impl_items: non-singleton-module use")
@@ -1690,108 +1738,72 @@
!:Unexpected = yes
;
ModuleDefn = md_include_module(_),
- !:RevRemainderItems = [ItemAndContext | !.RevRemainderItems]
+ !:RevRemainderItems = [Item | !.RevRemainderItems]
)
- ; Item = item_type_defn(_, _, _, _, _) ->
- insert_type_defn(Context, Item, !TypeDefnItems)
+ ; Item = item_type_defn(ItemTypeDefn) ->
+ insert_type_defn(ItemTypeDefn, !TypeDefns)
;
- !:RevRemainderItems = [ItemAndContext | !.RevRemainderItems]
+ !:RevRemainderItems = [Item | !.RevRemainderItems]
),
- do_standardize_impl_items(ItemAndContexts, !Unexpected,
- !RevRemainderItems, !ImportItems, !UseItems, !TypeDefnItems).
+ do_standardize_impl_items(Items, !Unexpected,
+ !RevRemainderItems, !ImportSpecs, !UseSpecs, !TypeDefns).
-:- pred insert_import_module(prog_context::in, item::in,
- item_list::in(list_skel(item_context(import_item))),
- item_list::out(list_skel(item_context(import_item)))) is det.
+:- pred insert_module_spec(prog_varset::in, prog_context::in,
+ module_specifier::in,
+ list(module_specifier_in_defn)::in, list(module_specifier_in_defn)::out)
+ is det.
-insert_import_module(Context, Item, [], [item_and_context(Item, Context)]).
-insert_import_module(Context, Item, [Head | Tail], Result) :-
- Head = item_and_context(HeadItem, _HeadContext),
- % The lack of alias tracking prevents the compiler from figuring out
- % that this predicate is only called with values of Item for which
- % this test succeeds.
- ( Item = item_module_defn(_, md_import(list_module([ModulePrime]))) ->
- Module = ModulePrime
- ;
- unexpected(this_file, "insert_import_module: bad item")
- ),
- HeadItem = item_module_defn(_, md_import(list_module([HeadModule]))),
- compare(CompareSymName, Module, HeadModule),
+insert_module_spec(VarSet, Context, NewModuleSpec, [], [New]) :-
+ New = module_specifier_in_defn(VarSet, Context, NewModuleSpec).
+insert_module_spec(VarSet, Context, NewModuleSpec, [Head | Tail], Result) :-
+ Head = module_specifier_in_defn(_, _, HeadModuleSpec),
+ compare(CompareSymName, NewModuleSpec, HeadModuleSpec),
( CompareSymName = (<) ->
- Result = [item_and_context(Item, Context), Head | Tail]
+ New = module_specifier_in_defn(VarSet, Context, NewModuleSpec),
+ Result = [New, Head | Tail]
;
- insert_import_module(Context, Item, Tail, TailResult),
- Result = [Head | TailResult]
+ insert_module_spec(VarSet, Context, NewModuleSpec, Tail, NewTail),
+ Result = [Head | NewTail]
).
-:- pred insert_use_module(prog_context::in, item::in,
- item_list::in(list_skel(item_context(use_item))),
- item_list::out(list_skel(item_context(use_item)))) is det.
-
-insert_use_module(Context, Item, [], [item_and_context(Item, Context)]).
-insert_use_module(Context, Item, [Head | Tail], Result) :-
- Head = item_and_context(HeadItem, _HeadContext),
- % The lack of alias tracking prevents the compiler from figuring out
- % that this predicate is only called with values of Item for which
- % this test succeeds.
- ( Item = item_module_defn(_, md_use(list_module([ModulePrime]))) ->
- Module = ModulePrime
- ;
- unexpected(this_file, "insert_import_module: bad item")
- ),
- HeadItem = item_module_defn(_, md_use(list_module([HeadModule]))),
- compare(CompareSymName, Module, HeadModule),
- ( CompareSymName = (<) ->
- Result = [item_and_context(Item, Context), Head | Tail]
- ;
- insert_use_module(Context, Item, Tail, TailResult),
- Result = [Head | TailResult]
- ).
+:- pred insert_type_defn(item_type_defn_info::in,
+ list(item_type_defn_info)::in, list(item_type_defn_info)::out) is det.
-:- pred insert_type_defn(prog_context::in, item::in(type_defn_item),
- item_list::in(list_skel(item_context(type_defn_item))),
- item_list::out(list_skel(item_context(type_defn_item)))) is det.
-
-insert_type_defn(Context, Item, [], [item_and_context(Item, Context)]).
-insert_type_defn(Context, Item, [Head | Tail], Result) :-
- Head = item_and_context(HeadItem, _HeadContext),
- Item = item_type_defn(_, SymName, Params, _, _),
- HeadItem = item_type_defn(_, HeadSymName, HeadParams, _, _),
- compare(CompareSymName, SymName, HeadSymName),
+insert_type_defn(New, [], [New]).
+insert_type_defn(New, [Head | Tail], Result) :-
+ New = item_type_defn_info(_, NewSymName, NewParams, _, _, _),
+ Head = item_type_defn_info(_, HeadSymName, HeadParams, _, _, _),
+ compare(CompareSymName, NewSymName, HeadSymName),
(
(
CompareSymName = (<)
;
CompareSymName = (=),
- list.length(Params, ParamsLength),
+ list.length(NewParams, NewParamsLength),
list.length(HeadParams, HeadParamsLength),
- compare(Compare, ParamsLength, HeadParamsLength),
+ compare(Compare, NewParamsLength, HeadParamsLength),
Compare = (<)
)
->
- Result = [item_and_context(Item, Context), Head | Tail]
+ Result = [New, Head | Tail]
;
- insert_type_defn(Context, Item, Tail, TailResult),
- Result = [Head | TailResult]
+ insert_type_defn(New, Tail, NewTail),
+ Result = [Head | NewTail]
).
:- pred make_impl_type_abstract(type_ctor::in,
- assoc_list(type_defn, item_and_context)::in,
- assoc_list(type_defn, item_and_context)::out) is det.
+ assoc_list(type_defn, item_type_defn_info)::in,
+ assoc_list(type_defn, item_type_defn_info)::out) is det.
make_impl_type_abstract(_TypeCtor, !TypeDefnPairs) :-
(
- !.TypeDefnPairs = [parse_tree_du_type(Ctors, MaybeEqCmp)
- - item_and_context(Item0, Context)],
+ !.TypeDefnPairs =
+ [parse_tree_du_type(Ctors, MaybeEqCmp) - ItemTypeDefn0],
not constructor_list_represents_dummy_argument_type(Ctors, MaybeEqCmp)
->
Defn = parse_tree_abstract_type(non_solver_type),
- ( Item = Item0 ^ td_ctor_defn := Defn ->
- !:TypeDefnPairs = [Defn - item_and_context(Item, Context)]
- ;
- unexpected(this_file,
- "make_impl_type_abstract: item is not a type_defn")
- )
+ ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn := Defn,
+ !:TypeDefnPairs = [Defn - ItemTypeDefn]
;
true
).
@@ -1805,18 +1817,18 @@
% to an import_module or use_module declaration only imports
% a single module. (This should be the case, see prog_io.m.)
%
-:- pred strip_unnecessary_impl_imports(set(module_name)::in, item_list::in,
- item_list::out) is det.
+:- pred strip_unnecessary_impl_imports(set(module_name)::in, list(item)::in,
+ list(item)::out) is det.
strip_unnecessary_impl_imports(NecessaryImports, !Items) :-
- list.filter(is_necessary_impl_import(NecessaryImports), !Items).
+ list.filter(is_not_unnecessary_impl_import(NecessaryImports), !Items).
-:- pred is_necessary_impl_import(set(module_name)::in, item_and_context::in)
+:- pred is_not_unnecessary_impl_import(set(module_name)::in, item::in)
is semidet.
-is_necessary_impl_import(NecessaryImports, ItemAndContext) :-
- ItemAndContext = item_and_context(Item, _),
- ( Item = item_module_defn(_, Defn) ->
+is_not_unnecessary_impl_import(NecessaryImports, Item) :-
+ ( Item = item_module_defn(ItemModuleDefn) ->
+ ItemModuleDefn = item_module_defn_info(_, Defn, _),
(
( Defn = md_use(Module)
; Defn = md_import(Module)
@@ -1825,7 +1837,7 @@
( Module = list_module([ModuleName]) ->
set.member(ModuleName, NecessaryImports)
;
- unexpected(this_file, "is_necessary_impl_import: " ++
+ unexpected(this_file, "is_not_unnecessary_impl_import: " ++
"non-singleton import or use decl")
)
;
@@ -1841,17 +1853,16 @@
% not in NecessaryTypeCtors.
%
:- pred strip_unnecessary_impl_types(set(type_ctor)::in,
- item_list::in, item_list::out) is det.
+ list(item)::in, list(item)::out) is det.
strip_unnecessary_impl_types(NecessaryTypeCtors, !Items) :-
- list.filter(is_necessary_impl_type(NecessaryTypeCtors), !Items).
+ list.filter(is_not_unnecessary_impl_type(NecessaryTypeCtors), !Items).
-:- pred is_necessary_impl_type(set(type_ctor)::in, item_and_context::in)
- is semidet.
+:- pred is_not_unnecessary_impl_type(set(type_ctor)::in, item::in) is semidet.
-is_necessary_impl_type(NecessaryTypeCtors, ItemAndContext) :-
- ItemAndContext = item_and_context(Item, _),
- ( Item = item_type_defn(_, SymName, Params, _, _) ->
+is_not_unnecessary_impl_type(NecessaryTypeCtors, Item) :-
+ ( Item = item_type_defn(ItemTypeDefn) ->
+ ItemTypeDefn = item_type_defn_info(_, SymName, Params, _, _, _),
TypeCtor = type_ctor(SymName, list.length(Params)),
set.member(TypeCtor, NecessaryTypeCtors)
;
@@ -1890,17 +1901,15 @@
set.union(AbsEqvLhsTypeCtors, AbsEqvRhsTypeCtors, EqvTypeCtors).
:- pred accumulate_abs_impl_exported_type_lhs(type_defn_map::in,
- pair(type_ctor, pair(type_defn, item_and_context))::in,
+ pair(type_ctor, pair(type_defn, item_type_defn_info))::in,
set(type_ctor)::in, set(type_ctor)::out,
set(type_ctor)::in, set(type_ctor)::out) is det.
accumulate_abs_impl_exported_type_lhs(InterfaceTypeMap,
- TypeCtor - (TypeDefn - _ItemAndContext), !AbsEqvLhsTypeCtors,
- !DummyTypeCtors) :-
+ TypeCtor - (TypeDefn - _Item), !AbsEqvLhsTypeCtors, !DummyTypeCtors) :-
% A type may have multiple definitions because it may be defined both
% as a foreign type and as a Mercury type. We grab any equivalence types
% that are in there.
- %
(
TypeDefn = parse_tree_eqv_type(_RhsType),
map.search(InterfaceTypeMap, TypeCtor, _)
@@ -1934,7 +1943,7 @@
).
:- pred accumulate_abs_eqv_type_rhs_2(type_defn_map::in,
- pair(type_defn, item_and_context)::in,
+ pair(type_defn, item_type_defn_info)::in,
set(type_ctor)::in, set(type_ctor)::out,
set(module_name)::in, set(module_name)::out) is det.
@@ -2001,85 +2010,104 @@
true
).
-:- type type_defn_map == multi_map(type_ctor,
- pair(type_defn, item_and_context)).
-:- type type_defn_pair == pair(type_ctor, pair(type_defn, item_and_context)).
+:- type type_defn_map ==
+ multi_map(type_ctor, pair(type_defn, item_type_defn_info)).
+:- type type_defn_pair ==
+ pair(type_ctor, pair(type_defn, item_type_defn_info)).
+
+:- pred gather_type_defns(list(item)::in, list(item)::out, list(item)::out,
+ type_defn_map::out, type_defn_map::out) is det.
+
+gather_type_defns(Items0, IntItems, ImplItems, IntTypesMap, ImplTypesMap) :-
+ gather_type_defns_2(no, Items0, [], RevIntItems, [], RevImplItems,
+ map.init, IntTypesMap, map.init, ImplTypesMap),
+ list.reverse(RevIntItems, IntItems),
+ list.reverse(RevImplItems, ImplItems).
-:- pred gather_type_defns(bool::in, item_list::in,
- item_list::in, item_list::out, item_list::in, item_list::out,
+:- pred gather_type_defns_2(bool::in, list(item)::in,
+ list(item)::in, list(item)::out, list(item)::in, list(item)::out,
type_defn_map::in, type_defn_map::out,
type_defn_map::in, type_defn_map::out) is det.
-gather_type_defns(_, [], IntItems, reverse(IntItems),
- ImplItems, reverse(ImplItems), !IntTypes, !ImplTypes).
-gather_type_defns(!.InInterface,
- [item_and_context(Item, Context) | ItemContexts],
- !IntItems, !ImplItems, !IntTypes, !ImplTypes) :-
- ( Item = item_module_defn(_, md_interface) ->
- !:InInterface = yes
- ; Item = item_module_defn(_, md_implementation) ->
- !:InInterface = no
- ; Item = item_type_defn(_, Name, Args, Body, _) ->
+gather_type_defns_2(_, [], !RevIntItems, !RevImplItems,
+ !IntTypesMap, !ImplTypesMap).
+gather_type_defns_2(!.InInterface, [Item | Items],
+ !RevIntItems, !RevImplItems, !IntTypesMap, !ImplTypesMap) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ (
+ ModuleDefn = md_interface,
+ NewInInterface = yes
+ ;
+ ModuleDefn = md_implementation,
+ NewInInterface = no
+ )
+ ->
+ !:InInterface = NewInInterface
+ ;
+ Item = item_type_defn(ItemTypeDefn)
+ ->
+ ItemTypeDefn = item_type_defn_info(_, Name, Args, Body, _, _),
TypeCtor = type_ctor(Name, length(Args)),
(
!.InInterface = yes,
- !:IntItems = [item_and_context(Item, Context) | !.IntItems],
- gather_type_defn(TypeCtor, Body, item_and_context(Item, Context),
- !IntTypes)
+ !:RevIntItems = [Item | !.RevIntItems],
+ gather_type_defn(TypeCtor, Body, ItemTypeDefn, !IntTypesMap)
;
!.InInterface = no,
- % We don't add this to !ImplItems yet --
- % we may be removing this item.
- gather_type_defn(TypeCtor, Body, item_and_context(Item, Context),
- !ImplTypes)
+ % We don't add this to !RevImplItems yet -- we may be removing
+ % this item.
+ gather_type_defn(TypeCtor, Body, ItemTypeDefn, !ImplTypesMap)
)
;
(
!.InInterface = yes,
- !:IntItems = [item_and_context(Item, Context) | !.IntItems]
+ !:RevIntItems = [Item | !.RevIntItems]
;
!.InInterface = no,
- !:ImplItems = [item_and_context(Item, Context) | !.ImplItems]
+ !:RevImplItems = [Item | !.RevImplItems]
)
),
- gather_type_defns(!.InInterface, ItemContexts, !IntItems, !ImplItems,
- !IntTypes, !ImplTypes).
+ gather_type_defns_2(!.InInterface, Items, !RevIntItems, !RevImplItems,
+ !IntTypesMap, !ImplTypesMap).
-:- pred gather_type_defn(type_ctor::in, type_defn::in, item_and_context::in,
+:- pred gather_type_defn(type_ctor::in, type_defn::in, item_type_defn_info::in,
type_defn_map::in, type_defn_map::out) is det.
-gather_type_defn(TypeCtor, Body, Item, DefnMap0, DefnMap) :-
- multi_map.set(DefnMap0, TypeCtor, Body - Item, DefnMap).
+gather_type_defn(TypeCtor, Body, ItemTypeDefn, DefnMap0, DefnMap) :-
+ multi_map.set(DefnMap0, TypeCtor, Body - ItemTypeDefn, DefnMap).
-:- pred get_requirements_of_impl_typeclasses(item_list::in,
+:- pred get_requirements_of_impl_typeclasses(list(item)::in,
set(module_name)::out) is det.
get_requirements_of_impl_typeclasses(ImplItems, Modules) :-
list.foldl(get_requirements_of_impl_typeclass,
ImplItems, set.init, Modules).
-:- pred get_requirements_of_impl_typeclass(item_and_context::in,
+:- pred get_requirements_of_impl_typeclass(item::in,
set(module_name)::in, set(module_name)::out) is det.
-get_requirements_of_impl_typeclass(item_and_context(Item, _), !Modules) :-
+get_requirements_of_impl_typeclass(Item, !Modules) :-
(
- Item = item_typeclass(Constraints, _, _, _, _, _),
+ Item = item_typeclass(ItemTypeClass),
+ Constraints = ItemTypeClass ^ tc_constraints,
list.foldl(get_requirements_of_impl_from_constraint, Constraints,
!Modules)
;
- ( Item = item_clause(_, _, _, _, _, _)
- ; Item = item_type_defn(_, _, _, _, _)
- ; Item = item_inst_defn(_, _, _, _, _)
- ; Item = item_mode_defn(_, _, _, _, _)
- ; Item = item_module_defn(_, _)
- ; Item = item_pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _, _)
- ; Item = item_pred_or_func_mode(_, _, _, _, _, _, _)
- ; Item = item_pragma(_, _)
- ; Item = item_promise(_, _, _, _)
- ; Item = item_instance(_, _, _, _, _, _)
- ; Item = item_initialise(_, _, _)
- ; Item = item_finalise(_, _, _)
- ; Item = item_mutable(_, _, _, _, _, _)
+ ( Item = item_module_defn(_)
+ ; Item = item_clause(_)
+ ; Item = item_type_defn(_)
+ ; Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_pred_decl(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_pragma(_)
+ ; Item = item_promise(_)
+ ; Item = item_instance(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_mutable(_)
; Item = item_nothing(_)
)
).
@@ -2089,7 +2117,7 @@
get_requirements_of_impl_from_constraint(Constraint, !Modules) :-
Constraint = constraint(ClassName, Args),
- % NOTE: this assumes that everything has been module qualified.
+ % NOTE: This assumes that everything has been module qualified.
( sym_name_get_module_name(ClassName, ModuleName) ->
svset.insert(ModuleName, !Modules)
;
@@ -2124,10 +2152,14 @@
),
get_modules_from_constraint_arg_types(Args, !Modules)
;
- ( ArgType = tuple_type(Args, _)
- ; ArgType = apply_n_type(_, Args, _)
- ; ArgType = kinded_type(KindedType, _), Args = [KindedType]
- ; ArgType = higher_order_type(Args0, MaybeRetType, _, _),
+ (
+ ArgType = tuple_type(Args, _)
+ ;
+ ArgType = apply_n_type(_, Args, _)
+ ;
+ ArgType = kinded_type(KindedType, _), Args = [KindedType]
+ ;
+ ArgType = higher_order_type(Args0, MaybeRetType, _, _),
(
MaybeRetType = yes(RetType),
Args = [ RetType | Args0 ]
@@ -2143,19 +2175,18 @@
% defined in the interface of a module.
%
:- pred strip_local_foreign_enum_pragmas(type_defn_map::in,
- item_list::in, item_list::out) is det.
+ list(item)::in, list(item)::out) is det.
strip_local_foreign_enum_pragmas(IntTypeMap, !ImplItems) :-
list.filter(foreign_enum_is_local(IntTypeMap), !ImplItems).
-:- pred foreign_enum_is_local(type_defn_map::in, item_and_context::in)
- is semidet.
+:- pred foreign_enum_is_local(type_defn_map::in, item::in) is semidet.
-foreign_enum_is_local(TypeDefnMap, ItemAndContext) :-
- ItemAndContext = item_and_context(Item, _Context),
+foreign_enum_is_local(TypeDefnMap, Item) :-
(
- Item = item_pragma(_, PragmaItem),
- PragmaItem = pragma_foreign_enum(_Lang, TypeName, TypeArity, _Values)
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ Pragma = pragma_foreign_enum(_Lang, TypeName, TypeArity, _Values)
->
% We only add a pragma foreign_enum pragma to the interface file
% if it corresponds to a type _definition_ in the interface of the
@@ -2169,30 +2200,58 @@
%-----------------------------------------------------------------------------%
-:- pred check_for_clauses_in_interface(item_list::in, item_list::out,
- io::di, io::uo) is det.
+:- pred check_for_clauses_in_interface(list(item)::in, list(item)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_clauses_in_interface([], [], !IO).
-check_for_clauses_in_interface([ItemAndContext0 | Items0], Items, !IO) :-
- ItemAndContext0 = item_and_context(Item0, Context),
+check_for_clauses_in_interface([], [], !Specs).
+check_for_clauses_in_interface([Item0 | Items0], Items, !Specs) :-
(
- Item0 = item_clause(_, _, _, _, _, _)
- ->
- ClauseWarning = [words("Warning: clause in module interface.")],
- report_warning(Context, 0, ClauseWarning, !IO),
- check_for_clauses_in_interface(Items0, Items, !IO)
+ Item0 = item_clause(ItemClause0),
+ Context = ItemClause0 ^ cl_context,
+ Spec = clause_in_interface_warning("clause", Context),
+ !:Specs = [Spec | !.Specs],
+ check_for_clauses_in_interface(Items0, Items, !Specs)
;
- Item0 = item_pragma(_, Pragma),
- pragma_allowed_in_interface(Pragma, no)
- ->
- PragmaWarning = [words("Warning: pragma in module interface.")],
- report_warning(Context, 0, PragmaWarning, !IO),
- check_for_clauses_in_interface(Items0, Items, !IO)
+ Item0 = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, Context),
+ AllowedInInterface = pragma_allowed_in_interface(Pragma),
+ (
+ AllowedInInterface = no,
+ Spec = clause_in_interface_warning("pragma", Context),
+ !:Specs = [Spec | !.Specs],
+ check_for_clauses_in_interface(Items0, Items, !Specs)
;
- Items = [ItemAndContext0 | Items1],
- check_for_clauses_in_interface(Items0, Items1, !IO)
+ AllowedInInterface = yes,
+ check_for_clauses_in_interface(Items0, Items1, !Specs),
+ Items = [Item0 | Items1]
+ )
+ ;
+ ( Item0 = item_module_defn(_)
+ ; Item0 = item_type_defn(_)
+ ; Item0 = item_inst_defn(_)
+ ; Item0 = item_mode_defn(_)
+ ; Item0 = item_pred_decl(_)
+ ; Item0 = item_mode_decl(_)
+ ; Item0 = item_promise(_)
+ ; Item0 = item_typeclass(_)
+ ; Item0 = item_instance(_)
+ ; Item0 = item_initialise(_)
+ ; Item0 = item_finalise(_)
+ ; Item0 = item_mutable(_)
+ ; Item0 = item_nothing(_)
+ ),
+ check_for_clauses_in_interface(Items0, Items1, !Specs),
+ Items = [Item0 | Items1]
).
+:- func clause_in_interface_warning(string, prog_context) = error_spec.
+
+clause_in_interface_warning(ClauseOrPragma, Context) = Spec :-
+ Pieces = [words("Warning:"), words(ClauseOrPragma),
+ words("in module interface.")],
+ Spec = error_spec(severity_warning, phase_term_to_parse_tree,
+ [simple_msg(Context, [always(Pieces)])]).
+
% strip_clauses_from_interface is the same as
% check_for_clauses_in_interface except that it doesn't issue any
% warnings, and that it also strips out the `:- interface' and `:-
@@ -2205,88 +2264,97 @@
% clause, since they should always be grouped together with the clauses
% and should not appear in private interfaces.
%
-:- pred strip_clauses_from_interface(item_list::in, item_list::out) is det.
+:- pred strip_clauses_from_interface(list(item)::in, list(item)::out) is det.
strip_clauses_from_interface(Items0, Items) :-
split_clauses_and_decls(Items0, _Clauses, Items).
-:- pred split_clauses_and_decls(item_list::in,
- item_list::out, item_list::out) is det.
+:- pred split_clauses_and_decls(list(item)::in,
+ list(item)::out, list(item)::out) is det.
split_clauses_and_decls([], [], []).
-split_clauses_and_decls([ItemAndContext0 | Items0],
- ClauseItems, InterfaceItems) :-
- ItemAndContext0 = item_and_context(Item0, _Context),
- (
- ( Item0 = item_module_defn(_, md_interface)
- ; Item0 = item_module_defn(_, md_implementation)
- )
- ->
- split_clauses_and_decls(Items0, ClauseItems, InterfaceItems)
- ;
- (
- Item0 = item_clause(_,_,_,_,_,_)
- ;
- Item0 = item_pragma(_, Pragma),
- pragma_allowed_in_interface(Pragma, no)
- ;
- Item0 = item_initialise(_, _, _)
- ;
- Item0 = item_finalise(_, _, _)
- )
- ->
- split_clauses_and_decls(Items0, ClauseItems1, InterfaceItems),
- ClauseItems = [ItemAndContext0 | ClauseItems1]
- ;
- split_clauses_and_decls(Items0, ClauseItems, InterfaceItems1),
- InterfaceItems = [ItemAndContext0 | InterfaceItems1]
- ).
-
-% pragma `obsolete', `terminates', `does_not_terminate'
-% `termination_info', `check_termination', `reserve_tag' and
-% `foreign_enum' pragma declarations are supposed to go in the
-% interface, but all other pragma declarations are implementation details
-% only, and should go in the implementation.
-
-% XXX we should allow c_header_code;
-% but if we do allow it, we should put it in the generated
-% header file, which currently we don't.
-
-pragma_allowed_in_interface(pragma_foreign_code(_, _), no).
-pragma_allowed_in_interface(pragma_foreign_decl(_, _, _), no).
-pragma_allowed_in_interface(pragma_foreign_export(_, _, _, _, _), no).
-pragma_allowed_in_interface(pragma_foreign_export_enum(_, _, _, _, _), no).
-pragma_allowed_in_interface(pragma_foreign_enum(_, _, _, _), yes).
-pragma_allowed_in_interface(pragma_foreign_import_module(_, _), yes).
-pragma_allowed_in_interface(pragma_foreign_proc(_, _, _, _, _, _, _), no).
-pragma_allowed_in_interface(pragma_inline(_, _), no).
-pragma_allowed_in_interface(pragma_no_inline(_, _), no).
-pragma_allowed_in_interface(pragma_obsolete(_, _), yes).
-pragma_allowed_in_interface(pragma_import(_, _, _, _, _), no).
-pragma_allowed_in_interface(pragma_source_file(_), yes).
- % yes, but the parser will strip out `source_file' pragmas anyway...
-pragma_allowed_in_interface(pragma_fact_table(_, _, _), no).
-pragma_allowed_in_interface(pragma_tabled(_, _, _, _, _, _), no).
- % `reserve_tag' must be in the interface iff the corresponding
- % type definition is in the interface. This is checked in make_hlds.m.
-pragma_allowed_in_interface(pragma_reserve_tag(_, _), yes).
-pragma_allowed_in_interface(pragma_promise_pure(_, _), no).
-pragma_allowed_in_interface(pragma_promise_semipure(_, _), no).
-pragma_allowed_in_interface(pragma_promise_equivalent_clauses(_, _), no).
-pragma_allowed_in_interface(pragma_unused_args(_, _, _, _, _), no).
-pragma_allowed_in_interface(pragma_exceptions(_, _, _, _, _), no).
-pragma_allowed_in_interface(pragma_trailing_info(_, _, _, _, _), no).
-pragma_allowed_in_interface(pragma_mm_tabling_info(_, _, _, _, _), no).
-pragma_allowed_in_interface(pragma_type_spec(_, _, _, _, _, _, _, _), yes).
-pragma_allowed_in_interface(pragma_termination_info(_, _, _, _, _), yes).
-pragma_allowed_in_interface(pragma_termination2_info(_,_, _, _, _, _), yes).
-pragma_allowed_in_interface(pragma_terminates(_, _), yes).
-pragma_allowed_in_interface(pragma_does_not_terminate(_, _), yes).
-pragma_allowed_in_interface(pragma_check_termination(_, _), yes).
-pragma_allowed_in_interface(pragma_structure_sharing(_, _, _, _, _, _), yes).
-pragma_allowed_in_interface(pragma_structure_reuse(_, _, _, _, _, _), yes).
-pragma_allowed_in_interface(pragma_mode_check_clauses(_, _), yes).
-pragma_allowed_in_interface(pragma_require_feature_set(_), no).
+split_clauses_and_decls([Item | Items], !:ClauseItems, !:InterfaceItems) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ( ModuleDefn = md_interface
+ ; ModuleDefn = md_implementation
+ )
+ ->
+ split_clauses_and_decls(Items, !:ClauseItems, !:InterfaceItems)
+ ;
+ (
+ Item = item_clause(_)
+ ;
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ pragma_allowed_in_interface(Pragma) = no
+ ;
+ Item = item_initialise(_)
+ ;
+ Item = item_finalise(_)
+ )
+ ->
+ split_clauses_and_decls(Items, !:ClauseItems, !:InterfaceItems),
+ !:ClauseItems = [Item | !.ClauseItems]
+ ;
+ split_clauses_and_decls(Items, !:ClauseItems, !:InterfaceItems),
+ !:InterfaceItems = [Item | !.InterfaceItems]
+ ).
+
+pragma_allowed_in_interface(Pragma) = Allowed :-
+ % XXX This comment is out of date.
+ % pragma `obsolete', `terminates', `does_not_terminate'
+ % `termination_info', `check_termination', `reserve_tag' and
+ % `foreign_enum' pragma declarations are supposed to go in the
+ % interface, but all other pragma declarations are implementation details
+ % only, and should go in the implementation.
+
+ % XXX we should allow c_header_code;
+ % but if we do allow it, we should put it in the generated
+ % header file, which currently we don't.
+ (
+ ( Pragma = pragma_foreign_code(_, _)
+ ; Pragma = pragma_foreign_decl(_, _, _)
+ ; Pragma = pragma_foreign_export(_, _, _, _, _)
+ ; Pragma = pragma_foreign_export_enum(_, _, _, _, _)
+ ; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _)
+ ; Pragma = pragma_inline(_, _)
+ ; Pragma = pragma_no_inline(_, _)
+ ; Pragma = pragma_import(_, _, _, _, _)
+ ; Pragma = pragma_fact_table(_, _, _)
+ ; Pragma = pragma_tabled(_, _, _, _, _, _)
+ ; Pragma = pragma_promise_pure(_, _)
+ ; Pragma = pragma_promise_semipure(_, _)
+ ; Pragma = pragma_promise_equivalent_clauses(_, _)
+ ; Pragma = pragma_unused_args(_, _, _, _, _)
+ ; Pragma = pragma_exceptions(_, _, _, _, _)
+ ; Pragma = pragma_trailing_info(_, _, _, _, _)
+ ; Pragma = pragma_mm_tabling_info(_, _, _, _, _)
+ ; Pragma = pragma_require_feature_set(_)
+ ),
+ Allowed = no
+ ;
+ % Note that the parser will strip out `source_file' pragmas anyway,
+ % and that `reserve_tag' must be in the interface iff the corresponding
+ % type definition is in the interface. This is checked in make_hlds.
+ ( Pragma = pragma_foreign_enum(_, _, _, _)
+ ; Pragma = pragma_foreign_import_module(_, _)
+ ; Pragma = pragma_obsolete(_, _)
+ ; Pragma = pragma_source_file(_)
+ ; Pragma = pragma_reserve_tag(_, _)
+ ; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _)
+ ; Pragma = pragma_termination_info(_, _, _, _, _)
+ ; Pragma = pragma_termination2_info(_,_, _, _, _, _)
+ ; Pragma = pragma_terminates(_, _)
+ ; Pragma = pragma_does_not_terminate(_, _)
+ ; Pragma = pragma_check_termination(_, _)
+ ; Pragma = pragma_structure_sharing(_, _, _, _, _, _)
+ ; Pragma = pragma_structure_reuse(_, _, _, _, _, _)
+ ; Pragma = pragma_mode_check_clauses(_, _)
+ ),
+ Allowed = yes
+ ).
check_for_no_exports(Items, ModuleName, !IO) :-
globals.io_lookup_bool_option(warn_nothing_exported, ExportWarning, !IO),
@@ -2302,25 +2370,28 @@
% interface, this procedure checks if the module doesn't export
% anything, and if so, and --warn-nothing-exported is set, it reports
% a warning.
-:- pred check_int_for_no_exports(item_list::in, module_name::in,
+ %
+ % XXX Should return an error spec.
+ %
+:- pred check_int_for_no_exports(list(item)::in, module_name::in,
io::di, io::uo) is det.
check_int_for_no_exports([], ModuleName, !IO) :-
warn_no_exports(ModuleName, !IO).
-check_int_for_no_exports([item_and_context(Item, _Context) | ItemAndContexts],
- ModuleName, !IO) :-
+check_int_for_no_exports([Item | Items], ModuleName, !IO) :-
(
(
Item = item_nothing(_)
;
- Item = item_module_defn(_, ModuleDefn),
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
ModuleDefn \= md_include_module(_)
)
->
- % nothing useful - keep searching
- check_int_for_no_exports(ItemAndContexts, ModuleName, !IO)
+ % Nothing useful - keep searching.
+ check_int_for_no_exports(Items, ModuleName, !IO)
;
- % we found something useful - don't issue the warning
+ % We found something useful - don't issue the warning.
true
).
@@ -2353,23 +2424,19 @@
%-----------------------------------------------------------------------------%
:- pred write_interface_file(file_name::in, module_name::in, string::in,
- maybe(timestamp)::in, item_list::in, io::di, io::uo) is det.
+ maybe(timestamp)::in, list(item)::in, io::di, io::uo) is det.
write_interface_file(_SourceFileName, ModuleName, Suffix, MaybeTimestamp,
- InterfaceItemAndContexts0, !IO) :-
-
+ InterfaceItems0, !IO) :-
% Create (e.g.) `foo.int.tmp'.
string.append(Suffix, ".tmp", TmpSuffix),
module_name_to_file_name(ModuleName, Suffix, yes, OutputFileName, !IO),
module_name_to_file_name(ModuleName, TmpSuffix, no, TmpOutputFileName,
!IO),
-
globals.io_lookup_bool_option(line_numbers, LineNumbers, !IO),
globals.io_set_option(line_numbers, bool(no), !IO),
-
globals.io_lookup_bool_option(generate_item_version_numbers,
GenerateVersionNumbers, !IO),
-
(
GenerateVersionNumbers = yes,
% Find the timestamp of the current module.
@@ -2379,33 +2446,32 @@
% Read in the previous version of the file.
read_mod_ignore_errors(ModuleName, Suffix,
"Reading old interface for module", yes, no,
- OldItemAndContexts, OldError, _OldIntFileName, _OldTimestamp,
- !IO),
+ OldItems, OldError, _OldIntFileName, _OldTimestamp, !IO),
( OldError = no_module_errors ->
- MaybeOldItemAndContexts = yes(OldItemAndContexts)
+ MaybeOldItems = yes(OldItems)
;
% If we can't read in the old file, the timestamps will
% all be set to the modification time of the source file.
- MaybeOldItemAndContexts = no
+ MaybeOldItems = no
),
recompilation.version.compute_version_numbers(Timestamp,
- InterfaceItemAndContexts0, MaybeOldItemAndContexts,
- VersionNumbers),
- VersionNumberItem = item_module_defn(varset.init,
- md_version_numbers(ModuleName, VersionNumbers)),
- VersionNumberItemAndContext =
- item_and_context(VersionNumberItem, term.context_init),
- (
- InterfaceItemAndContexts0 = [FirstItemAndContext |
- InterfaceItemAndContexts1],
- FirstItemAndContext =
- item_and_context(item_module_defn(_, md_interface), _)
+ InterfaceItems0, MaybeOldItems, VersionNumbers),
+ VersionNumberItemModuleDefn = item_module_defn_info(varset.init,
+ md_version_numbers(ModuleName, VersionNumbers),
+ term.context_init),
+ VersionNumberItem = item_module_defn(VersionNumberItemModuleDefn),
+ (
+ InterfaceItems0 = [FirstItem | InterfaceItems1],
+ FirstItem = item_module_defn(FirstItemModuleDefn),
+ FirstItemModuleDefn =
+ item_module_defn_info(_, FirstModuleDefn, _),
+ FirstModuleDefn = md_interface
->
- InterfaceItemAndContexts = [FirstItemAndContext,
- VersionNumberItemAndContext | InterfaceItemAndContexts1]
+ InterfaceItems = [FirstItem, VersionNumberItem
+ | InterfaceItems1]
;
- InterfaceItemAndContexts = [make_pseudo_decl(md_interface),
- VersionNumberItemAndContext | InterfaceItemAndContexts0]
+ InterfaceItems = [make_pseudo_decl(md_interface),
+ VersionNumberItem | InterfaceItems0]
)
;
MaybeTimestamp = no,
@@ -2414,10 +2480,9 @@
)
;
GenerateVersionNumbers = no,
- InterfaceItemAndContexts = InterfaceItemAndContexts0
+ InterfaceItems = InterfaceItems0
),
- convert_to_mercury(ModuleName, TmpOutputFileName, InterfaceItemAndContexts,
- !IO),
+ convert_to_mercury(ModuleName, TmpOutputFileName, InterfaceItems, !IO),
globals.io_set_option(line_numbers, bool(LineNumbers), !IO),
update_interface(OutputFileName, !IO).
@@ -2860,7 +2925,7 @@
).
:- pred init_module_imports(file_name::in, module_name::in, module_name::in,
- item_list::in, list(module_name)::in, list(module_name)::in,
+ list(item)::in, list(module_name)::in, list(module_name)::in,
list(string)::in, maybe(module_timestamps)::in, module_imports::out)
is det.
@@ -2892,16 +2957,17 @@
list.append(Items0, [make_pseudo_decl(PseudoDecl)], Items),
Module = Module0 ^ items := Items.
-make_pseudo_decl(PseudoDecl) =
- item_and_context(item_module_defn(varset.init, PseudoDecl),
- term.context_init).
+make_pseudo_decl(PseudoDecl) = Item :-
+ ItemModuleDefn = item_module_defn_info(varset.init, PseudoDecl,
+ term.context_init),
+ Item = item_module_defn(ItemModuleDefn).
%-----------------------------------------------------------------------------%
get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps) :-
add_implicit_imports(Items, Globals, [], ImportDeps, [], UseDeps).
-:- pred add_implicit_imports(item_list::in, globals::in,
+:- pred add_implicit_imports(list(item)::in, globals::in,
list(module_name)::in, list(module_name)::out,
list(module_name)::in, list(module_name)::out) is det.
@@ -2985,29 +3051,28 @@
SSDB = no
).
-:- pred contains_tabling_pragma(item_list::in, table_attr_statistics::out)
+:- pred contains_tabling_pragma(list(item)::in, table_attr_statistics::out)
is semidet.
-contains_tabling_pragma(ItemAndContexts, HasStats) :-
- contains_tabling_pragma_2(ItemAndContexts, no, HasTabling,
+contains_tabling_pragma(Items, HasStats) :-
+ contains_tabling_pragma_2(Items, no, HasTabling,
table_dont_gather_statistics, HasStats),
HasTabling = yes.
-:- pred contains_tabling_pragma_2(item_list::in, bool::in, bool::out,
+:- pred contains_tabling_pragma_2(list(item)::in, bool::in, bool::out,
table_attr_statistics::in, table_attr_statistics::out) is det.
contains_tabling_pragma_2([], !HasTabling, !HasStats).
-contains_tabling_pragma_2([ItemAndContext | ItemAndContexts],
- !HasTabling, !HasStats) :-
- ItemAndContext = item_and_context(Item, _Context),
+contains_tabling_pragma_2([Item | Items], !HasTabling, !HasStats) :-
(
- Item = item_pragma(_, Pragma),
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
Pragma = pragma_tabled(_, _, _, _, _, MaybeAttributes)
->
!:HasTabling = yes,
(
MaybeAttributes = no,
- contains_tabling_pragma_2(ItemAndContexts, !HasTabling, !HasStats)
+ contains_tabling_pragma_2(Items, !HasTabling, !HasStats)
;
MaybeAttributes = yes(Attributes),
StatsAttr = Attributes ^ table_attr_statistics,
@@ -3018,12 +3083,11 @@
;
StatsAttr = table_dont_gather_statistics,
% Leave !HasStats as it is.
- contains_tabling_pragma_2(ItemAndContexts,
- !HasTabling, !HasStats)
+ contains_tabling_pragma_2(Items, !HasTabling, !HasStats)
)
)
;
- contains_tabling_pragma_2(ItemAndContexts, !HasTabling, !HasStats)
+ contains_tabling_pragma_2(Items, !HasTabling, !HasStats)
).
% Warn if a module imports itself, or an ancestor.
@@ -6075,7 +6139,7 @@
module_contains_foreign_export :: contains_foreign_export
).
-:- pred get_item_list_foreign_code(globals::in, item_list::in,
+:- pred get_item_list_foreign_code(globals::in, list(item)::in,
set(foreign_language)::out, foreign_import_module_info_list::out,
contains_foreign_export::out) is det.
@@ -6088,13 +6152,14 @@
ForeignProcLangs = map.values(LangMap),
LangSet = set.insert_list(LangSet0, ForeignProcLangs).
-:- pred get_item_foreign_code(globals::in, item_and_context::in,
+:- pred get_item_foreign_code(globals::in, item::in,
module_foreign_info::in, module_foreign_info::out) is det.
-get_item_foreign_code(Globals, item_and_context(Item, Context), !Info) :-
- ( Item = item_pragma(_, Pragma) ->
+get_item_foreign_code(Globals, Item, !Info) :-
+ ( Item = item_pragma(ItemPragma) ->
+ ItemPragma = item_pragma_info(_, Pragma, Context),
do_get_item_foreign_code(Globals, Pragma, Context, !Info)
- ; Item = item_mutable(_, _, _, _, _, _) ->
+ ; Item = item_mutable(_) ->
% Mutables introduce foreign_procs, but mutable declarations
% won't have been expanded by the time we get here so we need
% to handle them separately.
@@ -6103,7 +6168,7 @@
% (See do_get_item_foreign_code for details/5).
!:Info = !.Info ^ used_foreign_languages :=
set.insert(!.Info ^ used_foreign_languages, lang_c)
- ; ( Item = item_initialise(_, _, _) ; Item = item_finalise(_, _, _) ) ->
+ ; ( Item = item_initialise(_) ; Item = item_finalise(_) ) ->
% Intialise/finalise declarations introduce export pragmas, but
% again they won't have been expanded by the time we get here.
% XXX we don't currently support these on non-C backends.
@@ -6407,22 +6472,21 @@
read_dependencies(ModuleName, Search, ModuleImportsList, !IO) :-
read_mod_ignore_errors(ModuleName, ".m",
- "Getting dependencies for module", Search, no, ItemAndContexts0, Error,
+ "Getting dependencies for module", Search, no, Items0, Error,
FileName0, _, !IO),
globals.io_get_globals(Globals, !IO),
(
- ItemAndContexts0 = [],
+ Items0 = [],
Error = fatal_module_errors
->
read_mod_ignore_errors(ModuleName, ".int",
"Getting dependencies for module interface", Search,
- no, ItemAndContexts, _Error, FileName, _, !IO),
- SubModuleList = [ModuleName - ItemAndContexts]
+ no, Items, _Error, FileName, _, !IO),
+ SubModuleList = [ModuleName - Items]
;
FileName = FileName0,
- ItemAndContexts = ItemAndContexts0,
- split_into_submodules(ModuleName, ItemAndContexts, SubModuleList,
- [], Specs),
+ Items = Items0,
+ split_into_submodules(ModuleName, Items, SubModuleList, [], Specs),
sort_error_specs(Specs, SortedSpecs),
write_error_specs(SortedSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
!IO)
@@ -6432,19 +6496,19 @@
Error, Globals), SubModuleList, ModuleImportsList).
init_dependencies(FileName, SourceFileModuleName, NestedModuleNames,
- Error, Globals, ModuleName - ItemAndContexts, ModuleImports) :-
+ Error, Globals, ModuleName - Items, ModuleImports) :-
ParentDeps = get_ancestors(ModuleName),
- get_dependencies(ItemAndContexts, ImplImportDeps0, ImplUseDeps0),
- add_implicit_imports(ItemAndContexts, Globals,
+ get_dependencies(Items, ImplImportDeps0, ImplUseDeps0),
+ add_implicit_imports(Items, Globals,
ImplImportDeps0, ImplImportDeps,
ImplUseDeps0, ImplUseDeps),
list.append(ImplImportDeps, ImplUseDeps, ImplementationDeps),
- get_interface(ModuleName, no, ItemAndContexts, InterfaceItemAndContexts),
- get_dependencies(InterfaceItemAndContexts,
+ get_interface(ModuleName, no, Items, InterfaceItems),
+ get_dependencies(InterfaceItems,
InterfaceImportDeps0, InterfaceUseDeps0),
- add_implicit_imports(InterfaceItemAndContexts, Globals,
+ add_implicit_imports(InterfaceItems, Globals,
InterfaceImportDeps0, InterfaceImportDeps,
InterfaceUseDeps0, InterfaceUseDeps),
list.append(InterfaceImportDeps, InterfaceUseDeps, InterfaceDeps),
@@ -6452,8 +6516,8 @@
% We don't fill in the indirect dependencies yet.
IndirectDeps = [],
- get_children(ItemAndContexts, IncludeDeps),
- get_children(InterfaceItemAndContexts, InterfaceIncludeDeps),
+ get_children(Items, IncludeDeps),
+ get_children(InterfaceItems, InterfaceIncludeDeps),
( ModuleName = SourceFileModuleName ->
list.delete_all(NestedModuleNames, ModuleName, NestedDeps)
@@ -6461,10 +6525,10 @@
NestedDeps = []
),
- get_fact_table_dependencies(ItemAndContexts, FactTableDeps),
+ get_fact_table_dependencies(Items, FactTableDeps),
% Figure out whether the items contain foreign code.
- get_item_list_foreign_code(Globals, ItemAndContexts, LangSet,
+ get_item_list_foreign_code(Globals, Items, LangSet,
ForeignImports0, ContainsPragmaExport),
( set.empty(LangSet) ->
ContainsForeignCode = no_foreign_code
@@ -6475,7 +6539,7 @@
% If this module contains `:- pragma foreign_export' or
% `:- pragma foreign_type' declarations, importing modules
% may need to import its `.mh' file.
- get_foreign_self_imports(ItemAndContexts, SelfImportLangs),
+ get_foreign_self_imports(Items, SelfImportLangs),
ForeignSelfImports = list.map(
(func(Lang) = foreign_import_module_info(Lang, ModuleName,
term.context_init)),
@@ -6484,10 +6548,10 @@
% Work out whether the items contain main/2.
(
- list.member(ItemAndContext, ItemAndContexts),
- ItemAndContext = item_and_context(Item, _),
- Item = item_pred_or_func(_, _, _, _, pf_predicate, Name, [_, _],
- WithType, _, _, _, _, _),
+ list.member(Item, Items),
+ Item = item_pred_decl(ItemPredDecl),
+ ItemPredDecl = item_pred_decl_info(_, _, _, _, pf_predicate, Name,
+ [_, _], WithType, _, _, _, _, _, _),
unqualify_name(Name) = "main",
% XXX We should allow `main/2' to be declared using
@@ -6517,7 +6581,7 @@
%-----------------------------------------------------------------------------%
:- pred read_mod(read_modules::in, module_name::in, string::in, string::in,
- bool::in, bool::in, item_list::out, module_error::out, file_name::out,
+ bool::in, bool::in, list(item)::out, module_error::out, file_name::out,
maybe(timestamp)::out, io::di, io::uo) is det.
read_mod(ReadModules, ModuleName, Extension, Descr, Search, ReturnTimestamp,
@@ -6552,7 +6616,7 @@
no, ReturnTimestamp, Items, Error, FileName, MaybeTimestamp, !IO).
:- pred read_mod_2(bool::in, module_name::in, string::in, string::in,
- bool::in, maybe(timestamp)::in, bool::in, item_list::out,
+ bool::in, maybe(timestamp)::in, bool::in, list(item)::out,
module_error::out, file_name::out, maybe(timestamp)::out,
io::di, io::uo) is det.
@@ -6841,7 +6905,7 @@
% checking that each one is accessible.
%
:- pred check_imports_accessibility(module_name::in, list(module_name)::in,
- item_list::in, list(error_spec)::in, list(error_spec)::out) is det.
+ list(item)::in, list(error_spec)::in, list(error_spec)::out) is det.
check_imports_accessibility(ModuleName, Imports, Items, !Specs) :-
get_accessible_children(Items, AccessibleSubModules),
@@ -6849,54 +6913,57 @@
AccessibleSubModules, Items), Imports, !Specs).
:- pred check_module_accessibility(module_name::in, list(module_name)::in,
- item_list::in, module_name::in,
+ list(item)::in, module_name::in,
list(error_spec)::in, list(error_spec)::out) is det.
-check_module_accessibility(ModuleName, AccessibleSubModules, ItemAndContexts,
+check_module_accessibility(ModuleName, AccessibleSubModules, Items,
ImportedModule, !Specs) :-
( ImportedModule = qualified(ParentModule, SubModule) ->
( list.member(ImportedModule, AccessibleSubModules) ->
true
;
- % The user attempted to import an inaccessible
- % sub-module, so report an error.
- % Unfortunately we didn't get passed the
- % context of the `import_module' or `use_module'
- % declaration(s), so we need to search the item
- % list again to find them.
- FindImports = (pred(ItemAndContext::in) is semidet :-
- ItemAndContext = item_and_context(Item, _),
- Item = item_module_defn(_, ModuleDefn),
- ( ModuleDefn = md_import(list_module(Mods))
- ; ModuleDefn = md_use(list_module(Mods))
+ % The user attempted to import an inaccessible submodule,
+ % so report an error. Unfortunately we didn't get passed the
+ % context(s) of the `import_module' or `use_module' declaration(s),
+ % so we need to search the item list again to find them.
+ FindImports = (pred(Item::in, ImportInfo::out) is semidet :-
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, Context),
+ (
+ ModuleDefn = md_import(list_module(Mods)),
+ DeclName = "import_module"
+ ;
+ ModuleDefn = md_use(list_module(Mods)),
+ DeclName = "use_module"
),
- list.member(ImportedModule, Mods)
+ list.member(ImportedModule, Mods),
+ ImportInfo = DeclName - Context
),
- list.filter(FindImports, ItemAndContexts, ImportItemAndContexts),
+ list.filter_map(FindImports, Items, ImportInfos),
(
- ImportItemAndContexts = [],
+ ImportInfos = [],
unexpected(this_file, "check_parent_module")
;
- ImportItemAndContexts = [_ | _]
- ),
+ ImportInfos = [_ | _],
list.foldl(
- report_inaccessible_module_error(
- ModuleName, ParentModule, SubModule),
- ImportItemAndContexts, !Specs)
+ report_inaccessible_module_error(ModuleName,
+ ParentModule, SubModule),
+ ImportInfos, !Specs)
+ )
)
;
true
).
:- pred report_inaccessible_module_error(module_name::in, module_name::in,
- string::in, item_and_context::in,
+ string::in, pair(string, prog_context)::in,
list(error_spec)::in, list(error_spec)::out) is det.
% The error message should come out like this
% (the second sentence is included only with --verbose-errors):
% very_long_name.m:123: In module `very_long_name':
% very_long_name.m:123: error in `import_module' declaration:
-% very_long_name.m:123: module `parent_module:sub_module' is inaccessible.
+% very_long_name.m:123: module `parent_module.sub_module' is inaccessible.
% very_long_name.m:123: Either there was no prior `import_module' or
% very_long_name.m:123: `use_module' declaration to import module
% very_long_name.m:123: `parent_module', or the interface for module
@@ -6904,15 +6971,7 @@
% very_long_name.m:123: declaration for module `sub_module'.
report_inaccessible_module_error(ModuleName, ParentModule, SubModule,
- item_and_context(Item, Context), !Specs) :-
- ( Item = item_module_defn(_, md_import(list_module(_))) ->
- DeclName = "import_module"
- ; Item = item_module_defn(_, md_use(list_module(_))) ->
- DeclName = "use_module"
- ;
- unexpected(this_file,
- "report_inaccessible_parent_error: invalid item")
- ),
+ DeclName - Context, !Specs) :-
MainPieces = [words("In module"), sym_name(ModuleName), suffix(":"), nl,
words("error in"), quote(DeclName), words("declaration:"), nl,
words("module"), sym_name(qualified(ParentModule, SubModule)),
@@ -7009,30 +7068,26 @@
!ImpIndirectImports, !Module, !IO)
).
-replace_section_decls(IntStatusItemAndContext, ImpStatusItemAndContext,
- !ItemAndContexts) :-
- list.map(
- replace_section_decl(IntStatusItemAndContext, ImpStatusItemAndContext),
- !ItemAndContexts).
+replace_section_decls(IntStatusItem, ImpStatusItem, !Items) :-
+ list.map(replace_section_decl(IntStatusItem, ImpStatusItem), !Items).
-:- pred replace_section_decl(item_and_context::in, item_and_context::in,
- item_and_context::in, item_and_context::out) is det.
+:- pred replace_section_decl(item::in, item::in, item::in, item::out) is det.
-replace_section_decl(IntStatusItemAndContext, ImpStatusItemAndContext,
- ItemAndContext0, ItemAndContext) :-
+replace_section_decl(IntStatusItem, ImpStatusItem, Item0, Item) :-
(
- ItemAndContext0 = item_and_context(item_module_defn(_, Defn), _),
+ Item0 = item_module_defn(ItemModuleDefn0),
+ ItemModuleDefn0 = item_module_defn_info(_, Defn0, _),
(
- Defn = md_interface,
- ItemAndContextPrime = IntStatusItemAndContext
+ Defn0 = md_interface,
+ ItemPrime = IntStatusItem
;
- Defn = md_implementation,
- ItemAndContextPrime = ImpStatusItemAndContext
+ Defn0 = md_implementation,
+ ItemPrime = ImpStatusItem
)
->
- ItemAndContext = ItemAndContextPrime
+ Item = ItemPrime
;
- ItemAndContext = ItemAndContext0
+ Item = Item0
).
:- pred maybe_add_int_error(module_error::in, module_error::in,
@@ -7062,69 +7117,81 @@
% IncludeDeps is the list of sub-modules declared with `:- include_module'
% in Items.
%
-:- pred get_children(item_list::in, list(module_name)::out) is det.
+:- pred get_children(list(item)::in, list(module_name)::out) is det.
get_children(Items, IncludeDeps) :-
get_children_2(Items, [], IncludeDeps).
-:- pred get_children_2(item_list::in, list(module_name)::in,
- list(module_name)::out) is det.
+:- pred get_children_2(list(item)::in,
+ list(module_name)::in, list(module_name)::out) is det.
-get_children_2([], IncludeDeps, IncludeDeps).
-get_children_2([ItemAndContext | ItemAndContexts],
- IncludeDeps0, IncludeDeps) :-
- ItemAndContext = item_and_context(Item, _),
- ( Item = item_module_defn(_VarSet, md_include_module(Modules)) ->
- IncludeDeps1 = IncludeDeps0 ++ Modules
+get_children_2([], !IncludeDeps).
+get_children_2([Item | Items], !IncludeDeps) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ModuleDefn = md_include_module(Modules)
+ ->
+ !:IncludeDeps = !.IncludeDeps ++ Modules
;
- IncludeDeps1 = IncludeDeps0
+ true
),
- get_children_2(ItemAndContexts, IncludeDeps1, IncludeDeps).
+ get_children_2(Items, !IncludeDeps).
% get_accessible_children(Items, IncludeDeps):
%
% IncludeDeps is the list of sub-modules declared with `:- include_module'
% in Items which are visible in the current module.
%
-:- pred get_accessible_children(item_list::in, list(module_name)::out) is det.
+:- pred get_accessible_children(list(item)::in, list(module_name)::out) is det.
get_accessible_children(Items, IncludeDeps) :-
get_accessible_children_2(yes, Items, [], IncludeDeps).
-:- pred get_accessible_children_2(bool::in, item_list::in,
+:- pred get_accessible_children_2(bool::in, list(item)::in,
list(module_name)::in, list(module_name)::out) is det.
get_accessible_children_2(_, [], !IncludeDeps).
-get_accessible_children_2(!.Visible, [ItemAndContext | ItemAndContexts],
- !IncludeDeps) :-
- ItemAndContext = item_and_context(Item, _),
- (
- Item = item_module_defn(_VarSet, Defn),
- ( Defn = md_abstract_imported
- ; Defn = md_opt_imported
- ; Defn = md_transitively_imported
- )
- ->
+get_accessible_children_2(!.Visible, [Item | Items], !IncludeDeps) :-
+ ( Item = item_module_defn(ItemModuleDefn) ->
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ (
+ ( ModuleDefn = md_abstract_imported
+ ; ModuleDefn = md_opt_imported
+ ; ModuleDefn = md_transitively_imported
+ ),
!:Visible = no
;
- Item = item_module_defn(_VarSet, Defn),
- ( Defn = md_imported(_)
- ; Defn = md_used(_)
- ; Defn = md_interface
- ; Defn = md_implementation
- ; Defn = md_private_interface
- )
- ->
+ ( ModuleDefn = md_imported(_)
+ ; ModuleDefn = md_used(_)
+ ; ModuleDefn = md_interface
+ ; ModuleDefn = md_implementation
+ ; ModuleDefn = md_private_interface
+ ),
!:Visible = yes
;
- Item = item_module_defn(_VarSet, md_include_module(Modules)),
- !.Visible = yes
- ->
+ ModuleDefn = md_include_module(Modules),
+ (
+ !.Visible = yes,
!:IncludeDeps = !.IncludeDeps ++ Modules
;
+ !.Visible = no
+ )
+ ;
+ ( ModuleDefn = md_module(_)
+ ; ModuleDefn = md_end_module(_)
+ ; ModuleDefn = md_external(_, _)
+ ; ModuleDefn = md_export(_)
+ ; ModuleDefn = md_import(_)
+ ; ModuleDefn = md_use(_)
+ ; ModuleDefn = md_version_numbers(_, _)
+ )
+ % Do nothing.
+ )
+ ;
true
),
- get_accessible_children_2(!.Visible, ItemAndContexts, !IncludeDeps).
+ get_accessible_children_2(!.Visible, Items, !IncludeDeps).
%-----------------------------------------------------------------------------%
@@ -7155,7 +7222,7 @@
% and the first `:- interface' or `:- implementation' are in the
% implementation.
%
-:- pred get_dependencies(item_list::in,
+:- pred get_dependencies(list(item)::in,
list(module_name)::out, list(module_name)::out,
list(module_name)::out, list(module_name)::out) is det.
@@ -7164,7 +7231,7 @@
get_dependencies_implementation(Items,
[], IntImportDeps, [], IntUseDeps, [], ImpImportDeps, [], ImpUseDeps).
-:- pred get_dependencies_implementation(item_list::in,
+:- pred get_dependencies_implementation(list(item)::in,
list(module_name)::in, list(module_name)::out,
list(module_name)::in, list(module_name)::out,
list(module_name)::in, list(module_name)::out,
@@ -7172,25 +7239,30 @@
get_dependencies_implementation([],
!IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps).
-get_dependencies_implementation([ItemAndContext | ItemAndContexts],
+get_dependencies_implementation([Item | Items],
!IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps) :-
- ItemAndContext = item_and_context(Item, _Context),
- ( Item = item_module_defn(_VarSet, md_interface) ->
- get_dependencies_interface(ItemAndContexts,
+ ( Item = item_module_defn(ItemModuleDefn) ->
+ ItemModuleDefn = item_module_defn_info(_VarSet, ModuleDefn, _),
+ ( ModuleDefn = md_interface ->
+ get_dependencies_interface(Items,
!IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps)
;
- ( Item = item_module_defn(_VarSet, md_import(list_module(Modules))) ->
+ ( ModuleDefn = md_import(list_module(Modules)) ->
!:ImpImportDeps = !.ImpImportDeps ++ Modules
- ; Item = item_module_defn(_VarSet, md_use(list_module(Modules))) ->
+ ; ModuleDefn = md_use(list_module(Modules)) ->
!:ImpUseDeps = !.ImpUseDeps ++ Modules
;
true
),
- get_dependencies_implementation(ItemAndContexts,
+ get_dependencies_implementation(Items,
+ !IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps)
+ )
+ ;
+ get_dependencies_implementation(Items,
!IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps)
).
-:- pred get_dependencies_interface(item_list::in,
+:- pred get_dependencies_interface(list(item)::in,
list(module_name)::in, list(module_name)::out,
list(module_name)::in, list(module_name)::out,
list(module_name)::in, list(module_name)::out,
@@ -7198,66 +7270,77 @@
get_dependencies_interface([],
!IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps).
-get_dependencies_interface([ItemAndContext | ItemAndContexts],
+get_dependencies_interface([Item | Items],
!IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps) :-
- ItemAndContext = item_and_context(Item, _Context),
- ( Item = item_module_defn(_VarSet, md_implementation) ->
- get_dependencies_implementation(ItemAndContexts,
+ ( Item = item_module_defn(ItemModuleDefn) ->
+ ItemModuleDefn = item_module_defn_info(_VarSet, ModuleDefn, _),
+ ( ModuleDefn = md_implementation ->
+ get_dependencies_implementation(Items,
!IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps)
;
- ( Item = item_module_defn(_VarSet, md_import(list_module(Modules))) ->
+ ( ModuleDefn = md_import(list_module(Modules)) ->
!:IntImportDeps = !.IntImportDeps ++ Modules
- ; Item = item_module_defn(_VarSet, md_use(list_module(Modules))) ->
+ ; ModuleDefn = md_use(list_module(Modules)) ->
!:IntUseDeps = !.IntUseDeps ++ Modules
;
true
),
- get_dependencies_interface(ItemAndContexts,
+ get_dependencies_interface(Items,
+ !IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps)
+ )
+ ;
+ get_dependencies_interface(Items,
!IntImportDeps, !IntUseDeps, !ImpImportDeps, !ImpUseDeps)
).
%-----------------------------------------------------------------------------%
- % get the fact table dependencies for a module
-:- pred get_fact_table_dependencies(item_list::in, list(string)::out) is det.
+ % Get the fact table dependencies for a module.
+ %
+:- pred get_fact_table_dependencies(list(item)::in, list(string)::out) is det.
get_fact_table_dependencies(Items, Deps) :-
get_fact_table_dependencies_2(Items, [], Deps).
-:- pred get_fact_table_dependencies_2(item_list::in, list(string)::in,
+:- pred get_fact_table_dependencies_2(list(item)::in, list(string)::in,
list(string)::out) is det.
get_fact_table_dependencies_2([], !Deps).
-get_fact_table_dependencies_2([ItemAndContext | ItemAndContexts], !Deps) :-
- ItemAndContext = item_and_context(Item, _Context),
- ( Item = item_pragma(_, pragma_fact_table(_SymName, _Arity, FileName)) ->
+get_fact_table_dependencies_2([Item | Items], !Deps) :-
+ (
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ Pragma = pragma_fact_table(_SymName, _Arity, FileName)
+ ->
!:Deps = [FileName | !.Deps]
;
true
),
- get_fact_table_dependencies_2(ItemAndContexts, !Deps).
+ get_fact_table_dependencies_2(Items, !Deps).
%-----------------------------------------------------------------------------%
-:- type submodule_map == map(module_name, item_list).
+:- type submodule_map == map(module_name, list(item)).
% Given a module (well, a list of items), split it into
% its constituent sub-modules, in top-down order.
%
-split_into_submodules(ModuleName, ItemAndContexts0, ModuleList, !Specs) :-
+split_into_submodules(ModuleName, Items0, ModuleList, !Specs) :-
InParentInterface = no,
- split_into_submodules_2(ModuleName, ItemAndContexts0, InParentInterface,
- ItemAndContexts, ModuleList, !Specs),
+ split_into_submodules_2(ModuleName, Items0, InParentInterface,
+ LeftOverItems, ModuleList, !Specs),
% Check that there are no items after the end_module declaration.
- ( ItemAndContexts = [item_and_context(_Item, Context) | _] ->
- report_items_after_end_module(Context, !Specs)
+ (
+ LeftOverItems = []
;
- true
+ LeftOverItems = [FirstLeftOverItem | _],
+ Context = get_item_context(FirstLeftOverItem),
+ report_items_after_end_module(Context, !Specs)
),
% Check for modules declared as both nested and separate sub-modules.
- get_children(ItemAndContexts0, NestedSubmodules),
+ get_children(Items0, NestedSubmodules),
assoc_list.keys(ModuleList, SeparateSubModules),
Duplicates = set.intersect(
set.list_to_set(NestedSubmodules),
@@ -7265,64 +7348,68 @@
( set.empty(Duplicates) ->
true
;
- report_duplicate_modules(Duplicates, ItemAndContexts0, !Specs)
+ report_duplicate_modules(Duplicates, Items0, !Specs)
).
-:- pred split_into_submodules_2(module_name::in, item_list::in, bool::in,
- item_list::out, module_list::out,
+:- pred split_into_submodules_2(module_name::in, list(item)::in, bool::in,
+ list(item)::out, module_list::out,
list(error_spec)::in, list(error_spec)::out) is det.
-split_into_submodules_2(ModuleName, ItemAndContexts0, InParentInterface,
- ItemAndContexts, ModuleList, !Specs) :-
+split_into_submodules_2(ModuleName, Items0, InParentInterface, Items,
+ ModuleList, !Specs) :-
InInterface0 = no,
- split_into_submodules_3(ModuleName, ItemAndContexts0,
+ split_into_submodules_3(ModuleName, Items0,
InParentInterface, InInterface0,
- ThisModuleItemAndContexts, ItemAndContexts, SubModules, !Specs),
+ ThisModuleItems, Items, SubModules, !Specs),
map.to_assoc_list(SubModules, SubModuleList),
- ModuleList = [ModuleName - ThisModuleItemAndContexts | SubModuleList].
+ ModuleList = [ModuleName - ThisModuleItems | SubModuleList].
-:- pred split_into_submodules_3(module_name::in, item_list::in, bool::in,
- bool::in, item_list::out, item_list::out,
- map(module_name, item_list)::out,
+:- pred split_into_submodules_3(module_name::in, list(item)::in, bool::in,
+ bool::in, list(item)::out, list(item)::out,
+ map(module_name, list(item))::out,
list(error_spec)::in, list(error_spec)::out) is det.
split_into_submodules_3(_ModuleName, [], _, _, [], [], SubModules, !Specs) :-
map.init(SubModules).
-split_into_submodules_3(ModuleName, [ItemAndContext | ItemAndContexts1],
- InParentInterface, InInterface0,
- ThisModuleItemAndContexts, OtherItemAndContexts, SubModules, !Specs) :-
- ItemAndContext = item_and_context(Item, Context),
+split_into_submodules_3(ModuleName, [Item | Items1],
+ InParentInterface, !.InInterface,
+ ThisModuleItems, OtherItems, SubModules, !Specs) :-
(
% Check for a `module' declaration, which signals the start
% of a nested module.
- Item = item_module_defn(VarSet, md_module(SubModuleName))
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ ModuleDefn = md_module(SubModuleName)
->
% Parse in the items for the nested submodule.
- split_into_submodules_2(SubModuleName, ItemAndContexts1, InInterface0,
- ItemAndContexts2, SubModules0, !Specs),
+ split_into_submodules_2(SubModuleName, Items1, !.InInterface,
+ Items2, SubModules0, !Specs),
% Parse in the remaining items for this module.
- split_into_submodules_3(ModuleName, ItemAndContexts2,
- InParentInterface, InInterface0,
- ThisModuleItemAndContexts0, ItemAndContexts3,
- SubModules1, !Specs),
+ split_into_submodules_3(ModuleName, Items2,
+ InParentInterface, !.InInterface,
+ ThisModuleItems0, Items3, SubModules1, !Specs),
- % Combine the sub-module declarations from the previous two steps.
+ % Combine the submodule declarations from the previous two steps.
list.foldl(add_submodule, SubModules0, SubModules1, SubModules),
% Replace the nested submodule with an `include_module' declaration.
- IncludeSubMod = item_and_context(item_module_defn(VarSet,
- md_include_module([SubModuleName])), Context),
- ThisModuleItemAndContexts =
- [IncludeSubMod | ThisModuleItemAndContexts0],
- OtherItemAndContexts = ItemAndContexts3
+ IncludeSubModModuleDefn = md_include_module([SubModuleName]),
+ IncludeSubModItemModuleDefn = item_module_defn_info(VarSet,
+ IncludeSubModModuleDefn, Context),
+ IncludeSubModItem = item_module_defn(IncludeSubModItemModuleDefn),
+ ThisModuleItems = [IncludeSubModItem | ThisModuleItems0],
+ OtherItems = Items3
;
% Check for a matching `end_module' declaration.
- Item = item_module_defn(_VarSet, md_end_module(ModuleName))
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_VarSet, ModuleDefn, _Context),
+ ModuleDefn = md_end_module(EndModuleName),
+ EndModuleName = ModuleName
->
% If so, that's the end of this module.
- ThisModuleItemAndContexts = [],
- OtherItemAndContexts = ItemAndContexts1,
+ ThisModuleItems = [],
+ OtherItems = Items1,
map.init(SubModules)
;
% Otherwise, process the next item in this module.
@@ -7330,46 +7417,51 @@
% Update the flag which records whether we're currently in the
% interface section, and report an error if there is an
% `implementation' section inside an `interface' section.
- ( Item = item_module_defn(_, md_interface) ->
- InInterface1 = yes
- ; Item = item_module_defn(_, md_implementation) ->
+ ( Item = item_module_defn(ItemModuleDefn) ->
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, Context),
+ ( ModuleDefn = md_interface ->
+ !:InInterface = yes
+ ; ModuleDefn = md_implementation ->
+ !:InInterface = no,
(
InParentInterface = yes,
- report_error_implementation_in_interface(ModuleName, Context,
- !Specs)
+ report_error_implementation_in_interface(ModuleName,
+ Context, !Specs)
;
InParentInterface = no
- ),
- InInterface1 = no
+ )
;
- InInterface1 = InInterface0
+ true
+ )
+ ;
+ true
),
% Check to make sure that a non-abstract instance declaration
% does not occur in a module interface.
(
- InInterface1 = yes,
- Item = item_instance(_, _, _, Body, _, _),
- Body \= instance_body_abstract
+ !.InInterface = yes,
+ Item = item_instance(ItemInstance),
+ ItemInstance ^ ci_method_instances \= instance_body_abstract
->
- report_non_abstract_instance_in_interface(Context, !Specs)
+ InstanceContext = ItemInstance ^ ci_context,
+ report_non_abstract_instance_in_interface(InstanceContext, !Specs)
;
true
),
% Parse the remaining items for this module.
- split_into_submodules_3(ModuleName, ItemAndContexts1,
- InParentInterface, InInterface1,
- ThisModuleItemAndContexts0, ItemAndContexts2, SubModules, !Specs),
+ split_into_submodules_3(ModuleName, Items1,
+ InParentInterface, !.InInterface,
+ ThisModuleItems0, Items2, SubModules, !Specs),
% Put the current item back onto the front of the item list
% for this module.
- ThisModuleItemAndContexts =
- [ItemAndContext | ThisModuleItemAndContexts0],
- OtherItemAndContexts = ItemAndContexts2
+ ThisModuleItems = [Item | ThisModuleItems0],
+ OtherItems = Items2
).
-:- pred add_submodule(pair(module_name, item_list)::in,
+:- pred add_submodule(pair(module_name, list(item))::in,
submodule_map::in, submodule_map::out) is det.
add_submodule(ModuleName - ModuleItemList, !SubModules) :-
@@ -7406,21 +7498,21 @@
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
-:- pred report_duplicate_modules(set(module_name)::in, item_list::in,
+:- pred report_duplicate_modules(set(module_name)::in, list(item)::in,
list(error_spec)::in, list(error_spec)::out) is det.
-report_duplicate_modules(Duplicates, ItemAndContexts, !Specs) :-
- solutions.solutions(is_duplicate_error(Duplicates, ItemAndContexts),
+report_duplicate_modules(Duplicates, Items, !Specs) :-
+ solutions.solutions(is_duplicate_error(Duplicates, Items),
DuplicateErrors),
list.foldl(report_error_duplicate_module_decl, DuplicateErrors, !Specs).
-:- pred is_duplicate_error(set(module_name)::in, item_list::in,
+:- pred is_duplicate_error(set(module_name)::in, list(item)::in,
pair(module_name, prog_context)::out) is nondet.
-is_duplicate_error(Duplicates, ItemAndContexts, SubModuleName - Context) :-
- list.member(ItemAndContext, ItemAndContexts),
- ItemAndContext = item_and_context(Item, Context),
- Item = item_module_defn(_VarSet, ModuleDefn),
+is_duplicate_error(Duplicates, Items, SubModuleName - Context) :-
+ list.member(Item, Items),
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_VarSet, ModuleDefn, Context),
(
ModuleDefn = md_module(SubModuleName)
;
@@ -7471,8 +7563,8 @@
% The bodies of instance definitions are removed because
% the instance methods have not yet been module qualified.
%
-:- pred get_interface(module_name::in, bool::in, item_list::in, item_list::out)
- is det.
+:- pred get_interface(module_name::in, bool::in,
+ list(item)::in, list(item)::out) is det.
get_interface(ModuleName, IncludeImplTypes, Items0, Items) :-
AddToImpl = (func(_, ImplItems) = ImplItems),
@@ -7483,7 +7575,7 @@
order_items(Items2, Items).
:- pred get_interface_and_implementation(module_name::in, bool::in,
- item_list::in, item_list::out, item_list::out) is det.
+ list(item)::in, list(item)::out, list(item)::out) is det.
get_interface_and_implementation(ModuleName, IncludeImplTypes,
Items0, InterfaceItems, ImplementationItems) :-
@@ -7496,110 +7588,106 @@
InterfaceItems0, InterfaceItems).
:- pred maybe_add_foreign_import_module(module_name::in,
- item_list::in, item_list::out) is det.
+ list(item)::in, list(item)::out) is det.
-maybe_add_foreign_import_module(ModuleName,
- ItemAndContexts0, ItemAndContexts) :-
- get_foreign_self_imports(ItemAndContexts0, Langs),
- ImportItemAndContexts = list.map(make_foreign_import(ModuleName), Langs),
- ItemAndContexts = ImportItemAndContexts ++ ItemAndContexts0.
+maybe_add_foreign_import_module(ModuleName, Items0, Items) :-
+ get_foreign_self_imports(Items0, Langs),
+ ImportItems = list.map(make_foreign_import(ModuleName), Langs),
+ Items = ImportItems ++ Items0.
-:- func make_foreign_import(module_name, foreign_language) = item_and_context.
+:- func make_foreign_import(module_name, foreign_language) = item.
-make_foreign_import(ModuleName, Lang) = ImportItemAndContext :-
+make_foreign_import(ModuleName, Lang) = Item :-
Origin = compiler(foreign_imports),
Pragma = pragma_foreign_import_module(Lang, ModuleName),
- ImportItem = item_pragma(Origin, Pragma),
- ImportItemAndContext = item_and_context(ImportItem, term.context_init).
+ ItemPragma = item_pragma_info(Origin, Pragma, term.context_init),
+ Item = item_pragma(ItemPragma).
-:- pred get_foreign_self_imports(item_list::in, list(foreign_language)::out)
+:- pred get_foreign_self_imports(list(item)::in, list(foreign_language)::out)
is det.
get_foreign_self_imports(Items, Langs) :-
list.foldl(accumulate_item_foreign_import_langs, Items, set.init, LangSet),
set.to_sorted_list(LangSet, Langs).
-:- pred accumulate_item_foreign_import_langs(item_and_context::in,
+:- pred accumulate_item_foreign_import_langs(item::in,
set(foreign_language)::in, set(foreign_language)::out) is det.
-accumulate_item_foreign_import_langs(item_and_context(Item, _), !LangSet) :-
- solutions.solutions(item_needs_foreign_imports(Item), Langs),
+accumulate_item_foreign_import_langs(Item, !LangSet) :-
+ Langs = item_needs_foreign_imports(Item),
svset.insert_list(Langs, !LangSet).
-:- pred get_interface_and_implementation_2(bool::in, item_list::in, bool::in,
- item_list::in, item_list::out,
- func(item_and_context, T) = T::in, T::in, T::out) is det.
-
-get_interface_and_implementation_2(_, [], _, !IntItemAndContexts,
- _, !ImplItemAndContexts).
-get_interface_and_implementation_2(IncludeImplTypes, [ItemAndContext | Rest],
- InInterface0, !IntItemAndContexts,
- AddImplItem, !ImplItemAndContexts) :-
- ItemAndContext = item_and_context(Item, Context),
- (
- Item = item_module_defn(_, md_interface)
- ->
- !:IntItemAndContexts = [ItemAndContext | !.IntItemAndContexts],
- InInterface1 = yes,
- Continue = yes
- ;
- Item = item_module_defn(_, Defn),
- ( Defn = md_imported(_)
- ; Defn = md_used(_)
+:- pred get_interface_and_implementation_2(bool::in, list(item)::in, bool::in,
+ list(item)::in, list(item)::out,
+ func(item, T) = T::in, T::in, T::out) is det.
+
+get_interface_and_implementation_2(_, [], _, !RevIntItems, _, !RevImplItems).
+get_interface_and_implementation_2(IncludeImplTypes, [Item | Rest],
+ !.InInterface, !RevIntItems, AddImplItem, !RevImplItems) :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ( ModuleDefn = md_interface
+ ; ModuleDefn = md_implementation
+ ; ModuleDefn = md_imported(_)
+ ; ModuleDefn = md_used(_)
)
->
- % Items after here are not part of this module.
- InInterface1 = no,
- Continue = no
+ (
+ ModuleDefn = md_interface,
+ !:RevIntItems = [Item | !.RevIntItems],
+ !:InInterface = yes,
+ get_interface_and_implementation_2(IncludeImplTypes, Rest,
+ !.InInterface, !RevIntItems, AddImplItem, !RevImplItems)
;
- Item = item_module_defn(_, md_implementation)
- ->
- !:IntItemAndContexts = [ItemAndContext | !.IntItemAndContexts],
- InInterface1 = no,
- Continue = yes
+ ModuleDefn = md_implementation,
+ !:RevIntItems = [Item | !.RevIntItems],
+ !:InInterface = no,
+ get_interface_and_implementation_2(IncludeImplTypes, Rest,
+ !.InInterface, !RevIntItems, AddImplItem, !RevImplItems)
+ ;
+ ( ModuleDefn = md_imported(_)
+ ; ModuleDefn = md_used(_)
+ )
+ % Items after here are not part of this module, which is why
+ % we don't have a recursive call here.
+ )
;
(
- InInterface0 = yes,
- ( make_abstract_instance(Item, Item1) ->
- ItemToWrite = Item1,
- !:ImplItemAndContexts =
- AddImplItem(ItemAndContext, !.ImplItemAndContexts)
+ !.InInterface = yes,
+ ( Item = item_instance(ItemInstance) ->
+ % Include the abstract version of the instance in the
+ % interface, ...
+ AbstractItemInstance = make_instance_abstract(ItemInstance),
+ AbstractItem = item_instance(AbstractItemInstance),
+ !:RevIntItems = [AbstractItem | !.RevIntItems],
+
+ % ... and the concrete version in the implementation.
+ !:RevImplItems = AddImplItem(Item, !.RevImplItems)
;
- ItemToWrite = Item
- ),
- !:IntItemAndContexts = [item_and_context(ItemToWrite, Context)
- | !.IntItemAndContexts]
+ !:RevIntItems = [Item | !.RevIntItems]
+ )
;
- InInterface0 = no,
- !:ImplItemAndContexts =
- AddImplItem(ItemAndContext, !.ImplItemAndContexts),
+ !.InInterface = no,
+ !:RevImplItems = AddImplItem(Item, !.RevImplItems),
(
IncludeImplTypes = yes,
- include_in_int_file_implementation(Item)
+ include_in_int_file_implementation(Item) = yes
->
- ( make_abstract_defn(Item, int2, ImpItem1) ->
- ImpItem = ImpItem1
- ; make_abstract_unify_compare(Item, int2, ImpItem1) ->
- ImpItem = ImpItem1
+ ( make_abstract_defn(Item, int2, AbstractItem) ->
+ ItemToAdd = AbstractItem
+ ; make_abstract_unify_compare(Item, int2, AbstractItem) ->
+ ItemToAdd = AbstractItem
;
- ImpItem = Item
+ ItemToAdd = Item
),
- !:IntItemAndContexts = [item_and_context(ImpItem, Context)
- | !.IntItemAndContexts]
+ !:RevIntItems = [ItemToAdd | !.RevIntItems]
;
true
)
),
- InInterface1 = InInterface0,
- Continue = yes
- ),
- (
- Continue = yes,
get_interface_and_implementation_2(IncludeImplTypes, Rest,
- InInterface1, !IntItemAndContexts,
- AddImplItem, !ImplItemAndContexts)
- ;
- Continue = no
+ !.InInterface, !RevIntItems, AddImplItem, !RevImplItems)
).
:- type short_interface_kind
@@ -7618,8 +7706,8 @@
% type declarations, then it doesn't need any import_module
% declarations.
%
-:- pred get_short_interface(item_list::in, short_interface_kind::in,
- item_list::out) is det.
+:- pred get_short_interface(list(item)::in, short_interface_kind::in,
+ list(item)::out) is det.
get_short_interface(Items0, Kind, Items) :-
get_short_interface_2(Items0, Kind, [], RevItems),
@@ -7627,100 +7715,285 @@
maybe_strip_import_decls(Items1, Items2),
order_items(Items2, Items).
-:- pred get_short_interface_2(item_list::in, short_interface_kind::in,
- item_list::in, item_list::out) is det.
+:- pred get_short_interface_2(list(item)::in, short_interface_kind::in,
+ list(item)::in, list(item)::out) is det.
-get_short_interface_2([], _Kind, Items, Items).
-get_short_interface_2([ItemAndContext | Rest], Kind, Items0, Items) :-
- ItemAndContext = item_and_context(Item0, Context),
- ( make_abstract_defn(Item0, Kind, Item1) ->
- Items1 = [item_and_context(Item1, Context) | Items0]
- ; make_abstract_unify_compare(Item0, Kind, Item1) ->
- Items1 = [item_and_context(Item1, Context) | Items0]
- ; include_in_short_interface(Item0) ->
- Items1 = [ItemAndContext | Items0]
+get_short_interface_2([], _Kind, !RevItems).
+get_short_interface_2([Item | Items], Kind, !RevItems) :-
+ ( make_abstract_defn(Item, Kind, AbstractItem) ->
+ !:RevItems = [AbstractItem | !.RevItems]
+ ; make_abstract_unify_compare(Item, Kind, AbstractItem) ->
+ !:RevItems = [AbstractItem | !.RevItems]
;
- Items1 = Items0
+ Include = include_in_short_interface(Item),
+ (
+ Include = yes,
+ !:RevItems = [Item | !.RevItems]
+ ;
+ Include = no
+ )
),
- get_short_interface_2(Rest, Kind, Items1, Items).
+ get_short_interface_2(Items, Kind, !RevItems).
-:- pred include_in_short_interface(item::in) is semidet.
+:- func include_in_short_interface(item) = bool.
-include_in_short_interface(item_type_defn(_, _, _, _, _)).
-include_in_short_interface(item_inst_defn(_, _, _, _, _)).
-include_in_short_interface(item_mode_defn(_, _, _, _, _)).
-include_in_short_interface(item_module_defn(_, _)).
-include_in_short_interface(item_instance(_, _, _, _, _, _)).
-include_in_short_interface(item_pragma(_, pragma_foreign_import_module(_, _))).
+include_in_short_interface(Item) = Include :-
+ (
+ ( Item = item_module_defn(_)
+ ; Item = item_type_defn(_)
+ ; Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_instance(_)
+ ),
+ Include = yes
+ ;
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ % XXX This if-then-else should be a switch, or (even better)
+ % we should take pragma_foreign_import_modules out of the pragma items
+ % and given them their own item type.
+ ( Pragma = pragma_foreign_import_module(_, _) ->
+ Include = yes
+ ;
+ Include = no
+ )
+ ;
+ ( Item = item_clause(_)
+ ; Item = item_pred_decl(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_promise(_)
+ ; Item = item_typeclass(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_mutable(_)
+ ; Item = item_nothing(_)
+ ),
+ Include = no
+ ).
% Could this item use items from imported modules.
%
:- func item_needs_imports(item) = bool.
-item_needs_imports(item_clause(_, _, _, _, _, _)) = yes.
-item_needs_imports(Item @ item_type_defn(_, _, _, _, _)) =
- ( Item ^ td_ctor_defn = parse_tree_abstract_type(_) -> no ; yes ).
-item_needs_imports(item_inst_defn(_, _, _, _, _)) = yes.
-item_needs_imports(item_mode_defn(_, _, _, _, _)) = yes.
-item_needs_imports(item_module_defn(_, _)) = no.
-item_needs_imports(item_pragma(_, _)) = yes.
-item_needs_imports(item_pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _, _)) =
- yes.
-item_needs_imports(item_pred_or_func_mode(_, _, _, _, _, _, _)) = yes.
-item_needs_imports(item_typeclass(_, _, _, _, _, _)) = yes.
-item_needs_imports(item_instance(_, _, _, _, _, _)) = yes.
-item_needs_imports(item_promise(_, _, _, _)) = yes.
-item_needs_imports(item_initialise(_, _, _)) = yes.
-item_needs_imports(item_finalise(_, _, _)) = yes.
-item_needs_imports(item_mutable(_, _, _, _, _, _)) = yes.
-item_needs_imports(item_nothing(_)) = no.
-
-:- pred item_needs_foreign_imports(item::in, foreign_language::out) is nondet.
+item_needs_imports(Item) = NeedsImports :-
+ (
+ Item = item_type_defn(ItemTypeDefn),
+ ( ItemTypeDefn ^ td_ctor_defn = parse_tree_abstract_type(_) ->
+ NeedsImports = no
+ ;
+ NeedsImports = yes
+ )
+ ;
+ ( Item = item_clause(_)
+ ; Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_pragma(_)
+ ; Item = item_pred_decl(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_typeclass(_)
+ ; Item = item_instance(_)
+ ; Item = item_promise(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_mutable(_)
+ ),
+ NeedsImports = yes
+ ;
+ ( Item = item_module_defn(_)
+ ; Item = item_nothing(_)
+ ),
+ NeedsImports = no
+ ).
-item_needs_foreign_imports(item_pragma(_,
- pragma_foreign_export(Lang, _, _, _, _)), Lang).
+:- func item_needs_foreign_imports(item) = list(foreign_language).
+item_needs_foreign_imports(Item) = Langs :-
+ (
+ Item = item_mutable(_ItemMutable),
+ % We can use all foreign languages.
+ Langs = all_foreign_languages
+ ;
+ Item = item_type_defn(ItemTypeDefn),
+ (
+ ItemTypeDefn ^ td_ctor_defn =
+ parse_tree_foreign_type(ForeignType, _, _)
+ ->
+ Langs = [foreign_type_language(ForeignType)]
+ ;
+ Langs = []
+ )
+ ;
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ (
+ Pragma = pragma_import(_, _, _, _, _),
% `:- pragma import' is only supported for C.
-item_needs_foreign_imports(item_pragma(_, pragma_import(_, _, _, _, _)),
- lang_c).
-item_needs_foreign_imports(Item @ item_type_defn(_, _, _, _, _), Lang) :-
- Item ^ td_ctor_defn = parse_tree_foreign_type(ForeignType, _, _),
- Lang = foreign_type_language(ForeignType).
-item_needs_foreign_imports(item_pragma(_, pragma_foreign_decl(Lang, _, _)),
- Lang).
-item_needs_foreign_imports(item_pragma(_, pragma_foreign_code(Lang, _)), Lang).
-item_needs_foreign_imports(item_pragma(_,
- pragma_foreign_proc(Attrs, _, _, _, _, _, _)),
- get_foreign_language(Attrs)).
-item_needs_foreign_imports(item_mutable(_, _, _, _, _, _), Lang) :-
- foreign_language(Lang).
-item_needs_foreign_imports(item_pragma(_, pragma_foreign_enum(Lang, _, _, _)),
- Lang) :-
- foreign_language(Lang).
-
-:- pred include_in_int_file_implementation(item::in) is semidet.
-
-include_in_int_file_implementation(item_type_defn(_, _, _, _, _)).
-include_in_int_file_implementation(item_module_defn(_, Defn)) :-
- Defn \= md_external(_, _).
-
- % `:- typeclass declarations' may be referred to
- % by the constructors in type declarations.
- % Since these constructors are abstractly exported,
- % we won't need the local instance declarations.
- %
-include_in_int_file_implementation(item_typeclass(_, _, _, _, _, _)).
-include_in_int_file_implementation(item_pragma(_,
- pragma_foreign_import_module(_, _))).
-include_in_int_file_implementation(Item) :-
- Item = item_pragma(_, pragma_foreign_enum(_, _, _, _)).
+ Langs = [lang_c]
+ ;
+ ( Pragma = pragma_foreign_decl(Lang, _, _)
+ ; Pragma = pragma_foreign_code(Lang, _)
+ ; Pragma = pragma_foreign_enum(Lang, _, _, _)
+ ; Pragma = pragma_foreign_export(Lang, _, _, _, _)
+ ),
+ Langs = [Lang]
+ ;
+ Pragma = pragma_foreign_proc(Attrs, _, _, _, _, _, _),
+ Langs = [get_foreign_language(Attrs)]
+ ;
+ ( Pragma = pragma_foreign_import_module(_, _)
+ ; Pragma = pragma_foreign_export_enum(_, _, _, _, _)
+ ; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _)
+ ; Pragma = pragma_inline(_, _)
+ ; Pragma = pragma_no_inline(_, _)
+ ; Pragma = pragma_unused_args(_, _, _, _, _)
+ ; Pragma = pragma_exceptions(_, _, _, _, _)
+ ; Pragma = pragma_trailing_info(_, _, _, _, _)
+ ; Pragma = pragma_mm_tabling_info(_, _, _, _, _)
+ ; Pragma = pragma_obsolete(_, _)
+ ; Pragma = pragma_source_file(_)
+ ; Pragma = pragma_tabled(_, _, _, _, _, _)
+ ; Pragma = pragma_fact_table(_, _, _)
+ ; Pragma = pragma_reserve_tag(_, _)
+ ; Pragma = pragma_promise_equivalent_clauses(_, _)
+ ; Pragma = pragma_promise_pure(_, _)
+ ; Pragma = pragma_promise_semipure(_, _)
+ ; Pragma = pragma_termination_info(_, _, _, _, _)
+ ; Pragma = pragma_termination2_info(_, _, _, _, _, _)
+ ; Pragma = pragma_terminates(_, _)
+ ; Pragma = pragma_does_not_terminate(_, _)
+ ; Pragma = pragma_check_termination(_, _)
+ ; Pragma = pragma_mode_check_clauses(_, _)
+ ; Pragma = pragma_structure_sharing(_, _, _, _, _, _)
+ ; Pragma = pragma_structure_reuse(_, _, _, _, _, _)
+ ; Pragma = pragma_require_feature_set(_)
+ ),
+ Langs = []
+ )
+ ;
+ ( Item = item_module_defn(_)
+ ; Item = item_clause(_)
+ ; Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_pred_decl(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_typeclass(_)
+ ; Item = item_instance(_)
+ ; Item = item_promise(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_nothing(_)
+ ),
+ Langs = []
+ ).
+
+:- func include_in_int_file_implementation(item) = bool.
+
+include_in_int_file_implementation(Item) = Include :-
+ (
+ % `:- typeclass declarations' may be referred to by the constructors
+ % in type declarations. Since these constructors are abstractly
+ % exported, we won't need the local instance declarations.
+ ( Item = item_type_defn(_)
+ ; Item = item_typeclass(_)
+ ),
+ Include = yes
+ ;
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ (
+ % XXX Some of these should yield an exception.
+ ( ModuleDefn = md_module(_)
+ ; ModuleDefn = md_end_module(_)
+ ; ModuleDefn = md_interface
+ ; ModuleDefn = md_implementation
+ ; ModuleDefn = md_private_interface
+ ; ModuleDefn = md_imported(_)
+ ; ModuleDefn = md_used(_)
+ ; ModuleDefn = md_abstract_imported
+ ; ModuleDefn = md_opt_imported
+ ; ModuleDefn = md_transitively_imported
+ ; ModuleDefn = md_export(_)
+ ; ModuleDefn = md_import(_)
+ ; ModuleDefn = md_use(_)
+ ; ModuleDefn = md_include_module(_)
+ ; ModuleDefn = md_version_numbers(_, _)
+ ),
+ Include = yes
+ ;
+ ModuleDefn = md_external(_, _),
+ Include = no
+ )
+ ;
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ (
+ ( Pragma = pragma_foreign_import_module(_, _)
+ ; Pragma = pragma_foreign_enum(_, _, _, _)
+ ),
+ Include = yes
+ ;
+ % XXX I am not sure about the proper value of Include
+ % for some of these. -zs
+ ( Pragma = pragma_foreign_decl(_, _, _)
+ ; Pragma = pragma_foreign_code(_, _)
+ ; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _)
+ ; Pragma = pragma_foreign_export(_, _, _, _, _)
+ ; Pragma = pragma_import(_, _, _, _, _)
+ ; Pragma = pragma_foreign_export_enum(_, _, _, _, _)
+ ; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _)
+ ; Pragma = pragma_inline(_, _)
+ ; Pragma = pragma_no_inline(_, _)
+ ; Pragma = pragma_unused_args(_, _, _, _, _)
+ ; Pragma = pragma_exceptions(_, _, _, _, _)
+ ; Pragma = pragma_trailing_info(_, _, _, _, _)
+ ; Pragma = pragma_mm_tabling_info(_, _, _, _, _)
+ ; Pragma = pragma_obsolete(_, _)
+ ; Pragma = pragma_source_file(_)
+ ; Pragma = pragma_tabled(_, _, _, _, _, _)
+ ; Pragma = pragma_fact_table(_, _, _)
+ ; Pragma = pragma_reserve_tag(_, _)
+ ; Pragma = pragma_promise_equivalent_clauses(_, _)
+ ; Pragma = pragma_promise_pure(_, _)
+ ; Pragma = pragma_promise_semipure(_, _)
+ ; Pragma = pragma_termination_info(_, _, _, _, _)
+ ; Pragma = pragma_termination2_info(_, _, _, _, _, _)
+ ; Pragma = pragma_terminates(_, _)
+ ; Pragma = pragma_does_not_terminate(_, _)
+ ; Pragma = pragma_check_termination(_, _)
+ ; Pragma = pragma_mode_check_clauses(_, _)
+ ; Pragma = pragma_structure_sharing(_, _, _, _, _, _)
+ ; Pragma = pragma_structure_reuse(_, _, _, _, _, _)
+ ; Pragma = pragma_require_feature_set(_)
+ ),
+ Include = no
+ )
+ ;
+ ( Item = item_clause(_)
+ ; Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_pred_decl(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_promise(_)
+ ; Item = item_instance(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_mutable(_)
+ ; Item = item_nothing(_)
+ ),
+ Include = no
+ ).
+
+ % XXX make_abstract_defn should be merged with make_abstract_unify_compare
+ % and made det, returning the unchanged item if it does not need to be made
+ % abstract (so we can use det switches instead semidet tests in the code).
:- pred make_abstract_defn(item::in, short_interface_kind::in, item::out)
is semidet.
-make_abstract_defn(Item0 @ item_type_defn(_VarSet, _Name, _Args, TypeDefn,
- _Cond), ShortInterfaceKind,
- Item0 ^ td_ctor_defn := parse_tree_abstract_type(IsSolverType)) :-
+make_abstract_defn(Item, ShortInterfaceKind, AbstractItem) :-
+ (
+ Item = item_type_defn(ItemTypeDefn),
+ TypeDefn = ItemTypeDefn ^ td_ctor_defn,
(
TypeDefn = parse_tree_du_type(_, _),
IsSolverType = non_solver_type,
@@ -7757,81 +8030,85 @@
% to handle inter-language interfacing correctly.
IsSolverType = non_solver_type,
semidet_fail
+ ),
+ AbstractItemTypeDefn = ItemTypeDefn ^ td_ctor_defn
+ := parse_tree_abstract_type(IsSolverType),
+ AbstractItem = item_type_defn(AbstractItemTypeDefn)
+ ;
+ Item = item_instance(ItemInstance),
+ ShortInterfaceKind = int2,
+ AbstractItemInstance = make_instance_abstract(ItemInstance),
+ AbstractItem = item_instance(AbstractItemInstance)
+ ;
+ Item = item_typeclass(ItemTypeClass),
+ AbstractItemTypeClass = ItemTypeClass ^ tc_class_methods
+ := class_interface_abstract,
+ AbstractItem = item_typeclass(AbstractItemTypeClass)
).
-make_abstract_defn(item_instance(_, _, _, _, _, _) @ Item0, int2, Item) :-
- make_abstract_instance(Item0, Item).
-make_abstract_defn(item_typeclass(_, _, _, _, _, _) @ Item, _,
- Item ^ tc_class_methods := class_interface_abstract).
:- pred make_abstract_unify_compare(item::in, short_interface_kind::in,
item::out) is semidet.
-make_abstract_unify_compare(
- item_type_defn(VarSet, Name, Args, TypeDefn0, Cond), int2,
- item_type_defn(VarSet, Name, Args, TypeDefn, Cond)) :-
+make_abstract_unify_compare(Item, int2, AbstractItem) :-
+ Item = item_type_defn(ItemTypeDefn),
+ TypeDefn = ItemTypeDefn ^ td_ctor_defn,
(
- TypeDefn0 = parse_tree_du_type(Constructors, yes(_UserEqComp)),
- TypeDefn = parse_tree_du_type(Constructors, yes(
+ TypeDefn = parse_tree_du_type(Constructors, yes(_UserEqComp)),
+ AbstractTypeDefn = parse_tree_du_type(Constructors, yes(
abstract_noncanonical_type(non_solver_type)))
;
- TypeDefn0 = parse_tree_foreign_type(ForeignType,
- yes(_UserEqComp), Assertions),
TypeDefn = parse_tree_foreign_type(ForeignType,
+ yes(_UserEqComp), Assertions),
+ AbstractTypeDefn = parse_tree_foreign_type(ForeignType,
yes(abstract_noncanonical_type(non_solver_type)), Assertions)
;
- TypeDefn0 = parse_tree_solver_type(SolverTypeDetails,
- yes(_UserEqComp)),
- TypeDefn = parse_tree_solver_type(SolverTypeDetails,
+ TypeDefn = parse_tree_solver_type(SolverTypeDetails, yes(_UserEqComp)),
+ AbstractTypeDefn = parse_tree_solver_type(SolverTypeDetails,
yes(abstract_noncanonical_type(solver_type)))
- ).
+ ),
+ AbstractItemTypeDefn = ItemTypeDefn ^ td_ctor_defn := AbstractTypeDefn,
+ AbstractItem = item_type_defn(AbstractItemTypeDefn).
% All instance declarations must be written to `.int' files as
% abstract instance declarations, because the method names have not yet
% been module qualified. This could cause the wrong predicate to be
% used if calls to the method are specialized.
%
-:- pred make_abstract_instance(item::in, item::out) is semidet.
+:- func make_instance_abstract(item_instance_info) = item_instance_info.
-make_abstract_instance(Item0, Item) :-
- Item0 = item_instance(_Constraints, _Class, _ClassTypes, Body0,
- _TVarSet, _ModName),
- Body0 = instance_body_concrete(_),
- Body = instance_body_abstract,
- Item = Item0 ^ ci_method_instances := Body.
+make_instance_abstract(Info0) = Info :-
+ Info = Info0 ^ ci_method_instances := instance_body_abstract.
-:- pred maybe_strip_import_decls(item_list::in, item_list::out) is det.
+:- pred maybe_strip_import_decls(list(item)::in, list(item)::out) is det.
-maybe_strip_import_decls(!ItemAndContexts) :-
+maybe_strip_import_decls(!Items) :-
(
some [Item] (
- list.member(item_and_context(Item, _), !.ItemAndContexts),
+ list.member(Item, !.Items),
item_needs_imports(Item) = yes
)
->
true
;
- list.filter(
- (pred((item_and_context(ThisItem, _))::in) is semidet :-
- \+ (
- ThisItem = item_module_defn(_, Defn),
- ( Defn = md_import(_)
- ; Defn = md_use(_)
- )
- )
- ), !ItemAndContexts)
+ list.filter(not_import_or_use_item, !Items)
),
(
some [Item] (
- list.member(item_and_context(Item, _), !.ItemAndContexts),
- item_needs_foreign_imports(Item, _)
+ list.member(Item, !.Items),
+ item_needs_foreign_imports(Item) = [_ | _]
)
->
true
;
- list.filter(
- (pred((item_and_context(ThisItem, _))::in) is semidet :-
- ThisItem \= item_pragma(_, pragma_foreign_import_module(_, _))
- ), !ItemAndContexts)
+ NotPragmaForeignImport =
+ (pred(ThisItem::in) is semidet :-
+ \+ (
+ ThisItem = item_pragma(ThisItemPragma),
+ ThisItemPragma = item_pragma_info(_, Pragma, _),
+ Pragma = pragma_foreign_import_module(_, _)
+ )
+ ),
+ list.filter(NotPragmaForeignImport, !Items)
).
%-----------------------------------------------------------------------------%
@@ -7844,25 +8121,40 @@
% with the current representation of the module, which is just a list of
% items without further structure.
%
-:- pred order_items(item_list::in, item_list::out) is det.
+:- pred order_items(list(item)::in, list(item)::out) is det.
-order_items(ItemAndContexts0, ItemAndContexts) :-
- filter_unnecessary_flips(ItemAndContexts0, other, ItemAndContexts1),
- do_order_items(ItemAndContexts1, ItemAndContexts2),
+order_items(Items0, Items) :-
+ filter_unnecessary_flips(Items0, other, Items1),
+ do_order_items(Items1, Items2),
% Delete any redundant :- interface and :- implementation markers at the
% end, to make Items as insensitive as we can to the number of interface
% sections in the source file. If some of the implementation sections
% are not empty, we won't be fully successful.
- list.reverse(ItemAndContexts2, RevItemAndContexts2),
- list.takewhile(interface_or_import_marker, RevItemAndContexts2, _,
- RevItemAndContexts),
- list.reverse(RevItemAndContexts, ItemAndContexts).
-
-:- pred interface_or_import_marker(item_and_context::in) is semidet.
-
-interface_or_import_marker(item_and_context(Item, _)) :-
- ( Item = item_module_defn(_, md_interface)
- ; Item = item_module_defn(_, md_implementation)
+ list.reverse(Items2, RevItems2),
+ list.takewhile(interface_or_import_marker, RevItems2, _, RevItems),
+ list.reverse(RevItems, Items).
+
+:- pred interface_or_import_marker(item::in) is semidet.
+
+interface_or_import_marker(Item) :-
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ( ModuleDefn = md_interface
+ ; ModuleDefn = md_implementation
+ ).
+
+:- pred not_import_or_use_item(item::in) is semidet.
+
+not_import_or_use_item(Item) :-
+ not import_or_use_item(Item).
+
+:- pred import_or_use_item(item::in) is semidet.
+
+import_or_use_item(Item) :-
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ( ModuleDefn = md_import(_)
+ ; ModuleDefn = md_use(_)
).
% Which section of the module we are in. The "other" alternative
@@ -7875,40 +8167,51 @@
; in_implementation
; other.
-:- pred filter_unnecessary_flips(item_list::in, cur_pos::in, item_list::out)
+:- pred filter_unnecessary_flips(list(item)::in, cur_pos::in, list(item)::out)
is det.
filter_unnecessary_flips([], _, []).
-filter_unnecessary_flips([ItemAndContext], _, [ItemAndContext]).
-filter_unnecessary_flips([ItemAndContext1, ItemAndContext2 | ItemAndContexts0],
- CurPos, ItemAndContexts) :-
- ItemAndContext1 = item_and_context(Item1, _Context1),
- ItemAndContext2 = item_and_context(Item2, _Context2),
+filter_unnecessary_flips([Item], _, [Item]).
+filter_unnecessary_flips([Item1, Item2 | Items0], CurPos, Items) :-
(
CurPos = in_interface,
- Item1 = item_module_defn(_, md_implementation),
- Item2 = item_module_defn(_, md_interface)
+ Item1 = item_module_defn(ItemModuleDefn1),
+ ItemModuleDefn1 = item_module_defn_info(_, md_implementation, _),
+ Item2 = item_module_defn(ItemModuleDefn2),
+ ItemModuleDefn2 = item_module_defn_info(_, md_interface, _)
->
- filter_unnecessary_flips(ItemAndContexts0, CurPos, ItemAndContexts)
+ filter_unnecessary_flips(Items0, CurPos, Items)
;
CurPos = in_implementation,
- Item1 = item_module_defn(_, md_interface),
- Item2 = item_module_defn(_, md_implementation)
+ Item1 = item_module_defn(ItemModuleDefn1),
+ ItemModuleDefn1 = item_module_defn_info(_, md_interface, _),
+ Item2 = item_module_defn(ItemModuleDefn2),
+ ItemModuleDefn2 = item_module_defn_info(_, md_implementation, _)
->
- filter_unnecessary_flips(ItemAndContexts0, CurPos, ItemAndContexts)
+ filter_unnecessary_flips(Items0, CurPos, Items)
;
- ( Item1 = item_module_defn(_, md_implementation) ->
+ (
+ Item1 = item_module_defn(ItemModuleDefn1),
+ ItemModuleDefn1 = item_module_defn_info(_, md_implementation, _)
+ ->
NextPos = in_implementation
- ; Item1 = item_module_defn(_, md_interface) ->
+ ;
+ Item1 = item_module_defn(ItemModuleDefn1),
+ ItemModuleDefn1 = item_module_defn_info(_, md_interface, _)
+ ->
NextPos = in_interface
- ; chunkable_item(Item1) = yes ->
+ ;
+ Chunkable1 = chunkable_item(Item1),
+ (
+ Chunkable1 = yes,
NextPos = CurPos
;
+ Chunkable1 = no,
NextPos = other
+ )
),
- filter_unnecessary_flips([ItemAndContext2 | ItemAndContexts0], NextPos,
- ItemAndContextsTail),
- ItemAndContexts = [ItemAndContext1 | ItemAndContextsTail]
+ filter_unnecessary_flips([Item2 | Items0], NextPos, ItemsTail),
+ Items = [Item1 | ItemsTail]
).
% Find a chunk of items which should in most cases (but unfortunately
@@ -7920,55 +8223,52 @@
% prefix of items for which this reordering is safe. The chunk will then
% be followed by the ordered versions of later chunks, if any.
%
-:- pred do_order_items(item_list::in, item_list::out) is det.
+:- pred do_order_items(list(item)::in, list(item)::out) is det.
do_order_items([], []).
-do_order_items([ItemAndContext0 | ItemAndContexts0], OrderedItemAndContexts) :-
- ( chunkable_item_and_context(ItemAndContext0) = yes ->
- list.takewhile(is_chunkable, ItemAndContexts0, FrontItemAndContexts,
- RemainItemAndContexts),
- list.filter(is_reorderable, [ItemAndContext0 | FrontItemAndContexts],
- ReorderableItemAndContexts, NonReorderableItemAndContexts),
- list.filter(import_or_use, ReorderableItemAndContexts,
- ImportReorderableItemAndContexts,
- NonImportReorderableItemAndContexts),
- list.filter(symname_orderable, NonReorderableItemAndContexts,
- SymNameItemAndContexts, NonSymNameItemAndContexts),
+do_order_items([Item0 | Items0], OrderedItems) :-
+ Chunkable0 = chunkable_item(Item0),
+ (
+ Chunkable0 = yes,
+ list.takewhile(is_chunkable, Items0, FrontItems, RemainItems),
+ list.filter(is_reorderable, [Item0 | FrontItems],
+ ReorderableItems, NonReorderableItems),
+ list.filter(import_or_use, ReorderableItems,
+ ImportReorderableItems, NonImportReorderableItems),
+ list.filter(symname_orderable, NonReorderableItems,
+ SymNameItems, NonSymNameItems),
% We rely on the sort being stable to keep the items with the same
% sym_names in their original order.
- list.sort(compare_by_symname, SymNameItemAndContexts,
- OrderedSymNameItemAndContexts),
- do_order_items(RemainItemAndContexts, OrderedRemainItemAndContexts),
- OrderedItemAndContexts = list.sort(ImportReorderableItemAndContexts) ++
- list.sort(NonImportReorderableItemAndContexts) ++
- OrderedSymNameItemAndContexts ++ NonSymNameItemAndContexts ++
- OrderedRemainItemAndContexts
+ list.sort(compare_by_symname, SymNameItems, OrderedSymNameItems),
+ do_order_items(RemainItems, OrderedRemainItems),
+ OrderedItems = list.sort(ImportReorderableItems) ++
+ list.sort(NonImportReorderableItems) ++
+ OrderedSymNameItems ++ NonSymNameItems ++ OrderedRemainItems
;
- do_order_items(ItemAndContexts0, OrderedItemAndContextsTail),
- OrderedItemAndContexts = [ItemAndContext0 | OrderedItemAndContextsTail]
+ Chunkable0 = no,
+ do_order_items(Items0, OrderedItemsTail),
+ OrderedItems = [Item0 | OrderedItemsTail]
).
-:- pred import_or_use(item_and_context::in) is semidet.
-
-import_or_use(item_and_context(item_module_defn(_, md_import(_)), _)).
-import_or_use(item_and_context(item_module_defn(_, md_use(_)), _)).
+:- pred import_or_use(item::in) is semidet.
-:- pred is_reorderable(item_and_context::in) is semidet.
-
-is_reorderable(ItemAndContext) :-
- reorderable_item_and_context(ItemAndContext) = yes.
+import_or_use(item_module_defn(ItemModuleDefn)) :-
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ ( ModuleDefn = md_import(_)
+ ; ModuleDefn = md_use(_)
+ ).
-:- func reorderable_item_and_context(item_and_context) = bool.
+:- pred is_reorderable(item::in) is semidet.
-reorderable_item_and_context(item_and_context(Item, _Context)) =
- reorderable_item(Item).
+is_reorderable(Item) :-
+ reorderable_item(Item) = yes.
% The kinds of items for which reorderable_item returns yes can be
% arbitrarily reordered with respect to each other and with respect to
% other chunkable items in all kinds of interface files (.int, .int2,
% .int3, and .int0). This predicate is not relevant to .opt and
% .trans_opt files, since those are generated from the HLDS, not
- % from item_lists.
+ % from item lists.
%
% We should make this predicate call "unexpected" for items that should
% never occur in interface files. However, I don't have a reliable list
@@ -7976,7 +8276,39 @@
%
:- func reorderable_item(item) = bool.
-reorderable_item(item_module_defn(_, ModuleDefn)) = Reorderable :-
+reorderable_item(Item) = Reorderable :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ Reorderable = reorderable_module_defn(ModuleDefn)
+ ;
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ Reorderable = reorderable_pragma_type(Pragma)
+ ;
+ ( Item = item_type_defn(_)
+ ; Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_promise(_)
+ ; Item = item_typeclass(_)
+ ; Item = item_instance(_)
+ ),
+ Reorderable = yes
+ ;
+ ( Item = item_clause(_)
+ ; Item = item_pred_decl(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_mutable(_)
+ ; Item = item_nothing(_)
+ ),
+ Reorderable = no
+ ).
+
+:- func reorderable_module_defn(module_defn) = bool.
+
+reorderable_module_defn(ModuleDefn) = Reorderable :-
( ModuleDefn = md_import(_), Reorderable = yes
; ModuleDefn = md_abstract_imported, Reorderable = no
; ModuleDefn = md_end_module(_), Reorderable = no
@@ -7994,7 +8326,10 @@
; ModuleDefn = md_used(_), Reorderable = no
; ModuleDefn = md_version_numbers(_, _), Reorderable = no
).
-reorderable_item(item_pragma(_, Pragma)) = Reorderable :-
+
+:- func reorderable_pragma_type(pragma_type) = bool.
+
+reorderable_pragma_type(Pragma) = Reorderable :-
( Pragma = pragma_check_termination(_, _), Reorderable = yes
; Pragma = pragma_does_not_terminate(_, _), Reorderable = yes
; Pragma = pragma_exceptions(_, _, _, _, _), Reorderable = yes
@@ -8028,30 +8363,11 @@
; Pragma = pragma_unused_args(_, _, _, _, _), Reorderable = yes
; Pragma = pragma_require_feature_set(_), Reorderable = yes
).
-reorderable_item(item_type_defn(_, _, _, _, _)) = yes.
-reorderable_item(item_inst_defn(_, _, _, _, _)) = yes.
-reorderable_item(item_mode_defn(_, _, _, _, _)) = yes.
-reorderable_item(item_promise(_, _, _, _)) = yes.
-reorderable_item(item_typeclass(_, _, _, _, _, _)) = yes.
-reorderable_item(item_instance(_, _, _, _, _, _)) = yes.
-reorderable_item(item_clause(_, _, _, _, _, _)) = no.
-reorderable_item(item_nothing(_)) = no.
-reorderable_item(item_pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _, _)) =
- no.
-reorderable_item(item_pred_or_func_mode(_, _, _, _, _, _, _)) = no.
-reorderable_item(item_initialise(_, _, _)) = no.
-reorderable_item(item_finalise(_, _, _)) = no.
-reorderable_item(item_mutable(_, _, _, _, _, _)) = no.
-
-:- pred is_chunkable(item_and_context::in) is semidet.
-
-is_chunkable(ItemAndContext) :-
- chunkable_item_and_context(ItemAndContext) = yes.
-:- func chunkable_item_and_context(item_and_context) = bool.
+:- pred is_chunkable(item::in) is semidet.
-chunkable_item_and_context(item_and_context(Item, _Context)) =
- chunkable_item(Item).
+is_chunkable(Item) :-
+ chunkable_item(Item) = yes.
% Given a list of items for which chunkable_item returns yes, we need
% to keep the relative order of the non-reorderable items, but we can
@@ -8063,7 +8379,38 @@
%
:- func chunkable_item(item) = bool.
-chunkable_item(item_module_defn(_, ModuleDefn)) = Reorderable :-
+chunkable_item(Item) = Chunkable :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, _),
+ Chunkable = chunkable_module_defn(ModuleDefn)
+ ;
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, Pragma, _),
+ Chunkable = chunkable_pragma_type(Pragma)
+ ;
+ ( Item = item_clause(_)
+ ; Item = item_type_defn(_)
+ ; Item = item_inst_defn(_)
+ ; Item = item_mode_defn(_)
+ ; Item = item_pred_decl(_)
+ ; Item = item_mode_decl(_)
+ ; Item = item_promise(_)
+ ; Item = item_typeclass(_)
+ ; Item = item_instance(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_nothing(_)
+ ),
+ Chunkable = yes
+ ;
+ Item = item_mutable(_),
+ Chunkable = no
+ ).
+
+:- func chunkable_module_defn(module_defn) = bool.
+
+chunkable_module_defn(ModuleDefn) = Reorderable :-
( ModuleDefn = md_abstract_imported, Reorderable = no
; ModuleDefn = md_end_module(_), Reorderable = no
; ModuleDefn = md_export(_), Reorderable = yes
@@ -8081,7 +8428,10 @@
; ModuleDefn = md_used(_), Reorderable = no
; ModuleDefn = md_version_numbers(_, _), Reorderable = no
).
-chunkable_item(item_pragma(_, Pragma)) = Reorderable :-
+
+:- func chunkable_pragma_type(pragma_type) = bool.
+
+chunkable_pragma_type(Pragma) = Reorderable :-
( Pragma = pragma_check_termination(_, _), Reorderable = yes
; Pragma = pragma_does_not_terminate(_, _), Reorderable = yes
; Pragma = pragma_exceptions(_, _, _, _, _), Reorderable = no
@@ -8115,44 +8465,34 @@
; Pragma = pragma_unused_args(_, _, _, _, _), Reorderable = yes
; Pragma = pragma_require_feature_set(_), Reorderable = yes
).
-chunkable_item(item_type_defn(_, _, _, _, _)) = yes.
-chunkable_item(item_inst_defn(_, _, _, _, _)) = yes.
-chunkable_item(item_mode_defn(_, _, _, _, _)) = yes.
-chunkable_item(item_pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _, _)) = yes.
-chunkable_item(item_pred_or_func_mode(_, _, _, _, _, _, _)) = yes.
-chunkable_item(item_promise(_, _, _, _)) = yes.
-chunkable_item(item_typeclass(_, _, _, _, _, _)) = yes.
-chunkable_item(item_instance(_, _, _, _, _, _)) = yes.
-chunkable_item(item_clause(_, _, _, _, _, _)) = yes.
-chunkable_item(item_initialise(_, _, _)) = yes.
-chunkable_item(item_finalise(_, _, _)) = yes.
-chunkable_item(item_mutable(_, _, _, _, _, _)) = no.
-chunkable_item(item_nothing(_)) = yes.
% Given a list of items for which symname_ordered succeeds, we need to keep
% the relative order of the items with the same sym_name as returned by
% symname_ordered, but the relative order of items with different sym_names
% doesn't matter.
%
-:- pred symname_ordered(item_and_context::in, sym_name::out) is semidet.
+:- pred symname_ordered(item::in, sym_name::out) is semidet.
-symname_ordered(item_and_context(Item, _Context), Name) :-
- ( Item = item_pred_or_func(_, _, _, _, _, Name, _, _, _, _, _, _, _)
- ; Item = item_pred_or_func_mode(_, _, Name, _, _, _, _)
+symname_ordered(Item, Name) :-
+ (
+ Item = item_pred_decl(ItemPredDecl),
+ Name = ItemPredDecl ^ pf_name
+ ;
+ Item = item_mode_decl(ItemModeDecl),
+ Name = ItemModeDecl ^ pfm_name
).
-:- pred symname_orderable(item_and_context::in) is semidet.
+:- pred symname_orderable(item::in) is semidet.
-symname_orderable(ItemAndContext) :-
- symname_ordered(ItemAndContext, _).
+symname_orderable(Item) :-
+ symname_ordered(Item, _).
-:- pred compare_by_symname(item_and_context::in, item_and_context::in,
- comparison_result::out) is det.
+:- pred compare_by_symname(item::in, item::in, comparison_result::out) is det.
-compare_by_symname(ItemAndContextA, ItemAndContextB, Result) :-
+compare_by_symname(ItemA, ItemB, Result) :-
(
- symname_ordered(ItemAndContextA, SymNameA),
- symname_ordered(ItemAndContextB, SymNameB)
+ symname_ordered(ItemA, SymNameA),
+ symname_ordered(ItemB, SymNameB)
->
compare(Result, SymNameA, SymNameB)
;
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.204
diff -u -b -r1.204 prog_data.m
--- compiler/prog_data.m 25 Jan 2008 04:03:58 -0000 1.204
+++ compiler/prog_data.m 11 Feb 2008 14:55:02 -0000
@@ -704,11 +704,9 @@
% defined using the `pred(...) is <Name>' syntax
sym_name
)
-
; instance_proc_def_clauses(
% defined using clauses
- list(item) % the items must be either
- % pred_clause or func_clause items
+ list(item_clause_info)
).
:- type instance_body
Index: compiler/prog_foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_foreign.m,v
retrieving revision 1.14
diff -u -b -r1.14 prog_foreign.m
--- compiler/prog_foreign.m 14 Jul 2007 02:32:48 -0000 1.14
+++ compiler/prog_foreign.m 9 Feb 2008 01:16:30 -0000
@@ -151,11 +151,9 @@
:- func prefer_foreign_language(globals, compilation_target,
foreign_language, foreign_language) = bool.
- % The `multi' mode returns all supported foreign languages.
+ % Return all supported foreign languages.
%
-:- pred foreign_language(foreign_language).
-:- mode foreign_language(in) is det.
-:- mode foreign_language(out) is multi.
+:- func all_foreign_languages = list(foreign_language).
:- func foreign_type_language(foreign_language_type) = foreign_language.
@@ -192,6 +190,7 @@
:- import_module char.
:- import_module int.
+:- import_module solutions.
:- import_module string.
%-----------------------------------------------------------------------------%
@@ -340,11 +339,19 @@
%-----------------------------------------------------------------------------%
-foreign_language(lang_c).
-foreign_language(lang_java).
-foreign_language(lang_csharp).
-foreign_language(lang_il).
-foreign_language(lang_erlang).
+all_foreign_languages = Langs :-
+ GetLangs = (pred(Lang::out) is multi :- valid_foreign_language(Lang)),
+ solutions(GetLangs, Langs).
+
+:- pred valid_foreign_language(foreign_language).
+:- mode valid_foreign_language(in) is det.
+:- mode valid_foreign_language(out) is multi.
+
+valid_foreign_language(lang_c).
+valid_foreign_language(lang_java).
+valid_foreign_language(lang_csharp).
+valid_foreign_language(lang_il).
+valid_foreign_language(lang_erlang).
%-----------------------------------------------------------------------------%
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.288
diff -u -b -r1.288 prog_io.m
--- compiler/prog_io.m 22 Jan 2008 15:06:15 -0000 1.288
+++ compiler/prog_io.m 11 Feb 2008 14:44:14 -0000
@@ -105,13 +105,13 @@
%
:- pred read_module(open_file(FileInfo)::in(open_file),
module_name::in, bool::in, module_error::out, maybe(FileInfo)::out,
- module_name::out, message_list::out, item_list::out,
+ module_name::out, message_list::out, list(item)::out,
maybe(io.res(timestamp))::out, io::di, io::uo) is det.
:- pred read_module_if_changed(open_file(FileInfo)::in(open_file),
module_name::in, timestamp::in, module_error::out,
maybe(FileInfo)::out, module_name::out, message_list::out,
- item_list::out, maybe(io.res(timestamp))::out, io::di, io::uo) is det.
+ list(item)::out, maybe(io.res(timestamp))::out, io::di, io::uo) is det.
% Same as read_module, but use intermod_directories instead of
% search_directories when searching for the file.
@@ -119,7 +119,7 @@
% the expected module name.
%
:- pred read_opt_file(file_name::in, module_name::in, module_error::out,
- message_list::out, item_list::out, io::di, io::uo) is det.
+ message_list::out, list(item)::out, io::di, io::uo) is det.
% check_module_has_expected_name(FileName, ExpectedName, ActualName):
%
@@ -168,8 +168,8 @@
% otherwise it is bound to an appropriate error message. Qualify
% appropriate parts of the item, with ModuleName as the module name.
%
-:- pred parse_item(module_name::in, varset::in, term::in,
- maybe_item_and_context::out) is det.
+:- pred parse_item(module_name::in, varset::in, term::in, maybe1(item)::out)
+ is det.
% parse_decl(ModuleName, VarSet, Term, Result):
%
@@ -178,14 +178,14 @@
% Qualify appropriate parts of the item, with ModuleName as the module
% name.
%
-:- pred parse_decl(module_name::in, varset::in, term::in,
- maybe_item_and_context::out) is det.
+:- pred parse_decl(module_name::in, varset::in, term::in, maybe1(item)::out)
+ is det.
- % parse_type_defn_head(ModuleName, Head, Body, HeadResult):
+ % parse_type_defn_head(ModuleName, Head, HeadResult):
%
% Check the head of a type definition for errors.
%
-:- pred parse_type_defn_head(module_name::in, term::in, term::in,
+:- pred parse_type_defn_head(module_name::in, term::in,
maybe2(sym_name, list(type_param))::out) is det.
% parse_type_decl_where_part_if_present(TypeSymName, Arity,
@@ -230,7 +230,7 @@
% ContainingTerm, Msg, Result):
%
% parse_implicitly_qualified_term/5 takes a default module name and a term,
- % (and also the containing term, and a string describing the context from
+ % and also the containing term, and a string describing the context from
% which it was called (e.g. "clause head"), and returns a sym_name and
% a list of argument terms. Returns an error on ill-formed input or
% a module qualifier that doesn't match the DefaultModName.
@@ -342,7 +342,7 @@
%
:- pred read_module_2(open_file(T)::in(open_file), module_name::in,
maybe(timestamp)::in, bool::in, module_error::out, maybe(T)::out,
- module_name::out, message_list::out, item_list::out,
+ module_name::out, message_list::out, list(item)::out,
maybe(io.res(timestamp))::out, io::di, io::uo) is det.
read_module_2(OpenFile, DefaultModuleName, MaybeOldTimestamp, ReturnTimestamp,
@@ -575,25 +575,25 @@
% Extract the final `:- end_module' declaration if any.
%
-:- pred get_end_module(module_name::in, item_list::in, item_list::out,
+:- pred get_end_module(module_name::in, list(item)::in, list(item)::out,
module_end::out) is det.
-get_end_module(ModuleName, RevItemAndContexts0, RevItemAndContexts,
- EndModule) :-
+get_end_module(ModuleName, RevItems0, RevItems, EndModule) :-
(
% Note: if the module name in the end_module declaration does not match
% what we expect, given the source file name, then we assume that it is
% for a nested module, and so we leave it alone. If it is not for a
% nested module, the error will be caught by make_hlds.
- RevItemAndContexts0 = [item_and_context(Item, Context) |
- RevItemAndContextsPrime],
- Item = item_module_defn(_VarSet, md_end_module(ModuleName))
+ RevItems0 = [Item | RevItemsPrime],
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, ModuleDefn, Context),
+ ModuleDefn = md_end_module(ModuleName)
->
- RevItemAndContexts = RevItemAndContextsPrime,
+ RevItems = RevItemsPrime,
EndModule = module_end_yes(ModuleName, Context)
;
- RevItemAndContexts = RevItemAndContexts0,
+ RevItems = RevItems0,
EndModule = module_end_no
).
@@ -604,15 +604,16 @@
% and construct the final parsing result.
%
:- pred check_end_module(module_end::in, message_list::in, message_list::out,
- item_list::in, item_list::out, module_error::in, module_error::out) is det.
+ list(item)::in, list(item)::out, module_error::in, module_error::out)
+ is det.
-check_end_module(EndModule, !Messages, !ItemAndContexts, !Error) :-
+check_end_module(EndModule, !Messages, !Items, !Error) :-
% Double-check that the first item is a `:- module ModuleName' declaration,
% and remove it from the front of the item list.
(
- !.ItemAndContexts = [ItemAndContext | !:ItemAndContexts],
- ItemAndContext = item_and_context(Item, _Context1),
- Item = item_module_defn(_VarSet, md_module(ModuleName1))
+ !.Items = [Item | !:Items],
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, md_module(ModuleName1), _)
->
% Check that the end module declaration (if any) matches
% the begin module declaration.
@@ -706,7 +707,7 @@
% We use a continuation-passing style here.
%
:- pred read_all_items(module_name::in, module_name::out, message_list::out,
- item_list::out, module_error::out, io::di, io::uo) is det.
+ list(item)::out, module_error::out, io::di, io::uo) is det.
read_all_items(DefaultModuleName, ModuleName, Messages, Items, Error, !IO) :-
% Read all the items (the first one is handled specially).
@@ -750,8 +751,8 @@
% we reparse it in the default module scope. Blecchh.
%
:- pred read_first_item(module_name::in, file_name::in, file_name::out,
- module_name::out, message_list::out, item_list::out, maybe(read_term)::out,
- module_error::out, io.state::di, io.state::uo) is det.
+ module_name::out, message_list::out, list(item)::out,
+ maybe(read_term)::out, module_error::out, io::di, io::uo) is det.
read_first_item(DefaultModuleName, !SourceFileName, ModuleName,
Messages, Items, MaybeSecondTerm, Error, !IO) :-
@@ -767,15 +768,19 @@
(
% Apply and then skip `pragma source_file' decls, by calling ourselves
% recursively with the new source file name.
- MaybeFirstItem = read_item_ok(FirstItem, _),
- FirstItem = item_pragma(_, pragma_source_file(!:SourceFileName))
+ MaybeFirstItem = read_item_ok(FirstItem),
+ FirstItem = item_pragma(FirstItemPragma),
+ FirstItemPragma = item_pragma_info(_,
+ pragma_source_file(!:SourceFileName), _)
->
read_first_item(DefaultModuleName, !SourceFileName,
ModuleName, Messages, Items, MaybeSecondTerm, Error, !IO)
;
% Check if the first term was a `:- module' decl.
- MaybeFirstItem = read_item_ok(FirstItem, FirstContext),
- FirstItem = item_module_defn(_VarSet, ModuleDefn),
+ MaybeFirstItem = read_item_ok(FirstItem),
+ FirstItem = item_module_defn(FirstItemModuleDefn),
+ FirstItemModuleDefn = item_module_defn_info(_VarSet, ModuleDefn,
+ FirstContext),
ModuleDefn = md_module(StartModuleName)
->
% If so, then check that it matches the expected module name,
@@ -806,8 +811,8 @@
% If the first term was not a `:- module' decl, then issue a warning
% (if warning enabled), and insert an implicit `:- module ModuleName'
% decl.
- ( MaybeFirstItem = read_item_ok(_FirstItem, FirstContext0) ->
- FirstContext = FirstContext0
+ ( MaybeFirstItem = read_item_ok(FirstItem) ->
+ FirstContext = get_item_context(FirstItem)
;
term.context_init(!.SourceFileName, 1, FirstContext)
),
@@ -832,12 +837,13 @@
).
:- pred make_module_decl(module_name::in, term.context::in,
- item_and_context::out) is det.
+ item::out) is det.
-make_module_decl(ModuleName, Context, item_and_context(Item, Context)) :-
+make_module_decl(ModuleName, Context, Item) :-
varset.init(EmptyVarSet),
ModuleDefn = md_module(ModuleName),
- Item = item_module_defn(EmptyVarSet, ModuleDefn).
+ ItemInfo = item_module_defn_info(EmptyVarSet, ModuleDefn, Context),
+ Item = item_module_defn(ItemInfo).
:- pred maybe_add_warning(bool::in, read_term::in, term.context::in,
string::in, message_list::in, message_list::out) is det.
@@ -863,8 +869,8 @@
% garbage collection. But optimizing for NU-Prolog is no longer a concern.
:- pred read_items_loop(module_name::in, file_name::in,
- message_list::in, message_list::out, item_list::in, item_list::out,
- module_error::in, module_error::out, io.state::di, io.state::uo) is det.
+ message_list::in, message_list::out, list(item)::in, list(item)::out,
+ module_error::in, module_error::out, io::di, io::uo) is det.
read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, !IO) :-
read_item(ModuleName, SourceFileName, MaybeItem, !IO),
@@ -875,11 +881,11 @@
:- pred read_items_loop_2(read_item_result::in, module_name::in,
file_name::in, message_list::in, message_list::out,
- item_list::in, item_list::out, module_error::in, module_error::out,
- io.state::di, io.state::uo) is det.
+ list(item)::in, list(item)::out, module_error::in, module_error::out,
+ io::di, io::uo) is det.
read_items_loop_2(MaybeItemOrEOF, !.ModuleName, !.SourceFileName, !Msgs,
- !ItemAndContexts, !Error, !IO) :-
+ !Items, !Error, !IO) :-
(
MaybeItemOrEOF = read_item_eof
% If the next item was end-of-file, then we're done.
@@ -893,7 +899,7 @@
!:Msgs = [ThisError | !.Msgs],
!:Error = some_module_errors,
read_items_loop(!.ModuleName, !.SourceFileName, !Msgs,
- !ItemAndContexts, !Error, !IO)
+ !Items, !Error, !IO)
;
MaybeItemOrEOF = read_item_errors(Errors),
% If the next item was a semantic error, then insert it in the list
@@ -901,24 +907,26 @@
list.foldl(add_error, Errors, !Msgs),
!:Error = some_module_errors,
read_items_loop(!.ModuleName, !.SourceFileName, !Msgs,
- !ItemAndContexts, !Error, !IO)
+ !Items, !Error, !IO)
;
- MaybeItemOrEOF = read_item_ok(Item, Context),
- read_items_loop_ok(Item, Context, !ModuleName, !SourceFileName,
- !Msgs, !ItemAndContexts, !Error, !IO),
+ MaybeItemOrEOF = read_item_ok(Item),
+ read_items_loop_ok(Item, !ModuleName, !SourceFileName,
+ !Msgs, !Items, !Error, !IO),
read_items_loop(!.ModuleName, !.SourceFileName, !Msgs,
- !ItemAndContexts, !Error, !IO)
+ !Items, !Error, !IO)
).
-:- pred read_items_loop_ok(item::in, term.context::in,
- module_name::in, module_name::out, file_name::in, file_name::out,
- message_list::in, message_list::out,
- item_list::in, item_list::out, module_error::in, module_error::out,
- io.state::di, io.state::uo) is det.
-
-read_items_loop_ok(Item0, Context, !ModuleName, !SourceFileName, !Msgs,
- !ItemAndContexts, !Error, !IO) :-
- ( Item0 = item_nothing(yes(Warning)) ->
+:- pred read_items_loop_ok(item::in, module_name::in, module_name::out,
+ file_name::in, file_name::out, message_list::in, message_list::out,
+ list(item)::in, list(item)::out, module_error::in, module_error::out,
+ io::di, io::uo) is det.
+
+read_items_loop_ok(Item0, !ModuleName, !SourceFileName, !Msgs, !Items,
+ !Error, !IO) :-
+ (
+ Item0 = item_nothing(ItemNothing0),
+ ItemNothing0 = item_nothing_info(yes(Warning), Context0)
+ ->
Warning = item_warning(MaybeOption, Msg, Term),
(
MaybeOption = yes(Option),
@@ -941,72 +949,82 @@
;
Warn = no
),
- Item = item_nothing(no)
+ ItemNothing = item_nothing_info(no, Context0),
+ Item = item_nothing(ItemNothing)
;
Item = Item0
),
- % If the next item was a valid item, check whether it was
- % a declaration that affects the current parsing context --
- % i.e. either a `module'/`end_module' declaration or a
- % `pragma source_file' declaration. If so, set the new
- % parsing context according. Next, unless the item is a
- % `pragma source_file' declaration, insert it into the item list.
+ % If the next item was a valid item, check whether it was a declaration
+ % that affects the current parsing context -- i.e. either a `module' or
+ % `end_module' declaration, or a `pragma source_file' declaration.
+ % If so, set the new parsing context according. Next, unless the item
+ % is a `pragma source_file' declaration, insert it into the item list.
% Then continue looping.
- ( Item = item_pragma(_, pragma_source_file(NewSourceFileName)) ->
+ (
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, PragmaType, _),
+ PragmaType = pragma_source_file(NewSourceFileName)
+ ->
!:SourceFileName = NewSourceFileName
- ; Item = item_module_defn(_VarSet, md_module(NestedModuleName)) ->
+ ;
+ Item = item_module_defn(ItemModuleDefn)
+ ->
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ ( ModuleDefn = md_module(NestedModuleName) ->
!:ModuleName = NestedModuleName,
- !:ItemAndContexts = [item_and_context(Item, Context) |
- !.ItemAndContexts]
- ; Item = item_module_defn(_VarSet, md_end_module(NestedModuleName)) ->
+ !:Items = [Item | !.Items]
+ ; ModuleDefn = md_end_module(NestedModuleName) ->
root_module_name(RootModuleName),
sym_name_get_module_name(NestedModuleName, RootModuleName,
ParentModuleName),
!:ModuleName = ParentModuleName,
- !:ItemAndContexts = [item_and_context(Item, Context) |
- !.ItemAndContexts]
- ; Item = item_module_defn(VarSet, md_import(list_module(Modules))) ->
- ImportItems = list.map(make_pseudo_import_module_decl(VarSet, Context),
+ !:Items = [Item | !.Items]
+ ; ModuleDefn = md_import(list_module(Modules)) ->
+ ImportItems = list.map(
+ make_pseudo_import_module_decl(VarSet, Context),
Modules),
- list.append(ImportItems, !ItemAndContexts)
- ; Item = item_module_defn(VarSet, md_use(list_module(Modules))) ->
- UseItems = list.map(make_pseudo_use_module_decl(VarSet, Context),
+ !:Items = ImportItems ++ !.Items
+ ; ModuleDefn = md_use(list_module(Modules)) ->
+ UseItems = list.map(
+ make_pseudo_use_module_decl(VarSet, Context),
Modules),
- list.append(UseItems, !ItemAndContexts)
- ; Item = item_module_defn(VarSet, md_include_module(Modules)) ->
+ !:Items = UseItems ++ !.Items
+ ; ModuleDefn = md_include_module(Modules) ->
IncludeItems = list.map(
make_pseudo_include_module_decl(VarSet, Context),
Modules),
- list.append(IncludeItems, !ItemAndContexts)
+ !:Items = IncludeItems ++ !.Items
+ ;
+ !:Items = [Item | !.Items]
+ )
;
- !:ItemAndContexts = [item_and_context(Item, Context) |
- !.ItemAndContexts]
+ !:Items = [Item | !.Items]
).
:- func make_pseudo_import_module_decl(prog_varset, prog_context,
- module_specifier) = item_and_context.
+ module_specifier) = item.
-make_pseudo_import_module_decl(Varset, Context, ModuleSpecifier) =
- item_and_context(
- item_module_defn(Varset, md_import(list_module([ModuleSpecifier]))),
- Context).
+make_pseudo_import_module_decl(Varset, Context, ModuleSpecifier) = Item :-
+ ModuleDefn = md_import(list_module([ModuleSpecifier])),
+ ItemModuleDefn = item_module_defn_info(Varset, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn).
:- func make_pseudo_use_module_decl(prog_varset, prog_context,
- module_specifier) = item_and_context.
+ module_specifier) = item.
-make_pseudo_use_module_decl(Varset, Context, ModuleSpecifier) =
- item_and_context(
- item_module_defn(Varset, md_use(list_module([ModuleSpecifier]))),
- Context).
+make_pseudo_use_module_decl(Varset, Context, ModuleSpecifier) = Item :-
+ ModuleDefn = md_use(list_module([ModuleSpecifier])),
+ ItemModuleDefn = item_module_defn_info(Varset, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn).
:- func make_pseudo_include_module_decl(prog_varset, prog_context, module_name)
- = item_and_context.
+ = item.
-make_pseudo_include_module_decl(Varset, Context, ModuleSpecifier) =
- item_and_context(
- item_module_defn(Varset, md_include_module([ModuleSpecifier])),
- Context).
+make_pseudo_include_module_decl(Varset, Context, ModuleSpecifier) = Item :-
+ ModuleDefn = md_include_module([ModuleSpecifier]),
+ ItemModuleDefn = item_module_defn_info(Varset, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn).
%-----------------------------------------------------------------------------%
@@ -1014,7 +1032,7 @@
---> read_item_eof
; read_item_syntax_error(file_name, int)
; read_item_errors(assoc_list(string, term))
- ; read_item_ok(item, term.context).
+ ; read_item_ok(item).
% Read_item/1 reads a single item, and if it is a valid term parses it.
%
@@ -1035,10 +1053,10 @@
parse_item(ModuleName, VarSet, Term, MaybeItem),
convert_item(MaybeItem, MaybeItemOrEof).
-:- pred convert_item(maybe_item_and_context::in, read_item_result::out) is det.
+:- pred convert_item(maybe1(item)::in, read_item_result::out) is det.
-convert_item(ok2(Item, Context), read_item_ok(Item, Context)).
-convert_item(error2(Errors), read_item_errors(Errors)).
+convert_item(ok1(Item), read_item_ok(Item)).
+convert_item(error1(Errors), read_item_errors(Errors)).
parse_item(ModuleName, VarSet, Term, Result) :-
( Term = term.functor(term.atom(":-"), [Decl], _DeclContext) ->
@@ -1057,25 +1075,18 @@
;
% It's a fact.
Head = Term,
- ( Head = term.functor(_Functor, _Args, HeadContext) ->
- TheContext = HeadContext
- ;
- % Term consists of just a single variable - the context
- % has been lost.
- term.context_init(TheContext)
- ),
+ TheContext = get_term_context(Head),
Body = term.functor(term.atom("true"), [], TheContext)
),
varset.coerce(VarSet, ProgVarSet),
- process_clause(ModuleName, Term, Head, Body, TheContext, ProgVarSet,
+ process_clause(ModuleName, Term, Head, Body, ProgVarSet, TheContext,
Result)
).
:- pred process_clause(module_name::in, term::in, term::in, term::in,
- term.context::in, prog_varset::in, maybe_item_and_context::out) is det.
+ prog_varset::in, term.context::in, maybe1(item)::out) is det.
-process_clause(ModuleName, Term, Head, Body0, TheContext, ProgVarSet0,
- Result) :-
+process_clause(ModuleName, Term, Head, Body0, ProgVarSet0, Context, Result) :-
parse_goal(Body0, MaybeBody, ProgVarSet0, ProgVarSet),
(
MaybeBody = ok1(Body),
@@ -1086,36 +1097,52 @@
parse_implicitly_qualified_term(ModuleName, FuncHead, Head,
"equation head", MaybeFunctor),
process_func_clause(MaybeFunctor, FuncResult, ProgVarSet, Body,
- MaybeItem)
+ Context, Result)
;
parse_implicitly_qualified_term(ModuleName, Head, Term,
"clause head", MaybeFunctor),
- process_pred_clause(MaybeFunctor, ProgVarSet, Body, MaybeItem)
- ),
- add_context(MaybeItem, TheContext, Result)
+ process_pred_clause(MaybeFunctor, ProgVarSet, Body, Context,
+ Result)
+ )
;
MaybeBody = error1(Errors),
- Result = error2(Errors)
+ Result = error1(Errors)
).
:- pred process_pred_clause(maybe_functor::in, prog_varset::in, goal::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item)::out) is det.
-process_pred_clause(ok2(Name, Args0), VarSet, Body,
- ok1(item_clause(user, VarSet, pf_predicate, Name, Args, Body))) :-
- list.map(term.coerce, Args0, Args).
-process_pred_clause(error2(Errors0), _, _, error1(Errors)) :-
- Errors = assoc_list.map_values_only(term.coerce, Errors0).
+process_pred_clause(MaybeFunctor, VarSet, Body, Context, MaybeItem) :-
+ (
+ MaybeFunctor = ok2(Name, Args0),
+ list.map(term.coerce, Args0, Args),
+ ItemClause = item_clause_info(user, VarSet, pf_predicate, Name,
+ Args, Body, Context),
+ Item = item_clause(ItemClause),
+ MaybeItem = ok1(Item)
+ ;
+ MaybeFunctor = error2(Errors0),
+ Errors = assoc_list.map_values_only(term.coerce, Errors0),
+ MaybeItem = error1(Errors)
+ ).
:- pred process_func_clause(maybe_functor::in, term::in, prog_varset::in,
- goal::in, maybe1(item)::out) is det.
+ goal::in, prog_context::in, maybe1(item)::out) is det.
-process_func_clause(ok2(Name, Args0), Result0, VarSet, Body,
- ok1(item_clause(user, VarSet, pf_function, Name, Args, Body))) :-
+process_func_clause(MaybeFunctor, Result0, VarSet, Body, Context, MaybeItem) :-
+ (
+ MaybeFunctor = ok2(Name, Args0),
list.append(Args0, [Result0], Args1),
- list.map(term.coerce, Args1, Args).
-process_func_clause(error2(Errors0), _, _, _, error1(Errors)) :-
- Errors = assoc_list.map_values_only(term.coerce, Errors0).
+ list.map(term.coerce, Args1, Args),
+ ItemClause = item_clause_info(user, VarSet, pf_function, Name,
+ Args, Body, Context),
+ Item = item_clause(ItemClause),
+ MaybeItem = ok1(Item)
+ ;
+ MaybeFunctor = error2(Errors0),
+ Errors = assoc_list.map_values_only(term.coerce, Errors0),
+ MaybeItem = error1(Errors)
+ ).
%-----------------------------------------------------------------------------%
@@ -1146,20 +1173,25 @@
% attributes, in the order innermost to outermost.
%
:- pred parse_decl_2(module_name::in, varset::in, term::in, decl_attrs::in,
- maybe_item_and_context::out) is det.
+ maybe1(item)::out) is det.
parse_decl_2(ModuleName, VarSet, F, Attributes, Result) :-
( F = term.functor(term.atom(Atom), Args, Context) ->
- ( parse_decl_attribute(Atom, Args, Attribute, SubTerm) ->
+ (
+ parse_decl_attribute(Atom, Args, Attribute, SubTerm)
+ ->
NewAttributes = [Attribute - F | Attributes],
parse_decl_2(ModuleName, VarSet, SubTerm, NewAttributes, Result)
- ; process_decl(ModuleName, VarSet, Atom, Args, Attributes, R) ->
- add_context(R, Context, Result)
;
- Result = error2(["unrecognized declaration" - F])
+ process_decl(ModuleName, VarSet, Atom, Args, Attributes, Context,
+ ResultPrime)
+ ->
+ ResultPrime = Result
+ ;
+ Result = error1(["unrecognized declaration" - F])
)
;
- Result = error2(["atom expected after `:-'" - F])
+ Result = error1(["atom expected after `:-'" - F])
).
% process_decl(ModuleName, VarSet, Attributes, Atom, Args, Result):
@@ -1169,151 +1201,169 @@
% enclosing declaration attributes, in the order outermost to innermost.
%
:- pred process_decl(module_name::in, varset::in, string::in, list(term)::in,
- decl_attrs::in, maybe1(item)::out) is semidet.
+ decl_attrs::in, prog_context::in, maybe1(item)::out) is semidet.
-process_decl(ModuleName, VarSet, "type", [TypeDecl], Attributes, Result) :-
- parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Result).
-
-process_decl(ModuleName, VarSet, "pred", [PredDecl], Attributes, Result) :-
- parse_type_decl_pred(ModuleName, VarSet, PredDecl, Attributes, Result).
+process_decl(ModuleName, VarSet, "type", [TypeDecl], Attributes, Context,
+ Result) :-
+ parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Context, Result).
-process_decl(ModuleName, VarSet, "func", [FuncDecl], Attributes, Result) :-
- parse_type_decl_func(ModuleName, VarSet, FuncDecl, Attributes, Result).
+process_decl(ModuleName, VarSet, "pred", [PredDecl], Attributes, Context,
+ Result) :-
+ parse_type_decl_pred(ModuleName, VarSet, PredDecl, Attributes, Context,
+ Result).
-process_decl(ModuleName, VarSet, "mode", [ModeDecl], Attributes, Result) :-
- parse_mode_decl(ModuleName, VarSet, ModeDecl, Attributes, Result).
+process_decl(ModuleName, VarSet, "func", [FuncDecl], Attributes, Context,
+ Result) :-
+ parse_type_decl_func(ModuleName, VarSet, FuncDecl, Attributes, Context,
+ Result).
-process_decl(ModuleName, VarSet, "inst", [InstDecl], Attributes, Result) :-
- parse_inst_decl(ModuleName, VarSet, InstDecl, Result0),
+process_decl(ModuleName, VarSet, "mode", [ModeDecl], Attributes,
+ Context, Result) :-
+ parse_mode_decl(ModuleName, VarSet, ModeDecl, Attributes, Context, Result).
+
+process_decl(ModuleName, VarSet, "inst", [InstDecl], Attributes,
+ Context, Result) :-
+ parse_inst_decl(ModuleName, VarSet, InstDecl, Context, Result0),
check_no_attributes(Result0, Attributes, Result).
process_decl(_ModuleName, VarSet, "import_module", [ModuleSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_module_specifier, make_module, make_import,
- ModuleSpec, Attributes, VarSet, Result).
+ ModuleSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "use_module", [ModuleSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_module_specifier, make_module, make_use,
- ModuleSpec, Attributes, VarSet, Result).
+ ModuleSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "export_module", [ModuleSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_module_specifier, make_module, make_export,
- ModuleSpec, Attributes, VarSet, Result).
+ ModuleSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "import_sym", [SymSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_symbol_specifier, make_sym, make_import,
- SymSpec, Attributes, VarSet, Result).
+ SymSpec, Attributes, VarSet, Context, Result).
-process_decl(_ModuleName, VarSet, "use_sym", [SymSpec], Attributes, Result) :-
+process_decl(_ModuleName, VarSet, "use_sym", [SymSpec], Attributes,
+ Context, Result) :-
parse_symlist_decl(parse_symbol_specifier, make_sym, make_use,
- SymSpec, Attributes, VarSet, Result).
+ SymSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "export_sym", [SymSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_symbol_specifier, make_sym, make_export,
- SymSpec, Attributes, VarSet, Result).
+ SymSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "import_pred", [PredSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_predicate_specifier, make_pred, make_import,
- PredSpec, Attributes, VarSet, Result).
+ PredSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "use_pred", [PredSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_predicate_specifier, make_pred, make_use,
- PredSpec, Attributes, VarSet, Result).
+ PredSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "export_pred", [PredSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_predicate_specifier, make_pred, make_export,
- PredSpec, Attributes, VarSet, Result).
+ PredSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "import_func", [FuncSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_function_specifier, make_func, make_import,
- FuncSpec, Attributes, VarSet, Result).
+ FuncSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "use_func", [FuncSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_function_specifier, make_func, make_use,
- FuncSpec, Attributes, VarSet, Result).
+ FuncSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "export_func", [FuncSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_function_specifier, make_func, make_export,
- FuncSpec, Attributes, VarSet, Result).
+ FuncSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "import_cons", [ConsSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_constructor_specifier, make_cons, make_import,
- ConsSpec, Attributes, VarSet, Result).
+ ConsSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "use_cons", [ConsSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_constructor_specifier, make_cons, make_use,
- ConsSpec, Attributes, VarSet, Result).
+ ConsSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "export_cons", [ConsSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_constructor_specifier, make_cons, make_export,
- ConsSpec, Attributes, VarSet, Result).
+ ConsSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "import_type", [TypeSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_type_specifier, make_type, make_import,
- TypeSpec, Attributes, VarSet, Result).
+ TypeSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "use_type", [TypeSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_type_specifier, make_type, make_use,
- TypeSpec, Attributes, VarSet, Result).
+ TypeSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "export_type", [TypeSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_type_specifier, make_type, make_export,
- TypeSpec, Attributes, VarSet, Result).
+ TypeSpec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "import_adt", [ADT_Spec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_adt_specifier, make_adt, make_import,
- ADT_Spec, Attributes, VarSet, Result).
+ ADT_Spec, Attributes, VarSet, Context, Result).
-process_decl(_ModuleName, VarSet, "use_adt", [ADT_Spec], Attributes, Result) :-
+process_decl(_ModuleName, VarSet, "use_adt", [ADT_Spec], Attributes,
+ Context, Result) :-
parse_symlist_decl(parse_adt_specifier, make_adt, make_use,
- ADT_Spec, Attributes, VarSet, Result).
+ ADT_Spec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "export_adt", [ADT_Spec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_adt_specifier, make_adt, make_export,
- ADT_Spec, Attributes, VarSet, Result).
+ ADT_Spec, Attributes, VarSet, Context, Result).
process_decl(_ModuleName, VarSet, "import_op", [OpSpec], Attributes,
- Result) :-
+ Context, Result) :-
parse_symlist_decl(parse_op_specifier, make_op, make_import,
- OpSpec, Attributes, VarSet, Result).
+ OpSpec, Attributes, VarSet, Context, Result).
-process_decl(_ModuleName, VarSet, "use_op", [OpSpec], Attributes, Result) :-
+process_decl(_ModuleName, VarSet, "use_op", [OpSpec], Attributes,
+ Context, Result) :-
parse_symlist_decl(parse_op_specifier, make_op, make_use,
- OpSpec, Attributes, VarSet, Result).
+ OpSpec, Attributes, VarSet, Context, Result).
-process_decl(_ModuleName, VarSet, "export_op", [OpSpec], Attributes, Result) :-
+process_decl(_ModuleName, VarSet, "export_op", [OpSpec], Attributes,
+ Context, Result) :-
parse_symlist_decl(parse_op_specifier, make_op, make_export,
- OpSpec, Attributes, VarSet, Result).
+ OpSpec, Attributes, VarSet, Context, Result).
-process_decl(_ModuleName, VarSet0, "interface", [], Attributes, Result) :-
+process_decl(_ModuleName, VarSet0, "interface", [], Attributes, Context,
+ Result) :-
varset.coerce(VarSet0, VarSet),
- Result0 = ok1(item_module_defn(VarSet, md_interface)),
+ ItemModuleDefn = item_module_defn_info(VarSet, md_interface, Context),
+ Item = item_module_defn(ItemModuleDefn),
+ Result0 = ok1(Item),
check_no_attributes(Result0, Attributes, Result).
-process_decl(_ModuleName, VarSet0, "implementation", [], Attributes, Result) :-
+process_decl(_ModuleName, VarSet0, "implementation", [], Attributes, Context,
+ Result) :-
varset.coerce(VarSet0, VarSet),
- Result0 = ok1(item_module_defn(VarSet, md_implementation)),
+ ItemModuleDefn = item_module_defn_info(VarSet, md_implementation, Context),
+ Item = item_module_defn(ItemModuleDefn),
+ Result0 = ok1(Item),
check_no_attributes(Result0, Attributes, Result).
-process_decl(ModuleName, VarSet, "external", Args, Attributes, Result) :-
+process_decl(ModuleName, VarSet, "external", Args, Attributes, Context,
+ Result) :-
(
Args = [PredSpec],
MaybeBackend = no
@@ -1329,18 +1379,22 @@
),
MaybeBackend = yes(Backend)
),
- parse_implicitly_qualified_symbol_name_specifier(ModuleName,
- PredSpec, Result0),
- process_maybe1(make_external(VarSet, MaybeBackend), Result0, Result1),
+ parse_implicitly_qualified_symbol_name_specifier(ModuleName, PredSpec,
+ Result0),
+ process_maybe1(make_external(VarSet, MaybeBackend, Context), Result0,
+ Result1),
check_no_attributes(Result1, Attributes, Result).
process_decl(DefaultModuleName, VarSet0, "module", [ModuleName], Attributes,
- Result) :-
+ Context, Result) :-
parse_module_name(DefaultModuleName, ModuleName, Result0),
(
Result0 = ok1(ModuleNameSym),
varset.coerce(VarSet0, VarSet),
- Result1 = ok1(item_module_defn(VarSet, md_module(ModuleNameSym)))
+ ModuleDefn = md_module(ModuleNameSym),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn),
+ Result1 = ok1(Item)
;
Result0 = error1(Errors),
Result1 = error1(Errors)
@@ -1348,13 +1402,15 @@
check_no_attributes(Result1, Attributes, Result).
process_decl(DefaultModuleName, VarSet0, "include_module", [ModuleNames],
- Attributes, Result) :-
+ Attributes, Context, Result) :-
parse_list(parse_module_name(DefaultModuleName), ModuleNames, Result0),
(
Result0 = ok1(ModuleNameSyms),
varset.coerce(VarSet0, VarSet),
- Result1 = ok1(item_module_defn(VarSet,
- md_include_module(ModuleNameSyms)))
+ ModuleDefn = md_include_module(ModuleNameSyms),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn),
+ Result1 = ok1(Item)
;
Result0 = error1(Errors),
Result1 = error1(Errors)
@@ -1362,7 +1418,7 @@
check_no_attributes(Result1, Attributes, Result).
process_decl(DefaultModuleName, VarSet0, "end_module", [ModuleName],
- Attributes, Result) :-
+ Attributes, Context, Result) :-
% The name in an `end_module' declaration not inside the scope of the
% module being ended, so the default module name here is the parent
% of the previous default module name.
@@ -1374,48 +1430,69 @@
(
Result0 = ok1(ModuleNameSym),
varset.coerce(VarSet0, VarSet),
- Result1 = ok1(item_module_defn(VarSet, md_end_module(ModuleNameSym)))
+ ModuleDefn = md_end_module(ModuleNameSym),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn),
+ Result1 = ok1(Item)
;
Result0 = error1(Errors),
Result1 = error1(Errors)
),
check_no_attributes(Result1, Attributes, Result).
-process_decl(ModuleName, VarSet, "pragma", Pragma, Attributes, Result):-
- parse_pragma(ModuleName, VarSet, Pragma, Result0),
+process_decl(ModuleName, VarSet, "pragma", Pragma, Attributes, Context,
+ Result):-
+ parse_pragma(ModuleName, VarSet, Pragma, Context, Result0),
check_no_attributes(Result0, Attributes, Result).
-process_decl(ModuleName, VarSet, "promise", Assertion, Attributes, Result):-
+process_decl(ModuleName, VarSet, "promise", Assertion, Attributes, Context,
+ Result):-
parse_promise(ModuleName, promise_type_true, VarSet,
- Assertion, Attributes, Result0),
+ Assertion, Attributes, Context, Result0),
check_no_attributes(Result0, Attributes, Result).
process_decl(ModuleName, VarSet, "promise_exclusive", PromiseGoal, Attributes,
- Result):-
+ Context, Result):-
parse_promise(ModuleName, promise_type_exclusive, VarSet,
- PromiseGoal, Attributes, Result).
+ PromiseGoal, Attributes, Context, Result).
process_decl(ModuleName, VarSet, "promise_exhaustive", PromiseGoal, Attributes,
- Result):-
+ Context, Result):-
parse_promise(ModuleName, promise_type_exhaustive, VarSet,
- PromiseGoal, Attributes, Result).
+ PromiseGoal, Attributes, Context, Result).
process_decl(ModuleName, VarSet, "promise_exclusive_exhaustive", PromiseGoal,
- Attributes, Result):-
+ Attributes, Context, Result):-
parse_promise(ModuleName, promise_type_exclusive_exhaustive, VarSet,
- PromiseGoal, Attributes, Result).
+ PromiseGoal, Attributes, Context, Result).
-process_decl(ModuleName, VarSet, "typeclass", Args, Attributes, Result):-
- parse_typeclass(ModuleName, VarSet, Args, Result0),
- check_no_attributes(Result0, Attributes, Result).
+process_decl(ModuleName, VarSet, "typeclass", Args, Attributes, Context,
+ Result):-
+ parse_typeclass(ModuleName, VarSet, Args, Context, Result0),
+ (
+ Result0 = ok1(ItemTypeClass),
+ Result1 = ok1(item_typeclass(ItemTypeClass))
+ ;
+ Result0 = error1(Errors),
+ Result1 = error1(Errors)
+ ),
+ check_no_attributes(Result1, Attributes, Result).
-process_decl(ModuleName, VarSet, "instance", Args, Attributes, Result):-
- parse_instance(ModuleName, VarSet, Args, Result0),
- check_no_attributes(Result0, Attributes, Result).
+process_decl(ModuleName, VarSet, "instance", Args, Attributes, Context,
+ Result):-
+ parse_instance(ModuleName, VarSet, Args, Context, Result0),
+ (
+ Result0 = ok1(ItemInstance),
+ Result1 = ok1(item_instance(ItemInstance))
+ ;
+ Result0 = error1(Errors),
+ Result1 = error1(Errors)
+ ),
+ check_no_attributes(Result1, Attributes, Result).
process_decl(ModuleName, VarSet0, "version_numbers",
[VersionNumberTerm, ModuleNameTerm, VersionNumbersTerm],
- Attributes, Result) :-
+ Attributes, Context, Result) :-
parse_module_specifier(ModuleNameTerm, ModuleNameResult),
(
VersionNumberTerm = term.functor(term.integer(VersionNumber), [], _),
@@ -1429,8 +1506,11 @@
(
Result0 = ok1(VersionNumbers),
varset.coerce(VarSet0, VarSet),
- Result1 = ok1(item_module_defn(VarSet,
- md_version_numbers(ModuleName, VersionNumbers))),
+ ModuleDefn = md_version_numbers(ModuleName, VersionNumbers),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn,
+ Context),
+ Item = item_module_defn(ItemModuleDefn),
+ Result1 = ok1(Item),
check_no_attributes(Result1, Attributes, Result)
;
Result0 = error1(Errors),
@@ -1447,25 +1527,30 @@
dummy_term_with_context(Context, DummyTerm),
Warning = item_warning(yes(warn_smart_recompilation),
Msg, DummyTerm),
- Result = ok1(item_nothing(yes(Warning)))
+ ItemNothing = item_nothing_info(yes(Warning), Context),
+ Item = item_nothing(ItemNothing),
+ Result = ok1(Item)
;
Msg = "invalid version number in `:- version_numbers'",
Result = error1([Msg - VersionNumberTerm])
)
).
-process_decl(ModuleName, VarSet, InitDecl, Args, Attributes, Result) :-
+process_decl(ModuleName, VarSet, InitDecl, Args, Attributes, Context,
+ Result) :-
( InitDecl = "initialise" ; InitDecl = "initialize" ),
- parse_initialise_decl(ModuleName, VarSet, Args, Result0),
+ parse_initialise_decl(ModuleName, VarSet, Args, Context, Result0),
check_no_attributes(Result0, Attributes, Result).
-process_decl(ModuleName, VarSet, FinalDecl, Args, Attributes, Result) :-
+process_decl(ModuleName, VarSet, FinalDecl, Args, Attributes, Context,
+ Result) :-
( FinalDecl = "finalise" ; FinalDecl = "finalize" ),
- parse_finalise_decl(ModuleName, VarSet, Args, Result0),
+ parse_finalise_decl(ModuleName, VarSet, Args, Context, Result0),
check_no_attributes(Result0, Attributes, Result).
-process_decl(ModuleName, VarSet, "mutable", Args, Attributes, Result) :-
- parse_mutable_decl(ModuleName, VarSet, Args, Result0),
+process_decl(ModuleName, VarSet, "mutable", Args, Attributes, Context,
+ Result) :-
+ parse_mutable_decl(ModuleName, VarSet, Args, Context, Result0),
check_no_attributes(Result0, Attributes, Result).
:- pred parse_decl_attribute(string::in, list(term)::in, decl_attribute::out,
@@ -1517,9 +1602,11 @@
%-----------------------------------------------------------------------------%
:- pred parse_promise(module_name::in, promise_type::in, varset::in,
- list(term)::in, decl_attrs::in, maybe1(item)::out) is semidet.
+ list(term)::in, decl_attrs::in, prog_context::in, maybe1(item)::out)
+ is semidet.
-parse_promise(ModuleName, PromiseType, VarSet, [Term], Attributes, Result) :-
+parse_promise(ModuleName, PromiseType, VarSet, [Term], Attributes, Context,
+ Result) :-
varset.coerce(VarSet, ProgVarSet0),
parse_goal(Term, MaybeGoal0, ProgVarSet0, ProgVarSet),
(
@@ -1544,7 +1631,10 @@
list.map(term.coerce_var, UnivVars0, UnivVars),
Goal0 = Goal
),
- Result = ok1(item_promise(PromiseType, Goal, ProgVarSet, UnivVars))
+ ItemPromise = item_promise_info(PromiseType, Goal, ProgVarSet,
+ UnivVars, Context),
+ Item = item_promise(ItemPromise),
+ Result = ok1(Item)
;
MaybeGoal0 = error1(Errors),
Result = error1(Errors)
@@ -1553,9 +1643,9 @@
%-----------------------------------------------------------------------------%
:- pred parse_type_decl(module_name::in, varset::in, term::in, decl_attrs::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item)::out) is det.
-parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Result) :-
+parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Context, Result) :-
(
TypeDecl = term.functor(term.atom(Name), Args, _),
parse_type_decl_type(ModuleName, Name, Args, Attributes, Cond, R)
@@ -1568,21 +1658,26 @@
),
% We should check the condition for errors (don't bother at the moment,
% since we ignore conditions anyhow :-).
- process_maybe1(make_type_defn(VarSet, Cond1), R1, Result).
+ process_maybe1(make_type_defn(VarSet, Cond1, Context), R1, Result).
-:- pred make_type_defn(varset::in, condition::in, processed_type_body::in,
- item::out) is det.
+:- pred make_type_defn(varset::in, condition::in, prog_context::in,
+ processed_type_body::in, item::out) is det.
-make_type_defn(VarSet0, Cond, processed_type_body(Name, Args, TypeDefn),
- item_type_defn(VarSet, Name, Args, TypeDefn, Cond)) :-
- varset.coerce(VarSet0, VarSet).
+make_type_defn(VarSet0, Cond, Context, ProcessedTypeBody, Item) :-
+ ProcessedTypeBody = processed_type_body(Name, Args, TypeDefn),
+ varset.coerce(VarSet0, VarSet),
+ ItemTypeDefn = item_type_defn_info(VarSet, Name, Args, TypeDefn, Cond,
+ Context),
+ Item = item_type_defn(ItemTypeDefn).
-:- pred make_external(varset::in, maybe(backend)::in, sym_name_specifier::in,
- item::out) is det.
+:- pred make_external(varset::in, maybe(backend)::in, prog_context::in,
+ sym_name_specifier::in, item::out) is det.
-make_external(VarSet0, MaybeBackend, SymSpec,
- item_module_defn(VarSet, md_external(MaybeBackend, SymSpec))) :-
- varset.coerce(VarSet0, VarSet).
+make_external(VarSet0, MaybeBackend, Context, SymSpec, Item) :-
+ varset.coerce(VarSet0, VarSet),
+ ModuleDefn = md_external(MaybeBackend, SymSpec),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn).
:- pred get_is_solver_type(is_solver_type::out,
decl_attrs::in, decl_attrs::out) is det.
@@ -1693,8 +1788,8 @@
du_type_rhs_ctors_and_where_terms(Term, CtorsTerm, MaybeWhereTerm) :-
(
- Term = term.functor(term.atom("where"), [CtorsTerm0, WhereTerm],
- _Context)
+ Term = term.functor(term.atom("where"), Args, _Context),
+ Args = [CtorsTerm0, WhereTerm]
->
CtorsTerm = CtorsTerm0,
MaybeWhereTerm = yes(WhereTerm)
@@ -1710,9 +1805,9 @@
% to a representation of the declaration.
%
:- pred parse_type_decl_pred(module_name::in, varset::in, term::in,
- decl_attrs::in, maybe1(item)::out) is det.
+ decl_attrs::in, prog_context::in, maybe1(item)::out) is det.
-parse_type_decl_pred(ModuleName, VarSet, Pred, Attributes, Result) :-
+parse_type_decl_pred(ModuleName, VarSet, Pred, Attributes, Context, Result) :-
get_condition(Pred, Body, Condition),
get_determinism(Body, Body2, MaybeDeterminism),
get_with_inst(Body2, Body3, WithInst),
@@ -1720,7 +1815,7 @@
( WithTypeResult = ok1(WithType),
process_type_decl_pred_or_func(pf_predicate, ModuleName, WithType,
WithInst, MaybeDeterminism, VarSet, Body4, Condition, Attributes,
- Result)
+ Context, Result)
;
WithTypeResult = error1(Errors),
Result = error1(Errors)
@@ -1729,10 +1824,11 @@
:- pred process_type_decl_pred_or_func(pred_or_func::in, module_name::in,
maybe(mer_type)::in, maybe1(maybe(mer_inst))::in,
maybe1(maybe(determinism))::in, varset::in, term::in, condition::in,
- decl_attrs::in, maybe1(item)::out) is det.
+ decl_attrs::in, prog_context::in, maybe1(item)::out) is det.
process_type_decl_pred_or_func(PredOrFunc, ModuleName, WithType, WithInst0,
- MaybeDeterminism0, VarSet, Body, Condition, Attributes, Result) :-
+ MaybeDeterminism0, VarSet, Body, Condition, Attributes, Context,
+ Result) :-
(
MaybeDeterminism0 = ok1(MaybeDeterminism),
(
@@ -1751,11 +1847,11 @@
WithType = no
->
process_func(ModuleName, VarSet, Body, Condition,
- MaybeDeterminism, Attributes, Result)
+ MaybeDeterminism, Attributes, Context, Result)
;
- process_pred_or_func(PredOrFunc, ModuleName, VarSet, Body,
+ process_pred_decl(PredOrFunc, ModuleName, VarSet, Body,
Condition, WithType, WithInst, MaybeDeterminism,
- Attributes, Result)
+ Attributes, Context, Result)
)
)
;
@@ -1774,9 +1870,9 @@
% a representation of the declaration.
%
:- pred parse_type_decl_func(module_name::in, varset::in, term::in,
- decl_attrs::in, maybe1(item)::out) is det.
+ decl_attrs::in, prog_context::in, maybe1(item)::out) is det.
-parse_type_decl_func(ModuleName, VarSet, Func, Attributes, Result) :-
+parse_type_decl_func(ModuleName, VarSet, Func, Attributes, Context, Result) :-
get_condition(Func, Body, Condition),
get_determinism(Body, Body2, MaybeDeterminism),
get_with_inst(Body2, Body3, WithInst),
@@ -1785,7 +1881,7 @@
WithTypeResult = ok1(WithType),
process_type_decl_pred_or_func(pf_function, ModuleName,
WithType, WithInst, MaybeDeterminism, VarSet, Body4,
- Condition, Attributes, Result)
+ Condition, Attributes, Context, Result)
;
WithTypeResult = error1(Errors),
Result = error1(Errors)
@@ -1799,9 +1895,9 @@
% representation of the declaration.
%
:- pred parse_mode_decl_pred(module_name::in, varset::in, term::in,
- decl_attrs::in, maybe1(item)::out) is det.
+ decl_attrs::in, prog_context::in, maybe1(item)::out) is det.
-parse_mode_decl_pred(ModuleName, VarSet, Pred, Attributes, Result) :-
+parse_mode_decl_pred(ModuleName, VarSet, Pred, Attributes, Context, Result) :-
get_condition(Pred, Body, Condition),
get_determinism(Body, Body2, MaybeDeterminism0),
get_with_inst(Body2, Body3, WithInst0),
@@ -1817,7 +1913,7 @@
Result = error1([Msg - Body])
;
process_mode(ModuleName, VarSet, Body3, Condition, Attributes,
- WithInst, MaybeDeterminism, Result)
+ WithInst, MaybeDeterminism, Context, Result)
)
;
WithInst0 = error1(Errors),
@@ -1831,9 +1927,9 @@
%-----------------------------------------------------------------------------%
:- pred parse_initialise_decl(module_name::in, varset::in, list(term)::in,
- maybe1(item)::out) is semidet.
+ prog_context::in, maybe1(item)::out) is semidet.
-parse_initialise_decl(_ModuleName, _VarSet, [Term], Result) :-
+parse_initialise_decl(_ModuleName, _VarSet, [Term], Context, Result) :-
parse_symbol_name_specifier(Term, MaybeSymNameSpecifier),
(
MaybeSymNameSpecifier = error1(Errors),
@@ -1848,7 +1944,10 @@
(
( Arity = 0 ; Arity = 2 )
->
- Result = ok1(item_initialise(user, SymName, Arity))
+ ItemInitialise = item_initialise_info(user, SymName, Arity,
+ Context),
+ Item = item_initialise(ItemInitialise),
+ Result = ok1(Item)
;
Msg = "`initialise' declaration specifies a predicate " ++
"whose arity is not zero or two",
@@ -1860,9 +1959,9 @@
%-----------------------------------------------------------------------------%
:- pred parse_finalise_decl(module_name::in, varset::in, list(term)::in,
- maybe1(item)::out) is semidet.
+ prog_context::in, maybe1(item)::out) is semidet.
-parse_finalise_decl(_ModuleName, _VarSet, [Term], Result) :-
+parse_finalise_decl(_ModuleName, _VarSet, [Term], Context, Result) :-
parse_symbol_name_specifier(Term, MaybeSymNameSpecifier),
(
MaybeSymNameSpecifier = error1(Errors),
@@ -1877,7 +1976,10 @@
(
( Arity = 0 ; Arity = 2 )
->
- Result = ok1(item_finalise(user, SymName, Arity))
+ ItemFinalise = item_finalise_info(user, SymName, Arity,
+ Context),
+ Item = item_finalise(ItemFinalise),
+ Result = ok1(Item)
;
Msg = "`finalise' declaration specifies a predicate " ++
"whose arity is not zero or two",
@@ -1894,18 +1996,17 @@
%
:- pred parse_mutable_decl(module_name::in, varset::in, list(term)::in,
- maybe1(item)::out) is semidet.
+ prog_context::in, maybe1(item)::out) is semidet.
-parse_mutable_decl(_ModuleName, Varset, Terms, Result) :-
+parse_mutable_decl(_ModuleName, Varset, Terms, Context, Result) :-
Terms = [NameTerm, TypeTerm, ValueTerm, InstTerm | OptMutAttrsTerm],
parse_mutable_name(NameTerm, NameResult),
parse_mutable_type(TypeTerm, TypeResult),
term.coerce(ValueTerm, Value),
varset.coerce(Varset, ProgVarset),
parse_mutable_inst(InstTerm, InstResult),
- %
+
% The list of attributes is optional.
- %
(
OptMutAttrsTerm = [],
MutAttrsResult = ok1(default_mutable_attributes)
@@ -1925,8 +2026,10 @@
% references to it. Ignoring the varset may lead to later compiler
% passes attempting to reuse this variable when fresh variables are
% allocated.
- Result = ok1(item_mutable(Name, Type, Value, Inst, MutAttrs,
- ProgVarset))
+ ItemMutable = item_mutable_info(Name, Type, Value, Inst, MutAttrs,
+ ProgVarset, Context),
+ Item = item_mutable(ItemMutable),
+ Result = ok1(Item)
;
Errors = get_any_errors1(NameResult) ++ get_any_errors1(TypeResult) ++
get_any_errors1(InstResult) ++ get_any_errors1(MutAttrsResult),
@@ -1995,7 +2098,6 @@
% 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),
@@ -2094,8 +2196,8 @@
parse_type_decl_where_part_if_present(IsSolverType, ModuleName, Term0, Term,
Result) :-
(
- Term0 = term.functor(term.atom("where"), [Term1, WhereTerm],
- _Context)
+ Term0 = term.functor(term.atom("where"), Args0, _Context),
+ Args0 = [Term1, WhereTerm]
->
Term = Term1,
Result = parse_type_decl_where_term(IsSolverType, ModuleName,
@@ -2112,11 +2214,13 @@
:- func parse_type_decl_where_term(is_solver_type, module_name, maybe(term)) =
maybe2(maybe(solver_type_details), maybe(unify_compare)).
-parse_type_decl_where_term(_IsSolverType, _ModuleName, no) =
- ok2(no, no).
-
-parse_type_decl_where_term(IsSolverType, ModuleName, MaybeTerm0 @ yes(Term)) =
+parse_type_decl_where_term(IsSolverType, ModuleName, MaybeTerm0) =
MaybeWhereDetails :-
+ (
+ MaybeTerm0 = no,
+ MaybeWhereDetails = ok2(no, no)
+ ;
+ MaybeTerm0 = yes(Term0),
some [!MaybeTerm] (
!:MaybeTerm = MaybeTerm0,
parse_where_attribute(parse_where_type_is_abstract_noncanonical,
@@ -2143,8 +2247,7 @@
ComparisonIsResult, !MaybeTerm),
parse_where_end(!.MaybeTerm, WhereEndResult)
),
- MaybeWhereDetails =
- make_maybe_where_details(
+ MaybeWhereDetails = make_maybe_where_details(
IsSolverType,
TypeIsAbstractNoncanonicalResult,
RepresentationIsResult,
@@ -2155,7 +2258,8 @@
EqualityIsResult,
ComparisonIsResult,
WhereEndResult,
- Term
+ Term0
+ )
).
% parse_where_attribute(Parser, Result, MaybeTerm0, MaybeTerm)
@@ -2170,8 +2274,13 @@
:- pred parse_where_attribute((func(term) = maybe1(maybe(T)))::in,
maybe1(maybe(T))::out, maybe(term)::in, maybe(term)::out) is det.
-parse_where_attribute(_Parser, ok1(no), no, no).
-parse_where_attribute( Parser, Result, yes(Term0), MaybeRest) :-
+parse_where_attribute(Parser, Result, MaybeTerm0, MaybeRest) :-
+ (
+ MaybeTerm0 = no,
+ MaybeRest = no,
+ Result = ok1(no)
+ ;
+ MaybeTerm0 = yes(Term0),
(
Term0 = term.functor(term.atom(","), [Term1, Term], _Context)
->
@@ -2190,6 +2299,7 @@
;
Result = ok1(yes(_)),
MaybeRest = MaybeRestIfYes
+ )
).
% Parser for `where ...' attributes of the form
@@ -2245,7 +2355,8 @@
promise_pure (
(
Result1 = ok1(yes(_)),
- semipure semipure_get_solver_auto_init_supported(AutoInitSupported),
+ semipure
+ semipure_get_solver_auto_init_supported(AutoInitSupported),
(
AutoInitSupported = yes,
Result = Result1
@@ -2309,9 +2420,9 @@
parse_mutable_decl_term(ModuleName, Term, Result) :-
(
- Term = term.functor(term.atom("mutable"), Args, _Ctxt),
+ Term = term.functor(term.atom("mutable"), Args, Context),
varset.init(VarSet),
- parse_mutable_decl(ModuleName, VarSet, Args, Result0)
+ parse_mutable_decl(ModuleName, VarSet, Args, Context, Result0)
->
Result = Result0
;
@@ -2607,8 +2718,7 @@
Result) :-
(
MaybeSolverTypeDetails = yes(SolverTypeDetails),
- dummy_term(Body),
- parse_type_defn_head(ModuleName, Head, Body, Result0),
+ parse_type_defn_head(ModuleName, Head, Result0),
(
Result0 = error2(Errors),
Result = error1(Errors)
@@ -2640,7 +2750,7 @@
maybe1(processed_type_body)::out) is det.
process_eqv_type(ModuleName, Head, Body, Result) :-
- parse_type_defn_head(ModuleName, Head, Body, Result0),
+ parse_type_defn_head(ModuleName, Head, Result0),
process_eqv_type_2(Result0, Body, Result).
:- pred process_eqv_type_2(maybe2(sym_name, list(type_param))::in, term::in,
@@ -2683,7 +2793,7 @@
maybe1(processed_type_body)::out) is det.
process_du_type(ModuleName, Head, Body, Ctors, MaybeUserEqComp, Result) :-
- parse_type_defn_head(ModuleName, Head, Body, Result0),
+ parse_type_defn_head(ModuleName, Head, Result0),
(
Result0 = error2(Errors),
Result = error1(Errors)
@@ -2729,7 +2839,7 @@
% Check that all type variables in existential quantifiers do not
% occur in the head (maybe this should just be a warning, not an error?
% If we were to allow it, we would need to rename them apart.)
- %
+
list.member(Var, ExistQVars),
list.member(Var, Params)
->
@@ -2738,7 +2848,7 @@
;
% Check that all type variables in existential quantifiers occur
% somewhere in the constructor argument types or constraints.
- %
+
list.member(Var, ExistQVars),
CtorArgTypes = list.map(func(C) = C ^ arg_type, CtorArgs),
\+ type_list_contains_var(CtorArgTypes, Var),
@@ -2750,7 +2860,7 @@
;
% Check that all type variables in existential constraints occur in
% the existential quantifiers.
- %
+
list.member(Constraint, Constraints),
Constraint = constraint(_Name, ConstraintArgs),
type_list_contains_var(ConstraintArgs, Var),
@@ -2774,8 +2884,7 @@
maybe1(processed_type_body)::out) is det.
process_abstract_type(ModuleName, Head, Attributes0, Result) :-
- dummy_term(Body),
- parse_type_defn_head(ModuleName, Head, Body, Result0),
+ parse_type_defn_head(ModuleName, Head, Result0),
get_is_solver_type(IsSolverType, Attributes0, Attributes),
process_abstract_type_2(Result0, IsSolverType, Result1),
check_no_attributes(Result1, Attributes, Result).
@@ -2790,17 +2899,13 @@
%-----------------------------------------------------------------------------%
-parse_type_defn_head(ModuleName, Head, Body, Result) :-
- ( Head = term.variable(_, _) ->
- % `Head' has no term.context, so we need to get the
- % context from `Body'.
- ( Body = term.functor(_, _, Context) ->
- dummy_term_with_context(Context, ErrorTerm)
- ;
- dummy_term(ErrorTerm)
- ),
+parse_type_defn_head(ModuleName, Head, Result) :-
+ (
+ Head = term.variable(_, Context),
+ dummy_term_with_context(Context, ErrorTerm),
Result = error2(["variable on LHS of type definition" - ErrorTerm])
;
+ Head = term.functor(_, _, _),
parse_implicitly_qualified_term(ModuleName, Head, Head,
"type definition", Headresult),
parse_type_defn_head_2(Headresult, Head, Result)
@@ -2942,37 +3047,38 @@
% parse a `:- pred p(...)' declaration or a
% `:- func f(...) `with_type` t' declaration
%
-:- pred process_pred_or_func(pred_or_func::in, module_name::in, varset::in,
+:- pred process_pred_decl(pred_or_func::in, module_name::in, varset::in,
term::in, condition::in, maybe(mer_type)::in, maybe(mer_inst)::in,
- maybe(determinism)::in, decl_attrs::in, maybe1(item)::out) is det.
+ maybe(determinism)::in, decl_attrs::in, prog_context::in,
+ maybe1(item)::out) is det.
-process_pred_or_func(PredOrFunc, ModuleName, VarSet, PredType, Cond, WithType,
- WithInst, MaybeDet, Attributes0, Result) :-
+process_pred_decl(PredOrFunc, ModuleName, VarSet, PredType, Cond, WithType,
+ WithInst, MaybeDet, Attributes0, Context, Result) :-
get_class_context_and_inst_constraints(ModuleName, Attributes0,
- Attributes, MaybeContext),
+ Attributes, MaybeClassContext),
(
- MaybeContext = ok3(ExistQVars, Constraints, InstConstraints),
+ MaybeClassContext = ok3(ExistQVars, Constraints, InstConstraints),
parse_implicitly_qualified_term(ModuleName, PredType, PredType,
pred_or_func_decl_string(PredOrFunc), R),
- process_pred_or_func_2(PredOrFunc, R, PredType, VarSet,
+ process_pred_decl_2(PredOrFunc, R, PredType, VarSet,
WithType, WithInst, MaybeDet, Cond, ExistQVars,
- Constraints, InstConstraints, Attributes, Result)
+ Constraints, InstConstraints, Attributes, Context, Result)
;
- MaybeContext = error3(Errors),
+ MaybeClassContext = error3(Errors),
Result = error1(Errors)
).
-:- pred process_pred_or_func_2(pred_or_func::in, maybe_functor::in, term::in,
+:- pred process_pred_decl_2(pred_or_func::in, maybe_functor::in, term::in,
varset::in, maybe(mer_type)::in, maybe(mer_inst)::in,
maybe(determinism)::in, condition::in, existq_tvars::in,
- prog_constraints::in, inst_var_sub::in, decl_attrs::in, maybe1(item)::out)
- is det.
+ prog_constraints::in, inst_var_sub::in, decl_attrs::in, prog_context::in,
+ maybe1(item)::out) is det.
-process_pred_or_func_2(_, error2(Errors), _, _, _, _, _, _, _, _, _, _,
+process_pred_decl_2(_, error2(Errors), _, _, _, _, _, _, _, _, _, _, _,
error1(Errors)).
-process_pred_or_func_2(PredOrFunc, ok2(F, As0), PredType, VarSet0,
+process_pred_decl_2(PredOrFunc, ok2(F, As0), PredType, VarSet0,
WithType, WithInst, MaybeDet, Cond, ExistQVars,
- ClassContext, InstConstraints, Attributes0, Result) :-
+ ClassContext, InstConstraints, Attributes0, Context, Result) :-
( convert_type_and_mode_list(InstConstraints, As0, As) ->
( verify_type_and_mode_list(As) ->
(
@@ -2999,9 +3105,11 @@
varset.coerce(VarSet0, TVarSet),
varset.coerce(VarSet0, IVarSet),
Origin = user,
- Result0 = ok1(item_pred_or_func(Origin, TVarSet, IVarSet,
+ ItemPredDecl = item_pred_decl_info(Origin, TVarSet, IVarSet,
ExistQVars, PredOrFunc, F, As, WithType, WithInst,
- MaybeDet, Cond, Purity, ClassContext)),
+ MaybeDet, Cond, Purity, ClassContext, Context),
+ Item = item_pred_decl(ItemPredDecl),
+ Result0 = ok1(Item),
check_no_attributes(Result0, Attributes, Result)
)
;
@@ -3200,15 +3308,17 @@
% Parse a `:- func p(...)' declaration.
%
:- pred process_func(module_name::in, varset::in, term::in, condition::in,
- maybe(determinism)::in, decl_attrs::in, maybe1(item)::out) is det.
+ maybe(determinism)::in, decl_attrs::in, prog_context::in,
+ maybe1(item)::out) is det.
-process_func(ModuleName, VarSet, Term, Cond, MaybeDet, Attributes0, Result) :-
+process_func(ModuleName, VarSet, Term, Cond, MaybeDet, Attributes0,
+ Context, Result) :-
get_class_context_and_inst_constraints(ModuleName, Attributes0,
Attributes, MaybeContext),
(
MaybeContext = ok3(ExistQVars, Constraints, InstConstraints),
process_func_2(ModuleName, VarSet, Term, Cond, MaybeDet, ExistQVars,
- Constraints, InstConstraints, Attributes, Result)
+ Constraints, InstConstraints, Attributes, Context, Result)
;
MaybeContext = error3(Errors),
Result = error1(Errors)
@@ -3216,10 +3326,11 @@
:- pred process_func_2(module_name::in, varset::in, term::in, condition::in,
maybe(determinism)::in, existq_tvars::in, prog_constraints::in,
- inst_var_sub::in, decl_attrs::in, maybe1(item)::out) is det.
+ inst_var_sub::in, decl_attrs::in, prog_context::in, maybe1(item)::out)
+ is det.
process_func_2(ModuleName, VarSet, Term, Cond, MaybeDet, ExistQVars,
- Constraints, InstConstraints, Attributes, Result) :-
+ Constraints, InstConstraints, Attributes, Context, Result) :-
(
Term = term.functor(term.atom("="),
[FuncTerm0, ReturnTypeTerm], _Context),
@@ -3228,7 +3339,8 @@
parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
"`:- func' declaration", R),
process_func_3(R, FuncTerm, ReturnTypeTerm, Term, VarSet, MaybeDet,
- Cond, ExistQVars, Constraints, InstConstraints, Attributes, Result)
+ Cond, ExistQVars, Constraints, InstConstraints, Attributes,
+ Context, Result)
;
Result = error1(["`=' expected in `:- func' declaration" - Term])
).
@@ -3236,12 +3348,13 @@
:- pred process_func_3(maybe_functor::in, term::in, term::in, term::in,
varset::in, maybe(determinism)::in, condition::in, existq_tvars::in,
prog_constraints::in, inst_var_sub::in, decl_attrs::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item)::out) is det.
-process_func_3(error2(Errors), _, _, _, _, _, _, _, _, _, _, error1(Errors)).
+process_func_3(error2(Errors), _, _, _, _, _, _, _, _, _, _, _,
+ error1(Errors)).
process_func_3(ok2(F, As0), FuncTerm, ReturnTypeTerm, FullTerm, VarSet0,
MaybeDet, Cond, ExistQVars, ClassContext, InstConstraints,
- Attributes0, Result) :-
+ Attributes0, Context, Result) :-
( convert_type_and_mode_list(InstConstraints, As0, As) ->
(
\+ verify_type_and_mode_list(As)
@@ -3273,9 +3386,11 @@
inst_var_constraints_are_consistent_in_type_and_modes(Args)
->
Origin = user,
- Result0 = ok1(item_pred_or_func(Origin, TVarSet, IVarSet,
+ Result0 = ok1(Item),
+ Item = item_pred_decl(ItemPredDecl),
+ ItemPredDecl = item_pred_decl_info(Origin, TVarSet, IVarSet,
ExistQVars, pf_function, F, Args, no, no, MaybeDet,
- Cond, Purity, ClassContext)),
+ Cond, Purity, ClassContext, Context),
check_no_attributes(Result0, Attributes, Result)
;
Msg = "inconsistent constraints on inst variables " ++
@@ -3323,10 +3438,10 @@
%
:- pred process_mode(module_name::in, varset::in, term::in, condition::in,
decl_attrs::in, maybe(mer_inst)::in, maybe(determinism)::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item)::out) is det.
process_mode(ModuleName, VarSet, Term, Cond, Attributes, WithInst, MaybeDet,
- Result) :-
+ Context, Result) :-
(
WithInst = no,
Term = term.functor(term.atom("="), [FuncTerm0, ReturnTypeTerm],
@@ -3336,21 +3451,21 @@
parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
"function `:- mode' declaration", R),
process_func_mode(R, ModuleName, FuncTerm, ReturnTypeTerm,
- Term, VarSet, MaybeDet, Cond, Attributes, Result)
+ Term, VarSet, MaybeDet, Cond, Attributes, Context, Result)
;
parse_implicitly_qualified_term(ModuleName, Term, Term,
"`:- mode' declaration", R),
- process_pred_or_func_mode(R, ModuleName, Term, VarSet,
- WithInst, MaybeDet, Cond, Attributes, Result)
+ process_mode_decl(R, ModuleName, Term, VarSet,
+ WithInst, MaybeDet, Cond, Attributes, Context, Result)
).
-:- pred process_pred_or_func_mode(maybe_functor::in, module_name::in, term::in,
+:- pred process_mode_decl(maybe_functor::in, module_name::in, term::in,
varset::in, maybe(mer_inst)::in, maybe(determinism)::in, condition::in,
- decl_attrs::in, maybe1(item)::out) is det.
+ decl_attrs::in, prog_context::in, maybe1(item)::out) is det.
-process_pred_or_func_mode(error2(Errors), _, _, _, _, _, _, _, error1(Errors)).
-process_pred_or_func_mode(ok2(F, As0), ModuleName, PredMode, VarSet0, WithInst,
- MaybeDet, Cond, Attributes0, Result) :-
+process_mode_decl(error2(Errors), _, _, _, _, _, _, _, _, error1(Errors)).
+process_mode_decl(ok2(F, As0), ModuleName, PredMode, VarSet0, WithInst,
+ MaybeDet, Cond, Attributes0, Context, Result) :-
( convert_mode_list(allow_constrained_inst_var, As0, As1) ->
get_class_context_and_inst_constraints(ModuleName, Attributes0,
Attributes, MaybeConstraints),
@@ -3368,8 +3483,10 @@
% until we expand out the inst.
PredOrFunc = no
),
- Result0 = ok1(item_pred_or_func_mode(VarSet, PredOrFunc, F, As,
- WithInst, MaybeDet, Cond))
+ ItemModeDecl = item_mode_decl_info(VarSet, PredOrFunc, F, As,
+ WithInst, MaybeDet, Cond, Context),
+ Item = item_mode_decl(ItemModeDecl),
+ Result0 = ok1(Item)
;
Msg = "inconsistent constraints on inst variables " ++
"in predicate mode declaration",
@@ -3386,11 +3503,11 @@
:- pred process_func_mode(maybe_functor::in, module_name::in, term::in,
term::in, term::in, varset::in, maybe(determinism)::in, condition::in,
- decl_attrs::in, maybe1(item)::out) is det.
+ decl_attrs::in, prog_context::in, maybe1(item)::out) is det.
-process_func_mode(error2(Errors), _, _, _, _, _, _, _, _, error1(Errors)).
+process_func_mode(error2(Errors), _, _, _, _, _, _, _, _, _, error1(Errors)).
process_func_mode(ok2(F, As0), ModuleName, FuncMode, RetMode0, FullTerm,
- VarSet0, MaybeDet, Cond, Attributes0, Result) :-
+ VarSet0, MaybeDet, Cond, Attributes0, Context, Result) :-
(
convert_mode_list(allow_constrained_inst_var, As0, As1)
->
@@ -3407,8 +3524,11 @@
varset.coerce(VarSet0, VarSet),
list.append(As, [RetMode], ArgModes),
( inst_var_constraints_are_consistent_in_modes(ArgModes) ->
- Result0 = ok1(item_pred_or_func_mode(VarSet,
- yes(pf_function), F, ArgModes, no, MaybeDet, Cond))
+ ItemModeDecl = item_mode_decl_info(VarSet,
+ yes(pf_function), F, ArgModes, no, MaybeDet, Cond,
+ Context),
+ Item = item_mode_decl(ItemModeDecl),
+ Result0 = ok1(Item)
;
Msg = "inconsistent constraints on inst variables " ++
"in function mode declaration",
@@ -3598,34 +3718,34 @@
% Parse a `:- inst <InstDefn>.' declaration.
%
:- pred parse_inst_decl(module_name::in, varset::in, term::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item)::out) is det.
-parse_inst_decl(ModuleName, VarSet, InstDefn, Result) :-
+parse_inst_decl(ModuleName, VarSet, InstDefn, Context, Result) :-
+ % XXX Some of the tests here could be factored out.
(
- InstDefn = term.functor(term.atom(Op), [H, B], _Context),
- Op = "=="
+ InstDefn = term.functor(term.atom("=="), [H, B], _Context)
->
get_condition(B, Body, Condition),
convert_inst_defn(ModuleName, H, Body, R),
- process_maybe1(make_inst_defn(VarSet, Condition), R, Result)
+ process_maybe1(make_inst_defn(VarSet, Condition, Context), R, Result)
;
% XXX This is for `abstract inst' declarations,
% which are not really supported.
- InstDefn = term.functor(term.atom("is"),
- [Head, term.functor(term.atom("private"), [], _)], _)
+ InstDefn = term.functor(term.atom("is"), Args, _Context),
+ Args = [Head, term.functor(term.atom("private"), [], _)]
->
Condition = cond_true,
convert_abstract_inst_defn(ModuleName, Head, R),
- process_maybe1(make_inst_defn(VarSet, Condition), R, Result)
+ process_maybe1(make_inst_defn(VarSet, Condition, Context), R, Result)
;
- InstDefn = term.functor(term.atom("--->"), [H, B], Context)
+ InstDefn = term.functor(term.atom("--->"), [H, B], _Context)
->
get_condition(B, Body, Condition),
Body1 = term.functor(term.atom("bound"), [Body], Context),
convert_inst_defn(ModuleName, H, Body1, R),
- % We should check the condition for errs (don't bother at the moment,
- % since we ignore conditions anyhow :-)
- process_maybe1(make_inst_defn(VarSet, Condition), R, Result)
+ % We should check the condition for errors. We don't bother
+ % at the moment, since we ignore conditions anyhow :-)
+ process_maybe1(make_inst_defn(VarSet, Condition, Context), R, Result)
;
Result = error1(["`==' expected in `:- inst' definition" - InstDefn])
).
@@ -3728,27 +3848,31 @@
Result = error1(["inst parameters must be variables" - Head])
).
-:- pred make_inst_defn(varset::in, condition::in, processed_inst_body::in,
- item::out) is det.
+:- pred make_inst_defn(varset::in, condition::in, prog_context::in,
+ processed_inst_body::in, item::out) is det.
-make_inst_defn(VarSet0, Cond, processed_inst_body(Name, Params, InstDefn),
- item_inst_defn(VarSet, Name, Params, InstDefn, Cond)) :-
- varset.coerce(VarSet0, VarSet).
+make_inst_defn(VarSet0, Cond, Context, ProcessedInstBody, Item) :-
+ ProcessedInstBody = processed_inst_body(Name, Params, InstDefn),
+ varset.coerce(VarSet0, VarSet),
+ ItemInstDefn = item_inst_defn_info(VarSet, Name, Params, InstDefn, Cond,
+ Context),
+ Item = item_inst_defn(ItemInstDefn).
%-----------------------------------------------------------------------------%
% Parse a `:- mode foo == ...' definition.
%
:- pred parse_mode_decl(module_name::in, varset::in, term::in, decl_attrs::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item)::out) is det.
-parse_mode_decl(ModuleName, VarSet, ModeDefn, Attributes, Result) :-
+parse_mode_decl(ModuleName, VarSet, ModeDefn, Attributes, Context, Result) :-
( mode_op(ModeDefn, H, B) ->
get_condition(B, Body, Condition),
convert_mode_defn(ModuleName, H, Body, R),
- process_maybe1(make_mode_defn(VarSet, Condition), R, Result)
+ process_maybe1(make_mode_defn(VarSet, Condition, Context), R, Result)
;
- parse_mode_decl_pred(ModuleName, VarSet, ModeDefn, Attributes, Result)
+ parse_mode_decl_pred(ModuleName, VarSet, ModeDefn, Attributes,
+ Context, Result)
).
:- pred mode_op(term::in, term::out, term::out) is semidet.
@@ -3835,12 +3959,15 @@
Result = type_only(Type)
).
-:- pred make_mode_defn(varset::in, condition::in, processed_mode_body::in,
- item::out) is det.
+:- pred make_mode_defn(varset::in, condition::in, prog_context::in,
+ processed_mode_body::in, item::out) is det.
-make_mode_defn(VarSet0, Cond, processed_mode_body(Name, Params, ModeDefn),
- item_mode_defn(VarSet, Name, Params, ModeDefn, Cond)) :-
- varset.coerce(VarSet0, VarSet).
+make_mode_defn(VarSet0, Cond, Context, ProcessedModeBody, Item) :-
+ ProcessedModeBody = processed_mode_body(Name, Params, ModeDefn),
+ varset.coerce(VarSet0, VarSet),
+ ItemModeDefn = item_mode_defn_info(VarSet, Name, Params, ModeDefn, Cond,
+ Context),
+ Item = item_mode_defn(ItemModeDefn).
%-----------------------------------------------------------------------------%
@@ -3849,24 +3976,27 @@
:- pred parse_symlist_decl(parser(T)::parser, maker(list(T), sym_list)::maker,
maker(sym_list, module_defn)::maker,
- term::in, decl_attrs::in, varset::in, maybe1(item)::out) is det.
+ term::in, decl_attrs::in, varset::in, prog_context::in, maybe1(item)::out)
+ is det.
parse_symlist_decl(ParserPred, MakeSymListPred, MakeModuleDefnPred,
- Term, Attributes, VarSet, Result) :-
+ Term, Attributes, VarSet, Context, Result) :-
parse_list(ParserPred, Term, Result0),
process_maybe1(make_module_defn(MakeSymListPred, MakeModuleDefnPred,
- VarSet), Result0, Result1),
+ VarSet, Context), Result0, Result1),
check_no_attributes(Result1, Attributes, Result).
:- pred make_module_defn(maker(T, sym_list)::maker,
- maker(sym_list, module_defn)::maker, varset::in, T::in, item::out)
- is det.
+ maker(sym_list, module_defn)::maker, varset::in, prog_context::in,
+ T::in, item::out) is det.
-make_module_defn(MakeSymListPred, MakeModuleDefnPred, VarSet0, T,
- item_module_defn(VarSet, ModuleDefn)) :-
+make_module_defn(MakeSymListPred, MakeModuleDefnPred, VarSet0, Context,
+ T, Item) :-
varset.coerce(VarSet0, VarSet),
call(MakeSymListPred, T, SymList),
- call(MakeModuleDefnPred, SymList, ModuleDefn).
+ call(MakeModuleDefnPred, SymList, ModuleDefn),
+ ItemModuleDefn = item_module_defn_info(VarSet, ModuleDefn, Context),
+ Item = item_module_defn(ItemModuleDefn).
%-----------------------------------------------------------------------------%
@@ -4479,6 +4609,41 @@
root_module_name(unqualified("")).
%-----------------------------------------------------------------------------%
+%
+% You can uncomment this section for debugging.
+%
+
+% :- interface.
+%
+% :- pred write_item_to_stream(io.output_stream::in, item::in, io::di, io::uo)
+% is det.
+%
+% :- pred write_item_to_stdout(item::in, io::di, io::uo) is det.
+%
+% :- pred write_items_to_file(string::in, list(item)::in, io::di, io::uo)
+% is det.
+%
+% :- implementation.
+%
+% :- import_module pretty_printer.
+%
+% write_item_to_stream(Stream, Item, !IO) :-
+% write_doc(Stream, format(Item), !IO),
+% io.nl(Stream, !IO).
+%
+% write_item_to_stdout(Item, !IO) :-
+% write_item_to_stream(io.stdout_stream, Item, !IO).
+%
+% write_items_to_file(FileName, Items, !IO) :-
+% io.open_output(FileName, Result, !IO),
+% (
+% Result = ok(Stream),
+% list.foldl(write_item_to_stream(Stream), Items, !IO)
+% ;
+% Result = error(_)
+% ).
+
+%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.42
diff -u -b -r1.42 prog_io_dcg.m
--- compiler/prog_io_dcg.m 19 Jan 2007 07:04:27 -0000 1.42
+++ compiler/prog_io_dcg.m 9 Feb 2008 02:56:45 -0000
@@ -33,7 +33,7 @@
%-----------------------------------------------------------------------------%
:- pred parse_dcg_clause(module_name::in, varset::in, term::in, term::in,
- prog_context::in, maybe_item_and_context::out) is det.
+ prog_context::in, maybe1(item)::out) is det.
% parse_dcg_pred_goal(GoalTerm, MaybeGoal, DCGVarInitial, DCGVarFinal,
% !Varset):
@@ -71,11 +71,10 @@
parse_implicitly_qualified_term(ModuleName, DCG_Head, DCG_Body,
"DCG clause head", HeadResult),
process_dcg_clause(HeadResult, ProgVarSet, DCG_0_Var, DCG_Var, Body,
- DCG_Context, ProcessResult),
- add_context(ProcessResult, DCG_Context, Result)
+ DCG_Context, Result)
;
MaybeBody = error1(Errors),
- Result = error2(Errors)
+ Result = error1(Errors)
).
%-----------------------------------------------------------------------------%
@@ -682,8 +681,17 @@
:- pred process_dcg_clause(maybe_functor::in, prog_varset::in, prog_var::in,
prog_var::in, goal::in, prog_context::in, maybe1(item)::out) is det.
-process_dcg_clause(ok2(Name, Args0), VarSet, Var0, Var, Body, Context,
- ok1(item_clause(user, VarSet, pf_predicate, Name, Args, Body))) :-
+process_dcg_clause(MaybeFunctor, VarSet, Var0, Var, Body, Context,
+ MaybeItem) :-
+ (
+ MaybeFunctor = ok2(Name, Args0),
list.map(term.coerce, Args0, Args1),
- Args = Args1 ++ [variable(Var0, Context), variable(Var, Context)].
-process_dcg_clause(error2(Errors), _, _, _, _, _, error1(Errors)).
+ Args = Args1 ++ [variable(Var0, Context), variable(Var, Context)],
+ ItemClause = item_clause_info(user, VarSet, pf_predicate, Name, Args,
+ Body, Context),
+ Item = item_clause(ItemClause),
+ MaybeItem = ok1(Item)
+ ;
+ MaybeFunctor = error2(Errors),
+ MaybeItem = error1(Errors)
+ ).
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.132
diff -u -b -r1.132 prog_io_pragma.m
--- compiler/prog_io_pragma.m 25 Jan 2008 04:03:59 -0000 1.132
+++ compiler/prog_io_pragma.m 11 Feb 2008 18:45:29 -0000
@@ -18,8 +18,9 @@
:- import_module libs.globals.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.prog_item.
+:- 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.
@@ -27,10 +28,11 @@
%-----------------------------------------------------------------------------%
- % Parse the pragma declaration.
+ % Parse the pragma declaration. The item (if any) it returns is not
+ % necessarily a pragma item.
%
:- pred parse_pragma(module_name::in, varset::in, list(term)::in,
- maybe1(item)::out) is semidet.
+ prog_context::in, maybe1(item)::out) is semidet.
% Parse a term that represents a foreign language.
%
@@ -44,7 +46,6 @@
:- import_module libs.compiler_util.
:- import_module libs.rat.
:- import_module parse_tree.prog_ctgc.
-:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_io.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
@@ -60,15 +61,15 @@
%-----------------------------------------------------------------------------%
-parse_pragma(ModuleName, VarSet, PragmaTerms, Result) :-
+parse_pragma(ModuleName, VarSet, PragmaTerms, Context, Result) :-
(
PragmaTerms = [SinglePragmaTerm0],
parse_type_decl_where_part_if_present(non_solver_type, ModuleName,
SinglePragmaTerm0, SinglePragmaTerm, WherePartResult),
- SinglePragmaTerm = term.functor(term.atom(PragmaType),
- PragmaArgs, _),
+ SinglePragmaTerm = term.functor(term.atom(PragmaType), PragmaArgs,
+ _Context),
parse_pragma_type(ModuleName, PragmaType, PragmaArgs, SinglePragmaTerm,
- VarSet, Result0)
+ VarSet, Context, Result0)
->
(
% The code to process `where' attributes will return an error
@@ -82,13 +83,15 @@
Result0 = ok1(Item0)
->
(
- Item0 = item_type_defn(_, _, _, _, _),
- Item0 ^ td_ctor_defn =
+ Item0 = item_type_defn(ItemTypeDefn0),
+ ItemTypeDefn0 ^ td_ctor_defn =
parse_tree_foreign_type(Type, _, Assertions)
->
- Result = ok1(Item0 ^ td_ctor_defn :=
+ ItemTypeDefn = ItemTypeDefn0 ^ td_ctor_defn :=
parse_tree_foreign_type(Type, MaybeUserEqComp,
- Assertions))
+ Assertions),
+ Item = item_type_defn(ItemTypeDefn),
+ Result = ok1(Item)
;
Msg = "unexpected `where equality/comparison is'",
Result = error1([Msg - SinglePragmaTerm0])
@@ -104,13 +107,194 @@
fail
).
+%----------------------------------------------------------------------------%
+
:- pred parse_pragma_type(module_name::in, string::in, list(term)::in,
- term::in, varset::in, maybe1(item)::out) is semidet.
+ term::in, varset::in, prog_context::in, maybe1(item)::out) is semidet.
-parse_pragma_type(_, "source_file", PragmaTerms, ErrorTerm, _VarSet, Result) :-
+parse_pragma_type(ModuleName, PragmaName, PragmaTerms, ErrorTerm, VarSet,
+ Context, Result) :-
+ (
+ PragmaName = "source_file",
+ parse_pragma_source_file(PragmaTerms, ErrorTerm, Context, Result)
+ ;
+ PragmaName = "foreign_type",
+ parse_pragma_foreign_type(ModuleName, PragmaTerms, ErrorTerm, VarSet,
+ Context, Result)
+ ;
+ PragmaName = "foreign_decl",
+ parse_pragma_foreign_decl_pragma(ModuleName, PragmaName,
+ PragmaTerms, ErrorTerm, VarSet, Context, Result)
+ ;
+ PragmaName = "c_header_code",
+ parse_pragma_c_header_code(ModuleName, PragmaTerms, ErrorTerm, VarSet,
+ Context, Result)
+ ;
+ PragmaName = "foreign_code",
+ parse_pragma_foreign_code_pragma(ModuleName, PragmaName,
+ PragmaTerms, ErrorTerm, VarSet, Context, Result)
+ ;
+ PragmaName = "foreign_proc",
+ parse_pragma_foreign_proc_pragma(ModuleName, PragmaName,
+ PragmaTerms, ErrorTerm, VarSet, Context, Result)
+ ;
+ PragmaName = "foreign_export_enum",
+ parse_pragma_foreign_export_enum(PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "foreign_enum",
+ parse_pragma_foreign_enum(PragmaTerms, ErrorTerm, Context, Result)
+ ;
+ PragmaName = "foreign_export",
+ parse_pragma_foreign_export(PragmaTerms, ErrorTerm, Context, Result)
+ ;
+ PragmaName = "c_code",
+ parse_pragma_c_code(ModuleName, PragmaTerms, ErrorTerm, VarSet,
+ Context, Result)
+ ;
+ PragmaName = "c_import_module",
+ parse_pragma_c_import_module(PragmaTerms, ErrorTerm, Context, Result)
+ ;
+ PragmaName = "foreign_import_module",
+ parse_pragma_foreign_import_module(PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "import",
+ parse_pragma_import(ModuleName, PragmaTerms, ErrorTerm, VarSet,
+ Context, Result)
+ ;
+ PragmaName = "export",
+ parse_pragma_export(PragmaTerms, ErrorTerm, Context, Result)
+ ;
+ (
+ PragmaName = "inline",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_inline(Name, Arity))
+ ;
+ PragmaName = "no_inline",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_no_inline(Name, Arity))
+ ;
+ PragmaName = "obsolete",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_obsolete(Name, Arity))
+ ;
+ PragmaName = "promise_equivalent_clauses",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_promise_equivalent_clauses(Name, Arity))
+ ;
+ PragmaName = "promise_pure",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_promise_pure(Name, Arity))
+ ;
+ PragmaName = "promise_semipure",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_promise_semipure(Name, Arity))
+ ;
+ PragmaName = "terminates",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_terminates(Name, Arity))
+ ;
+ PragmaName = "does_not_terminate",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_does_not_terminate(Name, Arity))
+ ;
+ PragmaName = "check_termination",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_check_termination(Name, Arity))
+ ;
+ PragmaName = "mode_check_clauses",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_mode_check_clauses(Name, Arity))
+ ),
+ parse_simple_pragma(ModuleName, PragmaName, MakePragma,
+ PragmaTerms, ErrorTerm, Context, Result)
+ ;
+ PragmaName = "reserve_tag",
+ MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+ Pragma = pragma_reserve_tag(Name, Arity)),
+ parse_simple_type_pragma(ModuleName, PragmaName, MakePragma,
+ PragmaTerms, ErrorTerm, Context, Result)
+ ;
+ (
+ PragmaName = "memo",
+ EvalMethod = eval_memo
+ ;
+ PragmaName = "loop_check",
+ EvalMethod = eval_loop_check
+ ;
+ PragmaName = "minimal_model",
+ % We don't yet know whether we will use the stack_copy or the
+ % own_stacks technique for computing minimal models. The decision
+ % depends on the grade, and is made in make_hlds.m; the
+ % "stack_copy" here is just a placeholder.
+ EvalMethod = eval_minimal(stack_copy)
+ ),
+ parse_tabling_pragma(ModuleName, PragmaName, EvalMethod,
+ PragmaTerms, ErrorTerm, Context, Result)
+ ;
+ PragmaName = "unused_args",
+ parse_pragma_unused_args(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "type_spec",
+ parse_pragma_type_spec(ModuleName, PragmaTerms, ErrorTerm, VarSet,
+ Context, Result)
+ ;
+ PragmaName = "fact_table",
+ parse_pragma_fact_table(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "termination_info",
+ parse_pragma_termination_info(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "termination2_info",
+ parse_pragma_termination2_info(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "structure_sharing",
+ parse_pragma_structure_sharing(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "structure_reuse",
+ parse_pragma_structure_reuse(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "exceptions",
+ parse_pragma_exceptions(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "trailing_info",
+ parse_pragma_trailing_info(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "mm_tabling_info",
+ parse_pragma_mm_tabling_info(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result)
+ ;
+ PragmaName = "require_feature_set",
+ parse_pragma_require_feature_set(PragmaTerms, ErrorTerm,
+ Context, Result)
+ ).
+
+%----------------------------------------------------------------------------%
+
+% XXX The predicates in the rest of this module ought to be clustered together
+% into groups of related predicates, grouping both parse_pragma_xxx predicates
+% together with their helper predicates, and grouping parse_pragma_xxx
+% predicates for related xxxs together.
+
+:- pred parse_pragma_source_file(list(term)::in, term::in, prog_context::in,
+ maybe1(item)::out) is det.
+
+parse_pragma_source_file(PragmaTerms, ErrorTerm, Context, Result) :-
( PragmaTerms = [SourceFileTerm] ->
( SourceFileTerm = term.functor(term.string(SourceFile), [], _) ->
- Result = ok1(item_pragma(user, pragma_source_file(SourceFile)))
+ Pragma = pragma_source_file(SourceFile),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Msg = "string expected in `:- pragma source_file' declaration",
Result = error1([Msg - SourceFileTerm])
@@ -121,7 +305,10 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "foreign_type", PragmaTerms, ErrorTerm, VarSet,
+:- pred parse_pragma_foreign_type(module_name::in, list(term)::in, term::in,
+ varset::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_foreign_type(ModuleName, PragmaTerms, ErrorTerm, VarSet, Context,
Result) :-
(
(
@@ -140,7 +327,7 @@
MaybeForeignType),
(
MaybeForeignType = ok1(ForeignType),
- parse_type_defn_head(ModuleName, MercuryTypeTerm, ErrorTerm,
+ parse_type_defn_head(ModuleName, MercuryTypeTerm,
MaybeTypeDefnHead),
(
MaybeTypeDefnHead = ok2(MercuryTypeSymName, MercuryParams),
@@ -151,11 +338,13 @@
->
% rafe: XXX I'm not sure that `no' here is right
% - we might need some more parsing...
- Result = ok1(item_type_defn(TVarSet,
+ ItemTypeDefn = item_type_defn_info(TVarSet,
MercuryTypeSymName, MercuryParams,
parse_tree_foreign_type(ForeignType, no,
Assertions),
- cond_true))
+ cond_true, Context),
+ Item = item_type_defn(ItemTypeDefn),
+ Result = ok1(Item)
;
MaybeAssertionTerm = yes(ErrorAssertionTerm)
->
@@ -186,43 +375,31 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms, ErrorTerm,
- VarSet, Result) :-
- parse_pragma_foreign_decl_pragma(ModuleName, "foreign_decl",
- PragmaTerms, ErrorTerm, VarSet, Result).
+:- pred parse_pragma_c_header_code(module_name::in, list(term)::in, term::in,
+ varset::in, prog_context::in, maybe1(item)::out) is det.
-parse_pragma_type(ModuleName, "c_header_code", PragmaTerms, ErrorTerm,
- VarSet, Result) :-
+parse_pragma_c_header_code(ModuleName, PragmaTerms, ErrorTerm, VarSet, Context,
+ Result) :-
( PragmaTerms = [term.functor(_, _, Context) | _] ->
LangC = term.functor(term.string("C"), [], Context),
parse_pragma_foreign_decl_pragma(ModuleName, "c_header_code",
- [LangC | PragmaTerms], ErrorTerm, VarSet, Result)
+ [LangC | PragmaTerms], ErrorTerm, VarSet, Context, Result)
;
Msg = "wrong number of arguments or unexpected variable " ++
"in `:- pragma c_header_code' declaration",
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "foreign_code", PragmaTerms, ErrorTerm,
- VarSet, Result) :-
- parse_pragma_foreign_code_pragma(ModuleName, "foreign_code",
- PragmaTerms, ErrorTerm, VarSet, Result).
-
-parse_pragma_type(ModuleName, "foreign_proc", PragmaTerms, ErrorTerm,
- VarSet, Result) :-
- parse_pragma_foreign_proc_pragma(ModuleName, "foreign_proc",
- PragmaTerms, ErrorTerm, VarSet, Result).
-
-
%----------------------------------------------------------------------------%
%
% Code for parsing foreign_export_enum pragmas
%
-parse_pragma_type(_ModuleName, "foreign_export_enum", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- (
+:- pred parse_pragma_foreign_export_enum(list(term)::in, term::in,
+ prog_context::in, maybe1(item)::out) is det.
+parse_pragma_foreign_export_enum(PragmaTerms, ErrorTerm, Context, Result) :-
+ (
(
PragmaTerms = [LangTerm, MercuryTypeTerm],
MaybeAttributesTerm = no,
@@ -255,12 +432,17 @@
ForeignLanguage, Name, Arity, Attributes,
Overrides
),
- Item = item_pragma(user, PragmaExportEnum),
+ ItemPragma = item_pragma_info(user, PragmaExportEnum,
+ Context),
+ Item = item_pragma(ItemPragma),
Result = ok1(Item)
;
MaybeOverrides = error1(Errors),
Result = error1(Errors)
)
+ ;
+ MaybeAttributes = error1(Errors),
+ Result = error1(Errors)
)
;
MaybeType = error2(Errors),
@@ -277,8 +459,7 @@
Result = error1([Msg - ErrorTerm])
).
-:- pred parse_export_enum_type(term::in,
- maybe2(sym_name, arity)::out) is det.
+:- pred parse_export_enum_type(term::in, maybe2(sym_name, arity)::out) is det.
parse_export_enum_type(TypeTerm, Result) :-
( parse_name_and_arity(TypeTerm, Name, Arity) ->
@@ -347,7 +528,6 @@
AttributesResult = error1([Msg - AttributesTerm])
;
% Check that the prefix attribute is specified at most once.
- %
IsPrefixAttr = (pred(A::in) is semidet :-
A = ee_attr_prefix(_)
),
@@ -397,8 +577,10 @@
% Code for parsing foreign_enum pragmas
%
-parse_pragma_type(_ModuleName, "foreign_enum", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+:- pred parse_pragma_foreign_enum(list(term)::in, term::in, prog_context::in,
+ maybe1(item)::out) is det.
+
+parse_pragma_foreign_enum(PragmaTerms, ErrorTerm, Context, Result) :-
( PragmaTerms = [LangTerm, MercuryTypeTerm, ValuesTerm] ->
( parse_foreign_language(LangTerm, ForeignLanguage) ->
parse_export_enum_type(MercuryTypeTerm, MaybeType),
@@ -412,12 +594,10 @@
(
MaybeValues = ok1(Values),
PragmaForeignImportEnum = pragma_foreign_enum(
- ForeignLanguage,
- TypeName,
- TypeArity,
- Values
- ),
- Item = item_pragma(user, PragmaForeignImportEnum),
+ ForeignLanguage, TypeName, TypeArity, Values),
+ ItemPragma = item_pragma_info(user,
+ PragmaForeignImportEnum, Context),
+ Item = item_pragma(ItemPragma),
Result = ok1(Item)
;
MaybeValues = error1(Errors),
@@ -443,8 +623,10 @@
% Code for parsing foreign_export pragmas
%
-parse_pragma_type(_ModuleName, "foreign_export", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+:- pred parse_pragma_foreign_export(list(term)::in, term::in, prog_context::in,
+ maybe1(item)::out) is det.
+
+parse_pragma_foreign_export(PragmaTerms, ErrorTerm, Context, Result) :-
( PragmaTerms = [LangTerm, PredAndModesTerm, FunctionTerm] ->
( FunctionTerm = term.functor(term.string(Function), [], _) ->
parse_pred_or_func_and_arg_modes(no, PredAndModesTerm,
@@ -453,9 +635,11 @@
(
PredAndModesResult = ok2(PredName - PredOrFunc, Modes),
( parse_foreign_language(LangTerm, ForeignLanguage) ->
- Result = ok1(item_pragma(user,
- pragma_foreign_export(ForeignLanguage, PredName,
- PredOrFunc, Modes, Function)))
+ Pragma = pragma_foreign_export(ForeignLanguage, PredName,
+ PredOrFunc, Modes, Function),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Msg = "invalid foreign language in " ++
"`:- pragma foreign_export declaration",
@@ -476,56 +660,69 @@
Result = error1([Msg - ErrorTerm])
).
+%----------------------------------------------------------------------------%
+
+:- pred parse_pragma_c_code(module_name::in, list(term)::in, term::in,
+ varset::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_c_code(ModuleName, PragmaTerms, ErrorTerm, VarSet, Context,
+ Result) :-
% pragma c_code is almost as if we have written foreign_code
% or foreign_proc with the language set to "C".
% There are a few differences (error messages, some deprecated
% syntax is still supported for c_code) so we pass the original
% pragma name to parse_pragma_foreign_code_pragma.
-parse_pragma_type(ModuleName, "c_code", PragmaTerms, ErrorTerm,
- VarSet, Result) :-
(
% arity = 1 (same as foreign_code)
- PragmaTerms = [term.functor(_, _, Context)]
+ PragmaTerms = [term.functor(_, _, FirstContext)]
->
- LangC = term.functor(term.string("C"), [], Context),
+ LangC = term.functor(term.string("C"), [], FirstContext),
parse_pragma_foreign_code_pragma(ModuleName, "c_code",
- [LangC | PragmaTerms], ErrorTerm, VarSet, Result)
+ [LangC | PragmaTerms], ErrorTerm, VarSet, Context, Result)
;
% arity > 1 (same as foreign_proc)
- PragmaTerms = [term.functor(_, _, Context) | _]
+ PragmaTerms = [term.functor(_, _, FirstContext) | _]
->
- LangC = term.functor(term.string("C"), [], Context),
+ LangC = term.functor(term.string("C"), [], FirstContext),
parse_pragma_foreign_proc_pragma(ModuleName, "c_code",
- [LangC | PragmaTerms], ErrorTerm, VarSet, Result)
+ [LangC | PragmaTerms], ErrorTerm, VarSet, Context, Result)
;
Msg = "wrong number of arguments or unexpected variable" ++
"in `:- pragma c_code' declaration",
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(_ModuleName, "c_import_module", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+:- pred parse_pragma_c_import_module(list(term)::in, term::in,
+ prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_c_import_module(PragmaTerms, ErrorTerm, Context, Result) :-
(
PragmaTerms = [ImportTerm],
sym_name_and_args(ImportTerm, Import, [])
->
- Result = ok1(item_pragma(user,
- pragma_foreign_import_module(lang_c, Import)))
+ Pragma = pragma_foreign_import_module(lang_c, Import),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Msg = "wrong number of arguments or invalid module name " ++
"in `:- pragma c_import_module' declaration",
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(_ModuleName, "foreign_import_module", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+:- pred parse_pragma_foreign_import_module(list(term)::in, term::in,
+ prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_foreign_import_module(PragmaTerms, ErrorTerm, Context, Result) :-
(
PragmaTerms = [LangTerm, ImportTerm],
sym_name_and_args(ImportTerm, Import, [])
->
( parse_foreign_language(LangTerm, Language) ->
- Result = ok1(item_pragma(user,
- pragma_foreign_import_module(Language, Import)))
+ Pragma = pragma_foreign_import_module(Language, Import),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Msg = "invalid foreign language in " ++
"`:- pragma foreign_import_module' declaration",
@@ -537,7 +734,10 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "import", PragmaTerms, ErrorTerm, VarSet,
+:- pred parse_pragma_import(module_name::in, list(term)::in, term::in,
+ varset::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_import(ModuleName, PragmaTerms, ErrorTerm, VarSet, Context,
Result) :-
% XXX We assume all imports are C.
ForeignLanguage = lang_c,
@@ -572,8 +772,11 @@
PredAndArgModesResult = ok2(PredName - PredOrFunc, ArgModes),
(
FlagsResult = ok1(Attributes),
- Result = ok1(item_pragma(user, pragma_import(PredName,
- PredOrFunc, ArgModes, Attributes, Function)))
+ Pragma = pragma_import(PredName, PredOrFunc, ArgModes,
+ Attributes, Function),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
FlagsResult = error1(FlagsErrors2),
Result = error1(FlagsErrors2)
@@ -591,17 +794,21 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(_ModuleName, "export", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+:- pred parse_pragma_export(list(term)::in, term::in,
+ prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_export(PragmaTerms, ErrorTerm, Context, Result) :-
( PragmaTerms = [PredAndModesTerm, FunctionTerm] ->
( FunctionTerm = term.functor(term.string(Function), [], _) ->
parse_pred_or_func_and_arg_modes(no, PredAndModesTerm, ErrorTerm,
"`:- pragma export' declaration", PredAndModesResult),
(
PredAndModesResult = ok2(PredName - PredOrFunc, Modes),
- Result = ok1(item_pragma(user,
- pragma_foreign_export(lang_c, PredName, PredOrFunc, Modes,
- Function)))
+ Pragma = pragma_foreign_export(lang_c, PredName, PredOrFunc,
+ Modes, Function),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
PredAndModesResult = error2(PredAndModesErrors),
Result = error1(PredAndModesErrors)
@@ -616,48 +823,13 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "inline", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_inline(Name, Arity)),
- parse_simple_pragma(ModuleName, "inline", MakePragma, PragmaTerms,
- ErrorTerm, Result).
+:- pred parse_pragma_unused_args(module_name::in, list(term)::in, term::in,
+ prog_context::in, maybe1(item)::out) is det.
-parse_pragma_type(ModuleName, "no_inline", PragmaTerms, ErrorTerm, _VarSet,
+parse_pragma_unused_args(ModuleName, PragmaTerms, ErrorTerm, Context,
Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_no_inline(Name, Arity)),
- parse_simple_pragma(ModuleName, "no_inline", MakePragma, PragmaTerms,
- ErrorTerm, Result).
-
-parse_pragma_type(ModuleName, "memo", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_tabling_pragma(ModuleName, "memo", eval_memo, PragmaTerms, ErrorTerm,
- Result).
-parse_pragma_type(ModuleName, "loop_check", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check,
- PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "minimal_model", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- % We don't yet know whether we will use the stack_copy or the own_stacks
- % technique for computing minimal models. The decision depends on the
- % grade, and is made in make_hlds.m; the stack_copy here is just a
- % placeholder.
- parse_tabling_pragma(ModuleName, "minimal_model", eval_minimal(stack_copy),
- PragmaTerms, ErrorTerm, Result).
-
-parse_pragma_type(ModuleName, "obsolete", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_obsolete(Name, Arity)),
- parse_simple_pragma(ModuleName, "obsolete", MakePragma, PragmaTerms,
- ErrorTerm, Result).
-
% pragma unused_args should never appear in user programs,
% only in .opt files.
-parse_pragma_type(ModuleName, "unused_args", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
(
PragmaTerms = [
PredOrFuncTerm,
@@ -679,13 +851,19 @@
convert_int_list(UnusedArgsTerm, UnusedArgsResult),
UnusedArgsResult = ok1(UnusedArgs)
->
- Result = ok1(item_pragma(user, pragma_unused_args(PredOrFunc, PredName,
- Arity, ModeNum, UnusedArgs)))
+ Pragma = pragma_unused_args(PredOrFunc, PredName, Arity, ModeNum,
+ UnusedArgs),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Result = error1(["error in `:- pragma unused_args'" - ErrorTerm])
).
-parse_pragma_type(ModuleName, "type_spec", PragmaTerms, ErrorTerm, VarSet0,
+:- pred parse_pragma_type_spec(module_name::in, list(term)::in, term::in,
+ varset::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_type_spec(ModuleName, PragmaTerms, ErrorTerm, VarSet0, Context,
Result) :-
(
(
@@ -725,10 +903,11 @@
UnqualName, newpred_type_subst(TVarSet, TypeSubn),
SpecializedName)
),
- TypeSpecPragma = pragma_type_spec(PredName, SpecializedName,
- Arity, MaybePredOrFunc, MaybeModes, TypeSubn, TVarSet,
- set.init),
- Result = ok1(item_pragma(user, TypeSpecPragma))
+ Pragma = pragma_type_spec(PredName, SpecializedName, Arity,
+ MaybePredOrFunc, MaybeModes, TypeSubn, TVarSet, set.init),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Msg = "expected type substitution in " ++
"`:- pragma type_spec' declaration",
@@ -743,23 +922,21 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "reserve_tag", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_reserve_tag(Name, Arity)),
- parse_simple_type_pragma(ModuleName, "reserve_tag", MakePragma,
- PragmaTerms, ErrorTerm, Result).
+:- pred parse_pragma_fact_table(module_name::in, list(term)::in, term::in,
+ prog_context::in, maybe1(item)::out) is det.
-parse_pragma_type(ModuleName, "fact_table", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+parse_pragma_fact_table(ModuleName, PragmaTerms, ErrorTerm,
+ Context, Result) :-
( PragmaTerms = [PredAndArityTerm, FileNameTerm] ->
parse_pred_name_and_arity(ModuleName, "fact_table",
PredAndArityTerm, ErrorTerm, NameArityResult),
(
NameArityResult = ok2(PredName, Arity),
( FileNameTerm = term.functor(term.string(FileName), [], _) ->
- Result = ok1(item_pragma(user,
- pragma_fact_table(PredName, Arity, FileName)))
+ Pragma = pragma_fact_table(PredName, Arity, FileName),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Result = error1(["expected string for fact table filename" -
FileNameTerm])
@@ -774,29 +951,11 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "promise_equivalent_clauses", PragmaTerms,
- ErrorTerm, _VarSet, Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_promise_equivalent_clauses(Name, Arity)),
- parse_simple_pragma(ModuleName, "promise_equivalent_clauses", MakePragma,
- PragmaTerms, ErrorTerm, Result).
+:- pred parse_pragma_termination_info(module_name::in, list(term)::in, term::in,
+ prog_context::in, maybe1(item)::out) is det.
-parse_pragma_type(ModuleName, "promise_pure", PragmaTerms, ErrorTerm, _VarSet,
+parse_pragma_termination_info(ModuleName, PragmaTerms, ErrorTerm, Context,
Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_promise_pure(Name, Arity)),
- parse_simple_pragma(ModuleName, "promise_pure", MakePragma,
- PragmaTerms, ErrorTerm, Result).
-
-parse_pragma_type(ModuleName, "promise_semipure", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_promise_semipure(Name, Arity)),
- parse_simple_pragma(ModuleName, "promise_semipure", MakePragma,
- PragmaTerms, ErrorTerm, Result).
-
-parse_pragma_type(ModuleName, "termination_info", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
(
PragmaTerms = [
PredAndModesTerm0,
@@ -830,8 +989,11 @@
TerminationTerm = term.functor(term.atom("cannot_loop"), [], _),
MaybeTerminationInfo = yes(cannot_loop(unit))
),
- Result0 = ok1(item_pragma(user, pragma_termination_info(PredOrFunc,
- PredName, ModeList, MaybeArgSizeInfo, MaybeTerminationInfo)))
+ Pragma = pragma_termination_info(PredOrFunc, PredName, ModeList,
+ MaybeArgSizeInfo, MaybeTerminationInfo),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result0 = ok1(Item)
->
Result = Result0
;
@@ -839,8 +1001,11 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "termination2_info", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+:- pred parse_pragma_termination2_info(module_name::in,
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_termination2_info(ModuleName, PragmaTerms, ErrorTerm, Context,
+ Result) :-
(
PragmaTerms = [
PredAndModesTerm0,
@@ -866,9 +1031,11 @@
TerminationTerm = term.functor(term.atom("cannot_loop"), [], _),
MaybeTerminationInfo = yes(cannot_loop(unit))
),
- Result0 = ok1(item_pragma(user, pragma_termination2_info(PredOrFunc,
- PredName, ModeList, SuccessArgSizeInfo, FailureArgSizeInfo,
- MaybeTerminationInfo)))
+ Pragma = pragma_termination2_info(PredOrFunc, PredName, ModeList,
+ SuccessArgSizeInfo, FailureArgSizeInfo, MaybeTerminationInfo),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result0 = ok1(Item)
->
Result = Result0
;
@@ -876,29 +1043,11 @@
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "terminates", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_terminates(Name, Arity)),
- parse_simple_pragma(ModuleName, "terminates", MakePragma,
- PragmaTerms, ErrorTerm, Result).
+:- pred parse_pragma_structure_sharing(module_name::in,
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
-parse_pragma_type(ModuleName, "does_not_terminate", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_does_not_terminate(Name, Arity)),
- parse_simple_pragma(ModuleName, "does_not_terminate", MakePragma,
- PragmaTerms, ErrorTerm, Result).
-
-parse_pragma_type(ModuleName, "check_termination", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_check_termination(Name, Arity)),
- parse_simple_pragma(ModuleName, "check_termination", MakePragma,
- PragmaTerms, ErrorTerm, Result).
-
-parse_pragma_type(ModuleName, "structure_sharing", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+parse_pragma_structure_sharing(ModuleName, PragmaTerms, ErrorTerm, Context,
+ Result) :-
(
PragmaTerms = [
PredAndModesTerm0,
@@ -931,19 +1080,23 @@
SharingTerm, _),
SharingTerm = [SharingAsTerm],
MaybeSharingAs = yes(parse_structure_sharing_domain(SharingAsTerm))
- ),
-
- Result0 = ok1(item_pragma(user, pragma_structure_sharing(PredOrFunc,
- PredName, ModeList, HeadVars, Types, MaybeSharingAs)))
+ )
->
- Result = Result0
+ Pragma = pragma_structure_sharing(PredOrFunc, PredName, ModeList,
+ HeadVars, Types, MaybeSharingAs),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Msg = "syntax error in `:- pragma structure_sharing' declaration",
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "structure_reuse", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+:- pred parse_pragma_structure_reuse(module_name::in,
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_structure_reuse(ModuleName, PragmaTerms, ErrorTerm, Context,
+ Result) :-
(
PragmaTerms = [
PredAndModesTerm0,
@@ -976,19 +1129,22 @@
MaybeStructureReuseTermArgs = [ StructureReuseTerm ],
StructureReuse = parse_structure_reuse_domain(StructureReuseTerm),
MaybeStructureReuse = yes(StructureReuse)
- ),
-
- Result0 = ok1(item_pragma(user, pragma_structure_reuse(PredOrFunc,
- PredName, ModeList, HeadVars, Types, MaybeStructureReuse)))
+ )
->
- Result = Result0
+ Pragma = pragma_structure_reuse(PredOrFunc, PredName, ModeList,
+ HeadVars, Types, MaybeStructureReuse),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Msg = "syntax error in `:- pragma structure_reuse' declaration",
Result = error1([Msg - ErrorTerm])
).
-parse_pragma_type(ModuleName, "exceptions", PragmaTerms, ErrorTerm, _VarSet,
- Result) :-
+:- pred parse_pragma_exceptions(module_name::in,
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_exceptions(ModuleName, PragmaTerms, ErrorTerm, Context, Result) :-
(
PragmaTerms = [
PredOrFuncTerm,
@@ -1028,14 +1184,20 @@
ThrowStatus = throw_conditional
)
->
- Result = ok1(item_pragma(user, pragma_exceptions(PredOrFunc, PredName,
- Arity, ModeNum, ThrowStatus)))
+ Pragma = pragma_exceptions(PredOrFunc, PredName, Arity, ModeNum,
+ ThrowStatus),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Result = error1(["error in `:- pragma exceptions'" - ErrorTerm])
).
-parse_pragma_type(ModuleName, "trailing_info", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+:- pred parse_pragma_trailing_info(module_name::in,
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_trailing_info(ModuleName, PragmaTerms, ErrorTerm, Context,
+ Result) :-
(
PragmaTerms = [
PredOrFuncTerm,
@@ -1068,14 +1230,20 @@
TrailingStatus = trail_conditional
)
->
- Result = ok1(item_pragma(user, pragma_trailing_info(PredOrFunc,
- PredName, Arity, ModeNum, TrailingStatus)))
+ Pragma = pragma_trailing_info(PredOrFunc, PredName, Arity, ModeNum,
+ TrailingStatus),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Result = error1(["error in `:- pragma trailing_info'" - ErrorTerm])
).
-parse_pragma_type(ModuleName, "mm_tabling_info", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+:- pred parse_pragma_mm_tabling_info(module_name::in,
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
+
+parse_pragma_mm_tabling_info(ModuleName, PragmaTerms, ErrorTerm, Context,
+ Result) :-
(
PragmaTerms = [
PredOrFuncTerm,
@@ -1109,21 +1277,19 @@
MM_TablingStatus = mm_tabled_conditional
)
->
- Result = ok1(item_pragma(user, pragma_mm_tabling_info(PredOrFunc,
- PredName, Arity, ModeNum, MM_TablingStatus)))
+ Pragma = pragma_mm_tabling_info(PredOrFunc, PredName, Arity, ModeNum,
+ MM_TablingStatus),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Result = error1(["error in `:- pragma mm_tabling_info'" - ErrorTerm])
).
-parse_pragma_type(ModuleName, "mode_check_clauses", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
- Pragma = pragma_mode_check_clauses(Name, Arity)),
- parse_simple_pragma(ModuleName, "mode_check_clauses", MakePragma,
- PragmaTerms, ErrorTerm, Result).
+:- pred parse_pragma_require_feature_set(list(term)::in, term::in,
+ prog_context::in, maybe1(item)::out) is det.
-parse_pragma_type(_ModuleName, "require_feature_set", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
+parse_pragma_require_feature_set(PragmaTerms, ErrorTerm, Context, Result) :-
( PragmaTerms = [FeatureListTerm] ->
convert_maybe_list(FeatureListTerm, parse_required_feature,
"not a feature", MaybeFeatureList),
@@ -1143,12 +1309,14 @@
;
(
FeatureList = [],
- Item = item_nothing(no)
+ ItemNothing = item_nothing_info(no, Context),
+ Item = item_nothing(ItemNothing)
;
FeatureList = [_ | _],
FeatureSet = set.from_list(FeatureList),
Pragma = pragma_require_feature_set(FeatureSet),
- Item = item_pragma(user, Pragma)
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma)
),
Result = ok1(Item)
)
@@ -1336,11 +1504,12 @@
% This predicate parses both c_header_code and foreign_decl pragmas.
%
:- pred parse_pragma_foreign_decl_pragma(module_name::in, string::in,
- list(term)::in, term::in, varset::in, maybe1(item)::out) is det.
+ list(term)::in, term::in, varset::in, prog_context::in,
+ maybe1(item)::out) is det.
-parse_pragma_foreign_decl_pragma(_ModuleName, Pragma, PragmaTerms,
- ErrorTerm, _VarSet, Result) :-
- string.format("invalid `:- pragma %s' declaration ", [s(Pragma)],
+parse_pragma_foreign_decl_pragma(_ModuleName, PragmaName, PragmaTerms,
+ ErrorTerm, _VarSet, Context, Result) :-
+ string.format("invalid `:- pragma %s' declaration ", [s(PragmaName)],
InvalidDeclStr),
(
(
@@ -1353,9 +1522,11 @@
->
( parse_foreign_language(LangTerm, ForeignLanguage) ->
( HeaderTerm = term.functor(term.string(HeaderCode), [], _) ->
- DeclCode = pragma_foreign_decl(ForeignLanguage, IsLocal,
+ Pragma = pragma_foreign_decl(ForeignLanguage, IsLocal,
HeaderCode),
- Result = ok1(item_pragma(user, DeclCode))
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
ErrMsg = "-- expected string for foreign declaration code",
Result = error1([string.append(InvalidDeclStr, ErrMsg) -
@@ -1367,7 +1538,7 @@
)
;
string.format("invalid `:- pragma %s' declaration ",
- [s(Pragma)], ErrorStr),
+ [s(PragmaName)], ErrorStr),
Result = error1([ErrorStr - ErrorTerm])
).
@@ -1376,11 +1547,12 @@
% is handled in parse_pragma_foreign_proc_pragma below.
%
:- pred parse_pragma_foreign_code_pragma(module_name::in, string::in,
- list(term)::in, term::in, varset::in, maybe1(item)::out) is det.
+ list(term)::in, term::in, varset::in, prog_context::in,
+ maybe1(item)::out) is det.
-parse_pragma_foreign_code_pragma(_ModuleName, Pragma, PragmaTerms,
- ErrorTerm, _VarSet, Result) :-
- string.format("invalid `:- pragma %s' declaration ", [s(Pragma)],
+parse_pragma_foreign_code_pragma(_ModuleName, PragmaName, PragmaTerms,
+ ErrorTerm, _VarSet, Context, Result) :-
+ string.format("invalid `:- pragma %s' declaration ", [s(PragmaName)],
InvalidDeclStr),
( PragmaTerms = [LangTerm, CodeTerm] ->
( parse_foreign_language(LangTerm, ForeignLanguagePrime) ->
@@ -1402,8 +1574,10 @@
Errs = LangErrs ++ CodeErrs,
(
Errs = [],
- Result = ok1(item_pragma(user,
- pragma_foreign_code(ForeignLanguage, Code)))
+ Pragma = pragma_foreign_code(ForeignLanguage, Code),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Errs = [_ | _],
Result = error1(Errs)
@@ -1416,11 +1590,12 @@
% This predicate parses both c_code and foreign_proc pragmas.
%
:- pred parse_pragma_foreign_proc_pragma(module_name::in, string::in,
- list(term)::in, term::in, varset::in, maybe1(item)::out) is det.
+ list(term)::in, term::in, varset::in, prog_context::in,
+ maybe1(item)::out) is det.
-parse_pragma_foreign_proc_pragma(ModuleName, Pragma, PragmaTerms,
- ErrorTerm, VarSet, Result) :-
- string.format("invalid `:- pragma %s' declaration ", [s(Pragma)],
+parse_pragma_foreign_proc_pragma(ModuleName, PragmaName, PragmaTerms,
+ ErrorTerm, VarSet, Context, Result) :-
+ string.format("invalid `:- pragma %s' declaration ", [s(PragmaName)],
InvalidDeclStr),
(
PragmaTerms = [LangTerm | RestTerms],
@@ -1436,13 +1611,13 @@
(
RestTerms = [PredAndVarsTerm, CodeTerm],
parse_pragma_ordinary_foreign_proc_pragma_old(ModuleName,
- Pragma, VarSet, PredAndVarsTerm, CodeTerm, ErrorTerm,
- ForeignLanguage, InvalidDeclStr, RestResult)
+ PragmaName, VarSet, PredAndVarsTerm, CodeTerm, ErrorTerm,
+ ForeignLanguage, InvalidDeclStr, Context, RestResult)
;
RestTerms = [PredAndVarsTerm, FlagsTerm, CodeTerm],
- parse_pragma_ordinary_foreign_proc_pragma(ModuleName, Pragma,
- VarSet, PredAndVarsTerm, FlagsTerm, CodeTerm,
- ForeignLanguage, InvalidDeclStr, RestResult)
+ parse_pragma_ordinary_foreign_proc_pragma(ModuleName,
+ PragmaName, VarSet, PredAndVarsTerm, FlagsTerm, CodeTerm,
+ ForeignLanguage, InvalidDeclStr, Context, RestResult)
;
RestTerms = [PredAndVarsTerm, FlagsTerm, FieldsTerm,
FirstTerm, LaterTerm],
@@ -1450,17 +1625,17 @@
SharedTerm = term.functor(term.atom("common_code"),
[term.functor(term.string(""), [], DummyContext)],
DummyContext),
- parse_pragma_model_non_foreign_proc_pragma(ModuleName, Pragma,
- VarSet, PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm,
- LaterTerm, SharedTerm, ForeignLanguage, InvalidDeclStr,
- RestResult)
+ parse_pragma_model_non_foreign_proc_pragma(ModuleName,
+ PragmaName, VarSet, PredAndVarsTerm, FlagsTerm,
+ FieldsTerm, FirstTerm, LaterTerm, SharedTerm,
+ ForeignLanguage, InvalidDeclStr, Context, RestResult)
;
RestTerms = [PredAndVarsTerm, FlagsTerm, FieldsTerm,
FirstTerm, LaterTerm, SharedTerm],
- parse_pragma_model_non_foreign_proc_pragma(ModuleName, Pragma,
- VarSet, PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm,
- LaterTerm, SharedTerm, ForeignLanguage, InvalidDeclStr,
- RestResult)
+ parse_pragma_model_non_foreign_proc_pragma(ModuleName,
+ PragmaName, VarSet, PredAndVarsTerm, FlagsTerm,
+ FieldsTerm, FirstTerm, LaterTerm, SharedTerm,
+ ForeignLanguage, InvalidDeclStr, Context, RestResult)
)
->
(
@@ -1488,20 +1663,20 @@
:- pred parse_pragma_ordinary_foreign_proc_pragma_old(module_name::in,
string::in, varset::in, term::in, term::in, term::in, foreign_language::in,
- string::in, maybe1(item)::out) is det.
+ string::in, prog_context::in, maybe1(item)::out) is det.
-parse_pragma_ordinary_foreign_proc_pragma_old(ModuleName, Pragma, VarSet,
+parse_pragma_ordinary_foreign_proc_pragma_old(ModuleName, PragmaName, VarSet,
PredAndVarsTerm, CodeTerm, ErrorTerm, ForeignLanguage, InvalidDeclStr,
- Result) :-
+ Context, Result) :-
% XXX We should issue a warning; this syntax is deprecated. We will
% continue to accept this if c_code is used, but not with foreign_code.
- ( Pragma = "c_code" ->
+ ( PragmaName = "c_code" ->
Attributes0 = default_attributes(ForeignLanguage),
set_legacy_purity_behaviour(yes, Attributes0, Attributes),
( CodeTerm = term.functor(term.string(Code), [], CodeContext) ->
Impl = fc_impl_ordinary(Code, yes(CodeContext)),
parse_pragma_foreign_code(ModuleName, Attributes,
- PredAndVarsTerm, Impl, VarSet, Result)
+ PredAndVarsTerm, Impl, VarSet, Context, Result)
;
ErrMsg = "-- expecting either `may_call_mercury' or "
++ "`will_not_call_mercury', and a string for foreign code",
@@ -1514,11 +1689,11 @@
:- pred parse_pragma_ordinary_foreign_proc_pragma(module_name::in, string::in,
varset::in, term::in, term::in, term::in, foreign_language::in,
- string::in, maybe1(item)::out) is det.
+ string::in, prog_context::in, maybe1(item)::out) is det.
-parse_pragma_ordinary_foreign_proc_pragma(ModuleName, Pragma, VarSet,
+parse_pragma_ordinary_foreign_proc_pragma(ModuleName, PragmaName, VarSet,
SecondTerm, ThirdTerm, CodeTerm, ForeignLanguage, InvalidDeclStr,
- Result) :-
+ Context, Result) :-
( CodeTerm = term.functor(term.string(CodePrime), [], CodeContextPrime) ->
Code = CodePrime,
CodeContext = CodeContextPrime,
@@ -1530,22 +1705,22 @@
++ "expecting string containing foreign code",
CodeErrs = [(InvalidDeclStr ++ CodeMsg) - CodeTerm]
),
- parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Pragma, VarSet,
- ThirdTerm, MaybeFlagsThird),
+ parse_pragma_foreign_proc_attributes_term(ForeignLanguage, PragmaName,
+ VarSet, ThirdTerm, MaybeFlagsThird),
(
MaybeFlagsThird = ok1(Flags),
FlagsErrs = [],
PredAndVarsTerm = SecondTerm
;
MaybeFlagsThird = error1(FlagsThirdErrors),
- parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Pragma,
+ parse_pragma_foreign_proc_attributes_term(ForeignLanguage, PragmaName,
VarSet, SecondTerm, MaybeFlagsSecond),
(
MaybeFlagsSecond = ok1(Flags),
% XXX We should issue a warning; this syntax is deprecated.
% We will continue to accept this if c_code is used,
% but not with foreign_code.
- ( Pragma = "c_code" ->
+ ( PragmaName = "c_code" ->
PredAndVarsTerm = ThirdTerm,
FlagsErrs = []
;
@@ -1569,7 +1744,7 @@
Errs = [],
Impl = fc_impl_ordinary(Code, yes(CodeContext)),
parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm,
- Impl, VarSet, Result)
+ Impl, VarSet, Context, Result)
;
Errs = [_ | _],
Result = error1(Errs)
@@ -1577,12 +1752,13 @@
:- pred parse_pragma_model_non_foreign_proc_pragma(module_name::in, string::in,
varset::in, term::in, term::in, term::in, term::in, term::in,
- term::in, foreign_language::in, string::in, maybe1(item)::out) is det.
+ term::in, foreign_language::in, string::in, prog_context::in,
+ maybe1(item)::out) is det.
-parse_pragma_model_non_foreign_proc_pragma(ModuleName, Pragma, VarSet,
+parse_pragma_model_non_foreign_proc_pragma(ModuleName, PragmaName, VarSet,
PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm, LaterTerm,
- SharedTerm, ForeignLanguage, InvalidDeclStr, Result) :-
- parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Pragma,
+ SharedTerm, ForeignLanguage, InvalidDeclStr, Context, Result) :-
+ parse_pragma_foreign_proc_attributes_term(ForeignLanguage, PragmaName,
VarSet, FlagsTerm, MaybeFlags),
(
MaybeFlags = ok1(Flags),
@@ -1672,7 +1848,7 @@
First, yes(FirstContext), Later, yes(LaterContext),
Treatment, Shared, yes(SharedContext)),
parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm,
- Impl, VarSet, Result)
+ Impl, VarSet, Context, Result)
;
Errs = [_ | _],
Result = error1(Errs)
@@ -1682,39 +1858,41 @@
%
:- pred parse_simple_pragma(module_name::in, string::in,
pred(sym_name, int, pragma_type)::(pred(in, in, out) is det),
- list(term)::in, term::in, maybe1(item)::out) is det.
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
parse_simple_pragma(ModuleName, PragmaType, MakePragma, PragmaTerms, ErrorTerm,
- Result) :-
- parse_simple_pragma_base(ModuleName, PragmaType,
- "predicate or function", MakePragma, PragmaTerms, ErrorTerm, Result).
+ Context, Result) :-
+ parse_simple_pragma_base(ModuleName, PragmaType, "predicate or function",
+ MakePragma, PragmaTerms, ErrorTerm, Context, Result).
% This parses a pragma that refers to type.
%
:- pred parse_simple_type_pragma(module_name::in, string::in,
pred(sym_name, int, pragma_type)::(pred(in, in, out) is det),
- list(term)::in, term::in, maybe1(item)::out) is det.
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
parse_simple_type_pragma(ModuleName, PragmaType, MakePragma,
- PragmaTerms, ErrorTerm, Result) :-
+ PragmaTerms, ErrorTerm, Context, Result) :-
parse_simple_pragma_base(ModuleName, PragmaType, "type", MakePragma,
- PragmaTerms, ErrorTerm, Result).
+ PragmaTerms, ErrorTerm, Context, Result).
% This parses a pragma that refers to symbol name / arity.
%
:- pred parse_simple_pragma_base(module_name::in, string::in, string::in,
pred(sym_name, int, pragma_type)::(pred(in, in, out) is det),
- list(term)::in, term::in, maybe1(item)::out) is det.
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
parse_simple_pragma_base(ModuleName, PragmaType, NameKind, MakePragma,
- PragmaTerms, ErrorTerm, Result) :-
+ PragmaTerms, ErrorTerm, Context, Result) :-
( PragmaTerms = [PredAndArityTerm] ->
parse_simple_name_and_arity(ModuleName, PragmaType, NameKind,
PredAndArityTerm, PredAndArityTerm, NameArityResult),
(
NameArityResult = ok2(PredName, Arity),
MakePragma(PredName, Arity, Pragma),
- Result = ok1(item_pragma(user, Pragma))
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
NameArityResult = error2(Errors),
Result = error1(Errors)
@@ -1780,10 +1958,10 @@
string::in, varset::in, term::in,
maybe1(pragma_foreign_proc_attributes)::out) is det.
-parse_pragma_foreign_proc_attributes_term(ForeignLanguage, Pragma, Varset,
+parse_pragma_foreign_proc_attributes_term(ForeignLanguage, PragmaName, Varset,
Term, MaybeAttributes) :-
Attributes0 = default_attributes(ForeignLanguage),
- ( ( Pragma = "c_code" ; Pragma = "import" ) ->
+ ( ( PragmaName = "c_code" ; PragmaName = "import" ) ->
set_legacy_purity_behaviour(yes, Attributes0, Attributes1),
set_purity(purity_pure, Attributes1, Attributes2)
;
@@ -2152,11 +2330,11 @@
% Parse a pragma foreign_code declaration.
%
:- pred parse_pragma_foreign_code(module_name::in,
- pragma_foreign_proc_attributes::in, term::in,
- pragma_foreign_code_impl::in, varset::in, maybe1(item)::out) is det.
+ pragma_foreign_proc_attributes::in, term::in, pragma_foreign_code_impl::in,
+ varset::in, prog_context::in, maybe1(item)::out) is det.
parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm0,
- PragmaImpl, VarSet0, Result) :-
+ PragmaImpl, VarSet0, Context, Result) :-
parse_pred_or_func_and_args(yes(ModuleName), PredAndVarsTerm0,
PredAndVarsTerm0, "`:- pragma c_code' declaration", PredAndArgsResult),
(
@@ -2176,8 +2354,11 @@
Error = no,
varset.coerce(VarSet0, ProgVarSet),
varset.coerce(VarSet0, InstVarSet),
- Result = ok1(item_pragma(user, pragma_foreign_proc(Flags, PredName,
- PredOrFunc, PragmaVars, ProgVarSet, InstVarSet, PragmaImpl)))
+ Pragma = pragma_foreign_proc(Flags, PredName, PredOrFunc,
+ PragmaVars, ProgVarSet, InstVarSet, PragmaImpl),
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
Error = yes(ErrorMessage),
Result = error1([ErrorMessage - PredAndVarsTerm0])
@@ -2224,10 +2405,10 @@
).
:- pred parse_tabling_pragma(module_name::in, string::in, eval_method::in,
- list(term)::in, term::in, maybe1(item)::out) is det.
+ list(term)::in, term::in, prog_context::in, maybe1(item)::out) is det.
parse_tabling_pragma(ModuleName, PragmaName, TablingType, PragmaTerms,
- ErrorTerm, Result) :-
+ ErrorTerm, Context, Result) :-
(
(
PragmaTerms = [PredAndModesTerm0],
@@ -2245,9 +2426,11 @@
MaybePredOrFunc, MaybeModes)),
(
MaybeAttrs = no,
- PragmaType = pragma_tabled(TablingType, PredName, Arity,
+ Pragma = pragma_tabled(TablingType, PredName, Arity,
MaybePredOrFunc, MaybeModes, no),
- Result = ok1(item_pragma(user, PragmaType))
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
MaybeAttrs = yes(AttrsListTerm),
convert_maybe_list(AttrsListTerm,
@@ -2259,10 +2442,12 @@
default_memo_table_attributes, MaybeAttributes),
(
MaybeAttributes = ok1(Attributes),
- PragmaType = pragma_tabled(TablingType, PredName,
+ Pragma = pragma_tabled(TablingType, PredName,
Arity, MaybePredOrFunc, MaybeModes,
yes(Attributes)),
- Result = ok1(item_pragma(user, PragmaType))
+ ItemPragma = item_pragma_info(user, Pragma, Context),
+ Item = item_pragma(ItemPragma),
+ Result = ok1(Item)
;
MaybeAttributes = error1(Errors),
Result = error1(Errors)
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.60
diff -u -b -r1.60 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 2 Oct 2007 04:32:48 -0000 1.60
+++ compiler/prog_io_typeclass.m 9 Feb 2008 04:16:45 -0000
@@ -31,12 +31,12 @@
% Parse a typeclass declaration.
%
:- pred parse_typeclass(module_name::in, varset::in, list(term)::in,
- maybe1(item)::out) is semidet.
+ prog_context::in, maybe1(item_typeclass_info)::out) is semidet.
% Parse an instance declaration.
%
:- pred parse_instance(module_name::in, varset::in, list(term)::in,
- maybe1(item)::out) is semidet.
+ prog_context::in, maybe1(item_instance_info)::out) is semidet.
% Parse a list of class constraints.
%
@@ -72,39 +72,35 @@
%-----------------------------------------------------------------------------%
-parse_typeclass(ModuleName, VarSet, TypeClassTerm, Result) :-
+parse_typeclass(ModuleName, VarSet, TypeClassTerm, Context, Result) :-
% XXX We should return an error if we get more than one arg, instead of
% failing.
TypeClassTerm = [Arg],
( Arg = term.functor(term.atom("where"), [Name, Methods], _) ->
- parse_non_empty_class(ModuleName, Name, Methods, VarSet, Result)
+ parse_non_empty_class(ModuleName, Name, Methods, VarSet, Context,
+ Result)
;
- parse_class_head(ModuleName, Arg, VarSet, Result)
+ parse_class_head(ModuleName, Arg, VarSet, Context, Result)
).
:- pred parse_non_empty_class(module_name::in, term::in, term::in, varset::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item_typeclass_info)::out) is det.
-parse_non_empty_class(ModuleName, Name, Methods, VarSet, Result) :-
+parse_non_empty_class(ModuleName, Name, Methods, VarSet, Context, Result) :-
varset.coerce(VarSet, TVarSet),
parse_class_methods(ModuleName, Methods, VarSet, MaybeParsedMethods),
(
MaybeParsedMethods = ok1(MethodList),
- parse_class_head(ModuleName, Name, VarSet, MaybeParsedNameAndVars),
+ parse_class_head(ModuleName, Name, VarSet, Context,
+ MaybeParsedNameAndVars),
(
MaybeParsedNameAndVars = error1(Errors),
Result = error1(Errors)
;
MaybeParsedNameAndVars = ok1(ParsedNameAndVars),
- ( ParsedNameAndVars = item_typeclass(_, _, _, _, _, _) ->
Result = ok1((ParsedNameAndVars
^ tc_class_methods := class_interface_concrete(MethodList))
^ tc_varset := TVarSet)
- ;
- % If the item we get back isn't a typeclass,
- % something has gone wrong...
- unexpected(this_file, "item should be a typeclass")
- )
)
;
MaybeParsedMethods = error1(Errors),
@@ -112,39 +108,40 @@
).
:- pred parse_class_head(module_name::in, term::in, varset::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item_typeclass_info)::out) is det.
-parse_class_head(ModuleName, Arg, VarSet, Result) :-
+parse_class_head(ModuleName, Arg, VarSet, Context, Result) :-
( Arg = term.functor(term.atom("<="), [Name, Constraints], _) ->
- parse_constrained_class(ModuleName, Name, Constraints, VarSet, Result)
+ parse_constrained_class(ModuleName, Name, Constraints, VarSet, Context,
+ Result)
;
varset.coerce(VarSet, TVarSet),
- parse_unconstrained_class(ModuleName, Arg, TVarSet, Result)
+ parse_unconstrained_class(ModuleName, Arg, TVarSet, Context, Result)
).
:- pred parse_constrained_class(module_name::in, term::in, term::in,
- varset::in, maybe1(item)::out) is det.
+ varset::in, prog_context::in, maybe1(item_typeclass_info)::out) is det.
-parse_constrained_class(ModuleName, Decl, Constraints, VarSet, Result) :-
+parse_constrained_class(ModuleName, Decl, Constraints, VarSet, Context,
+ Result) :-
varset.coerce(VarSet, TVarSet),
parse_superclass_constraints(ModuleName, Constraints,
MaybeParsedConstraints),
(
MaybeParsedConstraints = ok2(ConstraintList, FunDeps),
- parse_unconstrained_class(ModuleName, Decl, TVarSet, Result0),
+ parse_unconstrained_class(ModuleName, Decl, TVarSet, Context, Result0),
(
Result0 = error1(_),
Result = Result0
;
- Result0 = ok1(Item),
- ( Item = item_typeclass(_, _, _, _, _, _) ->
+ Result0 = ok1(ItemTypeClass),
(
% Check for type variables in the constraints which do not
% occur in the type class parameters.
prog_type.constraint_list_get_tvars(ConstraintList,
ConstrainedVars),
list.member(Var, ConstrainedVars),
- \+ list.member(Var, Item ^ tc_class_params)
+ \+ list.member(Var, ItemTypeClass ^ tc_class_params)
->
Msg = "type variable in superclass constraint " ++
"is not a parameter of this type class",
@@ -154,26 +151,19 @@
% occur in the type class parameters.
list.member(FunDep, FunDeps),
FunDep = fundep(Domain, Range),
- (
- list.member(Var, Domain)
- ;
- list.member(Var, Range)
+ ( list.member(Var, Domain)
+ ; list.member(Var, Range)
),
- \+ list.member(Var, Item ^ tc_class_params)
+ \+ list.member(Var, ItemTypeClass ^ tc_class_params)
->
Msg = "type variable in functional dependency " ++
"is not a parameter of this type class",
Result = error1([Msg - Constraints])
;
- Result = ok1((Item
+ Result = ok1((ItemTypeClass
^ tc_constraints := ConstraintList)
^ tc_fundeps := FunDeps)
)
- ;
- % If the item we get back isn't a typeclass,
- % something has gone wrong...
- unexpected(this_file, "item should be a typeclass")
- )
)
;
MaybeParsedConstraints = error2(Errors),
@@ -221,9 +211,9 @@
).
:- pred parse_unconstrained_class(module_name::in, term::in, tvarset::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item_typeclass_info)::out) is det.
-parse_unconstrained_class(ModuleName, Name, TVarSet, Result) :-
+parse_unconstrained_class(ModuleName, Name, TVarSet, Context, Result) :-
parse_implicitly_qualified_term(ModuleName,
Name, Name, "typeclass declaration", MaybeClassName),
(
@@ -234,8 +224,10 @@
list.sort_and_remove_dups(TermVars, SortedTermVars),
list.length(SortedTermVars) = list.length(TermVars) : int
->
- Result = ok1(item_typeclass([], [], ClassName, Vars,
- class_interface_abstract, TVarSet))
+ % XXX Would this be a better context?
+ % Context = get_term_context(Name),
+ Result = ok1(item_typeclass_info([], [], ClassName, Vars,
+ class_interface_abstract, TVarSet, Context))
;
Msg = "expected distinct variables as class parameters",
Result = error1([Msg - Name])
@@ -265,17 +257,21 @@
Result = error1(["expected list of class methods" - Methods])
).
-
-:- pred item_to_class_method(maybe2(item, prog_context)::in, term::in,
+:- pred item_to_class_method(maybe1(item)::in, term::in,
maybe1(class_method)::out) is det.
-item_to_class_method(error2(Errors), _, error1(Errors)).
-item_to_class_method(ok2(Item, Context), Term, Result) :-
- ( Item = item_pred_or_func(_Origin, A, B, C, D, E, F, G, H, I, J, K, L) ->
- Result = ok1(method_pred_or_func(A, B, C, D, E, F, G, H, I, J, K, L,
- Context))
- ; Item = item_pred_or_func_mode(A, B, C, D, E, F, G) ->
- Result = ok1(method_pred_or_func_mode(A, B, C, D, E, F, G, Context))
+item_to_class_method(error1(Errors), _, error1(Errors)).
+item_to_class_method(ok1(Item), Term, Result) :-
+ ( Item = item_pred_decl(ItemPredDecl) ->
+ ItemPredDecl = item_pred_decl_info(_Origin, A, B, C, D, E, F, G, H, I,
+ J, K, L, Context),
+ ClassMethod = method_pred_or_func(A, B, C, D, E, F, G, H, I,
+ J, K, L, Context),
+ Result = ok1(ClassMethod)
+ ; Item = item_mode_decl(ItemModeDecl) ->
+ ItemModeDecl = item_mode_decl_info(A, B, C, D, E, F, G, Context),
+ ClassMethod = method_pred_or_func_mode(A, B, C, D, E, F, G, Context),
+ Result = ok1(ClassMethod)
;
Msg = "Only pred, func and mode declarations " ++
"allowed in class interface",
@@ -516,52 +512,51 @@
%-----------------------------------------------------------------------------%
-parse_instance(ModuleName, VarSet, TypeClassTerm, Result) :-
+parse_instance(ModuleName, VarSet, TypeClassTerm, Context, Result) :-
% XXX We should return an error if we get more than one arg,
% instead of failing.
TypeClassTerm = [Arg],
varset.coerce(VarSet, TVarSet),
( Arg = term.functor(term.atom("where"), [Name, Methods], _) ->
parse_non_empty_instance(ModuleName, Name, Methods, VarSet, TVarSet,
- Result)
+ Context, Result)
;
- parse_instance_name(ModuleName, Arg, TVarSet, Result)
+ parse_instance_name(ModuleName, Arg, TVarSet, Context, Result)
).
:- pred parse_instance_name(module_name::in, term::in, tvarset::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item_instance_info)::out) is det.
-parse_instance_name(ModuleName, Arg, TVarSet, Result) :-
+parse_instance_name(ModuleName, Arg, TVarSet, Context, Result) :-
( Arg = term.functor(term.atom("<="), [Name, Constraints], _) ->
- parse_derived_instance(ModuleName, Name, Constraints, TVarSet, Result)
+ parse_derived_instance(ModuleName, Name, Constraints, TVarSet, Context,
+ Result)
;
- parse_underived_instance(ModuleName, Arg, TVarSet, Result)
+ parse_underived_instance(ModuleName, Arg, TVarSet, Context, Result)
).
:- pred parse_derived_instance(module_name::in, term::in, term::in,
- tvarset::in, maybe1(item)::out) is det.
+ tvarset::in, prog_context::in, maybe1(item_instance_info)::out) is det.
-parse_derived_instance(ModuleName, Decl, Constraints, TVarSet, Result) :-
+parse_derived_instance(ModuleName, Decl, Constraints, TVarSet, Context,
+ Result) :-
parse_instance_constraints(ModuleName, Constraints,
MaybeParsedConstraints),
(
MaybeParsedConstraints = ok1(ConstraintList),
- parse_underived_instance(ModuleName, Decl, TVarSet, Result0),
+ parse_underived_instance(ModuleName, Decl, TVarSet, Context, Result0),
(
Result0 = error1(_),
Result = Result0
;
- Result0 = ok1(Item),
- ( Item = item_instance(_, Name, Types, Body, VarSet, ModName) ->
- Result = ok1(item_instance(ConstraintList, Name, Types, Body,
- VarSet, ModName))
- ;
- % If the item we get back isn't an instance,
- % something has gone wrong...
- % Maybe we should use cleverer inst decls to avoid
- % this call to error.
- unexpected(this_file, "item should be an instance")
- )
+ Result0 = ok1(ItemInstance0),
+ ItemInstance0 = item_instance_info(_ConstraintList0, Name, Types,
+ Body, VarSet, ModName, InstanceContext),
+ % XXX Should we keep InstanceContext, or should we replace it
+ % with Context? Or will they always be the same?
+ ItemInstance = item_instance_info(ConstraintList, Name, Types,
+ Body, VarSet, ModName, InstanceContext),
+ Result = ok1(ItemInstance)
)
;
MaybeParsedConstraints = error1(Errors),
@@ -577,9 +572,9 @@
"type variables and ground types", Result).
:- pred parse_underived_instance(module_name::in, term::in, tvarset::in,
- maybe1(item)::out) is det.
+ prog_context::in, maybe1(item_instance_info)::out) is det.
-parse_underived_instance(ModuleName, Name, TVarSet, Result) :-
+parse_underived_instance(ModuleName, Name, TVarSet, Context, Result) :-
% We don't give a default module name here since the instance declaration
% could well be for a typeclass defined in another module.
parse_qualified_term(Name, Name, "instance declaration", MaybeClassName),
@@ -587,63 +582,62 @@
MaybeClassName = ok2(ClassName, TermTypes),
parse_types(TermTypes, TypesResult),
parse_underived_instance_2(Name, ClassName, TypesResult, TVarSet,
- ModuleName, Result)
+ ModuleName, Context, Result)
;
MaybeClassName = error2(Errors),
Result = error1(Errors)
).
:- pred parse_underived_instance_2(term::in, class_name::in,
- maybe1(list(mer_type))::in, tvarset::in, module_name::in,
- maybe1(item)::out) is det.
+ maybe1(list(mer_type))::in, tvarset::in, module_name::in, prog_context::in,
+ maybe1(item_instance_info)::out) is det.
-parse_underived_instance_2(_, _, error1(Errors), _, _, error1(Errors)).
-parse_underived_instance_2(_, ClassName, ok1(Types), TVarSet,
- ModuleName, Result) :-
- Result = ok1(item_instance([], ClassName, Types,
- instance_body_abstract, TVarSet, ModuleName)).
+parse_underived_instance_2(_, _, error1(Errors), _, _, _, error1(Errors)).
+parse_underived_instance_2(_, ClassName, ok1(Types), TVarSet, ModuleName,
+ Context, Result) :-
+ ItemInstance = item_instance_info([], ClassName, Types,
+ instance_body_abstract, TVarSet, ModuleName, Context),
+ Result = ok1(ItemInstance).
:- pred parse_non_empty_instance(module_name::in, term::in, term::in,
- varset::in, tvarset::in, maybe1(item)::out) is det.
+ varset::in, tvarset::in, prog_context::in,
+ maybe1(item_instance_info)::out) is det.
-parse_non_empty_instance(ModuleName, Name, Methods, VarSet, TVarSet, Result) :-
+parse_non_empty_instance(ModuleName, Name, Methods, VarSet, TVarSet, Context,
+ Result) :-
parse_instance_methods(ModuleName, Methods, VarSet, MaybeParsedMethods),
(
MaybeParsedMethods = ok1(MethodList),
- parse_instance_name(ModuleName, Name, TVarSet,
+ parse_instance_name(ModuleName, Name, TVarSet, Context,
MaybeParsedNameAndTypes),
(
MaybeParsedNameAndTypes = error1(Errors),
Result = error1(Errors)
;
MaybeParsedNameAndTypes = ok1(ParsedNameAndTypes),
- (
- ParsedNameAndTypes = item_instance(Constraints, NameString,
- Types, _, _, ModName)
- ->
- Result0 = ok1(item_instance(Constraints, NameString, Types,
- instance_body_concrete(MethodList), TVarSet, ModName)),
+ % XXX Should we keep InstanceContext, or should we replace it
+ % with Context? Or will they always be the same?
+ ParsedNameAndTypes = item_instance_info(Constraints, NameString,
+ Types, _, _, ModName, InstanceContext),
+ ItemInstance = item_instance_info(Constraints, NameString,
+ Types, instance_body_concrete(MethodList), TVarSet, ModName,
+ InstanceContext),
+ Result0 = ok1(ItemInstance),
check_tvars_in_instance_constraint(Result0, Name, Result)
- ;
- % If the item we get back isn't a typeclass,
- % something has gone wrong...
- unexpected(this_file, "item should be an instance")
- )
)
;
MaybeParsedMethods = error1(Errors),
Result = error1(Errors)
).
-:- pred check_tvars_in_instance_constraint(maybe1(item)::in, term::in,
- maybe1(item)::out) is det.
+:- pred check_tvars_in_instance_constraint(maybe1(item_instance_info)::in,
+ term::in, maybe1(item_instance_info)::out) is det.
check_tvars_in_instance_constraint(error1(Errors), _, error1(Errors)).
-check_tvars_in_instance_constraint(ok1(Item), InstanceTerm, Result) :-
- (
- Item = item_instance(Constraints, _Name, Types, _Methods, _TVarSet,
- _ModName)
- ->
+check_tvars_in_instance_constraint(ok1(ItemInstance), InstanceTerm, Result) :-
+ % XXX
+ ItemInstance = item_instance_info(Constraints, _Name, Types, _Methods,
+ _TVarSet, _ModName, _Context),
% Check that all of the type variables in the constraints
% on the instance declaration also occur in the type class
% argument types in the instance declaration.
@@ -656,11 +650,7 @@
"in constraints on instance declaration",
Result = error1([Msg - InstanceTerm])
;
- Result = ok1(Item)
- )
- ;
- unexpected(this_file,
- "check_tvars_in_constraint: expecting instance item")
+ Result = ok1(ItemInstance)
).
:- pred parse_instance_methods(module_name::in, term::in, varset::in,
@@ -738,17 +728,18 @@
DefaultModuleName = unqualified(""),
parse_item(DefaultModuleName, VarSet, MethodTerm, Result0),
(
- Result0 = error2(Errors),
+ Result0 = error1(Errors),
Result = error1(Errors)
;
- Result0 = ok2(Item, Context),
- (
- Item = item_clause(_Origin, _VarNames, PredOrFunc,
- ClassMethodName, HeadArgs, _ClauseBody)
- ->
+ Result0 = ok1(Item),
+ ( Item = item_clause(ItemClause) ->
+ ItemClause = item_clause_info(_Origin, _VarNames, PredOrFunc,
+ ClassMethodName, HeadArgs, _ClauseBody, Context),
adjust_func_arity(PredOrFunc, ArityInt, list.length(HeadArgs)),
- Result = ok1(instance_method(PredOrFunc, ClassMethodName,
- instance_proc_def_clauses([Item]), ArityInt, Context))
+ InstanceMethod = instance_method(PredOrFunc, ClassMethodName,
+ instance_proc_def_clauses([ItemClause]), ArityInt,
+ Context),
+ Result = ok1(InstanceMethod)
;
Msg = "expected clause or " ++
"`pred(<Name> / <Arity>) is <InstanceName>' or " ++
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.58
diff -u -b -r1.58 prog_io_util.m
--- compiler/prog_io_util.m 22 Jan 2008 15:06:15 -0000 1.58
+++ compiler/prog_io_util.m 9 Feb 2008 03:30:41 -0000
@@ -29,7 +29,6 @@
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
-:- import_module parse_tree.prog_item.
:- import_module assoc_list.
:- import_module list.
@@ -72,8 +71,6 @@
% ok(SymName, Args - MaybeFuncRetArg) ; error(Msg, Term).
:- type maybe_pred_or_func(T) == maybe2(sym_name, pair(list(T), maybe(T))).
-:- type maybe_item_and_context == maybe2(item, prog_context).
-
:- type var2tvar == map(var, tvar).
:- type var2pvar == map(var, prog_var).
@@ -81,9 +78,6 @@
:- type parser(T) == pred(term, maybe1(T)).
:- mode parser == (pred(in, out) is det).
-:- pred add_context(maybe1(item)::in, prog_context::in,
- maybe_item_and_context::out) is det.
-
% Various predicates to parse small bits of syntax.
% These predicates simply fail if they encounter a syntax error.
@@ -209,9 +203,6 @@
get_any_errors4(ok4(_, _, _, _)) = [].
get_any_errors4(error4(Errors)) = Errors.
-add_context(error1(Errs), _, error2(Errs)).
-add_context(ok1(Item), Context, ok2(Item, Context)).
-
parse_name_and_arity(ModuleName, PredAndArityTerm, SymName, Arity) :-
PredAndArityTerm = term.functor(term.atom("/"),
[PredNameTerm, ArityTerm], _),
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.30
diff -u -b -r1.30 prog_item.m
--- compiler/prog_item.m 5 Dec 2007 05:07:37 -0000 1.30
+++ compiler/prog_item.m 7 Feb 2008 08:18:51 -0000
@@ -49,7 +49,7 @@
:- type compilation_unit
---> unit_module(
module_name,
- item_list
+ list(item)
).
% Did an item originate in user code or was it added by the compiler as
@@ -87,64 +87,84 @@
% The compiler sometimes needs to insert additional foreign_import
% pragmas. XXX Why?
-:- type item_list == list(item_and_context).
+:- type item
+ ---> item_module_defn(item_module_defn_info)
+ ; item_clause(item_clause_info)
+ ; item_type_defn(item_type_defn_info)
+ ; item_inst_defn(item_inst_defn_info)
+ ; item_mode_defn(item_mode_defn_info)
+ ; item_pred_decl(item_pred_decl_info)
+ ; item_mode_decl(item_mode_decl_info)
+ ; item_pragma(item_pragma_info)
+ ; item_promise(item_promise_info)
+ ; item_typeclass(item_typeclass_info)
+ ; item_instance(item_instance_info)
+ ; item_initialise(item_initialise_info)
+ ; item_finalise(item_finalise_info)
+ ; item_mutable(item_mutable_info)
+ ; item_nothing(item_nothing_info).
-:- type item_and_context
- ---> item_and_context(
- item,
- prog_context
+:- type item_module_defn_info
+ ---> item_module_defn_info(
+ module_defn_varset :: prog_varset,
+ module_defn_module_defn :: module_defn,
+ module_defn_context :: prog_context
).
-:- type item
- ---> item_clause(
+:- type item_clause_info
+ ---> item_clause_info(
cl_origin :: item_origin,
cl_varset :: prog_varset,
cl_pred_or_func :: pred_or_func,
cl_predname :: sym_name,
cl_head_args :: list(prog_term),
- cl_body :: goal
- )
+ cl_body :: goal,
+ cl_context :: prog_context
+ ).
+:- type item_type_defn_info
+ ---> item_type_defn_info(
% `:- type ...':
% a definition of a type, or a declaration of an abstract type.
- ; item_type_defn(
+
td_tvarset :: tvarset,
td_ctor_name :: sym_name,
td_ctor_args :: list(type_param),
td_ctor_defn :: type_defn,
- td_cond :: condition
- )
+ td_cond :: condition,
+ td_context :: prog_context
+ ).
+:- type item_inst_defn_info
+ ---> item_inst_defn_info(
% `:- inst ... = ...':
% a definition of an inst.
- ; item_inst_defn(
id_varset :: inst_varset,
id_inst_name :: sym_name,
id_inst_args :: list(inst_var),
id_inst_defn :: inst_defn,
- id_cond :: condition
- )
+ id_cond :: condition,
+ id_context :: prog_context
+ ).
+:- type item_mode_defn_info
+ ---> item_mode_defn_info(
% `:- mode ... = ...':
% a definition of a mode.
- ; item_mode_defn(
md_varset :: inst_varset,
md_mode_name :: sym_name,
md_mode_args :: list(inst_var),
md_mode_defn :: mode_defn,
- md_cond :: condition
- )
-
- ; item_module_defn(
- module_defn_varset :: prog_varset,
- module_defn_module_defn :: module_defn
- )
+ md_cond :: condition,
+ md_context :: prog_context
+ ).
+:- type item_pred_decl_info
+ ---> item_pred_decl_info(
% `:- pred ...' or `:- func ...':
% a predicate or function declaration.
% This specifies the type of the predicate or function,
% and it may optionally also specify the mode and determinism.
- ; item_pred_or_func(
pf_origin :: item_origin,
pf_tvarset :: tvarset,
pf_instvarset :: inst_varset,
@@ -152,95 +172,116 @@
pf_which :: pred_or_func,
pf_name :: sym_name,
pf_arg_decls :: list(type_and_mode),
+ % The next two fields hold the `with_type` and `with_inst`
+ % annotations. This syntactic sugar is expanded out by
+ % equiv_type.m, which will then set these fields to `no'.
pf_maybe_with_type :: maybe(mer_type),
pf_maybe_with_inst :: maybe(mer_inst),
pf_maybe_detism :: maybe(determinism),
pf_cond :: condition,
pf_purity :: purity,
- pf_class_context :: prog_constraints
- )
- % The WithType and WithInst fields hold the `with_type`
- % and `with_inst` annotations, which are syntactic
- % sugar that is expanded by equiv_type.m
- % equiv_type.m will set these fields to `no'.
+ pf_class_context :: prog_constraints,
+ pf_context :: prog_context
+ ).
+:- type item_mode_decl_info
+ ---> item_mode_decl_info(
% `:- mode ...':
% a mode declaration for a predicate or function.
- ; item_pred_or_func_mode(
pfm_instvarset :: inst_varset,
pfm_which :: maybe(pred_or_func),
pfm_name :: sym_name,
pfm_arg_modes :: list(mer_mode),
+ % The next field holds the `with_inst` annotation. This
+ % syntactic sugar is expanded by equiv_type.m, which will
+ % then set the field to `no'.
pfm_maybe_with_inst :: maybe(mer_inst),
pfm_maybe_detism :: maybe(determinism),
- pfm_cond :: condition
- )
- % The WithInst field holds the `with_inst` annotation,
- % which is syntactic sugar that is expanded by
- % equiv_type.m. equiv_type.m will set the field to `no'.
+ pfm_cond :: condition,
+ pfm_context :: prog_context
+ ).
- ; item_pragma(
+:- type item_pragma_info
+ ---> item_pragma_info(
pragma_origin :: item_origin,
- pragma_type :: pragma_type
- )
+ pragma_type :: pragma_type,
+ pragma_context :: prog_context
+ ).
- ; item_promise(
+:- type item_promise_info
+ ---> item_promise_info(
prom_type :: promise_type,
prom_clause :: goal,
prom_varset :: prog_varset,
- prom_univ_quant_vars :: prog_vars
- )
+ prom_univ_quant_vars :: prog_vars,
+ prom_context :: prog_context
+ ).
- ; item_typeclass(
+:- type item_typeclass_info
+ ---> item_typeclass_info(
tc_constraints :: list(prog_constraint),
tc_fundeps :: list(prog_fundep),
tc_class_name :: class_name,
tc_class_params :: list(tvar),
tc_class_methods :: class_interface,
- tc_varset :: tvarset
- )
+ tc_varset :: tvarset,
+ tc_context :: prog_context
+ ).
- ; item_instance(
+:- type item_instance_info
+ ---> item_instance_info(
ci_deriving_class :: list(prog_constraint),
ci_class_name :: class_name,
ci_types :: list(mer_type),
ci_method_instances :: instance_body,
ci_varset :: tvarset,
- ci_module_containing_instance :: module_name
- )
+ ci_module_containing_instance :: module_name,
+ ci_context :: prog_context
+ ).
+:- type item_initialise_info
+ ---> item_initialise_info(
% :- initialise pred_name.
- ; item_initialise(
- item_origin,
- sym_name,
- arity
- )
+ init_origin :: item_origin,
+ init_name :: sym_name,
+ init_arity :: arity,
+ init_context :: prog_context
+ ).
+:- type item_finalise_info
+ ---> item_finalise_info(
% :- finalise pred_name.
- ; item_finalise(
- item_origin,
- sym_name,
- arity
- )
+ final_origin :: item_origin,
+ final_name :: sym_name,
+ final_arity :: arity,
+ final_context :: prog_context
+ ).
+:- type item_mutable_info
+ ---> item_mutable_info(
% :- mutable(var_name, type, inst, value, attrs).
- ; item_mutable(
mut_name :: string,
mut_type :: mer_type,
mut_init_value :: prog_term,
mut_inst :: mer_inst,
mut_attrs :: mutable_var_attributes,
- mut_varset :: prog_varset
- )
+ mut_varset :: prog_varset,
+ mut_context :: prog_context
+ ).
- % Used for items that should be ignored (for the
- % purposes of backwards compatibility etc).
- ; item_nothing(
- nothing_maybe_warning :: maybe(item_warning)
+:- type item_nothing_info
+ ---> item_nothing_info(
+ % Used for items that should be ignored (for purposes of
+ % backwards compatibility etc).
+ nothing_maybe_warning :: maybe(item_warning),
+ nothing_context :: prog_context
).
-:- inst item_mutable
- ---> item_mutable(ground, ground, ground, ground, ground, ground).
+:- func get_item_context(item) = prog_context.
+
+% XXX
+% :- inst item_mutable
+% ---> item_mutable(ground, ground, ground, ground, ground, ground).
:- type item_warning
---> item_warning(
@@ -833,6 +874,56 @@
:- implementation.
%-----------------------------------------------------------------------------%
+
+get_item_context(Item) = Context :-
+ (
+ Item = item_module_defn(ItemModuleDefn),
+ Context = ItemModuleDefn ^ module_defn_context
+ ;
+ Item = item_clause(ItemClause),
+ Context = ItemClause ^ cl_context
+ ;
+ Item = item_type_defn(ItemTypeDefn),
+ Context = ItemTypeDefn ^ td_context
+ ;
+ Item = item_inst_defn(ItemInstDefn),
+ Context = ItemInstDefn ^ id_context
+ ;
+ Item = item_mode_defn(ItemModeDefn),
+ Context = ItemModeDefn ^ md_context
+ ;
+ Item = item_pred_decl(ItemPredDecl),
+ Context = ItemPredDecl ^ pf_context
+ ;
+ Item = item_mode_decl(ItemModeDecl),
+ Context = ItemModeDecl ^ pfm_context
+ ;
+ Item = item_pragma(ItemPragma),
+ Context = ItemPragma ^ pragma_context
+ ;
+ Item = item_promise(ItemPromise),
+ Context = ItemPromise ^ prom_context
+ ;
+ Item = item_typeclass(ItemTypeClass),
+ Context = ItemTypeClass ^ tc_context
+ ;
+ Item = item_instance(ItemInstance),
+ Context = ItemInstance ^ ci_context
+ ;
+ Item = item_initialise(ItemInitialise),
+ Context = ItemInitialise ^ init_context
+ ;
+ Item = item_finalise(ItemFinalise),
+ Context = ItemFinalise ^ final_context
+ ;
+ Item = item_mutable(ItemMutable),
+ Context = ItemMutable ^ mut_context
+ ;
+ Item = item_nothing(ItemNothing),
+ Context = ItemNothing ^ nothing_context
+ ).
+
+%-----------------------------------------------------------------------------%
%
% Mutable variables
%
Index: compiler/prog_mutable.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mutable.m,v
retrieving revision 1.23
diff -u -b -r1.23 prog_mutable.m
--- compiler/prog_mutable.m 6 Aug 2007 12:50:25 -0000 1.23
+++ compiler/prog_mutable.m 7 Feb 2008 07:02:49 -0000
@@ -317,53 +317,61 @@
% Create predmode declarations for the four primitive operations.
%
-:- func unsafe_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
-:- func unsafe_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
-:- func lock_pred_decl(module_name, string) = item.
-:- func unlock_pred_decl(module_name, string) = item.
+:- func unsafe_get_pred_decl(module_name, string, mer_type, mer_inst,
+ prog_context) = item.
+:- func unsafe_set_pred_decl(module_name, string, mer_type, mer_inst,
+ prog_context) = item.
+:- func lock_pred_decl(module_name, string, prog_context) = item.
+:- func unlock_pred_decl(module_name, string, prog_context) = item.
% Create a predmode declaration for the semipure mutable get predicate.
% (This is the default get predicate.)
%
-:- func std_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func std_get_pred_decl(module_name, string, mer_type, mer_inst,
+ prog_context) = item.
% Create a predmode declaration for the impure mutable set predicate.
% (This is the default set predicate.)
%
-:- func std_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func std_set_pred_decl(module_name, string, mer_type, mer_inst,
+ prog_context) = item.
% Create a predmode declaration for a get predicate for a constant mutable.
% (This is only created if the `constant' attribute is given.)
%
-:- func constant_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func constant_get_pred_decl(module_name, string, mer_type, mer_inst,
+ prog_context) = item.
% Create a predmode declaration for a set predicate for a constant mutable;
% this predicate is designed to be used only from the mutable's
% initialization predicate.
% (This is created only if the `constant' attribute is given.)
%
-:- func constant_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func constant_set_pred_decl(module_name, string, mer_type, mer_inst,
+ prog_context) = item.
% Create a predmode declaration for a get predicate using the I/O state.
% (This is created only if the `attach_to_io_state' attribute is given.)
%
-:- func io_get_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func io_get_pred_decl(module_name, string, mer_type, mer_inst,
+ prog_context) = item.
% Create a predmode declaration for a set predicate using the I/O state.
% (This is created only if the `attach_to_io_state' attribute is given.)
%
-:- func io_set_pred_decl(module_name, string, mer_type, mer_inst) = item.
+:- func io_set_pred_decl(module_name, string, mer_type, mer_inst,
+ prog_context) = item.
% Create a predmode declaration for the mutable initialisation predicate.
%
-:- func mutable_init_pred_decl(module_name, string) = item.
+:- func mutable_init_pred_decl(module_name, string, prog_context) = item.
% Create a predmode declaration for the mutable pre-initialisation
% predicate. For normal mutables this initialises the mutex protecting
% the mutable. For thread-local mutables this allocates an index
% into an array of thread-local mutable values.
%
-:- func mutable_pre_init_pred_decl(module_name, string) = item.
+:- func mutable_pre_init_pred_decl(module_name, string, prog_context) = item.
% Names of the primtive operations.
%
@@ -426,145 +434,149 @@
% Predmode declarations for primitive operations
%
-unsafe_get_pred_decl(ModuleName, Name, Type, Inst) = UnsafeGetPredDecl :-
+unsafe_get_pred_decl(ModuleName, Name, Type, Inst, Context)
+ = UnsafeGetPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- UnsafeGetPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet,
- ExistQVars,
- pf_predicate,
+ UnsafeGetPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet,
+ ExistQVars, pf_predicate,
mutable_unsafe_get_pred_sym_name(ModuleName, Name),
[type_and_mode(Type, out_mode(Inst))],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_semipure, Constraints).
+ cond_true /* condition */, purity_semipure, Constraints, Context),
+ UnsafeGetPredDeclItem = item_pred_decl(UnsafeGetPredDecl).
-unsafe_set_pred_decl(ModuleName, Name, Type, Inst) = UnsafeSetPredDecl :-
+unsafe_set_pred_decl(ModuleName, Name, Type, Inst, Context)
+ = UnsafeSetPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- UnsafeSetPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet,
- ExistQVars,
- pf_predicate,
+ UnsafeSetPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet,
+ ExistQVars, pf_predicate,
mutable_unsafe_set_pred_sym_name(ModuleName, Name),
[type_and_mode(Type, in_mode(Inst))],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_impure, Constraints).
+ cond_true /* condition */, purity_impure, Constraints, Context),
+ UnsafeSetPredDeclItem = item_pred_decl(UnsafeSetPredDecl).
-lock_pred_decl(ModuleName, Name) = LockPredDecl :-
+lock_pred_decl(ModuleName, Name, Context) = LockPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- LockPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
- pf_predicate,
- mutable_lock_pred_sym_name(ModuleName, Name),
+ LockPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
+ pf_predicate, mutable_lock_pred_sym_name(ModuleName, Name),
[],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_impure, Constraints).
+ cond_true /* condition */, purity_impure, Constraints, Context),
+ LockPredDeclItem = item_pred_decl(LockPredDecl).
-unlock_pred_decl(ModuleName, Name) = UnlockPredDecl :-
+unlock_pred_decl(ModuleName, Name, Context) = UnlockPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- UnlockPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
- pf_predicate,
- mutable_unlock_pred_sym_name(ModuleName, Name),
+ UnlockPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
+ pf_predicate, mutable_unlock_pred_sym_name(ModuleName, Name),
[],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_impure, Constraints).
+ cond_true /* condition */, purity_impure, Constraints, Context),
+ UnlockPredDeclItem = item_pred_decl(UnlockPredDecl).
%-----------------------------------------------------------------------------%
-std_get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
+std_get_pred_decl(ModuleName, Name, Type, Inst, Context) = GetPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- GetPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
- pf_predicate,
- mutable_get_pred_sym_name(ModuleName, Name),
+ GetPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
+ pf_predicate, mutable_get_pred_sym_name(ModuleName, Name),
[type_and_mode(Type, out_mode(Inst))],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_semipure, Constraints).
+ cond_true /* condition */, purity_semipure, Constraints, Context),
+ GetPredDeclItem = item_pred_decl(GetPredDecl).
-std_set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
+std_set_pred_decl(ModuleName, Name, Type, Inst, Context) = SetPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- SetPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
- pf_predicate,
- mutable_set_pred_sym_name(ModuleName, Name),
+ SetPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
+ pf_predicate, mutable_set_pred_sym_name(ModuleName, Name),
[type_and_mode(Type, in_mode(Inst))],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_impure, Constraints).
+ cond_true /* condition */, purity_impure, Constraints, Context),
+ SetPredDeclItem = item_pred_decl(SetPredDecl).
-constant_get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
+constant_get_pred_decl(ModuleName, Name, Type, Inst, Context)
+ = GetPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- GetPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
- pf_predicate,
- mutable_get_pred_sym_name(ModuleName, Name),
+ GetPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
+ pf_predicate, mutable_get_pred_sym_name(ModuleName, Name),
[type_and_mode(Type, out_mode(Inst))],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_pure, Constraints).
+ cond_true /* condition */, purity_pure, Constraints, Context),
+ GetPredDeclItem = item_pred_decl(GetPredDecl).
-constant_set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
+constant_set_pred_decl(ModuleName, Name, Type, Inst, Context)
+ = SetPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- SetPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
- pf_predicate,
- mutable_secret_set_pred_sym_name(ModuleName, Name),
+ SetPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
+ pf_predicate, mutable_secret_set_pred_sym_name(ModuleName, Name),
[type_and_mode(Type, in_mode(Inst))],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_impure, Constraints).
+ cond_true /* condition */, purity_impure, Constraints, Context),
+ SetPredDeclItem = item_pred_decl(SetPredDecl).
-io_get_pred_decl(ModuleName, Name, Type, Inst) = GetPredDecl :-
+io_get_pred_decl(ModuleName, Name, Type, Inst, Context) = GetPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- GetPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
- pf_predicate,
- mutable_get_pred_sym_name(ModuleName, Name),
+ GetPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
+ pf_predicate, mutable_get_pred_sym_name(ModuleName, Name),
[type_and_mode(Type, out_mode(Inst)),
type_and_mode(io_state_type, di_mode),
type_and_mode(io_state_type, uo_mode)],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_pure, Constraints).
+ cond_true /* condition */, purity_pure, Constraints, Context),
+ GetPredDeclItem = item_pred_decl(GetPredDecl).
-io_set_pred_decl(ModuleName, Name, Type, Inst) = SetPredDecl :-
+io_set_pred_decl(ModuleName, Name, Type, Inst, Context) = SetPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
Origin = compiler(mutable_decl),
- SetPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
- pf_predicate,
- mutable_set_pred_sym_name(ModuleName, Name),
+ SetPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
+ pf_predicate, mutable_set_pred_sym_name(ModuleName, Name),
[type_and_mode(Type, in_mode(Inst)),
type_and_mode(io_state_type, di_mode),
type_and_mode(io_state_type, uo_mode)],
no /* with_type */, no /* with_inst */, yes(detism_det),
- cond_true /* condition */, purity_pure, Constraints).
+ cond_true /* condition */, purity_pure, Constraints, Context),
+ SetPredDeclItem = item_pred_decl(SetPredDecl).
-mutable_init_pred_decl(ModuleName, Name) = InitPredDecl :-
+mutable_init_pred_decl(ModuleName, Name, Context) = InitPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
@@ -574,12 +586,13 @@
WithInst = no,
Condition = cond_true,
Origin = compiler(mutable_decl),
- InitPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet, ExistQVars,
+ InitPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet, ExistQVars,
pf_predicate, mutable_init_pred_sym_name(ModuleName, Name), ArgDecls,
WithType, WithInst, yes(detism_det), Condition,
- purity_impure, Constraints).
+ purity_impure, Constraints, Context),
+ InitPredDeclItem = item_pred_decl(InitPredDecl).
-mutable_pre_init_pred_decl(ModuleName, Name) = PreInitPredDecl :-
+mutable_pre_init_pred_decl(ModuleName, Name, Context) = PreInitPredDeclItem :-
VarSet = varset.init,
InstVarSet = varset.init,
ExistQVars = [],
@@ -589,11 +602,12 @@
WithInst = no,
Condition = cond_true,
Origin = compiler(mutable_decl),
- PreInitPredDecl = item_pred_or_func(Origin, VarSet, InstVarSet,
+ PreInitPredDecl = item_pred_decl_info(Origin, VarSet, InstVarSet,
ExistQVars, pf_predicate,
mutable_pre_init_pred_sym_name(ModuleName, Name),
ArgDecls, WithType, WithInst, yes(detism_det), Condition,
- purity_impure, Constraints).
+ purity_impure, Constraints, Context),
+ PreInitPredDeclItem = item_pred_decl(PreInitPredDecl).
%-----------------------------------------------------------------------------%
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.40
diff -u -b -r1.40 recompilation.check.m
--- compiler/recompilation.check.m 23 May 2007 10:09:22 -0000 1.40
+++ compiler/recompilation.check.m 8 Feb 2008 17:31:50 -0000
@@ -693,11 +693,12 @@
(
MaybeUsedItemsTerm = yes(UsedItemsTerm),
Items = [InterfaceItem, VersionNumberItem | OtherItems],
- InterfaceItem =
- item_and_context(item_module_defn(_, md_interface), _),
- VersionNumberItem =
- item_and_context(
- item_module_defn(_, md_version_numbers(_, VersionNumbers)),
+ InterfaceItem = item_module_defn(InterfaceItemModuleDefn),
+ InterfaceItemModuleDefn =
+ item_module_defn_info(_, md_interface, _),
+ VersionNumberItem = item_module_defn(VersionNumberItemModuleDefn),
+ VersionNumberItemModuleDefn =
+ item_module_defn_info(_, md_version_numbers(_, VersionNumbers),
_)
->
check_module_used_items(ImportedModuleName, NeedQualifier,
@@ -719,7 +720,7 @@
).
:- pred check_module_used_items(module_name::in, need_qualifier::in,
- timestamp::in, term::in, version_numbers::in, item_list::in,
+ timestamp::in, term::in, version_numbers::in, list(item)::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
check_module_used_items(ModuleName, NeedQualifier, OldTimestamp,
@@ -854,17 +855,17 @@
% when the current module was last compiled.
%
:- pred check_for_ambiguities(need_qualifier::in, timestamp::in,
- item_version_numbers::in, item_and_context::in,
+ item_version_numbers::in, item::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
-check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
- ItemAndContext, !Info) :-
- ItemAndContext = item_and_context(Item, _Context),
+check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers, Item,
+ !Info) :-
(
- Item = item_clause(_, _, _, _, _, _),
+ Item = item_clause(_),
unexpected(this_file, "check_for_ambiguities: clause")
;
- Item = item_type_defn(_, Name, Params, Body, _),
+ Item = item_type_defn(ItemTypeDefn),
+ ItemTypeDefn = item_type_defn_info(_, Name, Params, Body, _, _),
Arity = list.length(Params),
check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
VersionNumbers, type_abstract_item, Name, Arity, NeedsCheck,
@@ -877,15 +878,19 @@
NeedsCheck = no
)
;
- Item = item_inst_defn(_, Name, Params, _, _),
+ Item = item_inst_defn(ItemInstDefn),
+ ItemInstDefn = item_inst_defn_info(_, Name, Params, _, _, _),
check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
VersionNumbers, inst_item, Name, list.length(Params), _, !Info)
;
- Item = item_mode_defn(_, Name, Params, _, _),
+ Item = item_mode_defn(ItemModeDefn),
+ ItemModeDefn = item_mode_defn_info(_, Name, Params, _, _, _),
check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
VersionNumbers, mode_item, Name, list.length(Params), _, !Info)
;
- Item = item_typeclass(_, _, Name, Params, Interface, _),
+ Item = item_typeclass(ItemTypeClass),
+ ItemTypeClass = item_typeclass_info(_, _, Name, Params, Interface,
+ _, _),
check_for_simple_item_ambiguity(NeedQualifier, OldTimestamp,
VersionNumbers, typeclass_item, Name, list.length(Params),
NeedsCheck, !Info),
@@ -899,19 +904,20 @@
true
)
;
- Item = item_pred_or_func(_, _, _, _, PredOrFunc, Name, Args,
- WithType, _, _, _, _, _),
+ Item = item_pred_decl(ItemPredDecl),
+ ItemPredDecl = item_pred_decl_info(_, _, _, _, PredOrFunc, Name, Args,
+ WithType, _, _, _, _, _, _),
check_for_pred_or_func_item_ambiguity(no, NeedQualifier, OldTimestamp,
VersionNumbers, PredOrFunc, Name, Args, WithType, !Info)
;
- ( Item = item_pred_or_func_mode(_, _, _, _, _, _, _)
- ; Item = item_pragma(_, _)
- ; Item = item_promise(_, _, _, _)
- ; Item = item_module_defn(_, _)
- ; Item = item_instance(_, _, _, _, _, _)
- ; Item = item_initialise(_, _, _)
- ; Item = item_finalise(_, _, _)
- ; Item = item_mutable(_, _, _, _, _, _)
+ ( Item = item_mode_decl(_)
+ ; Item = item_pragma(_)
+ ; Item = item_promise(_)
+ ; Item = item_module_defn(_)
+ ; Item = item_instance(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_mutable(_)
; Item = item_nothing(_)
)
).
@@ -1362,7 +1368,7 @@
some_modules([Module | Modules0])
).
-:- pred record_read_file(module_name::in, module_timestamp::in, item_list::in,
+:- pred record_read_file(module_name::in, module_timestamp::in, list(item)::in,
module_error::in, file_name::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
@@ -1521,15 +1527,6 @@
throw_syntax_error(Reason, Info)
).
-:- func get_term_context(term) = term.context.
-
-get_term_context(Term) =
- ( Term = term.functor(_, _, Context) ->
- Context
- ;
- term.context_init
- ).
-
:- pred record_recompilation_reason(recompile_reason::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.61
diff -u -b -r1.61 recompilation.version.m
--- compiler/recompilation.version.m 5 Dec 2007 05:07:38 -0000 1.61
+++ compiler/recompilation.version.m 9 Feb 2008 01:14:37 -0000
@@ -29,8 +29,8 @@
% compute_version_numbers(SourceFileModTime, NewItems, MaybeOldItems,
% VersionNumbers).
%
-:- pred compute_version_numbers(timestamp::in, item_list::in,
- maybe(item_list)::in, version_numbers::out) is det.
+:- pred compute_version_numbers(timestamp::in, list(item)::in,
+ maybe(list(item))::in, version_numbers::out) is det.
:- pred write_version_numbers(version_numbers::in, io::di, io::uo) is det.
@@ -63,39 +63,37 @@
%-----------------------------------------------------------------------------%
compute_version_numbers(SourceFileTime,
- ItemAndContexts, MaybeOldItemAndContexts,
+ Items, MaybeOldItems,
version_numbers(ItemVersionNumbers, InstanceVersionNumbers)) :-
- gather_items(section_implementation, ItemAndContexts,
- GatheredItemAndContexts, InstanceItemAndContexts),
+ gather_items(section_implementation, Items, GatheredItems, InstanceItems),
(
- MaybeOldItemAndContexts = yes(OldItemAndContexts0),
- OldItemAndContexts0 = [FirstItemAndContext, VersionNumberItemAndContext
- | OldItemAndContexts],
- FirstItemAndContext = item_and_context(FirstItem, _),
- FirstItem = item_module_defn(_, md_interface),
- VersionNumberItemAndContext = item_and_context(VersionNumberItem, _),
- VersionNumberItem = item_module_defn(_,
- md_version_numbers(_, OldVersionNumbers))
+ MaybeOldItems = yes(OldItems0),
+ OldItems0 = [FirstItem, VersionNumberItem | OldItems],
+ FirstItem = item_module_defn(FirstItemModuleDefn),
+ FirstItemModuleDefn = item_module_defn_info(_, md_interface, _),
+ VersionNumberItem = item_module_defn(VersionNumberItemModuleDefn),
+ VersionNumberItemModuleDefn = item_module_defn_info(_,
+ md_version_numbers(_, OldVersionNumbers), _)
->
OldVersionNumbers = version_numbers(OldItemVersionNumbers,
OldInstanceVersionNumbers),
- gather_items(section_implementation, OldItemAndContexts,
- GatheredOldItemAndContexts, OldInstanceItemAndContexts)
+ gather_items(section_implementation, OldItems,
+ GatheredOldItems, OldInstanceItems)
;
% There were no old version numbers, so every item
% gets the same timestamp as the source module.
OldItemVersionNumbers = init_item_id_set(map.init),
- GatheredOldItemAndContexts = init_item_id_set(map.init),
- map.init(OldInstanceItemAndContexts),
+ GatheredOldItems = init_item_id_set(map.init),
+ map.init(OldInstanceItems),
map.init(OldInstanceVersionNumbers)
),
compute_item_version_numbers(SourceFileTime,
- GatheredItemAndContexts, GatheredOldItemAndContexts,
+ GatheredItems, GatheredOldItems,
OldItemVersionNumbers, ItemVersionNumbers),
compute_instance_version_numbers(SourceFileTime,
- InstanceItemAndContexts, OldInstanceItemAndContexts,
+ InstanceItems, OldInstanceItems,
OldInstanceVersionNumbers, InstanceVersionNumbers).
:- pred compute_item_version_numbers(timestamp::in,
@@ -103,15 +101,15 @@
item_version_numbers::in, item_version_numbers::out) is det.
compute_item_version_numbers(SourceFileTime,
- GatheredItemAndContexts, GatheredOldItemAndContexts,
+ GatheredItems, GatheredOldItems,
OldVersionNumbers, VersionNumbers) :-
VersionNumbers = map_ids(compute_item_version_numbers_2(SourceFileTime,
- GatheredOldItemAndContexts, OldVersionNumbers),
- GatheredItemAndContexts, map.init).
+ GatheredOldItems, OldVersionNumbers),
+ GatheredItems, map.init).
:- func compute_item_version_numbers_2(timestamp, gathered_items,
item_version_numbers, item_type,
- map(pair(string, arity), assoc_list(section, item_and_context)))
+ map(pair(string, arity), assoc_list(section, item)))
= map(pair(string, arity), timestamp).
compute_item_version_numbers_2(SourceFileTime, GatheredOldItems,
@@ -121,7 +119,7 @@
:- func compute_item_version_numbers_3(timestamp, gathered_items,
item_version_numbers, item_type, pair(string, arity),
- assoc_list(section, item_and_context)) = timestamp.
+ assoc_list(section, item)) = timestamp.
compute_item_version_numbers_3(SourceFileTime, GatheredOldItems,
OldVersionNumbers, ItemType, NameArity, Items) =
@@ -160,7 +158,7 @@
InstanceItems
).
-:- pred gather_items(section::in, item_list::in,
+:- pred gather_items(section::in, list(item)::in,
gathered_items::out, instance_item_map::out) is det.
gather_items(Section, Items, GatheredItems, Instances) :-
@@ -180,12 +178,11 @@
GatheredItems1, GatheredItems).
:- pred distribute_pragma_items(
- {maybe_pred_or_func_id, item_and_context, section}::in,
+ {maybe_pred_or_func_id, item, section}::in,
gathered_items::in, gathered_items::out) is det.
-distribute_pragma_items({ItemId, ItemAndContext, Section}, !GatheredItems) :-
+distribute_pragma_items({ItemId, Item, Section}, !GatheredItems) :-
ItemId = MaybePredOrFunc - SymName / Arity,
- ItemAndContext = item_and_context(Item, ItemContext),
% For predicates defined using `with_type` annotations we don't know
% the actual arity, so always we need to add entries for pragmas, even if
@@ -200,35 +197,33 @@
MaybePredOrFunc = yes(PredOrFunc),
ItemType = pred_or_func_to_item_type(PredOrFunc),
add_gathered_item(Item, item_id(ItemType, ItemName),
- ItemContext, Section, AddIfNotExisting, !GatheredItems)
+ Section, AddIfNotExisting, !GatheredItems)
;
MaybePredOrFunc = no,
add_gathered_item(Item, item_id(predicate_item, ItemName),
- ItemContext, Section, AddIfNotExisting, !GatheredItems),
+ Section, AddIfNotExisting, !GatheredItems),
add_gathered_item(Item, item_id(function_item, ItemName),
- ItemContext, Section, AddIfNotExisting, !GatheredItems)
+ Section, AddIfNotExisting, !GatheredItems)
),
% Pragmas can apply to typeclass methods.
map.map_values(distribute_pragma_items_class_items(MaybePredOrFunc,
- SymName, Arity, ItemAndContext, Section),
+ SymName, Arity, Item, Section),
extract_ids(!.GatheredItems, typeclass_item), GatheredTypeClasses),
!:GatheredItems = update_ids(!.GatheredItems, typeclass_item,
GatheredTypeClasses).
:- pred distribute_pragma_items_class_items(maybe(pred_or_func)::in,
- sym_name::in, arity::in, item_and_context::in, section::in,
- pair(string, int)::in,
- assoc_list(section, item_and_context)::in,
- assoc_list(section, item_and_context)::out) is det.
+ sym_name::in, arity::in, item::in, section::in, pair(string, int)::in,
+ assoc_list(section, item)::in, assoc_list(section, item)::out) is det.
distribute_pragma_items_class_items(MaybePredOrFunc, SymName, Arity,
- ItemAndContext, Section, _, !ClassItemAndContexts) :-
+ Item, Section, _, !ClassItems) :-
(
% Does this pragma match any of the methods of this class.
- list.member(_ - ClassItemAndContext, !.ClassItemAndContexts),
- ClassItemAndContext = item_and_context(ClassItem, _),
- ClassItem = item_typeclass(_, _, _, _, Interface, _),
+ list.member(_ - ClassItem, !.ClassItems),
+ ClassItem = item_typeclass(ClassItemTypeClass),
+ Interface = ClassItemTypeClass ^ tc_class_methods,
Interface = class_interface_concrete(Methods),
list.member(Method, Methods),
Method = method_pred_or_func(_, _, _, MethodPredOrFunc, SymName,
@@ -247,8 +242,7 @@
)
->
% XXX O(N^2), but shouldn't happen too often.
- !:ClassItemAndContexts = !.ClassItemAndContexts ++
- [Section - ItemAndContext]
+ !:ClassItems = !.ClassItems ++ [Section - Item]
;
true
).
@@ -257,35 +251,38 @@
---> gathered_item_info(
gathered_items :: gathered_items,
pragma_items :: list({maybe_pred_or_func_id,
- item_and_context, section}),
- other_items :: item_list,
+ item, section}),
+ other_items :: list(item),
instances :: instance_item_map
).
:- type instance_item_map ==
- map(item_name, assoc_list(section, item_and_context)).
+ map(item_name, assoc_list(section, item)).
% The constructors set should always be empty.
:- type gathered_items == item_id_set(gathered_item_map).
:- type gathered_item_map == map(pair(string, arity),
- assoc_list(section, item_and_context)).
+ assoc_list(section, item)).
-:- pred gather_items_2(item_and_context::in, section::in, section::out,
+:- pred gather_items_2(item::in, section::in, section::out,
gathered_item_info::in, gathered_item_info::out) is det.
-gather_items_2(ItemAndContext, !Section, !Info) :-
- ItemAndContext = item_and_context(Item, ItemContext),
+gather_items_2(Item, !Section, !Info) :-
(
- Item = item_module_defn(_, md_interface)
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, md_interface, _)
->
!:Section = section_interface
;
- Item = item_module_defn(_, md_implementation)
+ Item = item_module_defn(ItemModuleDefn),
+ ItemModuleDefn = item_module_defn_info(_, md_implementation, _)
->
!:Section = section_implementation
;
- Item = item_type_defn(VarSet, Name, Args, Body, Cond)
+ Item = item_type_defn(ItemTypeDefn)
->
+ ItemTypeDefn = item_type_defn_info(VarSet, Name, Args, Body, Cond,
+ Context),
(
Body = parse_tree_abstract_type(_),
NameItem = Item,
@@ -295,8 +292,9 @@
BodyItem = Item
;
Body = parse_tree_du_type(_, _),
- NameItem = item_type_defn(VarSet, Name, Args,
- parse_tree_abstract_type(non_solver_type), Cond),
+ NameItemTypeDefn = item_type_defn_info(VarSet, Name, Args,
+ parse_tree_abstract_type(non_solver_type), Cond, Context),
+ NameItem = item_type_defn(NameItemTypeDefn),
BodyItem = Item
;
Body = parse_tree_eqv_type(_),
@@ -315,67 +313,69 @@
TypeCtorItem = item_name(Name, list.length(Args)),
GatheredItems0 = !.Info ^ gathered_items,
add_gathered_item(NameItem, item_id(type_abstract_item, TypeCtorItem),
- ItemContext, !.Section, yes, GatheredItems0, GatheredItems1),
+ !.Section, yes, GatheredItems0, GatheredItems1),
add_gathered_item(BodyItem, item_id(type_body_item, TypeCtorItem),
- ItemContext, !.Section, yes, GatheredItems1, GatheredItems),
+ !.Section, yes, GatheredItems1, GatheredItems),
!:Info = !.Info ^ gathered_items := GatheredItems
;
- Item = item_instance(_, ClassName, ClassArgs, _, _, _)
+ Item = item_instance(ItemInstance)
->
+ ItemInstance = item_instance_info(_, ClassName, ClassArgs, _, _, _, _),
Instances0 = !.Info ^ instances,
ClassArity = list.length(ClassArgs),
ClassItemName = item_name(ClassName, ClassArity),
- ( map.search(Instances0, ClassItemName, InstanceItemsPrime) ->
- InstanceItems = InstanceItemsPrime
+ NewInstanceItem = !.Section - Item,
+ ( map.search(Instances0, ClassItemName, OldInstanceItems) ->
+ NewInstanceItems = [NewInstanceItem | OldInstanceItems],
+ map.det_update(Instances0, ClassItemName, NewInstanceItems,
+ Instances)
;
- InstanceItems = []
+ map.det_insert(Instances0, ClassItemName, [NewInstanceItem],
+ Instances)
),
- NewInstanceItem = !.Section - item_and_context(Item, ItemContext),
- map.set(Instances0, ClassItemName, [NewInstanceItem | InstanceItems],
- Instances),
!:Info = !.Info ^ instances := Instances
;
% For predicates or functions defined using `with_inst` annotations
% the pred_or_func and arity here won't be correct, but equiv_type.m
% will record the dependency on the version number with the `incorrect'
% pred_or_func and arity, so this will work.
- Item = item_pred_or_func_mode(_, MaybePredOrFunc, SymName, Modes,
- WithInst, _, _),
+ Item = item_mode_decl(ItemModeDecl),
+ ItemModeDecl = item_mode_decl_info(_, MaybePredOrFunc, SymName, Modes,
+ WithInst, _, _, _),
MaybePredOrFunc = no,
WithInst = yes(_)
->
GatheredItems0 = !.Info ^ gathered_items,
ItemName = item_name(SymName, list.length(Modes)),
add_gathered_item(Item, item_id(predicate_item, ItemName),
- ItemContext, !.Section, yes, GatheredItems0, GatheredItems1),
+ !.Section, yes, GatheredItems0, GatheredItems1),
add_gathered_item(Item, item_id(function_item, ItemName),
- ItemContext, !.Section, yes, GatheredItems1, GatheredItems),
+ !.Section, yes, GatheredItems1, GatheredItems),
!:Info = !.Info ^ gathered_items := GatheredItems
;
item_to_item_id(Item, ItemId)
->
GatheredItems0 = !.Info ^ gathered_items,
- add_gathered_item(Item, ItemId, ItemContext, !.Section, yes,
+ add_gathered_item(Item, ItemId, !.Section, yes,
GatheredItems0, GatheredItems),
!:Info = !.Info ^ gathered_items := GatheredItems
;
- Item = item_pragma(_, PragmaType),
+ Item = item_pragma(ItemPragma),
+ ItemPragma = item_pragma_info(_, PragmaType, _),
is_pred_pragma(PragmaType, yes(PredOrFuncId))
->
PragmaItems = !.Info ^ pragma_items,
!:Info = !.Info ^ pragma_items :=
- [{PredOrFuncId, ItemAndContext, !.Section} | PragmaItems]
+ [{PredOrFuncId, Item, !.Section} | PragmaItems]
;
OtherItems = !.Info ^ other_items,
- !:Info = !.Info ^ other_items := [ItemAndContext | OtherItems]
+ !:Info = !.Info ^ other_items := [Item | OtherItems]
).
-:- pred add_gathered_item(item::in, item_id::in,
- prog_context::in, section::in, bool::in, gathered_items::in,
- gathered_items::out) is det.
+:- pred add_gathered_item(item::in, item_id::in, section::in, bool::in,
+ gathered_items::in, gathered_items::out) is det.
-add_gathered_item(Item, ItemId, ItemContext, Section, AddIfNotExisting,
- !GatheredItems) :-
+add_gathered_item(Item, ItemId, Section, AddIfNotExisting, !GatheredItems) :-
ItemId = item_id(ItemType, ItemName),
ItemName = item_name(SymName, Arity),
Name = unqualify_name(SymName),
@@ -392,24 +392,24 @@
->
true
;
- add_gathered_item_2(Item, ItemType, NameArity, ItemContext, Section,
+ add_gathered_item_2(Item, ItemType, NameArity, Section,
MatchingItems, !GatheredItems)
).
-:- pred add_gathered_item_2(item::in, item_type::in,
- pair(string, arity)::in, prog_context::in, section::in,
- assoc_list(section, item_and_context)::in,
+:- pred add_gathered_item_2(item::in, item_type::in, pair(string, arity)::in,
+ section::in, assoc_list(section, item)::in,
gathered_items::in, gathered_items::out) is det.
-add_gathered_item_2(Item, ItemType, NameArity, ItemContext, Section,
- MatchingItems0, !GatheredItems) :-
+add_gathered_item_2(Item, ItemType, NameArity, Section, MatchingItems0,
+ !GatheredItems) :-
% mercury_to_mercury.m splits combined pred and mode declarations.
% That needs to be done here as well the item list read from the interface
% file will match the item list generated here.
(
- Item = item_pred_or_func(Origin, TVarSet, InstVarSet, ExistQVars,
- PredOrFunc, PredName, TypesAndModes, WithType, WithInst, Det,
- Cond, Purity, ClassContext),
+ Item = item_pred_decl(ItemPredDecl),
+ ItemPredDecl = item_pred_decl_info(Origin, TVarSet, InstVarSet,
+ ExistQVars, PredOrFunc, PredName, TypesAndModes,
+ WithType, WithInst, Det, Cond, Purity, ClassContext, Context),
split_types_and_modes(TypesAndModes, Types, MaybeModes),
MaybeModes = yes(Modes),
( Modes = [_ | _]
@@ -418,9 +418,11 @@
->
TypesWithoutModes = list.map((func(Type) = type_only(Type)), Types),
varset.init(EmptyInstVarSet),
- PredOrFuncItem = item_pred_or_func(Origin, TVarSet, EmptyInstVarSet,
- ExistQVars, PredOrFunc, PredName, TypesWithoutModes, WithType,
- no, no, Cond, Purity, ClassContext),
+ PredItemPredDecl = item_pred_decl_info(Origin, TVarSet,
+ EmptyInstVarSet, ExistQVars, PredOrFunc, PredName,
+ TypesWithoutModes, WithType, no, no, Cond, Purity, ClassContext,
+ Context),
+ PredItem = item_pred_decl(PredItemPredDecl),
(
WithInst = yes(_),
% MaybePredOrFunc needs to be `no' here because when the item
@@ -431,24 +433,23 @@
WithInst = no,
MaybePredOrFunc = yes(PredOrFunc)
),
- PredOrFuncModeItem = item_pred_or_func_mode(InstVarSet,
- MaybePredOrFunc, PredName, Modes, WithInst, Det, Cond),
- MatchingItems =
- [Section - item_and_context(PredOrFuncItem, ItemContext),
- Section - item_and_context(PredOrFuncModeItem, ItemContext)
+ ModeItemModeDecl = item_mode_decl_info(InstVarSet,
+ MaybePredOrFunc, PredName, Modes, WithInst, Det, Cond, Context),
+ ModeItem = item_mode_decl(ModeItemModeDecl),
+ MatchingItems = [Section - PredItem, Section - ModeItem
| MatchingItems0]
;
- Item ^ tc_class_methods = class_interface_concrete(Methods0)
+ Item = item_typeclass(ItemTypeClass),
+ ItemTypeClass ^ tc_class_methods = class_interface_concrete(Methods0)
->
MethodsList = list.map(split_class_method_types_and_modes, Methods0),
list.condense(MethodsList, Methods),
- TypeclassItem = Item ^ tc_class_methods
+ NewItemTypeClass = ItemTypeClass ^ tc_class_methods
:= class_interface_concrete(Methods),
- MatchingItems = [Section - item_and_context(TypeclassItem, ItemContext)
- | MatchingItems0]
+ NewItem = item_typeclass(NewItemTypeClass),
+ MatchingItems = [Section - NewItem | MatchingItems0]
;
- MatchingItems = [Section - item_and_context(Item, ItemContext) |
- MatchingItems0]
+ MatchingItems = [Section - Item | MatchingItems0]
),
IdMap0 = extract_ids(!.GatheredItems, ItemType),
@@ -507,20 +508,39 @@
:- pred item_to_item_id_2(item::in, maybe(item_id)::out) is det.
-item_to_item_id_2(item_clause(_, _, _, _, _, _), no).
-item_to_item_id_2(item_type_defn(_, Name, Params, _, _),
- yes(item_id(type_abstract_item, item_name(Name, Arity)))) :-
- list.length(Params, Arity).
-item_to_item_id_2(item_inst_defn(_, Name, Params, _, _),
- yes(item_id(inst_item, item_name(Name, Arity)))) :-
- list.length(Params, Arity).
-item_to_item_id_2(item_mode_defn(_, Name, Params, _, _),
- yes(item_id(mode_item, item_name(Name, Arity)))) :-
- list.length(Params, Arity).
-item_to_item_id_2(item_module_defn(_, _), no).
-item_to_item_id_2(Item, yes(item_id(ItemType, item_name(SymName, Arity)))) :-
- Item = item_pred_or_func(_, _, _, _, PredOrFunc, SymName, TypesAndModes,
- WithType, _, _, _, _, _),
+item_to_item_id_2(Item, MaybeItemId) :-
+ (
+ ( Item = item_module_defn(_)
+ ; Item = item_clause(_)
+ ; Item = item_promise(_)
+ ; Item = item_initialise(_)
+ ; Item = item_finalise(_)
+ ; Item = item_mutable(_)
+ ; Item = item_nothing(_)
+ ),
+ MaybeItemId = no
+ ;
+ Item = item_type_defn(ItemTypeDefn),
+ ItemTypeDefn = item_type_defn_info(_, Name, Params, _, _, _),
+ list.length(Params, Arity),
+ ItemId = item_id(type_abstract_item, item_name(Name, Arity)),
+ MaybeItemId = yes(ItemId)
+ ;
+ Item = item_inst_defn(ItemInstDefn),
+ ItemInstDefn = item_inst_defn_info(_, Name, Params, _, _, _),
+ list.length(Params, Arity),
+ ItemId = item_id(inst_item, item_name(Name, Arity)),
+ MaybeItemId = yes(ItemId)
+ ;
+ Item = item_mode_defn(ItemModeDefn),
+ ItemModeDefn = item_mode_defn_info(_, Name, Params, _, _, _),
+ list.length(Params, Arity),
+ ItemId = item_id(mode_item, item_name(Name, Arity)),
+ MaybeItemId = yes(ItemId)
+ ;
+ Item = item_pred_decl(ItemPredDecl),
+ ItemPredDecl = item_pred_decl_info(_, _, _, _, PredOrFunc, SymName,
+ TypesAndModes, WithType, _, _, _, _, _, _),
% For predicates or functions defined using `with_type` annotations
% the arity here won't be correct, but equiv_type.m will record
% the dependency on the version number with the `incorrect' arity,
@@ -532,39 +552,45 @@
WithType = yes(_),
Arity = list.length(TypesAndModes)
),
- ItemType = pred_or_func_to_item_type(PredOrFunc).
-
-item_to_item_id_2(Item, ItemId) :-
- Item = item_pred_or_func_mode(_, MaybePredOrFunc, SymName, Modes, _, _, _),
+ ItemType = pred_or_func_to_item_type(PredOrFunc),
+ ItemId = item_id(ItemType, item_name(SymName, Arity)),
+ MaybeItemId = yes(ItemId)
+ ;
+ Item = item_mode_decl(ItemModeDecl),
+ ItemModeDecl = item_mode_decl_info(_, MaybePredOrFunc, SymName, Modes,
+ _, _, _, _),
(
MaybePredOrFunc = yes(PredOrFunc),
adjust_func_arity(PredOrFunc, Arity, list.length(Modes)),
ItemType = pred_or_func_to_item_type(PredOrFunc),
- ItemId = yes(item_id(ItemType, item_name(SymName, Arity)))
+ ItemId = item_id(ItemType, item_name(SymName, Arity)),
+ MaybeItemId = yes(ItemId)
;
MaybePredOrFunc = no,
- % We need to handle these separately because a `:- mode' declaration
- % with a `with_inst` annotation could be for a predicate or a function.
- ItemId = no
- ).
-
+ % We need to handle these separately because a `:- mode'
+ % declaration with a `with_inst` annotation could be for
+ % a predicate or a function.
+ MaybeItemId = no
+ )
+ ;
+ Item = item_pragma(_),
% We need to handle these separately because some pragmas
% may affect a predicate and a function.
-item_to_item_id_2(item_pragma(_, _), no).
-item_to_item_id_2(item_promise(_, _, _, _), no).
-item_to_item_id_2(Item,
- yes(item_id(typeclass_item, item_name(ClassName, ClassArity)))) :-
- Item = item_typeclass(_, _, ClassName, ClassVars, _, _),
- list.length(ClassVars, ClassArity).
-
+ MaybeItemId = no
+ ;
+ Item = item_typeclass(ItemTypeClass),
+ ItemTypeClass = item_typeclass_info(_, _, ClassName, ClassVars,
+ _, _, _),
+ list.length(ClassVars, ClassArity),
+ ItemId = item_id(typeclass_item, item_name(ClassName, ClassArity)),
+ MaybeItemId = yes(ItemId)
+ ;
+ Item = item_instance(_),
% Instances are handled separately (unlike other items, the module
% qualifier on an instance declaration is the module containing
% the class, not the module containing the instance).
-item_to_item_id_2(item_instance(_, _, _, _, _, _), no).
-item_to_item_id_2(item_initialise(_, _, _), no).
-item_to_item_id_2(item_finalise(_, _, _), no).
-item_to_item_id_2(item_mutable(_, _, _, _, _, _), no).
-item_to_item_id_2(item_nothing(_), no).
+ MaybeItemId = no
+ ).
:- type maybe_pred_or_func_id == pair(maybe(pred_or_func), sym_name_and_arity).
@@ -628,12 +654,12 @@
% For example, it won't work for clauses.
% It will never succeed when it shouldn't, so it will never
% cause a necessary recompilation to be missed.
-:- pred items_are_unchanged(assoc_list(section, item_and_context)::in,
- assoc_list(section, item_and_context)::in) is semidet.
+ %
+:- pred items_are_unchanged(assoc_list(section, item)::in,
+ assoc_list(section, item)::in) is semidet.
items_are_unchanged([], []).
-items_are_unchanged([Section - item_and_context(Item1, _) | Items1],
- [Section - item_and_context(Item2, _) | Items2]) :-
+items_are_unchanged([Section - Item1 | Items1], [Section - Item2 | Items2]) :-
yes = item_is_unchanged(Item1, Item2),
items_are_unchanged(Items1, Items2).
@@ -667,82 +693,75 @@
%
:- func item_is_unchanged(item, item) = bool.
-item_is_unchanged(item_type_defn(_, Name, Args, Defn, Cond), Item2) =
- ( Item2 = item_type_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
-item_is_unchanged(item_mode_defn(_VarSet, Name, Args, Defn, Cond), Item2) =
- ( Item2 = item_mode_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
-item_is_unchanged(item_inst_defn(_VarSet, Name, Args, Defn, Cond), Item2) =
- ( Item2 = item_inst_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
-item_is_unchanged(item_module_defn(_VarSet, Defn), Item2) =
- ( Item2 = item_module_defn(_, Defn) -> yes ; no ).
-item_is_unchanged(item_instance(Constraints, Name, Types, Body, _VarSet,
- Module), Item2) =
- ( Item2 = item_instance(Constraints, Name, Types, Body, _, Module) ->
- yes
+item_is_unchanged(Item1, Item2) = Unchanged :-
+ (
+ Item1 = item_module_defn(ItemModuleDefn1),
+ ItemModuleDefn1 = item_module_defn_info(_, ModuleDefn, _),
+ (
+ Item2 = item_module_defn(ItemModuleDefn2),
+ ItemModuleDefn2 = item_module_defn_info(_, ModuleDefn, _)
+ ->
+ Unchanged = yes
;
- no
- ).
-
+ Unchanged = no
+ )
+ ;
+ Item1 = item_clause(ItemClause1),
+ ItemClause1 = item_clause_info(_, _, PorF, SymName, Args, Goal, _),
% XXX Need to compare the goals properly in clauses and assertions.
% That's not necessary at the moment because smart recompilation
% doesn't work with inter-module optimization yet.
-item_is_unchanged(item_clause(_, _VarSet, PorF, SymName, Args, Goal), Item2) =
- ( Item2 = item_clause(_, _, PorF, SymName, Args, Goal) -> yes ; no ).
-item_is_unchanged(item_promise(PromiseType, Goal, _, UnivVars), Item2) =
- ( Item2 = item_promise(PromiseType, Goal, _, UnivVars) -> yes ; no ).
-
- % We do need to compare the variable names in `:- pragma type_spec'
- % declarations because the names of the variables are used
- % to find the corresponding variables in the predicate or
- % function type declaration.
-item_is_unchanged(item_pragma(_, PragmaType1), Item2) = Result :-
- ( Item2 = item_pragma(_, PragmaType2) ->
(
- PragmaType1 = pragma_type_spec(Name, SpecName, Arity,
- MaybePredOrFunc, MaybeModes, TypeSubst1, TVarSet1, _),
- PragmaType2 = pragma_type_spec(Name, SpecName, Arity,
- MaybePredOrFunc, MaybeModes, TypeSubst2, TVarSet2, _)
+ Item2 = item_clause(ItemClause2),
+ ItemClause2 = item_clause_info(_, _, PorF, SymName, Args, Goal, _)
->
- assoc_list.keys_and_values(TypeSubst1, TVars1, Types1),
- assoc_list.keys_and_values(TypeSubst2, TVars2, Types2),
- % XXX kind inference:
- % we assume vars have kind `star'.
- KindMap = map.init,
- prog_type.var_list_to_type_list(KindMap, TVars1, TVarTypes1),
- prog_type.var_list_to_type_list(KindMap, TVars2, TVarTypes2),
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_type_defn(ItemTypeDefn1),
+ ItemTypeDefn1 = item_type_defn_info(_, Name, Args, Defn, Cond, _),
(
- type_list_is_unchanged(
- TVarSet1, TVarTypes1 ++ Types1,
- TVarSet2, TVarTypes2 ++ Types2,
- _, _, _)
+ Item2 = item_type_defn(ItemTypeDefn2),
+ ItemTypeDefn2 = item_type_defn_info(_, Name, Args, Defn, Cond, _)
->
- Result = yes
+ Unchanged = yes
;
- Result = no
+ Unchanged = no
)
;
- Result = ( PragmaType1 = PragmaType2 -> yes ; no )
+ Item1 = item_inst_defn(ItemInstDefn1),
+ ItemInstDefn1 = item_inst_defn_info(_, Name, Args, Defn, Cond, _),
+ (
+ Item2 = item_inst_defn(ItemInstDefn2),
+ ItemInstDefn2 = item_inst_defn_info(_, Name, Args, Defn, Cond, _)
+ ->
+ Unchanged = yes
+ ;
+ Unchanged = no
)
;
- Result = no
- ).
-item_is_unchanged(item_nothing(A), Item2) =
- ( Item2 = item_nothing(A) -> yes ; no ).
-item_is_unchanged(item_initialise(O, A, B), Item2) =
- ( Item2 = item_initialise(O, A, B) -> yes ; no ).
-item_is_unchanged(item_finalise(O, A, B), Item2) =
- ( Item2 = item_finalise(O, A, B) -> yes ; no ).
-item_is_unchanged(item_mutable(A, B, C, D, E, F), Item2) =
- ( Item2 = item_mutable(A, B, C, D, E, F) -> yes ; no ).
-
-item_is_unchanged(Item1, Item2) = Result :-
- Item1 = item_pred_or_func(_, TVarSet1, _, ExistQVars1, PredOrFunc,
- Name, TypesAndModes1, WithType1, _,
- Det1, Cond, Purity, Constraints1),
+ Item1 = item_mode_defn(ItemModeDefn1),
+ ItemModeDefn1 = item_mode_defn_info(_, Name, Args, Defn, Cond, _),
+ (
+ Item2 = item_mode_defn(ItemModeDefn2),
+ ItemModeDefn2 = item_mode_defn_info(_, Name, Args, Defn, Cond, _)
+ ->
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_pred_decl(ItemPredDecl1),
+ ItemPredDecl1 = item_pred_decl_info(_, TVarSet1, _, ExistQVars1,
+ PredOrFunc, Name, TypesAndModes1, WithType1, _,
+ Det1, Cond, Purity, Constraints1, _),
(
- Item2 = item_pred_or_func(_, TVarSet2, _, ExistQVars2,
+ Item2 = item_pred_decl(ItemPredDecl2),
+ ItemPredDecl2 = item_pred_decl_info(_, TVarSet2, _, ExistQVars2,
PredOrFunc, Name, TypesAndModes2, WithType2,
- _, Det2, Cond, Purity, Constraints2),
+ _, Det2, Cond, Purity, Constraints2, _),
% For predicates, ignore the determinism -- the modes and
% determinism should have been split into a separate
@@ -764,36 +783,149 @@
TypesAndModes1, WithType1, Constraints1, TVarSet2,
ExistQVars2, TypesAndModes2, WithType2, Constraints2)
->
- Result = yes
+ Unchanged = yes
;
- Result = no
- ).
-
-item_is_unchanged(Item1, Item2) = Result :-
- Item1 = item_pred_or_func_mode(InstVarSet1, PredOrFunc, Name, Modes1,
- WithInst1, Det, Cond),
+ Unchanged = no
+ )
+ ;
+ Item1 = item_mode_decl(ItemModeDecl1),
+ ItemModeDecl1 = item_mode_decl_info(InstVarSet1, PredOrFunc, Name,
+ Modes1, WithInst1, Det, Cond, _),
(
- Item2 = item_pred_or_func_mode(InstVarSet2, PredOrFunc,
- Name, Modes2, WithInst2, Det, Cond),
+ Item2 = item_mode_decl(ItemModeDecl2),
+ ItemModeDecl2 = item_mode_decl_info(InstVarSet2, PredOrFunc,
+ Name, Modes2, WithInst2, Det, Cond, _),
pred_or_func_mode_is_unchanged(InstVarSet1, Modes1, WithInst1,
InstVarSet2, Modes2, WithInst2)
->
- Result = yes
+ Unchanged = yes
;
- Result = no
- ).
-
-item_is_unchanged(Item1, Item2) = Result :-
- Item1 = item_typeclass(Constraints, FunDeps, Name, Vars, Interface1,
- _VarSet),
+ Unchanged = no
+ )
+ ;
+ Item1 = item_pragma(ItemPragma1),
+ ItemPragma1 = item_pragma_info(_, PragmaType1, _),
+ % We do need to compare the variable names in `:- pragma type_spec'
+ % declarations because the names of the variables are used
+ % to find the corresponding variables in the predicate or
+ % function type declaration.
+ (
+ Item2 = item_pragma(ItemPragma2),
+ ItemPragma2 = item_pragma_info(_, PragmaType2, _)
+ ->
+ (
+ PragmaType1 = pragma_type_spec(Name, SpecName, Arity,
+ MaybePredOrFunc, MaybeModes, TypeSubst1, TVarSet1, _),
+ PragmaType2 = pragma_type_spec(Name, SpecName, Arity,
+ MaybePredOrFunc, MaybeModes, TypeSubst2, TVarSet2, _)
+ ->
+ assoc_list.keys_and_values(TypeSubst1, TVars1, Types1),
+ assoc_list.keys_and_values(TypeSubst2, TVars2, Types2),
+ % XXX kind inference:
+ % we assume vars have kind `star'.
+ KindMap = map.init,
+ prog_type.var_list_to_type_list(KindMap, TVars1, TVarTypes1),
+ prog_type.var_list_to_type_list(KindMap, TVars2, TVarTypes2),
+ (
+ type_list_is_unchanged(
+ TVarSet1, TVarTypes1 ++ Types1,
+ TVarSet2, TVarTypes2 ++ Types2,
+ _, _, _)
+ ->
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Unchanged = ( PragmaType1 = PragmaType2 -> yes ; no )
+ )
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_promise(ItemPromiseInfo1),
+ ItemPromiseInfo1 = item_promise_info(PromiseType, Goal, _,
+ UnivVars, _),
(
- Item2 = item_typeclass(Constraints, FunDeps, Name, Vars, Interface2,
- _),
+ Item2 = item_promise(ItemPromiseInfo2),
+ ItemPromiseInfo2 = item_promise_info(PromiseType, Goal, _,
+ UnivVars, _)
+ ->
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_initialise(ItemInitialise1),
+ ItemInitialise1 = item_initialise_info(A, B, C, _),
+ (
+ Item2 = item_initialise(ItemInitialise2),
+ ItemInitialise2 = item_initialise_info(A, B, C, _)
+ ->
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_finalise(ItemFinalise1),
+ ItemFinalise1 = item_finalise_info(A, B, C, _),
+ (
+ Item2 = item_finalise(ItemFinalise2),
+ ItemFinalise2 = item_finalise_info(A, B, C, _)
+ ->
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_mutable(ItemMutable1),
+ ItemMutable1 = item_mutable_info(A, B, C, D, E, F, _),
+ (
+ Item2 = item_mutable(ItemMutable2),
+ ItemMutable2 = item_mutable_info(A, B, C, D, E, F, _)
+ ->
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_typeclass(ItemTypeClass1),
+ ItemTypeClass1 = item_typeclass_info(Constraints, FunDeps, Name,
+ Vars, Interface1, _, _),
+ (
+ Item2 = item_typeclass(ItemTypeClass2),
+ ItemTypeClass2 = item_typeclass_info(Constraints, FunDeps, Name,
+ Vars, Interface2, _, _),
class_interface_is_unchanged(Interface1, Interface2)
->
- Result = yes
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_instance(ItemInstance1),
+ ItemInstance1 = item_instance_info(Constraints, Name, Types, Body,
+ _, Module, _),
+ (
+ Item2 = item_instance(ItemInstance2),
+ ItemInstance2 = item_instance_info(Constraints, Name, Types, Body,
+ _, Module, _)
+ ->
+ Unchanged = yes
+ ;
+ Unchanged = no
+ )
+ ;
+ Item1 = item_nothing(ItemNothing1),
+ ItemNothing1 = item_nothing_info(A, _),
+ (
+ Item2 = item_nothing(ItemNothing2),
+ ItemNothing2 = item_nothing_info(A, _)
+ ->
+ Unchanged = yes
;
- Result = no
+ Unchanged = no
+ )
).
% Apply a substitution to the existq_tvars, types_and_modes, and
@@ -958,8 +1090,8 @@
% ordinary predicate declarations, so the varsets won't necessarily match
% up if a typeclass declaration is read back from an interface file.
%
-:- pred class_interface_is_unchanged(class_interface::in,
- class_interface::in) is semidet.
+:- pred class_interface_is_unchanged(class_interface::in, class_interface::in)
+ is semidet.
class_interface_is_unchanged(Interface0, Interface) :-
(
@@ -971,8 +1103,8 @@
Interface = class_interface_concrete(Methods2)
).
-:- pred class_methods_are_unchanged(class_methods::in,
- class_methods::in) is semidet.
+:- pred class_methods_are_unchanged(class_methods::in, class_methods::in)
+ is semidet.
class_methods_are_unchanged([], []).
class_methods_are_unchanged([Method1 | Methods1], [Method2 | Methods2]) :-
Index: compiler/state_var.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/state_var.m,v
retrieving revision 1.23
diff -u -b -r1.23 state_var.m
--- compiler/state_var.m 29 Jan 2008 01:49:12 -0000 1.23
+++ compiler/state_var.m 8 Feb 2008 17:34:29 -0000
@@ -996,7 +996,8 @@
Arity0, Ctxt),
Cs = list.map(expand_item_bsvs, Cs0),
% Note that the condition should always succeed...
- ( Cs = [item_clause(_, _, _, _, Args, _) | _] ->
+ ( Cs = [ItemClause | _] ->
+ Args = ItemClause ^ cl_head_args,
adjust_func_arity(PredOrFunc, Arity, list.length(Args))
;
Arity = Arity0
@@ -1004,17 +1005,14 @@
IM = instance_method(PredOrFunc, Method, instance_proc_def_clauses(Cs),
Arity, Ctxt).
- % The instance method clause items will all be clause items.
- %
-:- func expand_item_bsvs(item) = item.
-
-expand_item_bsvs(Item) =
- ( Item = item_clause(Origin, VarSet, PredOrFunc, SymName, Args, Body) ->
- item_clause(Origin, VarSet, PredOrFunc, SymName,
- expand_bang_state_var_args(Args), Body)
- ;
- Item
- ).
+:- func expand_item_bsvs(item_clause_info) = item_clause_info.
+
+expand_item_bsvs(ItemClause0) = ItemClause :-
+ ItemClause0 = item_clause_info(Origin, VarSet, PredOrFunc, SymName,
+ Args0, Body, Context),
+ Args = expand_bang_state_var_args(Args0),
+ ItemClause = item_clause_info(Origin, VarSet, PredOrFunc, SymName,
+ Args, Body, Context).
%-----------------------------------------------------------------------------%
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.46
diff -u -b -r1.46 trans_opt.m
--- compiler/trans_opt.m 10 Jan 2008 04:29:54 -0000 1.46
+++ compiler/trans_opt.m 9 Feb 2008 02:44:21 -0000
@@ -207,8 +207,8 @@
maybe_write_string(Verbose, "% Done.\n", !IO).
-:- pred read_trans_opt_files(list(module_name)::in, item_list::in,
- item_list::out, bool::in, bool::out, io::di, io::uo) is det.
+:- pred read_trans_opt_files(list(module_name)::in, list(item)::in,
+ list(item)::out, bool::in, bool::out, io::di, io::uo) is det.
read_trans_opt_files([], !Items, !Error, !IO).
read_trans_opt_files([Import | Imports], !Items, !Error, !IO) :-
cvs diff: Diffing compiler/notes
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
Index: library/term.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.128
diff -u -b -r1.128 term.m
--- library/term.m 25 Sep 2007 12:59:43 -0000 1.128
+++ library/term.m 7 Feb 2008 09:03:09 -0000
@@ -59,6 +59,8 @@
:- type term == term(generic).
:- type var == var(generic).
+:- func get_term_context(term) = term.context.
+
%-----------------------------------------------------------------------------%
% The following predicates can convert values of (almost) any type
@@ -475,6 +477,13 @@
%-----------------------------------------------------------------------------%
+get_term_context(Term) = Context :-
+ ( Term = functor(_, _, Context)
+ ; Term = variable(_, Context)
+ ).
+
+%-----------------------------------------------------------------------------%
+
term_to_type(Term, Val) :-
try_term_to_type(Term, ok(Val)).
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/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