[m-rev.] for review: expand equivalence types fully
Simon Taylor
stayl at cs.mu.OZ.AU
Sat Nov 29 00:04:00 AEDT 2003
Estimated hours taken: 100
Branches: main
Make definitions of abstract types available when generating
code for importing modules. This is necessary for the .NET
back-end, and for `:- pragma export' on the C back-end.
compiler/prog_data.m:
compiler/modules.m:
compiler/make.dependencies.m:
compiler/recompilation.version.m:
Handle implementation sections in interface files.
There is a new pseudo-declaration `abstract_imported'
which is applied to items from the implementation
section of an interface file. `abstract_imported'
items may not be used in the error checking passes
for the curent module.
compiler/equiv_type_hlds.m:
compiler/notes/compiler_design.html:
New file.
Go over the HLDS expanding all types fully after
semantic checking has been run.
compiler/mercury_compile.m:
Add the new pass.
Don't write the `.opt' file if there are any errors.
compiler/instmap.m:
Add a predicate instmap_delta_map_foldl to apply
a procedure to all insts in an instmap.
compiler/equiv_type.m:
Export predicates for use by equiv_type_hlds.m
Reorder arguments so state variables and higher-order
programming can be used.
compiler/prog_data.m:
compiler/prog_io_pragma.m:
compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
Handle `:- pragma foreign_type' as a form of type
declaration rather than a pragma.
compiler/hlds_data.m:
compiler/*.m:
Add a field to the type_info_cell_constructor cons_id
to identify the type_ctor, which is needed by
equiv_type_hlds.m.
compiler/module_qual.m:
Donn't allow items from the implementation section of
interface files to match items in the current module.
compiler/*.m:
tests/*/*.m:
Add missing imports which only became apparent with
the bug fixes above.
Remove unnecessary imports which only became apparent with
the bug fixes above.
tests/hard_coded/Mmakefile:
tests/hard_coded/Mercury.options:
tests/hard_coded/export_test2.{m,exp}:
Test case.
tests/invalid/Mmakefile:
tests/invalid/missing_interface2.{m,err_exp,err_exp2}:
Test case.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.320
diff -u -u -r1.320 NEWS
--- NEWS 31 Oct 2003 03:27:13 -0000 1.320
+++ NEWS 28 Nov 2003 10:55:39 -0000
@@ -55,6 +55,11 @@
* exception.m now contains a predicate finally/6 which can be used to
ensure that resources are released whether a called closure exits
normally or throws an exception.
+* The behaviour of multi_map__to_assoc_list and multi_map.from_assoc_list
+ has changed to use assoc_lists where each key-value in the multi_map
+ has an entry in the assoc_list, rather than just and entry for each key.
+ The old behaviour is available using multi_map.to_multi_assoc_list
+ and multi_map.from_multi_assoc_list.
Portability improvements:
* Nothing yet.
@@ -144,6 +149,12 @@
* exception.m now contains a predicate finally/6 which can be used to
ensure that resources are released whether a called closure exits
normally or throws an exception.
+
+* The behaviour of multi_map__to_assoc_list and multi_map.from_assoc_list
+ has changed to use assoc_lists where each key-value in the multi_map
+ has an entry in the assoc_list, rather than just and entry for each key.
+ The old behaviour is available using multi_map.to_multi_assoc_list
+ and multi_map.from_multi_assoc_list.
* Several new functions have been added to the string module, namely
elem/2, unsafe_elem/2, chomp/1, lstrip/1, lstrip/2, rstrip/1, rstrip/2,
Index: compiler/aditi_backend.pp
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/aditi_backend.pp,v
retrieving revision 1.4
diff -u -u -r1.4 aditi_backend.pp
--- compiler/aditi_backend.pp 18 Mar 2003 02:43:35 -0000 1.4
+++ compiler/aditi_backend.pp 28 Nov 2003 06:44:57 -0000
@@ -75,6 +75,9 @@
% aditi_backend__rl_exprn uses backend_libs__builtin_ops.
:- import_module backend_libs.
+ % aditi_backend__magic uses ll_backend__saved_vars.
+:- import_module ll_backend.
+
:- end_module aditi_backend.
%-----------------------------------------------------------------------------%
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.25
diff -u -u -r1.25 assertion.m
--- compiler/assertion.m 31 Oct 2003 03:27:20 -0000 1.25
+++ compiler/assertion.m 26 Nov 2003 08:46:23 -0000
@@ -879,6 +879,7 @@
is_defined_in_implementation_section(imported(interface), no).
is_defined_in_implementation_section(imported(ancestor), no).
+is_defined_in_implementation_section(imported(ancestor_private_interface), no).
is_defined_in_implementation_section(external(interface), no).
is_defined_in_implementation_section(opt_imported, no).
is_defined_in_implementation_section(abstract_imported, no).
Index: compiler/backend_libs.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/backend_libs.m,v
retrieving revision 1.5
diff -u -u -r1.5 backend_libs.m
--- compiler/backend_libs.m 23 Oct 2003 02:02:08 -0000 1.5
+++ compiler/backend_libs.m 24 Nov 2003 14:33:23 -0000
@@ -16,6 +16,7 @@
:- import_module libs.
:- import_module parse_tree.
:- import_module transform_hlds. % is this needed?
+:- import_module ll_backend. % export.m uses ll_backend.arg_info.
% modules that provide functionality used by several different back-ends
:- include_module base_typeclass_info.
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.77
diff -u -u -r1.77 bytecode_gen.m
--- compiler/bytecode_gen.m 24 Oct 2003 06:17:35 -0000 1.77
+++ compiler/bytecode_gen.m 26 Nov 2003 12:59:10 -0000
@@ -760,7 +760,7 @@
ByteConsId = base_typeclass_info_const(ModuleName, ClassId,
Instance)
;
- ConsId = type_info_cell_constructor,
+ ConsId = type_info_cell_constructor(_),
ByteConsId = type_info_cell_constructor
;
ConsId = typeclass_info_cell_constructor,
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.283
diff -u -u -r1.283 code_info.m
--- compiler/code_info.m 13 Nov 2003 09:51:22 -0000 1.283
+++ compiler/code_info.m 25 Nov 2003 12:55:01 -0000
@@ -45,7 +45,7 @@
:- import_module ll_backend__trace.
:- import_module parse_tree__prog_data.
-:- import_module bool, set, list, map, std_util, assoc_list, counter.
+:- import_module bool, set, list, map, std_util, assoc_list, counter, term.
:- implementation.
@@ -61,7 +61,7 @@
:- import_module ll_backend__var_locn.
:- import_module parse_tree__prog_out.
-:- import_module term, varset.
+:- import_module varset.
:- import_module set, stack.
:- import_module string, require, char, bimap, int.
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.66
diff -u -u -r1.66 dependency_graph.m
--- compiler/dependency_graph.m 5 Nov 2003 03:17:36 -0000 1.66
+++ compiler/dependency_graph.m 26 Nov 2003 13:11:12 -0000
@@ -507,7 +507,7 @@
_Caller, !DepGraph).
dependency_graph__add_arcs_in_cons(base_typeclass_info_const(_, _, _, _),
_Caller, !DepGraph).
-dependency_graph__add_arcs_in_cons(type_info_cell_constructor,
+dependency_graph__add_arcs_in_cons(type_info_cell_constructor(_),
_Caller, !DepGraph).
dependency_graph__add_arcs_in_cons(typeclass_info_cell_constructor,
_Caller, !DepGraph).
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.51
diff -u -u -r1.51 dnf.m
--- compiler/dnf.m 31 Oct 2003 03:27:22 -0000 1.51
+++ compiler/dnf.m 24 Nov 2003 14:33:23 -0000
@@ -67,8 +67,6 @@
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
:- import_module hlds__instmap.
-:- import_module ll_backend__code_aux.
-:- import_module ll_backend__code_util.
:- import_module parse_tree__prog_data.
:- import_module transform_hlds__dependency_graph.
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.33
diff -u -u -r1.33 equiv_type.m
--- compiler/equiv_type.m 25 Jul 2003 02:27:19 -0000 1.33
+++ compiler/equiv_type.m 28 Nov 2003 06:02:42 -0000
@@ -16,7 +16,7 @@
:- import_module parse_tree__prog_data.
:- import_module recompilation.
-:- import_module bool, list, io, std_util.
+:- import_module bool, list, map, io, std_util.
%-----------------------------------------------------------------------------%
@@ -44,13 +44,45 @@
:- mode equiv_type__expand_eqv_types(in, in, out, out, out,
in, out, di, uo) is det.
- % Replace equivalence types in a given type, returning
- % the type_ctors of the equivalence types replaced.
-:- pred equiv_type__replace_in_type(type, tvarset, eqv_map, type,
- tvarset).
-:- mode equiv_type__replace_in_type(in, in, in, out, out) is det.
+ % Replace equivalence types in a given type.
+:- pred equiv_type__replace_in_type(eqv_map, type, type,
+ tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_type(in, in, out, in, out, in, out) is det.
-:- type eqv_map.
+:- pred equiv_type__replace_in_class_constraints(eqv_map, class_constraints,
+ class_constraints, tvarset, tvarset,
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_class_constraints(in, in, out,
+ in, out, in, out) is det.
+
+:- pred equiv_type__replace_in_class_constraint(eqv_map,
+ class_constraint, class_constraint, tvarset, tvarset,
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_class_constraint(in, in, out,
+ in, out, in, out) is det.
+
+:- pred equiv_type__replace_in_ctors(eqv_map,
+ list(constructor), list(constructor), tvarset, tvarset,
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_ctors(in, in, out, in, out, in, out) is det.
+
+:- type eqv_type_body ---> eqv_type_body(tvarset, list(type_param), type).
+:- type eqv_map == map(type_ctor, eqv_type_body).
+
+:- 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.
+:- pred equiv_type__maybe_record_expanded_items(module_name, sym_name,
+ maybe(recompilation_info), equiv_type_info).
+:- mode equiv_type__maybe_record_expanded_items(in, in, in, out) is det.
+
+ % Record all the expanded items in the recompilation_info.
+:- pred equiv_type__finish_recording_expanded_items(item_id,
+ equiv_type_info, maybe(recompilation_info), maybe(recompilation_info)).
+:- mode equiv_type__finish_recording_expanded_items(in, in, in, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -96,9 +128,6 @@
io__set_exit_status(1)
).
-:- type eqv_type_body ---> eqv_type_body(tvarset, list(type_param), type).
-:- type eqv_map == map(type_ctor, eqv_type_body).
-
% We need to expand equivalence insts in
% `:- pred p `with_inst` i' declarations.
:- type eqv_inst_body ---> eqv_inst_body(inst_varset, list(inst_var), inst).
@@ -124,25 +153,74 @@
:- mode equiv_type__build_eqv_map(in, in, out, in, out) is det.
equiv_type__build_eqv_map([], EqvMap, EqvMap, EqvInstMap, EqvInstMap).
-equiv_type__build_eqv_map([Item - _Context | Items], EqvMap0, EqvMap,
+equiv_type__build_eqv_map([Item - _Context | Items0], EqvMap0, EqvMap,
EqvInstMap0, EqvInstMap) :-
- ( Item = type_defn(VarSet, Name, Args, eqv_type(Body), _Cond) ->
+ (
+ Item = module_defn(_, abstract_imported)
+ ->
+ skip_abstract_imported_items(Items0, Items),
+ EqvMap1 = EqvMap0,
+ EqvInstMap1 = EqvInstMap0
+ ;
+ Item = type_defn(VarSet, Name, Args,
+ eqv_type(Body), _Cond)
+ ->
+ Items = Items0,
list__length(Args, Arity),
map__set(EqvMap0, Name - Arity,
eqv_type_body(VarSet, Args, Body), EqvMap1),
EqvInstMap1 = EqvInstMap0
- ; Item = inst_defn(VarSet, Name, Args, eqv_inst(Body), _) ->
+ ;
+ Item = inst_defn(VarSet, Name, Args, eqv_inst(Body), _)
+ ->
+ Items = Items0,
list__length(Args, Arity),
map__set(EqvInstMap0, Name - Arity,
eqv_inst_body(VarSet, Args, Body), EqvInstMap1),
EqvMap1 = EqvMap0
;
+ Items = Items0,
EqvMap1 = EqvMap0,
EqvInstMap1 = EqvInstMap0
),
equiv_type__build_eqv_map(Items, EqvMap1, EqvMap,
EqvInstMap1, EqvInstMap).
+:- pred skip_abstract_imported_items(list(item_and_context),
+ list(item_and_context)).
+:- mode skip_abstract_imported_items(in, out) is det.
+
+skip_abstract_imported_items([], []).
+skip_abstract_imported_items([Item - _ | Items0], Items) :-
+ (
+ Item = module_defn(_, Defn),
+ is_section_defn(Defn) = yes,
+ Defn \= abstract_imported
+ ->
+ Items = Items0
+ ;
+ skip_abstract_imported_items(Items0, Items)
+ ).
+
+:- func is_section_defn(module_defn) = bool.
+
+is_section_defn(module(_)) = yes.
+is_section_defn(end_module(_)) = yes.
+is_section_defn(interface) = yes.
+is_section_defn(implementation) = yes.
+is_section_defn(private_interface) = yes.
+is_section_defn(imported(_)) = yes.
+is_section_defn(used(_)) = yes.
+is_section_defn(abstract_imported) = yes.
+is_section_defn(opt_imported) = yes.
+is_section_defn(transitively_imported) = yes.
+is_section_defn(external(_)) = no.
+is_section_defn(export(_)) = no.
+is_section_defn(import(_)) = no.
+is_section_defn(use(_)) = no.
+is_section_defn(include_module(_)) = no.
+is_section_defn(version_numbers(_, _)) = no.
+
% The following predicate equiv_type__replace_in_item_list
% performs substititution of equivalence types on a list
% of items. Similarly the replace_in_<foo> predicates that
@@ -194,13 +272,14 @@
equiv_type__replace_in_item(ModuleName,
type_defn(VarSet0, Name, TArgs, TypeDefn0, Cond) @ Item,
- Context, EqvMap, _EqvInstMap, type_defn(VarSet, Name, TArgs,
- TypeDefn, Cond), Error, Info0, Info) :-
+ Context, EqvMap, _EqvInstMap,
+ type_defn(VarSet, Name, TArgs, TypeDefn, Cond),
+ Error, Info0, Info) :-
list__length(TArgs, Arity),
equiv_type__maybe_record_expanded_items(ModuleName, Name,
Info0, UsedTypeCtors0),
- equiv_type__replace_in_type_defn(Name - Arity, TypeDefn0,
- VarSet0, EqvMap, TypeDefn, VarSet, ContainsCirc,
+ equiv_type__replace_in_type_defn(EqvMap, Name - Arity, TypeDefn0,
+ TypeDefn, ContainsCirc, VarSet0, VarSet,
UsedTypeCtors0, UsedTypeCtors),
( ContainsCirc = yes ->
Error = [circular_equivalence(Item) - Context]
@@ -276,8 +355,9 @@
list__length(Vars, Arity),
equiv_type__maybe_record_expanded_items(ModuleName, ClassName,
Info0, ExpandedItems0),
- equiv_type__replace_in_class_constraint_list(Constraints0, VarSet0,
- EqvMap, Constraints, VarSet, ExpandedItems0, ExpandedItems1),
+ equiv_type__replace_in_class_constraint_list(EqvMap,
+ Constraints0, Constraints, VarSet0, VarSet,
+ ExpandedItems0, ExpandedItems1),
(
ClassInterface0 = abstract,
ClassInterface = abstract,
@@ -306,9 +386,10 @@
;
UsedTypeCtors0 = yes(ModuleName - set__init)
),
- equiv_type__replace_in_class_constraint_list(Constraints0, VarSet0,
- EqvMap, Constraints, VarSet1, UsedTypeCtors0, UsedTypeCtors1),
- equiv_type__replace_in_type_list(Ts0, VarSet1, EqvMap, Ts, VarSet, _,
+ equiv_type__replace_in_class_constraint_list(EqvMap,
+ Constraints0, Constraints, VarSet0, VarSet1,
+ UsedTypeCtors0, UsedTypeCtors1),
+ equiv_type__replace_in_type_list(EqvMap, Ts0, Ts, _, VarSet1, VarSet,
UsedTypeCtors1, UsedTypeCtors),
list__length(Ts0, Arity),
equiv_type__finish_recording_expanded_items(
@@ -327,7 +408,7 @@
;
ExpandedItems0 = yes(ModuleName - ItemIds0)
),
- equiv_type__replace_in_subst(Subst0, VarSet0, EqvMap, Subst, VarSet,
+ equiv_type__replace_in_subst(EqvMap, Subst0, Subst, VarSet0, VarSet,
ExpandedItems0, ExpandedItems),
(
ExpandedItems = no,
@@ -336,66 +417,47 @@
ExpandedItems = yes(_ - ItemIds)
).
-:- pred equiv_type__replace_in_type_defn(type_ctor, type_defn, tvarset,
- eqv_map, type_defn, tvarset, bool,
+:- pred equiv_type__replace_in_type_defn(eqv_map, type_ctor,
+ type_defn, type_defn, bool, tvarset, tvarset,
equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_defn(in, in, in, in, out, out, out,
+:- mode equiv_type__replace_in_type_defn(in, in, in, out, out, in, out,
in, out) is semidet.
-equiv_type__replace_in_type_defn(TypeCtor, eqv_type(TBody0),
- VarSet0, EqvMap, eqv_type(TBody),
- VarSet, ContainsCirc, Info0, Info) :-
- equiv_type__replace_in_type_2(TBody0, VarSet0, EqvMap, [TypeCtor],
- TBody, VarSet, ContainsCirc, Info0, Info).
-
-equiv_type__replace_in_type_defn(_, du_type(TBody0, IsSolverType, EqPred),
- VarSet0, EqvMap, du_type(TBody, IsSolverType, EqPred),
- VarSet, no, Info0, Info) :-
- equiv_type__replace_in_du(TBody0, VarSet0, EqvMap, TBody,
- VarSet, Info0, Info).
+equiv_type__replace_in_type_defn(EqvMap, TypeCtor, eqv_type(TBody0),
+ eqv_type(TBody), ContainsCirc, !VarSet, !Info) :-
+ equiv_type__replace_in_type_2(EqvMap, [TypeCtor], TBody0, TBody,
+ ContainsCirc, !VarSet, !Info).
-%-----------------------------------------------------------------------------%
+equiv_type__replace_in_type_defn(EqvMap, _,
+ du_type(TBody0, IsSolverType, EqPred),
+ du_type(TBody, IsSolverType, EqPred), no, !VarSet, !Info) :-
+ equiv_type__replace_in_ctors(EqvMap, TBody0, TBody, !VarSet, !Info).
-:- pred equiv_type__replace_in_class_constraints(class_constraints,
- tvarset, eqv_map, class_constraints, tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_constraints(in, in, in, out, out,
- in, out) is det.
+%-----------------------------------------------------------------------------%
-equiv_type__replace_in_class_constraints(Cs0, VarSet0, EqvMap, Cs, VarSet,
- Info0, Info) :-
+equiv_type__replace_in_class_constraints(EqvMap, Cs0, Cs, !VarSet, !Info) :-
Cs0 = constraints(UnivCs0, ExistCs0),
Cs = constraints(UnivCs, ExistCs),
- equiv_type__replace_in_class_constraint_list(UnivCs0, VarSet0, EqvMap,
- UnivCs, VarSet1, Info0, Info1),
- equiv_type__replace_in_class_constraint_list(ExistCs0, VarSet1, EqvMap,
- ExistCs, VarSet, Info1, Info).
-
-:- pred equiv_type__replace_in_class_constraint_list(list(class_constraint),
- tvarset, eqv_map, list(class_constraint), tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_constraint_list(in, in, in,
- out, out, in, out) is det.
+ equiv_type__replace_in_class_constraint_list(EqvMap, UnivCs0, UnivCs,
+ !VarSet, !Info),
+ equiv_type__replace_in_class_constraint_list(EqvMap, ExistCs0, ExistCs,
+ !VarSet, !Info).
+
+:- pred equiv_type__replace_in_class_constraint_list(eqv_map,
+ list(class_constraint), list(class_constraint),
+ tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_class_constraint_list(in, in, out,
+ in, out, in, out) is det.
-equiv_type__replace_in_class_constraint_list([], VarSet, _, [], VarSet,
- Info, Info).
-equiv_type__replace_in_class_constraint_list([C0|C0s], VarSet0, EqvMap,
- [C|Cs], VarSet, Info0, Info) :-
- equiv_type__replace_in_class_constraint(C0, VarSet0, EqvMap, C,
- VarSet1, Info0, Info1),
- equiv_type__replace_in_class_constraint_list(C0s, VarSet1, EqvMap, Cs,
- VarSet, Info1, Info).
-
-:- pred equiv_type__replace_in_class_constraint(class_constraint, tvarset,
- eqv_map, class_constraint, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_class_constraint(in, in, in,
- out, out, in, out) is det.
+equiv_type__replace_in_class_constraint_list(EqvMap, Cs0, Cs,
+ !VarSet, !Info) :-
+ list__map_foldl2(equiv_type__replace_in_class_constraint(EqvMap),
+ Cs0, Cs, !VarSet, !Info).
-equiv_type__replace_in_class_constraint(Constraint0, VarSet0, EqvMap,
- Constraint, VarSet, Info0, Info) :-
+equiv_type__replace_in_class_constraint(EqvMap, Constraint0, Constraint,
+ !VarSet, !Info) :-
Constraint0 = constraint(ClassName, Ts0),
- equiv_type__replace_in_type_list(Ts0, VarSet0, EqvMap, Ts, VarSet, _,
- Info0, Info),
+ equiv_type__replace_in_type_list(EqvMap, Ts0, Ts, _, !VarSet, !Info),
Constraint = constraint(ClassName, Ts).
%-----------------------------------------------------------------------------%
@@ -453,152 +515,116 @@
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_subst(assoc_list(tvar, type), tvarset,
- eqv_map, assoc_list(tvar, type), tvarset,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_subst(in, in, in, out, out, in, out) is det.
+:- pred equiv_type__replace_in_subst(eqv_map,
+ assoc_list(tvar, type), assoc_list(tvar, type),
+ tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_subst(in, in, out, in, out, in, out) is det.
-equiv_type__replace_in_subst([], VarSet, _EqvMap, [], VarSet,
- Info, Info).
-equiv_type__replace_in_subst([Var - Type0 | Subst0], VarSet0, EqvMap,
- [Var - Type | Subst], VarSet, Info0, Info) :-
- equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet1,
- Info0, Info1),
- equiv_type__replace_in_subst(Subst0, VarSet1, EqvMap, Subst, VarSet,
- Info1, Info).
+equiv_type__replace_in_subst(_EqvMap, [], [], !VarSet, !Info).
+equiv_type__replace_in_subst(EqvMap, [Var - Type0 | Subst0],
+ [Var - Type | Subst], !VarSet, !Info) :-
+ equiv_type__replace_in_type(EqvMap, Type0, Type, !VarSet, !Info),
+ equiv_type__replace_in_subst(EqvMap, Subst0, Subst, !VarSet, !Info).
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_uu(list(type), tvarset, eqv_map, list(type),
- tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_uu(in, in, in, out, out, in, out) is det.
-
-equiv_type__replace_in_uu(Ts0, VarSet0, EqvMap,
- Ts, VarSet, Info0, Info) :-
- equiv_type__replace_in_type_list(Ts0, VarSet0, EqvMap,
- Ts, VarSet, _, Info0, Info).
-
-%-----------------------------------------------------------------------------%
+equiv_type__replace_in_ctors(EqvMap, !Ctors, !VarSet, !Info) :-
+ list__map_foldl2(equiv_type__replace_in_ctor(EqvMap),
+ !Ctors, !VarSet, !Info).
-:- pred equiv_type__replace_in_du(list(constructor), tvarset, eqv_map,
- list(constructor), tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_du(in, in, in, out, out, in, out) is det.
+:- pred equiv_type__replace_in_ctor(eqv_map, constructor, constructor,
+ tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_ctor(in, in, out, in, out, in, out) is det.
-equiv_type__replace_in_du([], VarSet, _EqvMap, [], VarSet,
- Info, Info).
-equiv_type__replace_in_du([T0|Ts0], VarSet0, EqvMap, [T|Ts], VarSet,
- Info0, Info) :-
- equiv_type__replace_in_ctor(T0, VarSet0, EqvMap, T, VarSet1,
- Info0, Info1),
- equiv_type__replace_in_du(Ts0, VarSet1, EqvMap, Ts, VarSet,
- Info1, Info).
-
-:- pred equiv_type__replace_in_ctor(constructor, tvarset, eqv_map, constructor,
- tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_ctor(in, in, in, out, out, in, out) is det.
-
-equiv_type__replace_in_ctor(ctor(ExistQVars, Constraints0, TName, Targs0),
- VarSet0, EqvMap,
- ctor(ExistQVars, Constraints, TName, Targs), VarSet,
- Info0, Info) :-
- equiv_type__replace_in_ctor_arg_list(Targs0, VarSet0, EqvMap,
- Targs, VarSet1, _, Info0, Info1),
- equiv_type__replace_in_class_constraint_list(Constraints0, VarSet1,
- EqvMap, Constraints, VarSet, Info1, Info).
+equiv_type__replace_in_ctor(EqvMap,
+ ctor(ExistQVars, Constraints0, TName, Targs0),
+ ctor(ExistQVars, Constraints, TName, Targs), !VarSet, !Info) :-
+ equiv_type__replace_in_ctor_arg_list(EqvMap, Targs0, Targs, _,
+ !VarSet, !Info),
+ equiv_type__replace_in_class_constraint_list(EqvMap,
+ Constraints0, Constraints, !VarSet, !Info).
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_type_list(list(type), tvarset, eqv_map,
- list(type), tvarset, bool, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_list(in, in, in, out, out, out,
+:- pred equiv_type__replace_in_type_list(eqv_map, list(type), list(type),
+ bool, tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_type_list(in, in, out, out, in, out,
in, out) is det.
-equiv_type__replace_in_type_list(Ts0, VarSet0, EqvMap,
- Ts, VarSet, ContainsCirc, Info0, Info) :-
- equiv_type__replace_in_type_list_2(Ts0, VarSet0, EqvMap, [],
- Ts, VarSet, no, ContainsCirc, Info0, Info).
+equiv_type__replace_in_type_list(EqvMap, Ts0, Ts, ContainsCirc,
+ !VarSet, !Info) :-
+ equiv_type__replace_in_type_list_2(EqvMap, [], Ts0, Ts,
+ no, ContainsCirc, !VarSet, !Info).
-:- pred equiv_type__replace_in_type_list_2(list(type), tvarset, eqv_map,
- list(type_ctor), list(type), tvarset, bool, bool,
+:- pred equiv_type__replace_in_type_list_2(eqv_map, list(type_ctor),
+ list(type), list(type), bool, bool, tvarset, tvarset,
equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_list_2(in, in, in,
- in, out, out, in, out, in, out) is det.
+:- mode equiv_type__replace_in_type_list_2(in, in, in, out,
+ in, out, in, out, in, out) is det.
-equiv_type__replace_in_type_list_2([], VarSet, _EqvMap, _Seen, [], VarSet,
- ContainsCirc, ContainsCirc, Info, Info).
-equiv_type__replace_in_type_list_2([T0 | Ts0], VarSet0, EqvMap, Seen,
- [T | Ts], VarSet, Circ0, Circ, Info0, Info) :-
- equiv_type__replace_in_type_2(T0, VarSet0, EqvMap, Seen,
- T, VarSet1, ContainsCirc, Info0, Info1),
- bool__or(Circ0, ContainsCirc, Circ1),
- equiv_type__replace_in_type_list_2(Ts0, VarSet1, EqvMap, Seen,
- Ts, VarSet, Circ1, Circ, Info1, Info).
+equiv_type__replace_in_type_list_2(_EqvMap, _Seen, [], [],
+ !ContainsCirc, !VarSet, !Info).
+equiv_type__replace_in_type_list_2(EqvMap, Seen, [T0 | Ts0], [T | Ts],
+ !Circ, !VarSet, !Info) :-
+ equiv_type__replace_in_type_2(EqvMap, Seen, T0, T, ContainsCirc,
+ !VarSet, !Info),
+ !:Circ = ContainsCirc `or` !.Circ,
+ equiv_type__replace_in_type_list_2(EqvMap, Seen, Ts0, Ts,
+ !Circ, !VarSet, !Info).
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_ctor_arg_list(list(constructor_arg), tvarset,
- eqv_map, list(constructor_arg), tvarset, bool,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_ctor_arg_list(in, in, in, out, out, out,
- in, out) is det.
-
-equiv_type__replace_in_ctor_arg_list(As0, VarSet0, EqvMap,
- As, VarSet, ContainsCirc, Info0, Info) :-
- equiv_type__replace_in_ctor_arg_list_2(As0, VarSet0, EqvMap, [],
- As, VarSet, no, ContainsCirc, Info0, Info).
-
-:- pred equiv_type__replace_in_ctor_arg_list_2(list(constructor_arg), tvarset,
- eqv_map, list(type_ctor), list(constructor_arg), tvarset, bool, bool,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_ctor_arg_list_2(in, in, in,
- in, out, out, in, out, in, out) is det.
-
-equiv_type__replace_in_ctor_arg_list_2([], VarSet, _EqvMap, _Seen,
- [], VarSet, ContainsCirc, ContainsCirc,
- Info, Info).
-equiv_type__replace_in_ctor_arg_list_2([N - T0 | As0], VarSet0, EqvMap, Seen,
- [N - T | As], VarSet, Circ0, Circ, Info0, Info) :-
- equiv_type__replace_in_type_2(T0, VarSet0, EqvMap, Seen,
- T, VarSet1, ContainsCirc, Info0, Info1),
- bool__or(Circ0, ContainsCirc, Circ1),
- equiv_type__replace_in_ctor_arg_list_2(As0, VarSet1, EqvMap, Seen,
- As, VarSet, Circ1, Circ, Info1, Info).
+:- pred equiv_type__replace_in_ctor_arg_list(eqv_map,
+ list(constructor_arg), list(constructor_arg), bool,
+ tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_ctor_arg_list(in, in, out, out,
+ in, out, in, out) is det.
+
+equiv_type__replace_in_ctor_arg_list(EqvMap, As0, As, ContainsCirc,
+ !VarSet, !Info) :-
+ equiv_type__replace_in_ctor_arg_list_2(EqvMap, [], As0, As, no,
+ ContainsCirc, !VarSet, !Info).
+
+:- pred equiv_type__replace_in_ctor_arg_list_2(eqv_map, list(type_ctor),
+ list(constructor_arg), list(constructor_arg), bool, bool,
+ tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_ctor_arg_list_2(in, in, in, out,
+ in, out, in, out, in, out) is det.
+
+equiv_type__replace_in_ctor_arg_list_2(_EqvMap, _Seen, [], [], !ContainsCirc,
+ !VarSet, !Info).
+equiv_type__replace_in_ctor_arg_list_2(EqvMap, Seen, [N - T0 | As0],
+ [N - T | As], !Circ, !VarSet, !Info) :-
+ equiv_type__replace_in_type_2(EqvMap, Seen, T0, T, ContainsCirc,
+ !VarSet, !Info),
+ !:Circ = !.Circ `or` ContainsCirc,
+ equiv_type__replace_in_ctor_arg_list_2(EqvMap, Seen, As0, As,
+ !Circ, !VarSet, !Info).
%-----------------------------------------------------------------------------%
-equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet) :-
- equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet,
- no, _).
-
-:- pred equiv_type__replace_in_type(type, tvarset, eqv_map, type,
- tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type(in, in, in, out, out, in, out) is det.
-
-equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet,
- Info0, Info) :-
- equiv_type__replace_in_type_2(Type0, VarSet0, EqvMap,
- [], Type, VarSet, _, Info0, Info).
+equiv_type__replace_in_type(EqvMap, Type0, Type, !VarSet, !Info) :-
+ equiv_type__replace_in_type_2(EqvMap, [], Type0, Type, _,
+ !VarSet, !Info).
% Replace all equivalence types in a given type, detecting
% any circularities.
-:- pred equiv_type__replace_in_type_2(type, tvarset, eqv_map,
- list(type_ctor), type, tvarset, bool,
- equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_type_2(in, in, in, in, out, out, out,
- in, out) is det.
-
-equiv_type__replace_in_type_2(term__variable(V), VarSet, _EqvMap,
- _Seen, term__variable(V), VarSet, no, Info, Info).
-equiv_type__replace_in_type_2(Type0, VarSet0, EqvMap, TypeCtorsAlreadyExpanded,
- Type, VarSet, Circ, Info0, Info) :-
+:- pred equiv_type__replace_in_type_2(eqv_map, list(type_ctor), type, type,
+ bool, tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_type_2(in, in, in, out, out,
+ in, out, in, out) is det.
+equiv_type__replace_in_type_2(_EqvMap, _Seen,
+ term__variable(V), term__variable(V), no, !VarSet, !Info).
+equiv_type__replace_in_type_2(EqvMap, TypeCtorsAlreadyExpanded, Type0, Type,
+ Circ, !VarSet, !Info) :-
Type0 = term__functor(_, _, _),
(
type_to_ctor_and_args(Type0, EqvTypeCtor, TArgs0)
->
- equiv_type__replace_in_type_list_2(TArgs0, VarSet0, EqvMap,
- TypeCtorsAlreadyExpanded, TArgs1, VarSet1, no, Circ0,
- Info0, Info1),
+ equiv_type__replace_in_type_list_2(EqvMap,
+ TypeCtorsAlreadyExpanded, TArgs0, TArgs1,
+ no, Circ0, !VarSet, !Info),
( list__member(EqvTypeCtor, TypeCtorsAlreadyExpanded) ->
Circ1 = yes
@@ -620,29 +646,25 @@
% with the type variables in the predicate's
% declaration.
%
- varset__merge_without_names(VarSet1, EqvVarSet,
- [Body0 | Args0], VarSet2, [Body | Args]),
+ varset__merge_without_names(!.VarSet, EqvVarSet,
+ [Body0 | Args0], !:VarSet, [Body | Args]),
Circ0 = no,
Circ1 = no
->
equiv_type__record_expanded_item(
- item_id(type, EqvTypeCtor), Info1, Info2),
+ item_id(type, EqvTypeCtor), !Info),
term__term_list_to_var_list(Args, ArgVars),
term__substitute_corresponding(ArgVars, TArgs1,
Body, Type1),
- equiv_type__replace_in_type_2(Type1, VarSet2, EqvMap,
+ equiv_type__replace_in_type_2(EqvMap,
[EqvTypeCtor | TypeCtorsAlreadyExpanded],
- Type, VarSet, Circ, Info2, Info)
+ Type1, Type, Circ, !VarSet, !Info)
;
- VarSet = VarSet1,
- Info = Info1,
construct_type(EqvTypeCtor, TArgs1, Type),
bool__or(Circ0, Circ1, Circ)
)
;
- VarSet = VarSet0,
Type = Type0,
- Info = Info0,
Circ = no
).
@@ -702,19 +724,18 @@
equiv_type__replace_in_pred_type(PredName, PredOrFunc, Context, EqvMap,
EqvInstMap, ClassContext0, ClassContext,
- TypesAndModes0, TypesAndModes, TypeVarSet0, TypeVarSet,
+ TypesAndModes0, TypesAndModes, !TypeVarSet,
MaybeWithType0, MaybeWithType, MaybeWithInst0, MaybeWithInst,
- Det0, Det, Info0, Info, Errors) :-
- equiv_type__replace_in_class_constraints(ClassContext0, TypeVarSet0,
- EqvMap, ClassContext, TypeVarSet1, Info0, Info1),
- equiv_type__replace_in_tms(TypesAndModes0, TypeVarSet1, EqvMap,
- TypesAndModes1, TypeVarSet2, Info1, Info2),
+ Det0, Det, !Info, Errors) :-
+ equiv_type__replace_in_class_constraints(EqvMap,
+ ClassContext0, ClassContext, !TypeVarSet, !Info),
+ equiv_type__replace_in_tms(EqvMap, TypesAndModes0,
+ TypesAndModes1, !TypeVarSet, !Info),
(
MaybeWithType0 = yes(WithType0),
- equiv_type__replace_in_type(WithType0, TypeVarSet2,
- EqvMap, WithType, TypeVarSet,
- Info2, Info3),
+ equiv_type__replace_in_type(EqvMap, WithType0, WithType,
+ !TypeVarSet, !Info),
(
type_is_higher_order(WithType, _Purity, PredOrFunc,
_EvalMethod, ExtraTypes0)
@@ -728,15 +749,13 @@
)
;
MaybeWithType0 = no,
- Info3 = Info2,
ExtraTypes = [],
- TypeVarSet = TypeVarSet2,
Errors0 = []
),
equiv_type__replace_in_pred_mode(PredName, length(TypesAndModes0),
Context, type_decl, EqvInstMap, yes(PredOrFunc), _, ExtraModes,
- MaybeWithInst0, _, Det0, Det, Info3, Info4, ModeErrors),
+ MaybeWithInst0, _, Det0, Det, !Info, ModeErrors),
Errors1 = Errors0 ++ ModeErrors,
( Errors1 \= [] ->
@@ -770,13 +789,11 @@
),
( ExtraTypesAndModes = [] ->
- Info = Info4,
TypesAndModes = TypesAndModes1
;
OrigItemId = item_id(pred_or_func_to_item_type(PredOrFunc),
PredName - list__length(TypesAndModes0)),
- equiv_type__record_expanded_item(OrigItemId,
- Info4, Info),
+ equiv_type__record_expanded_item(OrigItemId, !Info),
TypesAndModes = TypesAndModes1 ++ ExtraTypesAndModes
).
@@ -840,40 +857,30 @@
ExtraModes = []
).
-:- pred equiv_type__replace_in_tms(list(type_and_mode), tvarset, eqv_map,
- list(type_and_mode), tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_tms(in, in, in, out, out, in, out) is det.
-
-equiv_type__replace_in_tms([], VarSet, _EqvMap, [], VarSet,
- Info, Info).
-equiv_type__replace_in_tms([TM0|TMs0], VarSet0, EqvMap, [TM|TMs], VarSet,
- Info0, Info) :-
- equiv_type__replace_in_tm(TM0, VarSet0, EqvMap, TM, VarSet1,
- Info0, Info1),
- equiv_type__replace_in_tms(TMs0, VarSet1, EqvMap, TMs, VarSet,
- Info1, Info).
-
-:- pred equiv_type__replace_in_tm(type_and_mode, tvarset, eqv_map,
- type_and_mode, tvarset, equiv_type_info, equiv_type_info).
-:- mode equiv_type__replace_in_tm(in, in, in, out, out, in, out) is det.
-
-equiv_type__replace_in_tm(type_only(Type0), VarSet0, EqvMap,
- type_only(Type), VarSet, Info0, Info) :-
- equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet,
- Info0, Info).
-
-equiv_type__replace_in_tm(type_and_mode(Type0, Mode), VarSet0, EqvMap,
- type_and_mode(Type, Mode), VarSet, Info0, Info) :-
- equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet,
- Info0, Info).
+:- pred equiv_type__replace_in_tms(eqv_map,
+ list(type_and_mode), list(type_and_mode), tvarset, tvarset,
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_tms(in, in, out, in, out, in, out) is det.
-%-----------------------------------------------------------------------------%
+equiv_type__replace_in_tms(EqvMap, !TMs, !VarSet, !Info) :-
+ list__map_foldl2(equiv_type__replace_in_tm(EqvMap),
+ !TMs, !VarSet, !Info).
-:- type equiv_type_info == maybe(pair(module_name, set(item_id))).
+:- pred equiv_type__replace_in_tm(eqv_map, type_and_mode, type_and_mode,
+ tvarset, tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_tm(in, in, out, in, out, in, out) is det.
-:- pred equiv_type__maybe_record_expanded_items(module_name, sym_name,
- maybe(recompilation_info), equiv_type_info).
-:- mode equiv_type__maybe_record_expanded_items(in, in, in, out) is det.
+equiv_type__replace_in_tm(EqvMap, type_only(Type0),
+ type_only(Type), !VarSet, !Info) :-
+ equiv_type__replace_in_type(EqvMap, Type0, Type, !VarSet, !Info).
+
+equiv_type__replace_in_tm(EqvMap, type_and_mode(Type0, Mode),
+ type_and_mode(Type, Mode), !VarSet, !Info) :-
+ equiv_type__replace_in_type(EqvMap, Type0, Type, !VarSet, !Info).
+
+%-----------------------------------------------------------------------------%
+
+:- type expanded_item_set == pair(module_name, set(item_id)).
equiv_type__maybe_record_expanded_items(_, _, no, no).
equiv_type__maybe_record_expanded_items(ModuleName, SymName,
@@ -906,10 +913,6 @@
Items = set__insert(Items0, ItemId)
).
-:- pred equiv_type__finish_recording_expanded_items(item_id,
- equiv_type_info, maybe(recompilation_info), maybe(recompilation_info)).
-:- mode equiv_type__finish_recording_expanded_items(in, in, in, out) is det.
-
equiv_type__finish_recording_expanded_items(_, no, no, no).
equiv_type__finish_recording_expanded_items(_, no, yes(Info), yes(Info)).
equiv_type__finish_recording_expanded_items(_, yes(_), no, _) :-
@@ -925,8 +928,7 @@
equiv_type__report_error(circular_equivalence(Item) - Context) -->
(
- { Item = type_defn(_, SymName, Params,
- TypeDefn, _) },
+ { Item = type_defn(_, SymName, Params, TypeDefn, _) },
{ TypeDefn = eqv_type(_) }
->
{ Pieces = append_punctuation([
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: compiler/equiv_type_hlds.m
diff -N compiler/equiv_type_hlds.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/equiv_type_hlds.m 28 Nov 2003 06:10:09 -0000
@@ -0,0 +1,573 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2003 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% Main author: stayl.
+%
+% Expand all types in the module_info using all equivalence
+% type definitions, even those local to (transitively) imported
+% modules.
+%
+% This is necessary to avoid problems with back-ends that
+% don't support equivalence types properly (or at all).
+%
+%-----------------------------------------------------------------------------%
+:- module transform_hlds__equiv_type_hlds.
+
+:- interface.
+
+:- import_module hlds__hlds_module.
+
+:- pred replace_in_hlds(module_info::in, module_info::out) is det.
+
+:- implementation.
+
+:- import_module check_hlds__mode_util.
+:- import_module check_hlds__type_util.
+:- import_module check_hlds__polymorphism.
+:- import_module hlds__goal_util.
+:- import_module hlds__hlds_goal.
+:- import_module hlds__hlds_pred.
+:- import_module hlds__hlds_data.
+:- import_module hlds__instmap.
+:- import_module hlds__quantification.
+:- import_module parse_tree__equiv_type.
+:- import_module parse_tree__inst.
+:- import_module parse_tree__prog_data.
+:- import_module recompilation.
+
+:- import_module bool, list, map, require, std_util, term, varset.
+
+replace_in_hlds(!ModuleInfo) :-
+ module_info_types(!.ModuleInfo, Types0),
+ map__foldl(add_type_to_eqv_map, Types0, map__init, EqvMap),
+
+ module_info_get_maybe_recompilation_info(!.ModuleInfo,
+ MaybeRecompInfo0),
+ module_info_name(!.ModuleInfo, ModuleName),
+ map__map_foldl(replace_in_type_defn(ModuleName, EqvMap), Types0, Types,
+ MaybeRecompInfo0, MaybeRecompInfo),
+ module_info_set_types(Types, !ModuleInfo),
+ module_info_set_maybe_recompilation_info(MaybeRecompInfo, !ModuleInfo),
+
+ module_info_insts(!.ModuleInfo, Insts0),
+ replace_in_inst_table(EqvMap, Insts0, Insts),
+ module_info_set_insts(Insts, !ModuleInfo),
+
+ module_info_predids(!.ModuleInfo, PredIds),
+ list__foldl(replace_in_pred(EqvMap), PredIds, !ModuleInfo).
+
+:- pred add_type_to_eqv_map(type_ctor::in, hlds_type_defn::in,
+ eqv_map::in, eqv_map::out) is det.
+
+add_type_to_eqv_map(TypeCtor, Defn, !EqvMap) :-
+ hlds_data__get_type_defn_body(Defn, Body),
+ ( Body = eqv_type(EqvType) ->
+ hlds_data__get_type_defn_tvarset(Defn, TVarSet),
+ hlds_data__get_type_defn_tparams(Defn, Params),
+ map__det_insert(!.EqvMap, TypeCtor,
+ eqv_type_body(TVarSet, Params, EqvType), !:EqvMap)
+ ;
+ true
+ ).
+
+:- pred replace_in_type_defn(module_name::in, eqv_map::in, type_ctor::in,
+ hlds_type_defn::in, hlds_type_defn::out,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out) is det.
+
+replace_in_type_defn(ModuleName, EqvMap, TypeCtor,
+ Defn0, Defn, !MaybeRecompInfo) :-
+ hlds_data__get_type_defn_tvarset(Defn0, TVarSet0),
+ hlds_data__get_type_defn_body(Defn0, Body0),
+ equiv_type__maybe_record_expanded_items(ModuleName, fst(TypeCtor),
+ !.MaybeRecompInfo, EquivTypeInfo0),
+ (
+ Body0 = du_type(Ctors0, _, _, _, _, _, _),
+ equiv_type__replace_in_ctors(EqvMap, Ctors0, Ctors,
+ TVarSet0, TVarSet, EquivTypeInfo0, EquivTypeInfo),
+ Body = Body0 ^ du_type_ctors := Ctors
+ ;
+ Body0 = eqv_type(Type0),
+ equiv_type__replace_in_type(EqvMap, Type0, Type,
+ TVarSet0, TVarSet, EquivTypeInfo0, EquivTypeInfo),
+ Body = eqv_type(Type)
+ ;
+ Body0 = foreign_type(_, _),
+ EquivTypeInfo = EquivTypeInfo0,
+ Body = Body0,
+ TVarSet = TVarSet0
+ ;
+ Body0 = abstract_type(_),
+ EquivTypeInfo = EquivTypeInfo0,
+ Body = Body0,
+ TVarSet = TVarSet0
+ ),
+ equiv_type__finish_recording_expanded_items(
+ item_id(type_body, TypeCtor), EquivTypeInfo,
+ !MaybeRecompInfo),
+ hlds_data__set_type_defn_body(Defn0, Body, Defn1),
+ hlds_data__set_type_defn_tvarset(Defn1, TVarSet, Defn).
+
+:- pred replace_in_inst_table(eqv_map::in,
+ inst_table::in, inst_table::out) is det.
+
+replace_in_inst_table(EqvMap, !InstTable) :-
+ /*
+ %
+ % We currently have no syntax for typed user-defined insts,
+ % so this is unnecessary.
+ %
+ inst_table_get_user_insts(!.InstTable, UserInsts0),
+ map__map_values(
+ (pred(_::in, Defn0::in, Defn::out) is det :-
+ Body0 = Defn0 ^ inst_body,
+ (
+ Body0 = abstract_inst,
+ Defn = Defn0
+ ;
+ Body0 = eqv_inst(Inst0),
+ % XXX We don't have a valid tvarset here.
+ TVarSet0 = varset__init.
+ replace_in_inst(EqvMap, Inst0, Inst,
+ TVarSet0, _)
+ )
+ ). UserInsts0, UserInsts),
+ inst_table_set_user_insts(!.InstTable, UserInsts, !:InstTable),
+ */
+
+ inst_table_get_unify_insts(!.InstTable, UnifyInsts0),
+ inst_table_get_merge_insts(!.InstTable, MergeInsts0),
+ inst_table_get_ground_insts(!.InstTable, GroundInsts0),
+ inst_table_get_any_insts(!.InstTable, AnyInsts0),
+ inst_table_get_shared_insts(!.InstTable, SharedInsts0),
+ inst_table_get_mostly_uniq_insts(!.InstTable, MostlyUniqInsts0),
+ replace_in_inst_table(replace_in_maybe_inst_det(EqvMap),
+ EqvMap, UnifyInsts0, UnifyInsts),
+ replace_in_merge_inst_table(EqvMap, MergeInsts0, MergeInsts),
+ replace_in_inst_table(replace_in_maybe_inst_det(EqvMap),
+ EqvMap, GroundInsts0, GroundInsts),
+ replace_in_inst_table(replace_in_maybe_inst_det(EqvMap),
+ EqvMap, AnyInsts0, AnyInsts),
+ replace_in_inst_table(replace_in_maybe_inst(EqvMap),
+ EqvMap, SharedInsts0, SharedInsts),
+ replace_in_inst_table(replace_in_maybe_inst(EqvMap),
+ EqvMap, MostlyUniqInsts0, MostlyUniqInsts),
+ inst_table_set_unify_insts(!.InstTable, UnifyInsts, !:InstTable),
+ inst_table_set_merge_insts(!.InstTable, MergeInsts, !:InstTable),
+ inst_table_set_ground_insts(!.InstTable, GroundInsts, !:InstTable),
+ inst_table_set_any_insts(!.InstTable, AnyInsts, !:InstTable),
+ inst_table_set_shared_insts(!.InstTable, SharedInsts, !:InstTable),
+ inst_table_set_mostly_uniq_insts(!.InstTable,
+ MostlyUniqInsts, !:InstTable).
+
+:- pred replace_in_inst_table(pred(T, T)::(pred(in, out) is det), eqv_map::in,
+ map(inst_name, T)::in, map(inst_name, T)::out) is det.
+
+replace_in_inst_table(P, EqvMap, Map0, Map) :-
+ map__to_assoc_list(Map0, AL0),
+ list__map(
+ (pred((Name0 - T0)::in, (Name - T)::out) is det :-
+ % XXX We don't have a valid tvarset here.
+ varset__init(TVarSet),
+ replace_in_inst_name(EqvMap, Name0, Name, TVarSet, _),
+ P(T0, T)
+ ), AL0, AL),
+ map__from_assoc_list(AL, Map).
+
+:- pred replace_in_merge_inst_table(eqv_map::in, merge_inst_table::in,
+ merge_inst_table::out) is det.
+
+replace_in_merge_inst_table(EqvMap, Map0, Map) :-
+ map__to_assoc_list(Map0, AL0),
+ list__map(
+ (pred(((InstA0 - InstB0) - MaybeInst0)::in,
+ ((InstA - InstB) - MaybeInst)::out) is det :-
+ some [!TVarSet] (
+ % XXX We don't have a valid tvarset here.
+ !:TVarSet = varset__init,
+ replace_in_inst(EqvMap, InstA0, InstA,
+ !TVarSet),
+ replace_in_inst(EqvMap, InstB0, InstB,
+ !.TVarSet, _),
+ replace_in_maybe_inst(EqvMap, MaybeInst0,
+ MaybeInst)
+ )
+ ), AL0, AL),
+ map__from_assoc_list(AL, Map).
+
+:- pred replace_in_maybe_inst(eqv_map::in,
+ maybe_inst::in, maybe_inst::out) is det.
+
+replace_in_maybe_inst(_, unknown, unknown).
+replace_in_maybe_inst(EqvMap, known(Inst0), known(Inst)) :-
+ % XXX We don't have a valid tvarset here.
+ varset__init(TVarSet),
+ replace_in_inst(EqvMap, Inst0, Inst, TVarSet, _).
+
+:- pred replace_in_maybe_inst_det(eqv_map::in,
+ maybe_inst_det::in, maybe_inst_det::out) is det.
+
+replace_in_maybe_inst_det(_, unknown, unknown).
+replace_in_maybe_inst_det(EqvMap, known(Inst0, Det), known(Inst, Det)) :-
+ % XXX We don't have a valid tvarset here.
+ varset__init(TVarSet),
+ replace_in_inst(EqvMap, Inst0, Inst, TVarSet, _).
+
+:- pred replace_in_pred(eqv_map::in, pred_id::in,
+ module_info::in, module_info::out) is det.
+
+replace_in_pred(EqvMap, PredId, !ModuleInfo) :-
+ some [!PredInfo, !EquivTypeInfo] (
+ module_info_name(!.ModuleInfo, ModuleName),
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
+ module_info_get_maybe_recompilation_info(!.ModuleInfo,
+ MaybeRecompInfo0),
+
+ PredName = pred_info_name(!.PredInfo),
+ equiv_type__maybe_record_expanded_items(ModuleName,
+ qualified(ModuleName, PredName),
+ MaybeRecompInfo0, !:EquivTypeInfo),
+
+ pred_info_arg_types(!.PredInfo, ArgTVarSet0, ExistQVars, ArgTypes0),
+ list__map_foldl2(equiv_type__replace_in_type(EqvMap),
+ ArgTypes0, ArgTypes, ArgTVarSet0, ArgTVarSet1, !EquivTypeInfo),
+
+ % The constraint_proofs aren't used after polymorphism,
+ % so they don't need to be processed.
+ pred_info_get_class_context(!.PredInfo, ClassContext0),
+ equiv_type__replace_in_class_constraints(EqvMap, ClassContext0,
+ ClassContext, ArgTVarSet1, ArgTVarSet, !EquivTypeInfo),
+ pred_info_set_class_context(ClassContext, !PredInfo),
+ pred_info_set_arg_types(ArgTVarSet, ExistQVars, ArgTypes, !PredInfo),
+
+ ItemId = item_id(pred_or_func_to_item_type(
+ pred_info_is_pred_or_func(!.PredInfo)),
+ qualified(pred_info_module(!.PredInfo), PredName) -
+ pred_info_arity(!.PredInfo)),
+ equiv_type__finish_recording_expanded_items(ItemId,
+ !.EquivTypeInfo, MaybeRecompInfo0, MaybeRecompInfo),
+ module_info_set_maybe_recompilation_info(MaybeRecompInfo,
+ !ModuleInfo),
+
+ pred_info_procedures(!.PredInfo, Procs0),
+ map__map_foldl(replace_in_proc(EqvMap), Procs0, Procs,
+ {!.ModuleInfo, !.PredInfo}, {!:ModuleInfo, !:PredInfo}),
+ pred_info_set_procedures(Procs, !PredInfo),
+
+ module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo)
+ ).
+
+:- pred replace_in_proc(eqv_map::in, proc_id::in,
+ proc_info::in, proc_info::out, {module_info, pred_info}::in,
+ {module_info, pred_info}::out) is det.
+
+replace_in_proc(EqvMap, _, !ProcInfo, {!.ModuleInfo, !.PredInfo},
+ {!:ModuleInfo, !:PredInfo}) :-
+ some [!TVarSet] (
+ pred_info_typevarset(!.PredInfo, !:TVarSet),
+
+ proc_info_argmodes(!.ProcInfo, ArgModes0),
+ list__map_foldl(replace_in_mode(EqvMap),
+ ArgModes0, ArgModes, !TVarSet),
+ proc_info_set_argmodes(ArgModes, !ProcInfo),
+
+ proc_info_maybe_declared_argmodes(!.ProcInfo, MaybeDeclModes0),
+ (
+ MaybeDeclModes0 = yes(DeclModes0),
+ list__map_foldl(replace_in_mode(EqvMap),
+ DeclModes0, DeclModes, !TVarSet),
+ proc_info_set_maybe_declared_argmodes(yes(DeclModes),
+ !ProcInfo)
+ ;
+ MaybeDeclModes0 = no
+ ),
+
+ proc_info_vartypes(!.ProcInfo, VarTypes0),
+ map__map_foldl(
+ (pred(_::in, VarType0::in, VarType::out,
+ !.TVarSet::in, !:TVarSet::out) is det :-
+ equiv_type__replace_in_type(EqvMap,
+ VarType0, VarType, !TVarSet, no, _)
+ ),
+ VarTypes0, VarTypes, !TVarSet),
+ proc_info_set_vartypes(VarTypes, !ProcInfo),
+
+ proc_info_typeclass_info_varmap(!.ProcInfo, TCVarMap0),
+ map__to_assoc_list(TCVarMap0, TCVarAL0),
+ list__map_foldl(
+ (pred((Constraint0 - Locn)::in, (Constraint - Locn)::out,
+ !.TVarSet::in, !:TVarSet::out) is det :-
+ equiv_type__replace_in_class_constraint(EqvMap,
+ Constraint0, Constraint, !TVarSet, no, _)
+ ), TCVarAL0, TCVarAL, !TVarSet),
+ map__from_assoc_list(TCVarAL, TCVarMap),
+ proc_info_set_typeclass_info_varmap(TCVarMap, !ProcInfo),
+
+ proc_info_goal(!.ProcInfo, Goal0),
+ replace_in_goal(EqvMap, Goal0, Goal,
+ replace_info(!.ModuleInfo, !.PredInfo,
+ !.ProcInfo, !.TVarSet, no),
+ replace_info(!:ModuleInfo, !:PredInfo,
+ !:ProcInfo, !:TVarSet, Recompute)),
+ proc_info_set_goal(Goal, !ProcInfo),
+
+ ( Recompute = yes ->
+ requantify_proc(!ProcInfo),
+ recompute_instmap_delta_proc(no, !ProcInfo, !ModuleInfo)
+ ;
+ true
+ ),
+
+ pred_info_set_typevarset(!.TVarSet, !PredInfo)
+ ).
+
+:- pred replace_in_mode(eqv_map::in, (mode)::in, (mode)::out,
+ tvarset::in, tvarset::out) is det.
+
+replace_in_mode(EqvMap, (InstA0 -> InstB0), (InstA -> InstB), !TVarSet) :-
+ replace_in_inst(EqvMap, InstA0, InstA, !TVarSet),
+ replace_in_inst(EqvMap, InstB0, InstB, !TVarSet).
+replace_in_mode(EqvMap, user_defined_mode(Name, Insts0),
+ user_defined_mode(Name, Insts), !TVarSet) :-
+ list__map_foldl(replace_in_inst(EqvMap), Insts0, Insts, !TVarSet).
+
+:- pred replace_in_inst(eqv_map::in, (inst)::in, (inst)::out,
+ tvarset::in, tvarset::out) is det.
+
+replace_in_inst(_, any(_) @ Inst, Inst, !TVarSet).
+replace_in_inst(_, free @ Inst, Inst, !TVarSet).
+replace_in_inst(EqvMap, free(Type0), free(Type), !TVarSet) :-
+ equiv_type__replace_in_type(EqvMap, Type0, Type, !TVarSet, no, _).
+replace_in_inst(EqvMap, bound(Uniq, BoundInsts0),
+ bound(Uniq, BoundInsts), !TVarSet) :-
+ list__map_foldl(
+ (pred(functor(ConsId, Insts0)::in, functor(ConsId, Insts)::out,
+ !.TVarSet::in, !:TVarSet::out) is det :-
+ list__map_foldl(replace_in_inst(EqvMap),
+ Insts0, Insts, !TVarSet)
+ ), BoundInsts0, BoundInsts, !TVarSet).
+replace_in_inst(_, ground(_, none) @ Inst, Inst, !TVarSet).
+replace_in_inst(EqvMap,
+ ground(Uniq, higher_order(pred_inst_info(PorF, Modes0, Det))),
+ ground(Uniq, higher_order(pred_inst_info(PorF, Modes, Det))),
+ !TVarSet) :-
+ list__map_foldl(replace_in_mode(EqvMap), Modes0, Modes, !TVarSet).
+replace_in_inst(_, not_reached @ Inst, Inst, !TVarSet).
+replace_in_inst(_, inst_var(_) @ Inst, Inst, !TVarSet).
+replace_in_inst(EqvMap, constrained_inst_vars(Vars, Inst0),
+ constrained_inst_vars(Vars, Inst), !TVarSet) :-
+ replace_in_inst(EqvMap, Inst0, Inst, !TVarSet).
+replace_in_inst(EqvMap, defined_inst(InstName0),
+ defined_inst(InstName), !TVarSet) :-
+ replace_in_inst_name(EqvMap, InstName0, InstName, !TVarSet).
+replace_in_inst(EqvMap, abstract_inst(Name, Insts0),
+ abstract_inst(Name, Insts), !TVarSet) :-
+ list__map_foldl(replace_in_inst(EqvMap), Insts0, Insts, !TVarSet).
+
+:- pred replace_in_inst_name(eqv_map::in, inst_name::in, inst_name::out,
+ tvarset::in, tvarset::out) is det.
+
+replace_in_inst_name(EqvMap, user_inst(Name, Insts0),
+ user_inst(Name, Insts), !TVarSet) :-
+ list__map_foldl(replace_in_inst(EqvMap), Insts0, Insts, !TVarSet).
+replace_in_inst_name(EqvMap, merge_inst(Name, Inst0),
+ merge_inst(Name, Inst), !TVarSet) :-
+ replace_in_inst(EqvMap, Inst0, Inst, !TVarSet).
+replace_in_inst_name(EqvMap, unify_inst(Live, InstA0, InstB0, Real),
+ unify_inst(Live, InstA, InstB, Real), !TVarSet) :-
+ replace_in_inst(EqvMap, InstA0, InstA, !TVarSet),
+ replace_in_inst(EqvMap, InstB0, InstB, !TVarSet).
+replace_in_inst_name(EqvMap, ground_inst(Name0, Live, Uniq, Real),
+ ground_inst(Name, Live, Uniq, Real), !TVarSet) :-
+ replace_in_inst_name(EqvMap, Name0, Name, !TVarSet).
+replace_in_inst_name(EqvMap, any_inst(Name0, Live, Uniq, Real),
+ any_inst(Name, Live, Uniq, Real), !TVarSet) :-
+ replace_in_inst_name(EqvMap, Name0, Name, !TVarSet).
+replace_in_inst_name(EqvMap, shared_inst(Name0),
+ shared_inst(Name), !TVarSet) :-
+ replace_in_inst_name(EqvMap, Name0, Name, !TVarSet).
+replace_in_inst_name(EqvMap, mostly_uniq_inst(Name0),
+ mostly_uniq_inst(Name), !TVarSet) :-
+ replace_in_inst_name(EqvMap, Name0, Name, !TVarSet).
+replace_in_inst_name(EqvMap, typed_ground(Uniq, Type0),
+ typed_ground(Uniq, Type), !TVarSet) :-
+ replace_in_type(EqvMap, Type0, Type, !TVarSet, no, _).
+replace_in_inst_name(EqvMap, typed_inst(Type0, Name0),
+ typed_inst(Type, Name), !TVarSet) :-
+ replace_in_type(EqvMap, Type0, Type, !TVarSet, no, _),
+ replace_in_inst_name(EqvMap, Name0, Name, !TVarSet).
+
+:- type replace_info
+ ---> replace_info(
+ module_info :: module_info,
+ pred_info :: pred_info,
+ proc_info :: proc_info,
+ tvarset :: tvarset,
+ recompute :: bool
+ ).
+
+:- pred replace_in_goal(eqv_map::in, hlds_goal::in, hlds_goal::out,
+ replace_info::in, replace_info::out) is det.
+
+replace_in_goal(EqvMap, GoalExpr0 - GoalInfo0,
+ GoalExpr - GoalInfo, !Info) :-
+ replace_in_goal_expr(EqvMap, GoalExpr0, GoalExpr, !Info),
+
+ goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
+ TVarSet0 = !.Info ^ tvarset,
+ instmap_delta_map_foldl(
+ (pred(_::in, Inst0::in, Inst::out,
+ !.TVarSet::in, !:TVarSet::out) is det :-
+ replace_in_inst(EqvMap, Inst0, Inst, !TVarSet)
+ ), InstMapDelta0, InstMapDelta, TVarSet0, TVarSet),
+ !:Info = !.Info ^ tvarset := TVarSet,
+ goal_info_set_instmap_delta(GoalInfo0, InstMapDelta, GoalInfo).
+
+:- pred replace_in_goal_expr(eqv_map::in,
+ hlds_goal_expr::in, hlds_goal_expr::out,
+ replace_info::in, replace_info::out) is det.
+
+replace_in_goal_expr(EqvMap, conj(Goals0), conj(Goals), !Info) :-
+ list__map_foldl(replace_in_goal(EqvMap), Goals0, Goals, !Info).
+replace_in_goal_expr(EqvMap, par_conj(Goals0), par_conj(Goals), !Info) :-
+ list__map_foldl(replace_in_goal(EqvMap), Goals0, Goals, !Info).
+replace_in_goal_expr(EqvMap, disj(Goals0), disj(Goals), !Info) :-
+ list__map_foldl(replace_in_goal(EqvMap), Goals0, Goals, !Info).
+replace_in_goal_expr(EqvMap, switch(A, B, Cases0),
+ switch(A, B, Cases), !Info) :-
+ list__map_foldl(
+ (pred(case(ConsId, Goal0)::in, case(ConsId, Goal)::out,
+ !.Info::in, !:Info::out) is det :-
+ replace_in_goal(EqvMap, Goal0, Goal, !Info)
+ ), Cases0, Cases, !Info).
+replace_in_goal_expr(EqvMap, not(Goal0), not(Goal), !Info) :-
+ replace_in_goal(EqvMap, Goal0, Goal, !Info).
+replace_in_goal_expr(EqvMap, some(A, B, Goal0), some(A, B, Goal), !Info) :-
+ replace_in_goal(EqvMap, Goal0, Goal, !Info).
+replace_in_goal_expr(EqvMap, if_then_else(Vars, Cond0, Then0, Else0),
+ if_then_else(Vars, Cond, Then, Else), !Info) :-
+ replace_in_goal(EqvMap, Cond0, Cond, !Info),
+ replace_in_goal(EqvMap, Then0, Then, !Info),
+ replace_in_goal(EqvMap, Else0, Else, !Info).
+replace_in_goal_expr(_, call(_, _, _, _, _, _) @ Goal, Goal, !Info).
+replace_in_goal_expr(EqvMap, foreign_proc(_, _, _, _, _, _, _) @ Goal0, Goal,
+ !Info) :-
+ TVarSet0 = !.Info ^ tvarset,
+ list__map_foldl2(replace_in_type(EqvMap), Goal0 ^ foreign_types,
+ Types, TVarSet0, TVarSet, no, _),
+ !:Info = !.Info ^ tvarset := TVarSet,
+ Goal = Goal0 ^ foreign_types := Types.
+replace_in_goal_expr(EqvMap, generic_call(A, B, Modes0, D),
+ generic_call(A, B, Modes, D), !Info) :-
+ TVarSet0 = !.Info ^ tvarset,
+ list__map_foldl(replace_in_mode(EqvMap), Modes0, Modes,
+ TVarSet0, TVarSet),
+ !:Info = !.Info ^ tvarset := TVarSet.
+replace_in_goal_expr(EqvMap, unify(Var, _, _, _, _) @ Goal0, Goal, !Info) :-
+ module_info_types(!.Info ^ module_info, Types),
+ proc_info_vartypes(!.Info ^ proc_info, VarTypes),
+ map__lookup(VarTypes, Var, VarType),
+ classify_type(!.Info ^ module_info, VarType) = TypeCat,
+ (
+ %
+ % If this goal constructs a type_info for an equivalence
+ % type, we need to expand that to make the type_info for
+ % the expanded type. It's simpler to just recreate the
+ % type-info from scratch.
+ %
+ Goal0 ^ unify_kind = construct(_, ConsId, _, _, _, _, _),
+ ConsId = type_info_cell_constructor(TypeCtor),
+ TypeCat = type_info_type,
+ map__search(Types, TypeCtor, TypeDefn),
+ hlds_data__get_type_defn_body(TypeDefn, Body),
+ Body = eqv_type(_),
+ type_to_ctor_and_args(VarType, _TypeInfoCtor,
+ [TypeInfoArgType])
+ ->
+ pred_info_set_typevarset(!.Info ^ tvarset,
+ !.Info ^ pred_info, PredInfo0),
+ create_poly_info(!.Info ^ module_info,
+ PredInfo0, !.Info ^ proc_info, PolyInfo0),
+ polymorphism__make_type_info_var(TypeInfoArgType,
+ term__context_init, TypeInfoVar,
+ Goals0, PolyInfo0, PolyInfo),
+ poly_info_extract(PolyInfo, PredInfo0, PredInfo,
+ !.Info ^ proc_info, ProcInfo, ModuleInfo),
+ pred_info_typevarset(PredInfo, TVarSet),
+ !:Info = (((!.Info ^ pred_info := PredInfo)
+ ^ proc_info := ProcInfo)
+ ^ module_info := ModuleInfo)
+ ^ tvarset := TVarSet,
+
+ goal_util__rename_vars_in_goals(Goals0, no,
+ map__from_assoc_list([TypeInfoVar - Var]),
+ Goals),
+ ( Goals = [Goal1 - _] ->
+ Goal = Goal1
+ ;
+ Goal = conj(Goals)
+ ),
+ !:Info = !.Info ^ recompute := yes
+ ;
+ %
+ % Check for a type_ctor_info for an equivalence type.
+ % We can just remove these because after the code above
+ % to fix up type_infos for equivalence types they can't
+ % be used.
+ %
+ Goal0 ^ unify_kind = construct(_, ConsId, _, _, _, _, _),
+ ConsId = type_info_cell_constructor(TypeCtor),
+ TypeCat = type_ctor_info_type,
+ map__search(Types, TypeCtor, TypeDefn),
+ hlds_data__get_type_defn_body(TypeDefn, Body),
+ Body = eqv_type(_)
+ ->
+ Goal = conj([]),
+ !:Info = !.Info ^ recompute := yes
+ ;
+ Goal0 ^ unify_mode = LMode0 - RMode0,
+ TVarSet0 = !.Info ^ tvarset,
+ replace_in_mode(EqvMap, LMode0, LMode, TVarSet0, TVarSet1),
+ replace_in_mode(EqvMap, RMode0, RMode, TVarSet1, TVarSet),
+ !:Info = !.Info ^ tvarset := TVarSet,
+ replace_in_unification(EqvMap, Goal0 ^ unify_kind, Unification,
+ !Info),
+ Goal = (Goal0 ^ unify_mode := LMode - RMode)
+ ^ unify_kind := Unification
+ ).
+replace_in_goal_expr(_, shorthand(_), _, !Info) :-
+ error("replace_in_goal_expr: shorthand").
+
+:- pred replace_in_unification(eqv_map::in, unification::in, unification::out,
+ replace_info::in, replace_info::out) is det.
+
+replace_in_unification(_, assign(_, _) @ Uni, Uni, !Info).
+replace_in_unification(_, simple_test(_, _) @ Uni, Uni, !Info).
+replace_in_unification(EqvMap, complicated_unify(UniMode0, B, C),
+ complicated_unify(UniMode, B, C), !Info) :-
+ replace_in_uni_mode(EqvMap, UniMode0, UniMode, !Info).
+replace_in_unification(EqvMap, construct(_, _, _, _, _, _, _) @ Uni0, Uni,
+ !Info) :-
+ list__map_foldl(replace_in_uni_mode(EqvMap),
+ Uni0 ^ construct_arg_modes, UniModes, !Info),
+ Uni = Uni0 ^ construct_arg_modes := UniModes.
+replace_in_unification(EqvMap, deconstruct(_, _, _, _, _, _) @ Uni0, Uni,
+ !Info) :-
+ list__map_foldl(replace_in_uni_mode(EqvMap),
+ Uni0 ^ deconstruct_arg_modes, UniModes, !Info),
+ Uni = Uni0 ^ deconstruct_arg_modes := UniModes.
+
+:- pred replace_in_uni_mode(eqv_map::in, uni_mode::in, uni_mode::out,
+ replace_info::in, replace_info::out) is det.
+
+replace_in_uni_mode(EqvMap, ((InstA0 - InstB0) -> (InstC0 - InstD0)),
+ ((InstA - InstB) -> (InstC - InstD)), !Info) :-
+ some [!TVarSet] (
+ !:TVarSet = !.Info ^ tvarset,
+ replace_in_inst(EqvMap, InstA0, InstA, !TVarSet),
+ replace_in_inst(EqvMap, InstB0, InstB, !TVarSet),
+ replace_in_inst(EqvMap, InstC0, InstC, !TVarSet),
+ replace_in_inst(EqvMap, InstD0, InstD, !TVarSet),
+ !:Info = !.Info ^ tvarset := !.TVarSet
+ ).
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.70
diff -u -u -r1.70 export.m
--- compiler/export.m 24 Oct 2003 06:17:37 -0000 1.70
+++ compiler/export.m 24 Nov 2003 14:33:23 -0000
@@ -81,8 +81,6 @@
:- import_module libs__globals.
:- import_module libs__options.
:- import_module ll_backend__arg_info.
-:- import_module ll_backend__code_gen.
-:- import_module ll_backend__code_util.
:- import_module parse_tree__modules.
:- import_module term, varset.
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.55
diff -u -u -r1.55 globals.m
--- compiler/globals.m 16 Mar 2003 08:01:27 -0000 1.55
+++ compiler/globals.m 24 Nov 2003 14:33:23 -0000
@@ -229,8 +229,6 @@
:- implementation.
-:- import_module ll_backend__exprn_aux.
-
:- import_module map, std_util, require, string.
convert_target(String, Target) :-
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.191
diff -u -u -r1.191 handle_options.m
--- compiler/handle_options.m 12 Nov 2003 16:15:53 -0000 1.191
+++ compiler/handle_options.m 24 Nov 2003 14:33:23 -0000
@@ -72,10 +72,8 @@
:- implementation.
-:- import_module backend_libs__foreign.
-:- import_module check_hlds__unify_proc.
:- import_module libs__trace_params.
-:- import_module parse_tree__prog_data.
+:- import_module parse_tree.
:- import_module parse_tree__prog_io_util.
:- import_module char, dir, int, string, map, set, library.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.113
diff -u -u -r1.113 higher_order.m
--- compiler/higher_order.m 31 Oct 2003 03:27:22 -0000 1.113
+++ compiler/higher_order.m 26 Nov 2003 13:12:37 -0000
@@ -713,7 +713,7 @@
Params ^ user_type_spec.
is_interesting_cons_id(Params, base_typeclass_info_const(_, _, _, _)) =
Params ^ user_type_spec.
-is_interesting_cons_id(Params, type_info_cell_constructor) =
+is_interesting_cons_id(Params, type_info_cell_constructor(_)) =
Params ^ user_type_spec.
is_interesting_cons_id(Params, typeclass_info_cell_constructor) =
Params ^ user_type_spec.
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.8
diff -u -u -r1.8 hlds_code_util.m
--- compiler/hlds_code_util.m 25 Jul 2003 02:27:19 -0000 1.8
+++ compiler/hlds_code_util.m 26 Nov 2003 13:04:30 -0000
@@ -55,7 +55,7 @@
type_ctor_info_constant(M,T,A).
cons_id_to_tag(base_typeclass_info_const(M,C,_,N), _, _) =
base_typeclass_info_constant(M,C,N).
-cons_id_to_tag(type_info_cell_constructor, _, _) = unshared_tag(0).
+cons_id_to_tag(type_info_cell_constructor(_), _, _) = unshared_tag(0).
cons_id_to_tag(typeclass_info_cell_constructor, _, _) = unshared_tag(0).
cons_id_to_tag(tabling_pointer_const(PredId,ProcId), _, _) =
tabling_pointer_constant(PredId,ProcId).
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.80
diff -u -u -r1.80 hlds_data.m
--- compiler/hlds_data.m 24 Oct 2003 04:41:47 -0000 1.80
+++ compiler/hlds_data.m 26 Nov 2003 13:04:51 -0000
@@ -50,7 +50,8 @@
% class instance, a string encoding the type
% names and arities of the arguments to the
% instance declaration
- ; type_info_cell_constructor
+ ; type_info_cell_constructor(type_ctor)
+ % module name, type name, type arity
; typeclass_info_cell_constructor
; tabling_pointer_const(pred_id, proc_id)
% The address of the static variable
@@ -201,7 +202,7 @@
error("cons_id_arity: can't get arity of type_ctor_info_const").
cons_id_arity(base_typeclass_info_const(_, _, _, _), _) :-
error("cons_id_arity: can't get arity of base_typeclass_info_const").
-cons_id_arity(type_info_cell_constructor, _) :-
+cons_id_arity(type_info_cell_constructor(_), _) :-
error("cons_id_arity: can't get arity of type_info_cell_constructor").
cons_id_arity(typeclass_info_cell_constructor, _) :-
error("cons_id_arity: can't get arity of typeclass_info_cell_constructor").
@@ -219,7 +220,7 @@
cons_id_maybe_arity(pred_const(_, _, _), no) .
cons_id_maybe_arity(type_ctor_info_const(_, _, _), no) .
cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _), no).
-cons_id_maybe_arity(type_info_cell_constructor, no) .
+cons_id_maybe_arity(type_info_cell_constructor(_), no) .
cons_id_maybe_arity(typeclass_info_cell_constructor, no) .
cons_id_maybe_arity(tabling_pointer_const(_, _), no).
cons_id_maybe_arity(deep_profiling_proc_static(_), no).
@@ -303,6 +304,10 @@
hlds_type_defn).
:- mode hlds_data__set_type_defn_body(in, in, out) is det.
+:- pred hlds_data__set_type_defn_tvarset(hlds_type_defn, tvarset,
+ hlds_type_defn).
+:- mode hlds_data__set_type_defn_tvarset(in, in, out) is det.
+
% An `hlds_type_body' holds the body of a type definition:
% du = discriminated union, uu = undiscriminated union,
% eqv_type = equivalence type (a type defined to be equivalent
@@ -591,6 +596,8 @@
hlds_data__get_type_defn_context(Defn, Defn ^ type_defn_context).
hlds_data__set_type_defn_body(Defn, Body, Defn ^ type_defn_body := Body).
+hlds_data__set_type_defn_tvarset(Defn, TVarSet,
+ Defn ^ type_defn_tvarset := TVarSet).
hlds_data__set_type_defn_status(Defn, Status,
Defn ^ type_defn_import_status := Status).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.319
diff -u -u -r1.319 hlds_out.m
--- compiler/hlds_out.m 5 Nov 2003 03:17:37 -0000 1.319
+++ compiler/hlds_out.m 26 Nov 2003 13:05:30 -0000
@@ -331,7 +331,7 @@
hlds_out__cons_id_to_string(type_ctor_info_const(_, _, _), "<type_ctor_info>").
hlds_out__cons_id_to_string(base_typeclass_info_const(_, _, _, _),
"<base_typeclass_info>").
-hlds_out__cons_id_to_string(type_info_cell_constructor,
+hlds_out__cons_id_to_string(type_info_cell_constructor(_),
"<type_info_cell_constructor>").
hlds_out__cons_id_to_string(typeclass_info_cell_constructor,
"<typeclass_info_cell_constructor>").
@@ -355,7 +355,7 @@
io__write_string("<type_ctor_info>").
hlds_out__write_cons_id(base_typeclass_info_const(_, _, _, _)) -->
io__write_string("<base_typeclass_info>").
-hlds_out__write_cons_id(type_info_cell_constructor) -->
+hlds_out__write_cons_id(type_info_cell_constructor(_)) -->
io__write_string("<type_info_cell_constructor>").
hlds_out__write_cons_id(typeclass_info_cell_constructor) -->
io__write_string("<typeclass_info_cell_constructor>").
@@ -2504,7 +2504,7 @@
io__write_string(Instance),
io__write_string(")")
;
- { ConsId = type_info_cell_constructor },
+ { ConsId = type_info_cell_constructor(_) },
hlds_out__write_functor(
term__atom("type_info_cell_constructor"),
ArgVars, VarSet, AppendVarnums, next_to_graphic_token)
@@ -2732,6 +2732,8 @@
io__write_string("imported in the interface").
hlds_out__write_import_status(imported(implementation)) -->
io__write_string("imported in the implementation").
+hlds_out__write_import_status(imported(ancestor_private_interface)) -->
+ io__write_string("imported from an ancestor's private interface").
hlds_out__write_import_status(imported(ancestor)) -->
io__write_string("imported by an ancestor").
hlds_out__write_import_status(external(interface)) -->
@@ -3190,7 +3192,8 @@
hlds_out__write_superclasses(Indent, SuperClassTable) -->
hlds_out__write_indent(Indent),
io__write_string("%-------- Super Classes --------\n"),
- { multi_map__to_assoc_list(SuperClassTable, SuperClassTableList) },
+ { multi_map__to_multi_assoc_list(SuperClassTable,
+ SuperClassTableList) },
io__write_list(SuperClassTableList, "\n\n",
hlds_out__write_superclass(Indent)),
io__nl.
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.135
diff -u -u -r1.135 hlds_pred.m
--- compiler/hlds_pred.m 5 Nov 2003 03:17:38 -0000 1.135
+++ compiler/hlds_pred.m 26 Nov 2003 10:09:21 -0000
@@ -1758,6 +1758,9 @@
:- pred proc_info_maybe_declared_argmodes(proc_info::in,
maybe(list(mode))::out) is det.
+:- pred proc_info_set_maybe_declared_argmodes(maybe(list(mode))::in,
+ proc_info::in, proc_info::out) is det.
+
:- pred proc_info_declared_argmodes(proc_info::in, list(mode)::out) is det.
:- pred proc_info_is_address_taken(proc_info::in, is_address_taken::out)
@@ -2196,6 +2199,8 @@
proc_info_set_vartypes(VT, ProcInfo, ProcInfo ^ var_types := VT).
proc_info_set_headvars(HV, ProcInfo, ProcInfo ^ head_vars := HV).
proc_info_set_argmodes(AM, ProcInfo, ProcInfo ^ actual_head_modes := AM).
+proc_info_set_maybe_declared_argmodes(AM, ProcInfo,
+ ProcInfo ^ maybe_declared_head_modes := AM).
proc_info_set_inst_varset(IV, ProcInfo, ProcInfo ^ inst_varset := IV).
proc_info_set_maybe_arglives(CL, ProcInfo,
ProcInfo ^ head_var_caller_liveness := CL).
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.32
diff -u -u -r1.32 instmap.m
--- compiler/instmap.m 6 Nov 2003 03:42:35 -0000 1.32
+++ compiler/instmap.m 24 Nov 2003 14:33:23 -0000
@@ -306,6 +306,12 @@
:- pred instmap_delta_to_assoc_list(instmap_delta, assoc_list(prog_var, inst)).
:- mode instmap_delta_to_assoc_list(in, out) is det.
+ % Apply the specified procedure to all insts in an instmap_delta.
+:- pred instmap_delta_map_foldl(pred(prog_var, inst, inst, T, T),
+ instmap_delta, instmap_delta, T, T).
+:- mode instmap_delta_map_foldl((pred(in, in, out, in, out) is det),
+ in, out, in, out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -359,6 +365,11 @@
instmap_delta_from_assoc_list(AL, reachable(Instmapping)) :-
map__from_assoc_list(AL, Instmapping).
+
+instmap_delta_map_foldl(_, unreachable, unreachable, T, T).
+instmap_delta_map_foldl(P, reachable(Instmapping0), reachable(Instmapping),
+ T0, T) :-
+ map__map_foldl(P, Instmapping0, Instmapping, T0, T).
%-----------------------------------------------------------------------------%
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.151
diff -u -u -r1.151 intermod.m
--- compiler/intermod.m 5 Nov 2003 03:17:38 -0000 1.151
+++ compiler/intermod.m 24 Nov 2003 14:33:23 -0000
@@ -1325,7 +1325,8 @@
{ Body = foreign_type(_, IsSolverType) },
{ TypeBody = abstract_type(IsSolverType) }
),
- mercury_output_item(type_defn(VarSet, Name, Args, TypeBody, true),
+ mercury_output_item(
+ type_defn(VarSet, Name, Args, TypeBody, true),
Context),
(
@@ -1336,26 +1337,28 @@
MaybeJava) }
->
( { MaybeIL = yes(ILForeignType - ILUserEqComp) },
- mercury_output_item(pragma(
- foreign_type(il(ILForeignType), VarSet,
- Name, Args, ILUserEqComp)),
+ mercury_output_item(
+ type_defn(VarSet, Name, Args,
+ foreign_type(il(ILForeignType),
+ ILUserEqComp), true),
Context)
; { MaybeIL = no },
[]
),
( { MaybeC = yes(CForeignType - CUserEqComp) },
- mercury_output_item(pragma(
- foreign_type(c(CForeignType), VarSet,
- Name, Args, CUserEqComp)),
+ mercury_output_item(
+ type_defn(VarSet, Name, Args,
+ foreign_type(c(CForeignType),
+ CUserEqComp), true),
Context)
; { MaybeC = no },
[]
),
( { MaybeJava = yes(JavaForeignType - JavaUserEqComp) },
- mercury_output_item(pragma(
- foreign_type(
- java(JavaForeignType),
- VarSet, Name, Args, JavaUserEqComp)),
+ mercury_output_item(
+ type_defn(VarSet, Name, Args,
+ foreign_type(java(JavaForeignType),
+ JavaUserEqComp), true),
Context)
; { MaybeJava = no },
[]
@@ -2232,8 +2235,7 @@
% make_hlds know the opt_imported stuff is coming.
%
{ module_imports_get_items(Module0, Items0) },
- { make_pseudo_decl(opt_imported, OptImportedDecl) },
- { list__append(Items0, [OptImportedDecl | OptItems], Items1) },
+ { Items1 = Items0 ++ [make_pseudo_decl(opt_imported) | OptItems] },
{ module_imports_set_items(Module0, Items1, Module1) },
%
@@ -2268,8 +2270,10 @@
list__condense(list__map(get_ancestors, OptFiles)),
ModuleName) },
process_module_private_interfaces(ReadModules, Int0Files,
- [], AncestorImports1, [], AncestorImports2,
- Module2, Module3),
+ make_pseudo_decl(opt_imported),
+ make_pseudo_decl(opt_imported),
+ [], AncestorImports1,
+ [], AncestorImports2, Module2, Module3),
%
% Figure out which .int files are needed by the .opt files
@@ -2288,9 +2292,17 @@
%
{ map__init(ReadModules) },
process_module_long_interfaces(ReadModules, must_be_qualified, NewDeps,
- ".int", [], NewIndirectDeps, Module3, Module4),
- process_module_short_interfaces_transitively(ReadModules,
- NewIndirectDeps, ".int2", Module4, Module),
+ ".int",
+ make_pseudo_decl(opt_imported),
+ make_pseudo_decl(opt_imported),
+ [], NewIndirectDeps, [], NewImplIndirectDeps,
+ Module3, Module4),
+ process_module_short_interfaces_and_implementations_transitively(
+ ReadModules, NewIndirectDeps ++ NewImplIndirectDeps,
+ ".int2",
+ make_pseudo_decl(opt_imported),
+ make_pseudo_decl(opt_imported),
+ Module4, Module),
%
% Figure out whether anything went wrong
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.35
diff -u -u -r1.35 magic_util.m
--- compiler/magic_util.m 11 Nov 2003 03:23:26 -0000 1.35
+++ compiler/magic_util.m 25 Nov 2003 12:46:50 -0000
@@ -19,7 +19,7 @@
:- import_module hlds__hlds_pred.
:- import_module parse_tree__prog_data.
-:- import_module bool, io, list, map, set, std_util.
+:- import_module bool, io, list, map, set, std_util, term.
% Check that the argument types and modes are legal for
% an Aditi relation.
@@ -130,7 +130,6 @@
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_out.
:- import_module hlds__instmap.
-:- import_module ll_backend__code_util.
:- import_module parse_tree__inst.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_util.
Index: compiler/make.dependencies.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.dependencies.m,v
retrieving revision 1.13
diff -u -u -r1.13 make.dependencies.m
--- compiler/make.dependencies.m 24 Sep 2003 06:35:26 -0000 1.13
+++ compiler/make.dependencies.m 24 Nov 2003 14:33:23 -0000
@@ -483,7 +483,7 @@
{ Info = Info1 }
;
foldl3_maybe_stop_at_error(Info1 ^ keep_going,
- union_deps(find_transitive_interface_imports),
+ union_deps(find_transitive_implementation_imports),
set__to_sorted_list(DirectImports), IndirectSuccess,
set__init, IndirectImports0, Info1, Info),
{ IndirectImports = set__difference(
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.454
diff -u -u -r1.454 make_hlds.m
--- compiler/make_hlds.m 21 Nov 2003 15:21:31 -0000 1.454
+++ compiler/make_hlds.m 28 Nov 2003 05:39:33 -0000
@@ -30,7 +30,7 @@
:- import_module parse_tree__module_qual.
:- import_module parse_tree__prog_data.
-:- import_module bool, list, io, std_util.
+:- import_module bool, list, io, std_util, term.
% parse_tree_to_hlds(ParseTree, MQInfo, EqvMap, HLDS, QualInfo,
% InvalidTypes, InvalidModes):
@@ -368,7 +368,7 @@
!.Status = item_status(IStat, _),
(
( status_defined_in_this_module(IStat, yes)
- ; IStat = imported(ancestor)
+ ; IStat = imported(ancestor_private_interface)
)
->
module_add_imported_module_specifiers(Specifiers,
@@ -442,8 +442,8 @@
true
).
-add_item_decl_pass_2(type_defn(VarSet, Name, Args, TypeDefn, Cond), Context,
- !Status, !Module, !IO) :-
+add_item_decl_pass_2(type_defn(VarSet, Name, Args, TypeDefn, Cond),
+ Context, !Status, !Module, !IO) :-
module_add_type_defn(VarSet, Name, Args, TypeDefn,
Cond, Context, !.Status, !Module, !IO).
@@ -483,14 +483,6 @@
% clauses).
Pragma = foreign_proc(_, _, _, _, _, _)
;
- % Note that we check during process_type_defn that we have
- % defined a foreign_type which is usable by the back-end
- % we are compiling on.
- Pragma = foreign_type(ForeignType, TVarSet, Name, Args,
- UserEqComp),
- add_pragma_foreign_type(Context, !.Status, ForeignType,
- TVarSet, Name, Args, UserEqComp, !Module, !IO)
- ;
% Handle pragma tabled decls later on (when we process
% clauses).
Pragma = tabled(_, _, _, _, _)
@@ -687,6 +679,8 @@
item_status(imported(Section), must_be_qualified)).
module_defn_update_import_status(opt_imported,
item_status(opt_imported, must_be_qualified)).
+module_defn_update_import_status(abstract_imported,
+ item_status(abstract_imported, must_be_qualified)).
%-----------------------------------------------------------------------------%
@@ -954,69 +948,6 @@
%-----------------------------------------------------------------------------%
-:- pred add_pragma_foreign_type(prog_context::in, item_status::in,
- foreign_language_type::in, tvarset::in, sym_name::in,
- list(type_param)::in, maybe(unify_compare)::in,
- module_info::in, module_info::out, io__state::di, io__state::uo)
- is det.
-
-add_pragma_foreign_type(Context, item_status(ImportStatus, NeedQual),
- ForeignType, TVarSet, Name, Args, UserEqComp, !Module, !IO) :-
- IsSolverType = non_solver_type,
- ( ForeignType = il(ILForeignType),
- Body = foreign_type(
- foreign_type_body(yes(ILForeignType - UserEqComp),
- no, no), IsSolverType)
- ; ForeignType = c(CForeignType),
- Body = foreign_type(foreign_type_body(no,
- yes(CForeignType - UserEqComp), no),
- IsSolverType)
- ; ForeignType = java(JavaForeignType),
- Body = foreign_type(foreign_type_body(no, no,
- yes(JavaForeignType - UserEqComp)),
- IsSolverType)
- ),
- Cond = true,
-
- Arity = list__length(Args),
- TypeCtor = Name - Arity,
- module_info_types(!.Module, Types),
- TypeStr = error_util__describe_sym_name_and_arity(Name / Arity),
- ( map__search(Types, TypeCtor, OldDefn) ->
- hlds_data__get_type_defn_status(OldDefn, OldStatus),
- hlds_data__get_type_defn_body(OldDefn, OldBody),
- (
- OldBody = abstract_type(_),
- status_is_exported_to_non_submodules(OldStatus, no),
- status_is_exported_to_non_submodules(ImportStatus, yes)
- ->
- ErrorPieces = [
- words("Error: pragma foreign_type "),
- fixed(TypeStr),
- words(
- "must have the same visibility as the type declaration.")
- ],
- error_util__write_error_pieces(Context, 0,
- ErrorPieces, !IO),
- module_info_incr_errors(!Module)
- ;
- module_info_contains_foreign_type(!Module),
- module_add_type_defn_2(TVarSet, Name, Args, Body, Cond,
- Context, item_status(ImportStatus, NeedQual),
- !Module, !IO)
- )
- ;
- ErrorPieces = [
- words("Error: type "),
- fixed(TypeStr),
- words("defined as foreign_type without being declared.")
- ],
- error_util__write_error_pieces(Context, 0, ErrorPieces, !IO),
- module_info_incr_errors(!Module)
- ).
-
-%-----------------------------------------------------------------------------%
-
:- pred add_pragma_reserve_tag(sym_name, arity, import_status, prog_context,
module_info, module_info, io__state, io__state).
:- mode add_pragma_reserve_tag(in, in, in, in, in, out, di, uo) is det.
@@ -2168,26 +2099,13 @@
:- mode module_add_type_defn(in, in, in, in, in,
in, in, in, out, di, uo) is det.
-module_add_type_defn(TVarSet, Name, Args, TypeDefn, Cond, Context,
+module_add_type_defn(TVarSet, Name, Args, TypeDefn, _Cond, Context,
item_status(Status0, NeedQual), !Module, !IO) :-
globals__io_get_globals(Globals, !IO),
list__length(Args, Arity),
TypeCtor = Name - Arity,
- convert_type_defn(TypeDefn, TypeCtor, Globals, Body),
- module_add_type_defn_2(TVarSet, Name, Args, Body, Cond,
- Context, item_status(Status0, NeedQual), !Module, !IO).
-
-:- pred module_add_type_defn_2(tvarset, sym_name, list(type_param),
- hlds_type_body, condition, prog_context, item_status,
- module_info, module_info, io__state, io__state).
-:- mode module_add_type_defn_2(in, in, in, in, in,
- in, in, in, out, di, uo) is det.
-
-module_add_type_defn_2(TVarSet, Name, Args, Body0, _Cond, Context,
- item_status(Status0, NeedQual), !Module, !IO) :-
+ convert_type_defn(TypeDefn, TypeCtor, Globals, Body0),
module_info_types(!.Module, Types0),
- list__length(Args, Arity),
- TypeCtor = Name - Arity,
(
(
Body0 = abstract_type(_)
@@ -2240,6 +2158,39 @@
hlds_data__set_type_defn(TVarSet, Args, Body, Status,
NeedQual, Context, T),
(
+ MaybeOldDefn = no,
+ Body = foreign_type(_, _)
+ ->
+ TypeStr = error_util__describe_sym_name_and_arity(
+ Name / Arity),
+ ErrorPieces = [
+ words("Error: type "),
+ fixed(TypeStr),
+ words("defined as foreign_type without being declared.")
+ ],
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO),
+ module_info_incr_errors(!Module)
+ ;
+ MaybeOldDefn = yes(OldDefn1),
+ Body = foreign_type(_, _),
+ hlds_data__get_type_defn_status(OldDefn1, OldStatus1),
+ hlds_data__get_type_defn_body(OldDefn1, OldBody1),
+ OldBody1 = abstract_type(_),
+ status_is_exported_to_non_submodules(OldStatus1, no),
+ status_is_exported_to_non_submodules(Status0, yes)
+ ->
+ TypeStr = error_util__describe_sym_name_and_arity(
+ Name / Arity),
+ ErrorPieces = [
+ words("Error: pragma foreign_type "),
+ fixed(TypeStr),
+ words(
+ "must have the same visibility as the type declaration.")
+ ],
+ error_util__write_error_pieces(Context, 0, ErrorPieces, !IO),
+ module_info_incr_errors(!Module)
+ ;
+
% if there was an existing non-abstract definition for the type
MaybeOldDefn = yes(T2),
hlds_data__get_type_defn_tvarset(T2, TVarSet_2),
@@ -2253,6 +2204,11 @@
globals__io_get_target(Target, !IO),
globals__io_lookup_bool_option(make_optimization_interface,
MakeOptInt, !IO),
+ ( Body = foreign_type(_, _) ->
+ module_info_contains_foreign_type(!Module)
+ ;
+ true
+ ),
(
% then if this definition was abstract, ignore it
% (but update the status of the old defn if necessary)
@@ -2341,6 +2297,8 @@
)
).
+%-----------------------------------------------------------------------------%
+
% We do not have syntax for adding `solver' annotations to
% `:- pragma foreign_type' declarations, so foreign_type bodies
% default to having an is_solver_type field of `non_solver_type'.
@@ -2698,6 +2656,18 @@
convert_type_defn(eqv_type(Body), _, _, eqv_type(Body)).
convert_type_defn(abstract_type(IsSolverType), _, _,
abstract_type(IsSolverType)).
+convert_type_defn(foreign_type(ForeignType, UserEqComp), _, _,
+ foreign_type(Body, non_solver_type)) :-
+ ( ForeignType = il(ILForeignType),
+ Body = foreign_type_body(yes(ILForeignType - UserEqComp),
+ no, no)
+ ; ForeignType = c(CForeignType),
+ Body = foreign_type_body(no,
+ yes(CForeignType - UserEqComp), no)
+ ; ForeignType = java(JavaForeignType),
+ Body = foreign_type_body(no, no,
+ yes(JavaForeignType - UserEqComp))
+ ).
:- pred ctors_add(list(constructor), type_ctor, tvarset, need_qualifier,
partial_qualifier_info, prog_context, import_status,
@@ -8141,7 +8111,12 @@
term__apply_variable_renaming(Type1, TVarRenaming, Type2),
% Expand equivalence types.
- equiv_type__replace_in_type(Type2, TVarSet1, EqvMap, Type, TVarSet)
+ % We don't need to record the expanded types for smart recompilation
+ % because at the moment no recompilation.item_id can depend on a
+ % clause item.
+ RecordExpanded = no,
+ equiv_type__replace_in_type(EqvMap, Type2, Type, TVarSet1, TVarSet,
+ RecordExpanded, _)
},
update_var_types(VarTypes0, Var, Type, Context, VarTypes),
{ Info = Info0 ^ qual_info := qual_info(EqvMap, TVarSet, TVarRenaming,
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.294
diff -u -u -r1.294 mercury_compile.m
--- compiler/mercury_compile.m 5 Nov 2003 03:17:40 -0000 1.294
+++ compiler/mercury_compile.m 27 Nov 2003 01:22:36 -0000
@@ -62,6 +62,7 @@
:- import_module check_hlds__check_typeclass.
:- import_module transform_hlds__intermod.
:- import_module transform_hlds__trans_opt.
+:- import_module transform_hlds__equiv_type_hlds.
:- import_module transform_hlds__table_gen.
:- import_module transform_hlds__lambda.
:- import_module backend_libs__type_ctor_info.
@@ -1286,7 +1287,7 @@
HLDS1, QualInfo, MaybeTimestamps, UndefTypes, UndefModes,
Errors1),
mercury_compile__frontend_pass(HLDS1, QualInfo, UndefTypes,
- UndefModes, HLDS20, Errors2),
+ UndefModes, Errors1, HLDS20, Errors2),
( { Errors1 = no }, { Errors2 = no } ->
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
@@ -1747,14 +1748,12 @@
%-----------------------------------------------------------------------------%
:- pred mercury_compile__frontend_pass(module_info, qual_info, bool, bool,
- module_info, bool, io__state, io__state).
-% :- mode mercury_compile__frontend_pass(di, in, in, in, uo, out, di, uo)
-% is det.
-:- mode mercury_compile__frontend_pass(in, in, in, in, out, out, di, uo)
+ bool, module_info, bool, io__state, io__state).
+:- mode mercury_compile__frontend_pass(in, in, in, in, in, out, out, di, uo)
is det.
mercury_compile__frontend_pass(HLDS1, QualInfo0, FoundUndefTypeError,
- FoundUndefModeError, HLDS, FoundError) -->
+ FoundUndefModeError, FoundError0, HLDS, FoundError) -->
%
% We can't continue after an undefined type error, since
% typecheck would get internal errors
@@ -1851,8 +1850,10 @@
{ bool__or(FoundTypeError, FoundTypeclassError,
FoundError) }
;
- { FoundTypeError = yes ; FoundPostTypecheckError = yes
- ; FoundTypeclassError = yes }
+ { FoundTypeError = yes
+ ; FoundPostTypecheckError = yes
+ ; FoundTypeclassError = yes
+ }
->
%
% XXX it would be nice if we could go on and mode-check
@@ -1864,9 +1865,11 @@
{ HLDS = HLDS4 },
{ FoundError = yes }
;
- % only write out the `.opt' file if there are no type errors
- % or undefined modes
- ( { FoundTypeError = no, FoundUndefModeError = no } ->
+ % only write out the `.opt' file if there are no errors
+ (
+ { FoundError0 = no },
+ { FoundUndefModeError = no }
+ ->
mercury_compile__maybe_write_optfile(MakeOptInt,
HLDS4, HLDS5)
;
@@ -1885,10 +1888,9 @@
%
mercury_compile__frontend_pass_2_by_phases(HLDS5,
HLDS, FoundModeOrDetError),
- { bool__or(FoundTypeError, FoundModeOrDetError,
- FoundError0) },
- { bool__or(FoundError0, FoundTypeclassError,
- FoundError) }
+ { FoundError = FoundTypeError
+ `or` FoundModeOrDetError
+ `or` FoundTypeclassError }
)
)
)
@@ -2097,6 +2099,9 @@
mercury_compile__process_lambdas(HLDS25, Verbose, HLDS26),
mercury_compile__maybe_dump_hlds(HLDS26, "26", "lambda"),
+ mercury_compile__expand_equiv_types_hlds(HLDS26, Verbose, HLDS27),
+ mercury_compile__maybe_dump_hlds(HLDS26, "27", "equiv_types"),
+
%
% Uncomment the following code to check that unique mode analysis
% works after simplification has been run. Currently it does not
@@ -2106,7 +2111,6 @@
% after optimizations because deforestation reruns it.
%
- { HLDS27 = HLDS26 },
%mercury_compile__check_unique_modes(HLDS26, Verbose, Stats,
% HLDS27, FoundUniqError),
%
@@ -2952,6 +2956,19 @@
"% Transforming lambda expressions..."),
maybe_flush_output(Verbose),
{ lambda__process_module(HLDS0, HLDS) },
+ maybe_write_string(Verbose, " done.\n").
+
+%-----------------------------------------------------------------------------%
+
+:- pred mercury_compile__expand_equiv_types_hlds(module_info, bool,
+ module_info, io__state, io__state).
+:- mode mercury_compile__expand_equiv_types_hlds(in, in, out, di, uo) is det.
+
+mercury_compile__expand_equiv_types_hlds(HLDS0, Verbose, HLDS) -->
+ maybe_write_string(Verbose,
+ "% Fully expanding equivalence types..."),
+ maybe_flush_output(Verbose),
+ { equiv_type_hlds__replace_in_hlds(HLDS0, HLDS) },
maybe_write_string(Verbose, " done.\n").
%-----------------------------------------------------------------------------%
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.234
diff -u -u -r1.234 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 19 Sep 2003 11:10:03 -0000 1.234
+++ compiler/mercury_to_mercury.m 26 Nov 2003 13:09:43 -0000
@@ -552,45 +552,6 @@
mercury_output_pragma_foreign_code(Attributes, Pred,
PredOrFunc, Vars, VarSet, PragmaCode)
;
- { Pragma = foreign_type(ForeignType, TVarSet,
- MercuryTypeSymName, MercuryTypeArgs,
- MaybeEqCompare) },
-
- io__write_string(":- pragma foreign_type("),
- ( { ForeignType = il(_) },
- io__write_string("il, ")
- ; { ForeignType = c(_) },
- io__write_string("c, ")
- ; { ForeignType = java(_) },
- io__write_string("java, ")
- ),
- { construct_qualified_term(MercuryTypeSymName,
- MercuryTypeArgs, MercuryType) },
- mercury_output_term(MercuryType, TVarSet, no),
- io__write_string(", \""),
- { ForeignType = il(il(RefOrVal,
- ForeignLocStr, ForeignTypeName)),
- ( RefOrVal = reference,
- RefOrValStr = "class "
- ; RefOrVal = value,
- RefOrValStr = "valuetype "
- ),
- sym_name_to_string(ForeignTypeName, ".", NameStr),
- ForeignTypeStr = RefOrValStr ++ "[" ++ ForeignLocStr ++
- "]" ++ NameStr
- ; ForeignType = c(c(ForeignTypeStr))
- ; ForeignType = java(java(ForeignTypeStr))
- },
- io__write_string(ForeignTypeStr),
- io__write_string("\")"),
- ( { MaybeEqCompare = yes(_) } ->
- io__write_string(" ")
- ;
- []
- ),
- mercury_output_equality_compare_preds(MaybeEqCompare),
- io__write_string(".\n")
- ;
{ Pragma = import(Pred, PredOrFunc, ModeList, Attributes,
C_Function) },
mercury_format_pragma_import(Pred, PredOrFunc, ModeList,
@@ -1598,7 +1559,7 @@
),
add_format(", instance number %d (%s)>",
[i(InstanceNum), s(InstanceString)]).
-mercury_format_cons_id(type_info_cell_constructor, _) -->
+mercury_format_cons_id(type_info_cell_constructor(_), _) -->
add_string("<type_info_cell_constructor>").
mercury_format_cons_id(typeclass_info_cell_constructor, _) -->
add_string("<typeclass_info_cell_constructor>").
@@ -1728,12 +1689,12 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_output_type_defn(tvarset, sym_name, list(type_param),
- type_defn, prog_context, io__state, io__state).
+:- pred mercury_output_type_defn(tvarset, sym_name,
+ list(type_param), type_defn, prog_context, io__state, io__state).
:- mode mercury_output_type_defn(in, in, in, in, in, di, uo) is det.
-mercury_output_type_defn(VarSet, Name, Args, abstract_type(IsSolverType),
- Context) -->
+mercury_output_type_defn(VarSet, Name, Args,
+ abstract_type(IsSolverType), Context) -->
mercury_output_begin_type_decl(IsSolverType),
{ construct_qualified_term(Name, Args, Context, TypeTerm) },
mercury_output_term(TypeTerm, VarSet, no, next_to_graphic_token),
@@ -1762,13 +1723,45 @@
mercury_output_equality_compare_preds(MaybeEqCompare),
io__write_string("\n\t.\n").
+mercury_output_type_defn(TVarSet, Name, Args,
+ foreign_type(ForeignType, MaybeEqCompare), _Context) -->
+ io__write_string(":- pragma foreign_type("),
+ ( { ForeignType = il(_) }, io__write_string("il, ")
+ ; { ForeignType = c(_) }, io__write_string("c, ")
+ ; { ForeignType = java(_) }, io__write_string("java, ")
+ ),
+ { construct_qualified_term(Name, Args, MercuryType) },
+ mercury_output_term(MercuryType, TVarSet, no),
+ io__write_string(", \""),
+ { ForeignType = il(il(RefOrVal, ForeignLocStr, ForeignTypeName)),
+ ( RefOrVal = reference, RefOrValStr = "class "
+ ; RefOrVal = value, RefOrValStr = "valuetype "
+ ),
+ sym_name_to_string(ForeignTypeName, ".", NameStr),
+ ForeignTypeStr = RefOrValStr ++ "[" ++ ForeignLocStr ++
+ "]" ++ NameStr
+ ; ForeignType = c(c(ForeignTypeStr))
+ ; ForeignType = java(java(ForeignTypeStr))
+ },
+ io__write_string(ForeignTypeStr),
+ io__write_string("\")"),
+ ( { MaybeEqCompare = yes(_) } ->
+ io__write_string(" ")
+ ;
+ []
+ ),
+ mercury_output_equality_compare_preds(MaybeEqCompare),
+ io__write_string(".\n").
+
:- pred mercury_output_begin_type_decl(is_solver_type, io__state, io__state).
:- mode mercury_output_begin_type_decl(in, di, uo) is det.
-mercury_output_begin_type_decl(solver_type) -->
- io__write_string(":- solver type ").
-mercury_output_begin_type_decl(non_solver_type) -->
- io__write_string(":- type ").
+mercury_output_begin_type_decl(IsSolverType) -->
+ io__write_string(":- "),
+ ( { IsSolverType = solver_type }, io__write_string("solver ")
+ ; { IsSolverType = non_solver_type }
+ ),
+ io__write_string("type ").
:- pred mercury_output_equality_compare_preds(maybe(unify_compare)::in,
io__state::di, io__state::uo) is det.
Index: compiler/ml_backend.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_backend.m,v
retrieving revision 1.5
diff -u -u -r1.5 ml_backend.m
--- compiler/ml_backend.m 16 Mar 2003 09:28:38 -0000 1.5
+++ compiler/ml_backend.m 24 Nov 2003 14:33:23 -0000
@@ -28,6 +28,7 @@
:- import_module libs.
:- import_module parse_tree.
:- import_module transform_hlds. % is this needed?
+:- import_module aditi_backend. % need aditi_backend.rl_file
%-----------------------------------------------------------------------------%
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.88
diff -u -u -r1.88 module_qual.m
--- compiler/module_qual.m 5 Nov 2003 03:17:41 -0000 1.88
+++ compiler/module_qual.m 26 Nov 2003 08:36:31 -0000
@@ -166,15 +166,22 @@
% `:- import_module' or `:- use_module'
% declaration in this module.
imported_modules::set(module_name),
+ % Modules which have been imported or used
+ % in the interface.
+ interface_visible_modules::set(module_name),
% Sets of all modules, types, insts, modes,
% and typeclasses visible in this module.
+ % impl_types is the set of all types visible
+ % from the implementation of the module.
modules::module_id_set,
types::type_id_set,
+ impl_types::type_id_set,
insts::inst_id_set,
modes::mode_id_set,
classes::class_id_set,
+
unused_interface_modules::set(module_name),
% modules imported in the
% interface that are not definitely
@@ -213,7 +220,8 @@
:- type import_status
---> exported
; local
- ; imported.
+ ; imported(import_locn)
+ ; abstract_imported.
% Pass over the item list collecting all defined module, type, mode and
% inst ids, all module synonym definitions, and the names of all
@@ -235,23 +243,42 @@
collect_mq_info_2(clause(_,_,_,_,_), Info, Info).
collect_mq_info_2(type_defn(_, SymName, Params, _, _), Info0, Info) :-
- list__length(Params, Arity),
- mq_info_get_types(Info0, Types0),
- mq_info_get_need_qual_flag(Info0, NeedQualifier),
- id_set_insert(NeedQualifier, SymName - Arity, Types0, Types),
- mq_info_set_types(Info0, Types, Info).
+ % This item is not visible in the current module.
+ ( mq_info_get_import_status(Info0, abstract_imported) ->
+ Info = Info0
+ ;
+ list__length(Params, Arity),
+ mq_info_get_types(Info0, Types0),
+ mq_info_get_impl_types(Info0, ImplTypes0),
+ mq_info_get_need_qual_flag(Info0, NeedQualifier),
+ id_set_insert(NeedQualifier, SymName - Arity, Types0, Types),
+ id_set_insert(NeedQualifier, SymName - Arity,
+ ImplTypes0, ImplTypes),
+ mq_info_set_types(Info0, Types, Info1),
+ mq_info_set_impl_types(Info1, ImplTypes, Info)
+ ).
collect_mq_info_2(inst_defn(_, SymName, Params, _, _), Info0, Info) :-
- list__length(Params, Arity),
- mq_info_get_insts(Info0, Insts0),
- mq_info_get_need_qual_flag(Info0, NeedQualifier),
- id_set_insert(NeedQualifier, SymName - Arity, Insts0, Insts),
- mq_info_set_insts(Info0, Insts, Info).
+ % This item is not visible in the current module.
+ ( mq_info_get_import_status(Info0, abstract_imported) ->
+ Info = Info0
+ ;
+ list__length(Params, Arity),
+ mq_info_get_insts(Info0, Insts0),
+ mq_info_get_need_qual_flag(Info0, NeedQualifier),
+ id_set_insert(NeedQualifier, SymName - Arity, Insts0, Insts),
+ mq_info_set_insts(Info0, Insts, Info)
+ ).
collect_mq_info_2(mode_defn(_, SymName, Params, _, _), Info0, Info) :-
- list__length(Params, Arity),
- mq_info_get_modes(Info0, Modes0),
- mq_info_get_need_qual_flag(Info0, NeedQualifier),
- id_set_insert(NeedQualifier, SymName - Arity, Modes0, Modes),
- mq_info_set_modes(Info0, Modes, Info).
+ % This item is not visible in the current module.
+ ( mq_info_get_import_status(Info0, abstract_imported) ->
+ Info = Info0
+ ;
+ list__length(Params, Arity),
+ mq_info_get_modes(Info0, Modes0),
+ mq_info_get_need_qual_flag(Info0, NeedQualifier),
+ id_set_insert(NeedQualifier, SymName - Arity, Modes0, Modes),
+ mq_info_set_modes(Info0, Modes, Info)
+ ).
collect_mq_info_2(module_defn(_, ModuleDefn), Info0, Info) :-
process_module_defn(ModuleDefn, Info0, Info).
collect_mq_info_2(pred_or_func(_,_,_,_,__,_,_,_,_,_,_,_), Info, Info).
@@ -286,11 +313,17 @@
).
collect_mq_info_2(nothing(_), Info, Info).
collect_mq_info_2(typeclass(_, SymName, Params, _, _), Info0, Info) :-
- list__length(Params, Arity),
- mq_info_get_classes(Info0, Classes0),
- mq_info_get_need_qual_flag(Info0, NeedQualifier),
- id_set_insert(NeedQualifier, SymName - Arity, Classes0, Classes),
- mq_info_set_classes(Info0, Classes, Info).
+ % This item is not visible in the current module.
+ ( mq_info_get_import_status(Info0, abstract_imported) ->
+ Info = Info0
+ ;
+ list__length(Params, Arity),
+ mq_info_get_classes(Info0, Classes0),
+ mq_info_get_need_qual_flag(Info0, NeedQualifier),
+ id_set_insert(NeedQualifier,
+ SymName - Arity, Classes0, Classes),
+ mq_info_set_classes(Info0, Classes, Info)
+ ).
collect_mq_info_2(instance(_,_,_,_,_,_), Info, Info).
% process_module_defn:
@@ -317,14 +350,17 @@
mq_info_set_import_status(Info0, local, Info).
process_module_defn(implementation, Info0, Info) :-
mq_info_set_import_status(Info0, local, Info).
-process_module_defn(imported(_), Info0, Info) :-
- mq_info_set_import_status(Info0, imported, Info1),
+process_module_defn(imported(Locn), Info0, Info) :-
+ mq_info_set_import_status(Info0, imported(Locn), Info1),
mq_info_set_need_qual_flag(Info1, may_be_unqualified, Info).
-process_module_defn(used(_), Info0, Info) :-
- mq_info_set_import_status(Info0, imported, Info1),
+process_module_defn(used(Locn), Info0, Info) :-
+ mq_info_set_import_status(Info0, imported(Locn), Info1),
mq_info_set_need_qual_flag(Info1, must_be_qualified, Info).
process_module_defn(opt_imported, Info0, Info) :-
- mq_info_set_import_status(Info0, imported, Info1),
+ mq_info_set_import_status(Info0, imported(implementation), Info1),
+ mq_info_set_need_qual_flag(Info1, must_be_qualified, Info).
+process_module_defn(abstract_imported, Info0, Info) :-
+ mq_info_set_import_status(Info0, abstract_imported, Info1),
mq_info_set_need_qual_flag(Info1, must_be_qualified, Info).
process_module_defn(transitively_imported, _, _) :-
error("process_module_defn: transitively_imported item").
@@ -349,19 +385,55 @@
:- pred add_imports(sym_list::in, mq_info::in, mq_info::out) is det.
-add_imports(Imports, Info0, Info) :-
- mq_info_get_import_status(Info0, Status),
- ( Imports = module(ImportedModules), Status \= imported ->
- mq_info_add_imported_modules(Info0, ImportedModules, Info1),
- ( Status = exported ->
- mq_info_add_unused_interface_modules(Info1,
- ImportedModules, Info)
- ;
- Info = Info1
+add_imports(Imports, !Info) :-
+ ( Imports = module(ImportedModules) ->
+ add_imports_2(ImportedModules, !Info)
+ ;
+ true
+ ).
+
+:- pred add_imports_2(list(sym_name)::in, mq_info::in, mq_info::out) is det.
+
+add_imports_2(Imports, !Info) :-
+ mq_info_get_import_status(!.Info, Status),
+ (
+ ( Status = local
+ ; Status = exported
+ ; Status = imported(ancestor_private_interface)
)
+ ->
+ mq_info_get_imported_modules(!.Info, Modules0),
+ set__insert_list(Modules0, Imports, Modules),
+ mq_info_set_imported_modules(!.Info, Modules, !:Info)
;
- Info = Info0
- ).
+ true
+ ),
+
+ (
+ Status = exported
+ ->
+ mq_info_get_unused_interface_modules(!.Info,
+ UnusedIntModules0),
+ set__insert_list(UnusedIntModules0, Imports, UnusedIntModules),
+ mq_info_set_unused_interface_modules(!.Info,
+ UnusedIntModules, !:Info)
+ ;
+ true
+ ),
+
+ (
+ ( Status = exported
+ ; Status = imported(ancestor_private_interface)
+ )
+ ->
+ mq_info_get_interface_visible_modules(!.Info, IntModules0),
+ set__insert_list(IntModules0, Imports, IntModules),
+ mq_info_set_interface_visible_modules(!.Info,
+ IntModules, !:Info)
+ ;
+ true
+ ).
+
%------------------------------------------------------------------------------
@@ -513,13 +585,16 @@
module_qualify_item(clause(A,B,C,D,E) - Con, clause(A,B,C,D,E) - Con,
Info, Info, yes) --> [].
-module_qualify_item(type_defn(A, SymName, Params, TypeDefn0, C) - Context,
- type_defn(A, SymName, Params, TypeDefn, C) - Context,
+module_qualify_item(
+ type_defn(TVarSet, SymName, Params, TypeDefn0, C) - Context,
+ type_defn(TVarSet, SymName, Params, TypeDefn, C) - Context,
Info0, Info, yes) -->
+ { mq_info_get_types(Info0, Types0) },
{ list__length(Params, Arity) },
{ mq_info_set_error_context(Info0,
type(SymName - Arity) - Context, Info1) },
- qualify_type_defn(TypeDefn0, TypeDefn, Info1, Info).
+ qualify_type_defn(TypeDefn0, TypeDefn, Info1, Info2),
+ { mq_info_set_types(Info2, Types0, Info) }.
module_qualify_item(inst_defn(A, SymName, Params, InstDefn0, C) - Context,
inst_defn(A, SymName, Params, InstDefn, C) - Context,
@@ -616,6 +691,8 @@
bool::out) is det.
update_import_status(opt_imported, Info, Info, no).
+update_import_status(abstract_imported, Info0, Info, yes) :-
+ mq_info_set_import_status(Info0, abstract_imported, Info).
update_import_status(transitively_imported, Info, Info, no).
update_import_status(module(_), Info, Info, yes).
update_import_status(interface, Info0, Info, yes) :-
@@ -656,8 +733,8 @@
{ MaybeEqualityPred = MaybeEqualityPred0 }.
qualify_type_defn(eqv_type(Type0), eqv_type(Type), Info0, Info) -->
qualify_type(Type0, Type, Info0, Info).
-qualify_type_defn(abstract_type(IsSolverType), abstract_type(IsSolverType),
- Info, Info) --> [].
+qualify_type_defn(abstract_type(_) @ Defn, Defn, Info, Info) --> [].
+qualify_type_defn(foreign_type(_, _) @ Defn, Defn, Info, Info) --> [].
:- pred qualify_constructors(list(constructor)::in, list(constructor)::out,
mq_info::in, mq_info::out, io__state::di, io__state::uo) is det.
@@ -897,7 +974,6 @@
qualify_pragma(X at source_file(_), X, Info, Info) --> [].
qualify_pragma(X at foreign_decl(_, _), X, Info, Info) --> [].
qualify_pragma(X at foreign_code(_, _), X, Info, Info) --> [].
-qualify_pragma(X at foreign_type(_, _, _, _, _), X, Info, Info) --> [].
qualify_pragma(X at foreign_import_module(_, _), X, Info, Info) --> [].
qualify_pragma(X, Y, Info0, Info) -->
{ PragmaVars0 = X ^ proc_vars },
@@ -1109,13 +1185,25 @@
{ Id0 = SymName0 - Arity },
{ mq_info_get_modules(Info0, Modules) },
{ id_set_search_sym_arity(Ids, SymName0, Arity, Modules,
- MatchingModules) },
+ MatchingModules0) },
+
+ { mq_info_get_import_status(Info0, exported) ->
+ % Items in the interface may only refer to modules
+ % imported in the interface.
+ mq_info_get_interface_visible_modules(Info0,
+ InterfaceImports),
+ list__filter(set__contains(InterfaceImports),
+ MatchingModules0, MatchingModules)
+ ;
+ MatchingModules = MatchingModules0
+ },
( { MatchingModules = [] } ->
% No matches for this id.
{ Id = Id0 },
( { mq_info_get_report_error_flag(Info0, yes) } ->
- report_undefined(Info0, Id0, TypeOfId),
+ report_undefined(MatchingModules0,
+ Info0, Id0, TypeOfId),
{ mq_info_set_error_flag(Info0, TypeOfId, Info1) },
{ mq_info_incr_errors(Info1, Info) }
;
@@ -1193,11 +1281,11 @@
; instance(id).
% Report an undefined type, inst or mode.
-:- pred report_undefined(mq_info, pair(sym_name, int),
+:- pred report_undefined(list(module_name), mq_info, pair(sym_name, int),
id_type, io__state, io__state).
-:- mode report_undefined(in, in, in, di, uo) is det.
+:- mode report_undefined(in, in, in, in, di, uo) is det.
-report_undefined(Info, Id, IdType) -->
+report_undefined(MatchingModules, Info, Id, IdType) -->
{ mq_info_get_error_context(Info, ErrorContext - Context) },
io__set_exit_status(1),
prog_out__write_context(Context),
@@ -1226,6 +1314,28 @@
mercury_output_bracketed_sym_name(ModuleName),
io__write_string("' has not been imported).\n")
;
+ { MatchingModules = [_ | MatchingModules1] }
+ ->
+ { MatchingModules1 = [],
+ ModuleWord = "module ",
+ HasWord = "has"
+ ; MatchingModules1 = [_|_],
+ ModuleWord = "modules ",
+ HasWord = "have"
+ },
+
+ io__write_string("\n"),
+ prog_out__write_context(Context),
+ io__write_string(" (the "),
+ io__write_string(ModuleWord),
+ io__write_string(" "),
+ prog_out__write_module_list(MatchingModules),
+ io__nl,
+ prog_out__write_context(Context),
+ io__write_string(" "),
+ io__write_string(HasWord),
+ io__write_string(" not been imported in the interface).\n")
+ ;
io__write_string(".\n")
).
@@ -1418,6 +1528,10 @@
set__init(InterfaceModules0),
get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps),
set__list_to_set(ImportDeps `list__append` UseDeps, ImportedModules),
+ set__insert_list(ImportedModules,
+ [ModuleName | get_ancestors(ModuleName)],
+ InterfaceVisibleModules),
+
id_set_init(Empty),
globals__lookup_bool_option(Globals, smart_recompilation,
SmartRecompilation),
@@ -1428,14 +1542,18 @@
SmartRecompilation = yes,
MaybeRecompInfo = yes(init_recompilation_info(ModuleName))
),
- Info0 = mq_info(ImportedModules, Empty, Empty, Empty, Empty,
- Empty, InterfaceModules0, local, 0, no, no,
- ReportErrors, ErrorContext, ModuleName,
+ Info0 = mq_info(ImportedModules, InterfaceVisibleModules,
+ Empty, Empty, Empty, Empty, Empty, Empty,
+ InterfaceModules0, local, 0,
+ no, no, ReportErrors, ErrorContext, ModuleName,
may_be_unqualified, MaybeRecompInfo).
:- pred mq_info_get_imported_modules(mq_info::in, set(module_name)::out) is det.
+:- pred mq_info_get_interface_visible_modules(mq_info::in,
+ set(module_name)::out) is det.
:- pred mq_info_get_modules(mq_info::in, module_id_set::out) is det.
:- pred mq_info_get_types(mq_info::in, type_id_set::out) is det.
+:- pred mq_info_get_impl_types(mq_info::in, type_id_set::out) is det.
:- pred mq_info_get_insts(mq_info::in, inst_id_set::out) is det.
:- pred mq_info_get_modes(mq_info::in, mode_id_set::out) is det.
:- pred mq_info_get_classes(mq_info::in, class_id_set::out) is det.
@@ -1449,8 +1567,11 @@
:- pred mq_info_get_error_context(mq_info::in, error_context::out) is det.
mq_info_get_imported_modules(MQInfo, MQInfo^imported_modules).
+mq_info_get_interface_visible_modules(MQInfo,
+ MQInfo^interface_visible_modules).
mq_info_get_modules(MQInfo, MQInfo^modules).
mq_info_get_types(MQInfo, MQInfo^types).
+mq_info_get_impl_types(MQInfo, MQInfo^impl_types).
mq_info_get_insts(MQInfo, MQInfo^insts).
mq_info_get_modes(MQInfo, MQInfo^modes).
mq_info_get_classes(MQInfo, MQInfo^classes).
@@ -1466,9 +1587,13 @@
:- pred mq_info_set_imported_modules(mq_info::in, set(module_name)::in,
mq_info::out) is det.
+:- pred mq_info_set_interface_visible_modules(mq_info::in,
+ set(module_name)::in, mq_info::out) is det.
:- pred mq_info_set_modules(mq_info::in, module_id_set::in, mq_info::out)
is det.
:- pred mq_info_set_types(mq_info::in, type_id_set::in, mq_info::out) is det.
+:- pred mq_info_set_impl_types(mq_info::in, type_id_set::in, mq_info::out)
+ is det.
:- pred mq_info_set_insts(mq_info::in, inst_id_set::in, mq_info::out) is det.
:- pred mq_info_set_modes(mq_info::in, mode_id_set::in, mq_info::out) is det.
:- pred mq_info_set_classes(mq_info::in, class_id_set::in, mq_info::out) is det.
@@ -1483,8 +1608,11 @@
mq_info_set_imported_modules(MQInfo,
ImportedModules, MQInfo^imported_modules := ImportedModules).
+mq_info_set_interface_visible_modules(MQInfo,
+ ImportedModules, MQInfo^interface_visible_modules := ImportedModules).
mq_info_set_modules(MQInfo, Modules, MQInfo^modules := Modules).
mq_info_set_types(MQInfo, Types, MQInfo^types := Types).
+mq_info_set_impl_types(MQInfo, Types, MQInfo^impl_types := Types).
mq_info_set_insts(MQInfo, Insts, MQInfo^insts := Insts).
mq_info_set_modes(MQInfo, Modes, MQInfo^modes := Modes).
mq_info_set_classes(MQInfo, Classes, MQInfo^classes := Classes).
@@ -1541,24 +1669,6 @@
;
Info = Info0
).
-
- % Add to the list of modules imported in the interface and not used.
-:- pred mq_info_add_unused_interface_modules(mq_info::in, list(module_name)::in,
- mq_info::out) is det.
-
-mq_info_add_unused_interface_modules(Info0, NewModules, Info) :-
- mq_info_get_unused_interface_modules(Info0, Modules0),
- set__insert_list(Modules0, NewModules, Modules),
- mq_info_set_unused_interface_modules(Info0, Modules, Info).
-
- % Add to the list of imported modules.
-:- pred mq_info_add_imported_modules(mq_info::in, list(module_name)::in,
- mq_info::out) is det.
-
-mq_info_add_imported_modules(Info0, NewModules, Info) :-
- mq_info_get_imported_modules(Info0, Modules0),
- set__insert_list(Modules0, NewModules, Modules),
- mq_info_set_imported_modules(Info0, Modules, Info).
%----------------------------------------------------------------------------%
% Define a type for representing sets of ids during module qualification
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.281
diff -u -u -r1.281 modules.m
--- compiler/modules.m 13 Nov 2003 15:08:03 -0000 1.281
+++ compiler/modules.m 26 Nov 2003 05:47:05 -0000
@@ -447,8 +447,7 @@
% or pseudo-declaration such as `:- imported'
% (which is inserted by the compiler, but can't be used
% in user code).
-:- pred make_pseudo_decl(module_defn, item_and_context).
-:- mode make_pseudo_decl(in, out) is det.
+:- func make_pseudo_decl(module_defn) = item_and_context.
% append_pseudo_decl(PseudoDecl, Module0, Module):
% append the specified module declaration to the list
@@ -457,10 +456,14 @@
:- pred append_pseudo_decl(module_defn, module_imports, module_imports).
:- mode append_pseudo_decl(in, in, out) is det.
- % Strip off the `:- interface' declaration at the start of
- % the item list, if any.
-:- pred strip_off_interface_decl(item_list, item_list).
-:- mode strip_off_interface_decl(in, out) is det.
+ % replace_section_decls(IntStatusItem, ImpStatusItem, !Items)
+ %
+ % Replace all occurrences of `:- interface' with IntStatusItem
+ % (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, item_and_context,
+ item_list, item_list).
+:- mode replace_section_decls(in, in, in, out) is det.
% Remove all the imported items the list.
:- pred strip_imported_items(item_list, item_list).
@@ -520,60 +523,114 @@
item_list, module_imports, module_error, io__state, io__state).
:- mode grab_unqual_imported_modules(in, in, in, in, out, out, di, uo) is det.
- % process_module_private_interfaces(Ancestors, DirectImports0,
- % DirectImports, DirectUses0, DirectUses,
- % Module0, Module):
+ % process_module_private_interfaces(Ancestors,
+ % IntStatusItem, ImpStatusItem, DirectImports0, DirectImports,
+ % DirectUses0, DirectUses, Module0, Module):
+ %
% Read the complete private interfaces for modules in Ancestors,
% and append any imports/uses in the ancestors to the
% corresponding previous lists.
%
:- pred process_module_private_interfaces(read_modules, list(module_name),
+ item_and_context, item_and_context,
list(module_name), list(module_name),
list(module_name), list(module_name),
module_imports, module_imports, io__state, io__state).
-:- mode process_module_private_interfaces(in, in, in, out, in, out, in, out,
- di, uo) is det.
+:- mode process_module_private_interfaces(in, in, in, in, in, out, in, out,
+ in, out, di, uo) is det.
% process_module_long_interfaces(ReadModules, NeedQualifier, Imports,
- % Ext, IndirectImports0, IndirectImports, Module0, Module):
+ % Ext, IntStatusItem, ImpStatusItem, !IndirectImports,
+ % !ImplIndirectImports, !Module):
%
% Read the long interfaces for modules in Imports
% (unless they've already been read in)
% from files with filename extension Ext,
% and append any imports/uses in those modules to the
- % IndirectImports list.
+ % IndirectImports list,
+ % and append any imports/uses in the implementation of those
+ % modules to the ImplIndirectImports list.
+ % Replace the `:- interface' declarations with IntStatusItem,
+ % which should set the import_status of the following items.
+ % Replace the `:- implementation' declarations with
+ % ImpStatusItem, which should set the import_status of the
+ % following items.
%
:- pred process_module_long_interfaces(read_modules, need_qualifier,
- list(module_name), string, list(module_name),
- list(module_name), module_imports, module_imports,
- io__state, io__state).
-:- mode process_module_long_interfaces(in, in, in, in, in, out, in, out,
- di, uo) is det.
+ list(module_name), string, item_and_context, item_and_context,
+ list(module_name), list(module_name),
+ list(module_name), list(module_name),
+ module_imports, module_imports, io__state, io__state).
+:- mode process_module_long_interfaces(in, in, in, in, in, in, in, out,
+ in, out, in, out, di, uo) is det.
% process_module_short_interfaces_transitively(ReadModules,
- % IndirectImports, Ext, Module0, Module):
+ % IndirectImports, Ext, IntStatusItem, ImpStatusItem,
+ % !ImpIndirectImports, !Module):
+ %
% Read the short interfaces for modules in IndirectImports
% (unless they've already been read in) and any
- % modules that those modules import (transitively).
+ % modules that those modules import (transitively) in
+ % the interface.
+ %
+ % Replace the `:- interface' declarations with IntStatusItem,
+ % which should set the import_status of the following items.
+ % Replace the `:- implementation' declarations with
+ % ImpStatusItem, which should set the import_status of the
+ % following items.
%
:- pred process_module_short_interfaces_transitively(read_modules,
- list(module_name), string, module_imports, module_imports,
+ list(module_name), string, item_and_context, item_and_context,
+ list(module_name), list(module_name),
+ module_imports, module_imports, io__state, io__state).
+:- mode process_module_short_interfaces_transitively(in, in, in, in, in,
+ in, out, in, out, di, uo) is det.
+
+ % process_module_short_interfaces_and_implementations_transitively(
+ % ReadModules, IndirectImports, Ext,
+ % IntStatusItem, ImpStatusItem, !Module):
+ %
+ % Read the short interfaces for modules in IndirectImports
+ % (unless they've already been read in) and any
+ % modules that those modules import (transitively) in
+ % the interface or implementation.
+ %
+ % Replace the `:- interface' declarations with IntStatusItem,
+ % which should set the import_status of the following items.
+ % Replace the `:- implementation' declarations with
+ % ImpStatusItem, which should set the import_status of the
+ % following items.
+ %
+:- pred process_module_short_interfaces_and_implementations_transitively(
+ read_modules, list(module_name), string, item_and_context,
+ item_and_context, module_imports, module_imports,
io__state, io__state).
-:- mode process_module_short_interfaces_transitively(in, in, in, in,
- out, di, uo) is det.
+:- mode process_module_short_interfaces_and_implementations_transitively(in,
+ in, in, in, in, in, out, di, uo) is det.
- % process_module_short_interfaces(ReadModules, Modules, Ext,
- % IndirectImports0, IndirectImports, Module0, Module):
+ % process_module_short_interfaces(ReadModules, IntStatusItem,
+ % ImpStatusItem, Modules, Ext, !IndirectImports,
+ % !ImpIndirectImports, !Module):
+ %
% Read the short interfaces for modules in Modules
% (unless they've already been read in).
- % Append the modules imported by Modules to
- % IndirectImports0 to give IndirectImports.
- %
+ % Append the modules imported by the interface of Modules to
+ % !IndirectImports.
+ % Append the modules imported by the implementation of Modules to
+ % !ImpIndirectImports.
+ %
+ % Replace the `:- interface' declarations with IntStatusItem,
+ % which should set the import_status of the following items.
+ % Replace the `:- implementation' declarations with
+ % ImpStatusItem, which should set the import_status of the
+ % following items.
:- pred process_module_short_interfaces(read_modules, list(module_name),
- string, list(module_name), list(module_name),
+ string, item_and_context, item_and_context,
+ list(module_name), list(module_name),
+ list(module_name), list(module_name),
module_imports, module_imports, io__state, io__state).
-:- mode process_module_short_interfaces(in, in, in, in, out, in, out, di, uo)
- is det.
+:- mode process_module_short_interfaces(in, in, in, in, in, in, out, in, out,
+ in, out, di, uo) is det.
%-----------------------------------------------------------------------------%
@@ -753,7 +810,7 @@
:- import_module string, map, term, varset, dir, library.
:- import_module assoc_list, relation, char, require.
-:- import_module getopt.
+:- import_module getopt, multi_map.
%-----------------------------------------------------------------------------%
@@ -1309,7 +1366,8 @@
), Items4, Items) },
write_interface_file(SourceFileName, ModuleName,
- ".int0", MaybeTimestamp, Items),
+ ".int0", MaybeTimestamp,
+ [make_pseudo_decl(interface) | Items]),
touch_interface_datestamp(ModuleName, ".date0")
)
).
@@ -1319,7 +1377,7 @@
% possible. Then write out the .int and .int2 files.
make_interface(SourceFileName, SourceFileModuleName, ModuleName,
MaybeTimestamp, Items0) -->
- { get_interface(Items0, InterfaceItems0) },
+ { get_interface(yes, Items0, InterfaceItems0) },
%
% Get the .int3 files for imported modules
%
@@ -1361,7 +1419,9 @@
{ strip_imported_items(InterfaceItems2, [],
InterfaceItems3) },
{ strip_assertions(InterfaceItems3, InterfaceItems4) },
- check_for_clauses_in_interface(InterfaceItems4,
+ { strip_unnecessary_impl_defns(InterfaceItems4,
+ InterfaceItems5) },
+ check_for_clauses_in_interface(InterfaceItems5,
InterfaceItems),
check_int_for_no_exports(InterfaceItems, ModuleName),
write_interface_file(SourceFileName, ModuleName,
@@ -1377,7 +1437,7 @@
% This qualifies everything as much as it can given the
% information in the current module and writes out the .int3 file.
make_short_interface(SourceFileName, ModuleName, Items0) -->
- { get_interface(Items0, InterfaceItems0) },
+ { get_interface(no, Items0, InterfaceItems0) },
% assertions are also stripped since they should
% only be written to .opt files,
{ strip_assertions(InterfaceItems0, InterfaceItems1) },
@@ -1404,6 +1464,8 @@
list__reverse(Items0, Items)
; Item = module_defn(_, used(_)) ->
list__reverse(Items0, Items)
+ ; Item = module_defn(_, abstract_imported) ->
+ list__reverse(Items0, Items)
;
strip_imported_items(Rest, [Item - Context | Items0], Items)
).
@@ -1422,6 +1484,139 @@
).
+%-----------------------------------------------------------------------------%
+
+:- pred strip_unnecessary_impl_defns(item_list::in, item_list::out) is det.
+
+strip_unnecessary_impl_defns(Items0,
+ promise_only_solution(strip_unnecessary_impl_defns_2(Items0))).
+
+:- pred strip_unnecessary_impl_defns_2(item_list::in,
+ item_list::out) is cc_multi.
+
+strip_unnecessary_impl_defns_2(Items0, Items) :-
+ some [!IntTypesMap, !ImplTypesMap] (
+ gather_type_defns(no, Items0, [], IntItems0, [], ImplItems0,
+ map__init, !:IntTypesMap,
+ map__init, !:ImplTypesMap),
+
+ % If a type in the implementation section doesn't have
+ % foreign type alternatives, make it abstract.
+ map__map_values(
+ (pred(_::in, Defns0::in, Defns::out) is det :-
+ (
+ Defns0 = [du_type(_, IsSolverType, _) -
+ (Item0 - Context)]
+ ->
+ Defn = abstract_type(IsSolverType),
+ (
+ Item = Item0 ^ td_ctor_defn := Defn
+ ->
+ Defns = [Defn - (Item - Context)]
+ ;
+ error(
+ "modules.strip_unnecessary_impl_defns: item is not a type_defn")
+ )
+ ;
+ Defns = Defns0
+ )
+ ), !ImplTypesMap),
+
+ % If there is an exported type declaration for a type with an abstract
+ % declaration in the implementation (usually it will originally
+ % have been a d.u. type), remove the declaration in the implementation.
+ unsorted_aggregate(
+ (pred(TypeCtor::out) is nondet :-
+ map__member(!.ImplTypesMap, TypeCtor, Defns),
+ \+ (
+ list__member(Defn, Defns),
+ Defn \= abstract_type(_) - _
+ ),
+ multi_map__contains(!.IntTypesMap, TypeCtor)
+ ),
+ (pred(TypeCtor::in, !.ImplTypesMap::in,
+ !:ImplTypesMap::out) is det :-
+ multi_map__delete(!.ImplTypesMap, TypeCtor,
+ !:ImplTypesMap)
+ ),
+ !ImplTypesMap),
+
+ map__foldl(
+ (pred(_::in, Defns::in, !.ImplItems::in,
+ !:ImplItems::out) is det :-
+ list__foldl(
+ (pred((_ - Item)::in, !.ImplItems::in,
+ !:ImplItems::out) is det :-
+ !:ImplItems = [Item | !.ImplItems]
+ ), Defns, !ImplItems)
+ ), !.ImplTypesMap, ImplItems0, ImplItems1),
+
+ IntItems = [make_pseudo_decl(interface) | IntItems0],
+ maybe_strip_import_decls(ImplItems1, ImplItems2),
+ ( ImplItems2 = [] ->
+ Items = IntItems
+ ;
+ Items = IntItems ++
+ [make_pseudo_decl(implementation) | ImplItems2]
+ )
+ ).
+
+:- 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)).
+
+:- pred gather_type_defns(bool::in, item_list::in,
+ item_list::in, item_list::out,
+ item_list::in, item_list::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(InInterface0, [Item - Context | Items0],
+ !IntItems, !ImplItems, !IntTypes, !ImplTypes) :-
+ (
+ Item = module_defn(_, interface)
+ ->
+ InInterface = yes
+ ;
+ Item = module_defn(_, implementation)
+ ->
+ InInterface = no
+ ;
+ Item = type_defn(_, Name, Args, Body, _)
+ ->
+ TypeCtor = Name - length(Args),
+ InInterface = InInterface0,
+ ( InInterface = yes ->
+ !:IntItems = [Item - Context | !.IntItems],
+ gather_type_defn(TypeCtor, Body,
+ Item - Context, !IntTypes)
+ ;
+ % We don't add this to !ImplItems yet --
+ % we may be removing this item.
+ gather_type_defn(TypeCtor, Body,
+ Item - Context, !ImplTypes)
+ )
+ ;
+ InInterface = InInterface0,
+ ( InInterface = yes ->
+ !:IntItems = [Item - Context | !.IntItems]
+ ;
+ !:ImplItems = [Item - Context | !.ImplItems]
+ )
+ ),
+ gather_type_defns(InInterface, Items0, !IntItems, !ImplItems,
+ !IntTypes, !ImplTypes).
+
+:- pred gather_type_defn(type_ctor::in, type_defn::in, item_and_context::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).
+
+%-----------------------------------------------------------------------------%
+
:- pred check_for_clauses_in_interface(item_list, item_list,
io__state, io__state).
:- mode check_for_clauses_in_interface(in, out, di, uo) is det.
@@ -1501,7 +1696,6 @@
pragma_allowed_in_interface(foreign_import_module(_, _), no).
pragma_allowed_in_interface(foreign_code(_, _), no).
pragma_allowed_in_interface(foreign_proc(_, _, _, _, _, _), no).
-pragma_allowed_in_interface(foreign_type(_, _, _, _, _), yes).
pragma_allowed_in_interface(inline(_, _), no).
pragma_allowed_in_interface(no_inline(_, _), no).
pragma_allowed_in_interface(obsolete(_, _), yes).
@@ -1540,7 +1734,7 @@
( { ExportWarning = no } ->
[]
;
- { get_interface(Items, InterfaceItems) },
+ { get_interface(no, Items, InterfaceItems) },
check_int_for_no_exports(InterfaceItems, ModuleName)
).
@@ -1627,11 +1821,9 @@
% Read in the previous version of the file.
read_mod_ignore_errors(ModuleName, Suffix,
"Reading old interface for module", yes, no,
- OldItems0, OldError, _OldIntFileName,
+ OldItems, OldError, _OldIntFileName,
_OldTimestamp),
( { OldError = no_module_errors } ->
- { strip_off_interface_decl(OldItems0,
- OldItems) },
{ MaybeOldItems = yes(OldItems) }
;
% If we can't read in the old file, the
@@ -1642,27 +1834,32 @@
{ recompilation__version__compute_version_numbers(
Timestamp, InterfaceItems0, MaybeOldItems,
VersionNumbers) },
- { VersionNumberItem = module_defn(VarSet,
+ { VersionNumberItem = module_defn(varset__init,
version_numbers(ModuleName, VersionNumbers))
- - Context },
- { InterfaceItems1 =
- [VersionNumberItem | InterfaceItems0] }
+ - term__context_init},
+ {
+ InterfaceItems0 =
+ [FirstItem | InterfaceItems1],
+ FirstItem = module_defn(_, interface) - _
+ ->
+ InterfaceItems =
+ [FirstItem, VersionNumberItem
+ | InterfaceItems1]
+ ;
+ InterfaceItems =
+ [make_pseudo_decl(interface),
+ VersionNumberItem
+ | InterfaceItems0]
+ }
;
{ MaybeTimestamp = no },
{ error(
"write_interface_file with `--smart-recompilation', timestamp not read") }
)
;
- { InterfaceItems1 = InterfaceItems0 }
+ { InterfaceItems = InterfaceItems0 }
),
- % Add a `:- interface' declaration at the start
- % of the item list.
- { varset__init(VarSet) },
- { term__context_init(Context) },
- { InterfaceDeclaration = module_defn(VarSet, interface) - Context },
- { InterfaceItems = [InterfaceDeclaration | InterfaceItems1] },
-
convert_to_mercury(ModuleName, TmpOutputFileName, InterfaceItems),
globals__io_set_option(line_numbers, bool(LineNumbers)),
update_interface(OutputFileName).
@@ -1782,7 +1979,7 @@
update_interface_create_file(Msg, OutputFileName,
TmpOutputFileName, Succeeded) -->
- globals__io_lookup_bool_option(verbose, Verbose),
+ globals__io_lookup_bool_option(verbose_make, Verbose),
maybe_write_string(Verbose, "% `"),
maybe_write_string(Verbose, OutputFileName),
maybe_write_string(Verbose, "' has "),
@@ -1856,7 +2053,7 @@
ImpUsedModules0, ImpUsedModules),
{ get_fact_table_dependencies(Items0, FactDeps) },
- { get_interface_and_implementation(Items0,
+ { get_interface_and_implementation(no, Items0,
InterfaceItems, ImplItems) },
{ get_children(InterfaceItems, PublicChildren) },
{ MaybeTimestamp = yes(Timestamp) ->
@@ -1880,13 +2077,10 @@
Items1 = Items0
;
split_clauses_and_decls(ImplItems, Clauses, ImplDecls),
- make_pseudo_decl(interface, InterfaceDecl),
- make_pseudo_decl(private_interface, PrivateInterfaceDecl),
- make_pseudo_decl(implementation, ImplementationDecl),
list__condense(
- [[InterfaceDecl | InterfaceItems],
- [PrivateInterfaceDecl | ImplDecls],
- [ImplementationDecl | Clauses]], Items1),
+ [[make_pseudo_decl(interface) | InterfaceItems],
+ [make_pseudo_decl(private_interface) | ImplDecls],
+ [make_pseudo_decl(implementation) | Clauses]], Items1),
module_imports_set_items(!.Module, Items1, !:Module)
},
@@ -1897,56 +2091,85 @@
IntImportedModules1, IntImportedModules2,
IntUsedModules1, IntUsedModules2) },
- % We add a pseudo-declaration `:- imported(ancestor)' at the
- % end of the item list. Uses of the items with declarations
- % following this do not need module qualifiers. Modules
- % imported by ancestors are considered to be visible
- % in the current module.
- { append_pseudo_decl(imported(ancestor), !Module) },
-
% Process the ancestor modules
+ % Uses of the items declared in ancestor modules
+ % do not need module qualifiers. Modules imported
+ % by ancestors are considered to be visible
+ % in the current module.
process_module_private_interfaces(ReadModules, AncestorModules,
+ make_pseudo_decl(imported(ancestor_private_interface)),
+ make_pseudo_decl(abstract_imported),
IntImportedModules2, IntImportedModules,
IntUsedModules2, IntUsedModules, !Module),
- % We add a pseudo-declaration `:- imported(interface)' at
- % the end of the item list. Uses of the items with declarations
- % following this do not need module qualifiers.
- { append_pseudo_decl(imported(interface), !Module) },
-
% Process the modules imported using `import_module'.
+ % Uses of these items do not need module qualifiers.
{ IntIndirectImports0 = [] },
+ { IntImpIndirectImports0 = [] },
process_module_long_interfaces(ReadModules, may_be_unqualified,
- IntImportedModules, ".int", IntIndirectImports0,
- IntIndirectImports1, !Module),
-
- { append_pseudo_decl(imported(implementation), !Module) },
+ IntImportedModules, ".int",
+ make_pseudo_decl(imported(interface)),
+ make_pseudo_decl(abstract_imported),
+ IntIndirectImports0, IntIndirectImports1,
+ IntImpIndirectImports0, IntImpIndirectImports1,
+ !Module),
{ ImpIndirectImports0 = [] },
+ { ImpImpIndirectImports0 = [] },
process_module_long_interfaces(ReadModules, may_be_unqualified,
- ImpImportedModules, ".int", ImpIndirectImports0,
- ImpIndirectImports1, !Module),
+ ImpImportedModules, ".int",
+ make_pseudo_decl(imported(implementation)),
+ make_pseudo_decl(abstract_imported),
+ ImpIndirectImports0, ImpIndirectImports1,
+ ImpImpIndirectImports0, ImpImpIndirectImports1,
+ !Module),
% Process the modules imported using `use_module' .
- { append_pseudo_decl(used(interface), !Module) },
process_module_long_interfaces(ReadModules, must_be_qualified,
- IntUsedModules, ".int", IntIndirectImports1,
- IntIndirectImports, !Module),
- { append_pseudo_decl(used(implementation), !Module) },
+ IntUsedModules, ".int",
+ make_pseudo_decl(used(interface)),
+ make_pseudo_decl(abstract_imported),
+ IntIndirectImports1, IntIndirectImports,
+ IntImpIndirectImports1, IntImpIndirectImports2,
+ !Module),
process_module_long_interfaces(ReadModules, must_be_qualified,
- ImpUsedModules, ".int", ImpIndirectImports1,
- ImpIndirectImports, !Module),
+ ImpUsedModules, ".int",
+ make_pseudo_decl(used(implementation)),
+ make_pseudo_decl(abstract_imported),
+ ImpIndirectImports1, ImpIndirectImports,
+ ImpImpIndirectImports1, ImpImpIndirectImports2,
+ !Module),
% Process the short interfaces for indirectly imported modules.
% The short interfaces are treated as if
% they are imported using `use_module'.
{ append_pseudo_decl(transitively_imported, !Module) },
- { append_pseudo_decl(used(interface), !Module) },
process_module_short_interfaces_transitively(ReadModules,
- IntIndirectImports, ".int2", !Module),
- { append_pseudo_decl(used(implementation), !Module) },
+ IntIndirectImports, ".int2",
+ make_pseudo_decl(used(interface)),
+ make_pseudo_decl(abstract_imported),
+ IntImpIndirectImports2, IntImpIndirectImports, !Module),
process_module_short_interfaces_transitively(ReadModules,
- ImpIndirectImports, ".int2", !Module),
+ ImpIndirectImports, ".int2",
+ make_pseudo_decl(used(implementation)),
+ make_pseudo_decl(abstract_imported),
+ ImpImpIndirectImports2, ImpImpIndirectImports, !Module),
+
+ % Process the short interfaces for modules imported in
+ % the implementation of indirectly imported modules.
+ % The items in these modules shouldn't be visible
+ % to typechecking -- they are used for fully expanding
+ % equivalence types after the semantic checking passes.
+ process_module_short_interfaces_and_implementations_transitively(
+ ReadModules, IntImpIndirectImports, ".int2",
+ make_pseudo_decl(abstract_imported),
+ make_pseudo_decl(abstract_imported),
+ !Module),
+ process_module_short_interfaces_and_implementations_transitively(
+ ReadModules, ImpImpIndirectImports, ".int2",
+ make_pseudo_decl(abstract_imported),
+ make_pseudo_decl(abstract_imported),
+ !Module),
{ module_imports_get_items(!.Module, Items) },
check_imports_accessibility(ModuleName,
@@ -1966,20 +2189,18 @@
%
{ ParentDeps = get_ancestors(ModuleName) },
{ get_dependencies(Items0, IntImportDeps0, IntUseDeps0,
- ImpImportDeps0, ImpUseDeps0) },
+ ImpImportDeps, ImpUseDeps) },
%
- % Construct the initial module import structure,
- % and append a `:- imported' decl to the items.
+ % Construct the initial module import structure.
%
{ init_module_imports(SourceFileName, SourceFileModuleName, ModuleName,
Items0, [], [], [], no, !:Module) },
- { append_pseudo_decl(imported(interface), !Module) },
% Add `builtin' and `private_builtin' to the imported modules.
globals__io_get_globals(Globals),
{ add_implicit_imports(Items0, Globals,
- IntImportDeps0, IntImportDeps1, IntUseDeps0, IntUseDeps1) },
+ IntImportDeps0, IntImportDeps, IntUseDeps0, IntUseDeps) },
%
% Get the .int3s and .int0s that the current module depends on.
@@ -1988,46 +2209,64 @@
% first the .int0s for parent modules
process_module_private_interfaces(ReadModules, ParentDeps,
- IntImportDeps1, IntImportDeps, IntUseDeps1, IntUseDeps,
+ make_pseudo_decl(imported(ancestor_private_interface)),
+ make_pseudo_decl(abstract_imported),
+ [], ParentImportDeps, [], ParentUseDeps,
!Module),
% then the .int3s for `:- import'-ed modules
process_module_long_interfaces(ReadModules, may_be_unqualified,
- IntImportDeps, ".int3", [],
- IntIndirectImportDeps0, !Module),
-
- { append_pseudo_decl(imported(ancestor), !Module) },
-
- process_module_private_interfaces(ReadModules, ParentDeps,
- ImpImportDeps0, ImpImportDeps, ImpUseDeps0, ImpUseDeps,
- !Module),
-
- { append_pseudo_decl(imported(implementation), !Module) },
-
+ ParentImportDeps, ".int3",
+ make_pseudo_decl(imported(ancestor)),
+ make_pseudo_decl(abstract_imported),
+ [], IntIndirectImportDeps0, [], _, !Module),
process_module_long_interfaces(ReadModules, may_be_unqualified,
- ImpImportDeps, ".int3", [], ImpIndirectImportDeps0,
- !Module),
+ IntImportDeps, ".int3",
+ make_pseudo_decl(imported(interface)),
+ make_pseudo_decl(abstract_imported),
+ IntIndirectImportDeps0, IntIndirectImportDeps1,
+ [], _, !Module),
+ process_module_long_interfaces(ReadModules, may_be_unqualified,
+ ImpImportDeps, ".int3",
+ make_pseudo_decl(imported(implementation)),
+ make_pseudo_decl(abstract_imported),
+ [], ImpIndirectImportDeps0,
+ [], _, !Module),
% then (after appropriate `:- used' decls)
% the .int3s for `:- use'-ed modules
- { append_pseudo_decl(used(interface), !Module) },
+ process_module_long_interfaces(ReadModules, may_be_unqualified,
+ ParentUseDeps, ".int3",
+ make_pseudo_decl(imported(ancestor)),
+ make_pseudo_decl(abstract_imported),
+ IntIndirectImportDeps1, IntIndirectImportDeps2,
+ [], _, !Module),
process_module_long_interfaces(ReadModules, must_be_qualified,
- IntUseDeps, ".int3", IntIndirectImportDeps0,
- IntIndirectImportDeps, !Module),
- { append_pseudo_decl(used(implementation), !Module) },
+ IntUseDeps, ".int3",
+ make_pseudo_decl(used(interface)),
+ make_pseudo_decl(abstract_imported),
+ IntIndirectImportDeps2, IntIndirectImportDeps,
+ [], _, !Module),
process_module_long_interfaces(ReadModules, must_be_qualified,
- ImpUseDeps, ".int3", ImpIndirectImportDeps0,
- ImpIndirectImportDeps, !Module),
+ ImpUseDeps, ".int3",
+ make_pseudo_decl(used(implementation)),
+ make_pseudo_decl(abstract_imported),
+ ImpIndirectImportDeps0, ImpIndirectImportDeps,
+ [], _, !Module),
% then (after appropriate `:- used' decl)
% the .int3s for indirectly imported modules
- { append_pseudo_decl(used(interface), !Module) },
process_module_short_interfaces_transitively(ReadModules,
- IntIndirectImportDeps, ".int3", !Module),
+ IntIndirectImportDeps, ".int3",
+ make_pseudo_decl(used(interface)),
+ make_pseudo_decl(abstract_imported),
+ [], _, !Module),
- { append_pseudo_decl(used(implementation), !Module) },
process_module_short_interfaces_transitively(ReadModules,
- ImpIndirectImportDeps, ".int3", !Module),
+ ImpIndirectImportDeps, ".int3",
+ make_pseudo_decl(used(implementation)),
+ make_pseudo_decl(abstract_imported),
+ [], _, !Module),
{ module_imports_get_items(!.Module, Items) },
check_imports_accessibility(ModuleName,
@@ -2078,14 +2317,11 @@
append_pseudo_decl(PseudoDecl, Module0, Module) :-
Items0 = Module0 ^ items,
- make_pseudo_decl(PseudoDecl, Item),
- list__append(Items0, [Item], Items),
+ list__append(Items0, [make_pseudo_decl(PseudoDecl)], Items),
Module = Module0 ^ items := Items.
-make_pseudo_decl(PseudoDecl, Item) :-
- term__context_init(Context),
- varset__init(Varset),
- Item = module_defn(Varset, PseudoDecl) - Context.
+make_pseudo_decl(PseudoDecl) =
+ module_defn(varset__init, PseudoDecl) - term__context_init.
%-----------------------------------------------------------------------------%
@@ -3368,10 +3604,13 @@
%
% compute the indirect dependencies: they are equal to the
% composition of the implementation dependencies
- % with the transitive closure of the interface dependencies.
+ % with the transitive closure of the implementation
+ % dependencies. (We used to take the transitive closure
+ % of the interface dependencies, but we now include
+ % implementation details in the interface files).
%
- { relation__tc(IntDepsRel, TransIntDepsRel) },
- { relation__compose(ImplDepsRel, TransIntDepsRel,
+ { relation__tc(ImplDepsRel, TransImplDepsRel) },
+ { relation__compose(ImplDepsRel, TransImplDepsRel,
IndirectDepsRel) },
%
@@ -5339,7 +5578,7 @@
ImplUseDeps0, ImplUseDeps),
list__append(ImplImportDeps, ImplUseDeps, ImplementationDeps),
- get_interface(Items, InterfaceItems),
+ get_interface(no, Items, InterfaceItems),
get_dependencies(InterfaceItems, InterfaceImportDeps0,
InterfaceUseDeps0),
add_implicit_imports(InterfaceItems, Globals,
@@ -5609,13 +5848,13 @@
%-----------------------------------------------------------------------------%
-process_module_private_interfaces(_, [], DirectImports, DirectImports,
- DirectUses, DirectUses, Module, Module) --> [].
+process_module_private_interfaces(_, [], _, _, !DirectImports,
+ !DirectUses, !Module) --> [].
process_module_private_interfaces(ReadModules, [Ancestor | Ancestors],
- DirectImports0, DirectImports, DirectUses0, DirectUses,
- Module0, Module) -->
- { ModuleName = Module0 ^ module_name },
- { ModAncestors0 = Module0 ^ parent_deps },
+ IntStatusItem, ImpStatusItem, !DirectImports,
+ !DirectUses, !Module) -->
+ { ModuleName = !.Module ^ module_name },
+ { ModAncestors0 = !.Module ^ parent_deps },
(
{ Ancestor = ModuleName }
->
@@ -5624,14 +5863,13 @@
{ list__member(Ancestor, ModAncestors0) }
->
% we've already read it
- process_module_private_interfaces(ReadModules, Ancestors,
- DirectImports0, DirectImports,
- DirectUses0, DirectUses,
- Module0, Module)
- ;
- { ModItems0 = Module0 ^ items },
- { ModError0 = Module0 ^ error },
- { Module0 ^ maybe_timestamps = yes(_) ->
+ process_module_private_interfaces(ReadModules,
+ Ancestors, IntStatusItem, ImpStatusItem,
+ !DirectImports, !DirectUses, !Module)
+ ;
+ { ModItems0 = !.Module ^ items },
+ { ModError0 = !.Module ^ error },
+ { !.Module ^ maybe_timestamps = yes(_) ->
ReturnTimestamp = yes
;
ReturnTimestamp = no
@@ -5642,9 +5880,10 @@
_AncestorFileName, MaybeTimestamp),
maybe_record_timestamp(Ancestor, ".int0", may_be_unqualified,
- MaybeTimestamp, Module0, Module1),
+ MaybeTimestamp, !Module),
- { strip_off_interface_decl(PrivateIntItems, Items) },
+ { replace_section_decls(IntStatusItem, ImpStatusItem,
+ PrivateIntItems, Items) },
{ maybe_add_int_error(PrivateIntError, ModError0, ModError) },
globals__io_lookup_bool_option(statistics, Statistics),
@@ -5656,41 +5895,41 @@
{ ModAncestors = [Ancestor | ModAncestors0] }
),
{ get_dependencies(Items, AncDirectImports, AncDirectUses) },
- { list__append(DirectImports0, AncDirectImports,
- DirectImports1) },
- { list__append(DirectUses0, AncDirectUses, DirectUses1) },
- { list__append(ModItems0, Items, ModItems) },
- { Module2 = ((Module1 ^ items := ModItems)
+ { !:DirectImports = !.DirectImports ++ AncDirectImports },
+ { !:DirectUses = !.DirectUses ++ AncDirectUses },
+ { ModItems = ModItems0 ++ Items },
+ { !:Module = ((!.Module ^ items := ModItems)
^ parent_deps := ModAncestors)
^ error := ModError },
process_module_private_interfaces(ReadModules, Ancestors,
- DirectImports1, DirectImports, DirectUses1,
- DirectUses, Module2, Module)
+ IntStatusItem, ImpStatusItem,
+ !DirectImports, !DirectUses, !Module)
).
%-----------------------------------------------------------------------------%
-process_module_long_interfaces(_, _, [], _Ext,
- IndirectImports, IndirectImports, Module, Module) --> [].
+process_module_long_interfaces(_, _, [], _Ext, _, _,
+ !IndirectImports, !ImplIndirectImports, !Module) --> [].
process_module_long_interfaces(ReadModules, NeedQualifier, [Import | Imports],
- Ext, IndirectImports0, IndirectImports, Module0, Module) -->
- { ModuleName = Module0 ^ module_name },
- { ModImplementationImports0 = Module0 ^ impl_deps },
+ Ext, IntStatusItem, ImpStatusItem, !IndirectImports,
+ !ImplIndirectImports, !Module) -->
+ { ModuleName = !.Module ^ module_name },
+ { ModImplementationImports0 = !.Module ^ impl_deps },
(
% have we already read it?
( { Import = ModuleName }
- ; { list__member(Import, Module0 ^ parent_deps) }
- ; { list__member(Import, Module0 ^ int_deps) }
+ ; { list__member(Import, !.Module ^ parent_deps) }
+ ; { list__member(Import, !.Module ^ int_deps) }
; { list__member(Import, ModImplementationImports0) }
)
->
process_module_long_interfaces(ReadModules, NeedQualifier,
- Imports, Ext, IndirectImports0, IndirectImports,
- Module0, Module)
+ Imports, Ext, IntStatusItem, ImpStatusItem,
+ !IndirectImports, !ImplIndirectImports, !Module)
;
- { ModItems0 = Module0 ^ items },
- { ModError0 = Module0 ^ error },
- { Module0 ^ maybe_timestamps = yes(_) ->
+ { ModItems0 = !.Module ^ items },
+ { ModError0 = !.Module ^ error },
+ { !.Module ^ maybe_timestamps = yes(_) ->
ReturnTimestamp = yes
;
ReturnTimestamp = no
@@ -5700,7 +5939,11 @@
LongIntItems, LongIntError, _LongIntFileName,
MaybeTimestamp),
- { strip_off_interface_decl(LongIntItems, Items) },
+ { get_dependencies(LongIntItems,
+ IndirectImports1, IndirectUses1,
+ ImplIndirectImports1, ImplIndirectUses1) },
+ { replace_section_decls(IntStatusItem, ImpStatusItem,
+ LongIntItems, Items) },
{ maybe_add_int_error(LongIntError, ModError0, ModError) },
globals__io_lookup_bool_option(statistics, Statistics),
@@ -5708,27 +5951,26 @@
( { LongIntError = fatal_module_errors } ->
{ ModImplementationImports =
- ModImplementationImports0 },
- { Module1 = Module0 }
+ ModImplementationImports0 }
;
maybe_record_timestamp(Import, Ext, NeedQualifier,
- MaybeTimestamp, Module0, Module1),
+ MaybeTimestamp, !Module),
{ ModImplementationImports =
[Import | ModImplementationImports0] }
),
- { get_dependencies(Items, IndirectImports1, IndirectUses1) },
- { list__append(IndirectImports0, IndirectImports1,
- IndirectImports2) },
- { list__append(IndirectImports2, IndirectUses1,
- IndirectImports3) },
+ { !:IndirectImports = !.IndirectImports ++ IndirectImports1
+ ++ IndirectUses1 },
+ { !:ImplIndirectImports = !.ImplIndirectImports
+ ++ ImplIndirectImports1 ++ ImplIndirectUses1 },
{ list__append(ModItems0, Items, ModItems) },
- { Module2 = ((Module1 ^ impl_deps := ModImplementationImports)
+ { !:Module =
+ ((!.Module ^ impl_deps := ModImplementationImports)
^ items := ModItems)
^ error := ModError },
process_module_long_interfaces(ReadModules, NeedQualifier,
- Imports, Ext, IndirectImports3, IndirectImports,
- Module2, Module)
+ Imports, Ext, IntStatusItem, ImpStatusItem,
+ !IndirectImports, !ImplIndirectImports, !Module)
).
:- pred check_imports_accessibility(module_name, list(module_name), item_list,
@@ -5741,13 +5983,13 @@
% interface for that module's parent module, which will contain
% the `include_module' declarations for any exported sub-modules
% of the parent. So the accessible sub-modules can be determined
- % by just calling get_children on the complete item list.
+ % by just calling get_accessible_children on the complete item list.
%
% We then go through all of the imported/used modules,
% checking that each one is accessible.
%
check_imports_accessibility(ModuleName, Imports, Items) -->
- { get_children(Items, AccessibleSubModules) },
+ { get_accessible_children(Items, AccessibleSubModules) },
list__foldl(check_module_accessibility(ModuleName,
AccessibleSubModules, Items), Imports).
@@ -5853,37 +6095,53 @@
%-----------------------------------------------------------------------------%
+process_module_short_interfaces_and_implementations_transitively(ReadModules,
+ Imports, Ext, IntStatusItem, ImpStatusItem, !Module) -->
+ process_module_short_interfaces_transitively(ReadModules, Imports, Ext,
+ IntStatusItem, ImpStatusItem, [], ImpIndirectImports, !Module),
+ ( { ImpIndirectImports = [] } ->
+ []
+ ;
+ process_module_short_interfaces_and_implementations_transitively(
+ ReadModules, ImpIndirectImports, Ext,
+ IntStatusItem, ImpStatusItem, !Module)
+ ).
+
process_module_short_interfaces_transitively(ReadModules, Imports, Ext,
- Module0, Module) -->
- process_module_short_interfaces(ReadModules, Imports, Ext, [],
- IndirectImports, Module0, Module1),
+ IntStatusItem, ImpStatusItem, !ImpIndirectImports, !Module) -->
+ process_module_short_interfaces(ReadModules, Imports, Ext,
+ IntStatusItem, ImpStatusItem, [], IndirectImports,
+ !ImpIndirectImports, !Module),
( { IndirectImports = [] } ->
- { Module = Module1 }
+ []
;
process_module_short_interfaces_transitively(ReadModules,
- IndirectImports, Ext, Module1, Module)
+ IndirectImports, Ext, IntStatusItem, ImpStatusItem,
+ !ImpIndirectImports, !Module)
).
-process_module_short_interfaces(_, [], _,
- IndirectImports, IndirectImports, Module, Module) --> [].
+process_module_short_interfaces(_, [], _, _, _, !IndirectImports,
+ !ImpIndirectImports, !Module) --> [].
process_module_short_interfaces(ReadModules, [Import | Imports], Ext,
- IndirectImports0, IndirectImports, Module0, Module) -->
- { ModIndirectImports0 = Module0 ^ indirect_deps },
+ IntStatusItem, ImpStatusItem, !IndirectImports,
+ !ImpIndirectImports, !Module) -->
+ { ModIndirectImports0 = !.Module ^ indirect_deps },
(
% check if the imported module has already been imported
- { Import = Module0 ^ module_name
- ; list__member(Import, Module0 ^ parent_deps)
- ; list__member(Import, Module0 ^ int_deps)
- ; list__member(Import, Module0 ^ impl_deps)
+ { Import = !.Module ^ module_name
+ ; list__member(Import, !.Module ^ parent_deps)
+ ; list__member(Import, !.Module ^ int_deps)
+ ; list__member(Import, !.Module ^ impl_deps)
; list__member(Import, ModIndirectImports0)
}
->
process_module_short_interfaces(ReadModules, Imports, Ext,
- IndirectImports0, IndirectImports, Module0, Module)
+ IntStatusItem, ImpStatusItem, !IndirectImports,
+ !ImpIndirectImports, !Module)
;
- { ModItems0 = Module0 ^ items },
- { ModError0 = Module0 ^ error },
- { Module0 ^ maybe_timestamps = yes(_) ->
+ { ModItems0 = !.Module ^ items },
+ { ModError0 = !.Module ^ error },
+ { !.Module ^ maybe_timestamps = yes(_) ->
ReturnTimestamp = yes
;
ReturnTimestamp = no
@@ -5893,35 +6151,47 @@
ReturnTimestamp, ShortIntItems, ShortIntError,
_ImportFileName, MaybeTimestamp),
maybe_record_timestamp(Import, Ext, must_be_qualified,
- MaybeTimestamp, Module0, Module1),
+ MaybeTimestamp, !Module),
- { strip_off_interface_decl(ShortIntItems, Items) },
+ { get_dependencies(ShortIntItems, IntImports1, IntUses1,
+ ImpImports1, ImpUses1) },
+ { replace_section_decls(IntStatusItem, ImpStatusItem,
+ ShortIntItems, Items) },
{ maybe_add_int_error(ShortIntError, ModError0, ModError) },
globals__io_lookup_bool_option(statistics, Statistics),
maybe_report_stats(Statistics),
{ ModIndirectImports = [Import | ModIndirectImports0] },
- { get_dependencies(Items, Imports1, Uses1) },
- { list__append(IndirectImports0, Imports1, IndirectImports1) },
- { list__append(IndirectImports1, Uses1, IndirectImports2) },
- { list__append(ModItems0, Items, ModItems) },
- { Module2 = ((Module1 ^ indirect_deps := ModIndirectImports)
+ { !:IndirectImports = !.IndirectImports ++
+ IntImports1 ++ IntUses1 },
+ { !:ImpIndirectImports = !.ImpIndirectImports ++
+ ImpImports1 ++ ImpUses1 },
+ { ModItems = ModItems0 ++ Items },
+ { !:Module = ((!.Module ^ indirect_deps := ModIndirectImports)
^ items := ModItems)
^ error := ModError },
process_module_short_interfaces(ReadModules, Imports, Ext,
- IndirectImports2, IndirectImports, Module2, Module)
+ IntStatusItem, ImpStatusItem, !IndirectImports,
+ !ImpIndirectImports, !Module)
).
-strip_off_interface_decl(Items0, Items) :-
- (
- Items0 = [ FirstItem | Items1 ],
- FirstItem = module_defn(_, interface) - _
- ->
- Items = Items1
- ;
- Items = Items0
- ).
+replace_section_decls(IntStatusItem, ImpStatusItem, !Items) :-
+ list__map(
+ (pred(Item0::in, Item::out) is det :-
+ (
+ Item0 = module_defn(_, Defn) - _,
+ ( Defn = interface,
+ Item1 = IntStatusItem
+ ; Defn = implementation,
+ Item1 = ImpStatusItem
+ )
+ ->
+ Item = Item1
+ ;
+ Item = Item0
+ )
+ ), !Items).
:- pred maybe_add_int_error(module_error, module_error, module_error).
:- mode maybe_add_int_error(in, in, out) is det.
@@ -5969,6 +6239,51 @@
),
get_children_2(Items, IncludeDeps1, 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, list(module_name)).
+:- mode get_accessible_children(in, out) is det.
+
+get_accessible_children(Items, IncludeDeps) :-
+ get_accessible_children_2(yes, Items, [], IncludeDeps).
+
+:- pred get_accessible_children_2(bool, item_list,
+ list(module_name), list(module_name)).
+:- mode get_accessible_children_2(in, in, in, out) is det.
+
+get_accessible_children_2(_, [], !IncludeDeps).
+get_accessible_children_2(!.Visible, [Item - _ | Items], !IncludeDeps) :-
+ (
+ Item = module_defn(_VarSet, Defn),
+ ( Defn = abstract_imported
+ ; Defn = opt_imported
+ ; Defn = transitively_imported
+ )
+ ->
+ !:Visible = no
+ ;
+ Item = module_defn(_VarSet, Defn),
+ ( Defn = imported(_)
+ ; Defn = used(_)
+ ; Defn = interface
+ ; Defn = implementation
+ ; Defn = private_interface
+ )
+ ->
+ !:Visible = yes
+ ;
+ Item = module_defn(_VarSet, include_module(Modules)),
+ !.Visible = yes
+ ->
+ !:IncludeDeps = !.IncludeDeps ++ Modules
+ ;
+ true
+ ),
+ get_accessible_children_2(!.Visible, Items, !IncludeDeps).
+
%-----------------------------------------------------------------------------%
get_dependencies(Items, ImportDeps, UseDeps) :-
@@ -6353,39 +6668,41 @@
% and `:- implementation'.
% The bodies of instance definitions are removed because
% the instance methods have not yet been module qualified.
-:- pred get_interface(item_list, item_list).
-:- mode get_interface(in, out) is det.
+:- pred get_interface(bool, item_list, item_list).
+:- mode get_interface(in, in, out) is det.
-get_interface(Items0, Items) :-
+get_interface(IncludeImplTypes, Items0, Items) :-
AddToImpl = (func(_, ImplItems) = ImplItems),
- get_interface_and_implementation_2(Items0, no, [], RevItems,
- AddToImpl, unit, _),
+ get_interface_and_implementation_2(IncludeImplTypes, Items0, no,
+ [], RevItems, AddToImpl, unit, _),
list__reverse(RevItems, Items).
-:- pred get_interface_and_implementation(item_list, item_list, item_list).
-:- mode get_interface_and_implementation(in, out, out) is det.
+:- pred get_interface_and_implementation(bool,
+ item_list, item_list, item_list).
+:- mode get_interface_and_implementation(in, in, out, out) is det.
-get_interface_and_implementation(Items0, InterfaceItems,
+get_interface_and_implementation(IncludeImplTypes, Items0, InterfaceItems,
ImplementationItems) :-
AddToImpl = (func(ImplItem, ImplItems) = [ImplItem | ImplItems]),
- get_interface_and_implementation_2(Items0, no, [], RevIntItems,
- AddToImpl, [], RevImplItems),
+ get_interface_and_implementation_2(IncludeImplTypes, Items0, no,
+ [], RevIntItems, AddToImpl, [], RevImplItems),
list__reverse(RevIntItems, InterfaceItems),
list__reverse(RevImplItems, ImplementationItems).
-:- pred get_interface_and_implementation_2(item_list, bool,
+:- pred get_interface_and_implementation_2(bool, item_list, bool,
item_list, item_list, func(item_and_context, T) = T, T, T).
-:- mode get_interface_and_implementation_2(in, in, in, out,
+:- mode get_interface_and_implementation_2(in, in, in, in, out,
in, in, out) is det.
-get_interface_and_implementation_2([], _, IntItems, IntItems, _,
- ImplItems, ImplItems).
-get_interface_and_implementation_2([ItemAndContext | Rest], InInterface0,
- IntItems0, IntItems, AddImplItem, ImplItems0, ImplItems) :-
+get_interface_and_implementation_2(_, [], _, !IntItems, _,
+ !ImplItems).
+get_interface_and_implementation_2(IncludeImplTypes, [ItemAndContext | Rest],
+ InInterface0, !IntItems, AddImplItem, !ImplItems) :-
ItemAndContext = Item - Context,
- ( Item = module_defn(_, interface) ->
- IntItems1 = IntItems0,
- ImplItems1 = ImplItems0,
+ (
+ Item = module_defn(_, interface)
+ ->
+ !:IntItems = [ItemAndContext | !.IntItems],
InInterface1 = yes,
Continue = yes
;
@@ -6395,42 +6712,57 @@
)
->
% Items after here are not part of this module.
- IntItems1 = IntItems0,
- ImplItems1 = ImplItems0,
InInterface1 = no,
Continue = no
;
Item = module_defn(_, implementation)
->
- IntItems1 = IntItems0,
- ImplItems1 = ImplItems0,
+ !:IntItems = [ItemAndContext | !.IntItems],
InInterface1 = no,
Continue = yes
;
( InInterface0 = yes ->
( make_abstract_instance(Item, Item1) ->
ItemToWrite = Item1,
- ImplItems1 = AddImplItem(ItemAndContext,
- ImplItems0)
+ !:ImplItems = AddImplItem(ItemAndContext,
+ !.ImplItems)
;
- ItemToWrite = Item,
- ImplItems1 = ImplItems0
+ ItemToWrite = Item
),
- IntItems1 = [ItemToWrite - Context | IntItems0]
+ !:IntItems = [ItemToWrite - Context | !.IntItems]
;
- IntItems1 = IntItems0,
- ImplItems1 = AddImplItem(ItemAndContext, ImplItems0)
+ !:ImplItems = AddImplItem(ItemAndContext, !.ImplItems),
+ (
+ IncludeImplTypes = yes,
+ include_in_int_file_implementation(Item)
+ ->
+ (
+ make_abstract_defn(Item, int2,
+ ImpItem1)
+ ->
+ ImpItem = ImpItem1
+ ;
+ make_abstract_unify_compare(Item,
+ int2, ImpItem1)
+ ->
+ ImpItem = ImpItem1
+ ;
+ ImpItem = Item
+ ),
+ !:IntItems = [ImpItem - Context | !.IntItems]
+ ;
+ true
+ )
),
InInterface1 = InInterface0,
Continue = yes
),
( Continue = yes ->
- get_interface_and_implementation_2(Rest, InInterface1,
- IntItems1, IntItems, AddImplItem,
- ImplItems1, ImplItems)
+ get_interface_and_implementation_2(IncludeImplTypes,
+ Rest, InInterface1, !IntItems, AddImplItem,
+ !ImplItems)
;
- ImplItems = ImplItems1,
- IntItems = IntItems1
+ true
).
% Given a module interface (well, a list of items), extract the
@@ -6453,52 +6785,50 @@
:- mode get_short_interface(in, in, out) is det.
get_short_interface(Items0, Kind, Items) :-
- get_short_interface_2(Items0, [], [], no, Kind,
- RevItems, RevImports, NeedsImports),
+ get_short_interface_2(Items0, Kind, [], RevItems),
list__reverse(RevItems, Items1),
- ( NeedsImports = yes ->
- list__reverse(RevImports, Imports1),
- list__append(Imports1, Items1, Items)
+ maybe_strip_import_decls(Items1, Items).
+
+:- pred maybe_strip_import_decls(item_list, item_list).
+:- mode maybe_strip_import_decls(in, out) is det.
+
+maybe_strip_import_decls(Items0, Items) :-
+ (
+ some [Item] (
+ list__member(Item - _, Items0),
+ item_needs_imports(Item) = yes
+ )
+ ->
+ Items = list__filter(
+ (pred((ThisItem - _)::in) is semidet :-
+ \+ (
+ ThisItem = module_defn(_, Defn),
+ ( Defn = imported(_)
+ ; Defn = used(_)
+ )
+ )
+ ), Items0)
;
- Items = Items1
+ Items = Items0
).
-:- pred get_short_interface_2(item_list, item_list, item_list, bool,
- short_interface_kind, item_list, item_list, bool).
-:- mode get_short_interface_2(in, in, in, in, in, out, out, out) is det.
+:- pred get_short_interface_2(item_list, short_interface_kind,
+ item_list, item_list).
+:- mode get_short_interface_2(in, in, in, out) is det.
-get_short_interface_2([], Items, Imports, NeedsImports, _Kind,
- Items, Imports, NeedsImports).
-get_short_interface_2([ItemAndContext | Rest], Items0, Imports0, NeedsImports0,
- Kind, Items, Imports, NeedsImports) :-
+get_short_interface_2([], _Kind, Items, Items).
+get_short_interface_2([ItemAndContext | Rest], Kind, Items0, Items) :-
ItemAndContext = Item0 - Context,
- ( Item0 = module_defn(_, import(_)) ->
- Items1 = Items0,
- Imports1 = [ItemAndContext | Imports0],
- NeedsImports1 = NeedsImports0
- ; Item0 = module_defn(_, use(_)) ->
- Items1 = Items0,
- Imports1 = [ItemAndContext | Imports0],
- NeedsImports1 = NeedsImports0
- ; make_abstract_defn(Item0, Kind, Item1) ->
- Imports1 = Imports0,
- Items1 = [Item1 - Context | Items0],
- NeedsImports1 = NeedsImports0
+ ( make_abstract_defn(Item0, Kind, Item1) ->
+ Items1 = [Item1 - Context | Items0]
; make_abstract_unify_compare(Item0, Kind, Item1) ->
- Imports1 = Imports0,
- Items1 = [Item1 - Context | Items0],
- NeedsImports1 = NeedsImports0
+ Items1 = [Item1 - Context | Items0]
; include_in_short_interface(Item0) ->
- Imports1 = Imports0,
- Items1 = [ItemAndContext | Items0],
- NeedsImports1 = yes
- ;
- Items1 = Items0,
- Imports1 = Imports0,
- NeedsImports1 = NeedsImports0
+ Items1 = [ItemAndContext | Items0]
+ ;
+ Items1 = Items0
),
- get_short_interface_2(Rest, Items1, Imports1, NeedsImports1, Kind,
- Items, Imports, NeedsImports).
+ get_short_interface_2(Rest, Kind, Items1, Items).
:- pred include_in_short_interface(item).
:- mode include_in_short_interface(in) is semidet.
@@ -6509,6 +6839,43 @@
include_in_short_interface(module_defn(_, _)).
include_in_short_interface(instance(_, _, _, _, _, _)).
+:- func item_needs_imports(item) = bool.
+
+item_needs_imports(clause(_, _, _, _, _)) = yes.
+item_needs_imports(Item @ type_defn(_, _, _, _, _)) =
+ ( Item ^ td_ctor_defn = abstract_type(_) -> no ; yes ).
+item_needs_imports(inst_defn(_, _, _, _, _)) = yes.
+item_needs_imports(mode_defn(_, _, _, _, _)) = yes.
+item_needs_imports(module_defn(_, _)) = no.
+item_needs_imports(pragma(_)) = yes.
+item_needs_imports(pred_or_func(_, _, _, _, _, _, _, _, _, _, _, _)) = yes.
+item_needs_imports(pred_or_func_mode(_, _, _, _, _, _, _)) = yes.
+item_needs_imports(Item @ typeclass(_, _, _, _, _)) =
+ (
+ Item ^ tc_class_methods = abstract,
+ \+ (
+ list__member(Constraint, Item ^ tc_constraints),
+ Constraint = constraint(_, ConstraintArgs),
+ list__member(ConstraintArg, ConstraintArgs),
+ ConstraintArg \= term__variable(_)
+ )
+ ->
+ no
+ ;
+ yes
+ ).
+item_needs_imports(instance(_, _, _, _, _, _)) = yes.
+item_needs_imports(promise(_, _, _, _)) = yes.
+item_needs_imports(nothing(_)) = no.
+
+:- pred include_in_int_file_implementation(item).
+:- mode include_in_int_file_implementation(in) is semidet.
+
+include_in_int_file_implementation(type_defn(_, _, _, _, _)).
+include_in_int_file_implementation(module_defn(_, Defn)) :-
+ Defn \= external(_).
+include_in_int_file_implementation(typeclass(_, _, _, _, _)).
+
:- pred make_abstract_defn(item, short_interface_kind, item).
:- mode make_abstract_defn(in, in, out) is semidet.
@@ -6537,6 +6904,12 @@
% types only for the `.int3' files.
ShortInterfaceKind = int3,
IsSolverType = non_solver_type
+ ;
+ TypeDefn = foreign_type(_, _),
+ % We always need the definitions of foreign types
+ % to handle inter-language interfacing correctly.
+ IsSolverType = non_solver_type,
+ semidet_fail
).
make_abstract_defn(instance(_, _, _, _, _, _) @ Item0, int2, Item) :-
make_abstract_instance(Item0, Item).
@@ -6549,10 +6922,16 @@
make_abstract_unify_compare(type_defn(VarSet, Name, Args, TypeDefn0, Cond),
int2,
type_defn(VarSet, Name, Args, TypeDefn, Cond)) :-
- TypeDefn0 = du_type(Constructors, IsSolverType, yes(_UnifyCompare)),
- TypeDefn = du_type(Constructors, IsSolverType,
- yes(abstract_noncanonical_type)).
-
+ (
+ TypeDefn0 = du_type(Constructors, IsSolverType,
+ yes(_UnifyCompare)),
+ TypeDefn = du_type(Constructors, IsSolverType,
+ yes(abstract_noncanonical_type))
+ ;
+ TypeDefn0 = foreign_type(ForeignType, yes(_)),
+ TypeDefn = foreign_type(ForeignType,
+ yes(abstract_noncanonical_type))
+ ).
% All instance declarations must be written
% to `.int' files as abstract instance
Index: compiler/parse_tree.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/parse_tree.m,v
retrieving revision 1.3
diff -u -u -r1.3 parse_tree.m
--- compiler/parse_tree.m 15 Mar 2003 03:09:04 -0000 1.3
+++ compiler/parse_tree.m 24 Nov 2003 14:33:23 -0000
@@ -17,6 +17,7 @@
:- import_module libs.
:- import_module hlds. % XXX for hlds_data__cons_id
:- import_module backend_libs. % XXX for `foreign'
+:- import_module recompilation.
% The parse tree data type itself.
:- include_module prog_data.
Index: compiler/pd_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_debug.m,v
retrieving revision 1.8
diff -u -u -r1.8 pd_debug.m
--- compiler/pd_debug.m 5 Nov 2003 03:17:42 -0000 1.8
+++ compiler/pd_debug.m 25 Nov 2003 12:58:21 -0000
@@ -17,7 +17,7 @@
:- import_module parse_tree__prog_data.
:- import_module transform_hlds__pd_info.
-:- import_module list, string.
+:- import_module io, list, string.
:- pred pd_debug__do_io(pred(io__state, io__state)::pred(di, uo) is det,
pd_info::pd_info_di, pd_info::pd_info_uo) is det.
@@ -60,7 +60,7 @@
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__prog_out.
-:- import_module bool, io, set, std_util.
+:- import_module bool, set, std_util.
pd_debug__do_io(Pred) -->
pd_debug__do_output(DoOutput),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.247
diff -u -u -r1.247 polymorphism.m
--- compiler/polymorphism.m 31 Oct 2003 03:27:27 -0000 1.247
+++ compiler/polymorphism.m 26 Nov 2003 13:00:30 -0000
@@ -354,8 +354,6 @@
:- import_module hlds__quantification.
:- import_module libs__globals.
:- import_module libs__options.
-:- import_module ll_backend__code_util.
-:- import_module ll_backend__llds.
:- import_module parse_tree__inst.
:- import_module parse_tree__prog_io.
:- import_module parse_tree__prog_out.
@@ -2769,7 +2767,13 @@
polymorphism__init_type_info_var(Type, ArgVars, MaybePreferredVar, TypeInfoVar,
TypeInfoGoal, !VarSet, !VarTypes) :-
- ConsId = cell_cons_id(type_info_cell),
+ ( type_to_ctor_and_args(Type, Ctor, _) ->
+ Cell = type_info_cell(Ctor)
+ ;
+ error(
+ "polymorphism__init_type_info_var: type_to_ctor_and_args failed")
+ ),
+ ConsId = cell_cons_id(Cell),
TypeInfoTerm = functor(ConsId, no, ArgVars),
% introduce a new variable
@@ -2801,7 +2805,7 @@
% note that we could perhaps be more accurate than
% `ground(shared)', but it shouldn't make any
% difference.
- InstConsId = cell_inst_cons_id(type_info_cell, NumArgVars),
+ InstConsId = cell_inst_cons_id(Cell, NumArgVars),
instmap_delta_from_assoc_list(
[TypeInfoVar - bound(unique, [functor(InstConsId, ArgInsts)])],
InstMapDelta),
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.59
diff -u -u -r1.59 post_typecheck.m
--- compiler/post_typecheck.m 31 Oct 2003 03:27:27 -0000 1.59
+++ compiler/post_typecheck.m 25 Nov 2003 12:50:00 -0000
@@ -37,7 +37,7 @@
:- import_module hlds__hlds_pred.
:- import_module parse_tree__prog_data.
-:- import_module list, io, bool, std_util.
+:- import_module list, io, bool, std_util, term.
% post_typecheck__finish_preds(PredIds, ReportTypeErrors,
% NumErrors, FoundTypeError, Module0, Module)
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.100
diff -u -u -r1.100 prog_data.m
--- compiler/prog_data.m 5 Nov 2003 06:05:25 -0000 1.100
+++ compiler/prog_data.m 26 Nov 2003 08:46:41 -0000
@@ -56,8 +56,15 @@
cl_body :: goal
)
- % `:- type ...':
+ % `:- type ...' or `:- type_impl':
% a definition of a type, or a declaration of an abstract type.
+ % The compiler places `:- type_impl' declarations in `.int'
+ % and `.int2' files to propagate definitions of abstract
+ % foreign types and equivalence types which should not be
+ % visible to importing modules (and shouldn't be used when
+ % typechecking those modules), but which are necessary for
+ % code generation. For examples the MS Common Language Runtime
+ % doesn't support equivalence types.
; type_defn(
td_tvarset :: tvarset,
td_ctor_name :: sym_name,
@@ -257,16 +264,6 @@
% VarNames, Foreign Code Implementation Info
)
- ; foreign_type(
- type_lang :: foreign_language_type,
- type_tvarset :: tvarset,
- type_name :: sym_name,
- type_params :: list(type_param),
- type_unifycompare :: maybe(unify_compare)
- % ForeignType, TVarSet, MercuryTypeName,
- % MercuryTypeParams, UnifyAndCompare
- )
-
; foreign_import_module(
imp_lang :: foreign_language,
imp_module :: module_name
@@ -1021,7 +1018,9 @@
:- type type_defn
---> du_type(list(constructor), is_solver_type, maybe(unify_compare))
; eqv_type(type)
- ; abstract_type(is_solver_type).
+ ; abstract_type(is_solver_type)
+ ; foreign_type(foreign_language_type, maybe(unify_compare))
+ .
:- type constructor
---> ctor(
@@ -1234,6 +1233,11 @@
% `:- use_module', and items from `.opt'
% and `.int2' files. It also records from which
% section the module was imported.
+ ; abstract_imported
+ % This is used internally by the compiler,
+ % to identify items which originally
+ % came from the implementation section
+ % of an interface file.
; opt_imported
% This is used internally by the compiler,
% to identify items which originally
@@ -1270,7 +1274,8 @@
:- type import_locn
---> implementation
; interface
- ; ancestor.
+ ; ancestor
+ ; ancestor_private_interface.
:- type sym_list
---> sym(list(sym_specifier))
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.61
diff -u -u -r1.61 prog_io_pragma.m
--- compiler/prog_io_pragma.m 5 Nov 2003 03:17:42 -0000 1.61
+++ compiler/prog_io_pragma.m 24 Nov 2003 14:33:23 -0000
@@ -48,14 +48,16 @@
UnifyCompareResult = ok(MaybeUserEqCompare),
(
MaybeUserEqCompare = yes(_),
- Result0 = ok(Pragma)
+ Result0 = ok(Item0)
->
(
- Pragma = pragma(foreign_type(A,
- B, C, D, _))
+ Item0 = type_defn(_, _, _, _, _),
+ foreign_type(Type, _) =
+ Item0 ^ td_ctor_defn
->
- Result = ok(pragma(foreign_type(A,
- B, C, D, MaybeUserEqCompare)))
+ Result = ok(Item0 ^ td_ctor_defn :=
+ foreign_type(Type,
+ MaybeUserEqCompare))
;
Result = error(
"unexpected `where equality/comparison is'",
@@ -112,17 +114,17 @@
MercuryTypeTerm, ErrorTerm,
MaybeTypeDefnHead),
(
- MaybeTypeDefnHead = ok(
- MercuryTypeSymName,
- MercuryArgs0),
+ MaybeTypeDefnHead =
+ ok(MercuryTypeSymName,
+ MercuryArgs0),
varset__coerce(VarSet, TVarSet),
MercuryArgs = list__map(term__coerce,
- MercuryArgs0),
- Result = ok(pragma(
- foreign_type(ForeignType,
- TVarSet,
- MercuryTypeSymName,
- MercuryArgs, no)))
+ MercuryArgs0),
+ Result = ok(type_defn(TVarSet,
+ MercuryTypeSymName,
+ MercuryArgs,
+ foreign_type(ForeignType, no),
+ true))
;
MaybeTypeDefnHead =
error(String, Term),
@@ -132,14 +134,15 @@
MaybeForeignType = error(String, Term),
Result = error(String, Term)
)
- ;
- Result = error("invalid foreign language in " ++
- "`:- pragma foreign_type' declaration",
- LangTerm)
+ ;
+ Result = error(
+ "invalid foreign language in `:- pragma foreign_type' declaration",
+ LangTerm)
)
;
- Result = error("wrong number of arguments in " ++
- "`:- pragma foreign_type' declaration", ErrorTerm)
+ Result = error(
+ "wrong number of arguments in `:- pragma foreign_type' declaration",
+ ErrorTerm)
).
parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms, ErrorTerm,
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.22
diff -u -u -r1.22 prog_rep.m
--- compiler/prog_rep.m 27 Oct 2003 06:00:35 -0000 1.22
+++ compiler/prog_rep.m 26 Nov 2003 13:08:08 -0000
@@ -105,7 +105,7 @@
Rep = "$type_ctor_info_const".
prog_rep__represent_cons_id(base_typeclass_info_const(_, _, _, _), Rep) :-
Rep = "$base_typeclass_info_const".
-prog_rep__represent_cons_id(type_info_cell_constructor, Rep) :-
+prog_rep__represent_cons_id(type_info_cell_constructor(_), Rep) :-
Rep = "$type_info_cell_constructor".
prog_rep__represent_cons_id(typeclass_info_cell_constructor, Rep) :-
Rep = "$typeclass_info_cell_constructor".
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.4
diff -u -u -r1.4 recompilation.check.m
--- compiler/recompilation.check.m 24 Oct 2003 06:17:47 -0000 1.4
+++ compiler/recompilation.check.m 26 Nov 2003 04:45:01 -0000
@@ -687,9 +687,8 @@
{ Recorded = bool__no },
read_mod_if_changed(ImportedModuleName, Suffix,
"Reading interface file for module",
- yes, RecordedTimestamp, Items0, Error,
- FileName, MaybeNewTimestamp),
- { strip_off_interface_decl(Items0, Items) }
+ yes, RecordedTimestamp, Items, Error,
+ FileName, MaybeNewTimestamp)
),
{
MaybeNewTimestamp = yes(NewTimestamp),
@@ -705,7 +704,9 @@
),
(
MaybeUsedItemsTerm = yes(UsedItemsTerm),
- Items = [VersionNumberItem | OtherItems],
+ Items = [InterfaceItem, VersionNumberItem
+ | OtherItems],
+ InterfaceItem = module_defn(_, interface) - _,
VersionNumberItem = module_defn(_,
version_numbers(_, VersionNumbers)) - _
->
@@ -1135,6 +1136,7 @@
TypeCtor, du_type(Ctors, _, _)) -->
list__foldl(check_functor_ambiguities(NeedQualifier, TypeCtor),
Ctors).
+check_type_defn_ambiguity_with_functor(_, _, foreign_type(_, _)) --> [].
:- pred check_functor_ambiguities(need_qualifier::in, type_ctor::in,
constructor::in, recompilation_check_info::in,
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.10
diff -u -u -r1.10 recompilation.usage.m
--- compiler/recompilation.usage.m 24 Oct 2003 06:17:47 -0000 1.10
+++ compiler/recompilation.usage.m 26 Nov 2003 04:45:01 -0000
@@ -79,6 +79,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module check_hlds.
:- import_module check_hlds__type_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_out.
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.6
diff -u -u -r1.6 recompilation.version.m
--- compiler/recompilation.version.m 25 Jul 2003 02:27:23 -0000 1.6
+++ compiler/recompilation.version.m 26 Nov 2003 05:50:36 -0000
@@ -36,6 +36,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module check_hlds.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
:- import_module hlds__hlds_out.
@@ -50,18 +51,19 @@
recompilation__version__compute_version_numbers(SourceFileTime, Items,
MaybeOldItems,
version_numbers(ItemVersionNumbers, InstanceVersionNumbers)) :-
- recompilation__version__gather_items(Items,
+ recompilation__version__gather_items(implementation, Items,
GatheredItems, InstanceItems),
(
MaybeOldItems = yes(OldItems0),
- OldItems0 = [VersionNumberItem | OldItems],
+ OldItems0 = [FirstItem, VersionNumberItem | OldItems],
+ FirstItem = module_defn(_, interface) - _,
VersionNumberItem = module_defn(_,
version_numbers(_, OldVersionNumbers)) - _
->
OldVersionNumbers = version_numbers(OldItemVersionNumbers,
OldInstanceVersionNumbers),
- recompilation__version__gather_items(OldItems, GatheredOldItems,
- OldInstanceItems)
+ recompilation__version__gather_items(implementation,
+ OldItems, GatheredOldItems, OldInstanceItems)
;
% There were no old version numbers, so every item
% gets the same timestamp as the source module.
@@ -134,15 +136,16 @@
InstanceItems
).
-:- pred recompilation__version__gather_items(item_list::in,
+:- pred recompilation__version__gather_items(section::in, item_list::in,
gathered_items::out, instance_item_map::out) is det.
-recompilation__version__gather_items(Items, GatheredItems, Instances) :-
+recompilation__version__gather_items(Section,
+ Items, GatheredItems, Instances) :-
list__reverse(Items, RevItems),
Info0 = gathered_item_info(init_item_id_set(map__init),
[], [], map__init),
- list__foldl(recompilation__version__gather_items_2, RevItems,
- Info0, Info1),
+ list__foldl2(recompilation__version__gather_items_2, RevItems,
+ Section, _, Info0, Info1),
%
% Items which could appear in _OtherItems (those which aren't
@@ -158,10 +161,10 @@
GatheredItems1, GatheredItems).
:- pred distribute_pragma_items(
- pair(maybe_pred_or_func_id, item_and_context)::in,
+ {maybe_pred_or_func_id, item_and_context, section}::in,
gathered_items::in, gathered_items::out) is det.
-distribute_pragma_items(ItemId - ItemAndContext,
+distribute_pragma_items({ItemId, ItemAndContext, Section},
GatheredItems0, GatheredItems) :-
ItemId = MaybePredOrFunc - SymName / Arity,
ItemAndContext = Item - ItemContext,
@@ -180,17 +183,17 @@
ItemType = pred_or_func_to_item_type(PredOrFunc),
recompilation__version__add_gathered_item(Item,
item_id(ItemType, SymName - Arity),
- ItemContext, AddIfNotExisting,
+ ItemContext, Section, AddIfNotExisting,
GatheredItems0, GatheredItems2)
;
MaybePredOrFunc = no,
recompilation__version__add_gathered_item(Item,
item_id(predicate, SymName - Arity),
- ItemContext, AddIfNotExisting,
+ ItemContext, Section, AddIfNotExisting,
GatheredItems0, GatheredItems1),
recompilation__version__add_gathered_item(Item,
item_id(function, SymName - Arity),
- ItemContext, AddIfNotExisting,
+ ItemContext, Section, AddIfNotExisting,
GatheredItems1, GatheredItems2)
),
@@ -200,7 +203,7 @@
(
% Does this pragma match any of the methods
% of this class.
- list__member(ClassItem, ClassItems0),
+ list__member(_ - ClassItem, ClassItems0),
ClassItem = typeclass(_, _, _, Interface, _) - _,
Interface = concrete(Methods),
list__member(Method, Methods),
@@ -221,7 +224,7 @@
)
->
% XXX O(N^2), but shouldn't happen too often.
- ClassItems = ClassItems0 ++ [ItemAndContext]
+ ClassItems = ClassItems0 ++ [Section - ItemAndContext]
;
ClassItems = ClassItems0
)
@@ -232,24 +235,35 @@
:- type gathered_item_info
---> gathered_item_info(
gathered_items :: gathered_items,
- pragma_items :: assoc_list(maybe_pred_or_func_id,
- item_and_context),
+ pragma_items :: list({maybe_pred_or_func_id,
+ item_and_context, section}),
other_items :: item_list,
instances :: instance_item_map
).
-:- type instance_item_map == map(item_name, item_list).
+:- type instance_item_map ==
+ map(item_name, assoc_list(section, item_and_context)).
% The constructors set should always be empty.
:- type gathered_items == item_id_set(gathered_item_map).
-:- type gathered_item_map == map(pair(string, arity), item_list).
+:- type gathered_item_map == map(pair(string, arity),
+ assoc_list(section, item_and_context)).
:- pred recompilation__version__gather_items_2(item_and_context::in,
+ section::in, section::out,
gathered_item_info::in, gathered_item_info::out) is det.
-recompilation__version__gather_items_2(ItemAndContext) -->
+recompilation__version__gather_items_2(ItemAndContext, !Section) -->
{ ItemAndContext = Item - ItemContext },
(
+ { Item = module_defn(_, interface) }
+ ->
+ { !:Section = interface }
+ ;
+ { Item = module_defn(_, implementation) }
+ ->
+ { !:Section = implementation }
+ ;
{ Item = type_defn(VarSet, Name, Args, Body, Cond) }
->
(
@@ -270,14 +284,18 @@
% always use the body.
{ NameItem = Item },
{ BodyItem = Item }
+ ;
+ { Body = foreign_type(_, _) },
+ { NameItem = Item },
+ { BodyItem = Item }
),
{ TypeCtor = Name - list__length(Args) },
GatheredItems0 =^ gathered_items,
{ recompilation__version__add_gathered_item(NameItem,
- item_id((type), TypeCtor), ItemContext,
+ item_id((type), TypeCtor), ItemContext, !.Section,
yes, GatheredItems0, GatheredItems1) },
{ recompilation__version__add_gathered_item(BodyItem,
- item_id(type_body, TypeCtor), ItemContext,
+ item_id(type_body, TypeCtor), ItemContext, !.Section,
yes, GatheredItems1, GatheredItems) },
^ gathered_items := GatheredItems
;
@@ -294,7 +312,8 @@
{ InstanceItems = [] }
),
{ map__set(Instances0, ClassName - ClassArity,
- [Item - ItemContext | InstanceItems], Instances) },
+ [!.Section - (Item - ItemContext) | InstanceItems],
+ Instances) },
^ instances := Instances
;
% For predicates or functions defined using `with_inst`
@@ -310,11 +329,11 @@
GatheredItems0 =^ gathered_items,
{ ItemName = SymName - list__length(Modes) },
{ recompilation__version__add_gathered_item(Item,
- item_id(predicate, ItemName), ItemContext,
+ item_id(predicate, ItemName), ItemContext, !.Section,
yes, GatheredItems0, GatheredItems1) },
{ recompilation__version__add_gathered_item(Item,
item_id(function, ItemName), ItemContext,
- yes, GatheredItems1, GatheredItems) },
+ !.Section, yes, GatheredItems1, GatheredItems) },
^ gathered_items := GatheredItems
;
@@ -322,25 +341,27 @@
->
GatheredItems0 =^ gathered_items,
{ recompilation__version__add_gathered_item(Item, ItemId,
- ItemContext, yes, GatheredItems0, GatheredItems) },
+ ItemContext, !.Section, yes,
+ GatheredItems0, GatheredItems) },
^ gathered_items := GatheredItems
;
{ Item = pragma(PragmaType) },
{ is_pred_pragma(PragmaType, yes(PredOrFuncId)) }
->
PragmaItems =^ pragma_items,
- ^ pragma_items := [PredOrFuncId - ItemAndContext | PragmaItems]
+ ^ pragma_items :=
+ [{PredOrFuncId, ItemAndContext, !.Section} | PragmaItems]
;
OtherItems =^ other_items,
^ other_items := [ItemAndContext | OtherItems]
).
:- pred recompilation__version__add_gathered_item(item::in, item_id::in,
- prog_context::in, bool::in, gathered_items::in,
+ prog_context::in, section::in, bool::in, gathered_items::in,
gathered_items::out) is det.
recompilation__version__add_gathered_item(Item, ItemId, ItemContext,
- AddIfNotExisting, GatheredItems0, GatheredItems) :-
+ Section, AddIfNotExisting, GatheredItems0, GatheredItems) :-
ItemId = item_id(ItemType, Id),
Id = SymName - Arity,
unqualify_name(SymName, Name),
@@ -355,16 +376,18 @@
GatheredItems = GatheredItems0
;
recompilation__version__add_gathered_item_2(Item, ItemType,
- NameArity, ItemContext, MatchingItems,
+ NameArity, ItemContext, Section, MatchingItems,
GatheredItems0, GatheredItems)
).
:- pred recompilation__version__add_gathered_item_2(item::in, item_type::in,
- pair(string, arity)::in, prog_context::in, item_list::in,
- gathered_items::in, gathered_items::out) is det.
+ pair(string, arity)::in, prog_context::in, section::in,
+ assoc_list(section, item_and_context)::in,
+ gathered_items::in, gathered_items::out) is det.
recompilation__version__add_gathered_item_2(Item, ItemType, NameArity,
- ItemContext, MatchingItems0, GatheredItems0, GatheredItems) :-
+ ItemContext, Section, MatchingItems0,
+ GatheredItems0, GatheredItems) :-
% mercury_to_mercury.m splits combined pred and mode
% declarations. That needs to be done here as well
@@ -399,8 +422,8 @@
PredOrFuncModeItem = pred_or_func_mode(InstVarSet,
MaybePredOrFunc, PredName, Modes, WithInst, Det, Cond),
MatchingItems =
- [PredOrFuncItem - ItemContext,
- PredOrFuncModeItem - ItemContext
+ [Section - (PredOrFuncItem - ItemContext),
+ Section - (PredOrFuncModeItem - ItemContext)
| MatchingItems0]
;
Item = typeclass(Constraints, ClassName, ClassArgs,
@@ -412,9 +435,11 @@
list__condense(MethodsList, Methods),
TypeclassItem = typeclass(Constraints, ClassName, ClassArgs,
concrete(Methods), ClassTVarSet),
- MatchingItems = [TypeclassItem - ItemContext | MatchingItems0]
+ MatchingItems = [Section - (TypeclassItem - ItemContext)
+ | MatchingItems0]
;
- MatchingItems = [Item - ItemContext| MatchingItems0]
+ MatchingItems = [Section - (Item - ItemContext)
+ | MatchingItems0]
),
IdMap0 = extract_ids(GatheredItems0, ItemType),
@@ -543,7 +568,6 @@
is_pred_pragma(foreign_proc(_, Name, PredOrFunc, Args, _, _),
yes(yes(PredOrFunc) - Name / Arity)) :-
adjust_func_arity(PredOrFunc, Arity, list__length(Args)).
-is_pred_pragma(foreign_type(_, _, _, _, _), no).
is_pred_pragma(type_spec(Name, _, Arity, MaybePredOrFunc, _, _, _, _),
yes(MaybePredOrFunc - Name / Arity)).
is_pred_pragma(inline(Name, Arity), yes(no - Name / Arity)).
@@ -585,10 +609,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(item_list::in, item_list::in) is semidet.
+:- pred items_are_unchanged(assoc_list(section, item_and_context)::in,
+ assoc_list(section, item_and_context)::in) is semidet.
items_are_unchanged([], []).
-items_are_unchanged([Item1 - _ | Items1], [Item2 - _ | Items2]) :-
+items_are_unchanged([Section - (Item1 - _) | Items1],
+ [Section - (Item2 - _) | Items2]) :-
yes = item_is_unchanged(Item1, Item2),
items_are_unchanged(Items1, Items2).
@@ -621,21 +647,21 @@
% from an interface file.
:- func item_is_unchanged(item, item) = bool.
-item_is_unchanged(type_defn(_VarSet, Name, Args, Defn, Cond), Item2) =
- ( Item2 = type_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
+item_is_unchanged(type_defn(_, Name, Args, Defn, Cond), Item2) =
+ ( Item2 = type_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
item_is_unchanged(mode_defn(_VarSet, Name, Args, Defn, Cond), Item2) =
- ( Item2 = mode_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
+ ( Item2 = mode_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
item_is_unchanged(inst_defn(_VarSet, Name, Args, Defn, Cond), Item2) =
- ( Item2 = inst_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
+ ( Item2 = inst_defn(_, Name, Args, Defn, Cond) -> yes ; no ).
item_is_unchanged(module_defn(_VarSet, Defn), Item2) =
- ( Item2 = module_defn(_, Defn) -> yes ; no ).
+ ( Item2 = module_defn(_, Defn) -> yes ; no ).
item_is_unchanged(instance(Constraints, Name, Types, Body, _VarSet, Module),
Item2) =
- ( Item2 = instance(Constraints, Name, Types, Body, _, Module) ->
- yes
- ;
- no
- ).
+ ( Item2 = instance(Constraints, Name, Types, Body, _, Module) ->
+ yes
+ ;
+ no
+ ).
% XXX Need to compare the goals properly in clauses and assertions.
% That's not necessary at the moment because smart recompilation
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.35
diff -u -u -r1.35 rl_exprn.m
--- compiler/rl_exprn.m 5 Nov 2003 03:17:43 -0000 1.35
+++ compiler/rl_exprn.m 26 Nov 2003 12:58:15 -0000
@@ -513,7 +513,7 @@
rl_exprn__set_term_arg_cons_id_code(base_typeclass_info_const(_, _, _, _),
_, _, _, _, _, _) -->
{ error("rl_exprn__set_term_arg_cons_id_code") }.
-rl_exprn__set_term_arg_cons_id_code(type_info_cell_constructor,
+rl_exprn__set_term_arg_cons_id_code(type_info_cell_constructor(_),
_, _, _, _, _, _) -->
{ error("rl_exprn__set_term_arg_cons_id_code") }.
rl_exprn__set_term_arg_cons_id_code(typeclass_info_cell_constructor,
@@ -1166,7 +1166,7 @@
{ ConsId = base_typeclass_info_const(_, _, _, _) },
{ error("rl_exprn__unify: unsupported cons_id - base_typeclass_info_const") }
;
- { ConsId = type_info_cell_constructor },
+ { ConsId = type_info_cell_constructor(_) },
% XXX for now we ignore these and hope it doesn't matter.
{ Code = empty }
;
Index: compiler/rl_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_gen.m,v
retrieving revision 1.14
diff -u -u -r1.14 rl_gen.m
--- compiler/rl_gen.m 5 Nov 2003 03:17:43 -0000 1.14
+++ compiler/rl_gen.m 24 Nov 2003 14:33:23 -0000
@@ -41,8 +41,6 @@
:- import_module libs__globals.
:- import_module libs__options.
:- import_module libs__tree.
-:- import_module ll_backend__code_aux.
-:- import_module ll_backend__code_util.
:- import_module parse_tree__inst.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/rl_relops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_relops.m,v
retrieving revision 1.8
diff -u -u -r1.8 rl_relops.m
--- compiler/rl_relops.m 5 Nov 2003 03:17:43 -0000 1.8
+++ compiler/rl_relops.m 24 Nov 2003 14:33:23 -0000
@@ -108,7 +108,6 @@
:- import_module libs__globals.
:- import_module libs__options.
:- import_module libs__tree.
-:- import_module ll_backend__code_aux.
:- import_module int, map, require, set.
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.125
diff -u -u -r1.125 simplify.m
--- compiler/simplify.m 28 Nov 2003 02:23:07 -0000 1.125
+++ compiler/simplify.m 28 Nov 2003 03:00:34 -0000
@@ -98,8 +98,6 @@
:- import_module hlds__special_pred.
:- import_module libs__options.
:- import_module libs__trace_params.
-:- import_module ll_backend__code_util.
-:- import_module ll_backend__follow_code.
:- import_module parse_tree__inst.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_util.
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.3
diff -u -u -r1.3 size_prof.m
--- compiler/size_prof.m 24 Oct 2003 06:17:48 -0000 1.3
+++ compiler/size_prof.m 26 Nov 2003 13:13:09 -0000
@@ -569,7 +569,7 @@
->
( VarTypeCtorName = "type_info" ->
(
- ConsId = type_info_cell_constructor,
+ ConsId = type_info_cell_constructor(_),
Args = [TypeCtorInfoVar | ArgTypeInfoVars]
->
record_known_type_info(Var, TypeCtorInfoVar,
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.7
diff -u -u -r1.7 transform_hlds.m
--- compiler/transform_hlds.m 22 Oct 2003 07:05:17 -0000 1.7
+++ compiler/transform_hlds.m 24 Nov 2003 14:33:23 -0000
@@ -20,6 +20,8 @@
:- include_module dependency_graph. % XXX imports llds (for profiling labels)
+:- include_module equiv_type_hlds.
+
:- include_module table_gen.
:- include_module (lambda).
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.132
diff -u -u -r1.132 type_util.m
--- compiler/type_util.m 21 Nov 2003 15:21:36 -0000 1.132
+++ compiler/type_util.m 26 Nov 2003 13:04:00 -0000
@@ -552,7 +552,7 @@
:- mode maybe_get_higher_order_arg_types(in, in, out) is det.
:- type polymorphism_cell
- ---> type_info_cell
+ ---> type_info_cell(type_ctor)
; typeclass_info_cell.
:- func cell_cons_id(polymorphism_cell) = cons_id.
@@ -1332,10 +1332,10 @@
ConsId = cons(Name, OrigArity),
InstConsId = ConsId
;
- ConsId0 = type_info_cell_constructor
+ ConsId0 = type_info_cell_constructor(CellCtor)
->
- ConsId = type_info_cell_constructor,
- InstConsId = cell_inst_cons_id(type_info_cell,
+ ConsId = ConsId0,
+ InstConsId = cell_inst_cons_id(type_info_cell(CellCtor),
list__length(Args))
;
ConsId0 = typeclass_info_cell_constructor
@@ -2041,14 +2041,14 @@
%-----------------------------------------------------------------------------%
-cell_cons_id(type_info_cell) = type_info_cell_constructor.
+cell_cons_id(type_info_cell(Ctor)) = type_info_cell_constructor(Ctor).
cell_cons_id(typeclass_info_cell) = typeclass_info_cell_constructor.
cell_inst_cons_id(Which, Arity) = InstConsId :-
% Soon neither of these function symbols will exist,
% even with fake arity, but they do not need to.
(
- Which = type_info_cell,
+ Which = type_info_cell(_),
Symbol = "type_info"
;
Which = typeclass_info_cell,
@@ -2057,7 +2057,7 @@
PrivateBuiltin = mercury_private_builtin_module,
InstConsId = cons(qualified(PrivateBuiltin, Symbol), Arity).
-cell_type_name(type_info_cell) = "type_info".
+cell_type_name(type_info_cell(_)) = "type_info".
cell_type_name(typeclass_info_cell) = "typeclass_info".
%-----------------------------------------------------------------------------%
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.128
diff -u -u -r1.128 unify_proc.m
--- compiler/unify_proc.m 20 Nov 2003 11:35:41 -0000 1.128
+++ compiler/unify_proc.m 24 Nov 2003 14:33:23 -0000
@@ -149,8 +149,6 @@
:- import_module libs__globals.
:- import_module libs__options.
:- import_module libs__tree.
-:- import_module ll_backend__code_info.
-:- import_module ll_backend__code_util.
:- import_module parse_tree__inst.
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__prog_out.
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.78
diff -u -u -r1.78 unique_modes.m
--- compiler/unique_modes.m 6 Nov 2003 03:42:36 -0000 1.78
+++ compiler/unique_modes.m 24 Nov 2003 14:33:23 -0000
@@ -73,7 +73,6 @@
:- import_module hlds__hlds_out.
:- import_module hlds__instmap.
:- import_module hlds__passes_aux.
-:- import_module ll_backend__llds.
:- import_module parse_tree__inst.
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__prog_data.
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.88
diff -u -u -r1.88 compiler_design.html
--- compiler/notes/compiler_design.html 20 Oct 2003 07:29:18 -0000 1.88
+++ compiler/notes/compiler_design.html 24 Nov 2003 14:33:23 -0000
@@ -689,6 +689,20 @@
(Is there any good reason why lambda.m comes after table_gen.m?)
+
+<p>
+
+Expansion of equivalence types (equiv_type_hlds.m)
+
+<ul>
+<li>
+ This pass expands equivalences which are not meant to
+ be visible to the user of imported modules. This
+ is necessary for the IL back-end and in some cases
+ for `:- pragma export' involving foreign types on
+ the C back-end.
+</ul>
+
<p>
The next pass is termination analysis. The various modules involved are:
Index: library/multi_map.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/multi_map.m,v
retrieving revision 1.10
diff -u -u -r1.10 multi_map.m
--- library/multi_map.m 26 May 2003 09:00:30 -0000 1.10
+++ library/multi_map.m 24 Nov 2003 14:33:23 -0000
@@ -104,17 +104,29 @@
:- mode multi_map__values(in, out) is det.
% convert a multi_map to an association list
-:- pred multi_map__to_assoc_list(multi_map(K,V), assoc_list(K,list(V))).
+:- pred multi_map__to_assoc_list(multi_map(K,V), assoc_list(K, V)).
:- mode multi_map__to_assoc_list(in, out) is det.
% convert an association list to a multi_map
-:- pred multi_map__from_assoc_list(assoc_list(K,list(V)), multi_map(K,V)).
+:- pred multi_map__from_assoc_list(assoc_list(K, V), multi_map(K,V)).
:- mode multi_map__from_assoc_list(in, out) is det.
+ % convert a multi_map to an association list, with all the
+ % values for each key in one element of the association list.
+:- pred multi_map__to_multi_assoc_list(multi_map(K, V),
+ assoc_list(K, list(V))).
+:- mode multi_map__to_multi_assoc_list(in, out) is det.
+
+ % convert an association list with all the values for each
+ % key in one element of the list to a multi_map
+:- pred multi_map__from_multi_assoc_list(assoc_list(K, list(V)),
+ multi_map(K,V)).
+:- mode multi_map__from_multi_assoc_list(in, out) is det.
+
% convert a sorted association list to a multi_map
-:- pred multi_map__from_sorted_assoc_list(assoc_list(K, list(V)),
- multi_map(K, V)).
-:- mode multi_map__from_sorted_assoc_list(in, out) is det.
+:- pred multi_map__from_sorted_multi_assoc_list(assoc_list(K, list(V)),
+ multi_map(K, V)).
+:- mode multi_map__from_sorted_multi_assoc_list(in, out) is det.
% delete a key and data from a multi_map
% if the key is not present, leave the multi_map unchanged
@@ -252,15 +264,31 @@
map__values(MultiMap, KeyList0),
list__condense(KeyList0, KeyList).
+multi_map__from_assoc_list(AList, MultiMap) :-
+ MultiMap = list__foldl(
+ (func(Key - Value, Map0) = Map :-
+ multi_map__set(Map0, Key, Value, Map)
+ ),
+ AList, map__init).
+
multi_map__to_assoc_list(MultiMap, AList) :-
- map__to_assoc_list(MultiMap, AList).
+ AList = list__reverse(map__foldl(
+ (func(Key, Values, AL) =
+ list__reverse(
+ list__map((func(Value) = Key - Value), Values)
+ ) ++ AL
+ ),
+ MultiMap, [])).
-multi_map__from_assoc_list(AList, MultiMap) :-
+multi_map__from_multi_assoc_list(AList, MultiMap) :-
map__from_assoc_list(AList, MultiMap).
-multi_map__from_sorted_assoc_list(AList, MultiMap) :-
+multi_map__from_sorted_multi_assoc_list(AList, MultiMap) :-
map__from_sorted_assoc_list(AList, MultiMap).
+multi_map__to_multi_assoc_list(MultiMap, AList) :-
+ map__to_assoc_list(MultiMap, AList).
+
multi_map__delete(MultiMap0, Key, MultiMap) :-
map__delete(MultiMap0, Key, MultiMap).
@@ -306,18 +334,8 @@
% XXX inefficient
multi_map__inverse_search(MultiMap, Value, Key) :-
- map__to_assoc_list(MultiMap, AssocList),
- multi_map__assoc_list_member(Value, AssocList, Key).
-
-:- pred multi_map__assoc_list_member(Value, assoc_list(Key, list(Value)), Key).
-:- mode multi_map__assoc_list_member(in, in, out) is nondet.
-multi_map__assoc_list_member(Value, [(AKey - AValues) | AList], Key) :-
- (
- list__member(Value, AValues),
- Key = AKey
- ;
- multi_map__assoc_list_member(Value, AList, Key)
- ).
+ map__member(MultiMap, Key, ValueList),
+ list__member(Value, ValueList).
%-----------------------------------------------------------------------------%
@@ -350,10 +368,10 @@
%-----------------------------------------------------------------------------%
multi_map__merge(M0, M1, M) :-
- multi_map__to_assoc_list(M0, ML0),
- multi_map__to_assoc_list(M1, ML1),
+ multi_map__to_multi_assoc_list(M0, ML0),
+ multi_map__to_multi_assoc_list(M1, ML1),
multi_map__assoc_list_merge(ML0, ML1, ML),
- multi_map__from_sorted_assoc_list(ML, M).
+ multi_map__from_sorted_multi_assoc_list(ML, M).
:- pred multi_map__assoc_list_merge(assoc_list(K, list(V)),
assoc_list(K, list(V)), assoc_list(K, list(V))).
Index: tests/benchmarks/nrev.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/nrev.m,v
retrieving revision 1.6
diff -u -u -r1.6 nrev.m
--- tests/benchmarks/nrev.m 8 Oct 2003 07:57:40 -0000 1.6
+++ tests/benchmarks/nrev.m 25 Nov 2003 14:15:03 -0000
@@ -8,7 +8,7 @@
:- interface.
-:- import_module io.
+:- import_module list, io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
@@ -17,8 +17,6 @@
:- mode main1(out) is det.
:- implementation.
-
-:- import_module list.
main --> main3(_).
Index: tests/benchmarks/primes.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/primes.m,v
retrieving revision 1.6
diff -u -u -r1.6 primes.m
--- tests/benchmarks/primes.m 8 Oct 2003 07:57:40 -0000 1.6
+++ tests/benchmarks/primes.m 25 Nov 2003 14:15:34 -0000
@@ -2,7 +2,7 @@
:- interface.
-:- import_module io.
+:- import_module io, list.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
@@ -12,7 +12,7 @@
:- implementation.
-:- import_module int, list, prolog.
+:- import_module int, prolog.
main --> main3(_).
Index: tests/benchmarks/qsort.m
===================================================================
RCS file: /home/mercury1/repository/tests/benchmarks/qsort.m,v
retrieving revision 1.7
diff -u -u -r1.7 qsort.m
--- tests/benchmarks/qsort.m 8 Oct 2003 07:57:40 -0000 1.7
+++ tests/benchmarks/qsort.m 25 Nov 2003 14:15:52 -0000
@@ -8,7 +8,7 @@
:- interface.
-:- import_module io.
+:- import_module io, list.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
@@ -18,7 +18,7 @@
:- implementation.
-:- import_module list, int.
+:- import_module int.
main --> main3(_).
Index: tests/general/string_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/general/string_test.m,v
retrieving revision 1.2
diff -u -u -r1.2 string_test.m
--- tests/general/string_test.m 19 Sep 1995 13:20:23 -0000 1.2
+++ tests/general/string_test.m 25 Nov 2003 14:16:31 -0000
@@ -1,7 +1,8 @@
:- module string_test.
-:- import_module io.
:- interface.
+
+:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.7
diff -u -u -r1.7 Mercury.options
--- tests/hard_coded/Mercury.options 22 Jul 2003 07:04:26 -0000 1.7
+++ tests/hard_coded/Mercury.options 28 Nov 2003 12:24:05 -0000
@@ -4,6 +4,7 @@
MCFLAGS-constraint = --constraint-propagation --enable-termination
MCFLAGS-constraint_order = --constraint-propagation --enable-termination
MCFLAGS-deforest_cc_bug = --deforestation
+MCFLAGS-export_test2 = --no-intermodule-optimization
MCFLAGS-lp = --intermodule-optimization -O3
MCFLAGS-boyer = --infer-all
MCFLAGS-float_consistency = --optimize-constant-propagation
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.207
diff -u -u -r1.207 Mmakefile
--- tests/hard_coded/Mmakefile 26 Oct 2003 12:43:33 -0000 1.207
+++ tests/hard_coded/Mmakefile 28 Nov 2003 12:18:58 -0000
@@ -54,6 +54,7 @@
existential_types_test \
expand \
export_test \
+ export_test2 \
failure_unify \
field_syntax \
float_field \
Index: tests/hard_coded/export_test2.exp
===================================================================
RCS file: tests/hard_coded/export_test2.exp
diff -N tests/hard_coded/export_test2.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/export_test2.exp 28 Nov 2003 12:18:48 -0000
@@ -0,0 +1 @@
+42
Index: tests/hard_coded/export_test2.m
===================================================================
RCS file: tests/hard_coded/export_test2.m
diff -N tests/hard_coded/export_test2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/export_test2.m 28 Nov 2003 12:26:40 -0000
@@ -0,0 +1,50 @@
+:- module export_test2.
+
+:- interface.
+
+:- import_module int, io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- pred foo(io__output_stream::in, io__output_stream::out,
+ int::in, int::out) is det.
+
+:- pred bar(io__output_stream::in, io__output_stream::out,
+ int::in, int::out) is det.
+
+
+:- implementation.
+
+main -->
+ io__stdout_stream(Stream0),
+ { bar(Stream0, Stream, 41, X) },
+ io__write(Stream, X),
+ io__write_char(Stream, '\n').
+
+foo(S, S, X, X+1).
+
+:- pragma foreign_decl("C",
+"#include ""mercury_library_types.h""
+
+/*
+** Make sure the foreign type definition of io__input_stream
+** is available here. If it is not, the automatically generated
+** definition of foo() will be
+** void foo(MR_Word, MR_Word *, MR_Integer, MR_Integer *);
+*/
+void foo(MercuryFilePtr, MercuryFilePtr *, MR_Integer, MR_Integer *);
+
+").
+
+
+:- pragma export(foo(in, out, in, out), "foo").
+
+:- pragma foreign_proc("C", bar(S::in, T::out, X::in, Y::out),
+ [may_call_mercury, promise_pure],
+"
+ foo(S, &T, X, &Y);
+").
+:- pragma foreign_proc("C#", bar(S::in, T::out, X::in, Y::out),
+ [may_call_mercury, promise_pure], "
+ export_test2.mercury_code.foo(S, ref T, X, ref Y);
+").
Index: tests/hard_coded/merge_and_remove_dups.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/merge_and_remove_dups.m,v
retrieving revision 1.1
diff -u -u -r1.1 merge_and_remove_dups.m
--- tests/hard_coded/merge_and_remove_dups.m 21 Sep 1998 13:24:18 -0000 1.1
+++ tests/hard_coded/merge_and_remove_dups.m 25 Nov 2003 14:16:57 -0000
@@ -9,11 +9,13 @@
:- interface.
+:- import_module io.
+
:- pred main(io:state::di, io:state::uo) is det.
:- implementation.
-:- import_module list, io.
+:- import_module list.
main -->
{ List1 = [1,2,3],
Index: tests/hard_coded/tim_qual1.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/tim_qual1.m,v
retrieving revision 1.2
diff -u -u -r1.2 tim_qual1.m
--- tests/hard_coded/tim_qual1.m 12 Jun 1996 17:18:46 -0000 1.2
+++ tests/hard_coded/tim_qual1.m 25 Nov 2003 14:17:37 -0000
@@ -5,11 +5,10 @@
% or mode is chosen.
:- module tim_qual1.
-:- import_module io.
-
:- interface.
:- import_module tim_qual2, tim_qual3.
+:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
Index: tests/hard_coded/unused_float_box_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/unused_float_box_test.m,v
retrieving revision 1.3
diff -u -u -r1.3 unused_float_box_test.m
--- tests/hard_coded/unused_float_box_test.m 28 Nov 2002 16:33:45 -0000 1.3
+++ tests/hard_coded/unused_float_box_test.m 25 Nov 2003 14:18:13 -0000
@@ -9,12 +9,10 @@
:- module unused_float_box_test.
:- interface.
-:- import_module io.
+:- import_module io, list, std_util.
:- pred main(io__state::di, io__state::uo) is det.
-:- import_module std_util.
-
:- type my_functor_tag_info
---> my_functor_integer(int)
; my_functor_float(float)
@@ -29,7 +27,7 @@
:- pred my_get_functor_info(my_univ::in, my_functor_tag_info::out) is semidet.
:- implementation.
-:- import_module list, int.
+:- import_module int.
main -->
wipe_stack(200),
Index: tests/hard_coded/typeclasses/complicated_constraint.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/complicated_constraint.m,v
retrieving revision 1.1
diff -u -u -r1.1 complicated_constraint.m
--- tests/hard_coded/typeclasses/complicated_constraint.m 30 Oct 1999 09:22:59 -0000 1.1
+++ tests/hard_coded/typeclasses/complicated_constraint.m 25 Nov 2003 14:18:42 -0000
@@ -1,6 +1,6 @@
:- module complicated_constraint.
:- interface.
-:- import_module io.
+:- import_module io, list.
:- typeclass printable(A) where [
pred p(A::in, io__state::di, io__state::uo) is det
@@ -17,7 +17,7 @@
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-:- import_module list, int.
+:- import_module int.
:- instance printable(int) where [
pred(p/3) is io__write_int
Index: tests/hard_coded/typeclasses/existential_rtti.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/existential_rtti.m,v
retrieving revision 1.1
diff -u -u -r1.1 existential_rtti.m
--- tests/hard_coded/typeclasses/existential_rtti.m 9 May 2000 10:48:54 -0000 1.1
+++ tests/hard_coded/typeclasses/existential_rtti.m 25 Nov 2003 14:19:15 -0000
@@ -4,6 +4,8 @@
:- interface.
+:- import_module io, list.
+
:- typeclass c(T) where [].
:- instance c(int) where [].
@@ -42,13 +44,11 @@
:- type multi2 ---> some [T1,T2,T3] multi2(T1, T2, T3)
=> (c2(T1, T2), c3(T1, T3)).
-:- import_module io.
-
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
-:- import_module list, std_util.
+:- import_module std_util.
main -->
io__write_string("Writing copies of terms:\n"),
Index: tests/hard_coded/typeclasses/extra_typeinfo.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/extra_typeinfo.m,v
retrieving revision 1.1
diff -u -u -r1.1 extra_typeinfo.m
--- tests/hard_coded/typeclasses/extra_typeinfo.m 10 Sep 1998 06:54:30 -0000 1.1
+++ tests/hard_coded/typeclasses/extra_typeinfo.m 25 Nov 2003 14:19:41 -0000
@@ -26,7 +26,7 @@
:- module extra_typeinfo.
:- interface.
-:- import_module io.
+:- import_module io, list.
:- typeclass foo(T) where [
pred foo_pred(T::in) is semidet
@@ -40,7 +40,7 @@
:- implementation.
-:- import_module list, std_util.
+:- import_module std_util.
main -->
{ L1 = [[1,2,3], [4,5,6]] },
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.143
diff -u -u -r1.143 Mmakefile
--- tests/invalid/Mmakefile 27 Oct 2003 09:26:00 -0000 1.143
+++ tests/invalid/Mmakefile 28 Nov 2003 12:58:31 -0000
@@ -87,6 +87,7 @@
method_impl \
missing_det_decls \
missing_interface_import \
+ missing_interface_import2 \
mode_inf \
modes_erroneous \
mostly_uniq1 \
Index: tests/invalid/missing_interface_import.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/missing_interface_import.err_exp,v
retrieving revision 1.3
diff -u -u -r1.3 missing_interface_import.err_exp
--- tests/invalid/missing_interface_import.err_exp 17 Jan 2003 05:57:08 -0000 1.3
+++ tests/invalid/missing_interface_import.err_exp 25 Nov 2003 15:48:55 -0000
@@ -1,9 +1,14 @@
missing_interface_import.m:007: In definition of type `missing_interface_import.bar'/0:
-missing_interface_import.m:007: error: undefined type `map'/2.
+missing_interface_import.m:007: error: undefined type `map'/2
+missing_interface_import.m:007: (the module `map'
+missing_interface_import.m:007: has not been imported in the interface).
missing_interface_import.m:009: In definition of predicate `missing_interface_import.p'/1:
missing_interface_import.m:009: error: undefined type `std_util.univ'/0
-missing_interface_import.m:009: (the module `std_util' has not been imported).
+missing_interface_import.m:009: (the module `std_util'
+missing_interface_import.m:009: has not been imported in the interface).
missing_interface_import.m:010: In definition of predicate `missing_interface_import.q'/1:
-missing_interface_import.m:010: error: undefined type `list'/1.
+missing_interface_import.m:010: error: undefined type `list'/1
+missing_interface_import.m:010: (the module `list'
+missing_interface_import.m:010: has not been imported in the interface).
`missing_interface_import.int' not written.
For more information, try recompiling with `-E'.
Index: tests/invalid/missing_interface_import.err_exp2
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/missing_interface_import.err_exp2,v
retrieving revision 1.3
diff -u -u -r1.3 missing_interface_import.err_exp2
--- tests/invalid/missing_interface_import.err_exp2 17 Jan 2003 05:57:08 -0000 1.3
+++ tests/invalid/missing_interface_import.err_exp2 26 Nov 2003 00:22:54 -0000
@@ -1,9 +1,14 @@
missing_interface_import.m:007: In definition of type `missing_interface_import.bar'/0:
-missing_interface_import.m:007: error: undefined type `map'/2.
+missing_interface_import.m:007: error: undefined type `map'/2
+missing_interface_import.m:007: (the module `map'
+missing_interface_import.m:007: has not been imported in the interface).
missing_interface_import.m:009: In definition of predicate `missing_interface_import.p'/1:
missing_interface_import.m:009: error: undefined type `std_util.univ'/0
-missing_interface_import.m:009: (the module `std_util' has not been imported).
+missing_interface_import.m:009: (the module `std_util'
+missing_interface_import.m:009: has not been imported in the interface).
missing_interface_import.m:010: In definition of predicate `missing_interface_import.q'/1:
-missing_interface_import.m:010: error: undefined type `list'/1.
+missing_interface_import.m:010: error: undefined type `list'/1
+missing_interface_import.m:010: (the module `list'
+missing_interface_import.m:010: has not been imported in the interface).
`Mercury/ints/missing_interface_import.int' not written.
For more information, try recompiling with `-E'.
Index: tests/invalid/missing_interface_import2.err_exp
===================================================================
RCS file: tests/invalid/missing_interface_import2.err_exp
diff -N tests/invalid/missing_interface_import2.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/missing_interface_import2.err_exp 28 Nov 2003 12:58:42 -0000
@@ -0,0 +1,10 @@
+missing_interface_import2.m:007: In definition of predicate `missing_interface_import2.main'/2:
+missing_interface_import2.m:007: error: undefined type `io.state'/0
+missing_interface_import2.m:007: (the module `io'
+missing_interface_import2.m:007: has not been imported in the interface).
+missing_interface_import2.m:007: In definition of predicate `missing_interface_import2.main'/2:
+missing_interface_import2.m:007: error: undefined type `io.state'/0
+missing_interface_import2.m:007: (the module `io'
+missing_interface_import2.m:007: has not been imported in the interface).
+`missing_interface_import2.int' not written.
+For more information, try recompiling with `-E'.
Index: tests/invalid/missing_interface_import2.err_exp2
===================================================================
RCS file: tests/invalid/missing_interface_import2.err_exp2
diff -N tests/invalid/missing_interface_import2.err_exp2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/missing_interface_import2.err_exp2 28 Nov 2003 12:59:39 -0000
@@ -0,0 +1,10 @@
+missing_interface_import2.m:007: In definition of predicate `missing_interface_import2.main'/2:
+missing_interface_import2.m:007: error: undefined type `io.state'/0
+missing_interface_import2.m:007: (the module `io'
+missing_interface_import2.m:007: has not been imported in the interface).
+missing_interface_import2.m:007: In definition of predicate `missing_interface_import2.main'/2:
+missing_interface_import2.m:007: error: undefined type `io.state'/0
+missing_interface_import2.m:007: (the module `io'
+missing_interface_import2.m:007: has not been imported in the interface).
+`Mercury/ints/missing_interface_import2.int' not written.
+For more information, try recompiling with `-E'.
Index: tests/invalid/missing_interface_import2.m
===================================================================
RCS file: tests/invalid/missing_interface_import2.m
diff -N tests/invalid/missing_interface_import2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/missing_interface_import2.m 28 Nov 2003 12:39:57 -0000
@@ -0,0 +1,11 @@
+:- module missing_interface_import2.
+
+:- import_module io.
+
+:- interface.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+main -->
+ io__write_string("ok\n").
+
Index: tests/invalid/purity/purity_type_error.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/purity_type_error.err_exp,v
retrieving revision 1.2
diff -u -u -r1.2 purity_type_error.err_exp
--- tests/invalid/purity/purity_type_error.err_exp 17 Jan 2003 05:57:15 -0000 1.2
+++ tests/invalid/purity/purity_type_error.err_exp 25 Nov 2003 15:49:23 -0000
@@ -1,9 +1,9 @@
-purity_type_error.m:018: In clause for predicate `purity_type_error.type_error/1':
-purity_type_error.m:018: in argument 1 of clause head:
-purity_type_error.m:018: type error in unification of variable `HeadVar__1'
-purity_type_error.m:018: and constant `1.00000000000000'.
-purity_type_error.m:018: variable `HeadVar__1' has type `int',
-purity_type_error.m:018: constant `1.00000000000000' has type `float'.
-purity_type_error.m:007: In predicate `purity_type_error.warn/1':
-purity_type_error.m:007: warning: declared `impure' but actually pure.
+purity_type_error.m:020: In clause for predicate `purity_type_error.type_error/1':
+purity_type_error.m:020: in argument 1 of clause head:
+purity_type_error.m:020: type error in unification of variable `HeadVar__1'
+purity_type_error.m:020: and constant `1.00000000000000'.
+purity_type_error.m:020: variable `HeadVar__1' has type `int',
+purity_type_error.m:020: constant `1.00000000000000' has type `float'.
+purity_type_error.m:009: In predicate `purity_type_error.warn/1':
+purity_type_error.m:009: warning: declared `impure' but actually pure.
For more information, try recompiling with `-E'.
Index: tests/invalid/purity/purity_type_error.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/purity_type_error.m,v
retrieving revision 1.1
diff -u -u -r1.1 purity_type_error.m
--- tests/invalid/purity/purity_type_error.m 13 Jul 2001 17:35:11 -0000 1.1
+++ tests/invalid/purity/purity_type_error.m 25 Nov 2003 14:25:03 -0000
@@ -4,13 +4,15 @@
:- interface.
+:- import_module list.
+
:- impure pred warn(list(int)::out) is det.
:- pred type_error(int::out) is det.
:- implementation.
-:- import_module list, string.
+:- import_module string.
warn(List) :-
append([1,2,3], [4,5,6], List).
Index: tests/valid/compl_unify_bug.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/compl_unify_bug.m,v
retrieving revision 1.1
diff -u -u -r1.1 compl_unify_bug.m
--- tests/valid/compl_unify_bug.m 16 Feb 1997 06:42:37 -0000 1.1
+++ tests/valid/compl_unify_bug.m 25 Nov 2003 14:39:21 -0000
@@ -4,11 +4,11 @@
:- interface.
+:- import_module list.
+
:- pred bug(int::in, list(T)::in) is semidet.
:- implementation.
-
-:- import_module list.
bug(NextInputArgNum, InputArgs) :-
list__drop(NextInputArgNum, InputArgs, [_|_]).
Index: tests/valid/deforest_bug.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/deforest_bug.m,v
retrieving revision 1.1
diff -u -u -r1.1 deforest_bug.m
--- tests/valid/deforest_bug.m 1 Sep 2000 10:31:15 -0000 1.1
+++ tests/valid/deforest_bug.m 27 Nov 2003 01:23:43 -0000
@@ -2,6 +2,8 @@
:- interface.
+:- import_module list, char, map.
+
:- type catalog ---> catalog(publicId -> systemId).
:- type [] ---> [].
@@ -26,7 +28,7 @@
:- implementation.
-:- import_module char, int, list, map, std_util, string.
+:- import_module int, std_util, string.
:- type entry
---> dtd(publicId, systemId)
Index: tests/valid/deforest_loop.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/deforest_loop.m,v
retrieving revision 1.1
diff -u -u -r1.1 deforest_loop.m
--- tests/valid/deforest_loop.m 3 Nov 1998 05:32:03 -0000 1.1
+++ tests/valid/deforest_loop.m 25 Nov 2003 14:38:04 -0000
@@ -3,7 +3,7 @@
:- module deforest_loop.
:- interface.
-:- import_module float.
+:- import_module float, list.
% Lights are modelled as points.
:- type light
Index: tests/valid/lambda_instmap_bug.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/lambda_instmap_bug.m,v
retrieving revision 1.1
diff -u -u -r1.1 lambda_instmap_bug.m
--- tests/valid/lambda_instmap_bug.m 8 May 1997 06:47:41 -0000 1.1
+++ tests/valid/lambda_instmap_bug.m 25 Nov 2003 14:37:26 -0000
@@ -5,7 +5,7 @@
:- interface.
-:- import_module set, std_util.
+:- import_module list, set, std_util.
:- type instr == pair(instruction, string).
@@ -18,8 +18,6 @@
:- mode detect_streams(in, in, out) is det.
:- implementation.
-
-:- import_module list.
detect_streams(Streams, Instrs0, Instrs) :-
Index: tests/valid/lazy_list.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/lazy_list.m,v
retrieving revision 1.1
diff -u -u -r1.1 lazy_list.m
--- tests/valid/lazy_list.m 12 Jul 1997 17:53:58 -0000 1.1
+++ tests/valid/lazy_list.m 25 Nov 2003 14:37:08 -0000
@@ -13,10 +13,11 @@
%---------------------------------------------------------------------------%
:- module lazy_list.
-:- import_module int, list.
-:- import_module std_util.
:- interface.
+
+:- import_module int, list.
+:- import_module std_util.
%-----------------------------------------------------------------------------%
Index: tests/warnings/pragma_source_file.m
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/pragma_source_file.m,v
retrieving revision 1.3
diff -u -u -r1.3 pragma_source_file.m
--- tests/warnings/pragma_source_file.m 29 Apr 1997 10:57:05 -0000 1.3
+++ tests/warnings/pragma_source_file.m 25 Nov 2003 14:36:43 -0000
@@ -1,7 +1,8 @@
:- module pragma_source_file.
-:- import_module list, int.
:- interface.
+
+:- import_module list, int.
:- pred my_append(list(int), list(int), list(int)).
:- mode my_append(in, in, out) is det.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list