[m-rev.] for review: smart recompilation
Simon Taylor
stayl at cs.mu.OZ.AU
Mon May 28 18:34:05 AEST 2001
Estimated hours taken: 400
Smart recompilation. Record version numbers for each item
in interface files. Record which items are used in each compilation.
Only recompile a module if the output file does not exist or
nothing has changed.
There is still some work to do on this:
- it doesn't work with inter-module optimization.
- it doesn't work when the module name doesn't match the file name.
(this problem will go away when mmake functionality is moved into
the compiler.
I'll hold off documenting this change in the NEWS file and
on the web page for a month or so, until I've had a bit more
experience using it.
compiler/options.m:
compiler/handle_options.m:
doc/user_guide.texi:
Add an option `--smart-recompilation', currently off by default.
Add an internal option `--generate-version-numbers' to control
whether version numbers are written to the interface files. If
`--smart-recompilation' is disabled because the module
is being compiled with `--intermodule-optimization' (e.g. in the
standard library), we still want to write the version numbers
to the interface files.
Add an option `--verbose-recompilation' (default off)
to write messages describing why recompilation is needed.
Add an option `--warn-smart-recompilation' (default on)
to control warnings relating to the smart recompilation
system. Warn if smart recompilation will not work with
the output and inter-module optimization options given.
compiler/recompilation.m:
Type declarations for smart recompilation.
Predicates to record program items used by compilation.
compiler/recompilation_version.m:
Compute version numbers for program items in interface files.
compiler/recompilation_usage.m:
Find all items used by a compilation.
compiler/recompilation_check.m:
Check whether recompilation is necessary.
compiler/mercury_compile.m:
Invoke the smart recompilation passes.
compiler/modules.m:
compiler/prog_io.m:
Return timestamps for modules read.
When reading a module make sure the current input stream
is reset to its old value, not stdin.
Handle version number items in interface files.
compiler/module_qual.m:
compiler/unify_proc.m:
compiler/make_hlds.m:
Record all items used by local items.
compiler/make_hlds.m:
Process `:- pragma type_spec' declarations in
add_item_list_clauses. The qual_info is needed
when processing `:- pragma type_spec' declarations
so that any equivalence types used by the declaration
can be recorded as used by the predicate or function to
which the `:- pragma type_spec' applies.
compiler/equiv_type.m:
For each imported item, record which equivalence types
are used by that item.
compiler/hlds_module.m:
Add a field to the module_info to store information about
items used during compilation of a module.
compiler/check_typeclass.m:
Make sure any items used in clauses for typeclass method
implementations are recorded in the `.used' file.
compiler/prog_data.m:
compiler/*.m:
Factor out some duplicated code by combining the
pred and func, and pred_mode and func_mode items.
Make it easier to extract the name of a type, inst or mode
from its declaration.
Add an item type to hold the version numbers for an interface file.
Allow warnings to be reported for `nothing' items (used for
reporting when version numbers are written using an
obsolete format).
compiler/prog_io.m:
compiler/prog_io_util.m:
compiler/typecheck.m:
compiler/type_util.m:
compiler/*.m:
Strip contexts from all types, not just those in class constraints.
This makes it possible to use ordinary unification to check
whether items have changed (with the exception of clauses).
Remove code to create types with contexts in typechecking.
Remove code scattered through the compiler to remove contexts
from types in class constraints.
compiler/hlds_pred.m:
compiler/prog_util.m:
Move hlds_pred__adjust_func_arity to prog_util, so that it
can be used by the pre-hlds passes.
compiler/typecheck.m:
compiler/hlds_module.m:
Move typecheck__visible_modules to hlds_module.m, so it can
be used by recompilation_usage.m.
compiler/typecheck.m:
Add a comment telling where updates may be required if the
code to typecheck a var-functor unification changes.
compiler/error_util.m:
Allow writing messages without contexts (used for the verbose
recompilation messages).
Add functions to format sym_name and sym_name_and_arity,
and to add punctuation to the end of an error message
without unwanted line breaks before the punctuation.
scripts/Mmake.rules:
compiler/modules.m:
Don't remove the output file before running the compiler. We need
to leave the old output file intact if smart recompilation detects
that recompilation is not needed.
compiler/notes/compiler_design.html:
Document the new modules.
library/io.m:
NEWS:
Add predicates to find the modification time of files
and input_streams.
library/set.m:
NEWS:
Add a predicate version of set__fold
Don't sort the output of set__filter, it's already sorted.
library/time.m:
Add undocumented predicates to convert time_t to and from int.
They are undocumented because they rely on the assumption that
`time_t' fits in a Mercury `int'.
configure.in:
runtime/mercury_conf.h.in:
runtime/RESERVED_MACRO_NAMES:
When checking whether the compiler is recent enough, check for
the --warn-smart-recompilation option.
Check for stat().
library/Mmakefile:
Disable warnings about smart recompilation not working with
`--intermodule-optimization'.
browser/Mmakefile:
Disable warnings about smart recompilation not working when
the module name doesn't match the file name.
runtime/mercury_string.h:
Add a macro MR_make_string_const() which automates computation
of the length of string argument to MR_string_const().
tests/recompilation/Mmakefile:
tests/recompilation/runtests:
tests/recompilation/test_functions:
tests/recompilation/TESTS:
tests/recompilation/README:
A framework for testing smart recompilation.
The option currently only works for the recompilation directory.
tests/recompilation/TEST.m.{1,2}:
tests/recompilation/TEST_2.m.{1,2}:
tests/recompilation/TEST.exp.{1,2}:
tests/recompilation/TEST.err_exp.2:
tests/recompilation/TEST_2.err_exp.2:
Test cases, where TEST is one of add_constructor_r, add_instance_r,
add_instance_2_r, add_type_nr, change_class_r, change_instance_r,
change_mode_r, field_r, func_overloading_nr, func_overloading_r,
lambda_mode_r, nested_module_r, no_version_numbers_r,
pragma_type_spec_r, pred_ctor_ambiguity_r, pred_overloading_r,
add_type_re, remove_type_re, type_qual_re.
tests/handle_options:
Add an option `-e' to generate any missing expected output files.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.209
diff -u -u -r1.209 NEWS
--- NEWS 2001/05/24 06:06:46 1.209
+++ NEWS 2001/05/24 06:10:37
@@ -30,6 +30,13 @@
* The exception module has a new predicate `try_store', which is
like `try_io', but which works with stores rather than io__states.
+* We've added predicates to io.m to find the last modification time
+ of files and input streams (io__file_modification_time,
+ io__input_stream_file_modification_time,
+ io__binary_input_stream_file_modification_time).
+
+* We've added a predicate version of `set__fold'.
+
Changes to the Mercury implementation:
* We've fixed a long-standing bug in the handling of module imports.
Previously, if `module1' imported `module2' which imported `module3' in
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.257
diff -u -u -r1.257 configure.in
--- configure.in 2001/05/27 10:52:03 1.257
+++ configure.in 2001/05/28 05:36:53
@@ -109,7 +109,7 @@
EOF
if
echo $BOOTSTRAP_MC conftest >&AC_FD_CC 2>&1 &&
- $BOOTSTRAP_MC --fixed-user-guided-type-specialization \
+ $BOOTSTRAP_MC --no-warn-smart-recompilation \
--halt-at-warn --link-flags "--static" conftest \
</dev/null >&AC_FD_CC 2>&1 &&
test "`./conftest 2>&1 | tr -d '\015'`" = "Hello, world"
@@ -446,7 +446,7 @@
ac_cv_func_mprotect=no ;;
esac
AC_HAVE_FUNCS(sysconf getpagesize memalign mprotect sigaction setitimer)
-AC_HAVE_FUNCS(strerror memmove dup fileno fdopen fstat)
+AC_HAVE_FUNCS(strerror memmove dup fileno fdopen fstat stat)
AC_HAVE_FUNCS(vsnprintf _vsnprintf)
#-----------------------------------------------------------------------------#
AC_CHECK_HEADER(unistd.h, HAVE_UNISTD_H=1)
Index: browser/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/Mmakefile,v
retrieving revision 1.16
diff -u -u -r1.16 Mmakefile
--- browser/Mmakefile 2001/05/18 14:23:49 1.16
+++ browser/Mmakefile 2001/05/27 19:33:43
@@ -57,6 +57,10 @@
esac \
`
+# XXX Smart recompilation currently doesn't work when the module
+# name doesn't match the file name, so disable it in this directory.
+MCFLAGS += --no-warn-smart-recompilation
+
MTAGS = $(SCRIPTS_DIR)/mtags
#-----------------------------------------------------------------------------#
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.41
diff -u -u -r1.41 check_typeclass.m
--- compiler/check_typeclass.m 2001/05/02 17:34:31 1.41
+++ compiler/check_typeclass.m 2001/05/03 02:09:42
@@ -53,12 +53,13 @@
:- import_module bool, io.
:- pred check_typeclass__check_instance_decls(module_info, qual_info,
- module_info, bool, io__state, io__state).
-:- mode check_typeclass__check_instance_decls(in, in, out, out, di, uo) is det.
+ module_info, qual_info, bool, io__state, io__state).
+:- mode check_typeclass__check_instance_decls(in, in, out, out,
+ out, di, uo) is det.
:- implementation.
-:- import_module prog_data, prog_out.
+:- import_module prog_data, prog_out, prog_util.
:- import_module hlds_pred, hlds_data, hlds_goal, hlds_out.
:- import_module type_util, typecheck, mode_util, inst_match.
:- import_module base_typeclass_info.
@@ -73,13 +74,13 @@
:- type error_messages == list(error_message).
check_typeclass__check_instance_decls(ModuleInfo0, QualInfo0,
- ModuleInfo, FoundError, IO0, IO) :-
+ ModuleInfo, QualInfo, FoundError, IO0, IO) :-
module_info_classes(ModuleInfo0, ClassTable),
module_info_instances(ModuleInfo0, InstanceTable0),
map__to_assoc_list(InstanceTable0, InstanceList0),
list_map_foldl2(check_one_class(ClassTable), InstanceList0,
InstanceList, check_tc_info([], ModuleInfo0, QualInfo0),
- check_tc_info(Errors, ModuleInfo1, _QualInfo),
+ check_tc_info(Errors, ModuleInfo1, QualInfo),
IO0, IO1),
(
Errors = []
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.25
diff -u -u -r1.25 equiv_type.m
--- compiler/equiv_type.m 2001/05/02 17:34:32 1.25
+++ compiler/equiv_type.m 2001/05/27 19:35:53
@@ -11,23 +11,34 @@
:- module equiv_type.
:- interface.
-:- import_module bool, prog_data, list, io.
+:- import_module bool, list, io, std_util.
+:- import_module recompilation, prog_data.
%-----------------------------------------------------------------------------%
- % equiv_type__expand_eqv_types(Items0, Items, CircularTypes, EqvMap).
+ % equiv_type__expand_eqv_types(ModuleName, Items0, Items,
+ % CircularTypes, EqvMap, MaybeRecompInfo0, MaybeRecompInfo).
%
% First it builds up a map from type_id to the equivalent type.
% Then it traverses through the list of items, expanding all types.
% This has the effect of eliminating all the equivalence types
% from the source code. Error messages are generated for any
% circular equivalence types.
-:- pred equiv_type__expand_eqv_types(list(item_and_context),
- list(item_and_context), bool, eqv_map, io__state, io__state).
-:- mode equiv_type__expand_eqv_types(in, out, out, out, di, uo) is det.
-
- % Replace equivalence types in a given type.
-:- pred equiv_type__replace_in_type(type, tvarset, eqv_map, type, tvarset).
+ %
+ % For items not defined in the current module, record the
+ % equivalence types expanded while processing each item
+ % in the recompilation_info.
+:- pred equiv_type__expand_eqv_types(module_name, list(item_and_context),
+ list(item_and_context), bool, eqv_map,
+ maybe(recompilation_info), maybe(recompilation_info),
+ io__state, io__state).
+:- 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_ids 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.
:- type eqv_map.
@@ -36,7 +47,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module assoc_list, bool, require, std_util, map, term, varset.
+:- import_module assoc_list, bool, require, std_util, map, set, term, varset.
:- import_module prog_data, prog_util, prog_out.
% XXX we shouldn't import the HLDS here.
@@ -49,11 +60,12 @@
% definitions. Then we go through the item list and replace
% them.
-equiv_type__expand_eqv_types(Items0, Items, CircularTypes, EqvMap) -->
+equiv_type__expand_eqv_types(ModuleName, Items0, Items, CircularTypes, EqvMap,
+ Info0, Info) -->
{ map__init(EqvMap0) },
{ equiv_type__build_eqv_map(Items0, EqvMap0, EqvMap) },
- { equiv_type__replace_in_item_list(Items0, EqvMap,
- [], RevItems, [], RevCircularTypeList) },
+ { equiv_type__replace_in_item_list(ModuleName, Items0, EqvMap,
+ [], RevItems, [], RevCircularTypeList, Info0, Info) },
{ list__reverse(RevItems, Items) },
(
{ RevCircularTypeList = [] }
@@ -74,7 +86,7 @@
equiv_type__build_eqv_map([], EqvMap, EqvMap).
equiv_type__build_eqv_map([Item - _Context | Items], EqvMap0, EqvMap) :-
- ( Item = type_defn(VarSet, eqv_type(Name, Args, Body), _Cond) ->
+ ( Item = type_defn(VarSet, Name, Args, eqv_type(Body), _Cond) ->
list__length(Args, Arity),
map__set(EqvMap0, Name - Arity,
eqv_type_body(VarSet, Args, Body), EqvMap1)
@@ -88,16 +100,23 @@
% of items. Similarly the replace_in_<foo> predicates that
% follow perform substitution of equivalence types on <foo>s.
-:- pred equiv_type__replace_in_item_list(list(item_and_context), eqv_map,
+:- pred equiv_type__replace_in_item_list(module_name, list(item_and_context),
+ eqv_map, list(item_and_context), list(item_and_context),
list(item_and_context), list(item_and_context),
- list(item_and_context), list(item_and_context)).
-:- mode equiv_type__replace_in_item_list(in, in, in, out, in, out) is det.
-
-equiv_type__replace_in_item_list([], _, Items, Items, Circ, Circ).
-equiv_type__replace_in_item_list([ItemAndContext0 | Items0], EqvMap,
- ReplItems0, ReplItems, Circ0, Circ) :-
+ maybe(recompilation_info), maybe(recompilation_info)).
+:- mode equiv_type__replace_in_item_list(in, in, in, in, out,
+ in, out, in, out) is det.
+
+equiv_type__replace_in_item_list(_, [], _, Items, Items,
+ Circ, Circ, Info, Info).
+equiv_type__replace_in_item_list(ModuleName, [ItemAndContext0 | Items0],
+ EqvMap, ReplItems0, ReplItems, Circ0, Circ, Info0, Info) :-
ItemAndContext0 = Item0 - Context,
- ( equiv_type__replace_in_item(Item0, EqvMap, Item, ContainsCirc) ->
+ (
+ equiv_type__replace_in_item(ModuleName, Item0, EqvMap, Item,
+ ContainsCirc, Info0, Info1)
+ ->
+ Info2 = Info1,
ItemAndContext = Item - Context,
( ContainsCirc = yes ->
Circ1 = [ItemAndContext | Circ0]
@@ -106,315 +125,368 @@
)
;
ItemAndContext = ItemAndContext0,
- Circ1 = Circ0
+ Circ1 = Circ0,
+ Info2 = Info0
),
ReplItems1 = [ItemAndContext | ReplItems0],
- equiv_type__replace_in_item_list(Items0, EqvMap, ReplItems1, ReplItems,
- Circ1, Circ).
+ equiv_type__replace_in_item_list(ModuleName, Items0, EqvMap,
+ ReplItems1, ReplItems, Circ1, Circ, Info2, Info).
-:- pred equiv_type__replace_in_item(item, eqv_map, item, bool).
-:- mode equiv_type__replace_in_item(in, in, out, out) is semidet.
-
-equiv_type__replace_in_item(type_defn(VarSet0, TypeDefn0, Cond),
- EqvMap, type_defn(VarSet, TypeDefn, Cond), ContainsCirc) :-
- equiv_type__replace_in_type_defn(TypeDefn0, VarSet0, EqvMap,
- TypeDefn, VarSet, ContainsCirc).
-
-equiv_type__replace_in_item(
- pred(TypeVarSet0, InstVarSet, ExistQVars, PredName,
- TypesAndModes0, Det, Cond, Purity, ClassContext0),
+:- pred equiv_type__replace_in_item(module_name, item, eqv_map, item, bool,
+ maybe(recompilation_info), maybe(recompilation_info)).
+:- mode equiv_type__replace_in_item(in, in, in, out, out, in, out) is semidet.
+
+equiv_type__replace_in_item(ModuleName,
+ type_defn(VarSet0, Name, TArgs, TypeDefn0, Cond),
+ EqvMap, type_defn(VarSet, Name, TArgs, TypeDefn, Cond),
+ ContainsCirc, Info0, Info) :-
+ list__length(TArgs, Arity),
+ equiv_type__maybe_record_used_equivalences(ModuleName, Name,
+ Info0, UsedTypeIds0),
+ equiv_type__replace_in_type_defn(Name - Arity, TypeDefn0,
+ VarSet0, EqvMap, TypeDefn, VarSet, ContainsCirc,
+ UsedTypeIds0, UsedTypeIds),
+ equiv_type__finish_recording_used_equivalences(
+ item_id(type_body, Name - Arity), UsedTypeIds, Info0, Info).
+
+equiv_type__replace_in_item(ModuleName,
+ pred_or_func(TypeVarSet0, InstVarSet, ExistQVars, PredOrFunc,
+ PredName, TypesAndModes0, Det, Cond,
+ Purity, ClassContext0),
EqvMap,
- pred(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, Det, Cond, Purity, ClassContext),
- no) :-
+ pred_or_func(TypeVarSet, InstVarSet, ExistQVars, PredOrFunc,
+ PredName, TypesAndModes, Det, Cond,
+ Purity, ClassContext),
+ no, Info0, Info) :-
+ list__length(TypesAndModes0, Arity),
+ equiv_type__maybe_record_used_equivalences(ModuleName, PredName,
+ Info0, UsedTypeIds0),
equiv_type__replace_in_class_constraints(ClassContext0, TypeVarSet0,
- EqvMap, ClassContext, TypeVarSet1),
+ EqvMap, ClassContext, TypeVarSet1, UsedTypeIds0, UsedTypeIds1),
equiv_type__replace_in_tms(TypesAndModes0, TypeVarSet1, EqvMap,
- TypesAndModes, TypeVarSet).
-
-equiv_type__replace_in_item(
- func(TypeVarSet0, InstVarSet, ExistQVars, PredName,
- TypesAndModes0, RetTypeAndMode0, Det, Cond,
- Purity, ClassContext0),
- EqvMap,
- func(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, RetTypeAndMode, Det, Cond,
- Purity, ClassContext),
- no) :-
- equiv_type__replace_in_class_constraints(ClassContext0, TypeVarSet0,
- EqvMap, ClassContext, TypeVarSet1),
- equiv_type__replace_in_tms(TypesAndModes0, TypeVarSet1, EqvMap,
- TypesAndModes, TypeVarSet2),
- equiv_type__replace_in_tm(RetTypeAndMode0, TypeVarSet2, EqvMap,
- RetTypeAndMode, TypeVarSet).
+ TypesAndModes, TypeVarSet, UsedTypeIds1, UsedTypeIds),
+ ItemType = pred_or_func_to_item_type(PredOrFunc),
+ adjust_func_arity(PredOrFunc, OrigArity, Arity),
+ equiv_type__finish_recording_used_equivalences(
+ item_id(ItemType, PredName - OrigArity),
+ UsedTypeIds, Info0, Info).
-equiv_type__replace_in_item(
+equiv_type__replace_in_item(ModuleName,
typeclass(Constraints0, ClassName, Vars,
ClassInterface0, VarSet0),
EqvMap,
typeclass(Constraints, ClassName, Vars,
ClassInterface, VarSet),
- no) :-
+ no, Info0, Info) :-
+ list__length(Vars, Arity),
+ equiv_type__maybe_record_used_equivalences(ModuleName, ClassName,
+ Info0, UsedTypeIds0),
equiv_type__replace_in_class_constraint_list(Constraints0, VarSet0,
- EqvMap, Constraints, VarSet),
+ EqvMap, Constraints, VarSet, UsedTypeIds0, UsedTypeIds1),
(
ClassInterface0 = abstract,
- ClassInterface = abstract
+ ClassInterface = abstract,
+ UsedTypeIds = UsedTypeIds1
;
ClassInterface0 = concrete(Methods0),
equiv_type__replace_in_class_interface(Methods0,
- EqvMap, Methods),
+ EqvMap, Methods, UsedTypeIds1, UsedTypeIds),
ClassInterface = concrete(Methods)
- ).
+ ),
+ equiv_type__finish_recording_used_equivalences(
+ item_id(typeclass, ClassName - Arity),
+ UsedTypeIds, Info0, Info).
-equiv_type__replace_in_item(
+equiv_type__replace_in_item(ModuleName,
instance(Constraints0, ClassName, Ts0,
InstanceBody, VarSet0, ModName),
EqvMap,
instance(Constraints, ClassName, Ts,
InstanceBody, VarSet, ModName),
- no) :-
+ no, Info0, Info) :-
+ ( (Info0 = no ; ModName = ModuleName) ->
+ UsedTypeIds0 = no
+ ;
+ UsedTypeIds0 = yes(ModuleName - set__init)
+ ),
equiv_type__replace_in_class_constraint_list(Constraints0, VarSet0,
- EqvMap, Constraints, VarSet1),
- equiv_type__replace_in_type_list(Ts0, VarSet1, EqvMap, Ts, VarSet, _).
-
-equiv_type__replace_in_item(
- pragma(type_spec(A, B, C, D, E, Subst0, VarSet0)),
- EqvMap,
- pragma(type_spec(A, B, C, D, E, Subst, VarSet)), no) :-
- equiv_type__replace_in_subst(Subst0, VarSet0, EqvMap, Subst, VarSet).
-
-:- pred equiv_type__replace_in_type_defn(type_defn, tvarset, eqv_map,
- type_defn, tvarset, bool).
-:- mode equiv_type__replace_in_type_defn(in, in, in, out, out, out) is semidet.
-
-equiv_type__replace_in_type_defn(eqv_type(TName, TArgs, TBody0), VarSet0,
- EqvMap, eqv_type(TName, TArgs, TBody), VarSet, ContainsCirc) :-
- list__length(TArgs, Arity),
- equiv_type__replace_in_type_2(TBody0, VarSet0, EqvMap, [TName - Arity],
- TBody, VarSet, ContainsCirc).
+ EqvMap, Constraints, VarSet1, UsedTypeIds0, UsedTypeIds1),
+ equiv_type__replace_in_type_list(Ts0, VarSet1, EqvMap, Ts, VarSet, _,
+ UsedTypeIds1, UsedTypeIds),
+ list__length(Ts0, Arity),
+ equiv_type__finish_recording_used_equivalences(
+ item_id(typeclass, ClassName - Arity),
+ UsedTypeIds, Info0, Info).
+
+equiv_type__replace_in_item(ModuleName,
+ pragma(type_spec(PredName, B, Arity, D, E,
+ Subst0, VarSet0, TypeIds0)),
+ EqvMap,
+ pragma(type_spec(PredName, B, Arity, D, E,
+ Subst, VarSet, TypeIds)),
+ no, Info, Info) :-
+ ( (Info = no ; PredName = qualified(ModuleName, _)) ->
+ UsedTypeIds0 = no
+ ;
+ UsedTypeIds0 = yes(ModuleName - TypeIds0)
+ ),
+ equiv_type__replace_in_subst(Subst0, VarSet0, EqvMap, Subst, VarSet,
+ UsedTypeIds0, UsedTypeIds),
+ (
+ UsedTypeIds = no,
+ TypeIds = TypeIds0
+ ;
+ UsedTypeIds = yes(_ - TypeIds)
+ ).
-equiv_type__replace_in_type_defn(uu_type(TName, TArgs, TBody0), VarSet0,
- EqvMap, uu_type(TName, TArgs, TBody), VarSet, no) :-
- equiv_type__replace_in_uu(TBody0, VarSet0, EqvMap, TBody, VarSet).
-
-equiv_type__replace_in_type_defn(du_type(TName, TArgs, TBody0, EqPred), VarSet0,
- EqvMap, du_type(TName, TArgs, TBody, EqPred), VarSet,
- no) :-
- equiv_type__replace_in_du(TBody0, VarSet0, EqvMap, TBody, VarSet).
+:- pred equiv_type__replace_in_type_defn(type_id, type_defn, tvarset,
+ eqv_map, type_defn, tvarset, bool,
+ equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_type_defn(in, in, in, in, out, out, out,
+ in, out) is semidet.
+
+equiv_type__replace_in_type_defn(TypeId, eqv_type(TBody0),
+ VarSet0, EqvMap, eqv_type(TBody),
+ VarSet, ContainsCirc, Info0, Info) :-
+ equiv_type__replace_in_type_2(TBody0, VarSet0, EqvMap, [TypeId],
+ TBody, VarSet, ContainsCirc, Info0, Info).
+
+equiv_type__replace_in_type_defn(_, uu_type(TBody0),
+ VarSet0, EqvMap, uu_type(TBody), VarSet, no,
+ Info0, Info) :-
+ equiv_type__replace_in_uu(TBody0, VarSet0, EqvMap, TBody,
+ VarSet, Info0, Info).
+
+equiv_type__replace_in_type_defn(_, du_type(TBody0,
+ EqPred), VarSet0, EqvMap, du_type(TBody, EqPred),
+ VarSet, no, Info0, Info) :-
+ equiv_type__replace_in_du(TBody0, VarSet0, EqvMap, TBody,
+ VarSet, Info0, Info).
%-----------------------------------------------------------------------------%
:- pred equiv_type__replace_in_class_constraints(class_constraints,
- tvarset, eqv_map, class_constraints, tvarset).
-:- mode equiv_type__replace_in_class_constraints(in, in, in, out, out) is det.
+ 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) :-
+equiv_type__replace_in_class_constraints(Cs0, VarSet0, EqvMap, Cs, VarSet,
+ Info0, Info) :-
Cs0 = constraints(UnivCs0, ExistCs0),
Cs = constraints(UnivCs, ExistCs),
equiv_type__replace_in_class_constraint_list(UnivCs0, VarSet0, EqvMap,
- UnivCs, VarSet1),
+ UnivCs, VarSet1, Info0, Info1),
equiv_type__replace_in_class_constraint_list(ExistCs0, VarSet1, EqvMap,
- ExistCs, VarSet).
+ ExistCs, VarSet, Info1, Info).
:- pred equiv_type__replace_in_class_constraint_list(list(class_constraint),
- tvarset, eqv_map, list(class_constraint), tvarset).
-:- mode equiv_type__replace_in_class_constraint_list(in, in, in, out, out)
- is det.
+ 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([], VarSet, _, [], VarSet).
+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) :-
+ [C|Cs], VarSet, Info0, Info) :-
equiv_type__replace_in_class_constraint(C0, VarSet0, EqvMap, C,
- VarSet1),
+ VarSet1, Info0, Info1),
equiv_type__replace_in_class_constraint_list(C0s, VarSet1, EqvMap, Cs,
- VarSet).
+ VarSet, Info1, Info).
:- pred equiv_type__replace_in_class_constraint(class_constraint, tvarset,
- eqv_map, class_constraint, tvarset).
-:- mode equiv_type__replace_in_class_constraint(in, in, in, out, out) is det.
+ 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(Constraint0, VarSet0, EqvMap,
- Constraint, VarSet) :-
+ Constraint, VarSet, Info0, Info) :-
Constraint0 = constraint(ClassName, Ts0),
- equiv_type__replace_in_type_list(Ts0, VarSet0, EqvMap, Ts1, VarSet, _),
- % we must maintain the invariant that types in class constraints
- % do not contain any info in their prog_context fields
- strip_prog_contexts(Ts1, Ts),
+ equiv_type__replace_in_type_list(Ts0, VarSet0, EqvMap, Ts, VarSet, _,
+ Info0, Info),
Constraint = constraint(ClassName, Ts).
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_class_interface(list(class_method),
- eqv_map, list(class_method)).
-:- mode equiv_type__replace_in_class_interface(in, in, out) is det.
+:- pred equiv_type__replace_in_class_interface(list(class_method), eqv_map,
+ list(class_method), equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_class_interface(in, in, out, in, out) is det.
equiv_type__replace_in_class_interface(ClassInterface0, EqvMap,
- ClassInterface) :-
- list__map(equiv_type__replace_in_class_method(EqvMap),
- ClassInterface0, ClassInterface).
+ ClassInterface, Info0, Info) :-
+ list__map_foldl(equiv_type__replace_in_class_method(EqvMap),
+ ClassInterface0, ClassInterface, Info0, Info).
:- pred equiv_type__replace_in_class_method(eqv_map, class_method,
- class_method).
-:- mode equiv_type__replace_in_class_method(in, in, out) is det.
+ class_method, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_class_method(in, in, out, in, out) is det.
equiv_type__replace_in_class_method(EqvMap,
- pred(TypeVarSet0, InstVarSet, ExistQVars, PredName,
- TypesAndModes0, Det, Cond, Purity,
- ClassContext0, Context),
- pred(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, Det, Cond, Purity,
- ClassContext, Context)
- ) :-
+ pred_or_func(TypeVarSet0, InstVarSet, ExistQVars, PredOrFunc,
+ PredName, TypesAndModes0, Det, Cond, Purity,
+ ClassContext0, Context),
+ pred_or_func(TypeVarSet, InstVarSet, ExistQVars, PredOrFunc,
+ PredName, TypesAndModes, Det, Cond, Purity,
+ ClassContext, Context),
+ Info0, Info) :-
equiv_type__replace_in_class_constraints(ClassContext0, TypeVarSet0,
- EqvMap, ClassContext, TypeVarSet1),
+ EqvMap, ClassContext, TypeVarSet1, Info0, Info1),
equiv_type__replace_in_tms(TypesAndModes0, TypeVarSet1, EqvMap,
- TypesAndModes, TypeVarSet).
-
-equiv_type__replace_in_class_method(EqvMap,
- func(TypeVarSet0, InstVarSet, ExistQVars, PredName,
- TypesAndModes0, RetTypeAndMode0, Det, Cond,
- Purity, ClassContext0, Context),
- func(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, RetTypeAndMode, Det, Cond,
- Purity, ClassContext, Context)
- ) :-
- equiv_type__replace_in_class_constraints(ClassContext0, TypeVarSet0,
- EqvMap, ClassContext, TypeVarSet1),
- equiv_type__replace_in_tms(TypesAndModes0, TypeVarSet1, EqvMap,
- TypesAndModes, TypeVarSet2),
- equiv_type__replace_in_tm(RetTypeAndMode0, TypeVarSet2, EqvMap,
- RetTypeAndMode, TypeVarSet).
+ TypesAndModes, TypeVarSet, Info1, Info).
equiv_type__replace_in_class_method(_,
- pred_mode(A,B,C,D,E,F),
- pred_mode(A,B,C,D,E,F)).
+ pred_or_func_mode(A,B,C,D,E,F,G),
+ pred_or_func_mode(A,B,C,D,E,F,G),
+ Info, Info).
-equiv_type__replace_in_class_method(_,
- func_mode(A,B,C,D,E,F,G),
- func_mode(A,B,C,D,E,F,G)).
-
%-----------------------------------------------------------------------------%
:- pred equiv_type__replace_in_subst(assoc_list(tvar, type), tvarset,
- eqv_map, assoc_list(tvar, type), tvarset).
-:- mode equiv_type__replace_in_subst(in, in, in, out, out) is det.
-
-equiv_type__replace_in_subst([], VarSet, _EqvMap, [], VarSet).
-equiv_type__replace_in_subst([Var - Type0 | Subst0], VarSet0,
- EqvMap, [Var - Type | Subst], VarSet) :-
- equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet1),
- equiv_type__replace_in_subst(Subst0, VarSet1, EqvMap, Subst, VarSet).
+ 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.
+
+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).
%-----------------------------------------------------------------------------%
-:- pred equiv_type__replace_in_uu(list(type), tvarset, eqv_map,
- list(type), tvarset).
-:- mode equiv_type__replace_in_uu(in, in, in, out, out) is det.
+:- 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) :-
+ Ts, VarSet, Info0, Info) :-
equiv_type__replace_in_type_list(Ts0, VarSet0, EqvMap,
- Ts, VarSet, _).
+ Ts, VarSet, _, Info0, Info).
%-----------------------------------------------------------------------------%
:- pred equiv_type__replace_in_du(list(constructor), tvarset, eqv_map,
- list(constructor), tvarset).
-:- mode equiv_type__replace_in_du(in, in, in, out, out) is det.
+ list(constructor), tvarset, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_du(in, in, in, out, out, in, out) is det.
-equiv_type__replace_in_du([], VarSet, _EqvMap, [], VarSet).
-equiv_type__replace_in_du([T0|Ts0], VarSet0, EqvMap, [T|Ts], VarSet) :-
- equiv_type__replace_in_ctor(T0, VarSet0, EqvMap, T, VarSet1),
- equiv_type__replace_in_du(Ts0, VarSet1, EqvMap, Ts, VarSet).
-
-:- pred equiv_type__replace_in_ctor(constructor, tvarset, eqv_map,
- constructor, tvarset).
-:- mode equiv_type__replace_in_ctor(in, in, in, out, 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) :-
+ ctor(ExistQVars, Constraints, TName, Targs), VarSet,
+ Info0, Info) :-
equiv_type__replace_in_ctor_arg_list(Targs0, VarSet0, EqvMap,
- Targs, VarSet1, _),
+ Targs, VarSet1, _, Info0, Info1),
equiv_type__replace_in_class_constraint_list(Constraints0, VarSet1,
- EqvMap, Constraints, VarSet).
+ EqvMap, Constraints, VarSet, Info1, Info).
%-----------------------------------------------------------------------------%
:- pred equiv_type__replace_in_type_list(list(type), tvarset, eqv_map,
- list(type), tvarset, bool).
-:- mode equiv_type__replace_in_type_list(in, in, in, out, out, out) is det.
+ list(type), tvarset, bool, equiv_type_info, equiv_type_info).
+:- mode equiv_type__replace_in_type_list(in, in, in, out, out, out,
+ in, out) is det.
equiv_type__replace_in_type_list(Ts0, VarSet0, EqvMap,
- Ts, VarSet, ContainsCirc) :-
+ Ts, VarSet, ContainsCirc, Info0, Info) :-
equiv_type__replace_in_type_list_2(Ts0, VarSet0, EqvMap, [],
- Ts, VarSet, no, ContainsCirc).
+ Ts, VarSet, no, ContainsCirc, Info0, Info).
:- pred equiv_type__replace_in_type_list_2(list(type), tvarset, eqv_map,
- list(type_id), list(type), tvarset, bool, bool).
+ list(type_id), list(type), tvarset, bool, bool,
+ equiv_type_info, equiv_type_info).
:- mode equiv_type__replace_in_type_list_2(in, in, in,
- in, out, out, in, out) is det.
+ in, out, out, in, out, in, out) is det.
-equiv_type__replace_in_type_list_2([], VarSet, _EqvMap, _Seen,
- [], VarSet, ContainsCirc, ContainsCirc).
+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) :-
+ [T | Ts], VarSet, Circ0, Circ, Info0, Info) :-
equiv_type__replace_in_type_2(T0, VarSet0, EqvMap, Seen,
- T, VarSet1, ContainsCirc),
+ 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).
+ Ts, VarSet, Circ1, Circ, Info1, Info).
%-----------------------------------------------------------------------------%
:- pred equiv_type__replace_in_ctor_arg_list(list(constructor_arg), tvarset,
- eqv_map, list(constructor_arg), tvarset, bool).
-:- mode equiv_type__replace_in_ctor_arg_list(in, in, in, out, out, out) is det.
+ 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) :-
+ As, VarSet, ContainsCirc, Info0, Info) :-
equiv_type__replace_in_ctor_arg_list_2(As0, VarSet0, EqvMap, [],
- As, VarSet, no, ContainsCirc).
+ As, VarSet, no, ContainsCirc, Info0, Info).
:- pred equiv_type__replace_in_ctor_arg_list_2(list(constructor_arg), tvarset,
- eqv_map, list(type_id), list(constructor_arg), tvarset, bool, bool).
+ eqv_map, list(type_id), 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) is det.
+ in, out, out, in, out, in, out) is det.
equiv_type__replace_in_ctor_arg_list_2([], VarSet, _EqvMap, _Seen,
- [], VarSet, ContainsCirc, ContainsCirc).
+ [], 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) :-
+ [N - T | As], VarSet, Circ0, Circ, Info0, Info) :-
equiv_type__replace_in_type_2(T0, VarSet0, EqvMap, Seen,
- T, VarSet1, ContainsCirc),
+ 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).
+ As, VarSet, Circ1, Circ, Info1, 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, _).
+ [], Type, VarSet, _, Info0, 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_id), type, tvarset, bool).
-:- mode equiv_type__replace_in_type_2(in, in, in, in, out, out, out) is det.
+ list(type_id), 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).
-equiv_type__replace_in_type_2(Type0, VarSet0, EqvMap,
- TypeIdsAlreadyExpanded, Type, VarSet, Circ) :-
+ _Seen, term__variable(V), VarSet, no, Info, Info).
+equiv_type__replace_in_type_2(Type0, VarSet0, EqvMap, TypeIdsAlreadyExpanded,
+ Type, VarSet, Circ, Info0, Info) :-
- Type0 = term__functor(_, _, Context),
+ Type0 = term__functor(_, _, _),
(
type_to_type_id(Type0, EqvTypeId, TArgs0)
->
equiv_type__replace_in_type_list_2(TArgs0, VarSet0, EqvMap,
- TypeIdsAlreadyExpanded, TArgs1, VarSet1, no, Circ0),
+ TypeIdsAlreadyExpanded, TArgs1, VarSet1, no, Circ0,
+ Info0, Info1),
( list__member(EqvTypeId, TypeIdsAlreadyExpanded) ->
Circ1 = yes
@@ -441,45 +513,98 @@
Circ0 = no,
Circ1 = no
->
+ map_maybe(equiv_type__record_used_type(EqvTypeId),
+ Info1, Info2),
term__term_list_to_var_list(Args, ArgVars),
term__substitute_corresponding(ArgVars, TArgs1,
Body, Type1),
equiv_type__replace_in_type_2(Type1, VarSet2,
EqvMap, [EqvTypeId | TypeIdsAlreadyExpanded],
- Type, VarSet, Circ)
+ Type, VarSet, Circ, Info2, Info)
;
VarSet = VarSet1,
- construct_type(EqvTypeId, TArgs1, Context, Type),
+ Info = Info1,
+ construct_type(EqvTypeId, TArgs1, Type),
bool__or(Circ0, Circ1, Circ)
)
;
VarSet = VarSet0,
Type = Type0,
+ Info = Info0,
Circ = no
).
+:- pred equiv_type__record_used_type(type_id, pair(module_name, set(type_id)),
+ pair(module_name, set(type_id))).
+:- mode equiv_type__record_used_type(in, in, out) is det.
+
+equiv_type__record_used_type(TypeId, UsedTypes0, UsedTypes) :-
+ UsedTypes0 = ModuleName - Types0,
+ ( TypeId = qualified(ModuleName, _) - _ ->
+ % We don't need to record local types.
+ UsedTypes = UsedTypes0
+ ;
+ UsedTypes = ModuleName - set__insert(Types0, TypeId)
+ ).
+
%-----------------------------------------------------------------------------%
:- pred equiv_type__replace_in_tms(list(type_and_mode), tvarset, eqv_map,
- list(type_and_mode), tvarset).
-:- mode equiv_type__replace_in_tms(in, in, in, out, out) is det.
+ 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).
-equiv_type__replace_in_tms([TM0|TMs0], VarSet0, EqvMap, [TM|TMs], VarSet) :-
- equiv_type__replace_in_tm(TM0, VarSet0, EqvMap, TM, VarSet1),
- equiv_type__replace_in_tms(TMs0, VarSet1, EqvMap, TMs, VarSet).
+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).
-:- mode equiv_type__replace_in_tm(in, in, in, out, out) is det.
+ 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) :-
- equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet).
+ 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) :-
- equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet).
+ type_and_mode(Type, Mode), VarSet, Info0, Info) :-
+ equiv_type__replace_in_type(Type0, VarSet0, EqvMap, Type, VarSet,
+ Info0, Info).
+
+%-----------------------------------------------------------------------------%
+
+:- type equiv_type_info == maybe(pair(module_name, set(type_id))).
+
+:- pred equiv_type__maybe_record_used_equivalences(module_name, sym_name,
+ maybe(recompilation_info), equiv_type_info).
+:- mode equiv_type__maybe_record_used_equivalences(in, in, in, out) is det.
+
+equiv_type__maybe_record_used_equivalences(_, _, no, no).
+equiv_type__maybe_record_used_equivalences(ModuleName, SymName,
+ yes(_), MaybeInfo) :-
+ ( SymName = qualified(ModuleName, _) ->
+ MaybeInfo = no
+ ;
+ MaybeInfo = yes(ModuleName - set__init)
+ ).
+
+:- pred equiv_type__finish_recording_used_equivalences(item_id,
+ equiv_type_info, maybe(recompilation_info), maybe(recompilation_info)).
+:- mode equiv_type__finish_recording_used_equivalences(in, in, in, out) is det.
+
+equiv_type__finish_recording_used_equivalences(_, no, no, no).
+equiv_type__finish_recording_used_equivalences(_, no, yes(Info), yes(Info)).
+equiv_type__finish_recording_used_equivalences(_, yes(_), no, _) :-
+ error("equiv_type__finish_recording_used_equivalences").
+equiv_type__finish_recording_used_equivalences(Item, yes(_ - UsedTypeIds),
+ yes(Info0), yes(Info)) :-
+ recompilation__record_used_equivalence_types(Item, UsedTypeIds,
+ Info0, Info).
%-----------------------------------------------------------------------------%
@@ -489,8 +614,9 @@
equiv_type__report_circular_types([]) --> [].
equiv_type__report_circular_types([Circ | Circs]) -->
(
- { Circ = type_defn(_, TypeDefn, _) - Context },
- { TypeDefn = eqv_type(SymName, Params, _) }
+ { Circ = type_defn(_, SymName, Params,
+ TypeDefn, _) - Context },
+ { TypeDefn = eqv_type(_) }
->
{ list__length(Params, Arity) },
prog_out__write_context(Context),
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.13
diff -u -u -r1.13 error_util.m
--- compiler/error_util.m 2000/10/22 07:27:17 1.13
+++ compiler/error_util.m 2001/05/17 10:55:08
@@ -17,7 +17,7 @@
:- interface.
:- import_module hlds_module, hlds_pred, prog_data.
-:- import_module assoc_list, io, list, std_util.
+:- import_module assoc_list, char, io, list, std_util.
% Given a context, a starting indentation level and a list of words,
% print an error message that looks like this:
@@ -57,10 +57,18 @@
:- pred error_util__list_to_pieces(list(string)::in,
list(format_component)::out) is det.
+ % Convert a list of lists of format_components into a list of
+ % format_components, suitable for displaying as an error message.
+:- func error_util__component_lists_to_pieces(list(list(format_component))) =
+ list(format_component).
+
% Display the given error message.
:- pred write_error_pieces(prog_context::in, int::in,
list(format_component)::in, io__state::di, io__state::uo) is det.
+:- pred write_error_pieces_maybe_with_context(maybe(prog_context)::in, int::in,
+ list(format_component)::in, io__state::di, io__state::uo) is det.
+
% Report a warning, and set the exit status to error if the
% --halt-at-warn option is set. This predicate does the same thing as
% prog_io_util__report_warning, except that it does a nicer job of
@@ -86,6 +94,14 @@
assoc_list(pred_proc_id, prog_context)::in,
list(format_component)::out) is det.
+:- func error_util__describe_sym_name(sym_name) = string.
+
+:- func error_util__describe_sym_name_and_arity(sym_name_and_arity) =
+ string.
+
+:- func error_util__append_punctuation(list(format_component), char) =
+ list(format_component).
+
% report_error_num_args(MaybePredOrFunc, Arity, CorrectArities).
%
% Write
@@ -115,7 +131,7 @@
:- implementation.
-:- import_module prog_out, globals, options.
+:- import_module prog_out, prog_util, globals, options.
:- import_module bool, io, list, term, char, string, int, require.
error_util__list_to_pieces([], []).
@@ -127,6 +143,16 @@
error_util__list_to_pieces([Elem2, Elem3 | Elems], Pieces1),
Pieces = [fixed(Piece1) | Pieces1].
+error_util__component_lists_to_pieces([]) = [].
+error_util__component_lists_to_pieces([Components]) = Components.
+error_util__component_lists_to_pieces([Components1, Components2]) =
+ list__condense([Components1, [words("and")], Components2]).
+error_util__component_lists_to_pieces(
+ [Components1, Components2, Components3 | Components]) =
+ list__append(append_punctuation(Components1, ','),
+ error_util__component_lists_to_pieces(
+ [Components2, Components3 | Components])).
+
report_warning(Context, Indent, Components) -->
globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
( { HaltAtWarn = yes } ->
@@ -137,6 +163,10 @@
write_error_pieces(Context, Indent, Components).
write_error_pieces(Context, Indent, Components) -->
+ write_error_pieces_maybe_with_context(yes(Context),
+ Indent, Components).
+
+write_error_pieces_maybe_with_context(MaybeContext, Indent, Components) -->
{
% The fixed characters at the start of the line are:
% filename
@@ -145,45 +175,62 @@
% :
% space
% indent
- term__context_file(Context, FileName),
- term__context_line(Context, LineNumber),
- string__length(FileName, FileNameLength),
- string__int_to_string(LineNumber, LineNumberStr),
- string__length(LineNumberStr, LineNumberStrLength0),
- ( LineNumberStrLength0 < 3 ->
- LineNumberStrLength = 3
+ (
+ MaybeContext = yes(Context),
+ term__context_file(Context, FileName),
+ term__context_line(Context, LineNumber),
+ string__length(FileName, FileNameLength),
+ string__int_to_string(LineNumber, LineNumberStr),
+ string__length(LineNumberStr, LineNumberStrLength0),
+ ( LineNumberStrLength0 < 3 ->
+ LineNumberStrLength = 3
+ ;
+ LineNumberStrLength = LineNumberStrLength0
+ ),
+ ContextLength = FileNameLength + 1 +
+ LineNumberStrLength + 2
;
- LineNumberStrLength = LineNumberStrLength0
+ MaybeContext = no,
+ ContextLength = 0
),
- Remain is 79 - (FileNameLength + 1 +
- LineNumberStrLength + 2 + Indent),
+ Remain is 79 - (ContextLength + Indent),
convert_components_to_word_list(Components, [], [], Words),
group_words(yes, Words, Remain, Lines)
},
- write_lines(Lines, Context, Indent).
+ write_lines(Lines, MaybeContext, Indent).
-:- pred write_lines(list(list(string))::in, prog_context::in, int::in,
+:- pred write_lines(list(list(string))::in, maybe(prog_context)::in, int::in,
io__state::di, io__state::uo) is det.
write_lines([], _, _) --> [].
-write_lines([Line | Lines], Context, Indent) -->
- prog_out__write_context(Context),
+write_lines([Line | Lines], MaybeContext, Indent) -->
+ (
+ { MaybeContext = yes(Context) },
+ prog_out__write_context(Context)
+ ;
+ { MaybeContext = no }
+ ),
{ string__pad_left("", ' ', Indent, IndentStr) },
io__write_string(IndentStr),
write_line(Line),
{ Indent2 is Indent + 2 },
- write_nonfirst_lines(Lines, Context, Indent2).
+ write_nonfirst_lines(Lines, MaybeContext, Indent2).
-:- pred write_nonfirst_lines(list(list(string))::in, prog_context::in, int::in,
- io__state::di, io__state::uo) is det.
+:- pred write_nonfirst_lines(list(list(string))::in, maybe(prog_context)::in,
+ int::in, io__state::di, io__state::uo) is det.
write_nonfirst_lines([], _, _) --> [].
-write_nonfirst_lines([Line | Lines], Context, Indent) -->
- prog_out__write_context(Context),
+write_nonfirst_lines([Line | Lines], MaybeContext, Indent) -->
+ (
+ { MaybeContext = yes(Context) },
+ prog_out__write_context(Context)
+ ;
+ { MaybeContext = no }
+ ),
{ string__pad_left("", ' ', Indent, IndentStr) },
io__write_string(IndentStr),
write_line(Line),
- write_nonfirst_lines(Lines, Context, Indent).
+ write_nonfirst_lines(Lines, MaybeContext, Indent).
:- pred write_line(list(string)::in, io__state::di, io__state::uo) is det.
@@ -414,6 +461,36 @@
error_util__describe_several_call_sites(Module, Sites, Pieces) :-
list__map(error_util__describe_one_call_site(Module), Sites, Pieces0),
error_util__list_to_pieces(Pieces0, Pieces).
+
+error_util__describe_sym_name_and_arity(SymName / Arity) =
+ string__append_list(["`", SymNameString,
+ "/", string__int_to_string(Arity), "'"]) :-
+ sym_name_to_string(SymName, SymNameString).
+
+error_util__describe_sym_name(SymName) =
+ string__append_list(["`", SymNameString, "'"]) :-
+ sym_name_to_string(SymName, SymNameString).
+
+
+error_util__append_punctuation([], _) = _ :-
+ error(
+ "error_util__append_full_stop: appending punctuation after nothing").
+error_util__append_punctuation([Piece0], Punc) = [Piece] :-
+ % Avoid unwanted line splitting between the punctuation and the
+ % full-stop.
+ (
+ Piece0 = words(String),
+ Piece = words(string__append(String, char_to_string(Punc)))
+ ;
+ Piece0 = fixed(String),
+ Piece = fixed(string__append(String, char_to_string(Punc)))
+ ;
+ Piece0 = nl,
+ error(
+ "error_util__append_punctutation: appending punctuation after newline")
+ ).
+error_util__append_punctuation([Piece1, Piece2 | Pieces], Punc) =
+ [Piece1 | error_util__append_punctuation([Piece2 | Pieces], Punc)].
%-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.110
diff -u -u -r1.110 handle_options.m
--- compiler/handle_options.m 2001/05/24 06:07:03 1.110
+++ compiler/handle_options.m 2001/05/28 05:38:52
@@ -94,7 +94,16 @@
GenerateIL, GenerateJava,
CompileOnly, AditiOnly],
NotLink) },
- { bool__not(NotLink, Link) }
+ { bool__not(NotLink, Link) },
+ globals__io_lookup_bool_option(smart_recompilation, Smart),
+ ( { Smart = yes, Link = yes } ->
+ % XXX Currently smart recompilation doesn't check
+ % that all the files needed to link are present
+ % and up-to-date, so disable it.
+ disable_smart_recompilation("linking")
+ ;
+ []
+ )
).
:- pred dump_arguments(list(string), io__state, io__state).
@@ -346,6 +355,60 @@
option_implies(intermodule_optimization, use_opt_files, bool(no)),
option_implies(transitive_optimization, use_trans_opt_files, bool(no)),
+ option_implies(smart_recompilation, generate_item_version_numbers,
+ bool(yes)),
+
+ %
+ % Disable `--smart-recompilation' for compilation options
+ % which either do not produce a compiled output file or
+ % for which smart recompilation will not work.
+ %
+ option_implies(generate_dependencies, smart_recompilation, bool(no)),
+ option_implies(convert_to_mercury, smart_recompilation, bool(no)),
+ option_implies(make_private_interface, smart_recompilation, bool(no)),
+ option_implies(make_interface, smart_recompilation, bool(no)),
+ option_implies(make_short_interface, smart_recompilation, bool(no)),
+ option_implies(make_short_interface, smart_recompilation, bool(no)),
+ option_implies(output_grade_string, smart_recompilation, bool(no)),
+ option_implies(make_optimization_interface,
+ smart_recompilation, bool(no)),
+ option_implies(make_transitive_opt_interface,
+ smart_recompilation, bool(no)),
+ option_implies(errorcheck_only, smart_recompilation, bool(no)),
+ option_implies(typecheck_only, smart_recompilation, bool(no)),
+
+ % `--aditi-only' is only used by the Aditi query shell,
+ % for queries which should only be compiled once.
+ % recompilation_check.m currently doesn't check whether
+ % the `.rlo' file is up to date (with `--no-aditi-only' the
+ % Aditi-RL bytecode is embedded in the `.c' file.
+ option_implies(aditi_only, smart_recompilation, bool(no)),
+
+ % We never use version number information in `.int3',
+ % `.opt' or `.trans_opt' files.
+ option_implies(make_short_interface, generate_item_version_numbers,
+ bool(no)),
+
+ % XXX Smart recompilation does not yet work with inter-module
+ % optimization, but we still want to generate version numbers
+ % in interface files for users of a library compiled with
+ % inter-module optimization but not using inter-module
+ % optimization themselves.
+ globals__io_lookup_bool_option(smart_recompilation, Smart),
+ maybe_disable_smart_recompilation(Smart, intermodule_optimization, yes,
+ "`--intermodule-optimization'"),
+ maybe_disable_smart_recompilation(Smart, use_opt_files, yes,
+ "`--use-opt-files'"),
+
+ % XXX Smart recompilation does not yet work with
+ % `--no-target-code-only'. With `--no-target-code-only'
+ % it becomes difficult to work out what all the target
+ % files are and check whether they are up-to-date.
+ % By default, mmake always enables `--target-code-only' and
+ % processes the object file itself, so this isn't a problem.
+ maybe_disable_smart_recompilation(Smart, target_code_only, no,
+ "`--no-target-code-only'"),
+
option_implies(very_verbose, verbose, bool(yes)),
globals__io_lookup_int_option(debug_liveness, DebugLiveness),
@@ -720,6 +783,47 @@
globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
( { SourceOptionValue = no } ->
globals__io_set_option(ImpliedOption, ImpliedOptionValue)
+ ;
+ []
+ ).
+
+ % Smart recompilation does not yet work with all
+ % options (in particular `--intermodule-optimization'
+ % and `--no-target-code-only'). Disable smart recompilation
+ % if such an option is set, maybe issuing a warning.
+:- pred maybe_disable_smart_recompilation(bool::in, option::in, bool::in,
+ string::in, io__state::di, io__state::uo) is det.
+
+maybe_disable_smart_recompilation(Smart, ConflictingOption,
+ ValueToDisableSmart, OptionDescr) -->
+ globals__io_lookup_bool_option(ConflictingOption, Value),
+ (
+ { Smart = yes },
+ { Value = ValueToDisableSmart }
+ ->
+ disable_smart_recompilation(OptionDescr)
+ ;
+ []
+ ).
+
+:- pred disable_smart_recompilation(string::in,
+ io__state::di, io__state::uo) is det.
+
+disable_smart_recompilation(OptionDescr) -->
+ globals__io_set_option(smart_recompilation, bool(no)),
+ globals__io_lookup_bool_option(warn_smart_recompilation,
+ WarnSmart),
+ ( { WarnSmart = yes } ->
+ io__write_string(
+ "Warning: smart recompilation does not yet work with "),
+ io__write_string(OptionDescr),
+ io__write_string(".\n"),
+ globals__io_lookup_bool_option(halt_at_warn, Halt),
+ ( { Halt = yes } ->
+ io__set_exit_status(1)
+ ;
+ []
+ )
;
[]
).
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.85
diff -u -u -r1.85 higher_order.m
--- compiler/higher_order.m 2001/04/07 14:04:37 1.85
+++ compiler/higher_order.m 2001/05/24 06:32:32
@@ -2801,10 +2801,7 @@
:- pred maybe_add_constraint(list(class_constraint)::in,
class_constraint::in, list(class_constraint)::out) is det.
-maybe_add_constraint(Constraints0, Constraint0, Constraints) :-
- Constraint0 = constraint(ClassName, Types0),
- strip_prog_contexts(Types0, Types),
- Constraint = constraint(ClassName, Types),
+maybe_add_constraint(Constraints0, Constraint, Constraints) :-
(
% Remove duplicates.
\+ list__member(Constraint, Constraints0)
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.66
diff -u -u -r1.66 hlds_module.m
--- compiler/hlds_module.m 2001/04/29 03:38:33 1.66
+++ compiler/hlds_module.m 2001/05/27 19:36:31
@@ -21,7 +21,7 @@
:- interface.
-:- import_module prog_data, module_qual.
+:- import_module prog_data, module_qual, recompilation.
:- import_module hlds_pred, hlds_data, unify_proc, special_pred.
:- import_module globals, llds.
:- import_module relation, map, std_util, list, set, multi_map, counter.
@@ -117,8 +117,8 @@
% the module_info.
%
:- pred module_info_init(module_name, item_list, globals,
- partial_qualifier_info, module_info).
-:- mode module_info_init(in, in, in, in, out) is det.
+ partial_qualifier_info, maybe(recompilation_info), module_info).
+:- mode module_info_init(in, in, in, in, in, out) is det.
:- pred module_info_get_predicate_table(module_info, predicate_table).
:- mode module_info_get_predicate_table(in, out) is det.
@@ -212,6 +212,14 @@
:- pred module_info_set_cell_counter(module_info, counter, module_info).
:- mode module_info_set_cell_counter(in, in, out) is det.
+:- pred module_info_get_maybe_recompilation_info(module_info,
+ maybe(recompilation_info)).
+:- mode module_info_get_maybe_recompilation_info(in, out) is det.
+
+:- pred module_info_set_maybe_recompilation_info(module_info,
+ maybe(recompilation_info), module_info).
+:- mode module_info_set_maybe_recompilation_info(in, in, out) is det.
+
:- pred module_add_imported_module_specifiers(list(module_specifier),
module_info, module_info).
:- mode module_add_imported_module_specifiers(in, in, out) is det.
@@ -228,6 +236,13 @@
set(module_specifier)).
:- mode module_info_get_indirectly_imported_module_specifiers(in, out) is det.
+ % The visible modules are the current module, any
+ % imported modules, and any ancestor modules.
+ % It excludes transitively imported modules (those
+ % for which we read `.int2' files).
+:- pred visible_module(module_name, module_info).
+:- mode visible_module(out, in) is multi.
+
% This returns all the modules that this module's code depends on,
% i.e. all modules that have been used or imported by this module,
% directly or indirectly, including parent modules.
@@ -478,11 +493,13 @@
superclass_table :: superclass_table,
assertion_table :: assertion_table,
ctor_field_table :: ctor_field_table,
- cell_counter :: counter
+ cell_counter :: counter,
% cell count, passed into code_info
% and used to generate unique label
% numbers for constant terms in the
% generated C code
+
+ maybe_recompilation_info :: maybe(recompilation_info)
).
:- type module_sub_info --->
@@ -537,7 +554,8 @@
% A predicate which creates an empty module
-module_info_init(Name, Items, Globals, QualifierInfo, ModuleInfo) :-
+module_info_init(Name, Items, Globals, QualifierInfo, RecompInfo,
+ ModuleInfo) :-
predicate_table_init(PredicateTable),
unify_proc__init_requests(Requests),
map__init(UnifyPredMap),
@@ -575,7 +593,7 @@
ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, SuperClassTable, InstanceTable, AssertionTable,
- FieldNameTable, counter__init(1)).
+ FieldNameTable, counter__init(1), RecompInfo).
%-----------------------------------------------------------------------------%
@@ -595,6 +613,7 @@
module_info_assertion_table(MI, MI ^ assertion_table).
module_info_ctor_field_table(MI, MI ^ ctor_field_table).
module_info_get_cell_counter(MI, MI ^ cell_counter).
+module_info_get_maybe_recompilation_info(MI, MI ^ maybe_recompilation_info).
%-----------------------------------------------------------------------------%
@@ -615,6 +634,8 @@
module_info_set_assertion_table(MI, A, MI ^ assertion_table := A).
module_info_set_ctor_field_table(MI, CF, MI ^ ctor_field_table := CF).
module_info_set_cell_counter(MI, CC, MI ^ cell_counter := CC).
+module_info_set_maybe_recompilation_info(MI, I,
+ MI ^ maybe_recompilation_info := I).
%-----------------------------------------------------------------------------%
@@ -840,6 +861,18 @@
module_info_ctors(ModuleInfo6, Ctors0),
map__optimize(Ctors0, Ctors),
module_info_set_ctors(ModuleInfo6, Ctors, ModuleInfo).
+
+visible_module(VisibleModule, ModuleInfo) :-
+ module_info_name(ModuleInfo, ThisModule),
+ module_info_get_imported_module_specifiers(ModuleInfo, ImportedModules),
+ (
+ VisibleModule = ThisModule
+ ;
+ set__member(VisibleModule, ImportedModules)
+ ;
+ get_ancestors(ThisModule, ParentModules),
+ list__member(VisibleModule, ParentModules)
+ ).
module_info_get_all_deps(ModuleInfo, AllImports) :-
module_info_name(ModuleInfo, ModuleName),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.94
diff -u -u -r1.94 hlds_pred.m
--- compiler/hlds_pred.m 2001/03/27 05:23:06 1.94
+++ compiler/hlds_pred.m 2001/03/27 08:41:16
@@ -2225,15 +2225,6 @@
:- pred pred_args_to_func_args(list(T), list(T), T).
:- mode pred_args_to_func_args(in, out, out) is det.
- % adjust_func_arity(PredOrFunc, FuncArity, PredArity).
- %
- % We internally store the arity as the length of the argument
- % list including the return value, which is one more than the
- % arity of the function reported in error messages.
-:- pred adjust_func_arity(pred_or_func, int, int).
-:- mode adjust_func_arity(in, in, out) is det.
-:- mode adjust_func_arity(in, out, in) is det.
-
% Get the last two arguments from the list, failing if there
% aren't at least two arguments.
:- pred get_state_args(list(T), list(T), T, T).
@@ -2276,9 +2267,6 @@
;
error("pred_args_to_func_args: function missing return value?")
).
-
-adjust_func_arity(predicate, Arity, Arity).
-adjust_func_arity(function, Arity - 1, Arity).
get_state_args(Args0, Args, State0, State) :-
list__reverse(Args0, RevArgs0),
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.99
diff -u -u -r1.99 intermod.m
--- compiler/intermod.m 2001/05/02 17:34:32 1.99
+++ compiler/intermod.m 2001/05/11 02:21:06
@@ -1241,22 +1241,19 @@
{ TypeId = Name - _Arity },
(
{ Body = du_type(Ctors, _, _, MaybeEqualityPred) },
- mercury_output_type_defn(VarSet,
- du_type(Name, Args, Ctors,
- MaybeEqualityPred),
- Context)
+ { TypeBody = du_type(Ctors, MaybeEqualityPred) }
;
{ Body = uu_type(_) },
{ error("uu types not implemented") }
;
{ Body = eqv_type(EqvType) },
- mercury_output_type_defn(VarSet,
- eqv_type(Name, Args, EqvType), Context)
+ { TypeBody = eqv_type(EqvType) }
;
{ Body = abstract_type },
- mercury_output_type_defn(VarSet,
- abstract_type(Name, Args), Context)
- ).
+ { TypeBody = abstract_type }
+ ),
+ mercury_output_item(type_defn(VarSet, Name, Args, TypeBody, true),
+ Context).
:- pred intermod__write_modes(module_info::in,
io__state::di, io__state::uo) is det.
@@ -1278,11 +1275,9 @@
{ SymName = qualified(ModuleName, _) },
{ ImportStatus = local }
->
- mercury_output_mode_defn(
- Varset,
- eqv_mode(SymName, Args, Mode),
- Context
- )
+ mercury_output_item(
+ mode_defn(Varset, SymName, Args, eqv_mode(Mode), true),
+ Context)
;
[]
).
@@ -1310,19 +1305,14 @@
->
(
{ Body = eqv_inst(Inst2) },
- mercury_output_inst_defn(
- Varset,
- eqv_inst(SymName, Args, Inst2),
- Context
- )
+ { InstBody = eqv_inst(Inst2) }
;
{ Body = abstract_inst },
- mercury_output_inst_defn(
- Varset,
- abstract_inst(SymName, Args),
- Context
- )
- )
+ { InstBody = abstract_inst }
+ ),
+ mercury_output_item(
+ inst_defn(Varset, SymName, Args, InstBody, true),
+ Context)
;
[]
).
@@ -1652,7 +1642,7 @@
( { multi_map__search(PragmaMap, PredId, TypeSpecPragmas) } ->
list__foldl(
( pred(Pragma::in, di, uo) is det -->
- ( { Pragma = type_spec(_, _, _, _, _, _, _) } ->
+ ( { Pragma = type_spec(_, _, _, _, _, _, _, _) } ->
{ AppendVarnums = yes },
mercury_output_pragma_type_spec(Pragma,
AppendVarnums)
@@ -2097,7 +2087,7 @@
% Read in the .opt files for imported and ancestor modules.
%
{ Module0 = module_imports(_, ModuleName, Ancestors0, InterfaceDeps0,
- ImplementationDeps0, _, _, _, _, _, _) },
+ ImplementationDeps0, _, _, _, _, _, _, _) },
{ list__condense([Ancestors0, InterfaceDeps0, ImplementationDeps0],
OptFiles) },
read_optimization_interfaces(OptFiles, [], OptItems, no, OptError),
@@ -2154,10 +2144,12 @@
% Read in the .int, and .int2 files needed by the .opt files.
% (XXX do we also need to read in .int0 files here?)
%
- process_module_long_interfaces(NewDeps, ".int", [], NewIndirectDeps,
- Module2, Module3),
- process_module_indirect_imports(NewIndirectDeps, ".int2",
- Module3, Module),
+ { map__init(ReadModules) },
+ process_module_long_interfaces(ReadModules,
+ must_be_qualified, NewDeps, ".int",
+ [], NewIndirectDeps, Module2, Module3),
+ process_module_indirect_imports(ReadModules, NewIndirectDeps, ".int2",
+ Module3, 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.13
diff -u -u -r1.13 magic_util.m
--- compiler/magic_util.m 2001/05/02 17:34:34 1.13
+++ compiler/magic_util.m 2001/05/18 09:13:17
@@ -274,9 +274,8 @@
%-----------------------------------------------------------------------------%
-magic_util__adjust_index(ArgTypes0, index_spec(IndexType, Attrs0),
+magic_util__adjust_index(ArgTypes, index_spec(IndexType, Attrs0),
index_spec(IndexType, Attrs)) :-
- strip_prog_contexts(ArgTypes0, ArgTypes),
construct_type(qualified(unqualified("aditi"), "state") - 0,
[], StateType),
( list__nth_member_search(ArgTypes, StateType, StateIndex) ->
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.371
diff -u -u -r1.371 make_hlds.m
--- compiler/make_hlds.m 2001/05/16 04:50:46 1.371
+++ compiler/make_hlds.m 2001/05/28 05:39:57
@@ -82,6 +82,11 @@
qual_info::in, qual_info::out,
io__state::di, io__state::uo) is det.
+ % Move the recompilation_info from the qual_info to the module_info
+ % after make_hlds is finished with it and the qual_info is dead.
+:- pred set_module_recompilation_info(qual_info::in,
+ module_info::in, module_info::out) is det.
+
:- pred next_mode_id(proc_table, maybe(determinism), proc_id).
:- mode next_mode_id(in, in, out) is det.
@@ -98,6 +103,7 @@
:- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
:- import_module fact_table, purity, goal_util, term_util, export, llds.
:- import_module error_util, foreign.
+:- import_module recompilation.
:- import_module string, char, int, set, bintree, map, multi_map, require.
:- import_module bag, term, varset, getopt, assoc_list, term_io.
@@ -106,7 +112,7 @@
UndefTypes, UndefModes) -->
globals__io_get_globals(Globals),
{ mq_info_get_partial_qualifier_info(MQInfo0, PQInfo) },
- { module_info_init(Name, Items, Globals, PQInfo, Module0) },
+ { module_info_init(Name, Items, Globals, PQInfo, no, Module0) },
add_item_list_decls_pass_1(Items,
item_status(local, may_be_unqualified), Module0, Module1),
globals__io_lookup_bool_option(statistics, Statistics),
@@ -211,57 +217,40 @@
:- mode add_item_decl_pass_1(in, in, in, in, out, out, di, uo) is det.
% skip clauses
-add_item_decl_pass_1(pred_clause(_, _, _, _), _, Status, Module, Status, Module)
+add_item_decl_pass_1(clause(_, _, _, _, _), _, Status, Module, Status, Module)
--> [].
-add_item_decl_pass_1(func_clause(_, _, _, _, _), _, Status, Module, Status,
- Module) --> [].
-add_item_decl_pass_1(type_defn(_, _, _), _, Status, Module, Status, Module)
- --> [].
+add_item_decl_pass_1(type_defn(_, _, _, _, _), _, Status, Module,
+ Status, Module) --> [].
-add_item_decl_pass_1(inst_defn(VarSet, InstDefn, Cond), Context,
+add_item_decl_pass_1(inst_defn(VarSet, Name, Params, InstDefn, Cond), Context,
Status, Module0, Status, Module) -->
- module_add_inst_defn(Module0, VarSet, InstDefn, Cond, Context,
- Status, Module).
+ module_add_inst_defn(Module0, VarSet, Name, Params,
+ InstDefn, Cond, Context, Status, Module).
-add_item_decl_pass_1(mode_defn(VarSet, ModeDefn, Cond), Context,
+add_item_decl_pass_1(mode_defn(VarSet, Name, Params, ModeDefn, Cond), Context,
Status, Module0, Status, Module) -->
- module_add_mode_defn(Module0, VarSet, ModeDefn, Cond, Context,
- Status, Module).
+ module_add_mode_defn(Module0, VarSet, Name, Params, ModeDefn,
+ Cond, Context, Status, Module).
-add_item_decl_pass_1(pred(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext),
+add_item_decl_pass_1(pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond,
+ Purity, ClassContext),
Context, Status, Module0, Status, Module) -->
{ init_markers(Markers) },
- module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext, Markers,
- Context, Status, _, Module).
-
-add_item_decl_pass_1(func(TypeVarSet, InstVarSet, ExistQVars, FuncName,
- TypesAndModes, RetTypeAndMode, MaybeDet, Cond, Purity,
- ClassContext), Context, Status, Module0, Status, Module) -->
- { init_markers(Markers) },
- module_add_func(Module0, TypeVarSet, InstVarSet, ExistQVars, FuncName,
- TypesAndModes, RetTypeAndMode, MaybeDet, Cond, Purity,
- ClassContext, Markers, Context, Status, _, Module).
-
-add_item_decl_pass_1(pred_mode(VarSet, PredName, Modes, MaybeDet, Cond),
+ module_add_pred_or_func(Module0, TypeVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond,
+ Purity, ClassContext, Markers, Context, Status, _, Module).
+
+add_item_decl_pass_1(
+ pred_or_func_mode(VarSet, PredOrFunc, PredName,
+ Modes, MaybeDet, Cond),
Context, Status, Module0, Status, Module) -->
{ Status = item_status(ImportStatus, _) },
{ IsClassMethod = no },
module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet, Cond,
- ImportStatus, Context, predicate, IsClassMethod,
- _, Module).
+ ImportStatus, Context, PredOrFunc, IsClassMethod, _, Module).
-add_item_decl_pass_1(func_mode(VarSet, FuncName, Modes, RetMode, MaybeDet,
- Cond), Context, Status, Module0, Status, Module) -->
- { list__append(Modes, [RetMode], Modes1) },
- { Status = item_status(ImportStatus, _) },
- { IsClassMethod = no },
- module_add_mode(Module0, VarSet, FuncName, Modes1,
- MaybeDet, Cond, ImportStatus, Context, function, IsClassMethod,
- _, Module).
-
add_item_decl_pass_1(pragma(_), _, Status, Module, Status, Module) --> [].
add_item_decl_pass_1(assertion(_, _), _, Status, Module, Status, Module) --> [].
@@ -316,6 +305,9 @@
report_unexpected_decl("end_module", Context),
{ Status = Status0 },
{ Module = Module0 }
+ ; { ModuleDefn = version_numbers(_, _) } ->
+ { Status = Status0 },
+ { Module = Module0 }
; { ModuleDefn = transitively_imported } ->
{ Status = Status0 },
{ Module = Module0 }
@@ -329,24 +321,7 @@
io__set_output_stream(OldStream, _)
).
-add_item_decl_pass_1(nothing, Context, Status, Module, Status, Module) -->
- %
- % Currently "nothing" is used only for NU-Prolog `when' declarations,
- % which we used to quietly ignore. We want to eventually drop support
- % for them, but to ease the transition, for now we just issue
- % a warning message.
- %
- prog_out__write_context(Context),
- report_warning(
- "Warning: NU-Prolog `when' declarations are deprecated.\n"),
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
- ( { VerboseErrors = yes } ->
- prog_out__write_context(Context),
- io__write_string("Future releases of the Mercury system "),
- io__write_string("will not support `when' declarations.\n")
- ;
- []
- ).
+add_item_decl_pass_1(nothing(_), _, Status, Module, Status, Module) --> [].
add_item_decl_pass_1(typeclass(Constraints, Name, Vars, Interface, VarSet),
Context, Status, Module0, Status, Module) -->
@@ -355,7 +330,7 @@
% We add instance declarations on the second pass so that we don't add
% an instance declaration before its class declaration.
-add_item_decl_pass_1(instance(_, _, _, _, _, _), _, Status, Module, Status,
+add_item_decl_pass_1(instance(_, _, _, _, _,_), _, Status, Module, Status,
Module) --> [].
%-----------------------------------------------------------------------------%
@@ -375,10 +350,10 @@
Status = Status0
}.
-add_item_decl_pass_2(type_defn(VarSet, TypeDefn, Cond), Context,
+add_item_decl_pass_2(type_defn(VarSet, Name, Args, TypeDefn, Cond), Context,
Status, Module0, Status, Module) -->
- module_add_type_defn(Module0, VarSet, TypeDefn, Cond, Context, Status,
- Module).
+ module_add_type_defn(Module0, VarSet, Name, Args, TypeDefn,
+ Cond, Context, Status, Module).
add_item_decl_pass_2(pragma(Pragma), Context, Status, Module0, Status, Module)
-->
@@ -456,8 +431,10 @@
ModeNum, UnusedArgs, Context, Module0, Module)
)
;
- { Pragma = type_spec(_, _, _, _, _, _, _) },
- add_pragma_type_spec(Pragma, Context, Module0, Module)
+ % Handle pragma type_spec decls later on (when we process
+ % clauses).
+ { Pragma = type_spec(_, _, _, _, _, _, _, _) },
+ { Module = Module0 }
;
% Handle pragma fact_table decls later on (when we process
% clauses).
@@ -547,42 +524,47 @@
Module)
).
-add_item_decl_pass_2(func(_TypeVarSet, _InstVarSet, _ExistQVars, FuncName,
- TypesAndModes, _RetTypeAndMode, _MaybeDet, _Cond, _Purity,
- _ClassContext), _Context, Status, Module0, Status, Module) -->
+add_item_decl_pass_2(
+ pred_or_func(_TypeVarSet, _InstVarSet, _ExistQVars,
+ PredOrFunc, SymName, TypesAndModes, _MaybeDet,
+ _Cond, _Purity, _ClassContext),
+ _Context, Status, Module0, Status, Module) -->
%
% add default modes for function declarations, if necessary
%
- { list__length(TypesAndModes, Arity) },
- { module_info_get_predicate_table(Module0, PredTable0) },
- (
- { predicate_table_search_func_sym_arity(PredTable0,
- FuncName, Arity, PredIds) }
- ->
- { predicate_table_get_preds(PredTable0, Preds0) },
- { maybe_add_default_func_modes(PredIds, Preds0, Preds) },
- { predicate_table_set_preds(PredTable0, Preds, PredTable) },
- { module_info_set_predicate_table(Module0, PredTable, Module) }
+ {
+ PredOrFunc = predicate,
+ Module = Module0
;
- { error("make_hlds.m: can't find func declaration") }
- ).
+ PredOrFunc = function,
+ list__length(TypesAndModes, Arity),
+ adjust_func_arity(function, FuncArity, Arity),
+ module_info_get_predicate_table(Module0, PredTable0),
+ (
+ predicate_table_search_func_sym_arity(PredTable0,
+ SymName, FuncArity, PredIds)
+ ->
+ predicate_table_get_preds(PredTable0, Preds0),
+ maybe_add_default_func_modes(PredIds, Preds0, Preds),
+ predicate_table_set_preds(PredTable0,
+ Preds, PredTable),
+ module_info_set_predicate_table(Module0,
+ PredTable, Module)
+ ;
+ error("make_hlds.m: can't find func declaration")
+ )
+ }.
add_item_decl_pass_2(assertion(_, _), _, Status, Module, Status, Module) --> [].
-add_item_decl_pass_2(func_clause(_, _, _, _, _), _, Status, Module, Status,
- Module) --> [].
-add_item_decl_pass_2(pred_clause(_, _, _, _), _, Status, Module, Status, Module)
- --> [].
-add_item_decl_pass_2(inst_defn(_, _, _), _, Status, Module, Status, Module)
- --> [].
-add_item_decl_pass_2(mode_defn(_, _, _), _, Status, Module, Status, Module)
- --> [].
-add_item_decl_pass_2(pred(_, _, _, _, _, _, _, _, _),
- _, Status, Module, Status, Module) --> [].
-add_item_decl_pass_2(pred_mode(_, _, _, _, _), _, Status, Module, Status,
- Module) --> [].
-add_item_decl_pass_2(func_mode(_, _, _, _, _, _), _, Status, Module, Status,
+add_item_decl_pass_2(clause(_, _, _, _, _), _, Status, Module, Status,
Module) --> [].
-add_item_decl_pass_2(nothing, _, Status, Module, Status, Module) --> [].
+add_item_decl_pass_2(inst_defn(_, _, _, _, _), _, Status, Module,
+ Status, Module) --> [].
+add_item_decl_pass_2(mode_defn(_, _, _, _, _), _, Status, Module,
+ Status, Module) --> [].
+add_item_decl_pass_2(pred_or_func_mode(_, _, _, _, _, _), _,
+ Status, Module, Status, Module) --> [].
+add_item_decl_pass_2(nothing(_), _, Status, Module, Status, Module) --> [].
add_item_decl_pass_2(typeclass(_, _, _, _, _)
, _, Status, Module, Status, Module) --> [].
add_item_decl_pass_2(instance(Constraints, Name, Types, Body, VarSet,
@@ -651,45 +633,56 @@
module_info, module_info, qual_info, qual_info, io__state, io__state).
:- mode add_item_clause(in, in, out, in, in, out, in, out, di, uo) is det.
-add_item_clause(func_clause(VarSet, PredName, Args, Result, Body), Status,
- Status, Context, Module0, Module, Info0, Info) -->
- check_not_exported(Status, Context, "clause"),
- { IsAssertion = no },
- module_add_func_clause(Module0, VarSet, PredName, Args, Result, Body,
- Status, Context, IsAssertion, Module, Info0, Info).
-add_item_clause(pred_clause(VarSet, PredName, Args, Body), Status, Status,
- Context, Module0, Module, Info0, Info) -->
+add_item_clause(clause(VarSet, PredOrFunc, PredName, Args, Body),
+ Status, Status, Context, Module0, Module, Info0, Info) -->
check_not_exported(Status, Context, "clause"),
{ IsAssertion = no },
- module_add_pred_clause(Module0, VarSet, PredName, Args, Body, Status,
- Context, IsAssertion, Module, Info0, Info).
-add_item_clause(type_defn(_, _, _), Status, Status, _,
+ module_add_clause(Module0, VarSet, PredOrFunc, PredName,
+ Args, Body, Status, Context, IsAssertion, Module, Info0, Info).
+add_item_clause(type_defn(_, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
-add_item_clause(inst_defn(_, _, _), Status, Status, _,
+add_item_clause(inst_defn(_, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
-add_item_clause(mode_defn(_, _, _), Status, Status, _,
+add_item_clause(mode_defn(_, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
-add_item_clause(pred(_, _, _, _, _, _, _, _, _), Status, Status, _,
- Module, Module, Info, Info) --> [].
-add_item_clause(func(_, _, _, FuncName, TypesAndModes, _, _, _, _, _),
+add_item_clause(
+ pred_or_func(_, _, _, PredOrFunc, SymName, TypesAndModes,
+ _, _, _, _),
Status, Status, Context, Module, Module, Info, Info) -->
- { list__length(TypesAndModes, FuncArity) },
- maybe_check_field_access_function(FuncName, FuncArity,
- Status, Context, Module).
+ (
+ { PredOrFunc = predicate }
+ ;
+ { PredOrFunc = function},
+ { list__length(TypesAndModes, PredArity) },
+ { adjust_func_arity(function, FuncArity, PredArity) },
+ maybe_check_field_access_function(SymName, FuncArity,
+ Status, Context, Module)
+ ).
-add_item_clause(pred_mode(_, _, _, _, _), Status, Status, _,
- Module, Module, Info, Info) --> [].
-add_item_clause(func_mode(_, _, _, _, _, _), Status, Status, _,
+add_item_clause(pred_or_func_mode(_, _, _, _, _, _), Status, Status, _,
Module, Module, Info, Info) --> [].
add_item_clause(module_defn(_, Defn), Status0, Status, _,
- Module, Module, Info0, Info) -->
- { module_defn_update_import_status(Defn, ItemStatus1) ->
+ Module0, Module, Info0, Info) -->
+ { Defn = version_numbers(ModuleName, ModuleVersionNumbers) ->
+ apply_to_recompilation_info(
+ (pred(RecompInfo0::in, RecompInfo::out) is det :-
+ map__set(RecompInfo0 ^ version_numbers, ModuleName,
+ ModuleVersionNumbers, VersionNumbers),
+ RecompInfo = RecompInfo0 ^ version_numbers
+ := VersionNumbers
+ ),
+ transform_info(Module0, Info0),
+ transform_info(Module, Info)),
+ Status = Status0
+ ; module_defn_update_import_status(Defn, ItemStatus1) ->
ItemStatus1 = item_status(Status1, NeedQual),
qual_info_get_mq_info(Info0, MQInfo0),
mq_info_set_need_qual_flag(MQInfo0, NeedQual, MQInfo),
qual_info_set_mq_info(Info0, MQInfo, Info),
+ Module = Module0,
Status = Status1
;
+ Module = Module0,
Info = Info0,
Status = Status0
}.
@@ -736,9 +729,14 @@
" structures. Use the --type-layout flag to enable them.\n")
),
{ Info = Info0 }
+ ;
+ { Pragma = type_spec(_, _, _, _, _, _, _, _) }
+ ->
+ add_pragma_type_spec(Pragma, Context, Module0, Module,
+ Info0, Info)
;
- % don't worry about any pragma decs but c_code, tabling
- % and fact_table here
+ % don't worry about any pragma decs but c_code, tabling,
+ % type_spec and fact_table here
{ Module = Module0 },
{ Info = Info0 }
).
@@ -780,11 +778,12 @@
% ( R = A + B <=> R = B + A ).
%
{ IsAssertion = yes },
- module_add_pred_clause(Module0, VarSet, unqualified(Name),
+ module_add_clause(Module0, VarSet, predicate, unqualified(Name),
HeadVars, Goal, Status, Context, IsAssertion, Module,
Info0, Info).
-add_item_clause(nothing, Status, Status, _, Module, Module, Info, Info) --> [].
+add_item_clause(nothing(_), Status, Status, _,
+ Module, Module, Info, Info) --> [].
add_item_clause(typeclass(_, _, _, _, _),
Status, Status, _, Module, Module, Info, Info) --> [].
add_item_clause(instance(_, _, _, _, _, _),
@@ -882,11 +881,13 @@
%-----------------------------------------------------------------------------%
:- pred add_pragma_type_spec(pragma_type, term__context,
- module_info, module_info, io__state, io__state).
-:- mode add_pragma_type_spec(in(type_spec), in, in, out, di, uo) is det.
+ module_info, module_info, qual_info, qual_info,
+ io__state, io__state).
+:- mode add_pragma_type_spec(in(type_spec), in, in, out,
+ in, out, di, uo) is det.
-add_pragma_type_spec(Pragma, Context, Module0, Module) -->
- { Pragma = type_spec(SymName, _, Arity, MaybePredOrFunc, _, _, _) },
+add_pragma_type_spec(Pragma, Context, Module0, Module, Info0, Info) -->
+ { Pragma = type_spec(SymName, _, Arity, MaybePredOrFunc, _, _, _, _) },
{ module_info_get_predicate_table(Module0, Preds) },
(
{ MaybePredOrFunc = yes(PredOrFunc) ->
@@ -900,20 +901,23 @@
{ PredIds \= [] }
->
list__foldl2(add_pragma_type_spec_2(Pragma, Context),
- PredIds, Module0, Module)
+ PredIds, transform_info(Module0, Info0),
+ transform_info(Module, Info))
;
+ { Info = Info0 },
undefined_pred_or_func_error(SymName, Arity, Context,
"`:- pragma type_spec' declaration"),
{ module_info_incr_errors(Module0, Module) }
).
:- pred add_pragma_type_spec_2(pragma_type, prog_context, pred_id,
- module_info, module_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode add_pragma_type_spec_2(in(type_spec), in, in, in, out, di, uo) is det.
-add_pragma_type_spec_2(Pragma0, Context, PredId, ModuleInfo0, ModuleInfo) -->
+add_pragma_type_spec_2(Pragma0, Context, PredId,
+ transform_info(ModuleInfo0, Info0), TransformInfo) -->
{ Pragma0 = type_spec(SymName, SpecName, Arity, _,
- MaybeModes, Subst, TVarSet0) },
+ MaybeModes, Subst, TVarSet0, UsedEquivTypes) },
{ module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
handle_pragma_type_spec_subst(Context, Subst, TVarSet0, PredInfo0,
TVarSet, Types, ExistQVars, ClassContext, SubstOk,
@@ -958,8 +962,10 @@
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
goal_info_set_context(GoalInfo1, Context, GoalInfo),
- construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
- GoalInfo, Goal),
+ % We don't record the called predicate as used --
+ % it is only used if there is some other call.
+ do_construct_pred_or_func_call(PredId, PredOrFunc, SymName,
+ Args, GoalInfo, Goal),
Clause = clause(ProcIds, Goal, Context),
map__init(TI_VarMap),
map__init(TCI_VarMap),
@@ -1009,20 +1015,27 @@
;
SpecMap = SpecMap0
),
-
Pragma = type_spec(SymName, SpecName, Arity,
yes(PredOrFunc), MaybeModes,
- map__to_assoc_list(RenamedSubst), TVarSet),
+ map__to_assoc_list(RenamedSubst), TVarSet,
+ UsedEquivTypes),
multi_map__set(PragmaMap0, PredId, Pragma, PragmaMap),
TypeSpecInfo = type_spec_info(ProcsToSpec,
ForceVersions, SpecMap, PragmaMap),
module_info_set_type_spec_info(ModuleInfo3,
- TypeSpecInfo, ModuleInfo)
+ TypeSpecInfo, ModuleInfo),
+
+ ItemType = pred_or_func_to_item_type(PredOrFunc),
+ apply_to_recompilation_info(
+ recompilation__record_used_equivalence_types(
+ item_id(ItemType, SymName - Arity),
+ UsedEquivTypes),
+ transform_info(ModuleInfo, Info0), TransformInfo)
;
- ModuleInfo = ModuleInfo2
+ TransformInfo = transform_info(ModuleInfo2, Info0)
}
;
- { ModuleInfo = ModuleInfo1 }
+ { TransformInfo = transform_info(ModuleInfo1, Info0) }
).
% Check that the type substitution for a `:- pragma type_spec'
@@ -1640,28 +1653,30 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_inst_defn(module_info, inst_varset, inst_defn, condition,
- prog_context, item_status,
+:- pred module_add_inst_defn(module_info, inst_varset, sym_name, list(inst_var),
+ inst_defn, condition, prog_context, item_status,
module_info, io__state, io__state).
-:- mode module_add_inst_defn(in, in, in, in, in, in, out, di, uo) is det.
+:- mode module_add_inst_defn(in, in, in, in, in, in, in, in,
+ out, di, uo) is det.
-module_add_inst_defn(Module0, VarSet, InstDefn, Cond,
+module_add_inst_defn(Module0, VarSet, Name, Args, InstDefn, Cond,
Context, item_status(Status, _NeedQual), Module) -->
{ module_info_insts(Module0, InstTable0) },
{ inst_table_get_user_insts(InstTable0, Insts0) },
- insts_add(Insts0, VarSet, InstDefn, Cond, Context, Status, Insts),
+ insts_add(Insts0, VarSet, Name, Args, InstDefn, Cond,
+ Context, Status, Insts),
{ inst_table_set_user_insts(InstTable0, Insts, InstTable) },
{ module_info_set_insts(Module0, InstTable, Module) }.
-:- pred insts_add(user_inst_table, inst_varset, inst_defn, condition,
- prog_context, import_status, user_inst_table,
- io__state, io__state).
-:- mode insts_add(in, in, in, in, in, in, out, di, uo) is det.
+:- pred insts_add(user_inst_table, inst_varset, sym_name, list(inst_var),
+ inst_defn, condition, prog_context, import_status,
+ user_inst_table, io__state, io__state).
+:- mode insts_add(in, in, in, in, in, in, in, in, out, di, uo) is det.
% XXX handle abstract insts
-insts_add(_, _, abstract_inst(_, _), _, _, _, _) -->
+insts_add(_, _, _, _, abstract_inst, _, _, _, _) -->
{ error("sorry, abstract insts not implemented") }.
-insts_add(Insts0, VarSet, eqv_inst(Name, Args, Body),
+insts_add(Insts0, VarSet, Name, Args, eqv_inst(Body),
Cond, Context, Status, Insts) -->
{ list__length(Args, Arity) },
(
@@ -1690,21 +1705,25 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_mode_defn(module_info, inst_varset, mode_defn, condition,
- prog_context, item_status, module_info, io__state, io__state).
-:- mode module_add_mode_defn(in, in, in, in, in, in, out, di, uo) is det.
+:- pred module_add_mode_defn(module_info, inst_varset, sym_name,
+ list(inst_var), mode_defn, condition, prog_context,
+ item_status, module_info, io__state, io__state).
+:- mode module_add_mode_defn(in, in, in, in, in, in, in,
+ in, out, di, uo) is det.
-module_add_mode_defn(Module0, VarSet, ModeDefn, Cond,
+module_add_mode_defn(Module0, VarSet, Name, Params, ModeDefn, Cond,
Context, item_status(Status, _NeedQual), Module) -->
{ module_info_modes(Module0, Modes0) },
- modes_add(Modes0, VarSet, ModeDefn, Cond, Context, Status, Modes),
+ modes_add(Modes0, VarSet, Name, Params, ModeDefn,
+ Cond, Context, Status, Modes),
{ module_info_set_modes(Module0, Modes, Module) }.
-:- pred modes_add(mode_table, inst_varset, mode_defn, condition, prog_context,
- import_status, mode_table, io__state, io__state).
-:- mode modes_add(in, in, in, in, in, in, out, di, uo) is det.
+:- pred modes_add(mode_table, inst_varset, sym_name, list(inst_var),
+ mode_defn, condition, prog_context, import_status,
+ mode_table, io__state, io__state).
+:- mode modes_add(in, in, in, in, in, in, in, in, out, di, uo) is det.
-modes_add(Modes0, VarSet, eqv_mode(Name, Args, Body),
+modes_add(Modes0, VarSet, Name, Args, eqv_mode(Body),
Cond, Context, Status, Modes) -->
{ list__length(Args, Arity) },
(
@@ -1729,11 +1748,6 @@
)
).
-:- pred mode_name_args(mode_defn, sym_name, list(inst_var), hlds_mode_body).
-:- mode mode_name_args(in, out, out, out) is det.
-
-mode_name_args(eqv_mode(Name, Args, Body), Name, Args, eqv_mode(Body)).
-
%-----------------------------------------------------------------------------%
% We allow more than one "definition" for a given type so
@@ -1741,15 +1755,17 @@
% e.g. `:- type t.', which is parsed as an type definition for
% t which defines t as an abstract_type.
-:- pred module_add_type_defn(module_info, tvarset, type_defn, condition,
- prog_context, item_status, module_info, io__state, io__state).
-:- mode module_add_type_defn(in, in, in, in, in, in, out, di, uo) is det.
+:- pred module_add_type_defn(module_info, tvarset, sym_name, list(type_param),
+ type_defn, condition, prog_context, item_status,
+ module_info, io__state, io__state).
+:- mode module_add_type_defn(in, in, in, in, in,
+ in, in, in, out, di, uo) is det.
-module_add_type_defn(Module0, TVarSet, TypeDefn, _Cond, Context,
+module_add_type_defn(Module0, TVarSet, Name, Args, TypeDefn, _Cond, Context,
item_status(Status0, NeedQual), Module) -->
{ module_info_types(Module0, Types0) },
globals__io_get_globals(Globals),
- { convert_type_defn(TypeDefn, Globals, Name, Args, Body) },
+ { convert_type_defn(TypeDefn, Globals, Body) },
{ list__length(Args, Arity) },
{ TypeId = Name - Arity },
{ Body = abstract_type ->
@@ -1809,7 +1825,7 @@
)
;
{ map__set(Types0, TypeId, T, Types) },
- { construct_qualified_term(Name, Args, Type) },
+ { construct_type(TypeId, Args, Type) },
(
{ Body = du_type(ConsList, _, _, _) }
->
@@ -1972,17 +1988,15 @@
Status = abstract_imported
).
-:- pred convert_type_defn(type_defn, globals,
- sym_name, list(type_param), hlds_type_body).
-:- mode convert_type_defn(in, in, out, out, out) is det.
+:- pred convert_type_defn(type_defn, globals, hlds_type_body).
+:- mode convert_type_defn(in, in, out) is det.
-convert_type_defn(du_type(Name, Args, Body, EqualityPred),
- Globals, Name, Args,
+convert_type_defn(du_type(Body, EqualityPred), Globals,
du_type(Body, CtorTags, IsEnum, EqualityPred)) :-
assign_constructor_tags(Body, Globals, CtorTags, IsEnum).
-convert_type_defn(uu_type(Name, Args, Body), _, Name, Args, uu_type(Body)).
-convert_type_defn(eqv_type(Name, Args, Body), _, Name, Args, eqv_type(Body)).
-convert_type_defn(abstract_type(Name, Args), _, Name, Args, abstract_type).
+convert_type_defn(uu_type(Body), _, uu_type(Body)).
+convert_type_defn(eqv_type(Body), _, eqv_type(Body)).
+convert_type_defn(abstract_type, _, abstract_type).
:- pred ctors_add(list(constructor), type_id, tvarset, need_qualifier,
partial_qualifier_info, prog_context, import_status,
@@ -2185,18 +2199,19 @@
%-----------------------------------------------------------------------------%
-:- pred module_add_pred(module_info, tvarset, inst_varset, existq_tvars,
- sym_name, list(type_and_mode), maybe(determinism), condition,
- purity, class_constraints, pred_markers, prog_context,
- item_status, maybe(pair(pred_id, proc_id)), module_info,
+:- pred module_add_pred_or_func(module_info, tvarset, inst_varset,
+ existq_tvars, pred_or_func, sym_name, list(type_and_mode),
+ maybe(determinism), condition, purity, class_constraints,
+ pred_markers, prog_context, item_status,
+ maybe(pair(pred_id, proc_id)), module_info,
io__state, io__state).
-:- mode module_add_pred(in, in, in, in, in, in, in, in, in, in, in, in, in,
- out, out, di, uo) is det.
+:- mode module_add_pred_or_func(in, in, in, in, in, in, in, in, in, in, in, in,
+ in, in, out, out, di, uo) is det.
-module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity, ClassContext, Markers,
- Context, item_status(Status, NeedQual), MaybePredProcId,
- Module) -->
+module_add_pred_or_func(Module0, TypeVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, PredName, TypesAndModes, MaybeDet, Cond, Purity,
+ ClassContext, Markers, Context, item_status(Status, NeedQual),
+ MaybePredProcId, Module) -->
% Only preds with opt_imported clauses are tagged as opt_imported, so
% that the compiler doesn't look for clauses for other preds read in
% from optimization interfaces.
@@ -2205,95 +2220,54 @@
;
DeclStatus = Status
},
- { split_types_and_modes(TypesAndModes, Types, MaybeModes) },
+ { split_types_and_modes(TypesAndModes, Types, MaybeModes0) },
add_new_pred(Module0, TypeVarSet, ExistQVars, PredName, Types, Cond,
Purity, ClassContext, Markers, Context, DeclStatus, NeedQual,
- predicate, Module1),
- (
- { MaybeModes = yes(Modes) },
+ PredOrFunc, Module1),
+ {
+ PredOrFunc = predicate,
+ MaybeModes0 = yes(Modes0),
% For predicates with no arguments, if the determinism
% is not declared a mode is not added. The determinism
% can be specified by a separate mode declaration.
- \+ {
- Modes = [],
- MaybeDet = no
- }
+ Modes0 = [],
+ MaybeDet = no
->
- { check_marker(Markers, class_method) ->
- IsClassMethod = yes
- ;
- IsClassMethod = no
- },
- module_add_mode(Module1, InstVarSet, PredName, Modes, MaybeDet,
- Cond, Status, Context, predicate, IsClassMethod,
- PredProcId, Module),
- { MaybePredProcId = yes(PredProcId) }
- ;
- { Module = Module1 },
- { MaybePredProcId = no }
- ).
-
-:- pred module_add_func(module_info, tvarset, inst_varset, existq_tvars,
- sym_name, list(type_and_mode),
- type_and_mode, maybe(determinism), condition, purity,
- class_constraints, pred_markers, prog_context,
- item_status, maybe(pair(pred_id, proc_id)),
- module_info, io__state, io__state).
-:- mode module_add_func(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
- out, out, di, uo) is det.
-
-module_add_func(Module0, TypeVarSet, InstVarSet, ExistQVars, FuncName,
- TypesAndModes, RetTypeAndMode, MaybeDet, Cond, Purity,
- ClassContext, Markers, Context,
- item_status(Status, NeedQual), MaybePredProcId, Module) -->
- % Only funcs with opt_imported clauses are tagged as opt_imported, so
- % that the compiler doesn't look for clauses for other preds.
- { Status = opt_imported ->
- DeclStatus = imported(interface)
+ MaybeModes = no
;
- DeclStatus = Status
- },
-
- { split_types_and_modes(TypesAndModes, Types, MaybeModes0) },
- { split_type_and_mode(RetTypeAndMode, RetType, MaybeRetMode0) },
- { list__append(Types, [RetType], Types1) },
- add_new_pred(Module0, TypeVarSet, ExistQVars, FuncName, Types1, Cond,
- Purity, ClassContext, Markers, Context, DeclStatus, NeedQual,
- function, Module1),
- {
- % If there are no modes, but there is a determinism
- % declared, assume the function has the default modes.
- (MaybeModes0 = no ; MaybeRetMode0 = no),
+ % Assume that a function with no modes but with a determinism
+ % declared has the default modes.
+ PredOrFunc = function,
+ MaybeModes0 = no,
MaybeDet = yes(_)
->
list__length(Types, Arity),
+ adjust_func_arity(function, FuncArity, Arity),
in_mode(InMode),
- list__duplicate(Arity, InMode, InModes),
- MaybeModes = yes(InModes),
+ list__duplicate(FuncArity, InMode, InModes),
out_mode(OutMode),
- MaybeRetMode = yes(OutMode)
+ list__append(InModes, [OutMode], ArgModes),
+ MaybeModes = yes(ArgModes)
;
- MaybeModes = MaybeModes0,
- MaybeRetMode = MaybeRetMode0
+ MaybeModes = MaybeModes0
},
+
(
{ MaybeModes = yes(Modes) },
- { MaybeRetMode = yes(RetMode) }
- ->
- { list__append(Modes, [RetMode], Modes1) },
{ check_marker(Markers, class_method) ->
IsClassMethod = yes
;
IsClassMethod = no
},
- module_add_mode(Module1, InstVarSet, FuncName, Modes1,
- MaybeDet, Cond, Status, Context, function,
- IsClassMethod, PredProcId, Module),
+ module_add_mode(Module1, InstVarSet, PredName, Modes, MaybeDet,
+ Cond, Status, Context, PredOrFunc, IsClassMethod,
+ PredProcId, Module),
{ MaybePredProcId = yes(PredProcId) }
;
+ { MaybeModes = no },
{ Module = Module1 },
- { MaybePredProcId = no}
+ { MaybePredProcId = no }
).
:- pred module_add_class_defn(module_info, list(class_constraint), sym_name,
@@ -2487,52 +2461,28 @@
module_add_class_method(Method, Name, Vars, Status, MaybePredIdProcId,
Module0, Module) -->
(
- { Method = pred(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, MaybeDet, Cond, Purity,
- ClassContext, Context) },
+ { Method = pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, PredName, TypesAndModes, MaybeDet,
+ Cond, Purity, ClassContext, Context) },
{ term__var_list_to_term_list(Vars, VarTerms) },
{ ClassContext = constraints(UnivCnstrs, ExistCnstrs) },
{ NewUnivCnstrs = [constraint(Name, VarTerms) | UnivCnstrs] },
{ NewClassContext = constraints(NewUnivCnstrs, ExistCnstrs) },
{ init_markers(Markers0) },
{ add_marker(Markers0, class_method, Markers) },
- module_add_pred(Module0, TypeVarSet, InstVarSet, ExistQVars,
- PredName, TypesAndModes, MaybeDet, Cond, Purity,
- NewClassContext, Markers, Context, Status,
- MaybePredIdProcId, Module)
- ;
- { Method = func(TypeVarSet, InstVarSet, ExistQVars, FuncName,
- TypesAndModes, RetTypeAndMode, MaybeDet, Cond,
- Purity, ClassContext, Context) },
- { term__var_list_to_term_list(Vars, VarTerms) },
- { ClassContext = constraints(UnivCnstrs, ExistCnstrs) },
- { NewUnivCnstrs = [constraint(Name, VarTerms) | UnivCnstrs] },
- { NewClassContext = constraints(NewUnivCnstrs, ExistCnstrs) },
- { init_markers(Markers0) },
- { add_marker(Markers0, class_method, Markers) },
- module_add_func(Module0, TypeVarSet, InstVarSet, ExistQVars,
- FuncName, TypesAndModes, RetTypeAndMode, MaybeDet,
- Cond, Purity, NewClassContext, Markers, Context,
- Status, MaybePredIdProcId, Module)
+ module_add_pred_or_func(Module0, TypeVarSet, InstVarSet,
+ ExistQVars, PredOrFunc, PredName, TypesAndModes,
+ MaybeDet, Cond, Purity, NewClassContext, Markers,
+ Context, Status, MaybePredIdProcId, Module)
;
- { Method = pred_mode(VarSet, PredName, Modes, MaybeDet,
- Cond, Context) },
+ { Method = pred_or_func_mode(VarSet, PredOrFunc, PredName,
+ Modes, MaybeDet, Cond, Context) },
{ Status = item_status(ImportStatus, _) },
{ IsClassMethod = yes },
- module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet,
- Cond, ImportStatus, Context, predicate, IsClassMethod,
- PredIdProcId, Module),
+ module_add_mode(Module0, VarSet, PredName, Modes, MaybeDet,
+ Cond, ImportStatus, Context, PredOrFunc,
+ IsClassMethod, PredIdProcId, Module),
{ MaybePredIdProcId = yes(PredIdProcId) }
- ;
- { Method = func_mode(VarSet, FuncName, Modes, RetMode, MaybeDet,
- Cond, Context) },
- { list__append(Modes, [RetMode], Modes1) },
- { Status = item_status(ImportStatus, _) },
- { IsClassMethod = yes },
- module_add_mode(Module0, VarSet, FuncName, Modes1, MaybeDet,
- Cond, ImportStatus, Context, function, IsClassMethod,
- PredIdProcId, Module),
- { MaybePredIdProcId = yes(PredIdProcId) }
).
% Go through the list of class methods, looking for
@@ -2548,11 +2498,8 @@
check_method_modes([], PredProcIds, PredProcIds, Module, Module) --> [].
check_method_modes([M|Ms], PredProcIds0, PredProcIds, Module0, Module) -->
(
- { M = func(_, _, _, QualName, TypesAndModes, _, _, _, _, _, _),
- PorF = function
- ; M = pred(_, _, _, QualName, TypesAndModes, _, _, _, _, _),
- PorF = predicate
- }
+ { M = pred_or_func(_, _, _, PorF, QualName, TypesAndModes,
+ _, _, _, _, _) }
->
{ QualName = qualified(ModuleName0, Name0) ->
ModuleName = ModuleName0,
@@ -2564,9 +2511,7 @@
"add_default_class_method_func_modes: unqualified func")
},
- { list__length(TypesAndModes, Arity) },
- { adjust_func_arity(PorF, Arity, PredArity) },
-
+ { list__length(TypesAndModes, PredArity) },
{ module_info_get_predicate_table(Module0, PredTable) },
(
{ predicate_table_search_pf_m_n_a(PredTable, PorF,
@@ -3528,63 +3473,29 @@
proc_id_to_int(ModeId, ModeInt).
%-----------------------------------------------------------------------------%
-
-:- pred module_add_pred_clause(module_info, prog_varset, sym_name,
- list(prog_term), goal, import_status, prog_context,
- bool, module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_pred_clause(in, in, in, in, in, in, in, in, out,
- in, out, di, uo) is det.
-
-module_add_pred_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body,
- Status, Context, IsAssertion, ModuleInfo,
- Info0, Info) -->
- % print out a progress message
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- ( { VeryVerbose = yes } ->
- { list__length(Args, Arity) },
- io__write_string("% Processing clause for predicate `"),
- prog_out__write_sym_name_and_arity(PredName/Arity),
- io__write_string("'...\n")
- ;
- []
- ),
- module_add_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body,
- Status, Context, predicate, IsAssertion, ModuleInfo,
- Info0, Info).
-:- pred module_add_func_clause(module_info, prog_varset, sym_name,
- list(prog_term), prog_term, goal, import_status, prog_context,
- bool, module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_func_clause(in, in, in, in, in,
- in, in, in, in, out, in, out, di, uo) is det.
+:- pred module_add_clause(module_info, prog_varset, pred_or_func, sym_name,
+ list(prog_term), goal, import_status, prog_context, bool,
+ module_info, qual_info, qual_info, io__state, io__state).
+:- mode module_add_clause(in, in, in, in, in, in, in, in, in,
+ out, in, out, di, uo) is det.
-module_add_func_clause(ModuleInfo0, ClauseVarSet, FuncName, Args0, Result, Body,
+module_add_clause(ModuleInfo0, ClauseVarSet, PredOrFunc, PredName, Args, Body,
Status, Context, IsAssertion, ModuleInfo,
Info0, Info) -->
- % print out a progress message
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
( { VeryVerbose = yes } ->
- io__write_string("% Processing clause for function `"),
- { list__length(Args0, Arity) },
- prog_out__write_sym_name_and_arity(FuncName/Arity),
+ io__write_string("% Processing clause for "),
+ hlds_out__write_pred_or_func(PredOrFunc),
+ io__write_string(" `"),
+ { list__length(Args, PredArity) },
+ { adjust_func_arity(PredOrFunc, OrigArity, PredArity) },
+ prog_out__write_sym_name_and_arity(PredName/OrigArity),
io__write_string("'...\n")
;
[]
),
- { list__append(Args0, [Result], Args) },
- module_add_clause(ModuleInfo0, ClauseVarSet, FuncName, Args, Body,
- Status, Context, function, IsAssertion, ModuleInfo,
- Info0, Info).
-
-:- pred module_add_clause(module_info, prog_varset, sym_name, list(prog_term),
- goal, import_status, prog_context, pred_or_func, bool,
- module_info, qual_info, qual_info, io__state, io__state).
-:- mode module_add_clause(in, in, in, in, in, in, in, in, in,
- out, in, out, di, uo) is det.
-module_add_clause(ModuleInfo0, ClauseVarSet, PredName, Args, Body, Status,
- Context, PredOrFunc, IsAssertion, ModuleInfo,
- Info0, Info) -->
% Lookup the pred declaration in the predicate table.
% (If it's not there, call maybe_undefined_pred_error
% and insert an implicit declaration for the predicate.)
@@ -3871,7 +3782,7 @@
add_annotation(empty, no, none).
add_annotation(empty, yes(Mode), modes([Mode])).
-add_annotation(modes(_), no, mixed).
+add_annotation(modes(_ `with_type` list(mode)), no, mixed).
add_annotation(modes(Modes), yes(Mode), modes(Modes ++ [Mode])).
add_annotation(none, no, none).
add_annotation(none, yes(_), mixed).
@@ -3902,7 +3813,7 @@
% handle the `pred(<MethodName>/<Arity>) is <ImplName>' syntax
produce_instance_method_clauses(name(InstancePredName), PredOrFunc, PredArity,
ArgTypes, Markers, Context, _Status, ClausesInfo,
- ModuleInfo, ModuleInfo, QualInfo, QualInfo, IO, IO) :-
+ ModuleInfo0, ModuleInfo, QualInfo0, QualInfo, IO, IO) :-
% Add the body of the introduced pred
@@ -3928,7 +3839,9 @@
make_n_fresh_vars("HeadVar__", PredArity, VarSet0, HeadVars, VarSet),
invalid_pred_id(InvalidPredId),
construct_pred_or_func_call(InvalidPredId, PredOrFunc,
- InstancePredName, HeadVars, GoalInfo, IntroducedGoal),
+ InstancePredName, HeadVars, GoalInfo, IntroducedGoal,
+ transform_info(ModuleInfo0, QualInfo0),
+ transform_info(ModuleInfo, QualInfo)),
IntroducedClause = clause([], IntroducedGoal, Context),
map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
@@ -3957,19 +3870,11 @@
ModuleInfo0 - QualInfo0 - ClausesInfo0,
ModuleInfo - QualInfo - ClausesInfo) -->
(
- {
- PredOrFunc = predicate,
- InstanceClause = pred_clause(CVarSet, PredName,
- HeadTerms, Body),
- Arity = list__length(HeadTerms)
- ;
- PredOrFunc = function,
- InstanceClause = func_clause(CVarSet, PredName,
- ArgTerms, ResultTerm, Body),
- HeadTerms = list__append(ArgTerms, [ResultTerm]),
- Arity = list__length(ArgTerms)
- }
+ { InstanceClause = clause(CVarSet, PredOrFunc, PredName,
+ HeadTerms, Body) }
->
+ { PredArity = list__length(HeadTerms) },
+ { adjust_func_arity(PredOrFunc, Arity, PredArity) },
% The tvarset argument is only used for explicit type
% qualifications, of which there are none in this clause,
% so it is set to a dummy value.
@@ -5659,9 +5564,11 @@
Purity1, GoalInfo) },
{ Goal0 = Call - GoalInfo },
+ { record_called_pred_or_func(predicate, Name, Arity,
+ Info0, Info1) },
insert_arg_unifications(HeadVars, Args,
Context, call(CallId), no,
- Goal0, VarSet1, Goal, VarSet, Info0, Info)
+ Goal0, VarSet1, Goal, VarSet, Info1, Info)
).
transform_goal_2(unify(A0, B0, Purity), Context, VarSet0, Subst, Goal, VarSet,
@@ -5887,13 +5794,13 @@
{ construct_field_access_function_call(set, Context,
MainContext, SubContext0, FieldName,
TermOutputVar, SetArgs,
- Functor, UpdateGoal) },
+ Functor, UpdateGoal, Info0, Info1) },
% extract the field containing the field to update.
{ construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, SubTermInputVar,
list__append(FieldArgVars, [TermInputVar]), _,
- GetSubFieldGoal) },
+ GetSubFieldGoal, Info1, Info2) },
% recursively update the field.
{ SubTermInputArgNumber = 2 + list__length(FieldArgs) },
@@ -5902,7 +5809,7 @@
expand_set_field_function_call_2(Context, MainContext,
SubContext, FieldNames, FieldValueVar, SubTermInputVar,
SubTermOutputVar, VarSet3, VarSet4, _,
- FieldSubContext, Goals0, Info0, Info1),
+ FieldSubContext, Goals0, Info2, Info3),
{ list__append([GetSubFieldGoal | Goals0],
[UpdateGoal], Goals1) }
@@ -5912,9 +5819,8 @@
[TermInputVar, FieldValueVar]) },
{ construct_field_access_function_call(set, Context,
MainContext, SubContext0, FieldName, TermOutputVar,
- SetArgs, Functor, Goal) },
+ SetArgs, Functor, Goal, Info0, Info3) },
{ FieldSubContext = Functor - SubContext0 },
- { Info1 = Info0 },
{ Goals1 = [Goal] }
),
@@ -5922,7 +5828,7 @@
{ goal_info_init(Context, GoalInfo) },
{ conj_list_to_goal(Goals1, GoalInfo, Conj0) },
append_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
- Conj0, VarSet4, Conj, VarSet, Info1, Info),
+ Conj0, VarSet4, Conj, VarSet, Info3, Info),
{ goal_to_conj_list(Conj, Goals) }.
% Expand a field extraction goal into a list of goals which
@@ -5950,14 +5856,15 @@
VarSet0, VarSet, Functor, FieldSubContext,
Goal, Info0, Info) -->
% unify the DCG input and output variables
- { create_atomic_unification(TermOutputVar, var(TermInputVar),
- Context, MainContext, SubContext, UnifyDCG) },
+ { make_atomic_unification(TermOutputVar, var(TermInputVar),
+ Context, MainContext, SubContext, UnifyDCG,
+ Info0, Info1) },
% process the access function as a get function on
% the output DCG variable
expand_get_field_function_call_2(Context, MainContext, SubContext,
FieldNames, FieldValueVar, TermOutputVar, VarSet0, VarSet,
- Functor, FieldSubContext, Goals1, Info0, Info),
+ Functor, FieldSubContext, Goals1, Info1, Info),
{ Goals = [UnifyDCG | Goals1] },
{ goal_info_init(Context, GoalInfo) },
{ conj_list_to_goal(Goals, GoalInfo, Goal) }.
@@ -6010,7 +5917,7 @@
{ varset__new_var(VarSet1, SubTermInputVar, VarSet2) },
{ construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, SubTermInputVar,
- GetArgVars, Functor, Goal) },
+ GetArgVars, Functor, Goal, Info0, Info1) },
% recursively extract until we run out of field names
{ TermInputArgNumber = 1 + list__length(FieldArgVars) },
@@ -6019,38 +5926,38 @@
expand_get_field_function_call_2(Context, MainContext,
SubContext, FieldNames, FieldValueVar, SubTermInputVar,
VarSet2, VarSet3, _, FieldSubContext,
- Goals1, Info0, Info1),
+ Goals1, Info1, Info2),
{ Goals2 = [Goal | Goals1] }
;
{ VarSet3 = VarSet1 },
{ FieldSubContext = Functor - SubContext0 },
{ construct_field_access_function_call(get, Context,
MainContext, SubContext0, FieldName, FieldValueVar,
- GetArgVars, Functor, Goal) },
- { Info1 = Info0 },
+ GetArgVars, Functor, Goal, Info0, Info2) },
{ Goals2 = [Goal] }
),
{ ArgContext = functor(Functor, MainContext, SubContext0) },
{ goal_info_init(Context, GoalInfo) },
{ conj_list_to_goal(Goals2, GoalInfo, Conj0) },
append_arg_unifications(FieldArgVars, FieldArgs, Context, ArgContext,
- Conj0, VarSet3, Conj, VarSet, Info1, Info),
+ Conj0, VarSet3, Conj, VarSet, Info2, Info),
{ goal_to_conj_list(Conj, Goals) }.
:- pred construct_field_access_function_call(field_access_type, prog_context,
unify_main_context, unify_sub_contexts, ctor_field_name,
- prog_var, list(prog_var), cons_id, hlds_goal).
+ prog_var, list(prog_var), cons_id, hlds_goal,
+ transform_info, transform_info).
:- mode construct_field_access_function_call(in, in, in, in, in,
- in, in, out, out) is det.
+ in, in, out, out, in, out) is det.
construct_field_access_function_call(AccessType, Context,
MainContext, SubContext, FieldName, RetArg, Args,
- Functor, Goal) :-
+ Functor, Goal, Info0, Info) :-
field_access_function_name(AccessType, FieldName, FuncName),
list__length(Args, Arity),
Functor = cons(FuncName, Arity),
- create_atomic_unification(RetArg, functor(Functor, Args),
- Context, MainContext, SubContext, Goal).
+ make_atomic_unification(RetArg, functor(Functor, Args),
+ Context, MainContext, SubContext, Goal, Info0, Info).
:- type field_list == assoc_list(ctor_field_name, list(prog_term)).
@@ -6213,9 +6120,11 @@
AllArgTerms)
},
+ { record_called_pred_or_func(PredOrFunc, SymName,
+ InsertArity, Info0, Info1) },
insert_arg_unifications(AllArgs, AllArgTerms,
Context, call(CallId), no,
- Goal0, VarSet3, Goal, VarSet, Info0, Info)
+ Goal0, VarSet3, Goal, VarSet, Info1, Info)
;
{ invalid_goal(UpdateStr, Args0, GoalInfo,
Goal, VarSet0, VarSet) },
@@ -6326,7 +6235,6 @@
{ set__delete_list(LambdaGoalVars0,
HeadArgs, LambdaGoalVars1) },
{ set__to_sorted_list(LambdaGoalVars1, LambdaNonLocals) },
-
{ aditi_delete_insert_delete_modify_goal_info(InsertDelMod,
PredOrFunc, SymName, PredArity, HeadArgs,
LambdaPredOrFunc, EvalMethod, LambdaModes,
@@ -6353,11 +6261,12 @@
{ FixModes = modes_need_fixing },
% Build the lambda expression for the modification condition.
- { create_atomic_unification(LambdaVar,
+ { make_atomic_unification(LambdaVar,
lambda_goal(LambdaPredOrFunc, EvalMethod,
FixModes, LambdaNonLocals,
HeadArgs, LambdaModes, Detism, PredGoal),
- Context, MainContext, [], LambdaConstruct) },
+ Context, MainContext, [], LambdaConstruct,
+ Info2, Info3) },
{ make_fresh_arg_var(AditiState0Term, AditiState0Var, [],
VarSet5, VarSet6) },
@@ -6383,11 +6292,14 @@
{ CallId = call(generic_call(
aditi_builtin(Builtin, ModifiedCallId))) },
+
+ { record_called_pred_or_func(PredOrFunc, SymName, PredArity,
+ Info3, Info4) },
insert_arg_unifications(AllArgs,
[term__variable(LambdaVar), AditiState0Term,
AditiStateTerm],
Context, CallId, no, UpdateConj, VarSet7, UpdateGoal,
- VarSet, Info2, Info)
+ VarSet, Info4, Info)
;
%
% Second syntax -
@@ -6424,8 +6336,10 @@
OtherArgs, GenericCallModes, det) - GoalInfo },
{ CallId = call(generic_call(
aditi_builtin(Builtin, ModifiedCallId))) },
+ { record_called_pred_or_func(PredOrFunc, SymName, Arity,
+ Info0, Info1) },
insert_arg_unifications(OtherArgs, OtherArgs0, Context, CallId,
- no, Call, VarSet1, UpdateGoal, VarSet, Info0, Info)
+ no, Call, VarSet1, UpdateGoal, VarSet, Info1, Info)
;
{ invalid_goal(Descr, Args0, GoalInfo,
UpdateGoal, VarSet0, VarSet) },
@@ -6534,8 +6448,13 @@
conjoin_aditi_update_goal_with_call(PredOrFunc, SymName, Args, Goal0, Goal) :-
invalid_pred_id(PredId),
Goal0 = _ - GoalInfo,
- construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
+
+ % The predicate is recorded as used in
+ % transform_aditi_tuple_insert_delete and
+ % transform_aditi_insert_delete_modify
+ do_construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
GoalInfo, CallGoal),
+
Goal = conj([CallGoal, Goal0]) - GoalInfo.
:- pred output_expected_aditi_update_syntax(prog_context,
@@ -6957,9 +6876,9 @@
unravel_unification(term__variable(X), term__variable(Y), Context,
MainContext, SubContext, VarSet0, Purity, Goal, VarSet, Info0, Info)
-->
- { create_atomic_unification(X, var(Y), Context, MainContext,
- SubContext, Goal) },
- check_expr_purity(Purity, Context, Info0, Info),
+ { make_atomic_unification(X, var(Y), Context, MainContext,
+ SubContext, Goal, Info0, Info1) },
+ check_expr_purity(Purity, Context, Info1, Info),
{ VarSet0 = VarSet }.
% If we find a unification of the form
@@ -6980,7 +6899,7 @@
{ F = term__atom("with_type") },
{ Args = [RVal, DeclType0] }
->
- { term__coerce(DeclType0, DeclType) },
+ { convert_type(DeclType0, DeclType) },
{ varset__coerce(VarSet0, DeclVarSet) },
process_type_qualification(X, DeclType, DeclVarSet,
Context, Info0, Info1),
@@ -7160,20 +7079,21 @@
{ FunctorArgs = Args }
),
( { FunctorArgs = [] } ->
- { create_atomic_unification(X, functor(ConsId, []),
- Context, MainContext, SubContext, Goal0) },
+ { make_atomic_unification(X, functor(ConsId, []),
+ Context, MainContext, SubContext, Goal0,
+ Info0, Info) },
{ Goal0 = GoalExpr - GoalInfo0 },
{ add_goal_info_purity_feature(GoalInfo0, Purity,
GoalInfo) },
{ Goal = GoalExpr - GoalInfo },
- { VarSet = VarSet0 },
- { Info = Info0 }
+ { VarSet = VarSet0 }
;
{ make_fresh_arg_vars(FunctorArgs, VarSet0,
HeadVars, VarSet1) },
- { create_atomic_unification(X,
+ { make_atomic_unification(X,
functor(ConsId, HeadVars), Context,
- MainContext, SubContext, Goal0) },
+ MainContext, SubContext, Goal0,
+ Info0, Info1) },
{ ArgContext = functor(ConsId,
MainContext, SubContext) },
% Should this be insert_... rather than append_...?
@@ -7185,7 +7105,7 @@
( { Purity = pure } ->
append_arg_unifications(HeadVars, FunctorArgs,
FunctorContext, ArgContext, Goal0,
- VarSet1, Goal, VarSet, Info0, Info)
+ VarSet1, Goal, VarSet, Info1, Info)
;
{ Goal0 = GoalExpr - GoalInfo0 },
{ add_goal_info_purity_feature(GoalInfo0,
@@ -7193,8 +7113,7 @@
{ Goal1 = GoalExpr - GoalInfo },
insert_arg_unifications(HeadVars, FunctorArgs,
FunctorContext, ArgContext, no, Goal1,
- VarSet1, Goal, VarSet, Info0,
- Info)
+ VarSet1, Goal, VarSet, Info1, Info)
)
)
).
@@ -7343,7 +7262,7 @@
HLDS_Goal0, VarSet2, Info1, Info2),
{ ArgContext = head(PredOrFunc, NumArgs) },
insert_arg_unifications(LambdaVars, Args, Context, ArgContext,
- no, HLDS_Goal0, VarSet2, HLDS_Goal1, VarSet, Info2, Info),
+ no, HLDS_Goal0, VarSet2, HLDS_Goal1, VarSet, Info2, Info3),
%
% Now figure out which variables we need to explicitly existentially
@@ -7373,19 +7292,33 @@
{ set__delete_list(LambdaGoalVars1, QuantifiedVars, LambdaGoalVars2) },
{ set__to_sorted_list(LambdaGoalVars2, LambdaNonLocals) },
- { create_atomic_unification(X,
+ { make_atomic_unification(X,
lambda_goal(PredOrFunc, EvalMethod, modes_are_ok,
LambdaNonLocals, LambdaVars, Modes, Det, HLDS_Goal),
- Context, MainContext, SubContext, Goal) }.
+ Context, MainContext, SubContext, Goal, Info3, Info) }.
%-----------------------------------------------------------------------------%
:- pred construct_pred_or_func_call(pred_id, pred_or_func, sym_name,
+ list(prog_var), hlds_goal_info, hlds_goal,
+ transform_info, transform_info).
+:- mode construct_pred_or_func_call(in, in, in, in, in, out, in, out) is det.
+
+construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
+ GoalInfo, Goal, Info0, Info) :-
+ do_construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
+ GoalInfo, Goal),
+ list__length(Args, Arity),
+ adjust_func_arity(PredOrFunc, OrigArity, Arity),
+ record_called_pred_or_func(PredOrFunc, SymName, OrigArity,
+ Info0, Info).
+
+:- pred do_construct_pred_or_func_call(pred_id, pred_or_func, sym_name,
list(prog_var), hlds_goal_info, hlds_goal).
-:- mode construct_pred_or_func_call(in, in, in, in, in, out) is det.
+:- mode do_construct_pred_or_func_call(in, in, in, in, in, out) is det.
-construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args, GoalInfo,
- Goal) :-
+do_construct_pred_or_func_call(PredId, PredOrFunc, SymName, Args,
+ GoalInfo, Goal) :-
(
PredOrFunc = predicate,
invalid_proc_id(DummyProcId),
@@ -7397,12 +7330,32 @@
list__length(FuncArgs, Arity),
ConsId = cons(SymName, Arity),
goal_info_get_context(GoalInfo, Context),
- create_atomic_unification(RetArg,
+ hlds_goal__create_atomic_unification(RetArg,
functor(ConsId, FuncArgs), Context,
explicit, [], GoalExpr - _),
Goal = GoalExpr - GoalInfo
).
+:- pred make_atomic_unification(prog_var, unify_rhs, prog_context,
+ unify_main_context, unify_sub_contexts, hlds_goal,
+ transform_info, transform_info).
+:- mode make_atomic_unification(in, in, in, in, in, out, in, out) is det.
+
+make_atomic_unification(Var, Rhs, Context, MainContext, SubContext,
+ Goal, Info0, Info) :-
+ (
+ Rhs = var(_),
+ Info = Info0
+ ;
+ Rhs = lambda_goal(_, _, _, _, _, _, _, _),
+ Info = Info0
+ ;
+ Rhs = functor(ConsId, _),
+ record_used_functor(ConsId, Info0, Info)
+ ),
+ hlds_goal__create_atomic_unification(Var, Rhs, Context,
+ MainContext, SubContext, Goal).
+
%-----------------------------------------------------------------------------%
% Process an explicit type qualification.
@@ -7658,6 +7611,54 @@
qual_info_set_found_syntax_error(FoundError, Info,
Info ^ found_syntax_error := FoundError).
+
+:- pred apply_to_recompilation_info(
+ pred(recompilation_info, recompilation_info),
+ transform_info, transform_info).
+:- mode apply_to_recompilation_info(pred(in, out) is det, in, out) is det.
+
+apply_to_recompilation_info(Pred, Info0, Info) :-
+ MQInfo0 = Info0 ^ qual_info ^ mq_info,
+ mq_info_get_recompilation_info(MQInfo0, MaybeRecompInfo0),
+ (
+ MaybeRecompInfo0 = yes(RecompInfo0),
+ Pred(RecompInfo0, RecompInfo),
+ mq_info_set_recompilation_info(MQInfo0,
+ yes(RecompInfo), MQInfo),
+ Info = Info0 ^ qual_info ^ mq_info := MQInfo
+ ;
+ MaybeRecompInfo0 = no,
+ Info = Info0
+ ).
+
+set_module_recompilation_info(QualInfo, ModuleInfo0, ModuleInfo) :-
+ mq_info_get_recompilation_info(QualInfo ^ mq_info, RecompInfo),
+ module_info_set_maybe_recompilation_info(ModuleInfo0,
+ RecompInfo, ModuleInfo).
+
+:- pred record_called_pred_or_func(pred_or_func, sym_name, arity,
+ transform_info, transform_info).
+:- mode record_called_pred_or_func(in, in, in, in, out) is det.
+
+record_called_pred_or_func(PredOrFunc, SymName, Arity) -->
+ { Id = SymName - Arity },
+ apply_to_recompilation_info(
+ recompilation__record_used_item(
+ pred_or_func_to_item_type(PredOrFunc), Id, Id)).
+
+:- pred record_used_functor(cons_id, transform_info, transform_info).
+:- mode record_used_functor(in, in, out) is det.
+
+record_used_functor(ConsId) -->
+ (
+ { ConsId = cons(SymName, Arity) }
+ ->
+ { Id = SymName - Arity },
+ apply_to_recompilation_info(
+ recompilation__record_used_item(functor, Id, Id))
+ ;
+ []
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.203
diff -u -u -r1.203 mercury_compile.m
--- compiler/mercury_compile.m 2001/05/24 06:07:04 1.203
+++ compiler/mercury_compile.m 2001/05/26 19:41:56
@@ -72,11 +72,12 @@
:- import_module mercury_to_mercury.
:- import_module dependency_graph, prog_util, rl_dump, rl_file.
:- import_module options, globals, trace_params, passes_aux.
+:- import_module recompilation, recompilation_usage, recompilation_check.
% library modules
:- import_module int, list, map, set, std_util, dir, require, string, bool.
-:- import_module library, getopt, set_bbbtree, term, varset.
-:- import_module gc.
+:- import_module library, getopt, set_bbbtree, term, varset, assoc_list.
+:- import_module time, gc.
%-----------------------------------------------------------------------------%
@@ -415,7 +416,7 @@
generate_file_dependencies(FileName),
{ ModulesToLink = [] }
;
- process_file_name(FileName, ModulesToLink)
+ process_module(file(FileName), ModulesToLink)
)
;
% If it doesn't end in `.m', then we assume it is
@@ -430,45 +431,114 @@
generate_module_dependencies(ModuleName),
{ ModulesToLink = [] }
;
- process_module_name(ModuleName, ModulesToLink)
+ process_module(module(ModuleName), ModulesToLink)
)
).
-:- pred process_module_name(module_name, list(string), io__state, io__state).
-:- mode process_module_name(in, out, di, uo) is det.
+:- type file_or_module
+ ---> file(file_name)
+ ; module(module_name)
+ .
+
+:- pred read_module(file_or_module, bool, module_name, file_name,
+ maybe(time_t), item_list, module_error,
+ read_modules, read_modules, io__state, io__state).
+:- mode read_module(in, in, out, out, out, out, out, in, out, di, uo) is det.
-process_module_name(ModuleName, ModulesToLink) -->
+read_module(module(ModuleName), ReturnTimestamp, ModuleName, FileName,
+ MaybeTimestamp, Items, Error, ReadModules0, ReadModules) -->
globals__io_lookup_bool_option(verbose, Verbose),
maybe_write_string(Verbose, "% Parsing module `"),
{ prog_out__sym_name_to_string(ModuleName, ModuleNameString) },
maybe_write_string(Verbose, ModuleNameString),
maybe_write_string(Verbose, "' and imported interfaces...\n"),
- read_mod(ModuleName, ".m", "Reading module", yes, Items, Error,
- FileName),
+ (
+ { find_read_module(ReadModules0, ModuleName, ".m",
+ ReturnTimestamp, Items0, MaybeTimestamp0,
+ Error0, FileName0) }
+ ->
+ { map__delete(ReadModules0, ModuleName - ".m", ReadModules) },
+ { FileName = FileName0 },
+ { Items = Items0 },
+ { Error = Error0 },
+ { MaybeTimestamp = MaybeTimestamp0 }
+ ;
+ { ReadModules = ReadModules0 },
+ read_mod(ModuleName, ".m", "Reading module", yes,
+ ReturnTimestamp, Items, Error, FileName,
+ MaybeTimestamp)
+ ),
globals__io_lookup_bool_option(statistics, Stats),
- maybe_report_stats(Stats),
- process_module(ModuleName, FileName, Items, Error, ModulesToLink).
-
-:- pred process_file_name(file_name, list(string), io__state, io__state).
-:- mode process_file_name(in, out, di, uo) is det.
-
-process_file_name(FileName, ModulesToLink) -->
+ maybe_report_stats(Stats).
+read_module(file(FileName), ReturnTimestamp, ModuleName, SourceFileName,
+ MaybeTimestamp, Items, Error, ReadModules0, ReadModules) -->
globals__io_lookup_bool_option(verbose, Verbose),
maybe_write_string(Verbose, "% Parsing file `"),
maybe_write_string(Verbose, FileName),
maybe_write_string(Verbose, "' and imported interfaces...\n"),
- read_mod_from_file(FileName, ".m", "Reading file", yes, Items, Error,
- ModuleName),
+
+ { file_name_to_module_name(FileName, DefaultModuleName) },
+ (
+ { find_read_module(ReadModules0, DefaultModuleName, ".m",
+ ReturnTimestamp, Items0, MaybeTimestamp0, Error0, _) }
+ ->
+ { map__delete(ReadModules0, ModuleName - ".m", ReadModules) },
+ { ModuleName = DefaultModuleName },
+ { Items = Items0 },
+ { Error = Error0 },
+ { MaybeTimestamp = MaybeTimestamp0 }
+ ;
+ { ReadModules = ReadModules0 },
+ read_mod_from_file(FileName, ".m", "Reading file", yes,
+ ReturnTimestamp, Items, Error, ModuleName,
+ MaybeTimestamp),
+
+ %
+ % XXX If the module name doesn't match the file name
+ % the compiler won't be able to find the `.used'
+ % file (the name of the `.used' file is derived from
+ % the module name not the file name).
+ % This will be fixed when mmake functionality
+ % is moved into the compiler.
+ %
+ globals__io_lookup_bool_option(smart_recompilation, Smart),
+ ( { Smart = yes, ModuleName \= DefaultModuleName } ->
+ globals__io_lookup_bool_option(
+ warn_smart_recompilation, Warn),
+ globals__io_lookup_bool_option(
+ halt_at_warn, Halt),
+ ( { Warn = yes } ->
+ io__write_string(
+ "Warning: module name does not match file name:\n"),
+ io__write_string(" "),
+ io__write_string(FileName),
+ io__write_string(" contains module `"),
+ prog_out__write_sym_name(ModuleName),
+ io__write_string(".\n"),
+ io__write_string(
+ " Smart recompilation will not work with this module.\n"),
+ ( { Halt = yes } ->
+ io__set_exit_status(1)
+ ;
+ []
+ )
+ ;
+ []
+ ),
+ globals__io_set_option(smart_recompilation, bool(no))
+ ;
+ []
+ )
+ ),
+
globals__io_lookup_bool_option(statistics, Stats),
maybe_report_stats(Stats),
- { string__append(FileName, ".m", SourceFileName) },
- process_module(ModuleName, SourceFileName, Items, Error, ModulesToLink).
+ { string__append(FileName, ".m", SourceFileName) }.
-:- pred process_module(module_name, file_name, item_list, module_error,
- list(string), io__state, io__state).
-:- mode process_module(in, in, in, in, out, di, uo) is det.
+:- pred process_module(file_or_module, list(string), io__state, io__state).
+:- mode process_module(in, out, di, uo) is det.
-process_module(ModuleName, FileName, Items, Error, ModulesToLink) -->
+process_module(FileOrModule, ModulesToLink) -->
globals__io_lookup_bool_option(halt_at_syntax_errors, HaltSyntax),
globals__io_lookup_bool_option(make_interface, MakeInterface),
globals__io_lookup_bool_option(make_short_interface,
@@ -476,29 +546,118 @@
globals__io_lookup_bool_option(make_private_interface,
MakePrivateInterface),
globals__io_lookup_bool_option(convert_to_mercury, ConvertToMercury),
- ( { Error = fatal } ->
- { ModulesToLink = [] }
- ; { Error = yes, HaltSyntax = yes } ->
- { ModulesToLink = [] }
- ; { MakeInterface = yes } ->
- split_into_submodules(ModuleName, Items, SubModuleList),
- list__foldl(make_interface(FileName), SubModuleList),
- { ModulesToLink = [] }
- ; { MakeShortInterface = yes } ->
- split_into_submodules(ModuleName, Items, SubModuleList),
- list__foldl(make_short_interface, SubModuleList),
- { ModulesToLink = [] }
- ; { MakePrivateInterface = yes } ->
- split_into_submodules(ModuleName, Items, SubModuleList),
- list__foldl(make_private_interface(FileName), SubModuleList),
+ globals__io_lookup_bool_option(generate_item_version_numbers,
+ GenerateVersionNumbers),
+ (
+ { MakeInterface = yes ->
+ ProcessModule = make_interface,
+ ReturnTimestamp = GenerateVersionNumbers
+ ; MakeShortInterface = yes ->
+ ProcessModule = make_short_interface,
+ ReturnTimestamp = no
+ ; MakePrivateInterface = yes ->
+ ProcessModule = make_private_interface,
+ ReturnTimestamp = GenerateVersionNumbers
+ ;
+ fail
+ }
+ ->
+ read_module(FileOrModule, ReturnTimestamp, ModuleName,
+ FileName, MaybeTimestamp, Items, Error, map__init, _),
+ ( { halt_at_module_error(HaltSyntax, Error) } ->
+ []
+ ;
+ split_into_submodules(ModuleName,
+ Items, SubModuleList),
+ list__foldl(
+ (pred(SubModule::in, di, uo) is det -->
+ ProcessModule(FileName, MaybeTimestamp,
+ SubModule)
+ ),
+ SubModuleList)
+ ),
{ ModulesToLink = [] }
- ; { ConvertToMercury = yes } ->
- module_name_to_file_name(ModuleName, ".ugly", yes,
+ ;
+ { ConvertToMercury = yes }
+ ->
+ read_module(FileOrModule, no, ModuleName, _, _,
+ Items, Error, map__init, _),
+
+ ( { halt_at_module_error(HaltSyntax, Error) } ->
+ []
+ ;
+ module_name_to_file_name(ModuleName, ".ugly", yes,
OutputFileName),
- convert_to_mercury(ModuleName, OutputFileName, Items),
+ convert_to_mercury(ModuleName, OutputFileName, Items)
+ ),
{ ModulesToLink = [] }
;
- split_into_submodules(ModuleName, Items, SubModuleList),
+ globals__io_lookup_bool_option(smart_recompilation, Smart),
+ ( { Smart = yes } ->
+ {
+ FileOrModule = module(ModuleName)
+ ;
+ FileOrModule = file(FileName),
+ % XXX This won't work if the module name
+ % doesn't match the file name -- such
+ % modules will always be recompiled.
+ %
+ % This problem will be fixed when mmake
+ % functionality is moved into the compiler.
+ % The file_name->module_name mapping
+ % will be explicitly recorded.
+ file_name_to_module_name(FileName, ModuleName)
+ },
+
+ globals__io_get_globals(Globals),
+ { find_smart_recompilation_target_files(
+ Globals, FindTargetFiles) },
+ recompilation_check__should_recompile(ModuleName,
+ FindTargetFiles, ModulesToRecompile,
+ ReadModules)
+ ;
+ { map__init(ReadModules) },
+ { ModulesToRecompile = (all) }
+ ),
+ ( { ModulesToRecompile = some([]) } ->
+ % XXX Currently smart recompilation is disabled
+ % if mmc is linking the executable because it
+ % doesn't know how to check whether all the
+ % necessary intermediate files are present
+ % and up-to-date.
+ { ModulesToLink = [] }
+ ;
+ process_module_2(FileOrModule, ModulesToRecompile,
+ ReadModules, ModulesToLink)
+ )
+ ).
+
+:- pred process_module_2(file_or_module, modules_to_recompile,
+ read_modules, list(string), io__state, io__state).
+:- mode process_module_2(in, in, in, out, di, uo) is det.
+
+process_module_2(FileOrModule, MaybeModulesToRecompile, ReadModules0,
+ ModulesToLink) -->
+ read_module(FileOrModule, yes, ModuleName, FileName,
+ MaybeTimestamp, Items, Error, ReadModules0, ReadModules),
+ globals__io_lookup_bool_option(halt_at_syntax_errors, HaltSyntax),
+ ( { halt_at_module_error(HaltSyntax, Error) } ->
+ { ModulesToLink = [] }
+ ;
+ split_into_submodules(ModuleName, Items, SubModuleList0),
+ { MaybeModulesToRecompile = some(ModulesToRecompile) ->
+ list__filter(
+ (pred((SubModule - _)::in) is semidet :-
+ list__member(SubModule,
+ ModulesToRecompile)
+ ),
+ SubModuleList0, SubModuleList)
+ ;
+ SubModuleList = SubModuleList0
+ },
+ { assoc_list__keys(SubModuleList, InlineSubModules0) },
+ { list__delete_all(InlineSubModules0,
+ ModuleName, InlineSubModules) },
(
{ any_mercury_builtin_module(ModuleName) }
->
@@ -508,19 +667,24 @@
% there should never be part of an execution trace
% anyway; they are effectively language primitives.
% (They may still be parts of stack traces.)
- globals__io_lookup_bool_option(trace_stack_layout, TSL),
+ globals__io_lookup_bool_option(trace_stack_layout,
+ TSL),
globals__io_get_trace_level(TraceLevel),
globals__io_set_option(trace_stack_layout, bool(no)),
globals__io_set_trace_level_none,
- compile_all_submodules(FileName, SubModuleList,
+ compile_all_submodules(FileName,
+ ModuleName - InlineSubModules,
+ MaybeTimestamp, ReadModules, SubModuleList,
ModulesToLink),
globals__io_set_option(trace_stack_layout, bool(TSL)),
globals__io_set_trace_level(TraceLevel)
;
- compile_all_submodules(FileName, SubModuleList,
+ compile_all_submodules(FileName,
+ ModuleName - InlineSubModules,
+ MaybeTimestamp, ReadModules, SubModuleList,
ModulesToLink)
)
).
@@ -536,34 +700,46 @@
%
% i.e. compile nested modules to a single C file.
-:- pred compile_all_submodules(string, list(pair(module_name, item_list)),
- list(string), io__state, io__state).
-:- mode compile_all_submodules(in, in, out, di, uo) is det.
-
-compile_all_submodules(FileName, SubModuleList, ModulesToLink) -->
- list__foldl(compile(FileName), SubModuleList),
+:- pred compile_all_submodules(string, pair(module_name, list(module_name)),
+ maybe(time_t), read_modules, list(pair(module_name, item_list)),
+ list(string), io__state, io__state).
+:- mode compile_all_submodules(in, in, in, in, in, out, di, uo) is det.
+
+compile_all_submodules(FileName, InlineSubModules, MaybeTimestamp,
+ ReadModules, SubModuleList, ModulesToLink) -->
+ list__foldl(
+ compile(FileName, InlineSubModules,
+ MaybeTimestamp, ReadModules),
+ SubModuleList),
list__map_foldl(module_to_link, SubModuleList, ModulesToLink).
-:- pred make_interface(file_name, pair(module_name, item_list),
+:- pred make_interface(file_name, maybe(time_t), pair(module_name, item_list),
io__state, io__state).
-:- mode make_interface(in, in, di, uo) is det.
+:- mode make_interface(in, in, in, di, uo) is det.
+
+make_interface(SourceFileName, MaybeTimestamp, ModuleName - Items) -->
+ make_interface(SourceFileName, ModuleName, MaybeTimestamp, Items).
+
+:- pred make_short_interface(file_name, maybe(time_t),
+ pair(module_name, item_list), io__state, io__state).
+:- mode make_short_interface(in, in, in, di, uo) is det.
-make_interface(SourceFileName, ModuleName - Items) -->
- make_interface(SourceFileName, ModuleName, Items).
+make_short_interface(SourceFileName, _, ModuleName - Items) -->
+ make_short_interface(SourceFileName, ModuleName, Items).
-:- pred make_short_interface(pair(module_name, item_list),
- io__state, io__state).
-:- mode make_short_interface(in, di, uo) is det.
+:- pred make_private_interface(file_name, maybe(time_t),
+ pair(module_name, item_list), io__state, io__state).
+:- mode make_private_interface(in, in, in, di, uo) is det.
-make_short_interface(ModuleName - Items) -->
- make_short_interface(ModuleName, Items).
+make_private_interface(SourceFileName, MaybeTimestamp, ModuleName - Items) -->
+ make_private_interface(SourceFileName, ModuleName,
+ MaybeTimestamp, Items).
-:- pred make_private_interface(file_name, pair(module_name, item_list),
- io__state, io__state).
-:- mode make_private_interface(in, in, di, uo) is det.
+:- pred halt_at_module_error(bool, module_error).
+:- mode halt_at_module_error(in, in) is semidet.
-make_private_interface(SourceFileName, ModuleName - Items) -->
- make_private_interface(SourceFileName, ModuleName, Items).
+halt_at_module_error(_, fatal).
+halt_at_module_error(HaltSyntax, yes) :- HaltSyntax = yes.
:- pred module_to_link(pair(module_name, item_list), string,
io__state, io__state).
@@ -574,6 +750,52 @@
%-----------------------------------------------------------------------------%
+ % Return a closure which will work out what the target files
+ % are for a module, so recompilation_check.m can check that
+ % they are up-to-date which deciding whether compilation is
+ % necessary.
+ % Note that `--smart-recompilation' only works with
+ % `--target-code-only', which is always set when the
+ % compiler is invoked by mmake. Using smart recompilation
+ % without using mmake is not a sensible thing to do.
+ % handle_options.m will disable smart recompilation if
+ % `--target-code-only' is not set.
+:- pred find_smart_recompilation_target_files(globals,
+ find_target_file_names).
+:- mode find_smart_recompilation_target_files(in,
+ out(find_target_file_names)) is det.
+
+find_smart_recompilation_target_files(Globals, FindTargetFiles) :-
+ globals__get_target(Globals, CompilationTarget),
+ (
+ CompilationTarget = c,
+ globals__lookup_bool_option(Globals, split_c_files, yes)
+ ->
+ FindTargetFiles =
+ (pred(ModuleName::in, [FileName]::out, di, uo) is det -->
+ % We don't know how many chunks there should
+ % be, so just check the first.
+ { Chunk = 0 },
+ object_extension(Obj),
+ module_name_to_split_c_file_name(ModuleName, Chunk,
+ Obj, FileName)
+ )
+ ;
+ ( CompilationTarget = c, TargetSuffix = ".c"
+ ; CompilationTarget = il, TargetSuffix = ".il"
+ ; CompilationTarget = java, TargetSuffix = ".java"
+ ; CompilationTarget = asm, TargetSuffix = ".s"
+ ),
+ FindTargetFiles =
+ (pred(ModuleName::in, [FileName]::out, di, uo) is det -->
+ % XXX Should we check the generated header files?
+ module_name_to_file_name(ModuleName, TargetSuffix,
+ no, FileName)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
% Given a fully expanded module (i.e. a module name and a list
% of all the items in the module and any of its imports),
% compile it.
@@ -587,23 +809,32 @@
% The initial arrangement has the stage numbers increasing by three
% so that new stages can be slotted in without too much trouble.
-:- pred compile(file_name, pair(module_name, item_list), io__state, io__state).
-:- mode compile(in, in, di, uo) is det.
+:- pred compile(file_name, pair(module_name, list(module_name)),
+ maybe(time_t), read_modules, pair(module_name, item_list),
+ io__state, io__state).
+:- mode compile(in, in, in, in, in, di, uo) is det.
-compile(SourceFileName, ModuleName - Items) -->
+compile(SourceFileName, RootModuleName - InlineSubModules0,
+ MaybeTimestamp, ReadModules, ModuleName - Items) -->
check_for_no_exports(Items, ModuleName),
- grab_imported_modules(SourceFileName, ModuleName, Items,
- Module, Error2),
+ grab_imported_modules(SourceFileName, ModuleName, ReadModules,
+ MaybeTimestamp, Items, Module, Error2),
( { Error2 \= fatal } ->
- mercury_compile(Module)
+ { ModuleName = RootModuleName ->
+ InlineSubModules = InlineSubModules0
+ ;
+ InlineSubModules = []
+ },
+ mercury_compile(Module, InlineSubModules)
;
[]
).
-:- pred mercury_compile(module_imports, io__state, io__state).
-:- mode mercury_compile(in, di, uo) is det.
+:- pred mercury_compile(module_imports, list(module_name),
+ io__state, io__state).
+:- mode mercury_compile(in, in, di, uo) is det.
-mercury_compile(Module) -->
+mercury_compile(Module, InlineSubModules) -->
{ module_imports_get_module_name(Module, ModuleName) },
% If we are only typechecking or error checking, then we should not
% modify any files, this includes writing to .d files.
@@ -611,7 +842,8 @@
globals__io_lookup_bool_option(errorcheck_only, ErrorCheckOnly),
{ bool__or(TypeCheckOnly, ErrorCheckOnly, DontWriteDFile) },
mercury_compile__pre_hlds_pass(Module, DontWriteDFile,
- HLDS1, QualInfo, UndefTypes, UndefModes, Errors1),
+ HLDS1, QualInfo, MaybeTimestamps, UndefTypes, UndefModes,
+ Errors1),
mercury_compile__frontend_pass(HLDS1, QualInfo, UndefTypes,
UndefModes, HLDS20, Errors2),
( { Errors1 = no }, { Errors2 = no } ->
@@ -656,15 +888,27 @@
globals__io_lookup_bool_option(target_code_only,
TargetCodeOnly),
+ %
+ % Remove any existing `.used' file before writing the
+ % output file file. This avoids leaving the old `used'
+ % file lying around if compilation is interrupted after
+ % the new output file is written but before the new
+ % `.used' file is written.
+ %
+ module_name_to_file_name(ModuleName, ".used", no,
+ UsageFileName),
+ invoke_system_command("rm -f " ++ UsageFileName, _),
+
% magic sets can report errors.
{ module_info_num_errors(HLDS50, NumErrors) },
( { NumErrors = 0 } ->
mercury_compile__maybe_generate_rl_bytecode(HLDS50,
Verbose, MaybeRLFile),
( { AditiOnly = yes } ->
- []
+ { HLDS = HLDS50 }
; { Target = il } ->
- mercury_compile__mlds_backend(HLDS50, MLDS),
+ { HLDS = HLDS50 },
+ mercury_compile__mlds_backend(HLDS, MLDS),
( { TargetCodeOnly = yes } ->
mercury_compile__mlds_to_il_assembler(MLDS)
;
@@ -675,7 +919,8 @@
HasMain)
)
; { Target = java } ->
- mercury_compile__mlds_backend(HLDS50, MLDS),
+ { HLDS = HLDS50 },
+ mercury_compile__mlds_backend(HLDS, MLDS),
mercury_compile__mlds_to_java(MLDS),
( { TargetCodeOnly = yes } ->
[]
@@ -684,7 +929,8 @@
)
; { Target = asm } ->
% compile directly to assembler using the gcc back-end
- mercury_compile__mlds_backend(HLDS50, MLDS),
+ { HLDS = HLDS50 },
+ mercury_compile__mlds_backend(HLDS, MLDS),
mercury_compile__maybe_mlds_to_gcc(MLDS,
ContainsCCode),
( { TargetCodeOnly = yes } ->
@@ -721,7 +967,8 @@
)
)
; { HighLevelCode = yes } ->
- mercury_compile__mlds_backend(HLDS50, MLDS),
+ { HLDS = HLDS50 },
+ mercury_compile__mlds_backend(HLDS, MLDS),
mercury_compile__mlds_to_high_level_c(MLDS),
( { TargetCodeOnly = yes } ->
[]
@@ -735,11 +982,13 @@
C_File, O_File, _CompileOK)
)
;
- mercury_compile__backend_pass(HLDS50, HLDS70,
+ mercury_compile__backend_pass(HLDS50, HLDS,
GlobalData, LLDS),
- mercury_compile__output_pass(HLDS70, GlobalData, LLDS,
+ mercury_compile__output_pass(HLDS, GlobalData, LLDS,
MaybeRLFile, ModuleName, _CompileErrors)
- )
+ ),
+ recompilation_usage__write_usage_file(HLDS,
+ InlineSubModules, MaybeTimestamps)
;
% If the number of errors is > 0, make sure that
% the compiler exits with a non-zero exit
@@ -772,13 +1021,14 @@
%-----------------------------------------------------------------------------%
:- pred mercury_compile__pre_hlds_pass(module_imports, bool,
- module_info, qual_info, bool, bool, bool,
- io__state, io__state).
-:- mode mercury_compile__pre_hlds_pass(in, in, out, out, out, out, out,
+ module_info, qual_info, maybe(module_timestamps),
+ bool, bool, bool, io__state, io__state).
+:- mode mercury_compile__pre_hlds_pass(in, in, out, out, out, out, out, out,
di, uo) is det.
mercury_compile__pre_hlds_pass(ModuleImports0, DontWriteDFile,
- HLDS1, QualInfo, UndefTypes, UndefModes, FoundError) -->
+ HLDS1, QualInfo, MaybeTimestamps,
+ UndefTypes, UndefModes, FoundError) -->
globals__io_lookup_bool_option(statistics, Stats),
globals__io_lookup_bool_option(verbose, Verbose),
@@ -799,11 +1049,16 @@
MaybeTransOptDeps, ModuleImports1, IntermodError),
{ module_imports_get_items(ModuleImports1, Items1) },
+ { MaybeTimestamps = ModuleImports1 ^ maybe_timestamps },
+
mercury_compile__module_qualify_items(Items1, Items2, Module, Verbose,
- Stats, MQInfo, _, UndefTypes0, UndefModes0),
+ Stats, MQInfo0, _, UndefTypes0, UndefModes0),
- mercury_compile__expand_equiv_types(Items2, Verbose, Stats,
- Items, CircularTypes, EqvMap),
+ { mq_info_get_recompilation_info(MQInfo0, RecompInfo0) },
+ mercury_compile__expand_equiv_types(Module, Items2, Verbose, Stats,
+ Items, CircularTypes, EqvMap,
+ RecompInfo0, RecompInfo),
+ { mq_info_set_recompilation_info(MQInfo0, RecompInfo, MQInfo) },
{ bool__or(UndefTypes0, CircularTypes, UndefTypes1) },
mercury_compile__make_hlds(Module, Items, MQInfo, EqvMap, Verbose,
@@ -917,7 +1172,7 @@
{ Imports0 = module_imports(_File, _Module, Ancestors,
InterfaceImports, ImplementationImports,
_IndirectImports, _PublicChildren, _FactDeps,
- _ForeignCode, _Items, _Error) },
+ _ForeignCode, _Items, _Error, _Timestamps) },
{ list__condense([Ancestors, InterfaceImports,
ImplementationImports], TransOptFiles) },
trans_opt__grab_optfiles(Imports1, TransOptFiles,
@@ -930,16 +1185,18 @@
{ bool__or(Error1, Error2, Error) }.
-:- pred mercury_compile__expand_equiv_types(item_list, bool, bool, item_list,
- bool, eqv_map, io__state, io__state).
-:- mode mercury_compile__expand_equiv_types(in, in, in, out,
- out, out, di, uo) is det.
+:- pred mercury_compile__expand_equiv_types(module_name, item_list,
+ bool, bool, item_list, bool, eqv_map, maybe(recompilation_info),
+ maybe(recompilation_info), io__state, io__state).
+:- mode mercury_compile__expand_equiv_types(in, in, in, in, out,
+ out, out, in, out, di, uo) is det.
-mercury_compile__expand_equiv_types(Items0, Verbose, Stats,
- Items, CircularTypes, EqvMap) -->
+mercury_compile__expand_equiv_types(ModuleName, Items0, Verbose, Stats,
+ Items, CircularTypes, EqvMap, RecompInfo0, RecompInfo) -->
maybe_write_string(Verbose, "% Expanding equivalence types..."),
maybe_flush_output(Verbose),
- equiv_type__expand_eqv_types(Items0, Items, CircularTypes, EqvMap),
+ equiv_type__expand_eqv_types(ModuleName, Items0, Items, CircularTypes,
+ EqvMap, RecompInfo0, RecompInfo),
maybe_write_string(Verbose, " done.\n"),
maybe_report_stats(Stats).
@@ -975,7 +1232,7 @@
:- mode mercury_compile__frontend_pass(in, in, in, in, out, out, di, uo)
is det.
-mercury_compile__frontend_pass(HLDS1, QualInfo, FoundUndefTypeError,
+mercury_compile__frontend_pass(HLDS1, QualInfo0, FoundUndefTypeError,
FoundUndefModeError, HLDS, FoundError) -->
%
% We can't continue after an undefined type error, since
@@ -994,9 +1251,11 @@
maybe_write_string(Verbose,
"% Checking typeclass instances...\n"),
- check_typeclass__check_instance_decls(HLDS1, QualInfo, HLDS2,
- FoundTypeclassError),
+ check_typeclass__check_instance_decls(HLDS1, QualInfo0, HLDS2,
+ QualInfo, FoundTypeclassError),
mercury_compile__maybe_dump_hlds(HLDS2, "02", "typeclass"),
+ { make_hlds__set_module_recompilation_info(QualInfo,
+ HLDS2, HLDS2a) },
globals__io_lookup_bool_option(intermodule_optimization, Intermod),
globals__io_lookup_bool_option(use_opt_files, UseOptFiles),
@@ -1007,17 +1266,17 @@
% to speed up compilation. This must be done after
% typeclass instances have been checked, since that
% fills in which pred_ids are needed by instance decls.
- { dead_pred_elim(HLDS2, HLDS2a) },
- mercury_compile__maybe_dump_hlds(HLDS2a, "02a",
+ { dead_pred_elim(HLDS2a, HLDS2b) },
+ mercury_compile__maybe_dump_hlds(HLDS2b, "02b",
"dead_pred_elim")
;
- { HLDS2a = HLDS2 }
+ { HLDS2b = HLDS2a }
),
%
% Next typecheck the clauses.
%
- typecheck(HLDS2a, HLDS3, FoundTypeError),
+ typecheck(HLDS2b, HLDS3, FoundTypeError),
( { FoundTypeError = yes } ->
maybe_write_string(Verbose,
"% Program contains type error(s).\n"),
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.186
diff -u -u -r1.186 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2001/05/15 12:14:08 1.186
+++ compiler/mercury_to_mercury.m 2001/05/23 12:44:54
@@ -90,7 +90,7 @@
in, in, in, in, in, in, di, uo) is det.
:- inst type_spec == bound(type_spec(ground, ground, ground, ground,
- ground, ground, ground)).
+ ground, ground, ground, ground)).
% mercury_output_pragma_type_spec(Pragma, AppendVarnums).
:- pred mercury_output_pragma_type_spec((pragma_type), bool,
@@ -109,10 +109,6 @@
:- pred mercury_output_pragma_foreign_decl(foreign_language, string, io__state, io__state).
:- mode mercury_output_pragma_foreign_decl(in, in, di, uo) is det.
-:- pred mercury_output_type_defn(tvarset, type_defn, prog_context,
- io__state, io__state).
-:- mode mercury_output_type_defn(in, in, in, di, uo) is det.
-
:- pred mercury_output_ctor(constructor, tvarset, io__state, io__state).
:- mode mercury_output_ctor(in, in, di, uo) is det.
@@ -120,14 +116,6 @@
io__state, io__state).
:- mode mercury_output_remaining_ctor_args(in, in, di, uo) is det.
-:- pred mercury_output_inst_defn(inst_varset, inst_defn, prog_context,
- io__state, io__state).
-:- mode mercury_output_inst_defn(in, in, in, di, uo) is det.
-
-:- pred mercury_output_mode_defn(inst_varset, mode_defn, prog_context,
- io__state, io__state).
-:- mode mercury_output_mode_defn(in, in, in, di, uo) is det.
-
% Output a list of insts in a format that makes them easy to read
% but may not be valid Mercury.
@@ -203,6 +191,10 @@
:- pred mercury_output_bracketed_sym_name(sym_name, io__state, io__state).
:- mode mercury_output_bracketed_sym_name(in, di, uo) is det.
+:- pred mercury_output_bracketed_sym_name(sym_name, needs_quotes,
+ io__state, io__state).
+:- mode mercury_output_bracketed_sym_name(in, in, di, uo) is det.
+
:- pred mercury_convert_var_name(string, string).
:- mode mercury_convert_var_name(in, out) is det.
@@ -233,7 +225,7 @@
:- implementation.
:- import_module prog_out, prog_util, hlds_pred, hlds_out, instmap.
-:- import_module purity, term_util.
+:- import_module recompilation_version, purity, term_util.
:- import_module globals, options, termination.
:- import_module assoc_list, char, int, string, set, lexer, require.
@@ -285,60 +277,77 @@
%-----------------------------------------------------------------------------%
% dispatch on the different types of items
-
-mercury_output_item(type_defn(VarSet, TypeDefn, _Cond), Context) -->
- maybe_output_line_number(Context),
- mercury_output_type_defn(VarSet, TypeDefn, Context).
-mercury_output_item(inst_defn(VarSet, InstDefn, _Cond), Context) -->
+mercury_output_item(type_defn(VarSet, Name, Args, TypeDefn, _Cond),
+ Context) -->
maybe_output_line_number(Context),
- mercury_output_inst_defn(VarSet, InstDefn, Context).
+ mercury_output_type_defn(VarSet, Name, Args, TypeDefn, Context).
-mercury_output_item(mode_defn(VarSet, ModeDefn, _Cond), Context) -->
+mercury_output_item(inst_defn(VarSet, Name, Args, InstDefn, _Cond),
+ Context) -->
maybe_output_line_number(Context),
- mercury_output_mode_defn(VarSet, ModeDefn, Context).
+ mercury_output_inst_defn(VarSet, Name, Args, InstDefn, Context).
-mercury_output_item(pred(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, Det, _Cond, Purity, ClassContext), Context) -->
- maybe_output_line_number(Context),
- mercury_output_pred_decl(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, Det, Purity, ClassContext, Context,
- ":- ", ".\n", ".\n").
-
-mercury_output_item(func(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, RetTypeAndMode, Det, _Cond, Purity,
- ClassContext), Context) -->
+mercury_output_item(mode_defn(VarSet, Name, Args, ModeDefn, _Cond),
+ Context) -->
maybe_output_line_number(Context),
- mercury_output_func_decl(TypeVarSet, InstVarSet, ExistQVars, PredName,
- TypesAndModes, RetTypeAndMode, Det, Purity, ClassContext,
- Context, ":- ", ".\n", ".\n").
+ mercury_output_mode_defn(VarSet, Name, Args, ModeDefn, Context).
-mercury_output_item(pred_mode(VarSet, PredName, Modes, MaybeDet, _Cond),
- Context) -->
+mercury_output_item(
+ pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, PredName, TypesAndModes, Det,
+ _Cond, Purity, ClassContext),
+ Context) -->
maybe_output_line_number(Context),
- mercury_output_pred_mode_decl(VarSet, PredName, Modes, MaybeDet,
- Context).
+ (
+ { PredOrFunc = predicate },
+ mercury_output_pred_decl(TypeVarSet, InstVarSet, ExistQVars,
+ PredName, TypesAndModes, Det, Purity,
+ ClassContext, Context,
+ ":- ", ".\n", ".\n")
+ ;
+ { PredOrFunc = function },
+ { pred_args_to_func_args(TypesAndModes, FuncTypesAndModes,
+ RetTypeAndMode) },
+ mercury_output_func_decl(TypeVarSet, InstVarSet, ExistQVars,
+ PredName, FuncTypesAndModes, RetTypeAndMode,
+ Det, Purity, ClassContext, Context,
+ ":- ", ".\n", ".\n")
+ ).
-mercury_output_item(func_mode(VarSet, PredName, Modes, RetMode, MaybeDet,
- _Cond), Context) -->
+mercury_output_item(
+ pred_or_func_mode(VarSet, PredOrFunc, PredName,
+ Modes, MaybeDet, _Cond),
+ Context) -->
maybe_output_line_number(Context),
- mercury_output_func_mode_decl(VarSet, PredName, Modes, RetMode,
- MaybeDet, Context).
+ (
+ { PredOrFunc = predicate },
+ mercury_output_pred_mode_decl(VarSet, PredName, Modes,
+ MaybeDet, Context)
+ ;
+ { PredOrFunc = function },
+ { pred_args_to_func_args(Modes, FuncModes, RetMode) },
+ mercury_output_func_mode_decl(VarSet, PredName,
+ FuncModes, RetMode, MaybeDet, Context)
+ ).
mercury_output_item(module_defn(VarSet, ModuleDefn), Context) -->
maybe_output_line_number(Context),
mercury_output_module_defn(VarSet, ModuleDefn, Context).
-
-mercury_output_item(pred_clause(VarSet, PredName, Args, Body), Context) -->
- maybe_output_line_number(Context),
- mercury_output_pred_clause(VarSet, PredName, Args, Body, Context),
- io__write_string(".\n").
-mercury_output_item(func_clause(VarSet, FuncName, Args, Result, Body),
+mercury_output_item(clause(VarSet, PredOrFunc, PredName, Args, Body),
Context) -->
maybe_output_line_number(Context),
- mercury_output_func_clause(VarSet, FuncName, Args, Result, Body,
- Context),
+ (
+ { PredOrFunc = predicate },
+ mercury_output_pred_clause(VarSet, PredName,
+ Args, Body, Context)
+ ;
+ { PredOrFunc = function },
+ { pred_args_to_func_args(Args, FuncArgs, Result) },
+ mercury_output_func_clause(VarSet, PredName, FuncArgs, Result,
+ Body, Context)
+ ),
io__write_string(".\n").
mercury_output_item(pragma(Pragma), Context) -->
@@ -374,7 +383,7 @@
{ eval_method_to_string(Type, TypeS) },
mercury_output_pragma_decl(Pred, Arity, predicate, TypeS)
;
- { Pragma = type_spec(_, _, _, _, _, _, _) },
+ { Pragma = type_spec(_, _, _, _, _, _, _, _) },
{ AppendVarnums = no },
mercury_output_pragma_type_spec(Pragma, AppendVarnums)
;
@@ -465,7 +474,7 @@
mercury_output_goal(Goal, VarSet, Indent),
io__write_string(".\n").
-mercury_output_item(nothing, _) --> [].
+mercury_output_item(nothing(_), _) --> [].
mercury_output_item(typeclass(Constraints, ClassName, Vars, Interface,
VarSet), _) -->
io__write_string(":- typeclass "),
@@ -538,29 +547,36 @@
output_class_method(Method) -->
io__write_string("\t"),
(
- { Method = pred(TypeVarSet, InstVarSet, ExistQVars, Name,
- TypesAndModes, Detism, _Condition, Purity, ClassContext,
- Context) },
- mercury_output_pred_decl(TypeVarSet, InstVarSet, ExistQVars,
- Name, TypesAndModes, Detism, Purity, ClassContext,
- Context, "", ",\n\t", "")
- ;
- { Method = func(TypeVarSet, InstVarSet, ExistQVars, Name,
- TypesAndModes, TypeAndMode, Detism, _Condition,
+ { Method = pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, Name, TypesAndModes, Detism, _Condition,
Purity, ClassContext, Context) },
- mercury_output_func_decl(TypeVarSet, InstVarSet, ExistQVars,
- Name, TypesAndModes, TypeAndMode, Detism, Purity,
- ClassContext, Context, "", ",\n\t", "")
+ (
+ { PredOrFunc = predicate },
+ mercury_output_pred_decl(TypeVarSet, InstVarSet,
+ ExistQVars, Name, TypesAndModes, Detism,
+ Purity, ClassContext, Context, "", ",\n\t", "")
+ ;
+ { PredOrFunc = function },
+ { pred_args_to_func_args(TypesAndModes,
+ FuncTypesAndModes, RetTypeAndMode) },
+ mercury_output_func_decl(TypeVarSet, InstVarSet,
+ ExistQVars, Name, FuncTypesAndModes,
+ RetTypeAndMode, Detism, Purity, ClassContext,
+ Context, "", ",\n\t", "")
+ )
;
- { Method = pred_mode(VarSet, Name, Modes, Detism,
- _Condition, Context) },
- mercury_output_pred_mode_decl_2(VarSet, Name, Modes, Detism,
- Context, "", "")
- ;
- { Method = func_mode(VarSet, Name, Modes, Mode,
- Detism, _Condition, Context) },
- mercury_output_func_mode_decl_2(VarSet, Name, Modes,
- Mode, Detism, Context, "", "")
+ { Method = pred_or_func_mode(VarSet, PredOrFunc,
+ Name, Modes, Detism, _Condition, Context) },
+ (
+ { PredOrFunc = predicate },
+ mercury_output_pred_mode_decl_2(VarSet, Name, Modes,
+ Detism, Context, "", "")
+ ;
+ { PredOrFunc = function },
+ { pred_args_to_func_args(Modes, FuncModes, RetMode) },
+ mercury_output_func_mode_decl_2(VarSet, Name,
+ FuncModes, RetMode, Detism, Context, "", "")
+ )
).
mercury_output_instance_methods(Methods) -->
@@ -590,35 +606,27 @@
{ Defn = clauses(ItemList) },
% XXX should we output the term contexts?
io__write_string("\t("),
- (
- { PredOrFunc = predicate },
- { WriteOneItem = (pred(Item::in, di, uo) is det -->
- (
- { Item = pred_clause(VarSet, _PredName,
- HeadTerms, Body) }
- ->
- mercury_output_pred_clause(VarSet,
- Name1, HeadTerms, Body,
- Context)
- ;
- { error("invalid instance item") }
- )) },
- io__write_list(ItemList, "),\n\t(", WriteOneItem)
- ;
- { PredOrFunc = function },
- { WriteOneItem = (pred(Item::in, di, uo) is det -->
- (
- { Item = func_clause(VarSet, _PredName,
- ArgTerms, ResultTerm, Body) }
- ->
- mercury_output_func_clause(VarSet,
- Name1, ArgTerms, ResultTerm,
- Body, Context)
- ;
- { error("invalid instance item") }
- )) },
- io__write_list(ItemList, "),\n\t(", WriteOneItem)
- ),
+ { WriteOneItem = (pred(Item::in, di, uo) is det -->
+ (
+ { Item = clause(VarSet, PredOrFunc, _PredName,
+ HeadTerms, Body) }
+ ->
+ (
+ { PredOrFunc = predicate },
+ mercury_output_pred_clause(VarSet,
+ Name1, HeadTerms, Body, Context)
+ ;
+ { PredOrFunc = function },
+ { pred_args_to_func_args(HeadTerms, ArgTerms,
+ ResultTerm) },
+ mercury_output_func_clause(VarSet,
+ Name1, ArgTerms, ResultTerm,
+ Body, Context)
+ )
+ ;
+ { error("invalid instance method item") }
+ )) },
+ io__write_list(ItemList, "),\n\t(", WriteOneItem),
io__write_string(")")
).
@@ -653,6 +661,14 @@
io__write_string(":- end_module "),
mercury_output_bracketed_sym_name(Module),
io__write_string(".\n")
+ ; { ModuleDefn = version_numbers(Module, VersionNumbers) } ->
+ io__write_string(":- version_numbers("),
+ io__write_int(version_numbers_version_number),
+ io__write_string(", "),
+ mercury_output_bracketed_sym_name(Module),
+ io__write_string(",\n"),
+ recompilation_version__write_version_numbers(VersionNumbers),
+ io__write_string(").\n")
;
% XXX unimplemented
io__write_string("% unimplemented module declaration\n")
@@ -672,13 +688,17 @@
mercury_write_module_spec_list(ModuleNames)
).
-mercury_output_inst_defn(VarSet, abstract_inst(Name, Args), Context) -->
+:- pred mercury_output_inst_defn(inst_varset, sym_name, list(inst_var),
+ inst_defn, prog_context, io__state, io__state).
+:- mode mercury_output_inst_defn(in, in, in, in, in, di, uo) is det.
+
+mercury_output_inst_defn(VarSet, Name, Args, abstract_inst, Context) -->
io__write_string(":- inst ("),
{ list__map(pred(V::in, variable(V)::out) is det, Args, ArgTerms) },
{ construct_qualified_term(Name, ArgTerms, Context, InstTerm) },
mercury_output_term(InstTerm, VarSet, no),
io__write_string(").\n").
-mercury_output_inst_defn(VarSet, eqv_inst(Name, Args, Body), Context) -->
+mercury_output_inst_defn(VarSet, Name, Args, eqv_inst(Body), Context) -->
io__write_string(":- inst ("),
{ list__map(pred(V::in, variable(V)::out) is det, Args, ArgTerms) },
{ construct_qualified_term(Name, ArgTerms, Context, InstTerm) },
@@ -1188,8 +1208,12 @@
[i(InstanceNum), s(InstanceString)]).
mercury_output_cons_id(tabling_pointer_const(_, _), _) -->
io__write_string("<tabling pointer>").
+
+:- pred mercury_output_mode_defn(inst_varset, sym_name, list(inst_var),
+ mode_defn, prog_context, io__state, io__state).
+:- mode mercury_output_mode_defn(in, in, in, in, in, di, uo) is det.
-mercury_output_mode_defn(VarSet, eqv_mode(Name, Args, Mode), Context) -->
+mercury_output_mode_defn(VarSet, Name, Args, eqv_mode(Mode), Context) -->
io__write_string(":- mode ("),
{ list__map(pred(V::in, variable(V)::out) is det, Args, ArgTerms) },
{ construct_qualified_term(Name, ArgTerms, Context, ModeTerm) },
@@ -1253,27 +1277,24 @@
%-----------------------------------------------------------------------------%
-mercury_output_type_defn(VarSet, TypeDefn, Context) -->
- mercury_output_type_defn_2(TypeDefn, VarSet, Context).
-
-:- pred mercury_output_type_defn_2(type_defn, tvarset, prog_context,
- io__state, io__state).
-:- mode mercury_output_type_defn_2(in, in, in, di, uo) is det.
+:- 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_2(uu_type(_Name, _Args, _Body), _VarSet, Context) -->
+mercury_output_type_defn(_VarSet, _Name, _Args, uu_type(_Body), Context) -->
io__stderr_stream(StdErr),
io__set_output_stream(StdErr, OldStream),
prog_out__write_context(Context),
io__write_string("warning: undiscriminated union types not yet supported.\n"),
io__set_output_stream(OldStream, _).
-mercury_output_type_defn_2(abstract_type(Name, Args), VarSet, Context) -->
+mercury_output_type_defn(VarSet, Name, Args, abstract_type, Context) -->
io__write_string(":- type "),
{ construct_qualified_term(Name, Args, Context, TypeTerm) },
mercury_output_term(TypeTerm, VarSet, no, next_to_graphic_token),
io__write_string(".\n").
-mercury_output_type_defn_2(eqv_type(Name, Args, Body), VarSet, Context) -->
+mercury_output_type_defn(VarSet, Name, Args, eqv_type(Body), Context) -->
io__write_string(":- type "),
{ construct_qualified_term(Name, Args, Context, TypeTerm) },
mercury_output_term(TypeTerm, VarSet, no),
@@ -1281,8 +1302,8 @@
mercury_output_term(Body, VarSet, no, next_to_graphic_token),
io__write_string(".\n").
-mercury_output_type_defn_2(du_type(Name, Args, Ctors, MaybeEqualityPred),
- VarSet, Context) -->
+mercury_output_type_defn(VarSet, Name, Args,
+ du_type(Ctors, MaybeEqualityPred), Context) -->
io__write_string(":- type "),
{ construct_qualified_term(Name, Args, Context, TypeTerm) },
mercury_output_term(TypeTerm, VarSet, no),
@@ -2352,7 +2373,7 @@
mercury_output_pragma_type_spec(Pragma, AppendVarnums) -->
{ Pragma = type_spec(PredName, SpecName, Arity,
- MaybePredOrFunc, MaybeModes, Subst, VarSet) },
+ MaybePredOrFunc, MaybeModes, Subst, VarSet, _) },
io__write_string(":- pragma type_spec("),
( { MaybeModes = yes(Modes) } ->
{ MaybePredOrFunc = yes(PredOrFunc0) ->
@@ -2820,10 +2841,6 @@
mercury_output_bracketed_sym_name(SymName) -->
mercury_output_bracketed_sym_name(SymName, not_next_to_graphic_token).
-
-:- pred mercury_output_bracketed_sym_name(sym_name, needs_quotes,
- io__state, io__state).
-:- mode mercury_output_bracketed_sym_name(in, in, di, uo) is det.
mercury_output_bracketed_sym_name(Name, NextToGraphicToken) -->
( { Name = qualified(ModuleName, Name2) },
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.67
diff -u -u -r1.67 module_qual.m
--- compiler/module_qual.m 2001/05/16 04:50:49 1.67
+++ compiler/module_qual.m 2001/05/27 19:37:27
@@ -19,8 +19,8 @@
%
:- interface.
-:- import_module prog_data.
-:- import_module bool, list, io.
+:- import_module prog_data, recompilation.
+:- import_module bool, list, std_util, io.
% module_qualify_items(Items0, Items, ModuleName, ReportUndefErrors,
% MQ_Info, NumErrors, UndefTypes, UndefModes):
@@ -71,6 +71,10 @@
:- pred mq_info_get_need_qual_flag(mq_info::in, need_qualifier::out) is det.
:- pred mq_info_get_partial_qualifier_info(mq_info::in,
partial_qualifier_info::out) is det.
+:- pred mq_info_get_recompilation_info(mq_info::in,
+ maybe(recompilation_info)::out) is det.
+:- pred mq_info_set_recompilation_info(mq_info::in,
+ maybe(recompilation_info)::in, mq_info::out) is det.
% The type partial_qualifier_info holds info need for computing which
% partial quantifiers are visible -- see get_partial_qualifiers/3.
@@ -107,10 +111,12 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module type_util, prog_io, prog_out.
+:- import_module type_util, prog_io, prog_out, hlds_out.
:- import_module prog_util, mercury_to_mercury, modules, globals, options.
:- import_module (inst), instmap.
-:- import_module int, map, require, set, std_util, string, term, varset.
+:- import_module hlds_data. % for cons_id.
+
+:- import_module int, map, require, set, string, term, varset.
:- import_module assoc_list.
module_qual__module_qualify_items(Items0, Items, ModuleName, ReportErrors,
@@ -181,7 +187,8 @@
this_module::module_name,
% must uses of the current item be
% explicitly module qualified.
- need_qual_flag::need_qualifier
+ need_qual_flag::need_qualifier,
+ maybe_recompilation_info::maybe(recompilation_info)
).
:- type partial_qualifier_info --->
@@ -216,20 +223,29 @@
:- pred collect_mq_info_2(item::in, mq_info::in, mq_info::out) is det.
-collect_mq_info_2(pred_clause(_,_,_,_), Info, Info).
-collect_mq_info_2(func_clause(_,_,_,_,_), Info, Info).
-collect_mq_info_2(type_defn(_, TypeDefn, _), Info0, Info) :-
- add_type_defn(TypeDefn, Info0, Info).
-collect_mq_info_2(inst_defn(_, InstDefn, _), Info0, Info) :-
- add_inst_defn(InstDefn, Info0, Info).
-collect_mq_info_2(mode_defn(_, ModeDefn, _), Info0, Info) :-
- add_mode_defn(ModeDefn, Info0, Info).
+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).
+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).
+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).
collect_mq_info_2(module_defn(_, ModuleDefn), Info0, Info) :-
process_module_defn(ModuleDefn, Info0, Info).
-collect_mq_info_2(pred(_,__,_,_,_,_,_,_,_), Info, Info).
-collect_mq_info_2(func(_,_,__,_,_,_,_,_,_,_), Info, Info).
-collect_mq_info_2(pred_mode(_,_,_,_,_), Info, Info).
-collect_mq_info_2(func_mode(_,_,_,_,_,_), Info, Info).
+collect_mq_info_2(pred_or_func(_,_,__,_,_,_,_,_,_,_), Info, Info).
+collect_mq_info_2(pred_or_func_mode(_,_,_,_,_,_), Info, Info).
collect_mq_info_2(pragma(_), Info, Info).
collect_mq_info_2(assertion(Goal, _ProgVarSet), Info0, Info) :-
process_assert(Goal, SymNames, Success),
@@ -257,59 +273,14 @@
mq_info_set_unused_interface_modules(Info0,
UnusedInterfaceModules, Info)
).
-collect_mq_info_2(nothing, Info, Info).
-collect_mq_info_2(typeclass(_, Name, Vars, _, _), Info0, Info) :-
- add_typeclass_defn(Name, Vars, Info0, Info).
-collect_mq_info_2(instance(_,_,_,_,_,_), Info, Info).
-
-
-% Predicates to add the type, inst, mode and typeclass ids visible
-% in this module to the mq_info.
-
-:- pred add_type_defn(type_defn::in, mq_info::in, mq_info::out) is det.
-
-add_type_defn(TypeDefn, Info0, Info) :-
- ( TypeDefn = du_type(SymName, Params, _, _EqualityPred)
- ; TypeDefn = uu_type(SymName, Params, _)
- ; TypeDefn = eqv_type(SymName, Params, _)
- ; TypeDefn = abstract_type(SymName, Params)
- ),
+collect_mq_info_2(nothing(_), Info, Info).
+collect_mq_info_2(typeclass(_, 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).
-
-:- pred add_inst_defn(inst_defn::in, mq_info::in, mq_info::out) is det.
-
-add_inst_defn(InstDefn, Info0, Info) :-
- ( InstDefn = eqv_inst(SymName, Params, _)
- ; InstDefn = abstract_inst(SymName, Params)
- ),
- 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).
-
-:- pred add_mode_defn(mode_defn::in, mq_info::in, mq_info::out) is det.
-
-add_mode_defn(eqv_mode(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).
-
-:- pred add_typeclass_defn(sym_name::in, list(tvar)::in,
- mq_info::in, mq_info::out) is det.
-
-add_typeclass_defn(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).
+collect_mq_info_2(instance(_,_,_,_,_,_), Info, Info).
% process_module_defn:
%
@@ -353,6 +324,7 @@
add_imports(Imports, Info0, Info).
process_module_defn(use(Imports), Info0, Info) :-
add_imports(Imports, Info0, Info).
+process_module_defn(version_numbers(_, _), Info, Info).
:- pred add_module_defn(module_name, mq_info, mq_info).
:- mode add_module_defn(in, in, out) is det.
@@ -523,77 +495,69 @@
mq_info::in, mq_info::out, bool::out,
io__state::di, io__state::uo) is det.
-module_qualify_item(pred_clause(A,B,C,D) - Con, pred_clause(A,B,C,D) - Con,
+module_qualify_item(clause(A,B,C,D,E) - Con, clause(A,B,C,D,E) - Con,
Info, Info, yes) --> [].
-module_qualify_item(func_clause(A,B,C,D,E) - Con, func_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,
+ Info0, Info, yes) -->
+ { list__length(Params, Arity) },
+ { mq_info_set_error_context(Info0,
+ type(SymName - Arity) - Context, Info1) },
+ qualify_type_defn(TypeDefn0, TypeDefn, Info1, Info).
+
+module_qualify_item(inst_defn(A, SymName, Params, InstDefn0, C) - Context,
+ inst_defn(A, SymName, Params, InstDefn, C) - Context,
+ Info0, Info, yes) -->
+ { list__length(Params, Arity) },
+ { mq_info_set_error_context(Info0,
+ inst(SymName - Arity) - Context, Info1) },
+ qualify_inst_defn(InstDefn0, InstDefn, Info1, Info).
-module_qualify_item(type_defn(A, TypeDefn0, C) - Context,
- type_defn(A, TypeDefn, C) - Context, Info0, Info, yes) -->
- qualify_type_defn(TypeDefn0, TypeDefn, Info0, Info, Context).
-
-module_qualify_item(inst_defn(A, InstDefn0, C) - Context,
- inst_defn(A, InstDefn, C) - Context, Info0, Info, yes) -->
- qualify_inst_defn(InstDefn0, InstDefn, Info0, Info, Context).
-
-module_qualify_item(mode_defn(A, ModeDefn0, C) - Context,
- mode_defn(A, ModeDefn, C) - Context, Info0, Info, yes) -->
- qualify_mode_defn(ModeDefn0, ModeDefn, Info0, Info, Context).
+module_qualify_item(mode_defn(A, SymName, Params, ModeDefn0, C) - Context,
+ mode_defn(A, SymName, Params, ModeDefn, C) - Context,
+ Info0, Info, yes) -->
+ { list__length(Params, Arity) },
+ { mq_info_set_error_context(Info0,
+ mode(SymName - Arity) - Context, Info1) },
+ qualify_mode_defn(ModeDefn0, ModeDefn, Info1, Info).
module_qualify_item(module_defn(A, ModuleDefn) - Context,
module_defn(A, ModuleDefn) - Context, Info0, Info, Continue) -->
{ update_import_status(ModuleDefn, Info0, Info, Continue) }.
module_qualify_item(
- pred(A, IVs, B, SymName, TypesAndModes0, C, D, E,
- Constraints0) - Context,
- pred(A, IVs, B, SymName, TypesAndModes, C, D, E,
- Constraints) - Context,
+ pred_or_func(A, IVs, B, PredOrFunc, SymName, TypesAndModes0,
+ C, D, E, Constraints0) - Context,
+ pred_or_func(A, IVs, B, PredOrFunc, SymName, TypesAndModes,
+ C, D, E, Constraints) - Context,
Info0, Info, yes) -->
{ list__length(TypesAndModes0, Arity) },
- { mq_info_set_error_context(Info0, pred(SymName - Arity) - Context,
- Info1) },
+ { mq_info_set_error_context(Info0,
+ pred_or_func(PredOrFunc, SymName - Arity) - Context,
+ Info1) },
qualify_types_and_modes(TypesAndModes0, TypesAndModes, Info1, Info2),
qualify_class_constraints(Constraints0, Constraints, Info2, Info).
module_qualify_item(
- func(A, IVs, B, SymName, TypesAndModes0, TypeAndMode0, F, G, H,
- Constraints0) - Context,
- func(A, IVs, B, SymName, TypesAndModes, TypeAndMode, F, G, H,
- Constraints) - Context,
+ pred_or_func_mode(A, PredOrFunc, SymName, Modes0,
+ C, D) - Context,
+ pred_or_func_mode(A, PredOrFunc, SymName, Modes,
+ C, D) - Context,
Info0, Info, yes) -->
- { list__length(TypesAndModes0, Arity) },
- { mq_info_set_error_context(Info0, func(SymName - Arity) - Context,
- Info1) },
- qualify_types_and_modes(TypesAndModes0, TypesAndModes, Info1, Info2),
- qualify_type_and_mode(TypeAndMode0, TypeAndMode, Info2, Info3),
- qualify_class_constraints(Constraints0, Constraints, Info3, Info).
-
-module_qualify_item(pred_mode(A, SymName, Modes0, C, D) - Context,
- pred_mode(A, SymName, Modes, C, D) - Context,
- Info0, Info, yes) -->
{ list__length(Modes0, Arity) },
- { mq_info_set_error_context(Info0, pred_mode(SymName - Arity) - Context,
- Info1) },
+ { mq_info_set_error_context(Info0,
+ pred_or_func_mode(PredOrFunc, SymName- Arity) - Context,
+ Info1) },
qualify_mode_list(Modes0, Modes, Info1, Info).
-module_qualify_item(func_mode(A, SymName, Modes0, Mode0, C, D) - Context,
- func_mode(A, SymName, Modes, Mode, C, D) - Context,
- Info0, Info, yes) -->
- { list__length(Modes0, Arity) },
- { mq_info_set_error_context(Info0, func_mode(SymName - Arity) - Context,
- Info1) },
- qualify_mode_list(Modes0, Modes, Info1, Info2),
- qualify_mode(Mode0, Mode, Info2, Info).
-
module_qualify_item(pragma(Pragma0) - Context, pragma(Pragma) - Context,
Info0, Info, yes) -->
{ mq_info_set_error_context(Info0, (pragma) - Context, Info1) },
qualify_pragma(Pragma0, Pragma, Info1, Info).
module_qualify_item(assertion(G, V) - Context, assertion(G, V) - Context,
Info, Info, yes) --> [].
-module_qualify_item(nothing - Context, nothing - Context,
+module_qualify_item(nothing(A) - Context, nothing(A) - Context,
Info, Info, yes) --> [].
module_qualify_item(typeclass(Constraints0, Name, Vars, Interface0, VarSet) -
Context,
@@ -614,10 +578,11 @@
{ Interface = concrete(Methods) }
).
-module_qualify_item(instance(Constraints0, Name0, Types0, Body0, VarSet,
- ModName) - Context,
- instance(Constraints, Name, Types, Body, VarSet, ModName) -
- Context,
+module_qualify_item(
+ instance(Constraints0, Name0, Types0, Body0, VarSet,
+ ModName) - Context,
+ instance(Constraints, Name, Types, Body, VarSet,
+ ModName) - Context,
Info0, Info, yes) -->
{ list__length(Types0, Arity) },
{ Id = Name0 - Arity },
@@ -648,6 +613,7 @@
update_import_status(export(_), Info, Info, yes).
update_import_status(import(_), Info, Info, yes).
update_import_status(use(_), Info, Info, yes).
+update_import_status(version_numbers(_, _), Info, Info, yes).
update_import_status(include_module(_), Info0, Info, yes) :-
% The sub-module might make use of *any* of the imported modules.
% There's no way for us to tell which ones.
@@ -658,40 +624,23 @@
% Qualify the constructors or other types in a type definition.
:- pred qualify_type_defn(type_defn::in, type_defn::out, mq_info::in,
- mq_info::out, prog_context::in, io__state::di, io__state::uo) is det.
+ mq_info::out, io__state::di, io__state::uo) is det.
-qualify_type_defn(du_type(SymName, Params, Ctors0, MaybeEqualityPred0),
- du_type(SymName, Params, Ctors, MaybeEqualityPred),
- Info0, Info, Context) -->
- { list__length(Params, Arity) },
- { mq_info_set_error_context(Info0, type(SymName - Arity) - Context,
- Info1) },
- qualify_constructors(Ctors0, Ctors, Info1, Info),
+qualify_type_defn(du_type(Ctors0, MaybeEqualityPred0),
+ du_type(Ctors, MaybeEqualityPred), Info0, Info) -->
+ qualify_constructors(Ctors0, Ctors, Info0, Info),
% User-defined equality pred names will be converted into
% predicate calls and then module-qualified after type analysis
% (during mode analysis). That way they get full type overloading
% resolution, etc. Thus we don't module-qualify them here.
{ MaybeEqualityPred = MaybeEqualityPred0 }.
+qualify_type_defn(uu_type(Types0), uu_type(Types), Info0, Info) -->
+ qualify_type_list(Types0, Types, Info0, Info).
+qualify_type_defn(eqv_type(Type0), eqv_type(Type), Info0, Info) -->
+ qualify_type(Type0, Type, Info0, Info).
+qualify_type_defn(abstract_type, abstract_type, Info, Info) --> [].
-qualify_type_defn(uu_type(SymName, Params, Types0),
- uu_type(SymName, Params, Types), Info0, Info, Context) -->
- { list__length(Params, Arity) },
- { mq_info_set_error_context(Info0, type(SymName - Arity) - Context,
- Info1) },
- qualify_type_list(Types0, Types, Info1, Info).
-
-qualify_type_defn(eqv_type(SymName, Params, Type0),
- eqv_type(SymName, Params, Type),
- Info0, Info, Context) -->
- { list__length(Params, Arity) },
- { mq_info_set_error_context(Info0, type(SymName - Arity) - Context,
- Info1) },
- qualify_type(Type0, Type, Info1, Info).
-
-qualify_type_defn(abstract_type(SymName, Params),
- abstract_type(SymName, Params), 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.
@@ -705,28 +654,18 @@
% Qualify the inst parameters of an inst definition.
:- pred qualify_inst_defn(inst_defn::in, inst_defn::out, mq_info::in,
- mq_info::out, prog_context::in, io__state::di, io__state::uo) is det.
+ mq_info::out, io__state::di, io__state::uo) is det.
-qualify_inst_defn(eqv_inst(SymName, Params, Inst0),
- eqv_inst(SymName, Params, Inst), Info0, Info, Context) -->
- { list__length(Params, Arity) },
- { mq_info_set_error_context(Info0, inst(SymName - Arity) - Context,
- Info1) },
- qualify_inst(Inst0, Inst, Info1, Info).
-
-qualify_inst_defn(abstract_inst(SymName, Params),
- abstract_inst(SymName, Params), Info, Info, _) --> [].
+qualify_inst_defn(eqv_inst(Inst0), eqv_inst(Inst), Info0, Info) -->
+ qualify_inst(Inst0, Inst, Info0, Info).
+qualify_inst_defn(abstract_inst, abstract_inst, Info, Info) --> [].
% Qualify the mode parameter of an equivalence mode definition.
:- pred qualify_mode_defn(mode_defn::in, mode_defn::out, mq_info::in,
- mq_info::out, prog_context::in, io__state::di, io__state::uo) is det.
+ mq_info::out, io__state::di, io__state::uo) is det.
-qualify_mode_defn(eqv_mode(SymName, Params, Mode0),
- eqv_mode(SymName, Params, Mode), Info0, Info, Context) -->
- { list__length(Params, Arity) },
- { mq_info_set_error_context(Info0, mode(SymName - Arity) - Context,
- Info1) },
- qualify_mode(Mode0, Mode, Info1, Info).
+qualify_mode_defn(eqv_mode(Mode0), eqv_mode(Mode), Info0, Info) -->
+ qualify_mode(Mode0, Mode, Info0, Info).
% Qualify a list of items of the form Type::Mode, as in a
% predicate declaration.
@@ -853,8 +792,16 @@
qualify_bound_inst_list([], [], Info, Info) --> [].
qualify_bound_inst_list([functor(ConsId, Insts0) | BoundInsts0],
[functor(ConsId, Insts) | BoundInsts], Info0, Info) -->
- qualify_inst_list(Insts0, Insts, Info0, Info1),
- qualify_bound_inst_list(BoundInsts0, BoundInsts, Info1, Info).
+ { ConsId = cons(Name, Arity) ->
+ Id = Name - Arity,
+ update_recompilation_info(
+ recompilation__record_used_item(functor, Id, Id),
+ Info0, Info1)
+ ;
+ Info1 = Info0
+ },
+ qualify_inst_list(Insts0, Insts, Info1, Info2),
+ qualify_bound_inst_list(BoundInsts0, BoundInsts, Info2, Info).
:- pred qualify_constructor_arg_list(list(constructor_arg)::in,
list(constructor_arg)::out, mq_info::in, mq_info::out,
@@ -961,8 +908,9 @@
qualify_mode_list(Modes0, Modes, Info0, Info).
qualify_pragma(unused_args(A, B, C, D, E), unused_args(A, B, C, D, E),
Info, Info) --> [].
-qualify_pragma(type_spec(A, B, C, D, MaybeModes0, Subst0, G),
- type_spec(A, B, C, D, MaybeModes, Subst, G), Info0, Info) -->
+qualify_pragma(type_spec(A, B, C, D, MaybeModes0, Subst0, G, H),
+ type_spec(A, B, C, D, MaybeModes, Subst, G, H),
+ Info0, Info) -->
(
{ MaybeModes0 = yes(Modes0) }
->
@@ -1078,10 +1026,12 @@
% There is no need to qualify the method name, since that is
% done when the item is parsed.
qualify_class_method(
- pred(TypeVarset, InstVarset, ExistQVars, Name, TypesAndModes0,
- MaybeDet, Cond, Purity, ClassContext0, Context),
- pred(TypeVarset, InstVarset, ExistQVars, Name, TypesAndModes,
- MaybeDet, Cond, Purity, ClassContext, Context),
+ pred_or_func(TypeVarset, InstVarset, ExistQVars, PredOrFunc,
+ Name, TypesAndModes0, MaybeDet, Cond, Purity,
+ ClassContext0, Context),
+ pred_or_func(TypeVarset, InstVarset, ExistQVars, PredOrFunc,
+ Name, TypesAndModes, MaybeDet, Cond, Purity,
+ ClassContext, Context),
MQInfo0, MQInfo
) -->
qualify_types_and_modes(TypesAndModes0, TypesAndModes,
@@ -1089,34 +1039,13 @@
qualify_class_constraints(ClassContext0, ClassContext,
MQInfo1, MQInfo).
qualify_class_method(
- func(TypeVarset, InstVarset, ExistQVars, Name, TypesAndModes0,
- ReturnMode0, MaybeDet, Cond, Purity, ClassContext0,
- Context),
- func(TypeVarset, InstVarset, ExistQVars, Name, TypesAndModes,
- ReturnMode, MaybeDet, Cond, Purity, ClassContext,
- Context),
+ pred_or_func_mode(Varset, PredOrFunc, Name, Modes0,
+ MaybeDet, Cond, Context),
+ pred_or_func_mode(Varset, PredOrFunc, Name, Modes,
+ MaybeDet, Cond, Context),
MQInfo0, MQInfo
) -->
- qualify_types_and_modes(TypesAndModes0, TypesAndModes,
- MQInfo0, MQInfo1),
- qualify_type_and_mode(ReturnMode0, ReturnMode, MQInfo1, MQInfo2),
- qualify_class_constraints(ClassContext0, ClassContext,
- MQInfo2, MQInfo).
-qualify_class_method(
- pred_mode(Varset, Name, Modes0, MaybeDet, Cond, Context),
- pred_mode(Varset, Name, Modes, MaybeDet, Cond, Context),
- MQInfo0, MQInfo
- ) -->
qualify_mode_list(Modes0, Modes, MQInfo0, MQInfo).
-qualify_class_method(
- func_mode(Varset, Name, Modes0, ReturnMode0, MaybeDet, Cond,
- Context),
- func_mode(Varset, Name, Modes, ReturnMode, MaybeDet, Cond,
- Context),
- MQInfo0, MQInfo
- ) -->
- qualify_mode_list(Modes0, Modes, MQInfo0, MQInfo1),
- qualify_mode(ReturnMode0, ReturnMode, MQInfo1, MQInfo).
:- pred qualify_instance_body(sym_name::in, instance_body::in,
instance_body::out) is det.
@@ -1170,9 +1099,9 @@
find_unique_match(Id0, Id, Ids, TypeOfId, Info0, Info) -->
% Find all IDs which match the current id.
- { Id0 = SymName - Arity },
+ { Id0 = SymName0 - Arity },
{ mq_info_get_modules(Info0, Modules) },
- { id_set_search_sym_arity(Ids, SymName, Arity, Modules,
+ { id_set_search_sym_arity(Ids, SymName0, Arity, Modules,
MatchingModules) },
( { MatchingModules = [] } ->
@@ -1187,9 +1116,13 @@
)
; { MatchingModules = [Module] } ->
% A unique match for this ID.
- { unqualify_name(SymName, IdName) },
+ { unqualify_name(SymName0, IdName) },
{ Id = qualified(Module, IdName) - Arity },
- { mq_info_set_module_used(Info0, Module, Info) }
+ { mq_info_set_module_used(Info0, Module, Info1) },
+ { ItemType = convert_simple_item_type(TypeOfId) },
+ { update_recompilation_info(
+ recompilation__record_used_item(ItemType, Id0, Id),
+ Info1, Info) }
;
% There are multiple matches.
{ Id = Id0 },
@@ -1203,6 +1136,29 @@
{ Info = Info0 }
)
).
+
+:- pred update_recompilation_info(pred(recompilation_info, recompilation_info),
+ mq_info, mq_info).
+:- mode update_recompilation_info(pred(in, out) is det, in, out) is det.
+
+update_recompilation_info(Pred, Info0, Info) :-
+ mq_info_get_recompilation_info(Info0, MaybeRecompInfo0),
+ (
+ MaybeRecompInfo0 = yes(RecompInfo0),
+ Pred(RecompInfo0, RecompInfo),
+ mq_info_set_recompilation_info(Info0, yes(RecompInfo), Info)
+ ;
+ MaybeRecompInfo0 = no,
+ Info = Info0
+ ).
+
+:- func convert_simple_item_type(id_type) = item_type.
+:- mode convert_simple_item_type(in) = out is det.
+
+convert_simple_item_type(type_id) = (type).
+convert_simple_item_type(mode_id) = (mode).
+convert_simple_item_type(inst_id) = (inst).
+convert_simple_item_type(class_id) = (typeclass).
%------------------------------------------------------------------------------
@@ -1220,10 +1176,8 @@
type(id)
; inst(id)
; mode(id)
- ; pred(id)
- ; func(id)
- ; pred_mode(id)
- ; func_mode(id)
+ ; pred_or_func(pred_or_func, id)
+ ; pred_or_func_mode(pred_or_func, id)
; (pragma)
; lambda_expr
; clause_mode_annotation
@@ -1312,19 +1266,19 @@
write_id(Id).
write_error_context2(inst(Id)) -->
io__write_string("definition of inst "),
- write_id(Id).
-write_error_context2(pred(Id)) -->
- io__write_string("definition of predicate "),
- write_id(Id).
-write_error_context2(pred_mode(Id)) -->
- io__write_string("mode declaration for predicate "),
write_id(Id).
-write_error_context2(func(Id)) -->
- io__write_string("definition of function "),
- write_id(Id).
-write_error_context2(func_mode(Id)) -->
- io__write_string("mode declaration for function "),
- write_id(Id).
+write_error_context2(pred_or_func(PredOrFunc, SymName - Arity)) -->
+ io__write_string("definition of "),
+ io__write(PredOrFunc),
+ io__write_string(" "),
+ { adjust_func_arity(PredOrFunc, OrigArity, Arity) },
+ write_id(SymName - OrigArity).
+write_error_context2(pred_or_func_mode(PredOrFunc, SymName - Arity)) -->
+ io__write_string("mode declaration for "),
+ io__write(PredOrFunc),
+ io__write_string(" "),
+ { adjust_func_arity(PredOrFunc, OrigArity, Arity) },
+ write_id(SymName - OrigArity).
write_error_context2(lambda_expr) -->
io__write_string("mode declaration for lambda expression").
write_error_context2(clause_mode_annotation) -->
@@ -1452,10 +1406,19 @@
get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps),
set__list_to_set(ImportDeps `list__append` UseDeps, ImportedModules),
id_set_init(Empty),
+ globals__lookup_bool_option(Globals, smart_recompilation,
+ SmartRecompilation),
+ (
+ SmartRecompilation = no,
+ MaybeRecompInfo = no
+ ;
+ 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,
- may_be_unqualified).
+ may_be_unqualified, MaybeRecompInfo).
:- pred mq_info_get_imported_modules(mq_info::in, set(module_name)::out) is det.
:- pred mq_info_get_modules(mq_info::in, module_id_set::out) is det.
@@ -1486,6 +1449,7 @@
mq_info_get_report_error_flag(MQInfo, MQInfo^report_error_flag).
mq_info_get_error_context(MQInfo, MQInfo^error_context).
mq_info_get_need_qual_flag(MQInfo, MQInfo^need_qual_flag).
+mq_info_get_recompilation_info(Info, Info ^ maybe_recompilation_info).
:- pred mq_info_set_imported_modules(mq_info::in, set(module_name)::in,
mq_info::out) is det.
@@ -1518,20 +1482,28 @@
mq_info_set_mode_error_flag(MQInfo, MQInfo^mode_error_flag := yes).
mq_info_set_error_context(MQInfo, Context, MQInfo^error_context := Context).
mq_info_set_need_qual_flag(MQInfo, Flag, MQInfo^need_qual_flag := Flag).
+mq_info_set_recompilation_info(Info, RecompInfo,
+ Info ^ maybe_recompilation_info := RecompInfo).
:- pred mq_info_incr_errors(mq_info::in, mq_info::out) is det.
mq_info_incr_errors(MQInfo, MQInfo^num_errors := (MQInfo^num_errors +1)).
:- pred mq_info_set_error_flag(mq_info::in, id_type::in, mq_info::out) is det.
+
+mq_info_set_error_flag(Info0, IdType, Info) :-
+ mq_info_set_error_flag_2(Info0, IdType, Info).
+
+:- pred mq_info_set_error_flag_2(mq_info::in,
+ id_type::in, mq_info::out) is det.
-mq_info_set_error_flag(Info0, type_id, Info) :-
+mq_info_set_error_flag_2(Info0, type_id, Info) :-
mq_info_set_type_error_flag(Info0, Info).
-mq_info_set_error_flag(Info0, mode_id, Info) :-
+mq_info_set_error_flag_2(Info0, mode_id, Info) :-
mq_info_set_mode_error_flag(Info0, Info).
-mq_info_set_error_flag(Info0, inst_id, Info) :-
+mq_info_set_error_flag_2(Info0, inst_id, Info) :-
mq_info_set_mode_error_flag(Info0, Info).
-mq_info_set_error_flag(Info0, class_id, Info) :-
+mq_info_set_error_flag_2(Info0, class_id, Info) :-
mq_info_set_type_error_flag(Info0, Info).
% If the current item is in the interface, remove its module
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.165
diff -u -u -r1.165 modules.m
--- compiler/modules.m 2001/05/18 14:23:49 1.165
+++ compiler/modules.m 2001/05/23 14:41:03
@@ -40,7 +40,7 @@
:- interface.
:- import_module prog_data, prog_io, globals.
-:- import_module std_util, bool, list, set, io.
+:- import_module std_util, bool, list, map, set, io, time.
%-----------------------------------------------------------------------------%
@@ -121,8 +121,8 @@
%-----------------------------------------------------------------------------%
- % read_mod(ModuleName, Extension, Descr, Search, Items, Error,
- % SourceFileName):
+ % read_mod(ModuleName, Extension, Descr, Search, ReturnTimestamp,
+ % Items, Error, SourceFileName, MaybeTimestamp):
% Given a module name and a file extension (e.g. `.m',
% `.int', or `int2'), read in the list of items in that file.
% If Extension is ".m", and ModuleName is a nested module,
@@ -131,6 +131,8 @@
% `foo.bar.baz.m', then `bar.baz.m', then `baz.m'.
% If Search is yes, search all directories given by the option
% search_directories for the module.
+ % If ReturnTimestamp is yes, attempt to return the modification
+ % time of the file in MaybeTimestamp.
% If the actual module name (as determined by the
% `:- module' declaration) does not match the specified
% module name, then report an error message.
@@ -141,21 +143,33 @@
% If you want to read a module given the file name,
% use `read_mod_from_file'.
%
-:- pred read_mod(module_name, string, string, bool,
- item_list, module_error, file_name, io__state, io__state).
-:- mode read_mod(in, in, in, in, out, out, out, di, uo) is det.
+:- pred read_mod(module_name, string, string, bool, bool,
+ item_list, module_error, file_name, maybe(time_t),
+ io__state, io__state).
+:- mode read_mod(in, in, in, in, in, out, out, out, out, di, uo) is det.
+
+:- pred read_mod_if_changed(module_name, string, string, bool, time_t,
+ item_list, module_error, file_name, maybe(time_t),
+ io__state, io__state).
+:- mode read_mod_if_changed(in, in, in, in, in,
+ out, out, out, out, di, uo) is det.
% Similar to read_mod, but doesn't return error messages.
-:- pred read_mod_ignore_errors(module_name, string, string, bool,
- item_list, module_error, file_name, io__state, io__state).
-:- mode read_mod_ignore_errors(in, in, in, in, out, out, out, di, uo) is det.
+:- pred read_mod_ignore_errors(module_name, string, string, bool, bool,
+ item_list, module_error, file_name, maybe(time_t),
+ io__state, io__state).
+:- mode read_mod_ignore_errors(in, in, in, in, in, out, out, out, out,
+ di, uo) is det.
- % read_mod_from_file(SourceFileName, Extension, Descr, Search, Items,
- % Error, ModuleName):
+ % read_mod_from_file(SourceFileName, Extension, Descr, Search,
+ % ReturnTimestamp, Items, Error,
+ % ModuleName, MaybeTimestamp):
% Given a file name and a file extension (e.g. `.m',
% `.int', or `int2'), read in the list of items in that file.
% If Search is yes, search all directories given by the option
% search_directories for the module.
+ % If ReturnTimestamp is yes, attempt to return the modification
+ % time of the file in MaybeTimestamp.
% Return the module name (as determined by the
% `:- module' declaration, if any).
%
@@ -163,37 +177,44 @@
% If you want to read a module given the module name,
% use `read_mod'.
%
-:- pred read_mod_from_file(file_name, string, string, bool,
- item_list, module_error, module_name, io__state, io__state).
-:- mode read_mod_from_file(in, in, in, in, out, out, out, di, uo) is det.
+:- pred read_mod_from_file(file_name, string, string, bool, bool,
+ item_list, module_error, module_name, maybe(time_t),
+ io__state, io__state).
+:- mode read_mod_from_file(in, in, in, in, in, out, out, out, out,
+ di, uo) is det.
%-----------------------------------------------------------------------------%
- % make_private_interface(SourceFileName, ModuleName, Items):
+ % make_private_interface(SourceFileName, ModuleName,
+ % MaybeTimestamp, Items):
% Given a source file name and module name,
+ % the timestamp of the source file,
% and the list of items in that module,
% output the private (`.int0') interface file for the module.
% (The private interface contains all the declarations in
% the module, including those in the `implementation'
% section; it is used when compiling sub-modules.)
%
-:- pred make_private_interface(file_name, module_name, item_list,
- io__state, io__state).
-:- mode make_private_interface(in, in, in, di, uo) is det.
+:- pred make_private_interface(file_name, module_name, maybe(time_t),
+ item_list, io__state, io__state).
+:- mode make_private_interface(in, in, in, in, di, uo) is det.
- % make_interface(SourceFileName, ModuleName, Items):
+ % make_interface(SourceFileName, ModuleName, MaybeTimestamp, Items):
% Given a source file name and module name,
+ % the timestamp of the source file,
% and the list of items in that module,
% output the long (`.int') and short (`.int2') interface files
% for the module.
%
-:- pred make_interface(file_name, module_name, item_list, io__state, io__state).
-:- mode make_interface(in, in, in, di, uo) is det.
+:- pred make_interface(file_name, module_name, maybe(time_t),
+ item_list, io__state, io__state).
+:- mode make_interface(in, in, in, in, di, uo) is det.
% Output the unqualified short interface file to <module>.int3.
%
-:- pred make_short_interface(module_name, item_list, io__state, io__state).
-:- mode make_short_interface(in, in, di, uo) is det.
+:- pred make_short_interface(file_name, module_name, item_list,
+ io__state, io__state).
+:- mode make_short_interface(in, in, in, di, uo) is det.
%-----------------------------------------------------------------------------%
@@ -245,9 +266,14 @@
% foreign code
items :: item_list,
% The contents of the module and its imports
- error :: module_error
+ error :: module_error,
% Whether an error has been encountered
% when reading in this module.
+
+ maybe_timestamps :: maybe(module_timestamps)
+ % If we are doing smart recompilation,
+ % we need to keep the timestamps of the
+ % modules read in.
).
:- type contains_foreign_code
@@ -255,6 +281,38 @@
; no_foreign_code
; unknown.
+ % When doing smart recompilation record for each module
+ % the suffix of the file that was read and the modification
+ % time of the file.
+:- type module_timestamps == map(module_name, module_timestamp).
+:- type module_timestamp
+ ---> module_timestamp(
+ suffix :: string,
+ timestamp :: time_t,
+ need_qualifier :: need_qualifier
+ ).
+
+ % recompilation_check.m records each file read to avoid
+ % reading it again. The string is the suffix of the file
+ % name.
+:- type read_modules == map(pair(module_name, string), read_module).
+
+:- type read_module
+ ---> read_module(
+ module_timestamp,
+ item_list,
+ module_error,
+ file_name
+ ).
+
+ % find_read_module(ReadModules, ModuleName, Suffix, ReturnTimestamp,
+ % Items, MaybeTimestamp, Error, FileName)
+ %
+ % Check whether a file was read during recompilation checking.
+:- pred find_read_module(read_modules, module_name, string, bool, item_list,
+ maybe(time_t), module_error, file_name).
+:- mode find_read_module(in, in, in, in, out, out, out, out) is semidet.
+
% Some access predicates for the module_imports structure
:- pred module_imports_get_source_file_name(module_imports, file_name).
@@ -307,6 +365,11 @@
:- pred append_pseudo_decl(module_imports, module_defn, 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.
+
%-----------------------------------------------------------------------------%
% Given a module (well, a list of items), split it into
@@ -322,8 +385,8 @@
%-----------------------------------------------------------------------------%
- % grab_imported_modules(SourceFileName, ModuleName,
- % Items, Module, Error)
+ % grab_imported_modules(SourceFileName, ModuleName, ReadModules,
+ % ModuleTimestamp, Items, Module, Error)
% Given a source file name and module name,
% and the list of items in that module,
% read in the private interface files for all the parent modules,
@@ -331,10 +394,13 @@
% and the short interface files for all the indirectly imported
% modules, and return a `module_imports' structure containing the
% relevant information.
+ % ReadModules contains the interface files read during
+ % recompilation checking.
%
-:- pred grab_imported_modules(file_name, module_name, item_list, module_imports,
- module_error, io__state, io__state).
-:- mode grab_imported_modules(in, in, in, out, out, di, uo) is det.
+:- pred grab_imported_modules(file_name, module_name, read_modules,
+ maybe(time_t), item_list, module_imports,
+ module_error, io__state, io__state).
+:- mode grab_imported_modules(in, in, in, in, in, out, out, di, uo) is det.
% grab_unqual_imported_modules(SourceFileName, ModuleName,
% Items, Module, Error):
@@ -350,21 +416,23 @@
module_imports, module_error, io__state, io__state).
:- mode grab_unqual_imported_modules(in, in, in, out, out, di, uo) is det.
- % process_module_long_interfaces(Imports, Ext, IndirectImports0,
- % IndirectImports, Module0, Module):
+ % process_module_long_interfaces(ReadModules, NeedQualifier, Imports,
+ % Ext, IndirectImports0, IndirectImports, Module0, 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.
%
-:- pred process_module_long_interfaces(list(module_name), string,
- list(module_name), list(module_name),
- module_imports, module_imports,
+:- 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, out, in, out, di, uo) is det.
+:- mode process_module_long_interfaces(in, in, in, in, in, out, in, out,
+ di, uo) is det.
- % process_module_indirect_imports(IndirectImports, Ext,
+ % process_module_indirect_imports(ReadModules, IndirectImports, Ext,
% Module0, Module):
% Read the short interfaces for modules in IndirectImports
% (unless they've already been read in) and any
@@ -373,33 +441,34 @@
% Put them all in a `:- used.' section, where the section
% is assumed to be in the interface.
%
-:- pred process_module_indirect_imports(list(module_name), string,
- module_imports, module_imports, io__state, io__state).
-:- mode process_module_indirect_imports(in, in, in, out, di, uo)
+:- pred process_module_indirect_imports(read_modules, list(module_name),
+ string, module_imports, module_imports, io__state, io__state).
+:- mode process_module_indirect_imports(in, in, in, in, out, di, uo)
is det.
- % process_module_short_interfaces_transitively(IndirectImports, Ext,
- % Module0, Module):
+ % process_module_short_interfaces_transitively(ReadModules,
+ % IndirectImports, Ext, Module0, Module):
% Read the short interfaces for modules in IndirectImports
% (unless they've already been read in) and any
% modules that those modules import (transitively).
%
-:- pred process_module_short_interfaces_transitively(list(module_name),
- string, module_imports, module_imports, io__state, io__state).
-:- mode process_module_short_interfaces_transitively(in, in, in, out, di, uo)
- is det.
+:- pred process_module_short_interfaces_transitively(read_modules,
+ list(module_name), string, module_imports, module_imports,
+ io__state, io__state).
+:- mode process_module_short_interfaces_transitively(in, in, in, in,
+ out, di, uo) is det.
- % process_module_short_interfaces(Modules, Ext,
+ % process_module_short_interfaces(ReadModules, Modules, Ext,
% IndirectImports0, IndirectImports, Module0, 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.
%
-:- pred process_module_short_interfaces(list(module_name), string,
- list(module_name), list(module_name),
+:- pred process_module_short_interfaces(read_modules, list(module_name),
+ string, list(module_name), list(module_name),
module_imports, module_imports, io__state, io__state).
-:- mode process_module_short_interfaces(in, in, in, out, in, out, di, uo)
+:- mode process_module_short_interfaces(in, in, in, in, out, in, out, di, uo)
is det.
%-----------------------------------------------------------------------------%
@@ -525,10 +594,11 @@
:- implementation.
:- import_module llds_out, passes_aux, prog_out, prog_util, mercury_to_mercury.
:- import_module prog_io_util, options, module_qual.
+:- import_module recompilation_version.
:- import_module string, map, term, varset, dir, library.
:- import_module assoc_list, relation, char, require.
-:- import_module getopt, term, varset.
+:- import_module getopt.
%-----------------------------------------------------------------------------%
@@ -803,7 +873,7 @@
% Read in the .int3 files that the current module depends on,
% and use these to qualify all the declarations
% as much as possible. Then write out the .int0 file.
-make_private_interface(SourceFileName, ModuleName, Items0) -->
+make_private_interface(SourceFileName, ModuleName, MaybeTimestamp, Items0) -->
grab_unqual_imported_modules(SourceFileName, ModuleName, Items0,
Module, Error),
%
@@ -841,7 +911,8 @@
)
), Items4, Items) },
- write_interface_file(ModuleName, ".int0", Items),
+ write_interface_file(SourceFileName, ModuleName,
+ ".int0", MaybeTimestamp, Items),
touch_interface_datestamp(ModuleName, ".date0")
)
).
@@ -849,7 +920,7 @@
% Read in the .int3 files that the current module depends on,
% and use these to qualify all items in the interface as much as
% possible. Then write out the .int and .int2 files.
-make_interface(SourceFileName, ModuleName, Items0) -->
+make_interface(SourceFileName, ModuleName, MaybeTimestamp, Items0) -->
{ get_interface(Items0, InterfaceItems0) },
%
% Get the .int3 files for imported modules
@@ -894,19 +965,19 @@
check_for_clauses_in_interface(InterfaceItems4,
InterfaceItems),
check_int_for_no_exports(InterfaceItems, ModuleName),
- write_interface_file(ModuleName, ".int",
- InterfaceItems),
+ write_interface_file(SourceFileName, ModuleName,
+ ".int", MaybeTimestamp, InterfaceItems),
{ get_short_interface(InterfaceItems, int2,
ShortInterfaceItems) },
- write_interface_file(ModuleName, ".int2",
- ShortInterfaceItems),
+ write_interface_file(SourceFileName, ModuleName,
+ ".int2", MaybeTimestamp, ShortInterfaceItems),
touch_interface_datestamp(ModuleName, ".date")
)
).
% This qualifies everything as much as it can given the
% information in the current module and writes out the .int3 file.
-make_short_interface(ModuleName, Items0) -->
+make_short_interface(SourceFileName, ModuleName, Items0) -->
{ get_interface(Items0, InterfaceItems0) },
% assertions are also stripped since they should
% only be written to .opt files,
@@ -915,7 +986,8 @@
{ get_short_interface(InterfaceItems, int3, ShortInterfaceItems0) },
module_qual__module_qualify_items(ShortInterfaceItems0,
ShortInterfaceItems, ModuleName, no, _, _, _, _),
- write_interface_file(ModuleName, ".int3", ShortInterfaceItems),
+ write_interface_file(SourceFileName, ModuleName, ".int3",
+ no, ShortInterfaceItems),
touch_interface_datestamp(ModuleName, ".date3").
%-----------------------------------------------------------------------------%
@@ -956,9 +1028,7 @@
check_for_clauses_in_interface([ItemAndContext0 | Items0], Items) -->
{ ItemAndContext0 = Item0 - Context },
(
- ( { Item0 = pred_clause(_,_,_,_) }
- ; { Item0 = func_clause(_,_,_,_,_) }
- )
+ { Item0 = clause(_,_,_,_,_) }
->
prog_out__write_context(Context),
report_warning("Warning: clause in module interface.\n"),
@@ -1003,8 +1073,7 @@
->
split_clauses_and_decls(Items0, ClauseItems, InterfaceItems)
;
- ( Item0 = pred_clause(_,_,_,_)
- ; Item0 = func_clause(_,_,_,_,_)
+ ( Item0 = clause(_,_,_,_,_)
; Item0 = pragma(Pragma),
pragma_allowed_in_interface(Pragma, no)
)
@@ -1041,7 +1110,7 @@
pragma_allowed_in_interface(promise_pure(_, _), no).
pragma_allowed_in_interface(promise_semipure(_, _), no).
pragma_allowed_in_interface(unused_args(_, _, _, _, _), no).
-pragma_allowed_in_interface(type_spec(_, _, _, _, _, _, _), yes).
+pragma_allowed_in_interface(type_spec(_, _, _, _, _, _, _, _), yes).
pragma_allowed_in_interface(termination_info(_, _, _, _, _), yes).
pragma_allowed_in_interface(terminates(_, _), yes).
pragma_allowed_in_interface(does_not_terminate(_, _), yes).
@@ -1079,7 +1148,7 @@
warn_no_exports(ModuleName).
check_int_for_no_exports([Item - _Context | Items], ModuleName) -->
(
- { Item = nothing
+ { Item = nothing(_)
; Item = module_defn(_, ModuleDefn),
ModuleDefn \= include_module(_)
}
@@ -1125,29 +1194,70 @@
).
%-----------------------------------------------------------------------------%
-
-:- pred write_interface_file(module_name, string, item_list,
- io__state, io__state).
-:- mode write_interface_file(in, in, in, di, uo) is det.
-write_interface_file(ModuleName, Suffix, InterfaceItems) -->
+:- pred write_interface_file(file_name, module_name, string, maybe(time_t),
+ item_list, io__state, io__state).
+:- mode write_interface_file(in, in, in, in, in, di, uo) is det.
- % create (e.g.) `foo.int.tmp'
+write_interface_file(SourceFileName, ModuleName, Suffix,
+ MaybeTimestamp, InterfaceItems0) -->
+ % Create (e.g.) `foo.int.tmp'.
{ string__append(Suffix, ".tmp", TmpSuffix) },
module_name_to_file_name(ModuleName, Suffix, yes, OutputFileName),
module_name_to_file_name(ModuleName, TmpSuffix, no, TmpOutputFileName),
+
+ globals__io_lookup_bool_option(line_numbers, LineNumbers),
+ globals__io_set_option(line_numbers, bool(no)),
+
+ globals__io_lookup_bool_option(generate_item_version_numbers,
+ GenerateVersionNumbers),
+
+ ( { GenerateVersionNumbers = yes } ->
+ % Find the timestamp of the current module.
+ (
+ { MaybeTimestamp = yes(Timestamp) },
+
+ % Read in the previous version of the file.
+ read_mod_ignore_errors(ModuleName, Suffix,
+ "Reading old interface for module", yes, no,
+ OldItems0, OldError, _OldIntFileName,
+ _OldTimestamp),
+ ( { OldError = no } ->
+ { strip_off_interface_decl(OldItems0,
+ OldItems) },
+ { MaybeOldItems = yes(OldItems) }
+ ;
+ % If we can't read in the old file, the
+ % timestamps will all be set to the
+ % modification time of the source file.
+ { MaybeOldItems = no }
+ ),
+ { recompilation_version__compute_version_numbers(
+ Timestamp, InterfaceItems0, MaybeOldItems,
+ VersionNumbers) },
+ { VersionNumberItem = module_defn(VarSet,
+ version_numbers(ModuleName, VersionNumbers))
+ - Context },
+ { InterfaceItems1 =
+ [VersionNumberItem | InterfaceItems0] }
+ ;
+ { MaybeTimestamp = no },
+ { InterfaceItems1 = InterfaceItems0 },
+ report_modification_time_warning(SourceFileName)
+ )
+ ;
+ { InterfaceItems1 = InterfaceItems0 }
+ ),
- % we need to add a `:- interface' declaration at the start
- % of the item list
+ % Add a `:- interface' declaration at the start
+ % of the item list.
{ varset__init(VarSet) },
{ term__context_init(Context) },
{ InterfaceDeclaration = module_defn(VarSet, interface) - Context },
- { InterfaceItems1 = [InterfaceDeclaration | InterfaceItems] },
+ { InterfaceItems = [InterfaceDeclaration | InterfaceItems1] },
- globals__io_lookup_bool_option(line_numbers, LineNumbers),
- globals__io_set_option(line_numbers, bool(no)),
- convert_to_mercury(ModuleName, TmpOutputFileName, InterfaceItems1),
+ convert_to_mercury(ModuleName, TmpOutputFileName, InterfaceItems),
globals__io_set_option(line_numbers, bool(LineNumbers)),
update_interface(OutputFileName).
@@ -1198,7 +1308,8 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-grab_imported_modules(SourceFileName, ModuleName, Items0, Module, Error) -->
+grab_imported_modules(SourceFileName, ModuleName, ReadModules, MaybeTimestamp,
+ Items0, Module, Error) -->
%
% Find out which modules this one depends on
%
@@ -1222,8 +1333,15 @@
{ get_fact_table_dependencies(Items0, FactDeps) },
{ get_interface(Items0, InterfaceItems) },
{ get_children(InterfaceItems, PublicChildren) },
+ { MaybeTimestamp = yes(Timestamp) ->
+ MaybeTimestamps = yes(map__det_insert(map__init, ModuleName,
+ module_timestamp(".m", Timestamp, may_be_unqualified)))
+ ;
+ MaybeTimestamps = no
+
+ },
{ init_module_imports(SourceFileName, ModuleName, Items0,
- PublicChildren, FactDeps, Module0) },
+ PublicChildren, FactDeps, MaybeTimestamps, Module0) },
% If this module has any seperately-compiled sub-modules,
% then we need to make everything in this module
@@ -1255,40 +1373,44 @@
IntImportedModules2, IntUsedModules2) },
% Process the ancestor modules
- process_module_private_interfaces(AncestorModules,
+ process_module_private_interfaces(ReadModules, AncestorModules,
IntImportedModules2, IntImportedModules,
IntUsedModules2, IntUsedModules,
Module2, Module3),
% Process the modules imported using `import_module'.
{ IntIndirectImports0 = [] },
- process_module_long_interfaces(IntImportedModules, ".int",
- IntIndirectImports0, IntIndirectImports1, Module3, Module4),
+ process_module_long_interfaces(ReadModules, may_be_unqualified,
+ IntImportedModules, ".int", IntIndirectImports0,
+ IntIndirectImports1, Module3, Module4),
{ append_pseudo_decl(Module4, imported(implementation), Module5) },
{ ImpIndirectImports0 = [] },
- process_module_long_interfaces(ImpImportedModules, ".int",
- ImpIndirectImports0, ImpIndirectImports1, Module5, Module6),
+ process_module_long_interfaces(ReadModules, may_be_unqualified,
+ ImpImportedModules, ".int", ImpIndirectImports0,
+ ImpIndirectImports1, Module5, Module6),
% Process the modules imported using `use_module' .
{ append_pseudo_decl(Module6, used(interface), Module7) },
- process_module_long_interfaces(IntUsedModules, ".int",
- IntIndirectImports1, IntIndirectImports, Module7, Module8),
+ process_module_long_interfaces(ReadModules, must_be_qualified,
+ IntUsedModules, ".int", IntIndirectImports1,
+ IntIndirectImports, Module7, Module8),
{ append_pseudo_decl(Module8, used(implementation), Module9) },
- process_module_long_interfaces(ImpUsedModules, ".int",
- ImpIndirectImports1, ImpIndirectImports, Module9, Module10),
+ process_module_long_interfaces(ReadModules, must_be_qualified,
+ ImpUsedModules, ".int", ImpIndirectImports1,
+ ImpIndirectImports, Module9, Module10),
% Process the short interfaces for indirectly imported modules.
% The short interfaces are treated as if
% they are imported using `use_module'.
{ append_pseudo_decl(Module10, transitively_imported, Module11) },
{ append_pseudo_decl(Module11, used(interface), Module12) },
- process_module_short_interfaces_transitively(IntIndirectImports,
- ".int2", Module12, Module13),
+ process_module_short_interfaces_transitively(ReadModules,
+ IntIndirectImports, ".int2", Module12, Module13),
{ append_pseudo_decl(Module13, used(implementation), Module14) },
- process_module_short_interfaces_transitively(ImpIndirectImports,
- ".int2", Module14, Module),
+ process_module_short_interfaces_transitively(ReadModules,
+ ImpIndirectImports, ".int2", Module14, Module),
{ module_imports_get_error(Module, Error) }.
@@ -1310,7 +1432,7 @@
% and append a `:- imported' decl to the items.
%
{ init_module_imports(SourceFileName, ModuleName, Items0, [], [],
- Module0) },
+ no, Module0) },
{ append_pseudo_decl(Module0, imported(interface), Module1) },
% Add `builtin' and `private_builtin' to the imported modules.
@@ -1321,58 +1443,73 @@
%
% Get the .int3s and .int0s that the current module depends on.
%
+ { map__init(ReadModules) },
% first the .int0s for parent modules
- process_module_private_interfaces(ParentDeps,
+ process_module_private_interfaces(ReadModules, ParentDeps,
IntImportDeps1, IntImportDeps, IntUseDeps1, IntUseDeps,
Module1, Module2),
% then the .int3s for `:- import'-ed modules
- process_module_long_interfaces(IntImportDeps, ".int3",
- [], IntIndirectImportDeps0, Module2, Module3),
+ process_module_long_interfaces(ReadModules, may_be_unqualified,
+ IntImportDeps, ".int3", [],
+ IntIndirectImportDeps0, Module2, Module3),
{ append_pseudo_decl(Module3, imported(implementation), Module4) },
- process_module_private_interfaces(ParentDeps,
+ process_module_private_interfaces(ReadModules, ParentDeps,
ImpImportDeps0, ImpImportDeps, ImpUseDeps0, ImpUseDeps,
Module4, Module5),
- process_module_long_interfaces(ImpImportDeps, ".int3",
- [], ImpIndirectImportDeps0, Module5, Module6),
+ process_module_long_interfaces(ReadModules, may_be_unqualified,
+ ImpImportDeps, ".int3", [], ImpIndirectImportDeps0,
+ Module5, Module6),
% then (after appropriate `:- used' decls)
% the .int3s for `:- use'-ed modules
{ append_pseudo_decl(Module6, used(interface), Module7) },
- process_module_long_interfaces(IntUseDeps, ".int3",
- IntIndirectImportDeps0, IntIndirectImportDeps,
- Module7, Module8),
+ process_module_long_interfaces(ReadModules, must_be_qualified,
+ IntUseDeps, ".int3", IntIndirectImportDeps0,
+ IntIndirectImportDeps, Module7, Module8),
{ append_pseudo_decl(Module8, used(implementation), Module9) },
- process_module_long_interfaces(ImpUseDeps, ".int3",
- ImpIndirectImportDeps0, ImpIndirectImportDeps,
- Module9, Module10),
+ process_module_long_interfaces(ReadModules, must_be_qualified,
+ ImpUseDeps, ".int3", ImpIndirectImportDeps0,
+ ImpIndirectImportDeps, Module9, Module10),
% then (after appropriate `:- used' decl)
% the .int3s for indirectly imported modules
{ append_pseudo_decl(Module10, used(interface), Module11) },
- process_module_short_interfaces_transitively(
+ process_module_short_interfaces_transitively(ReadModules,
IntIndirectImportDeps, ".int3", Module11, Module12),
{ append_pseudo_decl(Module12, used(implementation), Module13) },
- process_module_short_interfaces_transitively(
+ process_module_short_interfaces_transitively(ReadModules,
ImpIndirectImportDeps, ".int3", Module13, Module),
{ module_imports_get_error(Module, Error) }.
%-----------------------------------------------------------------------------%
+find_read_module(ReadModules, ModuleName, Suffix, ReturnTimestamp,
+ Items, MaybeTimestamp, Error, FileName) :-
+ map__search(ReadModules, ModuleName - Suffix, ReadModule),
+ ReadModule = read_module(ModuleTimestamp, Items, Error, FileName),
+ ( ReturnTimestamp = yes ->
+ ModuleTimestamp = module_timestamp(_, Timestamp, _),
+ MaybeTimestamp = yes(Timestamp)
+ ;
+ MaybeTimestamp = no
+ ).
+
:- pred init_module_imports(file_name, module_name, item_list,
- list(module_name), list(string), module_imports).
-:- mode init_module_imports(in, in, in, in, in, out) is det.
+ list(module_name), list(string),
+ maybe(module_timestamps), module_imports).
+:- mode init_module_imports(in, in, in, in, in, in, out) is det.
init_module_imports(SourceFileName, ModuleName, Items, PublicChildren,
- FactDeps, Module) :-
+ FactDeps, MaybeTimestamps, Module) :-
Module = module_imports(SourceFileName, ModuleName, [], [], [], [],
- PublicChildren, FactDeps, unknown, Items, no).
+ PublicChildren, FactDeps, unknown, Items, no, MaybeTimestamps).
module_imports_get_source_file_name(Module, Module ^ source_file_name).
module_imports_get_module_name(Module, Module ^ module_name).
@@ -1594,7 +1731,7 @@
write_dependency_file(Module, AllDepsSet, MaybeTransOptDeps) -->
{ Module = module_imports(SourceFileName, ModuleName, ParentDeps,
IntDeps, ImplDeps, IndirectDeps, _InclDeps, FactDeps0,
- _ContainsForeignCode, _Items, _Error) },
+ _ContainsForeignCode, _Items, _Error, _Timestamps) },
globals__io_lookup_bool_option(verbose, Verbose),
{ module_name_to_make_var_name(ModuleName, MakeVarName) },
module_name_to_file_name(ModuleName, ".d", yes, DependencyFileName),
@@ -1922,17 +2059,14 @@
"\n",
"\t$(MCTOI) $(ALL_MCTOIFLAGS) $<\n",
CFileName, " : ", SourceFileName, "\n",
- "\trm -f ", CFileName, "\n",
"\t$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) ",
"$< > ", ErrFileName, " 2>&1\n",
"ifeq ($(TARGET_ASM),yes)\n",
AsmFileName, " : ", SourceFileName, "\n",
- "\trm -f ", AsmFileName, "\n",
"\t$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) ",
"--target-code-only $< > ", ErrFileName,
" 2>&1\n",
PicAsmFileName, " : ", SourceFileName, "\n",
- "\trm -f ", PicAsmFileName, "\n",
"\t$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) ",
"--target-code-only --pic ",
"\\\n",
@@ -1941,12 +2075,10 @@
" 2>&1\n",
"endif # TARGET_ASM\n",
ILFileName, " : ", SourceFileName, "\n",
- "\trm -f ", ILFileName, "\n",
"\t$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) ",
"--il-only $< > ", ErrFileName,
" 2>&1\n",
RLOFileName, " : ", SourceFileName, "\n",
- "\trm -f ", RLOFileName, "\n",
"\t$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) ",
"--aditi-only $< > ", ErrFileName,
" 2>&1\n"
@@ -2202,8 +2334,8 @@
generate_file_dependencies(FileName) -->
% read in the top-level file (to figure out its module name)
- read_mod_from_file(FileName, ".m", "Reading file", no,
- Items, Error, ModuleName),
+ read_mod_from_file(FileName, ".m", "Reading file", no, no,
+ Items, Error, ModuleName, _),
{ string__append(FileName, ".m", SourceFileName) },
split_into_submodules(ModuleName, Items, SubModuleList),
globals__io_get_globals(Globals),
@@ -2751,6 +2883,12 @@
io__write_string(DepStream, "\n"),
io__write_string(DepStream, MakeVarName),
+ io__write_string(DepStream, ".useds = "),
+ write_compact_dependencies_list(Modules, "$(useds_subdir)", ".used",
+ Basis, DepStream),
+ io__write_string(DepStream, "\n"),
+
+ io__write_string(DepStream, MakeVarName),
io__write_string(DepStream, ".ils = "),
write_compact_dependencies_list(Modules, "$(ils_subdir)", ".il",
Basis, DepStream),
@@ -3209,6 +3347,7 @@
"\t-rm -f $(", MakeVarName, ".os) ", InitObjFileName, "\n",
"\t-rm -f $(", MakeVarName, ".pic_os) ", InitPicObjFileName,
"\n",
+ "\t-rm -f $(", MakeVarName, ".useds)\n",
"\t-rm -f $(", MakeVarName, ".ils)\n",
"\t-rm -f $(", MakeVarName, ".profs)\n",
"\t-rm -f $(", MakeVarName, ".errs)\n",
@@ -3555,12 +3694,12 @@
read_dependencies(ModuleName, Search, ModuleImportsList) -->
read_mod_ignore_errors(ModuleName, ".m",
- "Getting dependencies for module", Search, Items0, Error,
- FileName0),
+ "Getting dependencies for module", Search, no, Items0, Error,
+ FileName0, _),
( { Items0 = [], Error = fatal } ->
read_mod_ignore_errors(ModuleName, ".int",
- "Getting dependencies for module interface", Search,
- Items, _Error, FileName),
+ "Getting dependencies for module interface", Search, no,
+ Items, _Error, FileName, _),
{ SubModuleList = [ModuleName - Items] }
;
{ FileName = FileName0 },
@@ -3616,27 +3755,56 @@
ModuleImports = module_imports(FileName, ModuleName, ParentDeps,
InterfaceDeps, ImplementationDeps, IndirectDeps, IncludeDeps,
- FactTableDeps, ContainsForeignCode, [], Error).
+ FactTableDeps, ContainsForeignCode, [], Error, no).
%-----------------------------------------------------------------------------%
-read_mod(ModuleName, Extension, Descr, Search, Items, Error, FileName) -->
+:- pred read_mod(read_modules, module_name, string, string, bool, bool,
+ item_list, module_error, file_name, maybe(time_t),
+ io__state, io__state).
+:- mode read_mod(in, in, in, in, in, in, out, out, out, out, di, uo) is det.
+
+read_mod(ReadModules, ModuleName, Extension, Descr, Search, ReturnTimestamp,
+ Items, Error, FileName, MaybeTimestamp) -->
+ (
+ { find_read_module(ReadModules, ModuleName, Extension,
+ ReturnTimestamp, Items0, MaybeTimestamp0,
+ Error0, FileName0) }
+ ->
+ { Error = Error0 },
+ { Items = Items0 },
+ { MaybeTimestamp = MaybeTimestamp0 },
+ { FileName = FileName0 }
+ ;
+ read_mod(ModuleName, Extension, Descr, Search, ReturnTimestamp,
+ Items, Error, FileName, MaybeTimestamp)
+ ).
+
+read_mod(ModuleName, Extension, Descr, Search, ReturnTimestamp,
+ Items, Error, FileName, MaybeTimestamp) -->
+ read_mod_2(no, ModuleName, ModuleName, Extension, Descr, Search,
+ no, ReturnTimestamp, Items, Error, FileName, MaybeTimestamp).
+
+read_mod_if_changed(ModuleName, Extension, Descr, Search, OldTimestamp,
+ Items, Error, FileName, MaybeTimestamp) -->
read_mod_2(no, ModuleName, ModuleName, Extension, Descr, Search,
- Items, Error, FileName).
+ yes(OldTimestamp), yes, Items, Error,
+ FileName, MaybeTimestamp).
-read_mod_ignore_errors(ModuleName, Extension, Descr, Search,
- Items, Error, FileName) -->
+read_mod_ignore_errors(ModuleName, Extension, Descr, Search, ReturnTimestamp,
+ Items, Error, FileName, MaybeTimestamp) -->
read_mod_2(yes, ModuleName, ModuleName, Extension, Descr, Search,
- Items, Error, FileName).
+ no, ReturnTimestamp, Items, Error, FileName, MaybeTimestamp).
:- pred read_mod_2(bool, module_name, module_name, string, string,
- bool, item_list, module_error, file_name,
- io__state, io__state).
-:- mode read_mod_2(in, in, in, in, in, in, out, out, out, di, uo)
- is det.
+ bool, maybe(time_t), bool, item_list, module_error,
+ file_name, maybe(time_t), io__state, io__state).
+:- mode read_mod_2(in, in, in, in, in, in, in, in, out, out, out, out,
+ di, uo) is det.
read_mod_2(IgnoreErrors, ModuleName, PartialModuleName,
- Extension, Descr, Search, Items, Error, FileName) -->
+ Extension, Descr, Search, MaybeOldTimestamp,
+ ReturnTimestamp, Items, Error, FileName, MaybeTimestamp) -->
module_name_to_file_name(PartialModuleName, Extension, no, FileName0),
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
maybe_write_string(VeryVerbose, "% "),
@@ -3645,8 +3813,15 @@
maybe_write_string(VeryVerbose, FileName0),
maybe_write_string(VeryVerbose, "'... "),
maybe_flush_output(VeryVerbose),
- prog_io__read_module(FileName0, ModuleName, Search,
- Error0, ActualModuleName, Messages, Items0),
+ ( { MaybeOldTimestamp = yes(OldTimestamp) } ->
+ prog_io__read_module_if_changed(FileName0, ModuleName, Search,
+ OldTimestamp, Error0, ActualModuleName,
+ Messages, Items0, MaybeTimestamp0)
+ ;
+ prog_io__read_module(FileName0, ModuleName, Search,
+ ReturnTimestamp, Error0, ActualModuleName,
+ Messages, Items0, MaybeTimestamp0)
+ ),
check_module_has_expected_name(FileName0,
ModuleName, ActualModuleName),
%
@@ -3663,7 +3838,9 @@
maybe_write_string(VeryVerbose, "not found...\n"),
{ drop_one_qualifier(Parent, Child, PartialModuleName2) },
read_mod_2(IgnoreErrors, ModuleName, PartialModuleName2,
- Extension, Descr, Search, Items, Error, FileName)
+ Extension, Descr, Search, MaybeOldTimestamp,
+ ReturnTimestamp, Items, Error, FileName,
+ MaybeTimestamp)
;
( { IgnoreErrors = yes } ->
(
@@ -3685,17 +3862,27 @@
io__set_exit_status(1)
;
maybe_write_string(VeryVerbose,
- "successful parse.\n")
+ "successful parse.\n"),
+ (
+ { ReturnTimestamp = yes },
+ { MaybeTimestamp = no }
+ ->
+ report_modification_time_warning(
+ FileName)
+ ;
+ []
+ )
),
prog_out__write_messages(Messages)
),
{ Error = Error0 },
{ Items = Items0 },
+ { MaybeTimestamp = MaybeTimestamp0 },
{ FileName = FileName0 }
).
-read_mod_from_file(FileName, Extension, Descr, Search,
- Items, Error, ModuleName) -->
+read_mod_from_file(FileName, Extension, Descr, Search, ReturnTimestamp,
+ Items, Error, ModuleName, MaybeTimestamp) -->
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
maybe_write_string(VeryVerbose, "% "),
maybe_write_string(VeryVerbose, Descr),
@@ -3707,7 +3894,8 @@
{ dir__basename(FileName, BaseFileName) },
{ file_name_to_module_name(BaseFileName, DefaultModuleName) },
prog_io__read_module(FullFileName, DefaultModuleName, Search,
- Error, ModuleName, Messages, Items),
+ ReturnTimestamp, Error, ModuleName, Messages, Items,
+ MaybeTimestamp),
( { Error = fatal } ->
maybe_write_string(VeryVerbose, "fatal error(s).\n"),
io__set_exit_status(1)
@@ -3739,16 +3927,16 @@
% and append any imports/uses in the ancestors to the
% corresponding previous lists.
-:- pred process_module_private_interfaces(list(module_name),
+:- pred process_module_private_interfaces(read_modules, list(module_name),
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, out, in, out, in, out,
+:- mode process_module_private_interfaces(in, in, in, out, in, out, in, out,
di, uo) is det.
-process_module_private_interfaces([], DirectImports, DirectImports,
+process_module_private_interfaces(_, [], DirectImports, DirectImports,
DirectUses, DirectUses, Module, Module) --> [].
-process_module_private_interfaces([Ancestor | Ancestors],
+process_module_private_interfaces(ReadModules, [Ancestor | Ancestors],
DirectImports0, DirectImports, DirectUses0, DirectUses,
Module0, Module) -->
{ ModuleName = Module0 ^ module_name },
@@ -3761,16 +3949,26 @@
{ list__member(Ancestor, ModAncestors0) }
->
% we've already read it
- process_module_private_interfaces(Ancestors,
+ process_module_private_interfaces(ReadModules, Ancestors,
DirectImports0, DirectImports,
DirectUses0, DirectUses,
Module0, Module)
;
{ ModItems0 = Module0 ^ items },
{ ModError0 = Module0 ^ error },
- read_mod(Ancestor, ".int0",
- "Reading private interface for module", yes,
- PrivateIntItems, PrivateIntError, _AncestorFileName),
+ { Module0 ^ maybe_timestamps = yes(_) ->
+ ReturnTimestamp = yes
+ ;
+ ReturnTimestamp = no
+ },
+ read_mod(ReadModules, Ancestor, ".int0",
+ "Reading private interface for module", yes,
+ ReturnTimestamp, PrivateIntItems, PrivateIntError,
+ AncestorFileName, MaybeTimestamp),
+
+ maybe_record_timestamp(Ancestor, ".int0", may_be_unqualified,
+ AncestorFileName, MaybeTimestamp, Module0, Module1),
+
{ strip_off_interface_decl(PrivateIntItems, Items) },
{ maybe_add_int_error(PrivateIntError, ModError0, ModError) },
@@ -3787,20 +3985,20 @@
DirectImports1) },
{ list__append(DirectUses0, AncDirectUses, DirectUses1) },
{ list__append(ModItems0, Items, ModItems) },
- { Module1 = ((Module0 ^ items := ModItems)
+ { Module2 = ((Module1 ^ items := ModItems)
^ parent_deps := ModAncestors)
^ error := ModError },
- process_module_private_interfaces(Ancestors, DirectImports1,
- DirectImports, DirectUses1, DirectUses,
- Module1, Module)
+ process_module_private_interfaces(ReadModules, Ancestors,
+ DirectImports1, DirectImports, DirectUses1,
+ DirectUses, Module2, Module)
).
%-----------------------------------------------------------------------------%
-process_module_long_interfaces([], _Ext, IndirectImports, IndirectImports,
- Module, Module) --> [].
-process_module_long_interfaces([Import | Imports], Ext, IndirectImports0,
- IndirectImports, Module0, Module) -->
+process_module_long_interfaces(_, _, [], _Ext,
+ IndirectImports, IndirectImports, Module, Module) --> [].
+process_module_long_interfaces(ReadModules, NeedQualifier, [Import | Imports],
+ Ext, IndirectImports0, IndirectImports, Module0, Module) -->
{ ModuleName = Module0 ^ module_name },
{ ModImplementationImports0 = Module0 ^ impl_deps },
(
@@ -3811,15 +4009,22 @@
; { list__member(Import, ModImplementationImports0) }
)
->
- process_module_long_interfaces(Imports, Ext,
- IndirectImports0, IndirectImports,
- Module0, Module)
+ process_module_long_interfaces(ReadModules, NeedQualifier,
+ Imports, Ext, IndirectImports0, IndirectImports,
+ Module0, Module)
;
{ ModItems0 = Module0 ^ items },
{ ModError0 = Module0 ^ error },
- read_mod(Import, Ext,
- "Reading interface for module", yes,
- LongIntItems, LongIntError, _LongIntFileName),
+ { Module0 ^ maybe_timestamps = yes(_) ->
+ ReturnTimestamp = yes
+ ;
+ ReturnTimestamp = no
+ },
+ read_mod(ReadModules, Import, Ext,
+ "Reading interface for module", yes, ReturnTimestamp,
+ LongIntItems, LongIntError, LongIntFileName,
+ MaybeTimestamp),
+
{ strip_off_interface_decl(LongIntItems, Items) },
{ maybe_add_int_error(LongIntError, ModError0, ModError) },
@@ -3827,8 +4032,13 @@
maybe_report_stats(Statistics),
( { LongIntError = fatal } ->
- { ModImplementationImports = ModImplementationImports0 }
+ { ModImplementationImports =
+ ModImplementationImports0 },
+ { Module1 = Module0 }
;
+ maybe_record_timestamp(Import, Ext, NeedQualifier,
+ LongIntFileName, MaybeTimestamp,
+ Module0, Module1),
{ ModImplementationImports =
[Import | ModImplementationImports0] },
check_module_accessibility(ModuleName, Import,
@@ -3840,12 +4050,13 @@
{ list__append(IndirectImports2, IndirectUses1,
IndirectImports3) },
{ list__append(ModItems0, Items, ModItems) },
- { Module1 = ((Module0 ^ impl_deps := ModImplementationImports)
+ { Module2 = ((Module1 ^ impl_deps := ModImplementationImports)
^ items := ModItems)
^ error := ModError },
- process_module_long_interfaces(Imports, Ext,
- IndirectImports3, IndirectImports, Module1, Module)
+ process_module_long_interfaces(ReadModules, NeedQualifier,
+ Imports, Ext, IndirectImports3, IndirectImports,
+ Module2, Module)
).
:- pred check_module_accessibility(module_name, module_name, item_list,
@@ -3958,27 +4169,29 @@
%-----------------------------------------------------------------------------%
-process_module_indirect_imports(IndirectImports, Ext, Module0, Module) -->
+process_module_indirect_imports(ReadModules, IndirectImports, Ext,
+ Module0, Module) -->
% Treat indirectly imported items as if they were imported
% using `:- use_module', since all uses of them in the `.int'
% files must be module qualified.
{ append_pseudo_decl(Module0, used(interface), Module1) },
- process_module_short_interfaces_transitively(IndirectImports,
- Ext, Module1, Module).
+ process_module_short_interfaces_transitively(ReadModules,
+ IndirectImports, Ext, Module1, Module).
-process_module_short_interfaces_transitively(Imports, Ext, Module0, Module) -->
- process_module_short_interfaces(Imports, Ext, [], IndirectImports,
- Module0, Module1),
+process_module_short_interfaces_transitively(ReadModules, Imports, Ext,
+ Module0, Module) -->
+ process_module_short_interfaces(ReadModules, Imports, Ext, [],
+ IndirectImports, Module0, Module1),
( { IndirectImports = [] } ->
{ Module = Module1 }
;
- process_module_short_interfaces_transitively(IndirectImports,
- Ext, Module1, Module)
+ process_module_short_interfaces_transitively(ReadModules,
+ IndirectImports, Ext, Module1, Module)
).
-process_module_short_interfaces([], _,
+process_module_short_interfaces(_, [], _,
IndirectImports, IndirectImports, Module, Module) --> [].
-process_module_short_interfaces([Import | Imports], Ext,
+process_module_short_interfaces(ReadModules, [Import | Imports], Ext,
IndirectImports0, IndirectImports, Module0, Module) -->
{ ModIndirectImports0 = Module0 ^ indirect_deps },
(
@@ -3990,14 +4203,23 @@
; list__member(Import, ModIndirectImports0)
}
->
- process_module_short_interfaces(Imports, Ext,
+ process_module_short_interfaces(ReadModules, Imports, Ext,
IndirectImports0, IndirectImports, Module0, Module)
;
{ ModItems0 = Module0 ^ items },
{ ModError0 = Module0 ^ error },
- read_mod(Import, Ext,
- "Reading short interface for module", yes,
- ShortIntItems, ShortIntError, _ImportFileName),
+ { Module0 ^ maybe_timestamps = yes(_) ->
+ ReturnTimestamp = yes
+ ;
+ ReturnTimestamp = no
+ },
+ read_mod(ReadModules, Import, Ext,
+ "Reading short interface for module", yes,
+ ReturnTimestamp, ShortIntItems, ShortIntError,
+ ImportFileName, MaybeTimestamp),
+ maybe_record_timestamp(Import, Ext, must_be_qualified,
+ ImportFileName, MaybeTimestamp, Module0, Module1),
+
{ strip_off_interface_decl(ShortIntItems, Items) },
{ maybe_add_int_error(ShortIntError, ModError0, ModError) },
@@ -4009,18 +4231,13 @@
{ list__append(IndirectImports0, Imports1, IndirectImports1) },
{ list__append(IndirectImports1, Uses1, IndirectImports2) },
{ list__append(ModItems0, Items, ModItems) },
- { Module1 = ((Module0 ^ indirect_deps := ModIndirectImports)
+ { Module2 = ((Module1 ^ indirect_deps := ModIndirectImports)
^ items := ModItems)
^ error := ModError },
- process_module_short_interfaces(Imports, Ext,
- IndirectImports2, IndirectImports, Module1, Module)
+ process_module_short_interfaces(ReadModules, Imports, Ext,
+ IndirectImports2, IndirectImports, Module2, Module)
).
-:- pred strip_off_interface_decl(item_list, item_list).
-:- mode strip_off_interface_decl(in, out) is det.
-
-% strip off the `:- interface' declaration at the start, if any
-
strip_off_interface_decl(Items0, Items) :-
(
Items0 = [ FirstItem | Items1 ],
@@ -4534,30 +4751,33 @@
:- pred include_in_short_interface(item).
:- mode include_in_short_interface(in) is semidet.
-include_in_short_interface(type_defn(_, _, _)).
-include_in_short_interface(inst_defn(_, _, _)).
-include_in_short_interface(mode_defn(_, _, _)).
+include_in_short_interface(type_defn(_, _, _, _, _)).
+include_in_short_interface(inst_defn(_, _, _, _, _)).
+include_in_short_interface(mode_defn(_, _, _, _, _)).
include_in_short_interface(module_defn(_, _)).
:- pred make_abstract_defn(item, short_interface_kind, item).
:- mode make_abstract_defn(in, in, out) is semidet.
-make_abstract_defn(type_defn(VarSet, du_type(Name, Args, _, _), Cond), _,
- type_defn(VarSet, abstract_type(Name, Args), Cond)).
-make_abstract_defn(type_defn(VarSet, abstract_type(Name, Args), Cond), _,
- type_defn(VarSet, abstract_type(Name, Args), Cond)).
-make_abstract_defn(type_defn(VarSet, eqv_type(Name, Args, _), Cond),
- ShortInterfaceKind,
- type_defn(VarSet, abstract_type(Name, Args), Cond)) :-
- % For the `.int2' files, we need the full definitions of
- % equivalence types. They are needed to ensure that
- % non-abstract equivalence types always get fully expanded
- % before code generation, even in modules that only indirectly
- % import the definition of the equivalence type.
- % But the full definitions are not needed for the `.int3' files.
- % So we convert equivalence types into abstract types only for
- % the `.int3' files.
- ShortInterfaceKind = int3.
+make_abstract_defn(type_defn(VarSet, Name, Args, TypeDefn, Cond),
+ ShortInterfaceKind,
+ type_defn(VarSet, Name, Args, abstract_type, Cond)) :-
+ (
+ TypeDefn = du_type(_, _)
+ ;
+ TypeDefn = abstract_type
+ ;
+ TypeDefn = eqv_type(_),
+ % For the `.int2' files, we need the full definitions of
+ % equivalence types. They are needed to ensure that
+ % non-abstract equivalence types always get fully expanded
+ % before code generation, even in modules that only indirectly
+ % import the definition of the equivalence type.
+ % But the full definitions are not needed for the `.int3'
+ % files. So we convert equivalence types into abstract
+ % types only for the `.int3' files.
+ ShortInterfaceKind = int3
+ ).
make_abstract_defn(typeclass(A, B, C, _, E), _,
typeclass(A, B, C, abstract, E)).
@@ -4578,5 +4798,52 @@
Body = abstract,
Item = instance(Constraints, Class, ClassTypes, Body, TVarSet,
ModName).
+
+%-----------------------------------------------------------------------------%
+
+:- pred maybe_record_timestamp(module_name, string, need_qualifier, file_name,
+ maybe(time_t), module_imports, module_imports, io__state, io__state).
+:- mode maybe_record_timestamp(in, in, in, in, in, in, out, di, uo) is det.
+
+maybe_record_timestamp(ModuleName, Suffix, NeedQualifier, FileName,
+ MaybeTimestamp, Module0, Module) -->
+ (
+ { Module0 ^ maybe_timestamps = yes(Timestamps0) }
+ ->
+ ( { MaybeTimestamp = yes(Timestamp) } ->
+ { TimestampInfo = module_timestamp(Suffix,
+ Timestamp, NeedQualifier) },
+ { map__set(Timestamps0, ModuleName,
+ TimestampInfo, Timestamps) },
+ { Module = Module0 ^ maybe_timestamps :=
+ yes(Timestamps) }
+ ;
+ { Module = Module0 },
+ report_modification_time_warning(FileName)
+ )
+ ;
+ { Module = Module0 }
+ ).
+
+:- pred report_modification_time_warning(file_name, io__state, io__state).
+:- mode report_modification_time_warning(in, di, uo) is det.
+
+report_modification_time_warning(SourceFileName) -->
+ globals__io_set_option(smart_recompilation, bool(no)),
+ globals__io_lookup_bool_option(warn_smart_recompilation, Warn),
+ ( { Warn = yes } ->
+ io__write_string(
+ "Warning: cannot find modification time for "),
+ io__write_string(SourceFileName),
+ io__write_string(".\nSmart recompilation will not work.\n"),
+ globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
+ ( { HaltAtWarn = yes } ->
+ io__set_exit_status(1)
+ ;
+ []
+ )
+ ;
+ []
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.323
diff -u -u -r1.323 options.m
--- compiler/options.m 2001/05/24 07:18:38 1.323
+++ compiler/options.m 2001/05/24 07:19:26
@@ -63,12 +63,12 @@
; warn_duplicate_calls
; warn_missing_module_name
; warn_wrong_module_name
- ; warn_smart_recompilation % not yet used.
+ ; warn_smart_recompilation
% Verbosity options
; verbose
; very_verbose
; verbose_errors
- ; verbose_recompilation % not yet used.
+ ; verbose_recompilation
; statistics
; debug_types
; debug_modes
@@ -95,11 +95,11 @@
; aditi_only
; output_grade_string
% Auxiliary output options
- ; smart_recompilation % not yet used.
+ ; smart_recompilation
% This option is used to control output
% of version numbers in interface files.
- % It is implied by smart_recompilation,
+ % It is implied by --smart-recompilation,
% and cannot be set explicitly by the user.
; generate_item_version_numbers
; assume_gmake
@@ -1640,7 +1640,9 @@
"\ta `:- module' declaration.",
"--no-warn-wrong-module-name",
"\tDisable warnings for modules whose `:- module'",
- "\tdeclaration does not match the module's file name."
+ "\tdeclaration does not match the module's file name.",
+ "--no-warn-smart-recompilation",
+ "\tDisable warnings from the smart recompilation system."
]).
:- pred options_help_verbosity(io__state::di, io__state::uo) is det.
@@ -1655,6 +1657,9 @@
"-E, --verbose-error-messages",
"\tExplain error messages. Asks the compiler to give you a more",
"\tdetailed explanation of any errors it finds in your program.",
+ "--verbose-recompilation",
+ "\tWhen using `--smart-recompilation', output messages\n",
+ "\texplaining why a module needs to be recompiled.",
"-S, --statistics",
"\tOutput messages about the compiler's time/space usage.",
"\tAt the moment this option implies `--no-trad-passes', so you get",
@@ -1745,6 +1750,11 @@
options_help_aux_output -->
io__write_string("\nAuxiliary Output Options:\n"),
write_tabbed_lines([
+ "--smart-recompilation",
+ "\tWhen compiling, write program dependency information",
+ "\tto be used to avoid unnecessary recompilations if an",
+ "\timported module's interface changes in a way which does",
+ "\tnot invalidate the compiled code.",
"--no-assume-gmake",
"\tWhen generating `.dep' files, generate Makefile",
"\tfragments that use only the features of standard make;",
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.30
diff -u -u -r1.30 post_typecheck.m
--- compiler/post_typecheck.m 2001/03/27 05:23:16 1.30
+++ compiler/post_typecheck.m 2001/05/24 05:20:51
@@ -191,9 +191,8 @@
%
% bind all the type variables in `Set' to `void' ...
%
- pred_info_context(PredInfo0, Context),
pred_info_get_constraint_proofs(PredInfo0, Proofs0),
- bind_type_vars_to_void(Set, Context, VarTypesMap0, VarTypesMap,
+ bind_type_vars_to_void(Set, VarTypesMap0, VarTypesMap,
Proofs0, Proofs),
clauses_info_set_vartypes(ClausesInfo0, VarTypesMap,
ClausesInfo),
@@ -246,12 +245,12 @@
%
% bind all the type variables in `UnboundTypeVarsSet' to the type `void' ...
%
-:- pred bind_type_vars_to_void(set(tvar), prog_context,
+:- pred bind_type_vars_to_void(set(tvar),
map(prog_var, type), map(prog_var, type),
constraint_proof_map, constraint_proof_map).
-:- mode bind_type_vars_to_void(in, in, in, out, in, out) is det.
+:- mode bind_type_vars_to_void(in, in, out, in, out) is det.
-bind_type_vars_to_void(UnboundTypeVarsSet, Context,
+bind_type_vars_to_void(UnboundTypeVarsSet,
VarTypesMap0, VarTypesMap, Proofs0, Proofs) :-
%
% first create a pair of corresponding lists (UnboundTypeVars, Voids)
@@ -259,19 +258,15 @@
%
set__to_sorted_list(UnboundTypeVarsSet, UnboundTypeVars),
list__length(UnboundTypeVars, Length),
- Void = term__functor(term__atom("void"), [], Context),
+ term__context_init(InitContext),
+ Void = term__functor(term__atom("void"), [], InitContext),
list__duplicate(Length, Void, Voids),
%
% then create a *substitution* that maps the
- % unbound type variables to void, but throws away the term context,
- % for use in renaming the constraint proofs (ie. so that we can use
- % map__lookup on the proofs).
+ % unbound type variables to void.
%
- term__context_init(InitContext),
- VoidNoContext = term__functor(term__atom("void"), [], InitContext),
- list__duplicate(Length, VoidNoContext, VoidsNoContext),
- map__from_corresponding_lists(UnboundTypeVars, VoidsNoContext,
+ map__from_corresponding_lists(UnboundTypeVars, Voids,
VoidSubst),
%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.67
diff -u -u -r1.67 prog_data.m
--- compiler/prog_data.m 2001/05/02 17:34:42 1.67
+++ compiler/prog_data.m 2001/05/27 19:31:15
@@ -22,8 +22,9 @@
% Any types which are needed in both the parse tree and in the HLDS
% should be defined here, rather than in hlds*.m.
-:- import_module (inst).
-:- import_module bool, list, assoc_list, map, varset, term, std_util.
+:- import_module (inst), options.
+:- import_module recompilation.
+:- import_module bool, list, assoc_list, map, set, varset, term, std_util.
%-----------------------------------------------------------------------------%
@@ -44,42 +45,31 @@
:- type item_and_context == pair(item, prog_context).
:- type item
- ---> pred_clause(prog_varset, sym_name, list(prog_term), goal)
- % VarNames, PredName, HeadArgs, ClauseBody
-
- ; func_clause(prog_varset, sym_name, list(prog_term),
- prog_term, goal)
- % VarNames, PredName, HeadArgs, Result, ClauseBody
-
- ; type_defn(tvarset, type_defn, condition)
- ; inst_defn(inst_varset, inst_defn, condition)
- ; mode_defn(inst_varset, mode_defn, condition)
+ ---> clause(prog_varset, pred_or_func, sym_name,
+ list(prog_term), goal)
+ % VarNames, PredOrFunc, PredName, HeadArgs, ClauseBody
+
+ ; type_defn(tvarset, sym_name, list(type_param),
+ type_defn, condition)
+ % VarNames, Name, Args, TypeDefn, Condition
+
+ ; inst_defn(inst_varset, sym_name, list(inst_var),
+ inst_defn, condition)
+ ; mode_defn(inst_varset, sym_name, list(inst_var),
+ mode_defn, condition)
; module_defn(prog_varset, module_defn)
-
- ; pred(tvarset, inst_varset, existq_tvars, sym_name,
- list(type_and_mode), maybe(determinism), condition,
- purity, class_constraints)
- % TypeVarNames, InstVarNames,
- % ExistentiallyQuantifiedTypeVars, PredName, ArgTypes,
- % Deterministicness, Cond, Purity, TypeClassContext
- ; func(tvarset, inst_varset, existq_tvars, sym_name,
- list(type_and_mode), type_and_mode, maybe(determinism),
+ ; pred_or_func(tvarset, inst_varset, existq_tvars, pred_or_func,
+ sym_name, list(type_and_mode), maybe(determinism),
condition, purity, class_constraints)
% TypeVarNames, InstVarNames,
- % ExistentiallyQuantifiedTypeVars, PredName, ArgTypes,
- % ReturnType, Deterministicness, Cond, Purity,
- % TypeClassContext
-
- ; pred_mode(inst_varset, sym_name, list(mode), maybe(determinism),
- condition)
- % VarNames, PredName, ArgModes, Deterministicness,
- % Cond
-
- ; func_mode(inst_varset, sym_name, list(mode), mode,
- maybe(determinism), condition)
- % VarNames, PredName, ArgModes, ReturnValueMode,
- % Deterministicness, Cond
+ % ExistentiallyQuantifiedTypeVars, PredOrFunc, PredName,
+ % ArgTypes, Determinism, Cond, Purity, TypeClassContext
+
+ ; pred_or_func_mode(inst_varset, pred_or_func, sym_name,
+ list(mode), maybe(determinism), condition)
+ % VarNames, PredOrFunc, PredName, ArgModes,
+ % Determinism, Cond
; pragma(pragma_type)
@@ -95,10 +85,10 @@
% DerivingClass, ClassName, Types,
% MethodInstances, VarNames, ModuleContainingInstance
- ; nothing.
- % used for items that should be ignored (currently only
- % NU-Prolog `when' declarations, which are silently ignored
- % for backwards compatibility).
+ ; nothing(maybe(item_warning)).
+ % used for items that should be ignored (e.g.
+ % NU-Prolog `when' declarations, which are silently
+ % ignored for backwards compatibility).
:- type type_and_mode
---> type_only(type)
@@ -137,6 +127,14 @@
; erroneous
; failure.
+:- type item_warning
+ ---> item_warning(
+ maybe(option), % Option controlling whether the
+ % warning should be reported.
+ string, % The warning.
+ term % The term to which it relates.
+ ).
+
%-----------------------------------------------------------------------------%
%
% Pragmas
@@ -160,11 +158,12 @@
% VarNames, Foreign Code Implementation Info
; type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
- maybe(list(mode)), type_subst, tvarset)
+ maybe(list(mode)), type_subst, tvarset, set(type_id))
% PredName, SpecializedPredName, Arity,
% PredOrFunc, Modes if a specific procedure was
% specified, type substitution (using the variable
- % names from the pred declaration), TVarSet
+ % names from the pred declaration), TVarSet,
+ % Equivalence types used
; inline(sym_name, arity)
% Predname, Arity
@@ -441,9 +440,8 @@
% This invariant is needed to ensure that we can do
% unifications, map__lookups, etc., and get the
% expected semantics.
- % Any code that creates new class constraints must
- % ensure that this invariant is preserved,
- % probably by using strip_term_contexts/2 in type_util.m.
+ % (This invariant now applies to all types, but is
+ % especially important here.)
:- type class_constraint
---> constraint(class_name, list(type)).
@@ -460,36 +458,18 @@
; concrete(list(class_method)).
:- type class_method
- ---> pred(tvarset, inst_varset, existq_tvars, sym_name,
- list(type_and_mode), maybe(determinism), condition,
- purity, class_constraints, prog_context)
+ ---> pred_or_func(tvarset, inst_varset, existq_tvars, pred_or_func,
+ sym_name, list(type_and_mode), maybe(determinism),
+ condition, purity, class_constraints, prog_context)
% TypeVarNames, InstVarNames,
% ExistentiallyQuantifiedTypeVars,
- % PredName, ArgTypes, Determinism, Cond
+ % PredOrFunc, PredName, ArgTypes, Determinism, Cond
% Purity, ClassContext, Context
- ; func(tvarset, inst_varset, existq_tvars, sym_name,
- list(type_and_mode), type_and_mode,
- maybe(determinism), condition,
- purity, class_constraints, prog_context)
- % TypeVarNames, InstVarNames,
- % ExistentiallyQuantfiedTypeVars,
- % PredName, ArgTypes, ReturnType,
- % Determinism, Cond
- % Purity, ClassContext, Context
-
- ; pred_mode(inst_varset, sym_name, list(mode),
- maybe(determinism), condition,
- prog_context)
- % InstVarNames, PredName, ArgModes,
- % Determinism, Cond
- % Context
-
- ; func_mode(inst_varset, sym_name, list(mode), mode,
- maybe(determinism), condition,
+ ; pred_or_func_mode(inst_varset, pred_or_func, sym_name,
+ list(mode), maybe(determinism), condition,
prog_context)
- % InstVarNames, PredName, ArgModes,
- % ReturnValueMode,
+ % InstVarNames, PredOrFunc, PredName, ArgModes,
% Determinism, Cond
% Context
.
@@ -676,12 +656,10 @@
% type_defn/3 is defined above as a constructor for item/0
:- type type_defn
- ---> du_type(sym_name, list(type_param), list(constructor),
- maybe(equality_pred)
- )
- ; uu_type(sym_name, list(type_param), list(type))
- ; eqv_type(sym_name, list(type_param), type)
- ; abstract_type(sym_name, list(type_param)).
+ ---> du_type(list(constructor), maybe(equality_pred))
+ ; uu_type(list(type))
+ ; eqv_type(type)
+ ; abstract_type.
:- type constructor
---> ctor(
@@ -758,8 +736,8 @@
% inst_defn/3 defined above
:- type inst_defn
- ---> eqv_inst(sym_name, list(inst_var), inst)
- ; abstract_inst(sym_name, list(inst_var)).
+ ---> eqv_inst(inst)
+ ; abstract_inst.
% An `inst_name' is used as a key for the inst_table.
% It is either a user-defined inst `user_inst(Name, Args)',
@@ -820,7 +798,7 @@
% mode_defn/3 defined above
:- type mode_defn
- ---> eqv_mode(sym_name, list(inst_var), mode).
+ ---> eqv_mode(mode).
:- type (mode)
---> ((inst) -> (inst))
@@ -887,8 +865,13 @@
; export(sym_list)
; import(sym_list)
; use(sym_list)
+
+ ; include_module(list(module_name))
- ; include_module(list(module_name)).
+ % This is used to represent the version numbers
+ % of items in an interface file for use in
+ % smart recompilation.
+ ; version_numbers(module_name, recompilation__version_numbers).
:- type section
---> implementation
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.195
diff -u -u -r1.195 prog_io.m
--- compiler/prog_io.m 2001/05/24 06:07:10 1.195
+++ compiler/prog_io.m 2001/05/25 11:01:20
@@ -56,18 +56,21 @@
:- interface.
:- import_module prog_data, prog_io_util.
-:- import_module bool, varset, term, list, io.
+:- import_module bool, varset, term, list, io, time, std_util.
%-----------------------------------------------------------------------------%
% This module (prog_io) exports the following predicates:
- % prog_io__read_module(FileName, DefaultModuleName, Search, Error,
- % ActualModuleName, Messages, Program)
+ % prog_io__read_module(FileName, DefaultModuleName, Search,
+ % ReturnTimestamp, Error, ActualModuleName,
+ % Messages, Program, MaybeModuleTimestamp)
% Reads and parses the module in file `FileName',
% using the default module name `DefaultModuleName'.
- % If Search is yes, search directories given by the option
+ % If Search is `yes', search directories given by the option
% search_directories.
+ % If ReturnTimestamp is `yes', attempt to return the
+ % modification timestamp in MaybeModuleTimestamp.
% Error is `fatal' if the file coudn't be opened, `yes'
% if a syntax error was detected, and `no' otherwise.
% ActualModuleName is the module name specified in the
@@ -84,10 +87,17 @@
:- type file_name == string.
:- type dir_name == string.
-:- pred prog_io__read_module(file_name, module_name, bool,
+:- pred prog_io__read_module(file_name, module_name, bool, bool,
module_error, module_name, message_list, item_list,
- io__state, io__state).
-:- mode prog_io__read_module(in, in, in, out, out, out, out, di, uo) is det.
+ maybe(time_t), io__state, io__state).
+:- mode prog_io__read_module(in, in, in, in, out, out, out, out,
+ out, di, uo) is det.
+
+:- pred prog_io__read_module_if_changed(file_name, module_name, bool, time_t,
+ module_error, module_name, message_list,
+ item_list, maybe(time_t), io__state, io__state).
+:- mode prog_io__read_module_if_changed(in, in, in, in,
+ out, out, out, out, out, di, uo) is det.
% Same as prog_io__read_module, but use intermod_directories
% instead of search_directories when searching for the file.
@@ -186,21 +196,31 @@
:- import_module prog_io_typeclass.
:- import_module hlds_data, hlds_pred, prog_util, prog_out.
:- import_module globals, options, (inst).
+:- import_module recompilation, recompilation_version.
:- import_module int, string, std_util, parser, term_io, dir, require.
-:- import_module assoc_list.
+:- import_module assoc_list, map.
%-----------------------------------------------------------------------------%
+
+prog_io__read_module(FileName, DefaultModuleName, Search, ReturnTimestamp,
+ Error, ModuleName, Messages, Items, MaybeModuleTimestamp) -->
+ prog_io__read_module_2(FileName, DefaultModuleName, Search,
+ search_directories, no, ReturnTimestamp, Error, ModuleName,
+ Messages, Items, MaybeModuleTimestamp).
-prog_io__read_module(FileName, DefaultModuleName, Search,
- Error, ModuleName, Messages, Items) -->
+prog_io__read_module_if_changed(FileName, DefaultModuleName, Search,
+ OldTimestamp, Error, ModuleName, Messages,
+ Items, MaybeModuleTimestamp) -->
prog_io__read_module_2(FileName, DefaultModuleName, Search,
- search_directories, Error, ModuleName, Messages, Items).
+ search_directories, yes(OldTimestamp), yes, Error, ModuleName,
+ Messages, Items, MaybeModuleTimestamp).
-prog_io__read_opt_file(FileName, DefaultModuleName, Search,
+prog_io__read_opt_file(FileName, DefaultModuleName, Search,
Error, Messages, Items) -->
prog_io__read_module_2(FileName, DefaultModuleName, Search,
- intermod_directories, Error, ModuleName, Messages, Items),
+ intermod_directories, no, no, Error,
+ ModuleName, Messages, Items, _),
check_module_has_expected_name(FileName,
DefaultModuleName, ModuleName).
@@ -230,13 +250,14 @@
% late-input modes.)
:- pred prog_io__read_module_2(file_name, module_name, bool, option,
- module_error, module_name, message_list, item_list,
- io__state, io__state).
-:- mode prog_io__read_module_2(in, in, in, in, out, out, out, out,
- di, uo) is det.
-
-prog_io__read_module_2(FileName, DefaultModuleName, Search,
- SearchOpt, Error, ModuleName, Messages, Items) -->
+ maybe(time_t), bool, module_error, module_name, message_list,
+ item_list, maybe(time_t), io__state, io__state).
+:- mode prog_io__read_module_2(in, in, in, in, in, in, out, out, out, out,
+ out, di, uo) is det.
+
+prog_io__read_module_2(FileName, DefaultModuleName, Search, SearchOpt,
+ MaybeOldTimestamp, ReturnTimestamp, Error,
+ ModuleName, Messages, Items, MaybeModuleTimestamp) -->
(
{ Search = yes }
->
@@ -246,11 +267,44 @@
{ dir__this_directory(CurrentDir) },
{ Dirs = [CurrentDir] }
),
+ io__input_stream(OldInputStream),
search_for_file(Dirs, FileName, R),
( { R = yes } ->
- read_all_items(DefaultModuleName, ModuleName,
- Messages, Items, Error),
- io__seen
+ ( { ReturnTimestamp = yes } ->
+ io__input_stream(InputStream),
+ io__input_stream_file_modification_time(InputStream,
+ TimestampResult),
+ (
+ { TimestampResult = ok(Timestamp) },
+ { MaybeModuleTimestamp = yes(Timestamp) }
+ ;
+ { TimestampResult = error(_) },
+ { MaybeModuleTimestamp = no }
+ )
+ ;
+ { MaybeModuleTimestamp = no }
+ ),
+ (
+ { MaybeOldTimestamp = yes(OldTimestamp) },
+ { MaybeModuleTimestamp = yes(OldTimestamp) }
+ ->
+ %
+ % XXX Currently smart recompilation won't work
+ % if ModuleName \= DefaultModuleName.
+ % In that case, smart recompilation will
+ % be disabled and prog_io__read_module should
+ % never be passed an old timestamp.
+ %
+ { ModuleName = DefaultModuleName },
+ { Items = [] },
+ { Error = no },
+ { Messages = [] }
+ ;
+ read_all_items(DefaultModuleName, ModuleName,
+ Messages, Items, Error)
+ ),
+ io__seen,
+ io__set_input_stream(OldInputStream, _)
;
io__progname_base("prog_io.m", Progname),
{
@@ -261,7 +315,8 @@
Messages = [Message - Term],
Error = fatal,
Items = [],
- ModuleName = DefaultModuleName
+ ModuleName = DefaultModuleName,
+ MaybeModuleTimestamp = no
}
).
@@ -626,8 +681,36 @@
read_items_loop(ModuleName, SourceFileName, Msgs1, Items1, Error1,
Msgs, Items, Error).
-read_items_loop_2(ok(Item, Context), ModuleName0, SourceFileName0,
+read_items_loop_2(ok(Item0, Context), ModuleName0, SourceFileName0,
Msgs0, Items0, Error0, Msgs, Items, Error) -->
+
+ ( { Item0 = nothing(yes(Warning)) } ->
+ { Warning = item_warning(MaybeOption, Msg, Term) },
+ ( { MaybeOption = yes(Option) } ->
+ globals__io_lookup_bool_option(Option, Warn)
+ ;
+ { Warn = yes }
+ ),
+ ( { Warn = yes } ->
+ { add_warning(Msg, Term, Msgs0, Msgs1) },
+
+ globals__io_lookup_bool_option(halt_at_warn, Halt),
+ { Halt = yes ->
+ Error1 = yes
+ ;
+ Error1 = Error0
+ }
+ ;
+ { Error1 = Error0 },
+ { Msgs1 = Msgs0 }
+ ),
+ { Item = nothing(no) }
+ ;
+ { Error1 = Error0 },
+ { Msgs1 = Msgs0 },
+ { Item = Item0 }
+ ),
+
% if the next item was a valid item, check whether it was
% a declaration that affects the current parsing context --
% i.e. either a `module'/`end_module' declaration or a
@@ -655,7 +738,7 @@
ModuleName = ModuleName0,
Items1 = [Item - Context | Items0]
},
- read_items_loop(ModuleName, SourceFileName, Msgs0, Items1, Error0,
+ read_items_loop(ModuleName, SourceFileName, Msgs1, Items1, Error1,
Msgs, Items, Error).
%-----------------------------------------------------------------------------%
@@ -752,7 +835,7 @@
:- pred process_pred_clause(maybe_functor, prog_varset, goal, maybe1(item)).
:- mode process_pred_clause(in, in, in, out) is det.
process_pred_clause(ok(Name, Args0), VarSet, Body,
- ok(pred_clause(VarSet, Name, Args, Body))) :-
+ ok(clause(VarSet, predicate, Name, Args, Body))) :-
list__map(term__coerce, Args0, Args).
process_pred_clause(error(ErrMessage, Term0), _, _, error(ErrMessage, Term)) :-
term__coerce(Term0, Term).
@@ -761,9 +844,9 @@
maybe1(item)).
:- mode process_func_clause(in, in, in, in, out) is det.
process_func_clause(ok(Name, Args0), Result0, VarSet, Body,
- ok(func_clause(VarSet, Name, Args, Result, Body))) :-
- list__map(term__coerce, Args0, Args),
- term__coerce(Result0, Result).
+ ok(clause(VarSet, function, Name, Args, Body))) :-
+ list__append(Args0, [Result0], Args1),
+ list__map(term__coerce, Args1, Args).
process_func_clause(error(ErrMessage, Term0), _, _, _,
error(ErrMessage, Term)) :-
term__coerce(Term0, Term).
@@ -1033,9 +1116,18 @@
% backwards compatibility. We now issue a warning that they
% are deprecated. We should eventually drop support for them
% entirely.
-process_decl(_ModuleName, _VarSet, "when", [_Goal, _Cond], Attributes,
+process_decl(_ModuleName, _VarSet, "when", [Goal, _Cond], Attributes,
Result) :-
- Result0 = ok(nothing),
+ ( Goal = term__functor(_, _, Context0) ->
+ Context = Context0
+ ;
+ term__context_init(Context)
+ ),
+ dummy_term_with_context(Context, DummyTerm),
+ Result0 = ok(nothing(yes(item_warning(no,
+ "NU-Prolog `when' declarations are deprecated",
+ DummyTerm
+ )))),
check_no_attributes(Result0, Attributes, Result).
process_decl(ModuleName, VarSet, "pragma", Pragma, Attributes, Result):-
@@ -1054,6 +1146,53 @@
parse_instance(ModuleName, VarSet, Args, Result0),
check_no_attributes(Result0, Attributes, Result).
+process_decl(ModuleName, VarSet0, "version_numbers",
+ [VersionNumberTerm, ModuleNameTerm, VersionNumbersTerm],
+ Attributes, Result) :-
+ parse_module_specifier(ModuleNameTerm, ModuleNameResult),
+ (
+ VersionNumberTerm = term__functor(
+ term__integer(VersionNumber), [], _),
+ VersionNumber = version_numbers_version_number
+ ->
+ (
+ ModuleNameResult = ok(ModuleName)
+ ->
+ recompilation_version__parse_version_numbers(
+ VersionNumbersTerm, Result0),
+ (
+ Result0 = ok(VersionNumbers),
+ varset__coerce(VarSet0, VarSet),
+ Result1 = module_defn(VarSet,
+ version_numbers(ModuleName,
+ VersionNumbers)),
+ check_no_attributes(ok(Result1),
+ Attributes, Result)
+ ;
+ Result0 = error(A, B),
+ Result = error(A, B)
+ )
+ ;
+ Result = error(
+ "invalid module name in `:- version_numbers'",
+ ModuleNameTerm)
+ )
+ ;
+
+ ( VersionNumberTerm = term__functor(_, _, Context) ->
+ Msg =
+"interface file needs to be recreated, the version numbers are out of date",
+ dummy_term_with_context(Context, DummyTerm),
+ Warning = item_warning(yes(warn_smart_recompilation),
+ Msg, DummyTerm),
+ Result = ok(nothing(yes(Warning)))
+ ;
+ Result = error(
+ "invalid version number in `:- version_numbers'",
+ VersionNumberTerm)
+ )
+ ).
+
:- pred parse_decl_attribute(string, list(term), decl_attribute, term).
:- mode parse_decl_attribute(in, in, out, out) is semidet.
@@ -1128,10 +1267,11 @@
% (don't bother at the moment, since we ignore
% conditions anyhow :-)
-:- pred make_type_defn(varset, condition, type_defn, item).
+:- pred make_type_defn(varset, condition, processed_type_body, item).
:- mode make_type_defn(in, in, in, out) is det.
-make_type_defn(VarSet0, Cond, TypeDefn, type_defn(VarSet, TypeDefn, Cond)) :-
+make_type_defn(VarSet0, Cond, processed_type_body(Name, Args, TypeDefn),
+ type_defn(VarSet, Name, Args, TypeDefn, Cond)) :-
varset__coerce(VarSet0, VarSet).
:- pred make_external(varset, sym_name_specifier, item).
@@ -1163,7 +1303,7 @@
% a representation of the declaration.
:- pred parse_type_decl_type(module_name, string, list(term), condition,
- maybe1(type_defn)).
+ maybe1(processed_type_body)).
:- mode parse_type_decl_type(in, in, in, out, out) is semidet.
parse_type_decl_type(ModuleName, "--->", [H, B], Condition, R) :-
@@ -1342,31 +1482,39 @@
%-----------------------------------------------------------------------------%
+:- type processed_type_body
+ ---> processed_type_body(
+ sym_name,
+ list(type_param),
+ type_defn
+ ).
+
% This is for "Head = Body" (undiscriminated union) definitions.
-:- pred process_uu_type(module_name, term, term, maybe1(type_defn)).
+:- pred process_uu_type(module_name, term, term, maybe1(processed_type_body)).
:- mode process_uu_type(in, in, in, out) is det.
process_uu_type(ModuleName, Head, Body, Result) :-
check_for_errors(ModuleName, Head, Body, Result0),
process_uu_type_2(Result0, Body, Result).
-:- pred process_uu_type_2(maybe_functor, term, maybe1(type_defn)).
+:- pred process_uu_type_2(maybe_functor, term, maybe1(processed_type_body)).
:- mode process_uu_type_2(in, in, out) is det.
process_uu_type_2(error(Error, Term), _, error(Error, Term)).
-process_uu_type_2(ok(Name, Args0), Body0, ok(uu_type(Name, Args, List))) :-
+process_uu_type_2(ok(Name, Args0), Body,
+ ok(processed_type_body(Name, Args, uu_type(List)))) :-
list__map(term__coerce, Args0, Args),
- term__coerce(Body0, Body),
- sum_to_list(Body, List).
+ sum_to_list(Body, List0),
+ list__map(convert_type, List0, List).
%-----------------------------------------------------------------------------%
% This is for "Head == Body" (equivalence) definitions.
-:- pred process_eqv_type(module_name, term, term, maybe1(type_defn)).
+:- pred process_eqv_type(module_name, term, term, maybe1(processed_type_body)).
:- mode process_eqv_type(in, in, in, out) is det.
process_eqv_type(ModuleName, Head, Body, Result) :-
check_for_errors(ModuleName, Head, Body, Result0),
process_eqv_type_2(Result0, Body, Result).
-:- pred process_eqv_type_2(maybe_functor, term, maybe1(type_defn)).
+:- pred process_eqv_type_2(maybe_functor, term, maybe1(processed_type_body)).
:- mode process_eqv_type_2(in, in, out) is det.
process_eqv_type_2(error(Error, Term), _, error(Error, Term)).
process_eqv_type_2(ok(Name, Args0), Body0, Result) :-
@@ -1381,8 +1529,8 @@
Body0)
;
list__map(term__coerce, Args0, Args),
- term__coerce(Body0, Body),
- Result = ok(eqv_type(Name, Args, Body))
+ convert_type(Body0, Body),
+ Result = ok(processed_type_body(Name, Args, eqv_type(Body)))
).
%-----------------------------------------------------------------------------%
@@ -1393,14 +1541,14 @@
% TypeHead.
% This is for "Head ---> Body" (constructor) definitions.
:- pred process_du_type(module_name, term, term, maybe1(maybe(equality_pred)),
- maybe1(type_defn)).
+ maybe1(processed_type_body)).
:- mode process_du_type(in, in, in, in, out) is det.
process_du_type(ModuleName, Head, Body, EqualityPred, Result) :-
check_for_errors(ModuleName, Head, Body, Result0),
process_du_type_2(ModuleName, Result0, Body, EqualityPred, Result).
:- pred process_du_type_2(module_name, maybe_functor, term,
- maybe1(maybe(equality_pred)), maybe1(type_defn)).
+ maybe1(maybe(equality_pred)), maybe1(processed_type_body)).
:- mode process_du_type_2(in, in, in, in, out) is det.
process_du_type_2(_, error(Error, Term), _, _, error(Error, Term)).
process_du_type_2(ModuleName, ok(Functor, Args0), Body, MaybeEqualityPred,
@@ -1474,8 +1622,8 @@
;
(
MaybeEqualityPred = ok(EqualityPred),
- Result = ok(du_type(Functor, Args, Constrs,
- EqualityPred))
+ Result = ok(processed_type_body(Functor, Args,
+ du_type(Constrs, EqualityPred)))
;
MaybeEqualityPred = error(Error, Term),
Result = error(Error, Term)
@@ -1492,17 +1640,18 @@
% binds Result to a representation of the type information about the
% TypeHead.
-:- pred process_abstract_type(module_name, term, maybe1(type_defn)).
+:- pred process_abstract_type(module_name, term, maybe1(processed_type_body)).
:- mode process_abstract_type(in, in, out) is det.
process_abstract_type(ModuleName, Head, Result) :-
dummy_term(Body),
check_for_errors(ModuleName, Head, Body, Result0),
process_abstract_type_2(Result0, Result).
-:- pred process_abstract_type_2(maybe_functor, maybe1(type_defn)).
+:- pred process_abstract_type_2(maybe_functor, maybe1(processed_type_body)).
:- mode process_abstract_type_2(in, out) is det.
process_abstract_type_2(error(Error, Term), error(Error, Term)).
-process_abstract_type_2(ok(Functor, Args0), ok(abstract_type(Functor, Args))) :-
+process_abstract_type_2(ok(Functor, Args0),
+ ok(processed_type_body(Functor, Args, abstract_type))) :-
list__map(term__coerce, Args0, Args).
%-----------------------------------------------------------------------------%
@@ -1648,8 +1797,9 @@
get_purity(Attributes0, Purity, Attributes),
varset__coerce(VarSet0, TVarSet),
varset__coerce(VarSet0, IVarSet),
- Result0 = ok(pred(TVarSet, IVarSet, ExistQVars, F,
- As, MaybeDet, Cond, Purity, ClassContext)),
+ Result0 = ok(pred_or_func(TVarSet, IVarSet, ExistQVars,
+ predicate, F, As, MaybeDet, Cond, Purity,
+ ClassContext)),
check_no_attributes(Result0, Attributes, Result)
;
Result = error("some but not all arguments have modes",
@@ -1914,9 +2064,10 @@
get_purity(Attributes0, Purity, Attributes),
varset__coerce(VarSet0, TVarSet),
varset__coerce(VarSet0, IVarSet),
- Result0 = ok(func(TVarSet, IVarSet, ExistQVars,
- F, As, ReturnType, MaybeDet, Cond,
- Purity, ClassContext)),
+ list__append(As, [ReturnType], Args),
+ Result0 = ok(pred_or_func(TVarSet, IVarSet,
+ ExistQVars, function, F, Args,
+ MaybeDet, Cond, Purity, ClassContext)),
check_no_attributes(Result0, Attributes,
Result)
)
@@ -1965,7 +2116,8 @@
->
list__map(constrain_inst_vars_in_mode, As1, As),
varset__coerce(VarSet0, VarSet),
- Result = ok(pred_mode(VarSet, F, As, MaybeDet, Cond))
+ Result = ok(pred_or_func_mode(VarSet, predicate, F, As,
+ MaybeDet, Cond))
;
Result = error("syntax error in predicate mode declaration",
PredMode)
@@ -1985,8 +2137,9 @@
( convert_mode(RetMode0, RetMode1) ->
constrain_inst_vars_in_mode(RetMode1, RetMode),
varset__coerce(VarSet0, VarSet),
- Result = ok(func_mode(VarSet, F, As, RetMode, MaybeDet,
- Cond))
+ list__append(As, [RetMode], ArgModes),
+ Result = ok(pred_or_func_mode(VarSet, function, F,
+ ArgModes, MaybeDet, Cond))
;
Result = error(
"syntax error in return mode of function mode declaration",
@@ -2101,14 +2254,15 @@
% Parse a `:- inst <Head> ---> <Body>.' definition.
%
-:- pred convert_inst_defn(module_name, term, term, maybe1(inst_defn)).
+:- pred convert_inst_defn(module_name, term, term, maybe1(processed_inst_body)).
:- mode convert_inst_defn(in, in, in, out) is det.
convert_inst_defn(ModuleName, Head, Body, Result) :-
parse_implicitly_qualified_term(ModuleName,
Head, Body, "inst definition", R),
convert_inst_defn_2(R, Head, Body, Result).
-:- pred convert_inst_defn_2(maybe_functor, term, term, maybe1(inst_defn)).
+:- pred convert_inst_defn_2(maybe_functor, term, term,
+ maybe1(processed_inst_body)).
:- mode convert_inst_defn_2(in, in, in, out) is det.
convert_inst_defn_2(error(M, T), _, _, error(M, T)).
@@ -2150,8 +2304,9 @@
convert_inst(Body, ConvertedBody)
->
list__map(term__coerce_var, Args, InstArgs),
- Result = ok(eqv_inst(Name, InstArgs,
- ConvertedBody))
+ Result = ok(
+ processed_inst_body(Name, InstArgs,
+ eqv_inst(ConvertedBody)))
;
Result = error("syntax error in inst body",
Body)
@@ -2161,14 +2316,23 @@
Result = error("inst parameters must be variables", Head)
).
-:- pred convert_abstract_inst_defn(module_name, term, maybe1(inst_defn)).
+:- type processed_inst_body
+ ---> processed_inst_body(
+ sym_name,
+ list(inst_var),
+ inst_defn
+ ).
+
+:- pred convert_abstract_inst_defn(module_name, term,
+ maybe1(processed_inst_body)).
:- mode convert_abstract_inst_defn(in, in, out) is det.
convert_abstract_inst_defn(ModuleName, Head, Result) :-
parse_implicitly_qualified_term(ModuleName, Head, Head,
"inst definition", R),
convert_abstract_inst_defn_2(R, Head, Result).
-:- pred convert_abstract_inst_defn_2(maybe_functor, term, maybe1(inst_defn)).
+:- pred convert_abstract_inst_defn_2(maybe_functor, term,
+ maybe1(processed_inst_body)).
:- mode convert_abstract_inst_defn_2(in, in, out) is det.
convert_abstract_inst_defn_2(error(M, T), _, error(M, T)).
convert_abstract_inst_defn_2(ok(Name, ArgTerms), Head, Result) :-
@@ -2186,16 +2350,18 @@
Head)
;
list__map(term__coerce_var, Args, InstArgs),
- Result = ok(abstract_inst(Name, InstArgs))
+ Result = ok(processed_inst_body(Name, InstArgs,
+ abstract_inst))
)
;
Result = error("inst parameters must be variables", Head)
).
-:- pred make_inst_defn(varset, condition, inst_defn, item).
+:- pred make_inst_defn(varset, condition, processed_inst_body, item).
:- mode make_inst_defn(in, in, in, out) is det.
-make_inst_defn(VarSet0, Cond, InstDefn, inst_defn(VarSet, InstDefn, Cond)) :-
+make_inst_defn(VarSet0, Cond, processed_inst_body(Name, Params, InstDefn),
+ inst_defn(VarSet, Name, Params, InstDefn, Cond)) :-
varset__coerce(VarSet0, VarSet).
%-----------------------------------------------------------------------------%
@@ -2240,15 +2406,24 @@
:- mode mode_op(in, out, out) is semidet.
mode_op(term__functor(term__atom(Op), [H, B], _), H, B) :-
( Op = "==" ; Op = "::" ).
+
+:- type processed_mode_body
+ ---> processed_mode_body(
+ sym_name,
+ list(inst_var),
+ mode_defn
+ ).
-:- pred convert_mode_defn(module_name, term, term, maybe1(mode_defn)).
+:- pred convert_mode_defn(module_name, term, term,
+ maybe1(processed_mode_body)).
:- mode convert_mode_defn(in, in, in, out) is det.
convert_mode_defn(ModuleName, Head, Body, Result) :-
parse_implicitly_qualified_term(ModuleName, Head, Head,
"mode definition", R),
convert_mode_defn_2(R, Head, Body, Result).
-:- pred convert_mode_defn_2(maybe_functor, term, term, maybe1(mode_defn)).
+:- pred convert_mode_defn_2(maybe_functor, term, term,
+ maybe1(processed_mode_body)).
:- mode convert_mode_defn_2(in, in, in, out) is det.
convert_mode_defn_2(error(M, T), _, _, error(M, T)).
convert_mode_defn_2(ok(Name, ArgTerms), Head, Body, Result) :-
@@ -2279,8 +2454,8 @@
convert_mode(Body, ConvertedBody)
->
list__map(term__coerce_var, Args, InstArgs),
- Result = ok(eqv_mode(Name, InstArgs,
- ConvertedBody))
+ Result = ok(processed_mode_body(Name,
+ InstArgs, eqv_mode(ConvertedBody)))
;
% catch-all error message - we should do
% better than this
@@ -2316,16 +2491,14 @@
Result = type_only(Type)
).
-:- pred make_mode_defn(varset, condition, mode_defn, item).
+:- pred make_mode_defn(varset, condition, processed_mode_body, item).
:- mode make_mode_defn(in, in, in, out) is det.
-make_mode_defn(VarSet0, Cond, ModeDefn, mode_defn(VarSet, ModeDefn, Cond)) :-
+make_mode_defn(VarSet0, Cond, processed_mode_body(Name, Params, ModeDefn),
+ mode_defn(VarSet, Name, Params, ModeDefn, Cond)) :-
varset__coerce(VarSet0, VarSet).
%-----------------------------------------------------------------------------%
-:- type parser(T) == pred(term, maybe1(T)).
-:- mode parser :: pred(in, out) is det.
-
:- type maker(T1, T2) == pred(T1, T2).
:- mode maker :: pred(in, out) is det.
@@ -2352,34 +2525,6 @@
%-----------------------------------------------------------------------------%
- % Parse a comma-separated list (misleading described as
- % a "conjunction") of things.
-
-:- pred parse_list(parser(T), term, maybe1(list(T))).
-:- mode parse_list(parser, in, out) is det.
-parse_list(Parser, Term, Result) :-
- conjunction_to_list(Term, List),
- parse_list_2(List, Parser, Result).
-
-:- pred parse_list_2(list(term), parser(T), maybe1(list(T))).
-:- mode parse_list_2(in, parser, out) is det.
-parse_list_2([], _, ok([])).
-parse_list_2([X|Xs], Parser, Result) :-
- call(Parser, X, X_Result),
- parse_list_2(Xs, Parser, Xs_Result),
- combine_list_results(X_Result, Xs_Result, Result).
-
- % If a list of things contains multiple errors, then we only
- % report the first one.
-
-:- pred combine_list_results(maybe1(T), maybe1(list(T)), maybe1(list(T))).
-:- mode combine_list_results(in, in, out) is det.
-combine_list_results(error(Msg, Term), _, error(Msg, Term)).
-combine_list_results(ok(_), error(Msg, Term), error(Msg, Term)).
-combine_list_results(ok(X), ok(Xs), ok([X|Xs])).
-
-%-----------------------------------------------------------------------------%
-
:- pred process_maybe1(maker(T1, T2), maybe1(T1), maybe1(T2)).
:- mode process_maybe1(maker, in, out) is det.
process_maybe1(Maker, ok(X), ok(Y)) :- call(Maker, X, Y).
@@ -2903,7 +3048,7 @@
:- pred parse_type(term, maybe1(type)).
:- mode parse_type(in, out) is det.
parse_type(T0, ok(T)) :-
- term__coerce(T0, T).
+ convert_type(T0, T).
:- pred convert_constructor_arg_list(module_name,
list(term), list(constructor_arg)).
@@ -2924,11 +3069,6 @@
Arg = no - Type
),
convert_constructor_arg_list(ModuleName, Terms, Args).
-
-:- pred convert_type(term, type).
-:- mode convert_type(in, out) is det.
-convert_type(T0, T) :-
- term__coerce(T0, T).
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.16
diff -u -u -r1.16 prog_io_dcg.m
--- compiler/prog_io_dcg.m 2000/09/18 11:51:40 1.16
+++ compiler/prog_io_dcg.m 2001/05/18 05:21:23
@@ -460,7 +460,7 @@
:- mode process_dcg_clause(in, in, in, in, in, out) is det.
process_dcg_clause(ok(Name, Args0), VarSet, Var0, Var, Body,
- ok(pred_clause(VarSet, Name, Args, Body))) :-
+ ok(clause(VarSet, predicate, Name, Args, Body))) :-
list__map(term__coerce, Args0, Args1),
list__append(Args1, [term__variable(Var0),
term__variable(Var)], Args).
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.30
diff -u -u -r1.30 prog_io_pragma.m
--- compiler/prog_io_pragma.m 2001/04/03 03:20:16 1.30
+++ compiler/prog_io_pragma.m 2001/05/24 03:06:54
@@ -24,7 +24,7 @@
:- import_module globals, prog_io, prog_io_goal, prog_util.
:- import_module term_util, term_errors.
-:- import_module int, map, string, std_util, bool, require.
+:- import_module int, map, string, std_util, bool, require, set.
parse_pragma(ModuleName, VarSet, PragmaTerms, Result) :-
(
@@ -800,7 +800,7 @@
),
Result = ok(pragma(type_spec(PredName,
SpecializedName, Arity, MaybePredOrFunc,
- MaybeModes, TypeSubn, TVarSet)))
+ MaybeModes, TypeSubn, TVarSet, set__init)))
;
Result = error(
"expected type substitution in `:- pragma type_spec' declaration",
@@ -1477,6 +1477,6 @@
Term = term__functor(term__atom("="), [TypeVarTerm, SpecTypeTerm0], _),
TypeVarTerm = term__variable(TypeVar0),
term__coerce_var(TypeVar0, TypeVar),
- term__coerce(SpecTypeTerm0, SpecType),
+ convert_type(SpecTypeTerm0, SpecType),
TypeSpec = TypeVar - SpecType.
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.19
diff -u -u -r1.19 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 2001/05/02 17:34:42 1.19
+++ compiler/prog_io_typeclass.m 2001/05/24 04:19:02
@@ -32,9 +32,9 @@
:- implementation.
-:- import_module prog_io, prog_io_goal, hlds_pred.
+:- import_module prog_io, prog_io_goal, prog_util, hlds_pred.
:- import_module term, varset.
-:- import_module string, std_util, require, type_util.
+:- import_module int, string, std_util, require, type_util, set.
parse_typeclass(ModuleName, VarSet, TypeClassTerm, Result) :-
%XXX should return an error if we get more than one arg,
@@ -220,22 +220,14 @@
item_to_class_method(error(String, Term), _, error(String, Term)).
item_to_class_method(ok(Item, Context), Term, Result) :-
(
- Item = pred(A, B, C, D, E, F, G, H, I)
+ Item = pred_or_func(A, B, C, D, E, F, G, H, I, J)
->
- Result = ok(pred(A, B, C, D, E, F, G, H, I, Context))
+ Result = ok(pred_or_func(A, B, C, D, E, F, G, H, I, J, Context))
;
- Item = func(A, B, C, D, E, F, G, H, I, J)
+ Item = pred_or_func_mode(A, B, C, D, E, F)
->
- Result = ok(func(A, B, C, D, E, F, G, H, I, J, Context))
+ Result = ok(pred_or_func_mode(A, B, C, D, E, F, Context))
;
- Item = pred_mode(A, B, C, D, E)
- ->
- Result = ok(pred_mode(A, B, C, D, E, Context))
- ;
- Item = func_mode(A, B, C, D, E, F)
- ->
- Result = ok(func_mode(A, B, C, D, E, F, Context))
- ;
Result = error("Only pred, func and mode declarations allowed in class interface", Term)
).
@@ -344,8 +336,7 @@
% we need to enforce the invariant that types in type class
% constraints do not contain any info in their prog_context
% fields
- list__map(term__coerce, Args0, Args1),
- strip_prog_contexts(Args1, Args),
+ list__map(convert_type, Args0, Args),
Result = ok(constraint(ClassName, Args))
;
Result = error("expected atom as class name", Constraint)
@@ -434,7 +425,7 @@
MaybeClassName = ok(ClassName, TermTypes0),
% check that the type in the name of the instance
% decl is a functor with vars as args
- list__map(term__coerce, TermTypes0, TermTypes),
+ list__map(convert_type, TermTypes0, TermTypes),
IsFunctorAndVarArgs = lambda([Type::in] is semidet,
(
% Is the top level functor an atom?
@@ -643,18 +634,12 @@
parse_item(DefaultModuleName, VarSet, MethodTerm, Result0),
(
Result0 = ok(Item, Context),
- (
- Item = pred_clause(_VarNames, ClassMethodName,
- HeadArgs, _ClauseBody),
- PredOrFunc = predicate,
- ArityInt = list__length(HeadArgs)
- ;
- Item = func_clause(_VarNames, ClassMethodName,
- FuncArgs, _Result, _ClauseBody),
- ArityInt = list__length(FuncArgs),
- PredOrFunc = function
- )
+ Item = clause(_VarNames, PredOrFunc,
+ ClassMethodName, HeadArgs,
+ _ClauseBody)
->
+ adjust_func_arity(PredOrFunc, ArityInt,
+ list__length(HeadArgs)),
Result = ok(instance_method(PredOrFunc,
ClassMethodName,
clauses([Item]),
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.19
diff -u -u -r1.19 prog_io_util.m
--- compiler/prog_io_util.m 2000/10/13 13:55:55 1.19
+++ compiler/prog_io_util.m 2001/05/25 09:02:29
@@ -48,6 +48,9 @@
:- type var2pvar == map(var, prog_var).
+:- type parser(T) == pred(term, maybe1(T)).
+:- mode parser :: pred(in, out) is det.
+
:- pred add_context(maybe1(item), prog_context, maybe_item_and_context).
:- mode add_context(in, in, out) is det.
@@ -81,6 +84,9 @@
list(term(_T))).
:- mode parse_pred_or_func_and_args(in, out, out, out) is semidet.
+:- pred convert_type(term(T), type).
+:- mode convert_type(in, out) is det.
+
:- pred convert_mode_list(list(term), list(mode)).
:- mode convert_mode_list(in, out) is semidet.
@@ -117,6 +123,15 @@
:- pred sum_to_list(term(T), list(term(T))).
:- mode sum_to_list(in, out) is det.
+ % Parse a comma-separated list (misleading described as
+ % a "conjunction") of things.
+
+:- pred parse_list(parser(T), term, maybe1(list(T))).
+:- mode parse_list(parser, in, out) is det.
+
+:- pred map_parser(parser(T), list(term), maybe1(list(T))).
+:- mode map_parser(parser, in, out) is det.
+
% The following /3, /4 and /5 predicates are to be used for reporting
% warnings to stderr. This is preferable to using io__write_string, as
% this checks the halt-at-warn option.
@@ -222,6 +237,25 @@
Head = term__variable(V),
parse_list_of_vars(Tail, Vs).
+convert_type(T0, T) :-
+ term__coerce(strip_prog_context(T0), T).
+
+ % Strip out the prog_context fields, replacing them with empty
+ % prog_context (as obtained by term__context_init/1)
+ % in a type or list of types.
+ %
+ % This is necessary to allow maps indexed by class constraints.
+ % Also, the version number computation for smart recompilation
+ % relies on being able to unify program items, which won't
+ % work if the types in the items contain context information.
+:- func strip_prog_context(term(T)) = term(T).
+
+strip_prog_context(term__variable(V)) = term__variable(V).
+strip_prog_context(term__functor(F, As, _)) =
+ term__functor(F,
+ list__map(strip_prog_context, As),
+ term__context_init).
+
convert_mode_list([], []).
convert_mode_list([H0|T0], [H|T]) :-
convert_mode(H0, H),
@@ -479,6 +513,27 @@
;
List = [Term|List0]
).
+
+parse_list(Parser, Term, Result) :-
+ conjunction_to_list(Term, List),
+ map_parser(Parser, List, Result).
+
+map_parser(_, [], ok([])).
+map_parser(Parser, [X|Xs], Result) :-
+ call(Parser, X, X_Result),
+ map_parser(Parser, Xs, Xs_Result),
+ combine_list_results(X_Result, Xs_Result, Result).
+
+ % If a list of things contains multiple errors, then we only
+ % report the first one.
+:- pred combine_list_results(maybe1(T), maybe1(list(T)), maybe1(list(T))).
+:- mode combine_list_results(in, in, out) is det.
+
+combine_list_results(error(Msg, Term), _, error(Msg, Term)).
+combine_list_results(ok(_), error(Msg, Term), error(Msg, Term)).
+combine_list_results(ok(X), ok(Xs), ok([X|Xs])).
+
+%-----------------------------------------------------------------------------%
report_warning(Message) -->
io__stderr_stream(StdErr),
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.51
diff -u -u -r1.51 prog_util.m
--- compiler/prog_util.m 2000/09/21 00:21:06 1.51
+++ compiler/prog_util.m 2001/05/18 09:13:51
@@ -124,6 +124,17 @@
%-----------------------------------------------------------------------------%
+ % adjust_func_arity(PredOrFunc, FuncArity, PredArity).
+ %
+ % We internally store the arity as the length of the argument
+ % list including the return value, which is one more than the
+ % arity of the function reported in error messages.
+:- pred adjust_func_arity(pred_or_func, int, int).
+:- mode adjust_func_arity(in, in, out) is det.
+:- mode adjust_func_arity(in, out, in) is det.
+
+%-----------------------------------------------------------------------------%
+
% make_pred_name_with_context(ModuleName, Prefix, PredOrFunc, PredName,
% Line, Counter, SymName).
%
@@ -217,6 +228,11 @@
construct_qualified_term(SymName, Args, Term) :-
term__context_init(Context),
construct_qualified_term(SymName, Args, Context, Term).
+
+%-----------------------------------------------------------------------------%
+
+adjust_func_arity(predicate, Arity, Arity).
+adjust_func_arity(function, Arity - 1, Arity).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/recompilation.m
===================================================================
RCS file: recompilation.m
diff -N recompilation.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ recompilation.m Mon May 28 18:07:20 2001
@@ -0,0 +1,384 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: recompilation.m
+% Main author: stayl
+%
+% Smart recompilation.
+%
+% Currently smart recompilation does not work properly with
+% inter-module optimization. If a `.opt' file changes, all modules
+% importing it need to be recompiled.
+%
+% A module must be recompiled if
+% - The file itself has changed.
+% - An imported item used in compiling the module has changed or been removed.
+% - An item has been added to an imported module which could cause an
+% ambiguity with an item used in compiling the module.
+%
+%-----------------------------------------------------------------------------%
+:- module recompilation.
+
+:- interface.
+
+:- import_module prog_data.
+:- import_module io, map, set, std_util, time.
+
+ % Identify a particular version of a program item.
+ % This could be done using a timestamp or a hash value.
+:- type version_number == time_t.
+
+:- func int_to_version_number(int) = version_number.
+
+:- pred write_version_number(version_number::in,
+ io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- type item_id
+ ---> item_id(item_type, item_name).
+
+:- type item_name == pair(sym_name, arity).
+
+:- type item_type
+ ---> (type) % Just the name of the type, not its body.
+ % It is common for a value of a type to
+ % be passed through a predicate without
+ % inspecting the value -- such predicates
+ % do not need to be recompiled if the
+ % body of the type changes (except for
+ % equivalence types).
+ ; type_body
+ ; (mode)
+ ; (inst)
+ ; (typeclass)
+ ; functor % The RHS of a var-functor unification.
+ ; predicate
+ ; function
+ .
+
+:- inst simple_item
+ ---> (type)
+ ; type_body
+ ; (mode)
+ ; (inst)
+ ; (typeclass)
+ .
+
+:- inst pred_or_func
+ ---> predicate
+ ; function
+ .
+
+:- pred is_simple_item_type(
+ item_type::(ground->simple_item)) is semidet.
+
+:- pred is_pred_or_func_item_type(
+ item_type::(ground->pred_or_func)) is semidet.
+
+:- pred string_to_item_type(string, item_type).
+:- mode string_to_item_type(in, out) is semidet.
+:- mode string_to_item_type(out, in) is det.
+
+:- func pred_or_func_to_item_type(pred_or_func::in)
+ = (item_type::out(pred_or_func)) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- type recompilation_info
+ ---> recompilation_info(
+ % name of the current module
+ module_name :: module_name,
+
+ % used items imported from other modules
+ used_items :: used_items,
+
+ % For now we only record dependencies of imported
+ % items on equivalence types. The rest of the
+ % dependencies can be found be examining the
+ % pred_infos, type_defns etc. of the items
+ % recorded in the used_items field above.
+ dependencies :: map(item_id, set(item_id)),
+
+ version_numbers :: map(module_name, version_numbers)
+ ).
+
+:- func init_recompilation_info(module_name) = recompilation_info.
+
+ % recompilation__add_used_item(ItemType, UnqualifiedId, QualifiedId,
+ % Info0, Info).
+ %
+ % Record a reference to UnqualifiedId, for which QualifiedId
+ % is the only match. If a new declaration is added so that
+ % QualifiedId is not the only match, we need to recompile.
+:- pred recompilation__record_used_item(item_type::in, item_name::in,
+ item_name::in, recompilation_info::in, recompilation_info::out) is det.
+
+ % For each imported item we need to record which equivalence types
+ % are used because equiv_type.m removes all references to the
+ % equivalence types, and at that point we don't know which imported
+ % items are going to be used by the compilation.
+:- pred recompilation__record_used_equivalence_types(item_id::in,
+ set(type_id)::in, recompilation_info::in,
+ recompilation_info::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- type item_id_set(Map, Set, Cons)
+ ---> item_id_set(
+ types :: Map,
+ type_bodies :: Map,
+ modes :: Map,
+ insts :: Map,
+ typeclasses :: Map,
+ functors :: Cons,
+ predicates :: Set,
+ functions :: Set
+ ).
+
+:- type item_id_set(T) == item_id_set(T, T, T).
+
+:- func init_item_id_set(T) = item_id_set(T).
+
+:- func init_item_id_set(Simple, PorF, Cons) = item_id_set(Simple, PorF, Cons).
+
+%-----------------------------------------------------------------------------%
+
+ % An simple_item_set records the single possible match for an item.
+:- type simple_item_set == map(pair(string, arity),
+ map(module_qualifier, module_name)).
+
+ % For constructors, predicates and functions we can't work out
+ % which item is actually used until we've run typechecking.
+ %
+:- type pred_or_func_set == simple_item_set.
+
+:- type functor_set == simple_item_set.
+
+ % Items which are used by local items.
+:- type used_items ==
+ item_id_set(
+ simple_item_set,
+ pred_or_func_set,
+ functor_set
+ ).
+
+:- func init_used_items = used_items.
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % Access functions for item_id_sets.
+ %
+
+:- func extract_simple_item_set(item_id_set(Simple, PorF, Cons)::in,
+ item_type::in(simple_item)) = (Simple::out) is det.
+
+:- func update_simple_item_set(item_id_set(Simple, PorF, Cons)::in,
+ item_type::in(simple_item), Simple::in)
+ = (item_id_set(Simple, PorF, Cons)::out) is det.
+
+:- func extract_pred_or_func_set(item_id_set(Simple, PorF, Cons)::in,
+ item_type::in(pred_or_func)) = (PorF::out) is det.
+
+:- func update_pred_or_func_set(item_id_set(Simple, PorF, Cons)::in,
+ item_type::in(pred_or_func), PorF::in)
+ = (item_id_set(Simple, PorF, Cons)::out) is det.
+
+:- func extract_ids(item_id_set(T), item_type) = T.
+
+:- func update_ids(item_id_set(T), item_type, T) = item_id_set(T).
+
+:- func map_ids((func(item_type, T) = U),
+ item_id_set(T), U) = item_id_set(U).
+
+%-----------------------------------------------------------------------------%
+
+ % Version numbers for items in a single module.
+:- type version_numbers == pair(item_version_numbers,
+ instance_version_numbers).
+
+ % The constructors set should always be empty -
+ % constructors are never imported separately.
+:- type item_version_numbers == item_id_set(version_number_map).
+
+:- type version_number_map == map(pair(string, arity), version_number).
+
+ % For each interface file, we keep a version number for each class.
+:- type instance_version_numbers == map(item_name, version_number).
+
+%-----------------------------------------------------------------------------%
+
+ % unqualified("") if the symbol was unqualified.
+:- type module_qualifier == module_name.
+
+:- func find_module_qualifier(sym_name) = module_qualifier.
+
+:- func module_qualify_name(module_qualifier, string) = sym_name.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module prog_util.
+:- import_module globals, options, passes_aux, modules.
+:- import_module int, time, bool, list, require, string.
+
+%-----------------------------------------------------------------------------%
+
+int_to_version_number(Int) = time__int_to_time_t(Int).
+
+write_version_number(VersionNumber) -->
+ io__format("%#x", [i(time__time_t_to_int(VersionNumber))]).
+
+%-----------------------------------------------------------------------------%
+
+pred_or_func_to_item_type(predicate) = predicate.
+pred_or_func_to_item_type(function) = function.
+
+is_simple_item_type((type)).
+is_simple_item_type(type_body).
+is_simple_item_type((inst)).
+is_simple_item_type((mode)).
+is_simple_item_type((typeclass)).
+
+is_pred_or_func_item_type(predicate).
+is_pred_or_func_item_type(function).
+
+string_to_item_type("type", (type)).
+string_to_item_type("type_body", type_body).
+string_to_item_type("inst", (inst)).
+string_to_item_type("mode", (mode)).
+string_to_item_type("typeclass", (typeclass)).
+string_to_item_type("predicate", predicate).
+string_to_item_type("function", function).
+string_to_item_type("functor", functor).
+
+%-----------------------------------------------------------------------------%
+
+init_item_id_set(Init) =
+ item_id_set(Init, Init, Init, Init, Init, Init, Init, Init).
+
+init_item_id_set(Simple, PorF, Cons) =
+ item_id_set(Simple, Simple, Simple, Simple, Simple,
+ Cons, PorF, PorF).
+
+init_used_items = item_id_set(map__init, map__init, map__init, map__init,
+ map__init, map__init, map__init, map__init).
+
+extract_simple_item_set(Items, type) = Items ^ types.
+extract_simple_item_set(Items, type_body) = Items ^ type_bodies.
+extract_simple_item_set(Items, mode) = Items ^ modes.
+extract_simple_item_set(Items, inst) = Items ^ insts.
+extract_simple_item_set(Items, typeclass) = Items ^ typeclasses.
+
+update_simple_item_set(Items, type, IdMap) = Items ^ types := IdMap.
+update_simple_item_set(Items, type_body, IdMap) = Items ^ type_bodies := IdMap.
+update_simple_item_set(Items, mode, IdMap) = Items ^ modes := IdMap.
+update_simple_item_set(Items, inst, IdMap) = Items ^ insts := IdMap.
+update_simple_item_set(Items, typeclass, IdMap) = Items ^ typeclasses := IdMap.
+
+extract_pred_or_func_set(Items, predicate) = Items ^ predicates.
+extract_pred_or_func_set(Items, function) = Items ^ functions.
+
+update_pred_or_func_set(Items, predicate, Set) = Items ^ predicates := Set.
+update_pred_or_func_set(Items, function, Set) = Items ^ functions := Set.
+
+extract_ids(Items, type) = Items ^ types.
+extract_ids(Items, type_body) = Items ^ type_bodies.
+extract_ids(Items, mode) = Items ^ modes.
+extract_ids(Items, inst) = Items ^ insts.
+extract_ids(Items, typeclass) = Items ^ typeclasses.
+extract_ids(Items, functor) = Items ^ functors.
+extract_ids(Items, predicate) = Items ^ predicates.
+extract_ids(Items, function) = Items ^ functions.
+
+update_ids(Items, type, IdMap) = Items ^ types := IdMap.
+update_ids(Items, type_body, IdMap) = Items ^ type_bodies := IdMap.
+update_ids(Items, mode, IdMap) = Items ^ modes := IdMap.
+update_ids(Items, inst, IdMap) = Items ^ insts := IdMap.
+update_ids(Items, typeclass, IdMap) = Items ^ typeclasses := IdMap.
+update_ids(Items, predicate, IdMap) = Items ^ predicates := IdMap.
+update_ids(Items, function, IdMap) = Items ^ functions := IdMap.
+update_ids(Items, functor, IdMap) = Items ^ functors := IdMap.
+
+map_ids(Func, Items0, Init) = Items :-
+ Items1 = init_item_id_set(Init),
+ Items = list__foldl(
+ (func(ItemType, NewItems0) =
+ update_ids(NewItems0, ItemType,
+ Func(ItemType, extract_ids(Items0, ItemType)))
+ ),
+ [(type), type_body, (mode), (inst), (typeclass),
+ functor, predicate, function],
+ Items1).
+
+%-----------------------------------------------------------------------------%
+
+find_module_qualifier(unqualified(_)) = unqualified("").
+find_module_qualifier(qualified(ModuleName, _)) = ModuleName.
+
+module_qualify_name(Qualifier, Name) =
+ ( Qualifier = unqualified("") ->
+ unqualified(Name)
+ ;
+ qualified(Qualifier, Name)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+init_recompilation_info(ModuleName) =
+ recompilation_info(
+ ModuleName,
+ init_used_items,
+ map__init,
+ map__init
+ ).
+
+recompilation__record_used_item(ItemType, Id, QualifiedId) -->
+ ItemSet0 =^ used_items,
+ { IdSet0 = extract_ids(ItemSet0, ItemType) },
+ { QualifiedId = QualifiedName - Arity },
+ { unqualify_name(QualifiedName, UnqualifiedName) },
+ { ModuleName = find_module_qualifier(QualifiedName) },
+ { UnqualifiedId = UnqualifiedName - Arity },
+ { Id = SymName - _ },
+ { ModuleQualifier = find_module_qualifier(SymName) },
+ ( { map__search(IdSet0, UnqualifiedId, MatchingNames0) } ->
+ { MatchingNames1 = MatchingNames0 }
+ ;
+ { map__init(MatchingNames1) }
+ ),
+ ( { map__contains(MatchingNames1, ModuleQualifier) } ->
+ []
+ ;
+ { map__det_insert(MatchingNames1, ModuleQualifier,
+ ModuleName, MatchingNames) },
+ { map__set(IdSet0, UnqualifiedId,
+ MatchingNames, IdSet) },
+ { ItemSet = update_ids(ItemSet0, ItemType, IdSet) },
+ ^ used_items := ItemSet
+ ).
+
+recompilation__record_used_equivalence_types(Item, UsedTypes, Info0, Info) :-
+ ( set__empty(UsedTypes) ->
+ Info = Info0
+ ;
+ DepsMap0 = Info0 ^ dependencies,
+ ( map__search(DepsMap0, Item, Deps0) ->
+ Deps1 = Deps0
+ ;
+ set__init(Deps1)
+ ),
+ UsedItems = list__map((func(TypeId) = item_id(type, TypeId)),
+ set__to_sorted_list(UsedTypes)),
+ set__insert_list(Deps1, UsedItems, Deps),
+ map__set(DepsMap0, Item, Deps, DepsMap),
+ Info = Info0 ^ dependencies := DepsMap
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/recompilation_check.m
===================================================================
RCS file: recompilation_check.m
diff -N recompilation_check.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ recompilation_check.m Mon May 28 17:16:00 2001
@@ -0,0 +1,1475 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: recompilation_check.m
+% Main author: stayl
+%
+% Check whether a module should be recompiled.
+%-----------------------------------------------------------------------------%
+:- module recompilation_check.
+
+:- interface.
+
+:- import_module modules, prog_io, prog_data.
+:- import_module list, io.
+
+:- type modules_to_recompile
+ ---> (all)
+ ; some(list(module_name))
+ .
+
+:- type find_target_file_names ==
+ pred(module_name, list(file_name), io__state, io__state).
+:- inst find_target_file_names ==
+ (pred(in, out, di, uo) is det).
+
+ % recompilation_check__should_recompile(ModuleName, FindTargetFiles,
+ % ModulesToRecompile, ReadModules)
+ %
+ % Process the `.used' files for the given module and all its
+ % inline sub-modules to find out which modules need to be recompiled.
+ % `FindTargetFiles' takes a module name and returns a list of
+ % file names which need to be up-to-date to avoid recompilation.
+ % `ReadModules' is the list of interface files read during
+ % recompilation checking, returned to avoid rereading them
+ % if recompilation is required.
+:- pred recompilation_check__should_recompile(module_name::in,
+ find_target_file_names::in(find_target_file_names),
+ modules_to_recompile::out, read_modules::out,
+ io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module recompilation, recompilation_usage, recompilation_version.
+:- import_module prog_io_util, prog_util, prog_out, error_util.
+:- import_module globals, options.
+:- import_module hlds_pred. % for field_access_function_name,
+ % type pred_id.
+:- import_module hlds_data. % for type field_access_type
+
+:- import_module assoc_list, bool, exception, int, map, parser, require.
+:- import_module set, std_util, string, term, term_io, time.
+
+recompilation_check__should_recompile(ModuleName, FindTargetFiles,
+ Info ^ modules_to_recompile, Info ^ read_modules) -->
+ { Info0 = recompilation_check_info(ModuleName, no, [], map__init,
+ init_item_id_set(map__init, map__init, map__init),
+ set__init, some([])) },
+ recompilation_check__should_recompile_2(no, FindTargetFiles,
+ ModuleName, Info0, Info).
+
+:- pred recompilation_check__should_recompile_2(bool::in,
+ find_target_file_names::in(find_target_file_names), module_name::in,
+ recompilation_check_info::in, recompilation_check_info::out,
+ io__state::di, io__state::uo) is det.
+
+recompilation_check__should_recompile_2(IsSubModule, FindTargetFiles,
+ ModuleName, Info0, Info) -->
+ { Info1 = (Info0 ^ module_name := ModuleName)
+ ^ sub_modules := [] },
+ module_name_to_file_name(ModuleName, ".used", no, UsageFileName),
+ io__open_input(UsageFileName, MaybeVersionStream),
+ (
+ { MaybeVersionStream = ok(VersionStream0) },
+ io__set_input_stream(VersionStream0, OldInputStream),
+
+ promise_only_solution_io(
+ (pred(R::out, di, uo) is cc_multi -->
+ try_io(
+ (pred(Info2::out, di, uo) is det -->
+ recompilation_check__should_recompile_3(
+ IsSubModule, FindTargetFiles,
+ Info1, Info2)
+ ), R)
+ ),
+ Result),
+ (
+ { Result = succeeded(Info4) },
+ write_recompilation_message(
+ (pred(di, uo) is det -->
+ io__write_string("Not recompiling module "),
+ prog_out__write_sym_name(ModuleName),
+ io__write_string(".\n")
+ ))
+ ;
+ { Result = failed },
+ { error("recompilation_check__should_recompile_2") }
+ ;
+ { Result = exception(Exception) },
+ { det_univ_to_type(Exception, RecompileException) },
+ { RecompileException =
+ recompile_exception(Reason, Info3) },
+ write_recompilation_message(
+ (pred(di, uo) is det -->
+ write_recompile_reason(ModuleName, Reason)
+ )),
+ { add_module_to_recompile(ModuleName, Info3, Info4) }
+ ),
+
+ io__set_input_stream(OldInputStream, VersionStream),
+ io__close_input(VersionStream),
+
+ ( { (all) = Info1 ^ modules_to_recompile } ->
+ { Info = Info4 }
+ ;
+ { Info5 = Info4 ^ is_inline_sub_module := yes },
+ list__foldl2(
+ recompilation_check__should_recompile_2(yes,
+ FindTargetFiles),
+ Info5 ^ sub_modules, Info5, Info)
+ )
+ ;
+ { MaybeVersionStream = error(_) },
+ write_recompilation_message(
+ (pred(di, uo) is det -->
+ { Reason = file_error(UsageFileName,
+ "file not found.") },
+ write_recompile_reason(ModuleName, Reason)
+ )),
+ { Info = Info1 ^ modules_to_recompile := (all) }
+ ).
+
+:- pred recompilation_check__should_recompile_3(bool::in,
+ find_target_file_names::in(find_target_file_names),
+ recompilation_check_info::in, recompilation_check_info::out,
+ io__state::di, io__state::uo) is det.
+
+recompilation_check__should_recompile_3(IsSubModule, FindTargetFiles,
+ Info0, Info) -->
+ %
+ % Check that the format of the usage file is the current format.
+ %
+ read_term_check_for_error_or_eof(Info0, "usage file version number",
+ VersionNumberTerm),
+ (
+ { VersionNumberTerm = term__functor(term__atom(","),
+ [UsageFileVersionNumberTerm,
+ VersionNumbersVersionNumberTerm], _) },
+ { UsageFileVersionNumberTerm =
+ term__functor(
+ term__integer(usage_file_version_number),
+ _, _) },
+ { VersionNumbersVersionNumberTerm =
+ term__functor(
+ term__integer(version_numbers_version_number),
+ _, _) }
+ ->
+ []
+ ;
+ io__input_stream_name(UsageFileName),
+ { throw(recompile_exception(file_error(UsageFileName,
+ "invalid usage file version number."), Info0)) }
+ ),
+
+ %
+ % Find the timestamp of the module the last time it was compiled.
+ %
+ read_term_check_for_error_or_eof(Info0, "module timestamp",
+ TimestampTerm),
+ { parse_module_timestamp(Info0, TimestampTerm, _, ModuleTimestamp) },
+ { ModuleTimestamp = module_timestamp(_, RecordedTimestamp, _) },
+
+ ( { IsSubModule = yes } ->
+ % For inline sub-modules we don't need to check
+ % the module timestamp because we've already checked
+ % the timestamp for the parent module.
+ []
+ ;
+ %
+ % If the module has changed, recompile.
+ %
+ { ModuleName = Info0 ^ module_name },
+ read_mod_if_changed(ModuleName, ".m", "Reading module",
+ yes, RecordedTimestamp, Items, Error,
+ FileName, MaybeNewTimestamp),
+ {
+ MaybeNewTimestamp = yes(NewTimestamp),
+ NewTimestamp \= RecordedTimestamp
+ ->
+ record_read_file(ModuleName,
+ ModuleTimestamp ^ timestamp := NewTimestamp,
+ Items, Error, FileName, Info0, ErrorInfo),
+ throw(recompile_exception(module_changed(FileName),
+ ErrorInfo))
+ ;
+ ( Error \= no
+ ; MaybeNewTimestamp = no
+ )
+ ->
+ throw(recompile_exception(
+ file_error(FileName, "error reading module."),
+ Info0))
+ ;
+ true
+ }
+ ),
+
+ %
+ % Check whether the output files are present and up-to-date.
+ %
+ FindTargetFiles(Info0 ^ module_name, TargetFiles),
+ list__foldl(
+ (pred(TargetFile::in, di, uo) is det -->
+ io__file_modification_time(TargetFile, TargetModTimeResult),
+ (
+ { TargetModTimeResult = ok(TargetModTime) },
+ { compare(TargetModTimeCompare, TargetModTime,
+ RecordedTimestamp) },
+ { TargetModTimeCompare = (>) }
+ ->
+ []
+ ;
+ { Reason1 = output_file_not_up_to_date(TargetFile) },
+ { throw(recompile_exception(Reason1, Info0)) }
+ )
+ ), TargetFiles),
+
+ %
+ % Find out whether this module has any inline sub-modules.
+ %
+ read_term_check_for_error_or_eof(Info0, "inline sub-modules",
+ SubModulesTerm),
+ {
+ SubModulesTerm = term__functor(term__atom("sub_modules"),
+ SubModuleTerms, _),
+ list__map(
+ (pred(Term::in, SubModule::out) is semidet :-
+ sym_name_and_args(Term, SubModule, [])
+ ),
+ SubModuleTerms, SubModules)
+ ->
+ Info1 = Info0 ^ sub_modules := SubModules
+ ;
+ Reason2 = syntax_error(get_term_context(SubModulesTerm),
+ "error in sub_modules term"),
+ throw(recompile_exception(Reason2, Info0))
+ },
+
+ %
+ % Read in the used items, used for checking for
+ % ambiguities with new items.
+ %
+ read_term_check_for_error_or_eof(Info1, "used items",
+ UsedItemsTerm),
+ { parse_used_items(Info1, UsedItemsTerm, UsedItems) },
+ { Info2 = Info1 ^ used_items := UsedItems },
+
+ read_term_check_for_error_or_eof(Info2, "used classes",
+ UsedClassesTerm),
+ {
+ UsedClassesTerm = term__functor(term__atom("used_classes"),
+ UsedClassTerms, _),
+ list__map(
+ (pred(Term::in, UsedClass::out) is semidet :-
+ parse_name_and_arity(Term,
+ ClassName, ClassArity),
+ UsedClass = ClassName - ClassArity
+ ), UsedClassTerms, UsedClasses)
+ ->
+ Info3 = Info2 ^ used_typeclasses :=
+ set__list_to_set(UsedClasses)
+ ;
+ Reason3 = syntax_error(get_term_context(UsedClassesTerm),
+ "error in used_typeclasses term"),
+ throw(recompile_exception(Reason3, Info2))
+ },
+ check_imported_modules(Info3, Info).
+
+
+%-----------------------------------------------------------------------------%
+
+:- pred parse_module_timestamp(recompilation_check_info::in, term::in,
+ module_name::out, module_timestamp::out) is det.
+
+parse_module_timestamp(Info, Term, ModuleName, ModuleTimestamp) :-
+ conjunction_to_list(Term, Args),
+ (
+ Args = [ModuleNameTerm, SuffixTerm,
+ TimestampTerm | MaybeOtherTerms],
+ sym_name_and_args(ModuleNameTerm, ModuleName0, []),
+ SuffixTerm = term__functor(term__string(Suffix), [], _),
+ TimestampTerm = term__functor(term__integer(Timestamp),
+ [], _),
+ (
+ MaybeOtherTerms = [term__functor(term__atom("used"),
+ [], _)],
+ NeedQualifier = must_be_qualified
+ ;
+ MaybeOtherTerms = [],
+ NeedQualifier = may_be_unqualified
+ )
+ ->
+ ModuleName = ModuleName0,
+ ModuleTimestamp = module_timestamp(Suffix,
+ int_to_time_t(Timestamp), NeedQualifier)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in module timestamp"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred parse_used_items(recompilation_check_info::in,
+ term::in, resolved_used_items::out) is det.
+
+parse_used_items(Info, Term, UsedItems) :-
+ ( Term = term__functor(term__atom("used_items"), UsedItemTerms, _) ->
+ list__foldl(parse_used_item_set(Info), UsedItemTerms,
+ init_item_id_set(map__init, map__init, map__init),
+ UsedItems)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in used items"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_used_item_set(recompilation_check_info::in, term::in,
+ resolved_used_items::in, resolved_used_items::out) is det.
+
+parse_used_item_set(Info, Term, UsedItems0, UsedItems) :-
+ (
+ Term = term__functor(term__atom(ItemTypeStr), ItemTerms, _),
+ string_to_item_type(ItemTypeStr, ItemType)
+ ->
+ ( is_simple_item_type(ItemType) ->
+ list__foldl(parse_simple_item(Info),
+ ItemTerms, map__init, SimpleItems),
+ UsedItems = update_simple_item_set(UsedItems0,
+ ItemType, SimpleItems)
+ ; is_pred_or_func_item_type(ItemType) ->
+ list__foldl(parse_pred_or_func_item(Info),
+ ItemTerms, map__init, PredOrFuncItems),
+ UsedItems = update_pred_or_func_set(UsedItems0,
+ ItemType, PredOrFuncItems)
+ ; ItemType = functor ->
+ list__foldl(parse_functor_item(Info),
+ ItemTerms, map__init, CtorItems),
+ UsedItems = UsedItems0 ^ functors := CtorItems
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ string__append(
+ "error in used items: unknown item type :",
+ ItemTypeStr)),
+ throw(recompile_exception(Reason, Info))
+ )
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in used items"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_simple_item(recompilation_check_info::in, term::in,
+ simple_item_set::in, simple_item_set::out) is det.
+
+parse_simple_item(Info, Term, Set0, Set) :-
+ (
+ Term = term__functor(term__atom("-"),
+ [NameArityTerm, MatchesTerm], _),
+ parse_name_and_arity(NameArityTerm, SymName, Arity)
+ ->
+ unqualify_name(SymName, Name),
+ conjunction_to_list(MatchesTerm, MatchTermList),
+ list__foldl(parse_simple_item_match(Info),
+ MatchTermList, map__init, Matches),
+ map__det_insert(Set0, Name - Arity, Matches, Set)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in simple items"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_simple_item_match(recompilation_check_info::in, term::in,
+ map(module_qualifier, module_name)::in,
+ map(module_qualifier, module_name)::out) is det.
+
+parse_simple_item_match(Info, Term, Items0, Items) :-
+ (
+ (
+ Term = term__functor(term__atom("=>"),
+ [QualifierTerm, ModuleNameTerm], _)
+ ->
+ sym_name_and_args(QualifierTerm, Qualifier, []),
+ sym_name_and_args(ModuleNameTerm, ModuleName, [])
+ ;
+ sym_name_and_args(Term, ModuleName, []),
+ Qualifier = ModuleName
+ )
+ ->
+ map__det_insert(Items0, Qualifier, ModuleName, Items)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in simple item match"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_pred_or_func_item(recompilation_check_info::in,
+ term::in, resolved_pred_or_func_set::in,
+ resolved_pred_or_func_set::out) is det.
+
+parse_pred_or_func_item(Info, Term, Set0, Set) :-
+ (
+ Term = term__functor(term__atom("-"),
+ [NameArityTerm, MatchesTerm], _),
+ parse_name_and_arity(NameArityTerm, SymName, Arity)
+ ->
+ unqualify_name(SymName, Name),
+ conjunction_to_list(MatchesTerm, MatchTermList),
+ list__foldl(parse_pred_or_func_item_match(Info),
+ MatchTermList, map__init, Matches),
+ map__det_insert(Set0, Name - Arity, Matches, Set)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in pred or func match"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_pred_or_func_item_match(recompilation_check_info::in, term::in,
+ resolved_pred_or_func_map::in, resolved_pred_or_func_map::out) is det.
+
+parse_pred_or_func_item_match(Info, Term, Items0, Items) :-
+ invalid_pred_id(PredId),
+ (
+ (
+ Term = term__functor(term__atom("=>"),
+ [QualifierTerm, MatchesTerm], _)
+ ->
+ sym_name_and_args(QualifierTerm, Qualifier, []),
+ conjunction_to_list(MatchesTerm, MatchesList),
+ list__map(
+ (pred(MatchTerm::in, Match::out) is semidet :-
+ sym_name_and_args(MatchTerm, MatchName, []),
+ Match = PredId - MatchName
+ ),
+ MatchesList, Matches)
+ ;
+ sym_name_and_args(Term, Qualifier, []),
+ Matches = [PredId - Qualifier]
+ )
+ ->
+ map__det_insert(Items0, Qualifier, set__list_to_set(Matches),
+ Items)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in pred or func match"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_functor_item(recompilation_check_info::in, term::in,
+ resolved_functor_set::in, resolved_functor_set::out) is det.
+
+parse_functor_item(Info, Term, Set0, Set) :-
+ (
+ Term = term__functor(term__atom("-"),
+ [NameTerm, MatchesTerm], _),
+ NameTerm = term__functor(term__atom(Name), [], _)
+ ->
+ conjunction_to_list(MatchesTerm, MatchTermList),
+ list__map(parse_functor_arity_matches(Info),
+ MatchTermList, Matches),
+ map__det_insert(Set0, Name, Matches, Set)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in functor matches"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_functor_arity_matches(recompilation_check_info::in, term::in,
+ pair(arity, resolved_functor_map)::out) is det.
+
+parse_functor_arity_matches(Info, Term, Arity - MatchMap) :-
+ (
+ Term = term__functor(term__atom("-"),
+ [ArityTerm, MatchesTerm], _),
+ ArityTerm = term__functor(term__integer(Arity0), [], _),
+ conjunction_to_list(MatchesTerm, MatchTermList)
+ ->
+ Arity = Arity0,
+ list__foldl(parse_functor_matches(Info),
+ MatchTermList, map__init, MatchMap)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in functor match"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_functor_matches(recompilation_check_info::in, term::in,
+ resolved_functor_map::in, resolved_functor_map::out) is det.
+
+parse_functor_matches(Info, Term, Map0, Map) :-
+ (
+ Term = term__functor(term__atom("=>"),
+ [QualifierTerm, MatchesTerm], _),
+ sym_name_and_args(QualifierTerm, Qualifier, [])
+ ->
+ conjunction_to_list(MatchesTerm, MatchesList),
+ list__map(parse_resolved_functor(Info),
+ MatchesList, Matches),
+ map__det_insert(Map0, Qualifier,
+ set__list_to_set(Matches), Map)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in functor match"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+:- pred parse_resolved_functor(recompilation_check_info::in, term::in,
+ resolved_functor::out) is det.
+
+parse_resolved_functor(Info, Term, Ctor) :-
+ (
+ Term = term__functor(term__atom(PredOrFuncStr),
+ [ModuleTerm, ArityTerm], _),
+ ( PredOrFuncStr = "predicate", PredOrFunc = predicate
+ ; PredOrFuncStr = "function", PredOrFunc = function
+ ),
+ sym_name_and_args(ModuleTerm, ModuleName, []),
+ ArityTerm = term__functor(term__integer(Arity), [], _)
+ ->
+ invalid_pred_id(PredId),
+ Ctor = pred_or_func(PredId, ModuleName,
+ PredOrFunc, Arity)
+ ;
+ Term = term__functor(term__atom("ctor"), [NameArityTerm], _),
+ parse_name_and_arity(NameArityTerm, TypeName, TypeArity)
+ ->
+ Ctor = constructor(TypeName - TypeArity)
+ ;
+ Term = term__functor(term__atom("field"),
+ [TypeNameArityTerm, ConsNameArityTerm], _),
+ parse_name_and_arity(TypeNameArityTerm, TypeName, TypeArity),
+ parse_name_and_arity(ConsNameArityTerm, ConsName, ConsArity)
+ ->
+ Ctor = field(TypeName - TypeArity, ConsName - ConsArity)
+ ;
+ Reason = syntax_error(get_term_context(Term),
+ "error in functor match"),
+ throw(recompile_exception(Reason, Info))
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % Check whether the interface file read for a module
+ % in the last compilation has changed, and if so whether
+ % the items have changed in a way which should cause
+ % a recompilation.
+ %
+:- pred check_imported_modules(recompilation_check_info::in,
+ recompilation_check_info::out, io__state::di, io__state::uo) is det.
+
+check_imported_modules(Info0, Info) -->
+ parser__read_term(TermResult),
+ (
+ { TermResult = term(_, Term) },
+ ( { Term = term__functor(term__atom("done"), [], _) } ->
+ { Info = Info0 }
+ ;
+ check_imported_module(Term, Info0, Info1),
+ check_imported_modules(Info1, Info)
+ )
+ ;
+ { TermResult = error(Message, Line) },
+ io__input_stream_name(FileName),
+ { Reason = syntax_error(term__context(FileName, Line),
+ Message) },
+ { throw(recompile_exception(Reason, Info0)) }
+ ;
+ { TermResult = eof },
+ %
+ % There should always be an item `done.' at the end of
+ % the list of modules to check. This is used to make
+ % sure that the writing of the `.used' file was not
+ % interrupted.
+ %
+ io__input_stream_name(FileName),
+ io__get_line_number(Line),
+ { Reason = syntax_error(term__context(FileName, Line),
+ "unexpected end of file") },
+ { throw(recompile_exception(Reason, Info0)) }
+ ).
+
+:- pred check_imported_module(term::in, recompilation_check_info::in,
+ recompilation_check_info::out, io__state::di, io__state::uo) is det.
+
+check_imported_module(Term, Info0, Info) -->
+ {
+ Term = term__functor(term__atom("=>"),
+ [TimestampTerm0, UsedItemsTerm0], _)
+ ->
+ TimestampTerm = TimestampTerm0,
+ MaybeUsedItemsTerm = yes(UsedItemsTerm0)
+ ;
+ TimestampTerm = Term,
+ MaybeUsedItemsTerm = no
+ },
+ { parse_module_timestamp(Info0, TimestampTerm,
+ ImportedModuleName, ModuleTimestamp) },
+
+ { ModuleTimestamp = module_timestamp(Suffix,
+ RecordedTimestamp, NeedQualifier) },
+ (
+ %
+ % If we're checking a sub-module, don't re-read
+ % interface files read for other modules checked
+ % during this compilation.
+ %
+ { Info0 ^ is_inline_sub_module = yes },
+ { find_read_module(Info0 ^ read_modules, ImportedModuleName,
+ Suffix, yes, Items0, MaybeNewTimestamp0,
+ Error0, FileName0) }
+ ->
+ { Items = Items0 },
+ { MaybeNewTimestamp = MaybeNewTimestamp0 },
+ { Error = Error0 },
+ { FileName = FileName0 },
+ { Recorded = bool__yes }
+ ;
+ { 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) }
+ ),
+ {
+ MaybeNewTimestamp = yes(NewTimestamp),
+ NewTimestamp \= RecordedTimestamp
+ ->
+ ( Recorded = no ->
+ record_read_file(ImportedModuleName,
+ ModuleTimestamp ^ timestamp := NewTimestamp,
+ Items, Error, FileName, Info0, Info1)
+ ;
+ Info1 = Info0
+ ),
+ (
+ MaybeUsedItemsTerm = yes(UsedItemsTerm),
+ Items = [VersionNumberItem | OtherItems],
+ VersionNumberItem = module_defn(_,
+ version_numbers(_, VersionNumbers)) - _
+ ->
+ check_module_used_items(ImportedModuleName,
+ NeedQualifier, RecordedTimestamp,
+ UsedItemsTerm, VersionNumbers,
+ OtherItems, Info1, Info)
+ ;
+ throw(recompile_exception(
+ module_changed(FileName), Info1))
+ )
+ ;
+ Error \= no
+ ->
+ throw(recompile_exception(
+ file_error(FileName, "error reading file."),
+ Info0))
+ ;
+ Info = Info0
+ }.
+
+:- pred check_module_used_items(module_name::in, need_qualifier::in,
+ time_t::in, term::in, version_numbers::in, item_list::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
+
+check_module_used_items(ModuleName, NeedQualifier, OldTimestamp,
+ UsedItemsTerm, NewVersionNumbers,
+ Items) -->
+
+ { recompilation_version__parse_version_numbers(UsedItemsTerm,
+ UsedItemsResult) },
+ =(Info0),
+ {
+ UsedItemsResult = ok(UsedVersionNumbers)
+ ;
+ UsedItemsResult = error(Msg, ErrorTerm),
+ Reason = syntax_error(get_term_context(ErrorTerm),
+ Msg),
+ throw(recompile_exception(Reason, Info0))
+ },
+
+ { UsedVersionNumbers = UsedItemVersionNumbers
+ - UsedInstanceVersionNumbers },
+ { NewVersionNumbers = NewItemVersionNumbers
+ - NewInstanceVersionNumbers },
+
+ %
+ % Check whether any of the items which were used have changed.
+ %
+ list__foldl(
+ check_item_version_numbers(ModuleName,
+ UsedItemVersionNumbers, NewItemVersionNumbers),
+ [(type), type_body, (inst), (mode), (typeclass),
+ predicate, function]),
+
+ %
+ % Check whether added or modified items could cause name
+ % resolution ambiguities with items which were used.
+ %
+ list__foldl(
+ check_for_ambiguities(NeedQualifier,
+ OldTimestamp, UsedItemVersionNumbers),
+ Items),
+
+ %
+ % Check whether any instances of used typeclasses have been
+ % added, removed or changed.
+ %
+ check_instance_version_numbers(ModuleName, UsedInstanceVersionNumbers,
+ NewInstanceVersionNumbers),
+
+ %
+ % Check for new instances for used typeclasses.
+ %
+ { ModuleInstances = set__sorted_list_to_set(
+ map__sorted_keys(NewInstanceVersionNumbers)) },
+ { UsedInstances = set__sorted_list_to_set(
+ map__sorted_keys(UsedInstanceVersionNumbers)) },
+
+ UsedClasses =^ used_typeclasses,
+ { set__difference(set__intersect(UsedClasses, ModuleInstances),
+ UsedInstances, AddedInstances) },
+ ( { [AddedInstance | _] = set__to_sorted_list(AddedInstances) } ->
+ =(Info),
+ { Reason1 = changed_or_added_instance(ModuleName,
+ AddedInstance) },
+ { throw(recompile_exception(Reason1, Info)) }
+ ;
+ []
+ ).
+
+:- func make_item_id(module_name, item_type, pair(string, arity)) = item_id.
+
+make_item_id(Module, ItemType, Name - Arity) =
+ item_id(ItemType, qualified(Module, Name) - Arity).
+
+%-----------------------------------------------------------------------------%
+
+:- pred check_item_version_numbers(module_name::in, item_version_numbers::in,
+ item_version_numbers::in, item_type::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
+
+check_item_version_numbers(ModuleName, UsedVersionNumbers,
+ NewVersionNumbers, ItemType) -->
+ { NewItemTypeVersionNumbers = extract_ids(NewVersionNumbers,
+ ItemType) },
+ map__foldl(
+ (pred(NameArity::in, UsedVersionNumber::in, in, out) is det -->
+ (
+ { map__search(NewItemTypeVersionNumbers,
+ NameArity, NewVersionNumber) }
+ ->
+ ( { NewVersionNumber = UsedVersionNumber } ->
+ []
+ ;
+ =(Info),
+ { Reason = changed_item(
+ make_item_id(ModuleName, ItemType,
+ NameArity)) },
+ { throw(recompile_exception(Reason, Info)) }
+ )
+ ;
+ =(Info),
+ { Reason = removed_item(make_item_id(ModuleName,
+ ItemType, NameArity)) },
+ { throw(recompile_exception(Reason, Info)) }
+ )
+ ),
+ extract_ids(UsedVersionNumbers, ItemType)).
+
+:- pred check_instance_version_numbers(module_name::in,
+ instance_version_numbers::in, instance_version_numbers::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
+
+check_instance_version_numbers(ModuleName, UsedInstanceVersionNumbers,
+ NewInstanceVersionNumbers) -->
+ map__foldl(
+ (pred(ClassId::in, UsedVersionNumber::in, in, out) is det -->
+ (
+ { map__search(NewInstanceVersionNumbers,
+ ClassId, NewVersionNumber) }
+ ->
+ ( { UsedVersionNumber = NewVersionNumber } ->
+ []
+ ;
+ { Reason = changed_or_added_instance(
+ ModuleName, ClassId) },
+ =(Info),
+ { throw(recompile_exception(Reason, Info)) }
+ )
+ ;
+ { Reason = removed_instance(ModuleName, ClassId) },
+ =(Info),
+ { throw(recompile_exception(Reason, Info)) }
+ )
+ ), UsedInstanceVersionNumbers).
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % For each item which has changed since the last time
+ % we read the interface file, check whether it introduces
+ % ambiguities with items which were used when the current
+ % module was last compiled.
+ %
+:- pred check_for_ambiguities(need_qualifier::in, time_t::in,
+ item_version_numbers::in, item_and_context::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
+
+check_for_ambiguities(_, _, _, clause(_, _, _, _, _) - _) -->
+ { error("check_for_ambiguities: clause") }.
+check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
+ type_defn(_, Name, Params, Body, _) - _) -->
+ { Arity = list__length(Params) },
+ check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
+ (type), Name, Arity, NeedsCheck),
+ ( { NeedsCheck = yes } ->
+ check_type_defn_ambiguity_with_functor(NeedQualifier,
+ Name - Arity, Body)
+ ;
+ []
+ ).
+check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
+ inst_defn(_, Name, Params, _, _) - _) -->
+ check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
+ (inst), Name, list__length(Params), _).
+check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
+ mode_defn(_, Name, Params, _, _) - _) -->
+ check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
+ (mode), Name, list__length(Params), _).
+check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
+ typeclass(_, Name, Params, Interface, _) - _) -->
+ check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
+ (typeclass), Name, list__length(Params), NeedsCheck),
+ ( { NeedsCheck = yes, Interface = concrete(Methods) } ->
+ list__foldl(
+ (pred(ClassMethod::in, in, out) is det -->
+ (
+ { ClassMethod = pred_or_func(_, _, _,
+ PredOrFunc, MethodName, MethodArgs,
+ _, _, _, _, _) },
+ check_for_pred_or_func_item_ambiguity(yes,
+ NeedQualifier, OldTimestamp,
+ VersionNumbers, PredOrFunc,
+ MethodName, MethodArgs)
+ ;
+ { ClassMethod = pred_or_func_mode(_, _, _, _,
+ _, _, _) }
+ )
+ ),
+ Methods)
+ ;
+ []
+ ).
+check_for_ambiguities(NeedQualifier, OldTimestamp, VersionNumbers,
+ pred_or_func(_, _, _, PredOrFunc, Name, Args, _, _, _, _) - _)
+ -->
+ check_for_pred_or_func_item_ambiguity(no, NeedQualifier, OldTimestamp,
+ VersionNumbers, PredOrFunc, Name, Args).
+check_for_ambiguities(_, _, _, pred_or_func_mode(_, _, _, _, _, _) - _) --> [].
+check_for_ambiguities(_, _, _, pragma(_) - _) --> [].
+check_for_ambiguities(_, _, _, assertion(_, _) - _) --> [].
+check_for_ambiguities(_, _, _, module_defn(_, _) - _) --> [].
+check_for_ambiguities(_, _, _, instance(_, _, _, _, _, _) - _) --> [].
+check_for_ambiguities(_, _, _, nothing(_) - _) --> [].
+
+:- pred check_for_pred_or_func_item_ambiguity(bool::in, need_qualifier::in,
+ time_t::in, item_version_numbers::in, pred_or_func::in,
+ sym_name::in, list(T)::in, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+check_for_pred_or_func_item_ambiguity(NeedsCheck0, NeedQualifier, OldTimestamp,
+ VersionNumbers, PredOrFunc, Name, Args) -->
+ { adjust_func_arity(PredOrFunc, Arity, list__length(Args)) },
+ check_for_ambiguity(NeedsCheck0, NeedQualifier, OldTimestamp,
+ VersionNumbers, pred_or_func_to_item_type(PredOrFunc),
+ Name, Arity, NeedsCheck),
+ ( { NeedsCheck = yes } ->
+ { invalid_pred_id(PredId) },
+ ( { Name = qualified(ModuleName, _) } ->
+ check_functor_ambiguities(NeedQualifier, Name,
+ less_than_or_equal(Arity),
+ pred_or_func(PredId, ModuleName,
+ PredOrFunc, Arity))
+ ;
+ { error(
+ "check_for_pred_or_func_item_ambiguity: unqualified predicate name") }
+ )
+ ;
+ []
+ ).
+
+:- pred check_for_ambiguity(need_qualifier::in, time_t::in,
+ item_version_numbers::in, item_type::in, sym_name::in,
+ arity::in, bool::out, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+check_for_ambiguity(NeedQualifier, OldTimestamp, VersionNumbers,
+ ItemType, SymName, Arity, NeedsCheck) -->
+ check_for_ambiguity(no, NeedQualifier, OldTimestamp, VersionNumbers,
+ ItemType, SymName, Arity, NeedsCheck).
+
+:- pred check_for_ambiguity(bool::in, need_qualifier::in, time_t::in,
+ item_version_numbers::in, item_type::in, sym_name::in,
+ arity::in, bool::out, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+check_for_ambiguity(IsClassMethod, NeedQualifier, UsedFileTimestamp,
+ UsedVersionNumbers, ItemType, SymName, Arity, NeedsCheck) -->
+ { unqualify_name(SymName, Name) },
+ (
+ % For a typeclass method, we've already found out
+ % that the typeclass declaration has changed.
+ { IsClassMethod = no },
+
+ %
+ % If the item has not changed since the last time we read the
+ % file we don't need to check for ambiguities.
+ %
+ { map__search(extract_ids(UsedVersionNumbers, ItemType),
+ Name - Arity, UsedVersionNumber) },
+
+ % XXX This assumes that version numbers are timestamps.
+ { UsedFileVersionNumber = int_to_version_number(
+ time_t_to_int(UsedFileTimestamp)) },
+ { compare(Result, UsedVersionNumber, UsedFileVersionNumber) },
+ { Result = (=)
+ ; Result = (<)
+ }
+ ->
+ { NeedsCheck = no }
+ ;
+ UsedItems =^ used_items,
+ ( { is_simple_item_type(ItemType) } ->
+ { UsedItemMap = extract_simple_item_set(UsedItems,
+ ItemType) },
+ (
+ { map__search(UsedItemMap, Name - Arity,
+ MatchingQualifiers) }
+ ->
+ map__foldl(
+ check_for_simple_item_ambiguity(
+ ItemType, Name, NeedQualifier,
+ SymName, Arity),
+ MatchingQualifiers)
+ ;
+ []
+ )
+ ; { is_pred_or_func_item_type(ItemType) } ->
+ { UsedItemMap = extract_pred_or_func_set(UsedItems,
+ ItemType) },
+ (
+ { map__search(UsedItemMap, Name - Arity,
+ MatchingQualifiers) }
+ ->
+ map__foldl(
+ check_for_pred_or_func_ambiguity(
+ ItemType, Name, NeedQualifier,
+ SymName, Arity),
+ MatchingQualifiers)
+ ;
+ []
+ )
+ ;
+ []
+ ),
+ { NeedsCheck = yes }
+ ).
+
+:- pred check_for_simple_item_ambiguity(item_type::in, string::in,
+ need_qualifier::in, sym_name::in, arity::in, module_qualifier::in,
+ module_name::in, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+check_for_simple_item_ambiguity(ItemType, Name, NeedQualifier, SymName, Arity,
+ ModuleQualifier, MatchingModuleName) -->
+ (
+ % XXX This is a bit conservative in the
+ % case of partially qualified names but that
+ % hopefully won't come up too often.
+ { NeedQualifier = must_be_qualified },
+ { ModuleQualifier = unqualified("") }
+ ->
+ []
+ ;
+ { QualifiedName = module_qualify_name(ModuleQualifier, Name) },
+ { match_sym_name(QualifiedName, SymName) }
+ ->
+ (
+ { SymName = qualified(MatchingModuleName, _) }
+ ->
+ []
+ ;
+ { OldMatchingName =
+ qualified(MatchingModuleName, Name) },
+ { Reason = item_ambiguity(
+ item_id(ItemType, SymName - Arity),
+ [item_id(ItemType, OldMatchingName - Arity)]
+ ) },
+ =(Info),
+ { throw(recompile_exception(Reason, Info)) }
+ )
+ ;
+ []
+ ).
+
+:- pred check_for_pred_or_func_ambiguity(item_type::in, string::in,
+ need_qualifier::in, sym_name::in, arity::in, module_qualifier::in,
+ set(pair(pred_id, module_name))::in, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+check_for_pred_or_func_ambiguity(ItemType, Name, NeedQualifier,
+ SymName, Arity, ModuleQualifier, MatchingModuleNames) -->
+ (
+ % XXX This is a bit conservative in the
+ % case of partially qualified names but that
+ % hopefully won't come up too often.
+ { NeedQualifier = must_be_qualified },
+ { ModuleQualifier = unqualified("") }
+ ->
+ []
+ ;
+ { QualifiedName = module_qualify_name(ModuleQualifier, Name) },
+ { match_sym_name(QualifiedName, SymName) }
+ ->
+ (
+ { SymName = qualified(PredModuleName, _) },
+ { set__member(_ - PredModuleName,
+ MatchingModuleNames) }
+ ->
+ []
+ ;
+ { AmbiguousDecls = list__map(
+ (func(_ - OldMatchingModule) = Item :-
+ OldMatchingName =
+ qualified(OldMatchingModule, Name),
+ Item = item_id(ItemType,
+ OldMatchingName - Arity)
+ ),
+ set__to_sorted_list(MatchingModuleNames)) },
+ { Reason = item_ambiguity(
+ item_id(ItemType, SymName - Arity),
+ AmbiguousDecls
+ ) },
+ =(Info),
+ { throw(recompile_exception(Reason, Info)) }
+ )
+ ;
+ []
+ ).
+
+ %
+ % Go over the constructors for a type which has changed
+ % and check whether any of them could create an ambiguity
+ % with functors used during the last compilation.
+ %
+:- pred check_type_defn_ambiguity_with_functor(need_qualifier::in,
+ type_id::in, type_defn::in, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+check_type_defn_ambiguity_with_functor(_, _, abstract_type) --> [].
+check_type_defn_ambiguity_with_functor(_, _, eqv_type(_)) --> [].
+check_type_defn_ambiguity_with_functor(_, _, uu_type(_)) --> [].
+check_type_defn_ambiguity_with_functor(NeedQualifier,
+ TypeId, du_type(Ctors, _)) -->
+ list__foldl(check_functor_ambiguities(NeedQualifier, TypeId),
+ Ctors).
+
+:- pred check_functor_ambiguities(need_qualifier::in, type_id::in,
+ constructor::in, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+check_functor_ambiguities(NeedQualifier, TypeId,
+ ctor(_, _, Name, Args)) -->
+ { ResolvedCtor = constructor(TypeId) },
+ { Arity = list__length(Args) },
+ check_functor_ambiguities(NeedQualifier, Name, exact(Arity),
+ ResolvedCtor),
+ list__foldl(
+ check_field_ambiguities(NeedQualifier,
+ field(TypeId, Name - Arity)),
+ Args).
+
+:- pred check_field_ambiguities(need_qualifier::in, resolved_functor::in,
+ constructor_arg::in, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+check_field_ambiguities(_, _, no - _) --> [].
+check_field_ambiguities(NeedQualifier, ResolvedCtor, yes(FieldName) - _) -->
+ %
+ % XXX The arities to match below will need to change if we ever
+ % allow taking the address of field access functions.
+ %
+ { field_access_function_name(get, FieldName, ExtractFuncName) },
+ check_functor_ambiguities(NeedQualifier, ExtractFuncName,
+ exact(1), ResolvedCtor),
+ { field_access_function_name(set, FieldName, UpdateFuncName) },
+ check_functor_ambiguities(NeedQualifier, UpdateFuncName,
+ exact(2), ResolvedCtor).
+
+ %
+ % Predicates and functions used as functors can match
+ % any arity less than or equal to the predicate or function's
+ % arity.
+ %
+:- type functor_match_arity
+ ---> exact(arity)
+ ; less_than_or_equal(arity)
+ .
+
+:- pred check_functor_ambiguities(need_qualifier::in, sym_name::in,
+ functor_match_arity::in, resolved_functor::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
+
+check_functor_ambiguities(NeedQualifier, Name, MatchArity, ResolvedCtor) -->
+ UsedItems =^ used_items,
+ { unqualify_name(Name, UnqualName) },
+ { UsedCtors = UsedItems ^ functors },
+ ( { map__search(UsedCtors, UnqualName, UsedCtorAL) } ->
+ check_functor_ambiguities_2(NeedQualifier, Name, MatchArity,
+ ResolvedCtor, UsedCtorAL)
+ ;
+ []
+ ).
+
+:- pred check_functor_ambiguities_2(need_qualifier::in, sym_name::in,
+ functor_match_arity::in, resolved_functor::in,
+ assoc_list(arity, resolved_functor_map)::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
+
+check_functor_ambiguities_2(_, _, _, _, []) --> [].
+check_functor_ambiguities_2(NeedQualifier, Name, MatchArity,
+ ResolvedCtor, [Arity - UsedCtorMap | UsedCtorAL]) -->
+ (
+ { MatchArity = exact(ArityToMatch) },
+ { ArityToMatch = Arity ->
+ Check = bool__yes,
+ Continue = bool__no
+ ;
+ Check = no,
+ ( Arity < ArityToMatch ->
+ Continue = yes
+ ;
+ Continue = no
+ )
+ }
+ ;
+ { MatchArity = less_than_or_equal(ArityToMatch) },
+ { Arity =< ArityToMatch ->
+ Check = yes,
+ Continue = yes
+ ;
+ Check = no,
+ Continue = no
+ }
+ ),
+ ( { Check = yes } ->
+ map__foldl(
+ check_functor_ambiguity(NeedQualifier,
+ Name, Arity, ResolvedCtor),
+ UsedCtorMap)
+ ;
+ []
+ ),
+ ( { Continue = yes } ->
+ check_functor_ambiguities_2(NeedQualifier, Name, MatchArity,
+ ResolvedCtor, UsedCtorAL)
+ ;
+ []
+ ).
+
+:- pred check_functor_ambiguity(need_qualifier::in,
+ sym_name::in, arity::in, resolved_functor::in,
+ module_qualifier::in, set(resolved_functor)::in,
+ recompilation_check_info::in, recompilation_check_info::out) is det.
+
+check_functor_ambiguity(NeedQualifier, SymName, Arity, ResolvedCtor,
+ Qualifier, ResolvedCtors) -->
+ (
+ % XXX This is a bit conservative in the
+ % case of partially qualified names but that
+ % hopefully won't come up too often.
+ { NeedQualifier = must_be_qualified },
+ { Qualifier = unqualified("") }
+ ->
+ []
+ ;
+ { set__member(ResolvedCtor, ResolvedCtors) }
+ ->
+ []
+ ;
+ { unqualify_name(SymName, Name) },
+ { Reason = functor_ambiguity(
+ module_qualify_name(Qualifier, Name),
+ Arity,
+ ResolvedCtor,
+ set__to_sorted_list(ResolvedCtors)
+ ) },
+ =(Info),
+ { throw(recompile_exception(Reason, Info)) }
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type recompilation_check_info
+ ---> recompilation_check_info(
+ module_name :: module_name,
+ is_inline_sub_module :: bool,
+ sub_modules :: list(module_name),
+ read_modules :: read_modules,
+ used_items :: resolved_used_items,
+ used_typeclasses :: set(item_name),
+ modules_to_recompile :: modules_to_recompile
+ ).
+
+:- type recompile_exception
+ ---> recompile_exception(
+ recompile_reason,
+ recompilation_check_info
+ ).
+
+:- type recompile_reason
+ ---> file_error(
+ file_name,
+ string
+ )
+
+ ; output_file_not_up_to_date(
+ file_name
+ )
+
+ ; syntax_error(
+ term__context,
+ string
+ )
+
+ ; module_changed(
+ file_name
+ )
+
+ ; item_ambiguity(
+ item_id, % new item.
+ list(item_id) % ambiguous declarations.
+ )
+
+ ; functor_ambiguity(
+ sym_name,
+ arity,
+ resolved_functor, % new item.
+ list(resolved_functor)
+ % ambiguous declarations.
+ )
+
+ ; changed_item(
+ item_id
+ )
+
+ ; removed_item(
+ item_id
+ )
+
+ ; changed_or_added_instance(
+ module_name,
+ item_name % class name
+ )
+
+ ; removed_instance(
+ module_name,
+ item_name % class name
+ )
+ .
+
+:- pred add_module_to_recompile(module_name::in, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+add_module_to_recompile(Module, Info0, Info) :-
+ ModulesToRecompile0 = Info0 ^ modules_to_recompile,
+ (
+ ModulesToRecompile0 = (all),
+ Info = Info0
+ ;
+ ModulesToRecompile0 = some(Modules0),
+ Info = Info0 ^ modules_to_recompile :=
+ some([Module | Modules0])
+ ).
+
+:- pred record_read_file(module_name::in, module_timestamp::in, item_list::in,
+ module_error::in, file_name::in, recompilation_check_info::in,
+ recompilation_check_info::out) is det.
+
+record_read_file(ModuleName, ModuleTimestamp, Items, Error, FileName) -->
+ Imports0 =^ read_modules,
+ { map__set(Imports0, ModuleName - ModuleTimestamp ^ suffix,
+ read_module(ModuleTimestamp, Items, Error, FileName),
+ Imports) },
+ ^ read_modules := Imports.
+
+%-----------------------------------------------------------------------------%
+
+:- pred write_recompilation_message(pred(io__state, io__state),
+ io__state, io__state).
+:- mode write_recompilation_message(pred(di, uo) is det, di, uo) is det.
+
+write_recompilation_message(P) -->
+ globals__io_lookup_bool_option(verbose_recompilation, Verbose),
+ ( { Verbose = yes } ->
+ P
+ ;
+ []
+ ).
+
+:- pred write_recompile_reason(module_name::in, recompile_reason::in,
+ io__state::di, io__state::uo) is det.
+
+write_recompile_reason(ModuleName, Reason) -->
+ { recompile_reason_message(Reason, MaybeContext, ErrorPieces0) },
+ { ErrorPieces =
+ [words("Recompiling module"),
+ words(string__append(describe_sym_name(ModuleName), ":")),
+ nl
+ | ErrorPieces0] },
+ write_error_pieces_maybe_with_context(MaybeContext, 0, ErrorPieces).
+
+:- pred recompile_reason_message(recompile_reason::in, maybe(context)::out,
+ list(format_component)::out) is det.
+
+recompile_reason_message(file_error(FileName, Msg), no,
+ [words(string__append(FileName, ":")), words(Msg)]).
+recompile_reason_message(output_file_not_up_to_date(FileName), no,
+ [words("output file"), words(FileName),
+ words("is not up to date.")]).
+recompile_reason_message(syntax_error(Context, Msg), yes(Context),
+ [words(Msg)]).
+recompile_reason_message(module_changed(FileName), no,
+ [words(FileName), words("has changed.")]).
+recompile_reason_message(item_ambiguity(Item, AmbiguousItems), no, Pieces) :-
+ AmbiguousItemPieces = component_lists_to_pieces(
+ list__map(describe_item, AmbiguousItems)),
+ Pieces = append_punctuation(
+ list__condense([
+ [words("addition of ") | describe_item(Item)],
+ [words("could cause an ambiguity with")],
+ AmbiguousItemPieces]),
+ '.').
+recompile_reason_message(functor_ambiguity(SymName, Arity,
+ Functor, AmbiguousFunctors), no, Pieces) :-
+ FunctorPieces = describe_functor(SymName, Arity, Functor),
+ AmbiguousFunctorPieces = component_lists_to_pieces(
+ list__map(describe_functor(SymName, Arity),
+ AmbiguousFunctors)),
+ Pieces = append_punctuation(
+ list__condense([
+ [words("addition of ") | FunctorPieces],
+ [words("could cause an ambiguity with")],
+ AmbiguousFunctorPieces]),
+ '.').
+recompile_reason_message(changed_item(Item), no,
+ list__append(describe_item(Item), [words("was modified.")])).
+recompile_reason_message(removed_item(Item), no,
+ list__append(describe_item(Item), [words("was removed.")])).
+recompile_reason_message(
+ changed_or_added_instance(ModuleName, ClassName - ClassArity),
+ no,
+ [
+ words("an instance for class"),
+ words(describe_sym_name_and_arity(ClassName / ClassArity)),
+ words("in module"),
+ words(describe_sym_name(ModuleName)),
+ words("was added or modified.")
+ ]).
+recompile_reason_message(removed_instance(ModuleName, ClassName - ClassArity),
+ no,
+ [
+ words("an instance for class "),
+ words(describe_sym_name_and_arity(ClassName / ClassArity)),
+ words("in module"),
+ words(describe_sym_name(ModuleName)),
+ words("was removed.")
+ ]).
+
+:- func describe_item(item_id) = list(format_component).
+
+describe_item(item_id(ItemType0, SymName - Arity)) = Pieces :-
+ ( body_item(ItemType0, ItemType1) ->
+ ItemType = ItemType1,
+ BodyWords = "body of "
+ ;
+ ItemType = ItemType0,
+ BodyWords = ""
+ ),
+ string_to_item_type(ItemTypeStr, ItemType),
+ Pieces = [
+ words(string__append(BodyWords, ItemTypeStr)),
+ words(describe_sym_name_and_arity(SymName / Arity))
+ ].
+
+:- pred body_item(item_type::in, item_type::out) is semidet.
+
+body_item(type_body, (type)).
+
+:- func describe_functor(sym_name, arity, resolved_functor) =
+ list(format_component).
+
+describe_functor(SymName, _Arity,
+ pred_or_func(_, ModuleName, PredOrFunc, PredArity)) =
+ [words(ItemTypeStr), SymNameAndArityPiece] :-
+ string_to_item_type(ItemTypeStr,
+ pred_or_func_to_item_type(PredOrFunc)),
+ unqualify_name(SymName, UnqualName),
+ SymNameAndArityPiece = words(describe_sym_name_and_arity(
+ qualified(ModuleName, UnqualName) / PredArity)).
+describe_functor(SymName, Arity, constructor(TypeName - TypeArity)) =
+ [words("constructor"),
+ words(describe_sym_name_and_arity(SymName / Arity)),
+ words("of type"),
+ words(describe_sym_name_and_arity(TypeName / TypeArity))
+ ].
+describe_functor(SymName, Arity,
+ field(TypeName - TypeArity, ConsName - ConsArity)) =
+ [words("field access function"),
+ words(describe_sym_name_and_arity(SymName / Arity)),
+ words("for constructor"),
+ words(describe_sym_name_and_arity(ConsName / ConsArity)),
+ words("of type"),
+ words(describe_sym_name_and_arity(TypeName / TypeArity))
+ ].
+
+%-----------------------------------------------------------------------------%
+
+:- pred read_term_check_for_error_or_eof(recompilation_check_info::in,
+ string::in, term::out, io__state::di, io__state::uo) is det.
+
+read_term_check_for_error_or_eof(Info, Item, Term) -->
+ parser__read_term(TermResult),
+ (
+ { TermResult = term(_, Term) }
+ ;
+ { TermResult = error(Message, Line) },
+ io__input_stream_name(FileName),
+ { Reason = syntax_error(term__context(FileName, Line),
+ Message) },
+ { throw(recompile_exception(Reason, Info)) }
+ ;
+ { TermResult = eof },
+ io__input_stream_name(FileName),
+ io__get_line_number(Line),
+ { Reason = syntax_error(term__context(FileName, Line),
+ string__append_list(
+ ["unexpected end of file, expected ",
+ Item, "."])) },
+ { throw(recompile_exception(Reason, Info)) }
+ ).
+
+:- func get_term_context(term) = term__context.
+
+get_term_context(Term) =
+ ( Term = term__functor(_, _, Context) ->
+ Context
+ ;
+ term__context_init
+ ).
+
+%-----------------------------------------------------------------------------%
Index: compiler/recompilation_usage.m
===================================================================
RCS file: recompilation_usage.m
diff -N recompilation_usage.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ recompilation_usage.m Mon May 28 17:43:10 2001
@@ -0,0 +1,1459 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: recompilation_usage.m
+% Main author: stayl
+%
+% Write the file recording which imported items were used by a compilation.
+%-----------------------------------------------------------------------------%
+:- module recompilation_usage.
+
+:- interface.
+
+:- import_module hlds_module, hlds_pred, modules, recompilation, prog_data.
+:- import_module assoc_list, io, list, map, set, std_util.
+
+ %
+ % The resolved_used_items records the possible matches
+ % for a program item. It is used by recompilation_check.m
+ % to work out whether a new item could cause ambiguity with
+ % an item which was used during a compilation.
+ %
+:- type resolved_used_items ==
+ item_id_set(simple_item_set, resolved_pred_or_func_set,
+ resolved_functor_set).
+
+:- type resolved_pred_or_func_set ==
+ map(pair(string, arity), resolved_pred_or_func_map).
+
+:- type resolved_pred_or_func_map ==
+ map(module_qualifier, set(pair(pred_id, module_name))).
+
+ % A resolved_functor_set records all possible matches
+ % for each functor application.
+:- type resolved_functor_set == map(string, resolved_functor_list).
+
+ % The list is sorted on arity.
+ % This is useful because when determining whether
+ % there is an ambiguity we need to test a predicate or
+ % function against all used functors with equal or
+ % lower arity.
+:- type resolved_functor_list ==
+ assoc_list(arity, resolved_functor_map).
+
+:- type resolved_functor_map ==
+ map(module_qualifier, set(resolved_functor)).
+
+:- type resolved_functor
+ ---> pred_or_func(
+ pred_id,
+ module_name,
+ pred_or_func,
+ arity % The actual arity of the
+ % predicate or function
+ )
+ ; constructor(
+ item_name % type_id
+ )
+ ; field(
+ item_name, % type_id
+ item_name % cons_id
+ )
+ .
+
+:- pred recompilation_usage__write_usage_file(module_info::in,
+ list(module_name)::in, maybe(module_timestamps)::in,
+ io__state::di, io__state::uo) is det.
+
+ % Changes which modify the format of the `.used' files will
+ % increment this number. recompilation_check.m should recompile
+ % if the version number is out of date.
+:- func usage_file_version_number = int.
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module hlds_data, hlds_pred, prog_util, type_util, (inst).
+:- import_module hlds_out, mercury_to_mercury, passes_aux, prog_data.
+:- import_module globals, options.
+:- import_module recompilation_version.
+
+:- import_module assoc_list, bool, int, require.
+:- import_module queue, std_util, string, time.
+
+recompilation_usage__write_usage_file(ModuleInfo, InlineSubModules,
+ MaybeTimestamps) -->
+ { module_info_get_maybe_recompilation_info(ModuleInfo,
+ MaybeRecompInfo) },
+ (
+ { MaybeRecompInfo = yes(RecompInfo) },
+ { MaybeTimestamps = yes(Timestamps) }
+ ->
+ globals__io_lookup_bool_option(verbose, Verbose),
+ maybe_write_string(Verbose,
+ "% Writing recompilation compilation dependency information\n"),
+
+ { module_info_name(ModuleInfo, ModuleName) },
+ module_name_to_file_name(ModuleName, ".used", yes, FileName),
+ io__open_output(FileName, FileResult),
+ (
+ { FileResult = ok(Stream0) },
+ io__set_output_stream(Stream0, OldStream),
+ recompilation_usage__write_usage_file_2(ModuleInfo,
+ InlineSubModules, RecompInfo, Timestamps),
+ io__set_output_stream(OldStream, Stream),
+ io__close_output(Stream)
+ ;
+ { FileResult = error(IOError) },
+ { io__error_message(IOError, IOErrorMessage) },
+ io__write_string("\nError opening `"),
+ io__write_string(FileName),
+ io__write_string("'for output: "),
+ io__write_string(IOErrorMessage),
+ io__write_string(".\n"),
+ io__set_exit_status(1)
+ )
+ ;
+ []
+ ).
+
+:- pred recompilation_usage__write_usage_file_2(module_info::in,
+ list(module_name)::in, recompilation_info::in,
+ module_timestamps::in, io__state::di, io__state::uo) is det.
+
+recompilation_usage__write_usage_file_2(ModuleInfo, InlineSubModules,
+ RecompInfo, Timestamps) -->
+ io__write_int(usage_file_version_number),
+ io__write_string(","),
+ io__write_int(version_numbers_version_number),
+ io__write_string(".\n\n"),
+
+ { module_info_name(ModuleInfo, ThisModuleName) },
+ { map__lookup(Timestamps, ThisModuleName,
+ module_timestamp(_, ThisModuleTimestamp, _)) },
+ io__write_string("("),
+ mercury_output_bracketed_sym_name(ThisModuleName),
+ io__write_string(", "".m"", "),
+ write_version_number(ThisModuleTimestamp),
+ io__write_string(").\n\n"),
+
+ ( { InlineSubModules = [] } ->
+ io__write_string("sub_modules.\n\n")
+ ;
+ io__write_string("sub_modules("),
+ io__write_list(InlineSubModules, ", ",
+ mercury_output_bracketed_sym_name),
+ io__write_string(").\n\n")
+ ),
+
+ { UsedItems = RecompInfo ^ used_items },
+ { recompilation_usage__find_all_used_imported_items(ModuleInfo,
+ UsedItems, RecompInfo ^ dependencies, ResolvedUsedItems,
+ UsedClasses, ImportedItems, ModuleInstances) },
+
+ ( { UsedItems = init_used_items } ->
+ io__write_string("used_items.\n")
+ ;
+ io__write_string("used_items(\n\t"),
+ { WriteComma0 = no },
+ write_simple_item_matches((type), ResolvedUsedItems,
+ WriteComma0, WriteComma1),
+ write_simple_item_matches(type_body, ResolvedUsedItems,
+ WriteComma1, WriteComma2),
+ write_simple_item_matches((mode), ResolvedUsedItems,
+ WriteComma2, WriteComma3),
+ write_simple_item_matches((inst), ResolvedUsedItems,
+ WriteComma3, WriteComma4),
+ write_simple_item_matches((typeclass), ResolvedUsedItems,
+ WriteComma4, WriteComma5),
+ write_pred_or_func_matches((predicate), ResolvedUsedItems,
+ WriteComma5, WriteComma6),
+ write_pred_or_func_matches((function), ResolvedUsedItems,
+ WriteComma6, WriteComma7),
+ write_functor_matches(ResolvedUsedItems ^ functors,
+ WriteComma7, _),
+ io__write_string("\n).\n\n")
+ ),
+
+ ( { set__empty(UsedClasses) } ->
+ io__write_string("used_classes.\n")
+ ;
+ io__write_string("used_classes("),
+ io__write_list(set__to_sorted_list(UsedClasses), ", ",
+ (pred((ClassName - ClassArity)::in, di, uo) is det -->
+ mercury_output_bracketed_sym_name(ClassName),
+ io__write_string("/"),
+ io__write_int(ClassArity)
+ )),
+ io__write_string(").\n")
+ ),
+
+ map__foldl(
+ (pred(ModuleName::in, ModuleUsedItems::in, di, uo) is det -->
+ io__nl,
+ io__write_string("("),
+ mercury_output_bracketed_sym_name(ModuleName),
+ io__write_string(", """),
+ { map__lookup(Timestamps, ModuleName,
+ module_timestamp(Suffix, ModuleTimestamp,
+ NeedQualifier)) },
+ io__write_string(Suffix),
+ io__write_string(""", "),
+ write_version_number(ModuleTimestamp),
+ ( { NeedQualifier = must_be_qualified } ->
+ io__write_string(", used)")
+ ;
+ io__write_string(")")
+ ),
+ (
+ % XXX We don't yet record all uses of items
+ % from these modules in polymorphism.m, etc.
+ \+ { any_mercury_builtin_module(ModuleName) },
+ { map__search(RecompInfo ^ version_numbers, ModuleName,
+ ModuleItemVersions - ModuleInstanceVersions) }
+ ->
+ %
+ % Select out from the version numbers of all items
+ % in the imported module the ones which are used.
+ %
+
+ { ModuleUsedItemVersions = map_ids(
+ (func(ItemType, Ids0) = Ids :-
+ ModuleItemNames = extract_ids(
+ ModuleUsedItems, ItemType),
+ map__select(Ids0, ModuleItemNames, Ids)
+ ),
+ ModuleItemVersions,
+ map__init) },
+
+ {
+ map__search(ModuleInstances, ModuleName,
+ ModuleUsedInstances)
+ ->
+ map__select(ModuleInstanceVersions,
+ ModuleUsedInstances,
+ ModuleUsedInstanceVersions)
+ ;
+ map__init(ModuleUsedInstanceVersions)
+ },
+
+ io__write_string(" => "),
+ { ModuleUsedVersionNumbers = ModuleUsedItemVersions
+ - ModuleUsedInstanceVersions },
+ recompilation_version__write_version_numbers(
+ ModuleUsedVersionNumbers),
+ io__write_string(".\n")
+ ;
+ % If we don't have version numbers for a module
+ % we just recompile if the interface file's
+ % timestamp changes.
+ io__write_string(".\n")
+ )
+ ), ImportedItems),
+
+ %
+ % recompilation_check.m checks for this item when reading
+ % in the `.used' file to make sure the earlier compilation
+ % wasn't interrupted in the middle of writing the file.
+ %
+ io__nl,
+ io__write_string("done.\n").
+
+:- pred write_simple_item_matches(item_type::in(simple_item),
+ resolved_used_items::in, bool::in, bool::out,
+ io__state::di, io__state::uo) is det.
+
+write_simple_item_matches(ItemType, UsedItems, WriteComma0, WriteComma) -->
+ { Ids = extract_simple_item_set(UsedItems, ItemType) },
+ ( { map__is_empty(Ids) } ->
+ { WriteComma = WriteComma0 }
+ ;
+ ( { WriteComma0 = yes } ->
+ io__write_string(",\n\t")
+ ;
+ []
+ ),
+ { WriteComma = yes },
+ write_simple_item_matches_2(ItemType, Ids)
+ ).
+
+:- pred write_simple_item_matches_2(item_type::in, simple_item_set::in,
+ io__state::di, io__state::uo) is det.
+
+write_simple_item_matches_2(ItemType, ItemSet) -->
+ { string_to_item_type(ItemTypeStr, ItemType) },
+ io__write_string(ItemTypeStr),
+ io__write_string("(\n\t\t"),
+ { map__to_assoc_list(ItemSet, ItemList) },
+ io__write_list(ItemList, ",\n\t\t",
+ (pred(((Name - Arity) - Matches)::in, di, uo) is det -->
+ mercury_output_bracketed_sym_name(unqualified(Name),
+ next_to_graphic_token),
+ io__write_string("/"),
+ io__write_int(Arity),
+ io__write_string(" - ("),
+ { map__to_assoc_list(Matches, MatchList) },
+ io__write_list(MatchList, ", ",
+ (pred((Qualifier - ModuleName)::in, di, uo) is det -->
+ mercury_output_bracketed_sym_name(Qualifier),
+ ( { Qualifier = ModuleName } ->
+ []
+ ;
+ io__write_string(" => "),
+ mercury_output_bracketed_sym_name(ModuleName)
+ )
+ )
+ ),
+ io__write_string(")")
+ )
+ ),
+ io__write_string("\n\t)").
+
+:- pred write_pred_or_func_matches(item_type::in(pred_or_func),
+ resolved_used_items::in, bool::in, bool::out,
+ io__state::di, io__state::uo) is det.
+
+write_pred_or_func_matches(ItemType, UsedItems, WriteComma0, WriteComma) -->
+ { Ids = extract_pred_or_func_set(UsedItems, ItemType) },
+ ( { map__is_empty(Ids) } ->
+ { WriteComma = WriteComma0 }
+ ;
+ ( { WriteComma0 = yes } ->
+ io__write_string(",\n\t")
+ ;
+ []
+ ),
+ { WriteComma = yes },
+ write_pred_or_func_matches_2(ItemType, Ids)
+ ).
+
+:- pred write_pred_or_func_matches_2(item_type::in(pred_or_func),
+ resolved_pred_or_func_set::in,
+ io__state::di, io__state::uo) is det.
+
+write_pred_or_func_matches_2(ItemType, ItemSet) -->
+ { string_to_item_type(ItemTypeStr, ItemType) },
+ io__write_string(ItemTypeStr),
+ io__write_string("(\n\t\t"),
+ { map__to_assoc_list(ItemSet, ItemList) },
+ io__write_list(ItemList, ",\n\t\t",
+ (pred(((Name - Arity) - Matches)::in, di, uo) is det -->
+ mercury_output_bracketed_sym_name(unqualified(Name),
+ next_to_graphic_token),
+ io__write_string("/"),
+ io__write_int(Arity),
+ io__write_string(" - ("),
+ { map__to_assoc_list(Matches, MatchList) },
+ io__write_list(MatchList, ",\n\t\t\t",
+ (pred((Qualifier - PredIdModuleNames)::in,
+ di, uo) is det -->
+ { ModuleNames = assoc_list__values(set__to_sorted_list(
+ PredIdModuleNames)) },
+ mercury_output_bracketed_sym_name(Qualifier),
+ ( { ModuleNames = [Qualifier] } ->
+ []
+ ;
+ io__write_string(" => ("),
+ io__write_list(ModuleNames, ", ",
+ mercury_output_bracketed_sym_name),
+ io__write_string(")")
+ )
+ )
+ ),
+ io__write_string(")")
+ )
+ ),
+ io__write_string("\n\t)").
+
+:- pred write_functor_matches(resolved_functor_set::in,
+ bool::in, bool::out, io__state::di, io__state::uo) is det.
+
+write_functor_matches(Ids, WriteComma0, WriteComma) -->
+ ( { map__is_empty(Ids) } ->
+ { WriteComma = WriteComma0 }
+ ;
+ ( { WriteComma0 = yes } ->
+ io__write_string(",\n\t")
+ ;
+ []
+ ),
+ { WriteComma = yes },
+ write_functor_matches_2(Ids)
+ ).
+
+:- pred write_functor_matches_2(resolved_functor_set::in,
+ io__state::di, io__state::uo) is det.
+
+write_functor_matches_2(ItemSet) -->
+ io__write_string("functor(\n\t\t"),
+ { map__to_assoc_list(ItemSet, ItemList) },
+ io__write_list(ItemList, ",\n\t\t",
+ (pred((Name - MatchesAL)::in, di, uo) is det -->
+ mercury_output_bracketed_sym_name(unqualified(Name)),
+ io__write_string(" - ("),
+ io__write_list(MatchesAL, ",\n\t\t\t",
+ (pred((Arity - Matches)::in, di, uo) is det -->
+ io__write_int(Arity),
+ io__write_string(" - ("),
+ { map__to_assoc_list(Matches, MatchList) },
+ io__write_list(MatchList, ",\n\t\t\t\t",
+ (pred((Qualifier - MatchingCtors)::in,
+ di, uo) is det -->
+ mercury_output_bracketed_sym_name(Qualifier),
+ io__write_string(" => ("),
+ io__write_list(
+ set__to_sorted_list(MatchingCtors),
+ ", ", write_resolved_functor),
+ io__write_string(")")
+ )
+ ),
+ io__write_string(")")
+ )),
+ io__write_string(")")
+ )),
+ io__write_string("\n\t)").
+
+:- pred write_resolved_functor(resolved_functor::in,
+ io__state::di, io__state::uo) is det.
+
+write_resolved_functor(pred_or_func(_, ModuleName, PredOrFunc, Arity)) -->
+ io__write(PredOrFunc),
+ io__write_string("("),
+ mercury_output_bracketed_sym_name(ModuleName),
+ io__write_string(", "),
+ io__write_int(Arity),
+ io__write_string(")").
+write_resolved_functor(constructor(TypeName - Arity)) -->
+ io__write_string("ctor("),
+ mercury_output_bracketed_sym_name(TypeName, next_to_graphic_token),
+ io__write_string("/"),
+ io__write_int(Arity),
+ io__write_string(")").
+write_resolved_functor(
+ field(TypeName - TypeArity, ConsName - ConsArity)) -->
+ io__write_string("field("),
+ mercury_output_bracketed_sym_name(TypeName, next_to_graphic_token),
+ io__write_string("/"),
+ io__write_int(TypeArity),
+ io__write_string(", "),
+ mercury_output_bracketed_sym_name(ConsName, next_to_graphic_token),
+ io__write_string("/"),
+ io__write_int(ConsArity),
+ io__write_string(")").
+
+usage_file_version_number = 1.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- type recompilation_usage_info
+ ---> recompilation_usage_info(
+ module_info :: module_info,
+ item_queue :: queue(item_id),
+ imported_items :: imported_items,
+ % For each module, the used typeclasses for
+ % which the module contains an instance.
+ module_instances :: map(module_name, set(item_name)),
+ dependencies :: map(item_id, set(item_id)),
+ used_items :: resolved_used_items,
+ used_typeclasses :: set(item_name)
+ ).
+
+:- type imported_items == map(module_name, module_imported_items).
+
+ % The constructors set should always be empty -
+ % constructors are never imported separately.
+:- type module_imported_items == item_id_set(imported_item_set).
+
+:- type imported_item_set == set(pair(string, arity)).
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % Go over the set of imported items found to be used and
+ % find the transitive closure of the imported items they use.
+ %
+:- pred recompilation_usage__find_all_used_imported_items(module_info::in,
+ used_items::in, map(item_id, set(item_id))::in,
+ resolved_used_items::out, set(item_name)::out, imported_items::out,
+ map(module_name, set(item_name))::out) is det.
+
+recompilation_usage__find_all_used_imported_items(ModuleInfo,
+ UsedItems, Dependencies, ResolvedUsedItems, UsedTypeClasses,
+ ImportedItems, ModuleInstances) :-
+
+ %
+ % We need to make sure each visible module has an entry in
+ % the `.used' file, even if nothing was used from it.
+ % This will cause recompilation_check.m to check for new items
+ % causing ambiguity when the interface of the module changes.
+ %
+ map__init(ImportedItems0),
+ ImportedItems2 = promise_only_solution(
+ (pred(ImportedItems1::out) is cc_multi :-
+ std_util__unsorted_aggregate(
+ (pred(VisibleModule::out) is nondet :-
+ visible_module(VisibleModule, ModuleInfo),
+ \+ module_info_name(ModuleInfo, VisibleModule)
+ ),
+ (pred(VisibleModule::in, ImportedItemsMap0::in,
+ ImportedItemsMap::out) is det :-
+ ModuleItems = init_item_id_set(set__init),
+ map__det_insert(ImportedItemsMap0, VisibleModule,
+ ModuleItems, ImportedItemsMap)
+ ),
+ ImportedItems0, ImportedItems1)
+ )),
+
+ queue__init(ItemsToProcess0),
+ map__init(ModuleUsedClasses),
+ set__init(UsedClasses0),
+
+ UsedItems = item_id_set(Types, TypeBodies, Modes, Insts, Classes,
+ _, _, _),
+ map__init(ResolvedCtors),
+ map__init(ResolvedPreds),
+ map__init(ResolvedFuncs),
+ ResolvedUsedItems0 = item_id_set(Types, TypeBodies, Modes, Insts,
+ Classes, ResolvedCtors, ResolvedPreds, ResolvedFuncs),
+
+ Info0 = recompilation_usage_info(ModuleInfo, ItemsToProcess0,
+ ImportedItems2, ModuleUsedClasses, Dependencies,
+ ResolvedUsedItems0, UsedClasses0),
+
+ recompilation_usage__find_all_used_imported_items_2(UsedItems,
+ Info0, Info),
+
+ ImportedItems = Info ^ imported_items,
+ ModuleInstances = Info ^ module_instances,
+ UsedTypeClasses = Info ^ used_typeclasses,
+ ResolvedUsedItems = Info ^ used_items.
+
+:- pred recompilation_usage__find_all_used_imported_items_2(used_items::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_all_used_imported_items_2(UsedItems) -->
+
+ %
+ % Find items used by imported instances for local classes.
+ %
+ ModuleInfo =^ module_info,
+ { module_info_instances(ModuleInfo, Instances) },
+ map__foldl(
+ (pred(ClassId::in, InstanceDefns::in, in, out) is det -->
+ { ClassId = class_id(Name, Arity) },
+ =(Info),
+ { NameArity = Name - Arity },
+ ( { item_is_local(Info, NameArity) } ->
+ recompilation_usage__record_equivalence_types_used_by_item(
+ (typeclass), NameArity),
+ list__foldl(
+ recompilation_usage__find_items_used_by_instance(
+ NameArity),
+ InstanceDefns)
+ ;
+ []
+ )
+ ), Instances),
+
+ { Predicates = UsedItems ^ predicates },
+ recompilation_usage__find_items_used_by_preds(predicate, Predicates),
+
+ { Functions = UsedItems ^ functions },
+ recompilation_usage__find_items_used_by_preds(function, Functions),
+
+ { Constructors = UsedItems ^ functors },
+ recompilation_usage__find_items_used_by_functors(Constructors),
+
+ { Types = UsedItems ^ types },
+ recompilation_usage__find_items_used_by_simple_item_set((type), Types),
+
+ { TypeBodies = UsedItems ^ type_bodies },
+ recompilation_usage__find_items_used_by_simple_item_set((type_body),
+ TypeBodies),
+
+ { Modes = UsedItems ^ modes },
+ recompilation_usage__find_items_used_by_simple_item_set((mode), Modes),
+
+ { Classes = UsedItems ^ typeclasses },
+ recompilation_usage__find_items_used_by_simple_item_set((typeclass),
+ Classes),
+
+ { Insts = UsedItems ^ insts },
+ recompilation_usage__find_items_used_by_simple_item_set((inst), Insts),
+
+ recompilation_usage__process_imported_item_queue.
+
+:- pred recompilation_usage__process_imported_item_queue(
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__process_imported_item_queue -->
+ Queue0 =^ item_queue,
+ ^ item_queue := queue__init,
+ recompilation_usage__process_imported_item_queue_2(Queue0),
+ Queue =^ item_queue,
+ ( { queue__is_empty(Queue) } ->
+ []
+ ;
+ recompilation_usage__process_imported_item_queue
+ ).
+
+:- pred recompilation_usage__process_imported_item_queue_2(
+ queue(item_id)::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__process_imported_item_queue_2(Queue0) -->
+ ( { queue__get(Queue0, Item, Queue) } ->
+ { Item = item_id(ItemType, ItemId) },
+ recompilation_usage__find_items_used_by_item(ItemType, ItemId),
+ recompilation_usage__process_imported_item_queue_2(Queue)
+ ;
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred recompilation_usage__record_used_pred_or_func(pred_or_func::in,
+ pair(sym_name, arity)::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__record_used_pred_or_func(PredOrFunc, Id) -->
+ { ItemType = pred_or_func_to_item_type(PredOrFunc) },
+
+ ItemSet0 =^ used_items,
+ { IdSet0 = extract_pred_or_func_set(ItemSet0, ItemType) },
+ { Id = SymName - Arity },
+ { unqualify_name(SymName, UnqualifiedName) },
+ { ModuleQualifier = find_module_qualifier(SymName) },
+ { UnqualifiedId = UnqualifiedName - Arity },
+
+ { map__search(IdSet0, UnqualifiedId, MatchingNames0) ->
+ MatchingNames1 = MatchingNames0
+ ;
+ map__init(MatchingNames1)
+ },
+ ModuleInfo =^ module_info,
+ (
+ { map__contains(MatchingNames1, ModuleQualifier) }
+ ->
+ []
+ ;
+ { module_info_get_predicate_table(ModuleInfo, PredTable) },
+ { adjust_func_arity(PredOrFunc, OrigArity, Arity) },
+ { predicate_table_search_pf_sym_arity(PredTable,
+ PredOrFunc, SymName, OrigArity, MatchingPredIds) }
+ ->
+ { PredModules = set__list_to_set(list__map(
+ (func(PredId) = PredId - PredModule :-
+ module_info_pred_info(ModuleInfo,
+ PredId, PredInfo),
+ pred_info_module(PredInfo, PredModule)
+ ),
+ MatchingPredIds)) },
+ { map__det_insert(MatchingNames1, ModuleQualifier,
+ PredModules, MatchingNames) },
+ { map__set(IdSet0, UnqualifiedId, MatchingNames, IdSet) },
+ { ItemSet = update_pred_or_func_set(ItemSet0,
+ ItemType, IdSet) },
+ ^ used_items := ItemSet,
+ set__fold(
+ recompilation_usage__find_items_used_by_pred(
+ PredOrFunc, UnqualifiedId),
+ PredModules)
+ ;
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred recompilation_usage__record_used_functor(pair(sym_name, arity)::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__record_used_functor(SymName - Arity) -->
+ ItemSet0 =^ used_items,
+ { IdSet0 = ItemSet0 ^ functors },
+ { unqualify_name(SymName, UnqualifiedName) },
+ { ModuleQualifier = find_module_qualifier(SymName) },
+ { map__search(IdSet0, UnqualifiedName, MatchingNames0) ->
+ MatchingNames1 = MatchingNames0
+ ;
+ MatchingNames1 = []
+ },
+ recompilation_usage__record_used_functor_2(ModuleQualifier,
+ SymName, Arity, Recorded, MatchingNames1, MatchingNames),
+ ( { Recorded = yes } ->
+ { map__set(IdSet0, UnqualifiedName, MatchingNames, IdSet) },
+ { ItemSet = ItemSet0 ^ functors := IdSet },
+ ^ used_items := ItemSet
+ ;
+ []
+ ).
+
+:- pred recompilation_usage__record_used_functor_2(module_qualifier::in,
+ sym_name::in, arity::in, bool::out, resolved_functor_list::in,
+ resolved_functor_list::out, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__record_used_functor_2(ModuleQualifier,
+ SymName, Arity, Recorded, [], CtorList) -->
+ { map__init(CtorMap0) },
+ recompilation_usage__record_used_functor_3(ModuleQualifier,
+ SymName, Arity, Recorded, CtorMap0, CtorMap),
+ { Recorded = yes ->
+ CtorList = [Arity - CtorMap]
+ ;
+ CtorList = []
+ }.
+recompilation_usage__record_used_functor_2(ModuleQualifier,
+ SymName, Arity, Recorded, CtorList0, CtorList) -->
+ { CtorList0 = [CtorArity - ArityCtorMap0 | CtorListRest0] },
+ ( { Arity < CtorArity } ->
+ { map__init(NewArityCtorMap0) },
+ recompilation_usage__record_used_functor_3(ModuleQualifier,
+ SymName, Arity, Recorded, NewArityCtorMap0,
+ NewArityCtorMap),
+ { Recorded = yes ->
+ CtorList = [Arity - NewArityCtorMap | CtorList0]
+ ;
+ CtorList = CtorList0
+ }
+ ; { Arity = CtorArity } ->
+ recompilation_usage__record_used_functor_3(ModuleQualifier,
+ SymName, Arity, Recorded, ArityCtorMap0, ArityCtorMap),
+ { Recorded = yes ->
+ CtorList = [CtorArity - ArityCtorMap | CtorListRest0]
+ ;
+ CtorList = CtorList0
+ }
+ ;
+ recompilation_usage__record_used_functor_2(ModuleQualifier,
+ SymName, Arity, Recorded, CtorListRest0, CtorListRest),
+ { Recorded = yes ->
+ CtorList = [CtorArity - ArityCtorMap0 | CtorListRest]
+ ;
+ CtorList = CtorList0
+ }
+ ).
+
+:- pred recompilation_usage__record_used_functor_3(module_qualifier::in,
+ sym_name::in, arity::in, bool::out, resolved_functor_map::in,
+ resolved_functor_map::out, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__record_used_functor_3(ModuleQualifier, SymName, Arity,
+ Recorded, ResolvedCtorMap0, ResolvedCtorMap) -->
+ ( { map__contains(ResolvedCtorMap0, ModuleQualifier) } ->
+ { Recorded = no },
+ { ResolvedCtorMap = ResolvedCtorMap0 }
+ ;
+ ModuleInfo =^ module_info,
+ { recompilation_usage__find_matching_functors(ModuleInfo,
+ SymName, Arity, MatchingCtors) },
+ { unqualify_name(SymName, Name) },
+
+ set__fold(
+ recompilation_usage__find_items_used_by_functor(
+ Name, Arity),
+ MatchingCtors),
+
+ { set__empty(MatchingCtors) ->
+ Recorded = no,
+ ResolvedCtorMap = ResolvedCtorMap0
+ ;
+ Recorded = yes,
+ map__det_insert(ResolvedCtorMap0, ModuleQualifier,
+ MatchingCtors, ResolvedCtorMap)
+ }
+ ).
+
+:- pred recompilation_usage__find_matching_functors(module_info::in,
+ sym_name::in, arity::in, set(resolved_functor)::out) is det.
+
+recompilation_usage__find_matching_functors(ModuleInfo, SymName, Arity,
+ ResolvedConstructors) :-
+ %
+ % Is it a constructor.
+ %
+ module_info_ctors(ModuleInfo, Ctors),
+ ( map__search(Ctors, cons(SymName, Arity), ConsDefns0) ->
+ ConsDefns1 = ConsDefns0
+ ;
+ ConsDefns1 = []
+ ),
+ (
+ remove_new_prefix(SymName, SymNameMinusNew),
+ map__search(Ctors, cons(SymNameMinusNew, Arity), ConsDefns2)
+ ->
+ ConsDefns = list__append(ConsDefns1, ConsDefns2)
+ ;
+ ConsDefns = ConsDefns1
+ ),
+ MatchingConstructors =
+ list__map(
+ (func(ConsDefn) = Ctor :-
+ ConsDefn = hlds_cons_defn(_, _, _, TypeId, _),
+ Ctor = constructor(TypeId)
+ ),
+ ConsDefns),
+
+ %
+ % Is it a higher-order term or function call.
+ %
+ module_info_get_predicate_table(ModuleInfo, PredicateTable),
+ ( predicate_table_search_sym(PredicateTable, SymName, PredIds) ->
+ MatchingPreds = list__filter_map(
+ recompilation_usage__get_pred_or_func_ctors(ModuleInfo,
+ SymName, Arity),
+ PredIds)
+ ;
+ MatchingPreds = []
+ ),
+
+ %
+ % Is it a field access function.
+ %
+ (
+ is_field_access_function_name(ModuleInfo, SymName, Arity,
+ _, FieldName),
+ module_info_ctor_field_table(ModuleInfo, CtorFields),
+ map__search(CtorFields, FieldName, FieldDefns)
+ ->
+ MatchingFields = list__map(
+ (func(FieldDefn) = FieldCtor :-
+ FieldDefn = hlds_ctor_field_defn(_, _,
+ TypeId, ConsId, _),
+ ( ConsId = cons(ConsName, ConsArity) ->
+ FieldCtor = field(TypeId,
+ ConsName - ConsArity)
+ ;
+ error(
+ "weird cons_id in hlds_field_defn")
+ )
+ ), FieldDefns)
+ ;
+ MatchingFields = []
+ ),
+
+ ResolvedConstructors = set__list_to_set(list__condense(
+ [MatchingConstructors, MatchingPreds, MatchingFields])
+ ).
+
+:- func recompilation_usage__get_pred_or_func_ctors(module_info, sym_name,
+ arity, pred_id) = resolved_functor is semidet.
+
+recompilation_usage__get_pred_or_func_ctors(ModuleInfo, _SymName, Arity,
+ PredId) = ResolvedCtor :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
+ pred_info_get_exist_quant_tvars(PredInfo, PredExistQVars),
+ pred_info_arity(PredInfo, PredArity),
+ adjust_func_arity(PredOrFunc, OrigArity, PredArity),
+ (
+ PredOrFunc = predicate,
+ OrigArity >= Arity,
+ % We don't support first-class polymorphism,
+ % so you can't take the address of an existentially
+ % quantified predicate.
+ PredExistQVars = []
+ ;
+ PredOrFunc = function,
+ OrigArity >= Arity,
+ % We don't support first-class polymorphism,
+ % so you can't take the address of an existentially
+ % quantified function. You can however call such
+ % a function, so long as you pass *all* the parameters.
+ ( PredExistQVars = []
+ ; OrigArity = Arity
+ )
+ ),
+ pred_info_module(PredInfo, PredModule),
+ ResolvedCtor = pred_or_func(PredId, PredModule, PredOrFunc, OrigArity).
+
+%-----------------------------------------------------------------------------%
+
+:- pred recompilation_usage__find_items_used_by_item(item_type::in,
+ item_name::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_item((type), TypeId) -->
+ ModuleInfo =^ module_info,
+ { module_info_types(ModuleInfo, Types) },
+ { map__lookup(Types, TypeId, TypeDefn) },
+ { hlds_data__get_type_defn_body(TypeDefn, TypeBody) },
+ ( { TypeBody = eqv_type(Type) } ->
+ % If we use an equivalence type we also use the
+ % type it is equivalent to.
+ recompilation_usage__find_items_used_by_type(Type)
+ ;
+ []
+ ).
+recompilation_usage__find_items_used_by_item(type_body, TypeId) -->
+ ModuleInfo =^ module_info,
+ { module_info_types(ModuleInfo, Types) },
+ { map__lookup(Types, TypeId, TypeDefn) },
+ { hlds_data__get_type_defn_body(TypeDefn, TypeBody) },
+ recompilation_usage__find_items_used_by_type_body(TypeBody).
+recompilation_usage__find_items_used_by_item((mode), ModeId) -->
+ ModuleInfo =^ module_info,
+ { module_info_modes(ModuleInfo, Modes) },
+ { mode_table_get_mode_defns(Modes, ModeDefns) },
+ { map__lookup(ModeDefns, ModeId, ModeDefn) },
+ recompilation_usage__find_items_used_by_mode_defn(ModeDefn).
+recompilation_usage__find_items_used_by_item((inst), InstId) -->
+ ModuleInfo =^ module_info,
+ { module_info_insts(ModuleInfo, Insts) },
+ { inst_table_get_user_insts(Insts, UserInsts) },
+ { user_inst_table_get_inst_defns(UserInsts, UserInstDefns) },
+ { map__lookup(UserInstDefns, InstId, InstDefn) },
+ recompilation_usage__find_items_used_by_inst_defn(InstDefn).
+recompilation_usage__find_items_used_by_item((typeclass), ClassItemId) -->
+ { ClassItemId = ClassName - ClassArity },
+ { ClassId = class_id(ClassName, ClassArity) },
+ ModuleInfo =^ module_info,
+ { module_info_classes(ModuleInfo, Classes) },
+ { map__lookup(Classes, ClassId, ClassDefn) },
+ { ClassDefn = hlds_class_defn(_, Constraints, _, ClassInterface,
+ _, _, _) },
+ recompilation_usage__find_items_used_by_class_constraints(
+ Constraints),
+ (
+ { ClassInterface = abstract }
+ ;
+ { ClassInterface = concrete(Methods) },
+ list__foldl(
+ recompilation_usage__find_items_used_by_class_method,
+ Methods)
+ ),
+ { module_info_instances(ModuleInfo, Instances) },
+ ( { map__search(Instances, ClassId, InstanceDefns) } ->
+ list__foldl(
+ recompilation_usage__find_items_used_by_instance(
+ ClassItemId), InstanceDefns)
+ ;
+ []
+ ).
+
+ %
+ % It's simplest to deal with items used by predicates, functions
+ % and functors as we resolve the predicates, functions and functors.
+ %
+recompilation_usage__find_items_used_by_item(predicate, _) -->
+ { error("recompilation_usage__find_items_used_by_item: predicate") }.
+recompilation_usage__find_items_used_by_item(function, _) -->
+ { error("recompilation_usage__find_items_used_by_item: function") }.
+recompilation_usage__find_items_used_by_item(functor, _) -->
+ { error("recompilation_usage__find_items_used_by_item: functor") }.
+
+:- pred recompilation_usage__find_items_used_by_instance(item_name::in,
+ hlds_instance_defn::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_instance(ClassId,
+ hlds_instance_defn(InstanceModuleName, _, _, Constraints,
+ ArgTypes, _, _, _, _)) -->
+ % XXX handle interface (currently not needed because
+ % the interfaces for imported instances are only needed with
+ % --intermodule-optimization, which isn't handled here yet)
+ ModuleInfo =^ module_info,
+ (
+ { module_info_name(ModuleInfo, InstanceModuleName) }
+ ->
+ []
+ ;
+ recompilation_usage__find_items_used_by_class_constraints(
+ Constraints),
+ recompilation_usage__find_items_used_by_types(ArgTypes),
+ ModuleInstances0 =^ module_instances,
+ {
+ map__search(ModuleInstances0, InstanceModuleName,
+ ClassIds0)
+ ->
+ ClassIds1 = ClassIds0
+ ;
+ set__init(ClassIds1)
+ },
+ { set__insert(ClassIds1, ClassId, ClassIds) },
+ { map__set(ModuleInstances0, InstanceModuleName, ClassIds,
+ ModuleInstances) },
+ ^ module_instances := ModuleInstances
+ ).
+
+:- pred recompilation_usage__find_items_used_by_class_method(
+ class_method::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_class_method(
+ pred_or_func(_, _, _, _, _, ArgTypesAndModes,
+ _, _, _, Constraints, _)) -->
+ recompilation_usage__find_items_used_by_class_context(
+ Constraints),
+ list__foldl(
+ (pred(TypeAndMode::in, in, out) is det -->
+ (
+ { TypeAndMode = type_only(Type) }
+ ;
+ { TypeAndMode = type_and_mode(Type, Mode) },
+ recompilation_usage__find_items_used_by_mode(Mode)
+ ),
+ recompilation_usage__find_items_used_by_type(Type)
+ ), ArgTypesAndModes).
+recompilation_usage__find_items_used_by_class_method(
+ pred_or_func_mode(_, _, _, Modes, _, _, _)) -->
+ recompilation_usage__find_items_used_by_modes(Modes).
+
+:- pred recompilation_usage__find_items_used_by_type_body(hlds_type_body::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_type_body(du_type(Ctors, _, _, _)) -->
+ list__foldl(
+ (pred(Ctor::in, in, out) is det -->
+ { Ctor = ctor(_, Constraints, _, CtorArgs) },
+ recompilation_usage__find_items_used_by_class_constraints(
+ Constraints),
+ list__foldl(
+ (pred(CtorArg::in, in, out) is det -->
+ { CtorArg = _ - ArgType },
+ recompilation_usage__find_items_used_by_type(ArgType)
+ ), CtorArgs)
+ ), Ctors).
+recompilation_usage__find_items_used_by_type_body(eqv_type(Type)) -->
+ recompilation_usage__find_items_used_by_type(Type).
+recompilation_usage__find_items_used_by_type_body(uu_type(Types)) -->
+ recompilation_usage__find_items_used_by_types(Types).
+recompilation_usage__find_items_used_by_type_body(abstract_type) --> [].
+
+:- pred recompilation_usage__find_items_used_by_mode_defn(hlds_mode_defn::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_mode_defn(
+ hlds_mode_defn(_, _, eqv_mode(Mode), _, _, _)) -->
+ recompilation_usage__find_items_used_by_mode(Mode).
+
+:- pred recompilation_usage__find_items_used_by_inst_defn(hlds_inst_defn::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_inst_defn(
+ hlds_inst_defn(_, _, InstBody, _, _, _)) -->
+ (
+ { InstBody = eqv_inst(Inst) },
+ recompilation_usage__find_items_used_by_inst(Inst)
+ ;
+ { InstBody = abstract_inst }
+ ).
+
+:- pred recompilation_usage__find_items_used_by_preds(pred_or_func::in,
+ pred_or_func_set::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_preds(PredOrFunc, Set) -->
+ map__foldl(
+ (pred((Name - Arity)::in, MatchingPredMap::in, in, out) is det -->
+ map__foldl(
+ (pred(ModuleQualifier::in, _::in, in, out) is det -->
+ { SymName = module_qualify_name(ModuleQualifier,
+ Name) },
+ recompilation_usage__record_used_pred_or_func(
+ PredOrFunc, SymName - Arity)
+ ), MatchingPredMap)
+ ), Set).
+
+:- pred recompilation_usage__find_items_used_by_pred(pred_or_func::in,
+ pair(string, arity)::in, pair(pred_id, module_name)::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_pred(PredOrFunc, Name - Arity,
+ PredId - PredModule) -->
+ =(Info0),
+ { ItemType = pred_or_func_to_item_type(PredOrFunc) },
+ ModuleInfo =^ module_info,
+ { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+ (
+ { ItemId = qualified(PredModule, Name) - Arity },
+ {
+ recompilation_usage__item_is_recorded_used(Info0,
+ ItemType, ItemId)
+ ;
+ recompilation_usage__item_is_local(Info0, ItemId)
+ }
+ ->
+ % We've already recorded the items used by this predicate.
+ []
+ ;
+ %
+ % Items used by class methods are recorded when processing
+ % the typeclass declaration. Make sure that is done.
+ %
+ { pred_info_get_markers(PredInfo, Markers) },
+ { check_marker(Markers, class_method) }
+ ->
+ %
+ % The typeclass for which the predicate is a method is the
+ % first of the universal class constraints in the pred_info.
+ %
+ { pred_info_get_class_context(PredInfo, MethodClassContext) },
+ { MethodClassContext = constraints(MethodUnivConstraints, _) },
+ {
+ MethodUnivConstraints =
+ [constraint(ClassName0, ClassArgs) | _]
+ ->
+ ClassName = ClassName0,
+ ClassArity = list__length(ClassArgs)
+ ;
+ error("class method with no class constraints")
+ },
+ recompilation_usage__maybe_record_item_to_process(
+ typeclass, ClassName - ClassArity)
+ ;
+ { NameArity = qualified(PredModule, Name) - Arity },
+ recompilation_usage__record_equivalence_types_used_by_item(
+ ItemType, NameArity),
+ recompilation_usage__record_imported_item(ItemType, NameArity),
+ { pred_info_arg_types(PredInfo, ArgTypes) },
+ recompilation_usage__find_items_used_by_types(ArgTypes),
+ { pred_info_procedures(PredInfo, Procs) },
+ map__foldl(
+ (pred(_::in, ProcInfo::in, in, out) is det -->
+ { proc_info_argmodes(ProcInfo, ArgModes) },
+ recompilation_usage__find_items_used_by_modes(
+ ArgModes)
+ ), Procs),
+ { pred_info_get_class_context(PredInfo, ClassContext) },
+ recompilation_usage__find_items_used_by_class_context(
+ ClassContext),
+
+ %
+ % Record items used by `:- pragma type_spec' declarations.
+ %
+ { module_info_type_spec_info(ModuleInfo, TypeSpecInfo) },
+ { TypeSpecInfo = type_spec_info(_, _, _, PragmaMap) },
+ ( { map__search(PragmaMap, PredId, TypeSpecPragmas) } ->
+ list__foldl(
+ recompilation_usage__find_items_used_by_type_spec,
+ TypeSpecPragmas)
+ ;
+ []
+ )
+ ).
+
+:- pred recompilation_usage__find_items_used_by_type_spec(pragma_type::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_type_spec(Pragma) -->
+ ( { Pragma = type_spec(_, _, _, _, MaybeModes, Subst, _, _) } ->
+ ( { MaybeModes = yes(Modes) } ->
+ recompilation_usage__find_items_used_by_modes(Modes)
+ ;
+ []
+ ),
+ { assoc_list__values(Subst, SubstTypes) },
+ recompilation_usage__find_items_used_by_types(SubstTypes)
+ ;
+ { error(
+"recompilation_usage__find_items_used_by_type_spec: unexpected pragma type") }
+ ).
+
+:- pred recompilation_usage__find_items_used_by_functors(
+ functor_set::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_functors(Set) -->
+ map__foldl(
+ (pred((Name - Arity)::in, MatchingCtorMap::in, in, out) is det -->
+ map__foldl(
+ (pred(Qualifier::in, _::in, in, out) is det -->
+ { SymName = module_qualify_name(Qualifier, Name) },
+ recompilation_usage__record_used_functor(
+ SymName - Arity)
+ ), MatchingCtorMap)
+ ), Set).
+
+:- pred recompilation_usage__find_items_used_by_functor(
+ string::in, arity::in, resolved_functor::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_functor(Name, _Arity,
+ pred_or_func(PredId, PredModule, PredOrFunc, PredArity)) -->
+ recompilation_usage__find_items_used_by_pred(PredOrFunc,
+ Name - PredArity, PredId - PredModule).
+recompilation_usage__find_items_used_by_functor(_, _,
+ constructor(TypeId)) -->
+ recompilation_usage__maybe_record_item_to_process(type_body, TypeId).
+recompilation_usage__find_items_used_by_functor(_, _, field(TypeId, _)) -->
+ recompilation_usage__maybe_record_item_to_process(type_body, TypeId).
+
+:- pred recompilation_usage__find_items_used_by_simple_item_set(
+ item_type::in, simple_item_set::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_simple_item_set(ItemType, Set) -->
+ map__foldl(
+ (pred((Name - Arity)::in, MatchingIdMap::in, in, out) is det -->
+ map__foldl(
+ (pred(_::in, Module::in, in, out) is det -->
+ recompilation_usage__maybe_record_item_to_process(
+ ItemType, qualified(Module, Name) - Arity)
+ ), MatchingIdMap)
+ ), Set).
+
+:- pred recompilation_usage__find_items_used_by_types(list(type)::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_types(Types) -->
+ list__foldl(recompilation_usage__find_items_used_by_type, Types).
+
+:- pred recompilation_usage__find_items_used_by_type((type)::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_type(Type) -->
+ (
+ { type_to_type_id(Type, TypeId, TypeArgs) }
+ ->
+ (
+ % Unqualified type-ids are builtin types.
+ { TypeId = qualified(_, _) - _ },
+ \+ { type_id_is_higher_order(TypeId, _, _) }
+ ->
+ recompilation_usage__maybe_record_item_to_process(
+ (type), TypeId)
+ ;
+ []
+ ),
+ recompilation_usage__find_items_used_by_types(TypeArgs)
+ ;
+ []
+ ).
+
+:- pred recompilation_usage__find_items_used_by_modes(list(mode)::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_modes(Modes) -->
+ list__foldl(recompilation_usage__find_items_used_by_mode, Modes).
+
+:- pred recompilation_usage__find_items_used_by_mode((mode)::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_mode((Inst1 -> Inst2)) -->
+ recompilation_usage__find_items_used_by_inst(Inst1),
+ recompilation_usage__find_items_used_by_inst(Inst2).
+recompilation_usage__find_items_used_by_mode(
+ user_defined_mode(ModeName, ArgInsts)) -->
+ { list__length(ArgInsts, ModeArity) },
+ recompilation_usage__maybe_record_item_to_process((mode),
+ ModeName - ModeArity),
+ recompilation_usage__find_items_used_by_insts(ArgInsts).
+
+:- pred recompilation_usage__find_items_used_by_insts(list(inst)::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_insts(Modes) -->
+ list__foldl(recompilation_usage__find_items_used_by_inst, Modes).
+
+:- pred recompilation_usage__find_items_used_by_inst((inst)::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_inst(any(_)) --> [].
+recompilation_usage__find_items_used_by_inst(free) --> [].
+recompilation_usage__find_items_used_by_inst(free(_)) --> [].
+recompilation_usage__find_items_used_by_inst(bound(_, BoundInsts)) -->
+ list__foldl(
+ (pred(BoundInst::in, in, out) is det -->
+ { BoundInst = functor(ConsId, ArgInsts) },
+ ( { ConsId = cons(Name, Arity) } ->
+ recompilation_usage__record_used_functor(
+ Name - Arity)
+ ;
+ []
+ ),
+ recompilation_usage__find_items_used_by_insts(ArgInsts)
+ ), BoundInsts).
+recompilation_usage__find_items_used_by_inst(ground(_, GroundInstInfo)) -->
+ (
+ { GroundInstInfo = higher_order(pred_inst_info(_, Modes, _)) },
+ recompilation_usage__find_items_used_by_modes(Modes)
+ ;
+ { GroundInstInfo = constrained_inst_var(_) }
+ ;
+ { GroundInstInfo = none }
+ ).
+recompilation_usage__find_items_used_by_inst(not_reached) --> [].
+recompilation_usage__find_items_used_by_inst(inst_var(_)) --> [].
+recompilation_usage__find_items_used_by_inst(defined_inst(InstName)) -->
+ recompilation_usage__find_items_used_by_inst_name(InstName).
+recompilation_usage__find_items_used_by_inst(
+ abstract_inst(Name, ArgInsts)) -->
+ { list__length(ArgInsts, Arity) },
+ recompilation_usage__maybe_record_item_to_process((inst),
+ Name - Arity),
+ recompilation_usage__find_items_used_by_insts(ArgInsts).
+
+:- pred recompilation_usage__find_items_used_by_inst_name(inst_name::in,
+ recompilation_usage_info::in, recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_inst_name(
+ user_inst(Name, ArgInsts)) -->
+ { list__length(ArgInsts, Arity) },
+ recompilation_usage__maybe_record_item_to_process((inst),
+ Name - Arity),
+ recompilation_usage__find_items_used_by_insts(ArgInsts).
+recompilation_usage__find_items_used_by_inst_name(
+ merge_inst(Inst1, Inst2)) -->
+ recompilation_usage__find_items_used_by_inst(Inst1),
+ recompilation_usage__find_items_used_by_inst(Inst2).
+recompilation_usage__find_items_used_by_inst_name(
+ unify_inst(_, Inst1, Inst2, _)) -->
+ recompilation_usage__find_items_used_by_inst(Inst1),
+ recompilation_usage__find_items_used_by_inst(Inst2).
+recompilation_usage__find_items_used_by_inst_name(
+ ground_inst(InstName, _, _, _)) -->
+ recompilation_usage__find_items_used_by_inst_name(InstName).
+recompilation_usage__find_items_used_by_inst_name(
+ any_inst(InstName, _, _, _)) -->
+ recompilation_usage__find_items_used_by_inst_name(InstName).
+recompilation_usage__find_items_used_by_inst_name(shared_inst(InstName)) -->
+ recompilation_usage__find_items_used_by_inst_name(InstName).
+recompilation_usage__find_items_used_by_inst_name(
+ mostly_uniq_inst(InstName)) -->
+ recompilation_usage__find_items_used_by_inst_name(InstName).
+recompilation_usage__find_items_used_by_inst_name(typed_ground(_, Type)) -->
+ recompilation_usage__find_items_used_by_type(Type).
+recompilation_usage__find_items_used_by_inst_name(
+ typed_inst(Type, InstName)) -->
+ recompilation_usage__find_items_used_by_type(Type),
+ recompilation_usage__find_items_used_by_inst_name(InstName).
+
+:- pred recompilation_usage__find_items_used_by_class_context(
+ class_constraints::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_class_context(
+ constraints(Constraints1, Constraints2)) -->
+ recompilation_usage__find_items_used_by_class_constraints(
+ Constraints1),
+ recompilation_usage__find_items_used_by_class_constraints(
+ Constraints2).
+
+:- pred recompilation_usage__find_items_used_by_class_constraints(
+ list(class_constraint)::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_class_constraints(Constraints) -->
+ list__foldl(recompilation_usage__find_items_used_by_class_constraint,
+ Constraints).
+
+:- pred recompilation_usage__find_items_used_by_class_constraint(
+ class_constraint::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__find_items_used_by_class_constraint(
+ constraint(ClassName, ArgTypes)) -->
+ { ClassArity = list__length(ArgTypes) },
+ recompilation_usage__maybe_record_item_to_process((typeclass),
+ ClassName - ClassArity),
+ recompilation_usage__find_items_used_by_types(ArgTypes).
+
+:- pred recompilation_usage__maybe_record_item_to_process(item_type::in,
+ pair(sym_name, arity)::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__maybe_record_item_to_process(ItemType, NameArity) -->
+ ( { ItemType = (typeclass) } ->
+ Classes0 =^ used_typeclasses,
+ { set__insert(Classes0, NameArity, Classes) },
+ ^ used_typeclasses := Classes
+ ;
+ []
+ ),
+
+ =(Info),
+ (
+ { item_is_recorded_used(Info, ItemType, NameArity) }
+ ->
+ % This item has already been recorded.
+ []
+ ;
+ { item_is_local(Info, NameArity) }
+ ->
+ % Ignore local items. The items used by them
+ % have already been recorded by module_qual.m.
+ []
+ ;
+ Queue0 =^ item_queue,
+ { queue__put(Queue0, item_id(ItemType, NameArity), Queue) },
+ ^ item_queue := Queue,
+
+ recompilation_usage__record_imported_item(ItemType, NameArity),
+ recompilation_usage__record_equivalence_types_used_by_item(
+ ItemType, NameArity)
+ ).
+
+
+:- pred item_is_recorded_used(recompilation_usage_info::in, item_type::in,
+ pair(sym_name, arity)::in) is semidet.
+
+item_is_recorded_used(Info, ItemType, NameArity) :-
+ ImportedItems = Info ^ imported_items,
+ NameArity = qualified(ModuleName, Name) - Arity,
+ map__search(ImportedItems, ModuleName, ModuleIdSet),
+ ModuleItemIdSet = extract_ids(ModuleIdSet, ItemType),
+ set__member(Name - Arity, ModuleItemIdSet).
+
+:- pred item_is_local(recompilation_usage_info::in,
+ pair(sym_name, arity)::in) is semidet.
+
+item_is_local(Info, NameArity) :-
+ NameArity = qualified(ModuleName, _) - _,
+ module_info_name(Info ^ module_info, ModuleName).
+
+:- pred recompilation_usage__record_imported_item(item_type::in,
+ pair(sym_name, arity)::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__record_imported_item(ItemType, SymName - Arity) -->
+ { SymName = qualified(Module0, Name0) ->
+ Module = Module0,
+ Name = Name0
+ ;
+ error(
+"recompilation_usage__maybe_record_item_to_process: unqualified item")
+ },
+
+ ImportedItems0 =^ imported_items,
+ { map__search(ImportedItems0, Module, ModuleItems0) ->
+ ModuleItems1 = ModuleItems0
+ ;
+ ModuleItems1 = init_item_id_set(set__init)
+ },
+ { ModuleItemIds0 = extract_ids(ModuleItems1, ItemType) },
+ { set__insert(ModuleItemIds0, Name - Arity, ModuleItemIds) },
+ { ModuleItems = update_ids(ModuleItems1, ItemType, ModuleItemIds) },
+ { map__set(ImportedItems0, Module, ModuleItems, ImportedItems) },
+ ^ imported_items := ImportedItems.
+
+ % Uses of equivalence types have been expanded away by equiv_type.m.
+ % equiv_type.m records which equivalence types were used by each
+ % imported item.
+:- pred recompilation_usage__record_equivalence_types_used_by_item(
+ item_type::in, item_name::in, recompilation_usage_info::in,
+ recompilation_usage_info::out) is det.
+
+recompilation_usage__record_equivalence_types_used_by_item(ItemType,
+ NameArity) -->
+ Dependencies =^ dependencies,
+ (
+ { map__search(Dependencies, item_id(ItemType, NameArity),
+ EquivTypes) }
+ ->
+ list__foldl(
+ (pred(Item::in, in, out) is det -->
+ { Item = item_id(DepItemType, DepItemId) },
+ recompilation_usage__maybe_record_item_to_process(
+ DepItemType, DepItemId)
+ ), set__to_sorted_list(EquivTypes))
+ ;
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/recompilation_version.m
===================================================================
RCS file: recompilation_version.m
diff -N recompilation_version.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ recompilation_version.m Mon May 28 17:11:32 2001
@@ -0,0 +1,636 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: recompilation_version.m
+% Main author: stayl
+%
+% Compute version numbers for program items in interface files.
+%-----------------------------------------------------------------------------%
+:- module recompilation_version.
+
+:- interface.
+
+:- import_module recompilation, prog_data, prog_io_util.
+:- import_module io, std_util, time, term.
+
+ % recompilation_version__compute_version_numbers(SourceFileModTime,
+ % NewItems, MaybeOldItems, VersionNumbers).
+:- pred recompilation_version__compute_version_numbers(time_t::in,
+ item_list::in, maybe(item_list)::in, version_numbers::out) is det.
+
+:- pred recompilation_version__write_version_numbers(version_numbers::in,
+ io__state::di, io__state::uo) is det.
+
+:- pred recompilation_version__parse_version_numbers(term::in,
+ maybe1(version_numbers)::out) is det.
+
+ % The version number for the format of the version numbers
+ % written to the interface files.
+:- func version_numbers_version_number = int.
+
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module mercury_to_mercury, prog_io, prog_util.
+:- import_module assoc_list, bool, list, map, require, string.
+
+recompilation_version__compute_version_numbers(SourceFileTime, Items,
+ MaybeOldItems, ItemVersionNumbers - InstanceVersionNumbers) :-
+ recompilation_version__gather_items(Items,
+ GatheredItems, InstanceItems),
+ (
+ MaybeOldItems = yes(OldItems0),
+ OldItems0 = [VersionNumberItem | OldItems],
+ VersionNumberItem = module_defn(_,
+ version_numbers(_, OldVersionNumbers)) - _
+ ->
+ OldVersionNumbers = OldItemVersionNumbers
+ - OldInstanceVersionNumbers,
+ recompilation_version__gather_items(OldItems, GatheredOldItems,
+ OldInstanceItems)
+ ;
+ % There were no old version numbers, so every item
+ % gets the same timestamp as the source module.
+ OldItemVersionNumbers = init_item_id_set(map__init),
+ GatheredOldItems = init_item_id_set(map__init),
+ map__init(OldInstanceItems),
+ map__init(OldInstanceVersionNumbers)
+ ),
+
+ recompilation_version__compute_item_version_numbers(SourceFileTime,
+ GatheredItems, GatheredOldItems, OldItemVersionNumbers,
+ ItemVersionNumbers),
+
+ recompilation_version__compute_instance_version_numbers(SourceFileTime,
+ InstanceItems, OldInstanceItems, OldInstanceVersionNumbers,
+ InstanceVersionNumbers).
+
+:- pred recompilation_version__compute_item_version_numbers(time_t::in,
+ gathered_items::in, gathered_items::in,
+ item_version_numbers::in, item_version_numbers::out) is det.
+
+recompilation_version__compute_item_version_numbers(SourceFileTime,
+ GatheredItems, GatheredOldItems,
+ OldVersionNumbers, VersionNumbers) :-
+ VersionNumbers = map_ids(
+ (func(ItemType, Items0) =
+ map__map_values(
+ (func(NameArity, Items) = VersionNumber :-
+ OldIds = extract_ids(GatheredOldItems, ItemType),
+ (
+ map__search(OldIds, NameArity, OldItems),
+ items_are_unchanged(OldItems, Items),
+ map__search(
+ extract_ids(OldVersionNumbers, ItemType),
+ NameArity, OldVersionNumber)
+ ->
+ VersionNumber = OldVersionNumber
+ ;
+ VersionNumber = SourceFileTime
+ )
+ ),
+ Items0
+ )
+ ),
+ GatheredItems,
+ map__init
+ ).
+
+:- pred recompilation_version__compute_instance_version_numbers(time_t::in,
+ instance_item_map::in, instance_item_map::in,
+ instance_version_numbers::in, instance_version_numbers::out) is det.
+
+recompilation_version__compute_instance_version_numbers(SourceFileTime,
+ InstanceItems, OldInstanceItems,
+ OldInstanceVersionNumbers, InstanceVersionNumbers) :-
+ InstanceVersionNumbers =
+ map__map_values(
+ (func(ClassId, Items) = VersionNumber :-
+ (
+ map__search(OldInstanceItems, ClassId, OldItems),
+ items_are_unchanged(OldItems, Items),
+ map__search(OldInstanceVersionNumbers, ClassId,
+ OldVersionNumber)
+ ->
+ VersionNumber = OldVersionNumber
+ ;
+ VersionNumber = SourceFileTime
+ )
+ ),
+ InstanceItems
+ ).
+
+:- pred recompilation_version__gather_items(item_list::in,
+ gathered_items::out, instance_item_map::out) is det.
+
+recompilation_version__gather_items(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),
+
+ %
+ % Items which could appear in _OtherItems (those which aren't
+ % gathered into the list for another type of item) can't appear
+ % in the interface section. Those other items (e.g. assertions)
+ % will need to be handled here when smart recompilation is made to
+ % work with `--intermodule-optimization'.
+ %
+ Info1 = gathered_item_info(GatheredItems1, PragmaItems,
+ _OtherItems, Instances),
+ list__reverse(PragmaItems, RevPragmaItems),
+ list__foldl(distribute_pragma_items, RevPragmaItems,
+ GatheredItems1, GatheredItems).
+
+:- pred distribute_pragma_items(
+ pair(maybe_pred_or_func_id, item_and_context)::in,
+ gathered_items::in, gathered_items::out) is det.
+
+distribute_pragma_items(ItemId - ItemAndContext,
+ GatheredItems0, GatheredItems) :-
+ ItemId = MaybePredOrFunc - SymName / Arity,
+ ItemAndContext = Item - ItemContext,
+ AddIfNotExisting = no,
+ (
+ MaybePredOrFunc = yes(PredOrFunc),
+
+ ItemType = pred_or_func_to_item_type(PredOrFunc),
+ recompilation_version__add_gathered_item(Item,
+ item_id(ItemType, SymName - Arity),
+ ItemContext, AddIfNotExisting,
+ GatheredItems0, GatheredItems)
+ ;
+ MaybePredOrFunc = no,
+
+ recompilation_version__add_gathered_item(Item,
+ item_id(predicate, SymName - Arity),
+ ItemContext, AddIfNotExisting,
+ GatheredItems0, GatheredItems1),
+
+ adjust_func_arity(function, Arity, FuncArity),
+ recompilation_version__add_gathered_item(Item,
+ item_id(function, SymName - FuncArity),
+ ItemContext, AddIfNotExisting,
+ GatheredItems1, GatheredItems)
+ ).
+
+
+:- type gathered_item_info
+ ---> gathered_item_info(
+ gathered_items :: gathered_items,
+ pragma_items :: assoc_list(maybe_pred_or_func_id,
+ item_and_context),
+ other_items :: item_list,
+ instances :: instance_item_map
+ ).
+
+:- type instance_item_map == map(item_name, item_list).
+
+ % The constructors set should always be empty.
+:- type gathered_items == item_id_set(map(pair(string, arity), item_list)).
+
+:- pred recompilation_version__gather_items_2(item_and_context::in,
+ gathered_item_info::in, gathered_item_info::out) is det.
+
+recompilation_version__gather_items_2(ItemAndContext) -->
+ { ItemAndContext = Item - ItemContext },
+ (
+ { Item = type_defn(VarSet, Name, Args, Body, Cond) }
+ ->
+ (
+ { Body = abstract_type },
+ { NameItem = Item },
+ % The body of an abstract type can be recorded
+ % as used when generating a call to the automatically
+ % generated unification procedure.
+ { BodyItem = Item }
+ ;
+ { Body = du_type(_, _) },
+ { NameItem = type_defn(VarSet, Name, Args,
+ abstract_type, Cond) },
+ { BodyItem = Item }
+ ;
+ { Body = eqv_type(_) },
+ % When we use an equivalence type we
+ % always use the body.
+ { NameItem = Item },
+ { BodyItem = Item }
+ ;
+ { Body = uu_type(_) },
+ { error(
+ "recompilation_version__gather_items_2: uu_type") }
+ ),
+ { TypeId = Name - list__length(Args) },
+ GatheredItems0 =^ gathered_items,
+ { recompilation_version__add_gathered_item(NameItem,
+ item_id((type), TypeId), ItemContext,
+ yes, GatheredItems0, GatheredItems1) },
+ { recompilation_version__add_gathered_item(BodyItem,
+ item_id(type_body, TypeId), ItemContext,
+ yes, GatheredItems1, GatheredItems) },
+ ^ gathered_items := GatheredItems
+ ;
+ { Item = instance(_, ClassName, ClassArgs, _, _, _) }
+ ->
+ Instances0 =^ instances,
+ { ClassArity = list__length(ClassArgs) },
+ (
+ { map__search(Instances0, ClassName - ClassArity,
+ InstanceItems0) }
+ ->
+ { InstanceItems = InstanceItems0 }
+ ;
+ { InstanceItems = [] }
+ ),
+ { map__set(Instances0, ClassName - ClassArity,
+ [Item - ItemContext | InstanceItems], Instances) },
+ ^ instances := Instances
+ ;
+ { item_to_item_id(Item, ItemId) }
+ ->
+ GatheredItems0 =^ gathered_items,
+ { recompilation_version__add_gathered_item(Item, ItemId,
+ ItemContext, yes, GatheredItems0, GatheredItems) },
+ ^ gathered_items := GatheredItems
+ ;
+ { Item = pragma(PragmaType) },
+ { is_pred_pragma(PragmaType, yes(PredOrFuncId)) }
+ ->
+ PragmaItems =^ pragma_items,
+ ^ pragma_items := [PredOrFuncId - ItemAndContext | 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,
+ gathered_items::out) is det.
+
+recompilation_version__add_gathered_item(Item, ItemId, ItemContext,
+ AddIfNotExisting, GatheredItems0, GatheredItems) :-
+ ItemId = item_id(ItemType, Id),
+ Id = SymName - Arity,
+ unqualify_name(SymName, Name),
+ IdMap0 = extract_ids(GatheredItems0, ItemType),
+ NameArity = Name - Arity,
+ ( map__search(IdMap0, NameArity, MatchingItems0) ->
+ MatchingItems = MatchingItems0
+ ;
+ MatchingItems = []
+ ),
+ ( MatchingItems = [], AddIfNotExisting = no ->
+ GatheredItems = GatheredItems0
+ ;
+ recompilation_version__add_gathered_item_2(Item, ItemType,
+ NameArity, ItemContext, 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.
+
+recompilation_version__add_gathered_item_2(Item, ItemType, NameArity,
+ ItemContext, MatchingItems0, GatheredItems0, GatheredItems) :-
+
+ % mercury_to_mercury.m splits combined pred and mode
+ % declarations. That needs to be done here as well
+ % the item list read from the interface file will match
+ % the item list generated here.
+ (
+ Item = pred_or_func(TVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, PredName, TypesAndModes, Det,
+ Cond, Purity, ClassContext),
+ split_types_and_modes(TypesAndModes,
+ Types, MaybeModes),
+ MaybeModes = yes(Modes)
+ ->
+ TypesWithoutModes = list__map(
+ (func(Type) = type_only(Type)), Types),
+ PredOrFuncItem = pred_or_func(TVarSet, InstVarSet,
+ ExistQVars, PredOrFunc, PredName,
+ TypesWithoutModes, no, Cond, Purity,
+ ClassContext),
+ PredOrFuncModeItem = pred_or_func_mode(InstVarSet,
+ PredOrFunc, PredName, Modes, Det, Cond),
+ MatchingItems =
+ [PredOrFuncItem - ItemContext,
+ PredOrFuncModeItem - ItemContext
+ | MatchingItems0]
+ ;
+ Item = typeclass(Constraints, ClassName, ClassArgs,
+ ClassInterface0, ClassTVarSet),
+ ClassInterface0 = concrete(Methods0)
+ ->
+ MethodsList = list__map(
+ split_class_method_types_and_modes, Methods0),
+ list__condense(MethodsList, Methods),
+ TypeclassItem = typeclass(Constraints, ClassName, ClassArgs,
+ concrete(Methods), ClassTVarSet),
+ MatchingItems = [TypeclassItem - ItemContext | MatchingItems0]
+ ;
+ MatchingItems = [Item - ItemContext| MatchingItems0]
+ ),
+
+ IdMap0 = extract_ids(GatheredItems0, ItemType),
+ map__set(IdMap0, NameArity, MatchingItems, IdMap),
+ GatheredItems = update_ids(GatheredItems0, ItemType, IdMap).
+
+:- func split_class_method_types_and_modes(class_method) = list(class_method).
+
+split_class_method_types_and_modes(Method0) = Items :-
+ % Always strip the context from the item -- this is needed
+ % so the items can be easily tested for equality.
+ Method0 = pred_or_func(TVarSet, InstVarSet, ExistQVars,
+ PredOrFunc, SymName, TypesAndModes, MaybeDet,
+ Cond, Purity, ClassContext, _),
+ (
+ split_types_and_modes(TypesAndModes, Types, MaybeModes),
+ MaybeModes = yes(Modes)
+ ->
+ TypesWithoutModes = list__map(
+ (func(Type) = type_only(Type)), Types),
+ PredOrFuncModeItem = pred_or_func_mode(InstVarSet, PredOrFunc,
+ SymName, Modes, MaybeDet, Cond, term__context_init),
+ PredOrFuncModeItems = [PredOrFuncModeItem]
+ ;
+ TypesWithoutModes = TypesAndModes,
+ PredOrFuncModeItems = []
+ ),
+ PredOrFuncItem = pred_or_func(TVarSet, InstVarSet,
+ ExistQVars, PredOrFunc, SymName,
+ TypesWithoutModes, no, Cond, Purity,
+ ClassContext, term__context_init),
+ Items = [PredOrFuncItem | PredOrFuncModeItems].
+split_class_method_types_and_modes(Method0) = [Method] :-
+ % Always strip the context from the item -- this is needed
+ % so the items can be easily tested for equality.
+ Method0 = pred_or_func_mode(A, B, C, D, E, F, _),
+ Method = pred_or_func_mode(A, B, C, D, E, F, term__context_init).
+
+:- pred item_to_item_id(item::in, item_id::out) is semidet.
+
+item_to_item_id(Item, ItemId) :-
+ item_to_item_id_2(Item, yes(ItemId)).
+
+:- pred item_to_item_id_2(item::in, maybe(item_id)::out) is det.
+
+item_to_item_id_2(clause(_, _, _, _, _), no).
+item_to_item_id_2(type_defn(_, Name, Params, _, _),
+ yes(item_id((type), Name - Arity))) :-
+ list__length(Params, Arity).
+item_to_item_id_2(inst_defn(_, Name, Params, _, _),
+ yes(item_id((inst), Name - Arity))) :-
+ list__length(Params, Arity).
+item_to_item_id_2(mode_defn(_, Name, Params, _, _),
+ yes(item_id((mode), Name - Arity))) :-
+ list__length(Params, Arity).
+item_to_item_id_2(module_defn(_, _), no).
+item_to_item_id_2(Item, yes(item_id(ItemType, SymName - Arity))) :-
+ Item = pred_or_func(_, _, _, PredOrFunc, SymName,
+ TypesAndModes, _, _, _, _),
+ adjust_func_arity(PredOrFunc, Arity, list__length(TypesAndModes)),
+ ItemType = pred_or_func_to_item_type(PredOrFunc).
+item_to_item_id_2(Item, yes(item_id(ItemType, SymName - Arity))) :-
+ Item = pred_or_func_mode(_, PredOrFunc, SymName, Modes, _, _),
+ adjust_func_arity(PredOrFunc, Arity, list__length(Modes)),
+ ItemType = pred_or_func_to_item_type(PredOrFunc).
+
+ % We need to handle these separately because some pragmas
+ % may affect a predicate and a function.
+item_to_item_id_2(pragma(_), no).
+item_to_item_id_2(assertion(_, _), no).
+item_to_item_id_2(Item, yes(item_id((typeclass), ClassName - ClassArity))) :-
+ Item = typeclass(_, ClassName, ClassVars, _, _),
+ list__length(ClassVars, ClassArity).
+item_to_item_id_2(Item, yes(item_id((typeclass), ClassName - ClassArity))) :-
+ Item = instance(_, ClassName, ClassArgs, _, _, _),
+ list__length(ClassArgs, ClassArity).
+item_to_item_id_2(nothing(_), no).
+
+:- type maybe_pred_or_func_id ==
+ pair(maybe(pred_or_func), sym_name_and_arity).
+
+:- pred is_pred_pragma(pragma_type::in,
+ maybe(maybe_pred_or_func_id)::out) is det.
+
+is_pred_pragma(foreign_decl(_, _), no).
+is_pred_pragma(foreign_code(_, _), no).
+is_pred_pragma(foreign_proc(_, Name, PredOrFunc, Args, _, _),
+ yes(yes(PredOrFunc) - Name / Arity)) :-
+ adjust_func_arity(PredOrFunc, Arity, list__length(Args)).
+is_pred_pragma(type_spec(Name, _, Arity, MaybePredOrFunc, _, _, _, _),
+ yes(MaybePredOrFunc - Name / Arity)).
+is_pred_pragma(inline(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(no_inline(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(obsolete(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(export(Name, PredOrFunc, Modes, _),
+ yes(yes(PredOrFunc) - Name / Arity)) :-
+ adjust_func_arity(PredOrFunc, Arity, list__length(Modes)).
+ % Pragma import declarations are never used
+ % directly by Mercury code.
+is_pred_pragma(import(_, _, _, _, _), no).
+is_pred_pragma(source_file(_), no).
+is_pred_pragma(unused_args(PredOrFunc, Name, Arity, _, _),
+ yes(yes(PredOrFunc) - Name / Arity)).
+is_pred_pragma(fact_table(Name, Arity, _), yes(no - Name / Arity)).
+is_pred_pragma(aditi(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(base_relation(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(aditi_index(Name, Arity, _), yes(no - Name / Arity)).
+is_pred_pragma(naive(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(psn(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(aditi_memo(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(aditi_no_memo(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(supp_magic(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(context(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(owner(Name, Arity, _), yes(no - Name / Arity)).
+is_pred_pragma(tabled(_, Name, Arity, MaybePredOrFunc, _),
+ yes(MaybePredOrFunc - Name / Arity)).
+is_pred_pragma(promise_pure(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(promise_semipure(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(termination_info(PredOrFunc, Name, Modes, _, _),
+ yes(yes(PredOrFunc) - Name / Arity)) :-
+ adjust_func_arity(PredOrFunc, Arity, list__length(Modes)).
+is_pred_pragma(terminates(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(does_not_terminate(Name, Arity), yes(no - Name / Arity)).
+is_pred_pragma(check_termination(Name, Arity), yes(no - Name / Arity)).
+
+ % XXX This is a bit brittle (need to be careful with term__contexts).
+ % 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.
+
+items_are_unchanged([], []).
+items_are_unchanged([Item - _ | Items1], [Item - _ | Items2]) :-
+ items_are_unchanged(Items1, Items2).
+
+%-----------------------------------------------------------------------------%
+
+recompilation_version__write_version_numbers(
+ VersionNumbers - InstanceVersionNumbers) -->
+ { VersionNumbersList = list__filter_map(
+ (func(ItemType) = (ItemType - ItemVersions) is semidet :-
+ ItemVersions = extract_ids(VersionNumbers, ItemType),
+ \+ map__is_empty(ItemVersions)
+ ),
+ [(type), type_body, (mode), (inst),
+ predicate, function, (typeclass)]) },
+ io__write_string("{\n\t"),
+ io__write_list(VersionNumbersList, ",\n\t",
+ (pred((ItemType - ItemVersions)::in, di, uo) is det -->
+ { string_to_item_type(ItemTypeStr, ItemType) },
+ io__write_string(ItemTypeStr),
+ io__write_string("(\n\t\t"),
+ { map__to_assoc_list(ItemVersions, ItemVersionsList) },
+ io__write_list(ItemVersionsList, ",\n\t\t",
+ (pred((NameArity - VersionNumber)::in, di, uo) is det -->
+ { NameArity = Name - Arity },
+ mercury_output_bracketed_sym_name(unqualified(Name),
+ next_to_graphic_token),
+ io__write_string("/"),
+ io__write_int(Arity),
+ io__write_string(" - "),
+ write_version_number(VersionNumber)
+ )),
+ io__write_string("\n\t)")
+ )),
+ ( { map__is_empty(InstanceVersionNumbers) } ->
+ []
+ ;
+ ( { VersionNumbersList = [] } ->
+ []
+ ;
+ io__write_string(",\n\t")
+ ),
+ io__write_string("instance("),
+ { map__to_assoc_list(InstanceVersionNumbers, InstanceAL) },
+ io__write_list(InstanceAL, ",\n\n\t",
+ (pred((ClassNameArity - ClassVersionNumber)::in,
+ di, uo) is det -->
+ { ClassNameArity = ClassName - ClassArity },
+ mercury_output_bracketed_sym_name(ClassName,
+ next_to_graphic_token),
+ io__write_string("/"),
+ io__write_int(ClassArity),
+ io__write_string(" - "),
+ write_version_number(ClassVersionNumber)
+ )),
+ io__write_string(")\n\t")
+ ),
+ io__write_string("\n}").
+
+%-----------------------------------------------------------------------------%
+
+version_numbers_version_number = 1.
+
+%-----------------------------------------------------------------------------%
+
+parse_version_numbers(VersionNumbersTerm, Result) :-
+ (
+ VersionNumbersTerm = term__functor(term__atom("{}"),
+ VersionNumbersTermList0, _)
+ ->
+ VersionNumbersTermList = VersionNumbersTermList0
+ ;
+ VersionNumbersTermList = [VersionNumbersTerm]
+ ),
+ map_parser(parse_item_type_version_numbers,
+ VersionNumbersTermList, Result0),
+ (
+ Result0 = ok(List),
+ VersionNumbers0 = init_item_id_set(map__init) - map__init,
+ VersionNumbers = list__foldl(
+ (func(VNResult, VNs0 - Instances0) = VNs - Instances :-
+ (
+ VNResult = items(ItemType, ItemVNs),
+ VNs = update_ids(VNs0, ItemType, ItemVNs),
+ Instances = Instances0
+ ;
+ VNResult = instances(Instances),
+ VNs = VNs0
+ )
+ ), List, VersionNumbers0),
+ Result = ok(VersionNumbers)
+ ;
+ Result0 = error(A, B),
+ Result = error(A, B)
+ ).
+
+:- type item_version_numbers_result
+ ---> items(item_type, version_number_map)
+ ; instances(instance_version_numbers)
+ .
+
+:- pred parse_item_type_version_numbers(term::in,
+ maybe1(item_version_numbers_result)::out) is det.
+
+parse_item_type_version_numbers(Term, Result) :-
+ (
+ Term = term__functor(term__atom(ItemTypeStr),
+ ItemsVNsTerms, _),
+ string_to_item_type(ItemTypeStr, ItemType)
+ ->
+ ParseName =
+ (pred(NameTerm::in, Name::out) is semidet :-
+ NameTerm = term__functor(term__atom(Name), [], _)
+ ),
+ map_parser(parse_item_version_number(ParseName),
+ ItemsVNsTerms, Result0),
+ (
+ Result0 = ok(VNsAL),
+ map__from_assoc_list(VNsAL, VNsMap),
+ Result = ok(items(ItemType, VNsMap))
+ ;
+ Result0 = error(A, B),
+ Result = error(A, B)
+ )
+ ;
+ Term = term__functor(term__atom("instance"),
+ InstanceVNsTerms, _)
+ ->
+ ParseName =
+ (pred(NameTerm::in, Name::out) is semidet :-
+ sym_name_and_args(NameTerm, Name, [])
+ ),
+ map_parser(parse_item_version_number(ParseName),
+ InstanceVNsTerms, Result1),
+ (
+ Result1 = ok(VNsAL),
+ map__from_assoc_list(VNsAL, VNsMap),
+ Result = ok(instances(VNsMap))
+ ;
+ Result1 = error(A, B),
+ Result = error(A, B)
+ )
+ ;
+ Result = error("invalid item type version numbers",
+ Term)
+ ).
+
+:- pred parse_item_version_number(pred(term, T)::(pred(in, out) is semidet),
+ term::in, maybe1(pair(pair(T, arity), version_number))::out) is det.
+
+parse_item_version_number(ParseName, Term, Result) :-
+ (
+ Term = term__functor(term__atom("-"),
+ [ItemNameArityTerm, VersionNumberTerm], _),
+ ItemNameArityTerm = term__functor(term__atom("/"),
+ [NameTerm, ArityTerm], _),
+ ParseName(NameTerm, Name),
+ ArityTerm = term__functor(term__integer(Arity), _, _),
+ VersionNumberTerm = term__functor(term__integer(VersionInt),
+ _, _)
+ ->
+ VersionNumber =
+ recompilation__int_to_version_number(VersionInt),
+ Result = ok((Name - Arity) - VersionNumber)
+ ;
+ Result = error("error in item version number", Term)
+ ).
+
+%-----------------------------------------------------------------------------%
Index: compiler/rl.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl.m,v
retrieving revision 1.16
diff -u -u -r1.16 rl.m
--- compiler/rl.m 2000/09/18 11:51:42 1.16
+++ compiler/rl.m 2001/05/18 09:07:29
@@ -1178,9 +1178,8 @@
SchemaStrings0, SchemaStrings) :-
list__reverse(SchemaStrings0, SchemaStrings).
rl__schemas_to_strings_2(ModuleInfo, GatheredTypes0, RecursiveTypes0,
- [Schema0 | Schemas], TypeDecls0, TypeDecls,
+ [Schema | Schemas], TypeDecls0, TypeDecls,
SchemaStrings0, SchemaStrings) :-
- strip_prog_contexts(Schema0, Schema),
set__init(Parents0),
rl__gather_types(ModuleInfo, Parents0, Schema,
GatheredTypes0, GatheredTypes1,
@@ -1191,11 +1190,10 @@
Schemas, TypeDecls1, TypeDecls,
[SchemaString | SchemaStrings0], SchemaStrings).
-rl__schema_to_string(ModuleInfo, Types0, SchemaString) :-
+rl__schema_to_string(ModuleInfo, Types, SchemaString) :-
map__init(GatheredTypes0),
set__init(RecursiveTypes0),
set__init(Parents0),
- strip_prog_contexts(Types0, Types),
rl__gather_types(ModuleInfo, Parents0, Types,
GatheredTypes0, _, RecursiveTypes0, _, "", Decls,
"", SchemaString0),
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.95
diff -u -u -r1.95 type_util.m
--- compiler/type_util.m 2001/05/08 13:37:43 1.95
+++ compiler/type_util.m 2001/05/24 06:33:15
@@ -141,15 +141,12 @@
:- mode type_util__var(in, out) is semidet.
:- mode type_util__var(out, in) is det.
- % Given a type_id, a list of argument types and maybe a context,
+ % Given a type_id and a list of argument types,
% construct a type.
:- pred construct_type(type_id, list(type), (type)).
:- mode construct_type(in, in, out) is det.
-:- pred construct_type(type_id, list(type), prog_context, (type)).
-:- mode construct_type(in, in, in, out) is det.
-
:- pred construct_higher_order_type(pred_or_func, lambda_eval_method,
list(type), (type)).
:- mode construct_higher_order_type(in, in, in, out) is det.
@@ -416,12 +413,6 @@
:- pred apply_partial_map_to_list(list(T), map(T, T), list(T)).
:- mode apply_partial_map_to_list(in, in, out) is det.
-% strip out the prog_context fields, replacing them with empty
-% prog_context (as obtained by term__context_init/1)
-% in a type or list of types
-:- pred strip_prog_contexts(list(term(T))::in, list(term(T))::out) is det.
-:- pred strip_prog_context(term(T)::in, term(T)::out) is det.
-
% cons_id_adjusted_arity(ModuleInfo, Type, ConsId):
% Returns the number of arguments of specified constructor id,
% adjusted to include the extra typeclassinfo and typeinfo
@@ -710,15 +701,11 @@
).
construct_type(TypeId, Args, Type) :-
- term__context_init(Context),
- construct_type(TypeId, Args, Context, Type).
-
-construct_type(TypeId, Args, Context, Type) :-
( type_id_is_higher_order(TypeId, PredOrFunc, EvalMethod) ->
construct_higher_order_type(PredOrFunc, EvalMethod, Args, Type)
;
TypeId = SymName - _,
- construct_qualified_term(SymName, Args, Context, Type)
+ construct_qualified_term(SymName, Args, Type)
).
construct_higher_order_type(PredOrFunc, EvalMethod, ArgTypes, Type) :-
@@ -733,17 +720,15 @@
).
construct_higher_order_pred_type(EvalMethod, ArgTypes, Type) :-
- term__context_init(Context),
construct_qualified_term(unqualified("pred"),
- ArgTypes, Context, Type0),
+ ArgTypes, Type0),
qualify_higher_order_type(EvalMethod, Type0, Type).
construct_higher_order_func_type(EvalMethod, ArgTypes, RetType, Type) :-
- term__context_init(Context),
- construct_qualified_term(unqualified("func"),
- ArgTypes, Context, Type0),
+ construct_qualified_term(unqualified("func"), ArgTypes, Type0),
qualify_higher_order_type(EvalMethod, Type0, Type1),
- Type = term__functor(term__atom("="), [Type1, RetType], Context).
+ Type = term__functor(term__atom("="), [Type1, RetType],
+ term__context_init).
:- pred qualify_higher_order_type(lambda_eval_method, (type), (type)).
:- mode qualify_higher_order_type(in, in, out) is det.
@@ -1500,10 +1485,7 @@
apply_rec_subst_to_constraint(Subst, Constraint0, Constraint) :-
Constraint0 = constraint(ClassName, Types0),
- term__apply_rec_substitution_to_list(Types0, Subst, Types1),
- % we need to maintain the invariant that types in class constraints
- % do not have any information in their prog_context fields
- strip_prog_contexts(Types1, Types),
+ term__apply_rec_substitution_to_list(Types0, Subst, Types),
Constraint = constraint(ClassName, Types).
apply_subst_to_constraints(Subst,
@@ -1595,17 +1577,6 @@
Y = X
),
apply_partial_map_to_list(Xs, PartialMap, Ys).
-
-%-----------------------------------------------------------------------------%
-
-strip_prog_contexts(Terms, StrippedTerms) :-
- list__map(strip_prog_context, Terms, StrippedTerms).
-
-strip_prog_context(term__variable(V), term__variable(V)).
-strip_prog_context(term__functor(F, As0, _C0),
- term__functor(F, As, C)) :-
- term__context_init(C),
- strip_prog_contexts(As0, As).
%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.302
diff -u -u -r1.302 typecheck.m
--- compiler/typecheck.m 2001/05/15 12:14:09 1.302
+++ compiler/typecheck.m 2001/05/27 15:48:52
@@ -3685,6 +3685,12 @@
%-----------------------------------------------------------------------------%
+ %
+ % Note: changes here may require changes to
+ % post_typecheck__resolve_unify_functor,
+ % intermod__module_qualify_unify_rhs,
+ % recompilation_usage__find_matching_constructors
+ % and recompilation_check__check_functor_ambiguities.
:- pred typecheck_info_get_ctor_list(typecheck_info, cons_id, int,
list(cons_type_info), list(invalid_field_update)).
:- mode typecheck_info_get_ctor_list(typecheck_info_ui,
@@ -3783,9 +3789,7 @@
Arity = 0,
builtin_atomic_type(Functor, BuiltInTypeName)
->
- term__context_init("<builtin>", 0, Context),
- ConsType = term__functor(term__atom(BuiltInTypeName), [],
- Context),
+ construct_type(unqualified(BuiltInTypeName) - 0, [], ConsType),
varset__init(ConsTypeVarSet),
ConsInfo = cons_type_info(ConsTypeVarSet, [], ConsType, [],
constraints([], [])),
@@ -4399,13 +4403,13 @@
convert_cons_defn(TypeCheckInfo, HLDS_ConsDefn, ConsTypeInfo) :-
HLDS_ConsDefn = hlds_cons_defn(ExistQVars, ExistConstraints, Args,
- TypeId, Context),
+ TypeId, _),
assoc_list__values(Args, ArgTypes),
typecheck_info_get_types(TypeCheckInfo, Types),
map__lookup(Types, TypeId, TypeDefn),
hlds_data__get_type_defn_tvarset(TypeDefn, ConsTypeVarSet),
hlds_data__get_type_defn_tparams(TypeDefn, ConsTypeParams),
- construct_type(TypeId, ConsTypeParams, Context, ConsType),
+ construct_type(TypeId, ConsTypeParams, ConsType),
UnivConstraints = [],
Constraints = constraints(UnivConstraints, ExistConstraints),
ConsTypeInfo = cons_type_info(ConsTypeVarSet, ExistQVars,
@@ -5527,25 +5531,6 @@
io__write_string("' has not been imported).\n")
;
io__write_string(".\n")
- ).
-
-:- pred visible_module(module_name, module_info).
-:- mode visible_module(out, in) is multi.
-
-visible_module(VisibleModule, ModuleInfo) :-
- module_info_name(ModuleInfo, ThisModule),
- module_info_get_imported_module_specifiers(ModuleInfo, ImportedModules),
- %
- % the visible modules are the current module, any
- % imported modules, and any ancestor modules.
- %
- (
- VisibleModule = ThisModule
- ;
- set__member(VisibleModule, ImportedModules)
- ;
- get_ancestors(ThisModule, ParentModules),
- list__member(VisibleModule, ParentModules)
).
:- pred report_error_func_instead_of_pred(typecheck_info, pred_or_func,
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.92
diff -u -u -r1.92 unify_proc.m
--- compiler/unify_proc.m 2001/03/18 23:10:00 1.92
+++ compiler/unify_proc.m 2001/05/08 14:59:58
@@ -135,6 +135,7 @@
:- import_module quantification, clause_to_proc, term, varset.
:- import_module modes, mode_util, inst_match, instmap, (inst).
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
+:- import_module recompilation.
:- import_module tree, map, set, queue, int, string, require, assoc_list.
@@ -237,21 +238,35 @@
unify_proc__request_unify(UnifyId, InstVarSet, Determinism, Context,
ModuleInfo0, ModuleInfo) :-
+ UnifyId = TypeId - UnifyMode,
+
%
+ % Generating a unification procedure for a type uses its body.
+ %
+ module_info_get_maybe_recompilation_info(ModuleInfo0, MaybeRecompInfo0),
+ ( MaybeRecompInfo0 = yes(RecompInfo0) ->
+ recompilation__record_used_item(type_body,
+ TypeId, TypeId, RecompInfo0, RecompInfo),
+ module_info_set_maybe_recompilation_info(ModuleInfo0,
+ yes(RecompInfo), ModuleInfo1)
+ ;
+ ModuleInfo1 = ModuleInfo0
+ ),
+
+ %
% check if this unification has already been requested, or
% if the proc is hand defined.
%
- UnifyId = TypeId - UnifyMode,
(
(
- unify_proc__search_mode_num(ModuleInfo0, TypeId,
+ unify_proc__search_mode_num(ModuleInfo1, TypeId,
UnifyMode, Determinism, _)
;
TypeId = TypeName - _TypeArity,
TypeName = qualified(TypeModuleName, _),
- module_info_name(ModuleInfo0, ModuleName),
+ module_info_name(ModuleInfo1, ModuleName),
ModuleName = TypeModuleName,
- module_info_types(ModuleInfo0, TypeTable),
+ module_info_types(ModuleInfo1, TypeTable),
map__search(TypeTable, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
TypeBody = abstract_type
@@ -259,22 +274,22 @@
type_id_has_hand_defined_rtti(TypeId)
)
->
- ModuleInfo = ModuleInfo0
+ ModuleInfo = ModuleInfo1
;
%
% lookup the pred_id for the unification procedure
% that we are going to generate
%
- module_info_get_special_pred_map(ModuleInfo0, SpecialPredMap),
+ module_info_get_special_pred_map(ModuleInfo1, SpecialPredMap),
( map__search(SpecialPredMap, unify - TypeId, PredId0) ->
PredId = PredId0,
- ModuleInfo1 = ModuleInfo0
+ ModuleInfo2 = ModuleInfo1
;
% We generate unification predicates for most
% imported types lazily, so add the declarations
% and clauses now.
unify_proc__add_lazily_generated_unify_pred(TypeId,
- PredId, ModuleInfo0, ModuleInfo1)
+ PredId, ModuleInfo1, ModuleInfo2)
),
% convert from `uni_mode' to `list(mode)'
@@ -290,17 +305,17 @@
ArgLives = no, % XXX ArgLives should be part of the UnifyId
unify_proc__request_proc(PredId, ArgModes, InstVarSet, ArgLives,
- yes(Determinism), Context, ModuleInfo1,
- ProcId, ModuleInfo2),
+ yes(Determinism), Context, ModuleInfo2,
+ ProcId, ModuleInfo3),
%
% save the proc_id for this unify_proc_id
%
- module_info_get_proc_requests(ModuleInfo2, Requests0),
+ module_info_get_proc_requests(ModuleInfo3, Requests0),
unify_proc__get_unify_req_map(Requests0, UnifyReqMap0),
map__set(UnifyReqMap0, UnifyId, ProcId, UnifyReqMap),
unify_proc__set_unify_req_map(Requests0, UnifyReqMap, Requests),
- module_info_set_proc_requests(ModuleInfo2, Requests,
+ module_info_set_proc_requests(ModuleInfo3, Requests,
ModuleInfo)
).
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.63
diff -u -u -r1.63 compiler_design.html
--- compiler/notes/compiler_design.html 2001/05/24 06:07:33 1.63
+++ compiler/notes/compiler_design.html 2001/05/28 08:05:38
@@ -1044,6 +1044,35 @@
<hr>
<!---------------------------------------------------------------------------->
+<h3> SMART RECOMPILATION </h3>
+
+<p>
+
+The Mercury compiler can record program dependency information
+to avoid unnecessary recompilations when an imported module's
+interface changes in a way which does not invalidate previously
+compiled code.
+
+<ul>
+<li> recompilation.m contains types used by the other smart
+ recompilation modules.
+
+<li> recompilation_version.m generates version numbers for program items
+ in interface files.
+
+<li> recompilation_usage.m works out which program items were used
+ during a compilation.
+
+<li> recompilation_check.m is called before recompiling a module.
+ It uses the information written by recompilation_version.m and
+ recompilation_usage.m to work out whether the recompilation is
+ actually needed.
+</ul>
+
+<p>
+<hr>
+<!---------------------------------------------------------------------------->
+
<h3> MISCELLANEOUS </h3>
<dl>
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.251
diff -u -u -r1.251 user_guide.texi
--- doc/user_guide.texi 2001/05/24 06:07:40 1.251
+++ doc/user_guide.texi 2001/05/24 06:10:49
@@ -440,7 +440,7 @@
that contain the compiled code of the program
and the error messages produced by the compiler.
Specifically, this will remove all the @samp{.c}, @samp{.s}, @samp{.o},
- at samp{.pic_o}, @samp{.prof}, @samp{.no}, @samp{.ql},
+ at samp{.pic_o}, @samp{.prof}, @samp{.no}, @samp{.ql}, @samp{.used},
@ifset aditi
@samp{.schema},
@end ifset
@@ -2991,6 +2991,10 @@
Disable warnings for modules whose @samp{:- module} declaration
does not match the module's file name.
+ at sp 1
+ at item --no-warn-smart-recompilation
+Disable warnings from the smart recompilation system.
+
@end table
@node Verbosity options
@@ -3012,6 +3016,11 @@
detailed explanation of any errors it finds in your program.
@sp 1
+ at item --verbose-recompilation
+When using `--smart-recompilation', output messages
+explaining why a module needs to be recompiled.
+
+ at sp 1
@item -S
@itemx --statistics
Output messages about the compiler's time/space usage.
@@ -3176,6 +3185,12 @@
@node Auxiliary output options
@section Auxiliary output options
@table @code
+ at item --smart-recompilation
+When compiling, write program dependency information
+to be used to avoid unnecessary recompilations if an
+imported module's interface changes in a way which does
+not invalidate the compiled code.
+
@item --no-assume-gmake
When generating @file{.d}, @file{.dep} and @file{.dv} files,
generate Makefile fragments that use only the features of standard make;
Index: library/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.68
diff -u -u -r1.68 Mmakefile
--- library/Mmakefile 2001/05/18 14:23:52 1.68
+++ library/Mmakefile 2001/05/27 18:14:22
@@ -40,7 +40,11 @@
ifeq ($(LIBRARY_INTERMODULE),yes)
-INTERMODULE_OPTS = --transitive-intermodule-optimization
+# XXX Smart recompilation doesn't work with `--intermodule-optimization'.
+# We still want to generate version numbers in the interface files, so
+# just disable the warnings here.
+INTERMODULE_OPTS = --transitive-intermodule-optimization \
+ --no-warn-smart-recompilation
ENABLE_TERM_OPTS = --enable-termination
CHECK_TERM_OPTS =
# If you want to actually check termination for the library, then you need
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.224
diff -u -u -r1.224 io.m
--- library/io.m 2001/05/02 14:44:26 1.224
+++ library/io.m 2001/05/24 02:39:14
@@ -24,7 +24,7 @@
:- module io.
:- interface.
-:- import_module char, string, std_util, list.
+:- import_module char, string, std_util, list, time.
%-----------------------------------------------------------------------------%
@@ -970,6 +970,32 @@
% on some systems, the file previously named `NewFileName' will be
% deleted and replaced with the file previously named `OldFileName'.
+:- pred io__file_modification_time(string, io__res(time_t),
+ io__state, io__state).
+:- mode io__file_modification_time(in, out, di, uo) is det.
+ % io__file_modification_time(FileName, TimeResult)
+ % finds the last modification time of the given file.
+ % This predicate will only work on systems which provide
+ % the C library function stat(). On other systems the
+ % returned result will always be bound to error/1.
+
+:- pred io__input_stream_file_modification_time(io__input_stream,
+ io__res(time_t), io__state, io__state).
+:- mode io__input_stream_file_modification_time(in, out, di, uo) is det.
+ % io__input_stream_file_modification_time(Stream, TimeResult)
+ % finds the last modification time of the file corresponding to
+ % the given stream. Returns an error if the stream does not
+ % correspond to a regular file.
+ % This predicate will only work on systems which provide
+ % the C library function fstat(). On other systems the
+ % returned result will always be bound to error/1.
+
+:- pred io__binary_input_stream_file_modification_time(io__binary_input_stream,
+ io__res(time_t), io__state, io__state).
+:- mode io__binary_input_stream_file_modification_time(in,
+ out, di, uo) is det.
+ % As above, but for binary input streams.
+
%-----------------------------------------------------------------------------%
% Memory management predicates.
@@ -1657,6 +1683,110 @@
mercury::runtime::Errors::SORRY(""foreign code for this function"");
}").
+io__file_modification_time(File, Result) -->
+ io__file_modification_time_2(File, Status, Msg, Time),
+ { Status = 1 ->
+ Result = ok(Time)
+ ;
+ Result = error(io_error(Msg))
+ }.
+
+:- pred io__file_modification_time_2(string, int, string, time_t,
+ io__state, io__state).
+:- mode io__file_modification_time_2(in, out, out, out, di, uo) is det.
+
+:- pragma foreign_proc("C", io__file_modification_time_2(FileName::in,
+ Status::out, Msg::out, Time::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+#ifdef HAVE_STAT
+ struct stat s;
+ if (stat(FileName, &s) == 0) {
+ Time = s.st_mtime;
+ Msg = MR_string_const("""", 0);
+ Status = 1;
+ } else {
+ ML_maybe_make_err_msg(TRUE, ""stat() failed: "",
+ MR_PROC_LABEL, Msg);
+ Status = 0;
+ }
+#else
+ Status = 0;
+ Msg = MR_make_string_const(
+ ""io__file_modification_time not available on this platform"");
+#endif
+ update_io(IO0, IO);
+
+}").
+
+:- pragma foreign_proc("MC++", io__file_modification_time_2(_FileName::in,
+ _Status::out, _Msg::out, _Time::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ mercury::runtime::Errors::SORRY(""foreign code for this function"");
+}").
+
+io__binary_input_stream_file_modification_time(File, Result) -->
+ io__input_stream_file_modification_time(File, Result).
+
+io__input_stream_file_modification_time(File, Result) -->
+ io__input_stream_file_modification_time_2(File,
+ Status, Msg, Time),
+ { Status = 1 ->
+ Result = ok(Time)
+ ;
+ Result = error(io_error(Msg))
+ }.
+
+:- pred io__input_stream_file_modification_time_2(io__input_stream,
+ int, string, time_t, io__state, io__state).
+:- mode io__input_stream_file_modification_time_2(in,
+ out, out, out, di, uo) is det.
+
+:- pragma foreign_proc("C",
+ io__input_stream_file_modification_time_2(Stream::in,
+ Status::out, Msg::out, Time::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ MercuryFile *f = (MercuryFile *) Stream;
+#if defined(HAVE_FSTAT) && \
+ (defined(HAVE_FILENO) || defined(fileno)) && \
+ defined(S_ISREG)
+ struct stat s;
+ if (MR_IS_FILE_STREAM(*f)) {
+ if (fstat(fileno(MR_file(*f)), &s) == 0 &&
+ S_ISREG(s.st_mode))
+ {
+ Time = s.st_mtime;
+ Status = 1;
+ Msg = MR_string_const("""", 0);
+ } else {
+ ML_maybe_make_err_msg(TRUE, ""fstat() failed: "",
+ MR_PROC_LABEL, Msg);
+ Status = 0;
+ Time = 0;
+ }
+ } else {
+ Msg = MR_make_string_const(
+ ""io__input_stream_file_modification_time: stream not a regular file"");
+ Time = 0;
+ Status = 0;
+ }
+#else
+ Status = 0;
+ Msg = MR_make_string_const(
+""io__input_stream_file_modification_time not available on this platform"");
+#endif
+ update_io(IO0, IO);
+}").
+
+:- pragma foreign_proc("MC++",
+ io__input_stream_file_modification_time_2(_FileName::in,
+ _Status::out, _Msg::out, _Time::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, thread_safe],
+"{
+ mercury::runtime::Errors::SORRY(""foreign code for this function"");
+}").
%-----------------------------------------------------------------------------%
Index: library/set.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/set.m,v
retrieving revision 1.57
diff -u -u -r1.57 set.m
--- library/set.m 2001/04/24 03:59:12 1.57
+++ library/set.m 2001/05/24 02:39:14
@@ -247,6 +247,10 @@
:- func set__filter_map(func(T1) = T2, set(T1)) = set(T2).
:- mode set__filter_map(func(in) = out is semidet, in) = out is det.
+:- pred set__fold(pred(T1, T2, T2), set(T1), T2, T2).
+:- mode set__fold(pred(in, in, out) is det, in, in, out) is det.
+:- mode set__fold(pred(in, di, uo) is det, in, di, uo) is det.
+
:- func set__fold(func(T1, T2) = T2, set(T1), T2) = T2.
% set__divide(Pred, Set, TruePart, FalsePart):
@@ -430,10 +434,13 @@
S2 = set__list_to_set(list__map(F, set__to_sorted_list(S1))).
set__filter(P, S1) = S2 :-
- S2 = set__list_to_set(list__filter(P, set__to_sorted_list(S1))).
+ S2 = set__sorted_list_to_set(list__filter(P, set__to_sorted_list(S1))).
set__filter_map(PF, S1) = S2 :-
S2 = set__list_to_set(list__filter_map(PF, set__to_sorted_list(S1))).
+
+set__fold(F, S) -->
+ list__foldl(F, set__to_sorted_list(S)).
set__fold(F, S, A) = B :-
B = list__foldl(F, set__to_sorted_list(S), A).
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.229
diff -u -u -r1.229 std_util.m
--- library/std_util.m 2001/05/14 13:24:50 1.229
+++ library/std_util.m 2001/05/24 02:39:14
@@ -87,6 +87,20 @@
:- type maybe_error(T) ---> ok(T) ; error(string).
:- inst maybe_error(I) ---> ok(I) ; error(ground).
+ % map_maybe(P, yes(Value0), yes(Value)) :- P(Value, Value).
+ % map_maybe(_, no, no).
+ %
+:- pred map_maybe(pred(T, U), maybe(T), maybe(U)).
+:- mode map_maybe(pred(in, out) is det, in, out) is det.
+:- mode map_maybe(pred(in, out) is semidet, in, out) is semidet.
+:- mode map_maybe(pred(in, out) is multi, in, out) is multi.
+:- mode map_maybe(pred(in, out) is nondet, in, out) is nondet.
+
+ % map_maybe(F, yes(Value)) = yes(F(Value)).
+ % map_maybe(_, no) = no.
+ %
+:- func map_maybe(func(T) = U, maybe(T)) = maybe(U).
+
%-----------------------------------------------------------------------------%
% The "unit" type - stores no information at all.
@@ -606,6 +620,12 @@
:- import_module require, set, int, string, bool.
%-----------------------------------------------------------------------------%
+
+map_maybe(_, no, no).
+map_maybe(P, yes(T0), yes(T)) :- P(T0, T).
+
+map_maybe(_, no) = no.
+map_maybe(F, yes(T)) = yes(F(T)).
/****
Is this really useful?
Index: library/time.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/time.m,v
retrieving revision 1.20
diff -u -u -r1.20 time.m
--- library/time.m 2001/03/15 07:42:27 1.20
+++ library/time.m 2001/05/24 02:39:14
@@ -145,6 +145,20 @@
:- implementation.
+:- interface.
+
+% These functions are used internally by the compiler to deal with
+% file timestamps. Since this relies on the non-portable assumption
+% that a `time_t' can fit into a Mercury `int', this interface should
+% not be visible to users.
+
+:- func time__time_t_to_int(time_t) = int.
+:- func time__int_to_time_t(int) = time_t.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
:- import_module int, exception.
% XXX The assumption that a C `time_t' can fit into a Mercury `MR_Integer'
@@ -545,6 +559,10 @@
mercury::runtime::Errors::SORRY(""foreign code for this function"");
}").
+%-----------------------------------------------------------------------------%
+
+time_t_to_int(T) = T.
+int_to_time_t(T) = T.
%-----------------------------------------------------------------------------%
:- end_module time.
Index: runtime/RESERVED_MACRO_NAMES
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/RESERVED_MACRO_NAMES,v
retrieving revision 1.2
diff -u -u -r1.2 RESERVED_MACRO_NAMES
--- runtime/RESERVED_MACRO_NAMES 2001/03/19 02:34:48 1.2
+++ runtime/RESERVED_MACRO_NAMES 2001/05/28 06:20:26
@@ -93,6 +93,7 @@
HAVE_SIGCONTEXT_STRUCT_3ARG
HAVE_SIGINFO
HAVE_SIGINFO_T
+HAVE_STAT
HAVE_STRERROR
HAVE_SYSCONF
HAVE_SYS_PARAM
Index: runtime/mercury_conf.h.in
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf.h.in,v
retrieving revision 1.34
diff -u -u -r1.34 mercury_conf.h.in
--- runtime/mercury_conf.h.in 2001/03/13 18:02:25 1.34
+++ runtime/mercury_conf.h.in 2001/04/06 06:32:18
@@ -160,6 +160,7 @@
** HAVE_DLCLOSE we have the dlclose() function.
** HAVE_DLSYM we have the dlsym() function.
** HAVE_DLERROR we have the dlerror() function.
+** HAVE_STAT we have the stat() function.
** HAVE_FSTAT we have the fstat() function.
** HAVE_FDOPEN we have the fdopen() function.
** HAVE_FILENO we have the fileno() function.
@@ -181,6 +182,7 @@
#undef HAVE_DLCLOSE
#undef HAVE_DLSYM
#undef HAVE_DLERROR
+#undef HAVE_STAT
#undef HAVE_FSTAT
#undef HAVE_FDOPEN
#undef HAVE_FILENO
Index: runtime/mercury_string.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_string.h,v
retrieving revision 1.23
diff -u -u -r1.23 mercury_string.h
--- runtime/mercury_string.h 2000/12/06 06:05:46 1.23
+++ runtime/mercury_string.h 2001/04/10 04:29:41
@@ -39,6 +39,9 @@
*/
#define MR_string_const(string, len) ((MR_String) string)
+#define MR_make_string_const(string) \
+ MR_string_const((string), sizeof(string) - 1)
+
/*
** bool MR_string_equal(MR_ConstString s1, MR_ConstString s2):
** Return true iff the two Mercury strings s1 and s2 are equal.
Index: scripts/Mmake.rules
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/Mmake.rules,v
retrieving revision 1.95
diff -u -u -r1.95 Mmake.rules
--- scripts/Mmake.rules 2001/05/23 09:06:29 1.95
+++ scripts/Mmake.rules 2001/05/24 06:11:02
@@ -196,17 +196,14 @@
# C back-end
$(cs_subdir)%.c : %.m
- rm -f $(cs_subdir)$*.c
$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) $< > $*.err 2>&1
# Aditi-RL back-end
$(rlos_subdir)%.rlo : %.m
- rm -f $(rlos_subdir)$*.rlo
$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) --aditi-only $< > $*.err 2>&1
# .NET back-end
$(ils_subdir)%.il : %.m
- rm -f $(ils_subdir)$*.il
$(MCG) $(ALL_GRADEFLAGS) $(ALL_MCGFLAGS) --il-only $< > $*.err 2>&1
# These rules are only available in *il* backends, because we'd like to avoid
@@ -214,13 +211,11 @@
# IL to generate a DLL if we are in a non-IL grade.
ifeq ($(findstring il,$(GRADE)),il)
$(os_subdir)%.dll : %.cpp
- rm -f $(os_subdir)$*.dll
$(MS_CL) -CLR$(MS_CL_NOASM) -I$(MERC_C_INCL_DIR) \
-I$(MERC_DLL_DIR) $(ALL_MS_CLFLAGS) $< -link -noentry \
mscoree.lib -dll $(MS_CL_LIBS) -out:$@
$(os_subdir)%.dll : %.il
- rm -f $(os_subdir)$*.dll
$(MS_ILASM) $(ALL_MS_ILASMFLAGS) /dll /quiet /OUT=$@ $<
endif
Index: tests/README
===================================================================
RCS file: /home/mercury1/repository/tests/README,v
retrieving revision 1.5
diff -u -u -r1.5 README
--- tests/README 1999/07/12 06:24:58 1.5
+++ tests/README 2001/05/11 03:45:05
@@ -38,6 +38,9 @@
hard-coded in a hand-written `.exp' file, rather having the
`.exp' file be generated automatically using NU-Prolog.
+recompilation
+ This directory contains tests of the smart recompilation system.
+
valid
This directory is for test cases that are not complete
programs. We just check that the files compile.
Index: tests/handle_options
===================================================================
RCS file: /home/mercury1/repository/tests/handle_options,v
retrieving revision 1.7
diff -u -u -r1.7 handle_options
--- tests/handle_options 2001/01/31 11:34:24 1.7
+++ tests/handle_options 2001/05/15 04:11:27
@@ -15,6 +15,10 @@
Pass \`--target <target>' as an option to \`mmake check'.
-j <num-jobs>, --jobs <num-jobs>
Run using <num-jobs> different parallel processes.
+ -e, --generate-missing-exp-files
+ If any missing \`.exp' or \`.err_exp' files are missing,
+ generate them rather than reporting an error.
+ Currently only works in the recompilation directory.
"
targetopt=""
@@ -29,6 +33,7 @@
cflag=""
lflag=""
gflag=""
+generate_missing_exp_files=false
while [ $# -gt 0 ]; do
case "$1" in
@@ -67,6 +72,9 @@
-t|--target)
target_opt="--target '$2'"; shift ;;
+
+ -e|--generate-missing-exp-files)
+ generate_missing_exp_files=true ;;
--)
shift; break ;;
Index: tests/recompilation/Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null Mon Apr 16 11:57:05 2001
+++ Mmakefile Mon May 28 16:40:25 2001
@@ -0,0 +1,27 @@
+#-----------------------------------------------------------------------------#
+
+main_target: check
+
+include ../Mmake.common
+-include ../Mmake.params
+
+#-----------------------------------------------------------------------------#
+#-----------------------------------------------------------------------------#
+
+clean_local:
+
+realclean_local:
+ . ./TESTS; \
+ for module in $$TESTS_SHOULD_SUCCEED $$TESTS_SHOULD_FAIL; do \
+ rm -rf $$module.m $${module}_2.m ;\
+ done
+
+# Smart recompilation doesn't yet work with --intermodule-optimization.
+EXTRA_MCFLAGS += --no-intermodule-optimization --smart-recompilation \
+ --verbose-recompilation
+
+# This module tests recompilation of a module which depends on a module
+# for which no version numbers have been computed.
+MCFLAGS-no_version_numbers_r_2 = --no-smart-recompilation
+
+#-----------------------------------------------------------------------------#
Index: tests/recompilation/README
===================================================================
RCS file: README
diff -N README
--- /dev/null Mon Apr 16 11:57:05 2001
+++ README Fri May 25 02:54:56 2001
@@ -0,0 +1,24 @@
+
+This directory contains tests for the `--smart-recompilation' option.
+The output with `--verbose-recompilation' is checked to make sure
+that recompilation occurs when expected.
+
+Most of the tests consist of two modules, a main module and a module
+imported from the main module. The `.1' or `.2' after
+the file name is a version number.
+The tests are run as follows:
+ Compile the program using the `.1' versions of each module.
+ Check the expected output.
+ Update the imported module to version `.2'.
+ Check the expected output.
+ Check that the `.err' files contain the correct
+ `--verbose-recompilation' messages.
+
+Tests with names ending in `_nr' result in no recompilation
+of the main module after the change to the imported module.
+
+Tests with names ending in `_r' should recompile the main module.
+
+Tests with names ending in `_re' should recompile the main module,
+reporting an error in the recompilation.
+
Index: tests/recompilation/TESTS
===================================================================
RCS file: TESTS
diff -N TESTS
--- /dev/null Mon Apr 16 11:57:05 2001
+++ TESTS Mon May 28 15:29:29 2001
@@ -0,0 +1,24 @@
+
+TESTS_SHOULD_SUCCEED="\
+ add_constructor_r \
+ add_instance_r \
+ add_instance_2_r \
+ add_type_nr \
+ change_class_r \
+ change_instance_r \
+ change_mode_r \
+ field_r \
+ func_overloading_nr \
+ func_overloading_r \
+ lambda_mode_r \
+ nested_module_r \
+ no_version_numbers_r \
+ pragma_type_spec_r \
+ pred_ctor_ambiguity_r \
+ pred_overloading_r"
+
+TESTS_SHOULD_FAIL="\
+ add_type_re \
+ remove_type_re \
+ type_qual_re"
+
Index: tests/recompilation/add_constructor_r.err_exp.2
===================================================================
RCS file: add_constructor_r.err_exp.2
diff -N add_constructor_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_constructor_r.err_exp.2 Tue May 22 17:36:07 2001
@@ -0,0 +1,3 @@
+Recompiling module `add_constructor_r':
+ addition of constructor `c/1' of type `add_constructor_r_2:bar/0' could cause
+ an ambiguity with constructor `c/1' of type `add_constructor_r:t/0'.
Index: tests/recompilation/add_constructor_r.exp.1
===================================================================
RCS file: add_constructor_r.exp.1
diff -N add_constructor_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_constructor_r.exp.1 Thu May 17 02:44:58 2001
@@ -0,0 +1 @@
+c(1)
Index: tests/recompilation/add_constructor_r.exp.2
===================================================================
RCS file: add_constructor_r.exp.2
diff -N add_constructor_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_constructor_r.exp.2 Thu May 17 02:44:58 2001
@@ -0,0 +1 @@
+c(1)
Index: tests/recompilation/add_constructor_r.m.1
===================================================================
RCS file: add_constructor_r.m.1
diff -N add_constructor_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_constructor_r.m.1 Thu May 17 02:46:58 2001
@@ -0,0 +1,22 @@
+:- module add_constructor_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module add_constructor_r_2.
+
+:- type t
+ ---> c(int).
+
+main -->
+ output(c(1)).
+
+:- pred output(t::in, io__state::di, io__state::uo) is det.
+
+output(X) --> io__write(X), io__nl.
+
Index: tests/recompilation/add_constructor_r_2.err_exp.2
===================================================================
RCS file: add_constructor_r_2.err_exp.2
diff -N add_constructor_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_constructor_r_2.err_exp.2 Tue May 22 17:36:07 2001
@@ -0,0 +1,2 @@
+Recompiling module `add_constructor_r_2':
+ add_constructor_r_2.m has changed.
Index: tests/recompilation/add_constructor_r_2.m.1
===================================================================
RCS file: add_constructor_r_2.m.1
diff -N add_constructor_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_constructor_r_2.m.1 Thu May 17 02:24:12 2001
@@ -0,0 +1,8 @@
+:- module add_constructor_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
Index: tests/recompilation/add_constructor_r_2.m.2
===================================================================
RCS file: add_constructor_r_2.m.2
diff -N add_constructor_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_constructor_r_2.m.2 Thu May 17 02:26:02 2001
@@ -0,0 +1,11 @@
+
+:- module add_constructor_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- type bar
+ ---> c(float).
Index: tests/recompilation/add_instance_2_r.err_exp.2
===================================================================
RCS file: add_instance_2_r.err_exp.2
diff -N add_instance_2_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_2_r.err_exp.2 Tue May 22 20:07:37 2001
@@ -0,0 +1,3 @@
+Recompiling module `add_instance_2_r':
+ an instance for class `add_instance_2_r:io/1' in module `add_instance_2_r_2'
+ was added or modified.
Index: tests/recompilation/add_instance_2_r.exp.1
===================================================================
RCS file: add_instance_2_r.exp.1
diff -N add_instance_2_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_2_r.exp.1 Tue May 22 19:58:10 2001
@@ -0,0 +1 @@
+a
\ No newline at end of file
Index: tests/recompilation/add_instance_2_r.exp.2
===================================================================
RCS file: add_instance_2_r.exp.2
diff -N add_instance_2_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_2_r.exp.2 Tue May 22 20:07:37 2001
@@ -0,0 +1 @@
+a
\ No newline at end of file
Index: tests/recompilation/add_instance_2_r.m.1
===================================================================
RCS file: add_instance_2_r.m.1
diff -N add_instance_2_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_2_r.m.1 Tue May 22 20:05:22 2001
@@ -0,0 +1,32 @@
+:- module add_instance_2_r.
+
+:- interface.
+
+:- import_module io.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::out) is det.
+
+:- typeclass io(T) where [
+ pred output(T::in, io__state::di, io__state::uo) is det
+].
+
+:- instance io(foo) where [
+ pred(output/3) is io__write
+].
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+init_foo(a).
+
+:- import_module add_instance_2_r_2.
+
+main -->
+ { init_foo(X) },
+ output(X).
+
Index: tests/recompilation/add_instance_2_r_2.err_exp.2
===================================================================
RCS file: add_instance_2_r_2.err_exp.2
diff -N add_instance_2_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_2_r_2.err_exp.2 Mon May 28 15:18:36 2001
@@ -0,0 +1,2 @@
+Recompiling module `add_instance_2_r_2':
+ add_instance_2_r_2.m has changed.
Index: tests/recompilation/add_instance_2_r_2.m.1
===================================================================
RCS file: add_instance_2_r_2.m.1
diff -N add_instance_2_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_2_r_2.m.1 Tue May 22 19:59:28 2001
@@ -0,0 +1,9 @@
+:- module add_instance_2_r_2.
+
+:- interface.
+
+:- import_module add_instance_2_r.
+
+:- type bar == foo.
+
+:- implementation.
Index: tests/recompilation/add_instance_2_r_2.m.2
===================================================================
RCS file: add_instance_2_r_2.m.2
diff -N add_instance_2_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_2_r_2.m.2 Mon May 28 13:59:32 2001
@@ -0,0 +1,18 @@
+:- module add_instance_2_r_2.
+
+:- interface.
+
+:- import_module add_instance_2_r.
+
+:- type bar == foo.
+
+:- instance io(int).
+
+:- implementation.
+
+:- import_module io.
+
+:- instance io(int) where [
+ pred(output/3) is io__write_int
+].
+
Index: tests/recompilation/add_instance_r.err_exp.2
===================================================================
RCS file: add_instance_r.err_exp.2
diff -N add_instance_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_r.err_exp.2 Tue May 22 18:49:06 2001
@@ -0,0 +1,3 @@
+Recompiling module `add_instance_r':
+ an instance for class `add_instance_r_2:io/1' in module `add_instance_r_2'
+ was added or modified.
Index: tests/recompilation/add_instance_r.exp.1
===================================================================
RCS file: add_instance_r.exp.1
diff -N add_instance_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_r.exp.1 Tue May 22 18:49:03 2001
@@ -0,0 +1 @@
+a
\ No newline at end of file
Index: tests/recompilation/add_instance_r.exp.2
===================================================================
RCS file: add_instance_r.exp.2
diff -N add_instance_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_r.exp.2 Tue May 22 18:49:06 2001
@@ -0,0 +1 @@
+a
\ No newline at end of file
Index: tests/recompilation/add_instance_r.m.1
===================================================================
RCS file: add_instance_r.m.1
diff -N add_instance_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_r.m.1 Tue May 22 18:31:12 2001
@@ -0,0 +1,16 @@
+:- module add_instance_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module add_instance_r_2.
+
+main -->
+ { init_foo(X) },
+ output(X).
+
Index: tests/recompilation/add_instance_r_2.err_exp.2
===================================================================
RCS file: add_instance_r_2.err_exp.2
diff -N add_instance_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_r_2.err_exp.2 Tue May 22 18:49:06 2001
@@ -0,0 +1,2 @@
+Recompiling module `add_instance_r_2':
+ add_instance_r_2.m has changed.
Index: tests/recompilation/add_instance_r_2.m.1
===================================================================
RCS file: add_instance_r_2.m.1
diff -N add_instance_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_r_2.m.1 Mon May 28 15:21:44 2001
@@ -0,0 +1,26 @@
+:- module add_instance_r_2.
+
+:- interface.
+
+:- import_module io.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::out) is det.
+
+:- typeclass io(T) where [
+ pred output(T::in, io__state::di, io__state::uo) is det
+].
+
+:- instance io(foo).
+
+:- implementation.
+
+:- instance io(foo) where [
+ pred(output/3) is io__write
+].
+
+init_foo(a).
+
Index: tests/recompilation/add_instance_r_2.m.2
===================================================================
RCS file: add_instance_r_2.m.2
diff -N add_instance_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_instance_r_2.m.2 Mon May 28 15:24:41 2001
@@ -0,0 +1,32 @@
+:- module add_instance_r_2.
+
+:- interface.
+
+:- import_module io.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::out) is det.
+
+:- typeclass io(T) where [
+ pred output(T::in, io__state::di, io__state::uo) is det
+].
+
+:- instance io(foo).
+
+:- instance io(int).
+
+:- implementation.
+
+:- instance io(foo) where [
+ pred(output/3) is io__write
+].
+
+:- instance io(int) where [
+ pred(output/3) is io__write
+].
+
+init_foo(a).
+
Index: tests/recompilation/add_type_nr.err_exp.2
===================================================================
RCS file: add_type_nr.err_exp.2
diff -N add_type_nr.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_nr.err_exp.2 Tue May 22 17:36:23 2001
@@ -0,0 +1 @@
+Not recompiling module add_type_nr.
Index: tests/recompilation/add_type_nr.exp.1
===================================================================
RCS file: add_type_nr.exp.1
diff -N add_type_nr.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_nr.exp.1 Wed May 16 14:13:23 2001
@@ -0,0 +1 @@
+a
Index: tests/recompilation/add_type_nr.exp.2
===================================================================
RCS file: add_type_nr.exp.2
diff -N add_type_nr.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_nr.exp.2 Wed May 16 14:13:26 2001
@@ -0,0 +1 @@
+a
Index: tests/recompilation/add_type_nr.m.1
===================================================================
RCS file: add_type_nr.m.1
diff -N add_type_nr.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_nr.m.1 Tue May 15 17:31:41 2001
@@ -0,0 +1,20 @@
+:- module add_type_nr.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module add_type_nr_2.
+
+main -->
+ { init(X) },
+ output(X).
+
+:- pred output(foo::in, io__state::di, io__state::uo) is det.
+
+output(X) --> io__write(X), io__nl.
+
Index: tests/recompilation/add_type_nr_2.err_exp.2
===================================================================
RCS file: add_type_nr_2.err_exp.2
diff -N add_type_nr_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_nr_2.err_exp.2 Tue May 22 17:36:23 2001
@@ -0,0 +1,2 @@
+Recompiling module `add_type_nr_2':
+ add_type_nr_2.m has changed.
Index: tests/recompilation/add_type_nr_2.m.1
===================================================================
RCS file: add_type_nr_2.m.1
diff -N add_type_nr_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_nr_2.m.1 Tue May 15 14:10:41 2001
@@ -0,0 +1,14 @@
+:- module add_type_nr_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init(foo::out) is det.
+
+:- implementation.
+
+init(a).
+
Index: tests/recompilation/add_type_nr_2.m.2
===================================================================
RCS file: add_type_nr_2.m.2
diff -N add_type_nr_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_nr_2.m.2 Tue May 15 14:10:41 2001
@@ -0,0 +1,16 @@
+:- module add_type_nr_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- type bar == int.
+
+:- pred init(foo::out) is det.
+
+:- implementation.
+
+init(a).
+
Index: tests/recompilation/add_type_re.err_exp.2
===================================================================
RCS file: add_type_re.err_exp.2
diff -N add_type_re.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_re.err_exp.2 Tue May 22 17:37:12 2001
@@ -0,0 +1,8 @@
+Recompiling module `add_type_re':
+ addition of type `add_type_re_2:bar/0' could cause an ambiguity with type
+ `add_type_re:bar/0'.
+add_type_re.m:029: In definition of predicate `add_type_re:output_bar'/3
+add_type_re.m:029: ambiguity error: multiple possible matches for type `bar'/0.
+add_type_re.m:029: The possible matches are in modules
+add_type_re.m:029: `add_type_re' and `add_type_re_2'.
+For more information, try recompiling with `-E'.
Index: tests/recompilation/add_type_re.exp.1
===================================================================
RCS file: add_type_re.exp.1
diff -N add_type_re.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_re.exp.1 Wed May 16 14:13:29 2001
@@ -0,0 +1,2 @@
+a
+1.00000000000000
Index: tests/recompilation/add_type_re.m.1
===================================================================
RCS file: add_type_re.m.1
diff -N add_type_re.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_re.m.1 Tue May 15 17:40:20 2001
@@ -0,0 +1,31 @@
+:- module add_type_re.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module add_type_re_2.
+
+main -->
+ { init_foo(X) },
+ output_foo(X),
+ { init_bar(Y) },
+ output_bar(Y).
+
+:- type bar == float.
+
+:- pred init_bar(float::out) is det.
+
+init_bar(1.0).
+
+:- pred output_foo(foo::in, io__state::di, io__state::uo) is det.
+
+output_foo(X) --> io__write(X), io__nl.
+
+:- pred output_bar(bar::in, io__state::di, io__state::uo) is det.
+
+output_bar(X) --> io__write(X), io__nl.
Index: tests/recompilation/add_type_re_2.err_exp.2
===================================================================
RCS file: add_type_re_2.err_exp.2
diff -N add_type_re_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_re_2.err_exp.2 Mon May 28 15:15:20 2001
@@ -0,0 +1,2 @@
+Recompiling module `add_type_re_2':
+ add_type_re_2.used: file not found.
Index: tests/recompilation/add_type_re_2.m.1
===================================================================
RCS file: add_type_re_2.m.1
diff -N add_type_re_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_re_2.m.1 Tue May 15 17:28:16 2001
@@ -0,0 +1,14 @@
+:- module add_type_re_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::out) is det.
+
+:- implementation.
+
+init_foo(a).
+
Index: tests/recompilation/add_type_re_2.m.2
===================================================================
RCS file: add_type_re_2.m.2
diff -N add_type_re_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ add_type_re_2.m.2 Tue May 15 17:28:39 2001
@@ -0,0 +1,16 @@
+:- module add_type_re_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- type bar == int.
+
+:- pred init_foo(foo::out) is det.
+
+:- implementation.
+
+init_foo(a).
+
Index: tests/recompilation/change_class_r.err_exp.2
===================================================================
RCS file: change_class_r.err_exp.2
diff -N change_class_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_class_r.err_exp.2 Tue May 22 17:36:41 2001
@@ -0,0 +1,2 @@
+Recompiling module `change_class_r':
+ typeclass `change_class_r_2:io/1' was modified.
Index: tests/recompilation/change_class_r.exp.1
===================================================================
RCS file: change_class_r.exp.1
diff -N change_class_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_class_r.exp.1 Fri May 18 04:55:48 2001
@@ -0,0 +1 @@
+a
\ No newline at end of file
Index: tests/recompilation/change_class_r.exp.2
===================================================================
RCS file: change_class_r.exp.2
diff -N change_class_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_class_r.exp.2 Fri May 18 04:56:33 2001
@@ -0,0 +1 @@
+a
\ No newline at end of file
Index: tests/recompilation/change_class_r.m.1
===================================================================
RCS file: change_class_r.m.1
diff -N change_class_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_class_r.m.1 Fri May 18 04:39:20 2001
@@ -0,0 +1,16 @@
+:- module change_class_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module change_class_r_2.
+
+main -->
+ { init_foo(X) },
+ output(X).
+
Index: tests/recompilation/change_class_r_2.err_exp.2
===================================================================
RCS file: change_class_r_2.err_exp.2
diff -N change_class_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_class_r_2.err_exp.2 Tue May 22 17:36:41 2001
@@ -0,0 +1,2 @@
+Recompiling module `change_class_r_2':
+ change_class_r_2.m has changed.
Index: tests/recompilation/change_class_r_2.m.1
===================================================================
RCS file: change_class_r_2.m.1
diff -N change_class_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_class_r_2.m.1 Fri May 18 04:55:24 2001
@@ -0,0 +1,24 @@
+:- module change_class_r_2.
+
+:- interface.
+
+:- import_module io.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::out) is det.
+
+:- typeclass io(T) where [
+ pred output(T::in, io__state::di, io__state::uo) is det
+].
+
+:- instance io(foo) where [
+ pred(output/3) is io__write
+].
+
+:- implementation.
+
+init_foo(a).
+
Index: tests/recompilation/change_class_r_2.m.2
===================================================================
RCS file: change_class_r_2.m.2
diff -N change_class_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_class_r_2.m.2 Tue May 22 02:26:55 2001
@@ -0,0 +1,35 @@
+:- module change_class_r_2.
+
+:- interface.
+
+:- import_module io.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::out) is det.
+
+:- typeclass io(T) where [
+ pred output(T::in, io__state::di, io__state::uo) is det,
+ pred input(T::out, io__state::di, io__state::uo) is det
+].
+
+:- instance io(foo) where [
+ pred(output/3) is io__write,
+ (input(T) -->
+ io__read(Result),
+ { Result = ok(T0) ->
+ T = T0
+ ;
+ error("io__read failed")
+ }
+ )
+].
+
+:- implementation.
+
+:- import_module require.
+
+init_foo(a).
+
Index: tests/recompilation/change_instance_r.err_exp.2
===================================================================
RCS file: change_instance_r.err_exp.2
diff -N change_instance_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_instance_r.err_exp.2 Mon May 28 15:10:50 2001
@@ -0,0 +1,2 @@
+Recompiling module `change_instance_r':
+ type `change_instance_r_2:baz/0' was modified.
Index: tests/recompilation/change_instance_r.exp.1
===================================================================
RCS file: change_instance_r.exp.1
diff -N change_instance_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_instance_r.exp.1 Mon May 28 15:08:12 2001
@@ -0,0 +1 @@
+a
\ No newline at end of file
Index: tests/recompilation/change_instance_r.exp.2
===================================================================
RCS file: change_instance_r.exp.2
diff -N change_instance_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_instance_r.exp.2 Mon May 28 15:08:13 2001
@@ -0,0 +1 @@
+a
\ No newline at end of file
Index: tests/recompilation/change_instance_r.m.1
===================================================================
RCS file: change_instance_r.m.1
diff -N change_instance_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_instance_r.m.1 Mon May 28 15:05:41 2001
@@ -0,0 +1,32 @@
+:- module change_instance_r.
+
+:- interface.
+
+:- import_module io.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::out) is det.
+
+:- typeclass io(T) where [
+ pred output(T::in, io__state::di, io__state::uo) is det
+].
+
+:- instance io(foo) where [
+ pred(output/3) is io__write
+].
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+init_foo(a).
+
+:- import_module change_instance_r_2.
+
+main -->
+ { init_foo(X) },
+ output(X).
+
Index: tests/recompilation/change_instance_r_2.err_exp.2
===================================================================
RCS file: change_instance_r_2.err_exp.2
diff -N change_instance_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_instance_r_2.err_exp.2 Mon May 28 15:11:21 2001
@@ -0,0 +1,2 @@
+Recompiling module `change_instance_r_2':
+ change_instance_r_2.m has changed.
Index: tests/recompilation/change_instance_r_2.m.1
===================================================================
RCS file: change_instance_r_2.m.1
diff -N change_instance_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_instance_r_2.m.1 Mon May 28 15:07:13 2001
@@ -0,0 +1,20 @@
+:- module change_instance_r_2.
+
+:- interface.
+
+:- import_module change_instance_r.
+
+:- type bar == int.
+
+:- type baz == int.
+
+:- instance io(baz).
+
+:- implementation.
+
+:- import_module io.
+
+:- instance io(int) where [
+ pred(output/3) is io__write_int
+].
+
Index: tests/recompilation/change_instance_r_2.m.2
===================================================================
RCS file: change_instance_r_2.m.2
diff -N change_instance_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_instance_r_2.m.2 Mon May 28 15:07:39 2001
@@ -0,0 +1,20 @@
+:- module change_instance_r_2.
+
+:- interface.
+
+:- import_module change_instance_r.
+
+:- type bar == int.
+
+:- type baz == bar.
+
+:- instance io(baz).
+
+:- implementation.
+
+:- import_module io.
+
+:- instance io(int) where [
+ pred(output/3) is io__write_int
+].
+
Index: tests/recompilation/change_mode_r.err_exp.2
===================================================================
RCS file: change_mode_r.err_exp.2
diff -N change_mode_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_mode_r.err_exp.2 Tue May 22 17:36:58 2001
@@ -0,0 +1,2 @@
+Recompiling module `change_mode_r':
+ inst `change_mode_r_2:foo/0' was modified.
Index: tests/recompilation/change_mode_r.exp.1
===================================================================
RCS file: change_mode_r.exp.1
diff -N change_mode_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_mode_r.exp.1 Wed May 16 15:40:00 2001
@@ -0,0 +1 @@
+a
Index: tests/recompilation/change_mode_r.exp.2
===================================================================
RCS file: change_mode_r.exp.2
diff -N change_mode_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_mode_r.exp.2 Wed May 16 15:40:02 2001
@@ -0,0 +1 @@
+a
Index: tests/recompilation/change_mode_r.m.1
===================================================================
RCS file: change_mode_r.m.1
diff -N change_mode_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_mode_r.m.1 Wed May 16 14:42:18 2001
@@ -0,0 +1,21 @@
+:- module change_mode_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module change_mode_r_2.
+
+main -->
+ { init_foo(X) },
+ output_foo(X).
+
+
+:- pred output_foo(foo::in, io__state::di, io__state::uo) is det.
+
+output_foo(X) --> io__write(X), io__nl.
+
Index: tests/recompilation/change_mode_r_2.err_exp.2
===================================================================
RCS file: change_mode_r_2.err_exp.2
diff -N change_mode_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_mode_r_2.err_exp.2 Tue May 22 17:36:58 2001
@@ -0,0 +1,2 @@
+Recompiling module `change_mode_r_2':
+ change_mode_r_2.m has changed.
Index: tests/recompilation/change_mode_r_2.m.1
===================================================================
RCS file: change_mode_r_2.m.1
diff -N change_mode_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_mode_r_2.m.1 Wed May 16 15:39:38 2001
@@ -0,0 +1,17 @@
+:- module change_mode_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::foo_out) is det.
+
+:- mode foo_out == free >> foo.
+:- inst foo == ground.
+
+:- implementation.
+
+init_foo(a).
+
Index: tests/recompilation/change_mode_r_2.m.2
===================================================================
RCS file: change_mode_r_2.m.2
diff -N change_mode_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ change_mode_r_2.m.2 Wed May 16 15:39:44 2001
@@ -0,0 +1,18 @@
+:- module change_mode_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::foo_out) is det.
+
+:- mode foo_out == free >> foo.
+:- inst foo == foo2.
+:- inst foo2 == ground.
+
+:- implementation.
+
+init_foo(a).
+
Index: tests/recompilation/field_r.err_exp.2
===================================================================
RCS file: field_r.err_exp.2
diff -N field_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ field_r.err_exp.2 Mon May 28 15:27:04 2001
@@ -0,0 +1,4 @@
+Recompiling module `field_r':
+ addition of field access function `f/1' for constructor `field_r_2:t3/1' of
+ type `field_r_2:t3/0' could cause an ambiguity with constructor `f/1' of type
+ `field_r:t/0'.
Index: tests/recompilation/field_r.exp.1
===================================================================
RCS file: field_r.exp.1
diff -N field_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ field_r.exp.1 Mon May 28 15:27:00 2001
@@ -0,0 +1 @@
+f(1)
Index: tests/recompilation/field_r.exp.2
===================================================================
RCS file: field_r.exp.2
diff -N field_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ field_r.exp.2 Mon May 28 15:27:04 2001
@@ -0,0 +1 @@
+f(1)
Index: tests/recompilation/field_r.m.1
===================================================================
RCS file: field_r.m.1
diff -N field_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ field_r.m.1 Mon May 28 15:26:54 2001
@@ -0,0 +1,22 @@
+:- module field_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module field_r_2.
+
+:- type t
+ ---> f(t2).
+
+main -->
+ output(f(1)).
+
+:- pred output(t::in, io__state::di, io__state::uo) is det.
+
+output(X) --> io__write(X), io__nl.
+
Index: tests/recompilation/field_r_2.err_exp.2
===================================================================
RCS file: field_r_2.err_exp.2
diff -N field_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ field_r_2.err_exp.2 Mon May 28 15:27:04 2001
@@ -0,0 +1,2 @@
+Recompiling module `field_r_2':
+ field_r_2.m has changed.
Index: tests/recompilation/field_r_2.m.1
===================================================================
RCS file: field_r_2.m.1
diff -N field_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ field_r_2.m.1 Mon May 28 15:26:07 2001
@@ -0,0 +1,9 @@
+:- module field_r_2.
+
+:- interface.
+
+:- type t2 == int.
+
+:- type t3
+ ---> t3(int).
+
Index: tests/recompilation/field_r_2.m.2
===================================================================
RCS file: field_r_2.m.2
diff -N field_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ field_r_2.m.2 Mon May 28 15:26:01 2001
@@ -0,0 +1,9 @@
+:- module field_r_2.
+
+:- interface.
+
+:- type t2 == int.
+
+:- type t3
+ ---> t3(f :: int).
+
Index: tests/recompilation/func_overloading_nr.err_exp.2
===================================================================
RCS file: func_overloading_nr.err_exp.2
diff -N func_overloading_nr.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_nr.err_exp.2 Mon May 28 14:29:20 2001
@@ -0,0 +1 @@
+Not recompiling module func_overloading_nr.
Index: tests/recompilation/func_overloading_nr.exp.1
===================================================================
RCS file: func_overloading_nr.exp.1
diff -N func_overloading_nr.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_nr.exp.1 Mon May 28 14:29:17 2001
@@ -0,0 +1 @@
+f(1)
Index: tests/recompilation/func_overloading_nr.exp.2
===================================================================
RCS file: func_overloading_nr.exp.2
diff -N func_overloading_nr.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_nr.exp.2 Mon May 28 14:29:20 2001
@@ -0,0 +1 @@
+f(1)
Index: tests/recompilation/func_overloading_nr.m.1
===================================================================
RCS file: func_overloading_nr.m.1
diff -N func_overloading_nr.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_nr.m.1 Mon May 28 14:27:14 2001
@@ -0,0 +1,22 @@
+:- module func_overloading_nr.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module func_overloading_nr_2.
+
+:- type t
+ ---> f(t2).
+
+main -->
+ output(f(1)).
+
+:- pred output(t::in, io__state::di, io__state::uo) is det.
+
+output(X) --> io__write(X), io__nl.
+
Index: tests/recompilation/func_overloading_nr_2.err_exp.2
===================================================================
RCS file: func_overloading_nr_2.err_exp.2
diff -N func_overloading_nr_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_nr_2.err_exp.2 Mon May 28 14:29:20 2001
@@ -0,0 +1,2 @@
+Recompiling module `func_overloading_nr_2':
+ func_overloading_nr_2.m has changed.
Index: tests/recompilation/func_overloading_nr_2.m.1
===================================================================
RCS file: func_overloading_nr_2.m.1
diff -N func_overloading_nr_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_nr_2.m.1 Mon May 28 14:27:58 2001
@@ -0,0 +1,5 @@
+:- module func_overloading_nr_2.
+
+:- interface.
+
+:- type t2 == int.
Index: tests/recompilation/func_overloading_nr_2.m.2
===================================================================
RCS file: func_overloading_nr_2.m.2
diff -N func_overloading_nr_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_nr_2.m.2 Mon May 28 14:28:34 2001
@@ -0,0 +1,11 @@
+:- module func_overloading_nr_2.
+
+:- interface.
+
+:- type t2 == int.
+
+:- func f = float.
+
+:- implementation.
+
+f = 1.0.
Index: tests/recompilation/func_overloading_r.err_exp.2
===================================================================
RCS file: func_overloading_r.err_exp.2
diff -N func_overloading_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_r.err_exp.2 Mon May 28 14:26:03 2001
@@ -0,0 +1,3 @@
+Recompiling module `func_overloading_r':
+ addition of function `func_overloading_r_2:f/1' could cause an ambiguity with
+ constructor `f/1' of type `func_overloading_r:t/0'.
Index: tests/recompilation/func_overloading_r.exp.1
===================================================================
RCS file: func_overloading_r.exp.1
diff -N func_overloading_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_r.exp.1 Mon May 28 14:26:00 2001
@@ -0,0 +1 @@
+f(1)
Index: tests/recompilation/func_overloading_r.exp.2
===================================================================
RCS file: func_overloading_r.exp.2
diff -N func_overloading_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_r.exp.2 Mon May 28 14:26:03 2001
@@ -0,0 +1 @@
+f(1)
Index: tests/recompilation/func_overloading_r.m.1
===================================================================
RCS file: func_overloading_r.m.1
diff -N func_overloading_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_r.m.1 Mon May 28 14:25:49 2001
@@ -0,0 +1,22 @@
+:- module func_overloading_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module func_overloading_r_2.
+
+:- type t
+ ---> f(t2).
+
+main -->
+ output(f(1)).
+
+:- pred output(t::in, io__state::di, io__state::uo) is det.
+
+output(X) --> io__write(X), io__nl.
+
Index: tests/recompilation/func_overloading_r_2.err_exp.2
===================================================================
RCS file: func_overloading_r_2.err_exp.2
diff -N func_overloading_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_r_2.err_exp.2 Mon May 28 14:26:03 2001
@@ -0,0 +1,2 @@
+Recompiling module `func_overloading_r_2':
+ func_overloading_r_2.m has changed.
Index: tests/recompilation/func_overloading_r_2.m.1
===================================================================
RCS file: func_overloading_r_2.m.1
diff -N func_overloading_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_r_2.m.1 Mon May 28 14:25:22 2001
@@ -0,0 +1,5 @@
+:- module func_overloading_r_2.
+
+:- interface.
+
+:- type t2 == int.
Index: tests/recompilation/func_overloading_r_2.m.2
===================================================================
RCS file: func_overloading_r_2.m.2
diff -N func_overloading_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ func_overloading_r_2.m.2 Mon May 28 14:25:27 2001
@@ -0,0 +1,11 @@
+:- module func_overloading_r_2.
+
+:- interface.
+
+:- type t2 == int.
+
+:- func f(float) = float.
+
+:- implementation.
+
+f(X) = X.
Index: tests/recompilation/lambda_mode_r.err_exp.2
===================================================================
RCS file: lambda_mode_r.err_exp.2
diff -N lambda_mode_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ lambda_mode_r.err_exp.2 Mon May 28 14:55:07 2001
@@ -0,0 +1,2 @@
+Recompiling module `lambda_mode_r':
+ mode `lambda_mode_r_2:foo_in/0' was modified.
Index: tests/recompilation/lambda_mode_r.exp.1
===================================================================
RCS file: lambda_mode_r.exp.1
diff -N lambda_mode_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ lambda_mode_r.exp.1 Mon May 28 14:55:03 2001
@@ -0,0 +1 @@
+a
Index: tests/recompilation/lambda_mode_r.exp.2
===================================================================
RCS file: lambda_mode_r.exp.2
diff -N lambda_mode_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ lambda_mode_r.exp.2 Mon May 28 14:55:07 2001
@@ -0,0 +1 @@
+a
Index: tests/recompilation/lambda_mode_r.m.1
===================================================================
RCS file: lambda_mode_r.m.1
diff -N lambda_mode_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ lambda_mode_r.m.1 Mon May 28 14:54:56 2001
@@ -0,0 +1,25 @@
+:- module lambda_mode_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module lambda_mode_r_2.
+
+main -->
+ { P =
+ (pred(X :: foo_in, di, uo) is det -->
+ io__write(X),
+ io__nl
+ ) },
+ { init_foo(F) },
+ P(F).
+
+:- pred output_foo(foo::in, io__state::di, io__state::uo) is det.
+
+output_foo(X) --> io__write(X), io__nl.
+
Index: tests/recompilation/lambda_mode_r_2.err_exp.2
===================================================================
RCS file: lambda_mode_r_2.err_exp.2
diff -N lambda_mode_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ lambda_mode_r_2.err_exp.2 Mon May 28 14:55:07 2001
@@ -0,0 +1,2 @@
+Recompiling module `lambda_mode_r_2':
+ lambda_mode_r_2.m has changed.
Index: tests/recompilation/lambda_mode_r_2.m.1
===================================================================
RCS file: lambda_mode_r_2.m.1
diff -N lambda_mode_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ lambda_mode_r_2.m.1 Mon May 28 14:53:20 2001
@@ -0,0 +1,18 @@
+:- module lambda_mode_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::foo_out) is det.
+
+:- mode foo_out == free >> foo.
+:- mode foo_in == foo >> foo.
+:- inst foo == ground.
+
+:- implementation.
+
+init_foo(a).
+
Index: tests/recompilation/lambda_mode_r_2.m.2
===================================================================
RCS file: lambda_mode_r_2.m.2
diff -N lambda_mode_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ lambda_mode_r_2.m.2 Mon May 28 14:53:25 2001
@@ -0,0 +1,18 @@
+:- module lambda_mode_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred init_foo(foo::foo_out) is det.
+
+:- mode foo_out == free >> foo.
+:- mode foo_in == ground >> ground.
+:- inst foo == ground.
+
+:- implementation.
+
+init_foo(a).
+
Index: tests/recompilation/nested_module_r.err_exp.2
===================================================================
RCS file: nested_module_r.err_exp.2
diff -N nested_module_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ nested_module_r.err_exp.2 Mon May 28 04:01:18 2001
@@ -0,0 +1,4 @@
+Not recompiling module nested_module_r.
+Recompiling module `nested_module_r:sub_nested_module':
+ addition of constructor `c/1' of type `nested_module_r_2:bar/0' could cause
+ an ambiguity with constructor `c/1' of type `nested_module_r:t/0'.
Index: tests/recompilation/nested_module_r.exp.1
===================================================================
RCS file: nested_module_r.exp.1
diff -N nested_module_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ nested_module_r.exp.1 Mon May 28 03:21:52 2001
@@ -0,0 +1 @@
+c(1)
Index: tests/recompilation/nested_module_r.exp.2
===================================================================
RCS file: nested_module_r.exp.2
diff -N nested_module_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ nested_module_r.exp.2 Mon May 28 03:27:43 2001
@@ -0,0 +1 @@
+c(1)
Index: tests/recompilation/nested_module_r.m.1
===================================================================
RCS file: nested_module_r.m.1
diff -N nested_module_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ nested_module_r.m.1 Mon May 28 04:01:01 2001
@@ -0,0 +1,39 @@
+:- module nested_module_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module nested_module_r__sub_nested_module, nested_module_r_2.
+
+:- type t
+ ---> c(int).
+
+main -->
+ main_2.
+
+
+:- module nested_module_r__sub_nested_module.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main_2(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module nested_module_r_2.
+
+main_2 -->
+ output(c(1)).
+
+:- pred output(t::in, io__state::di, io__state::uo) is det.
+
+output(X) --> io__write(X), io__nl.
+
+:- end_module nested_module_r__sub_nested_module.
Index: tests/recompilation/nested_module_r_2.err_exp.2
===================================================================
RCS file: nested_module_r_2.err_exp.2
diff -N nested_module_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ nested_module_r_2.err_exp.2 Mon May 28 03:27:43 2001
@@ -0,0 +1,2 @@
+Recompiling module `nested_module_r_2':
+ nested_module_r_2.m has changed.
Index: tests/recompilation/nested_module_r_2.m.1
===================================================================
RCS file: nested_module_r_2.m.1
diff -N nested_module_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ nested_module_r_2.m.1 Mon May 28 03:04:20 2001
@@ -0,0 +1,8 @@
+:- module nested_module_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
Index: tests/recompilation/nested_module_r_2.m.2
===================================================================
RCS file: nested_module_r_2.m.2
diff -N nested_module_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ nested_module_r_2.m.2 Mon May 28 03:04:37 2001
@@ -0,0 +1,10 @@
+:- module nested_module_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- type bar
+ ---> c(float).
Index: tests/recompilation/no_version_numbers_r.err_exp.2
===================================================================
RCS file: no_version_numbers_r.err_exp.2
diff -N no_version_numbers_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ no_version_numbers_r.err_exp.2 Tue May 22 17:37:05 2001
@@ -0,0 +1,2 @@
+Recompiling module `no_version_numbers_r':
+ no_version_numbers_r_2.int has changed.
Index: tests/recompilation/no_version_numbers_r.exp.1
===================================================================
RCS file: no_version_numbers_r.exp.1
diff -N no_version_numbers_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ no_version_numbers_r.exp.1 Tue May 22 17:15:23 2001
@@ -0,0 +1 @@
+version 1
Index: tests/recompilation/no_version_numbers_r.exp.2
===================================================================
RCS file: no_version_numbers_r.exp.2
diff -N no_version_numbers_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ no_version_numbers_r.exp.2 Tue May 22 17:15:33 2001
@@ -0,0 +1 @@
+version 2
Index: tests/recompilation/no_version_numbers_r.m.1
===================================================================
RCS file: no_version_numbers_r.m.1
diff -N no_version_numbers_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ no_version_numbers_r.m.1 Tue May 22 17:10:53 2001
@@ -0,0 +1,16 @@
+:- module no_version_numbers_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module no_version_numbers_r_2.
+
+main -->
+ io__write_string(no_version_numbers_r_2__message),
+ io__nl.
+
Index: tests/recompilation/no_version_numbers_r_2.err_exp.2
===================================================================
RCS file: no_version_numbers_r_2.err_exp.2
diff -N no_version_numbers_r_2.err_exp.2
Index: tests/recompilation/no_version_numbers_r_2.m.1
===================================================================
RCS file: no_version_numbers_r_2.m.1
diff -N no_version_numbers_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ no_version_numbers_r_2.m.1 Tue May 22 17:11:53 2001
@@ -0,0 +1,9 @@
+:- module no_version_numbers_r_2.
+
+:- interface.
+
+:- func no_version_numbers_r_2__message = string.
+
+:- implementation.
+
+no_version_numbers_r_2__message = "version 1".
Index: tests/recompilation/no_version_numbers_r_2.m.2
===================================================================
RCS file: no_version_numbers_r_2.m.2
diff -N no_version_numbers_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ no_version_numbers_r_2.m.2 Tue May 22 17:12:17 2001
@@ -0,0 +1,11 @@
+:- module no_version_numbers_r_2.
+
+:- interface.
+
+:- type message == string.
+
+:- func no_version_numbers_r_2__message = message.
+
+:- implementation.
+
+no_version_numbers_r_2__message = "version 2".
Index: tests/recompilation/pragma_type_spec_r.err_exp.2
===================================================================
RCS file: pragma_type_spec_r.err_exp.2
diff -N pragma_type_spec_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pragma_type_spec_r.err_exp.2 Fri May 25 03:41:33 2001
@@ -0,0 +1,2 @@
+Recompiling module `pragma_type_spec_r':
+ type `pragma_type_spec_r_2:foo/0' was modified.
Index: tests/recompilation/pragma_type_spec_r.exp.1
===================================================================
RCS file: pragma_type_spec_r.exp.1
diff -N pragma_type_spec_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pragma_type_spec_r.exp.1 Fri May 25 03:41:30 2001
@@ -0,0 +1 @@
+[1, 2, 3, 4, 5, 6]
\ No newline at end of file
Index: tests/recompilation/pragma_type_spec_r.exp.2
===================================================================
RCS file: pragma_type_spec_r.exp.2
diff -N pragma_type_spec_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pragma_type_spec_r.exp.2 Fri May 25 03:41:33 2001
@@ -0,0 +1 @@
+[1, 2, 3, 4, 5, 6]
\ No newline at end of file
Index: tests/recompilation/pragma_type_spec_r.m.1
===================================================================
RCS file: pragma_type_spec_r.m.1
diff -N pragma_type_spec_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pragma_type_spec_r.m.1 Fri May 25 03:41:22 2001
@@ -0,0 +1,16 @@
+:- module pragma_type_spec_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list, pragma_type_spec_r_2.
+
+main -->
+ { List = f([1, 2, 3], [4, 5, 6]) },
+ io__write(List).
+
Index: tests/recompilation/pragma_type_spec_r_2.err_exp.2
===================================================================
RCS file: pragma_type_spec_r_2.err_exp.2
diff -N pragma_type_spec_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pragma_type_spec_r_2.err_exp.2 Fri May 25 04:06:25 2001
@@ -0,0 +1,2 @@
+Recompiling module `pragma_type_spec_r_2':
+ pragma_type_spec_r_2.m has changed.
Index: tests/recompilation/pragma_type_spec_r_2.m.1
===================================================================
RCS file: pragma_type_spec_r_2.m.1
diff -N pragma_type_spec_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pragma_type_spec_r_2.m.1 Fri May 25 03:45:41 2001
@@ -0,0 +1,18 @@
+:- module pragma_type_spec_r_2.
+
+:- interface.
+
+:- import_module list.
+
+:- func f(list(T), list(T)) = list(T).
+:- pragma type_spec(f/2, T = foo).
+
+:- type foo.
+
+:- implementation.
+
+:- type foo == int.
+
+f([], Bs) = Bs.
+f([H | T], Bs) = [H | f(T, Bs)].
+
Index: tests/recompilation/pragma_type_spec_r_2.m.2
===================================================================
RCS file: pragma_type_spec_r_2.m.2
diff -N pragma_type_spec_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pragma_type_spec_r_2.m.2 Fri May 25 03:45:46 2001
@@ -0,0 +1,16 @@
+:- module pragma_type_spec_r_2.
+
+:- interface.
+
+:- import_module list.
+
+:- func f(list(T), list(T)) = list(T).
+:- pragma type_spec(f/2, T = foo).
+
+:- type foo == int.
+
+:- implementation.
+
+f([], Bs) = Bs.
+f([H | T], Bs) = [H | f(T, Bs)].
+
Index: tests/recompilation/pred_ctor_ambiguity_r.err_exp.2
===================================================================
RCS file: pred_ctor_ambiguity_r.err_exp.2
diff -N pred_ctor_ambiguity_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_ctor_ambiguity_r.err_exp.2 Fri May 25 04:41:36 2001
@@ -0,0 +1,3 @@
+Recompiling module `pred_ctor_ambiguity_r':
+ addition of predicate `pred_ctor_ambiguity_r_2:c/2' could cause an ambiguity
+ with constructor `c/1' of type `pred_ctor_ambiguity_r:t/0'.
Index: tests/recompilation/pred_ctor_ambiguity_r.exp.1
===================================================================
RCS file: pred_ctor_ambiguity_r.exp.1
diff -N pred_ctor_ambiguity_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_ctor_ambiguity_r.exp.1 Fri May 25 04:40:39 2001
@@ -0,0 +1 @@
+c(1)
Index: tests/recompilation/pred_ctor_ambiguity_r.exp.2
===================================================================
RCS file: pred_ctor_ambiguity_r.exp.2
diff -N pred_ctor_ambiguity_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_ctor_ambiguity_r.exp.2 Fri May 25 04:41:36 2001
@@ -0,0 +1 @@
+c(1)
Index: tests/recompilation/pred_ctor_ambiguity_r.m.1
===================================================================
RCS file: pred_ctor_ambiguity_r.m.1
diff -N pred_ctor_ambiguity_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_ctor_ambiguity_r.m.1 Fri May 25 04:38:38 2001
@@ -0,0 +1,22 @@
+:- module pred_ctor_ambiguity_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module pred_ctor_ambiguity_r_2.
+
+:- type t
+ ---> c(int).
+
+main -->
+ output(c(1)).
+
+:- pred output(t::in, io__state::di, io__state::uo) is det.
+
+output(X) --> io__write(X), io__nl.
+
Index: tests/recompilation/pred_ctor_ambiguity_r_2.err_exp.2
===================================================================
RCS file: pred_ctor_ambiguity_r_2.err_exp.2
diff -N pred_ctor_ambiguity_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_ctor_ambiguity_r_2.err_exp.2 Fri May 25 04:41:36 2001
@@ -0,0 +1,2 @@
+Recompiling module `pred_ctor_ambiguity_r_2':
+ pred_ctor_ambiguity_r_2.m has changed.
Index: tests/recompilation/pred_ctor_ambiguity_r_2.m.1
===================================================================
RCS file: pred_ctor_ambiguity_r_2.m.1
diff -N pred_ctor_ambiguity_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_ctor_ambiguity_r_2.m.1 Fri May 25 04:39:21 2001
@@ -0,0 +1,8 @@
+:- module pred_ctor_ambiguity_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
Index: tests/recompilation/pred_ctor_ambiguity_r_2.m.2
===================================================================
RCS file: pred_ctor_ambiguity_r_2.m.2
diff -N pred_ctor_ambiguity_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_ctor_ambiguity_r_2.m.2 Fri May 25 04:41:19 2001
@@ -0,0 +1,15 @@
+:- module pred_ctor_ambiguity_r_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- pred c(float::in, float::out) is det.
+
+:- implementation.
+
+:- import_module float.
+
+c(X, X + 1.0).
Index: tests/recompilation/pred_overloading_r.err_exp.2
===================================================================
RCS file: pred_overloading_r.err_exp.2
diff -N pred_overloading_r.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_overloading_r.err_exp.2 Mon May 28 14:34:12 2001
@@ -0,0 +1,3 @@
+Recompiling module `pred_overloading_r':
+ addition of predicate `pred_overloading_r_2:p/3' could cause an ambiguity
+ with predicate `pred_overloading_r:p/3'.
Index: tests/recompilation/pred_overloading_r.exp.1
===================================================================
RCS file: pred_overloading_r.exp.1
diff -N pred_overloading_r.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_overloading_r.exp.1 Mon May 28 14:34:08 2001
@@ -0,0 +1 @@
+1
Index: tests/recompilation/pred_overloading_r.exp.2
===================================================================
RCS file: pred_overloading_r.exp.2
diff -N pred_overloading_r.exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_overloading_r.exp.2 Mon May 28 14:34:12 2001
@@ -0,0 +1 @@
+1
Index: tests/recompilation/pred_overloading_r.m.1
===================================================================
RCS file: pred_overloading_r.m.1
diff -N pred_overloading_r.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_overloading_r.m.1 Mon May 28 14:34:02 2001
@@ -0,0 +1,19 @@
+:- module pred_overloading_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module pred_overloading_r_2.
+
+main -->
+ p(1).
+
+:- pred p(t::in, io__state::di, io__state::uo) is det.
+
+p(X) --> io__write_int(X), io__nl.
+
Index: tests/recompilation/pred_overloading_r_2.err_exp.2
===================================================================
RCS file: pred_overloading_r_2.err_exp.2
diff -N pred_overloading_r_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_overloading_r_2.err_exp.2 Mon May 28 14:34:12 2001
@@ -0,0 +1,2 @@
+Recompiling module `pred_overloading_r_2':
+ pred_overloading_r_2.m has changed.
Index: tests/recompilation/pred_overloading_r_2.m.1
===================================================================
RCS file: pred_overloading_r_2.m.1
diff -N pred_overloading_r_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_overloading_r_2.m.1 Mon May 28 14:33:15 2001
@@ -0,0 +1,6 @@
+:- module pred_overloading_r_2.
+
+:- interface.
+
+:- type t == int.
+
Index: tests/recompilation/pred_overloading_r_2.m.2
===================================================================
RCS file: pred_overloading_r_2.m.2
diff -N pred_overloading_r_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ pred_overloading_r_2.m.2 Mon May 28 14:33:01 2001
@@ -0,0 +1,14 @@
+:- module pred_overloading_r_2.
+
+:- interface.
+
+:- import_module io.
+
+:- type t == int.
+
+:- pred p(float::in, io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+p(X) --> io__write_float(X), io__nl.
+
Index: tests/recompilation/remove_type_re.err_exp.2
===================================================================
RCS file: remove_type_re.err_exp.2
diff -N remove_type_re.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ remove_type_re.err_exp.2 Tue May 22 17:37:20 2001
@@ -0,0 +1,5 @@
+Recompiling module `remove_type_re':
+ type `remove_type_re_2:foo/0' was removed.
+remove_type_re.m:016: In definition of predicate `remove_type_re:output_foo'/3:
+remove_type_re.m:016: error: undefined type `foo'/0.
+For more information, try recompiling with `-E'.
Index: tests/recompilation/remove_type_re.exp.1
===================================================================
RCS file: remove_type_re.exp.1
diff -N remove_type_re.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ remove_type_re.exp.1 Wed May 16 14:13:33 2001
@@ -0,0 +1 @@
+a
Index: tests/recompilation/remove_type_re.m.1
===================================================================
RCS file: remove_type_re.m.1
diff -N remove_type_re.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ remove_type_re.m.1 Wed May 16 03:19:50 2001
@@ -0,0 +1,18 @@
+:- module remove_type_re.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module remove_type_re_2.
+
+main -->
+ output_foo(a).
+
+:- pred output_foo(foo::in, io__state::di, io__state::uo) is det.
+
+output_foo(X) --> io__write(X), io__nl.
Index: tests/recompilation/remove_type_re_2.err_exp.2
===================================================================
RCS file: remove_type_re_2.err_exp.2
diff -N remove_type_re_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ remove_type_re_2.err_exp.2 Mon May 28 15:15:26 2001
@@ -0,0 +1,2 @@
+Recompiling module `remove_type_re_2':
+ remove_type_re_2.used: file not found.
Index: tests/recompilation/remove_type_re_2.m.1
===================================================================
RCS file: remove_type_re_2.m.1
diff -N remove_type_re_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ remove_type_re_2.m.1 Wed May 16 03:18:24 2001
@@ -0,0 +1,9 @@
+:- module remove_type_re_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- type t == int.
Index: tests/recompilation/remove_type_re_2.m.2
===================================================================
RCS file: remove_type_re_2.m.2
diff -N remove_type_re_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ remove_type_re_2.m.2 Wed May 16 03:26:32 2001
@@ -0,0 +1,5 @@
+:- module remove_type_re_2.
+
+:- interface.
+
+:- type t == int.
Index: tests/recompilation/runtests
===================================================================
RCS file: runtests
diff -N runtests
--- /dev/null Mon Apr 16 11:57:05 2001
+++ runtests Mon May 28 15:29:48 2001
@@ -0,0 +1,53 @@
+#!/bin/sh
+# Test whether smart recompilation works and is producing the
+# expected output.
+# Return a status of 0 (true) if everything is all right, and 1 otherwise.
+
+. ../handle_options
+. ../startup
+
+. ./TESTS
+
+failing_tests=""
+cleanup=true
+
+export generate_missing_exp_files cleanup
+
+run_all_tests () {
+ test_should_fail=$1
+ shift
+
+ for test in "$@"
+ do
+ rm -f $test.res
+ touch $test.res
+ if ./two_module_test $test_should_fail $test ${test}_2
+ then
+ :
+ else
+ failing_tests="$failing_tests $test"
+ fi
+ done
+}
+
+run_all_tests false $TESTS_SHOULD_SUCCEED
+run_all_tests true $TESTS_SHOULD_FAIL
+
+cat *.res > .allres
+if [ "$failing_tests" = "" -a ! -s .allres ]
+then
+ echo "the tests in the recompilation directory succeeded"
+ echo "mmakeopts=$mmakeopts"
+ rm -f .allres
+ case $cleanup in true)
+ . ../shutdown ;;
+ esac
+ exit 0
+else
+ echo "the tests in the recompilation directory failed"
+ echo "mmakeopts=$mmakeopts"
+ echo "the tests that failed are: $failing_tests"
+ echo "the differences are:"
+ cat .allres
+ exit 1
+fi
Index: tests/recompilation/test_functions
===================================================================
RCS file: test_functions
diff -N test_functions
--- /dev/null Mon Apr 16 11:57:05 2001
+++ test_functions Mon May 28 17:34:28 2001
@@ -0,0 +1,185 @@
+#
+# Shell functions used to run the recompilation tests.
+#
+
+#
+# Set variables `main_module' and `modules' describing the test being run.
+# Copy in the initial versions of the test files.
+#
+test_module () {
+ if [ $# = 0 ]
+ then
+ echo "usage: test_module main_module other_modules"
+ exit 1
+ fi
+
+ main_module=$1
+ modules="$*"
+ echo Testing $main_module
+
+ for module in $modules
+ do
+ cp -f $module.m.1 $module.m
+
+ # The module.m.<n> files are the only ones
+ # that should be edited.
+ chmod -w $module.m
+
+ # XXX Avoid producing output files with the same timestamp
+ # as the input source file. The up-to-date check for the output
+ # file in recompilation_check.m checks that the output file's
+ # timestamp is strictly greater than the input file's, so it
+ # will recompile if they are the same.
+ #
+ # This won't be a problem in practice, unless for some reason
+ # a user decides to have mmake invoked by their editor
+ # automatically after each edit. If a file takes less
+ # than a second to compile, recompiling it all the time
+ # won't be noticeable. The recompilation will affect
+ # the `--verbose-recompilation' messages, so we need to
+ # avoid it here.
+ sleep 1
+ done
+}
+
+#
+# Simulate a user editing the file.
+#
+update_module () {
+ if [ $# != 2 ]
+ then
+ echo "usage: update_module module_name version"
+ exit 1
+ fi
+
+ module=$1
+ module_version=$2
+
+ cp -f $module.m.$module_version $module.m
+ chmod -w $module.m
+
+ sleep 1
+}
+
+mmake_depend () {
+ if mmake $main_module.depend
+ then
+ :
+ else
+ exit 1
+ fi
+}
+
+#
+# Compare the output file with the expected output file,
+# generating the expected output file if it doesn't exist
+# and the --generate-missing-exp-files option was given
+# to runtests.
+#
+compare_files () {
+ if [ $# != 2 ]
+ then
+ echo "usage: compare_files expected_file result_file"
+ exit 1
+ fi
+
+ exp_file=$1
+ res_file=$2
+
+ if [ -f $exp_file ]
+ then
+ if diff -c $exp_file $res_file >> $main_module.res
+ then
+ :
+ else
+ exit 1
+ fi
+ else
+ if [ $generate_missing_exp_files = true ]
+ then
+ echo "WARNING: generating $exp_file"
+ cp $res_file $exp_file
+ else
+ echo "Error: $exp_file not found"
+ exit 1
+ fi
+ fi
+}
+
+#
+# Build the test, then run it and compare the output.
+#
+mmake_test () {
+ if [ $# != 2 ]
+ then
+ echo "usage: mmake_test output_file_version should_fail"
+ exit 1
+ fi
+
+ output_file_version=$1
+ mmake_should_fail=$2
+
+ case $mmake_should_fail in
+ true)
+ #
+ # If the compilation is supposed to fail then the mmake
+ # output should be suppressed to avoid making it harder
+ # to find genuine failures in the nightly test logs.
+ #
+ mmake $main_module > /dev/null 2>&1
+ ;;
+ false)
+ mmake $main_module
+ ;;
+ esac
+
+ case $? in
+ 0)
+ case $mmake_should_fail in
+ true)
+ echo \
+ "Error: mmake $main_module succeeded where it should fail"
+ exit 1
+ ;;
+ esac
+
+ ./$main_module > $main_module.out
+ compare_files $main_module.exp.$output_file_version \
+ $main_module.out
+ ;;
+ *)
+ case $mmake_should_fail in
+ false)
+ echo "Error: mmake $main_module failed"
+ exit 1
+ ;;
+ esac
+ ;;
+ esac
+}
+
+check_err_file () {
+ if [ $# != 2 ]
+ then
+ echo "usage: check_err_file module message_file_version"
+ fi
+
+ module=$1
+ error_file_version=$2
+
+ compare_files $module.err_exp.$error_file_version $module.err
+}
+
+cleanup_test () {
+ case $cleanup in
+ true)
+ mmake $main_module.realclean
+
+ for module in $modules
+ do
+ rm -f $module.m
+ done
+ ;;
+ esac
+}
+
Index: tests/recompilation/two_module_test
===================================================================
RCS file: two_module_test
diff -N two_module_test
--- /dev/null Mon Apr 16 11:57:05 2001
+++ two_module_test Tue May 22 02:06:54 2001
@@ -0,0 +1,26 @@
+#!/bin/sh
+# Run a test which compiles a two module test case,
+# changes one of the modules, then tries to recompile.
+#
+
+. ./test_functions
+
+if [ $# != 3 ]
+then
+ echo "usage: two_module_test test_should_fail module1 module2"
+ exit 1
+fi
+
+test_should_fail=$1
+module1=$2
+module2=$3
+
+test_module "$module1" "$module2"
+mmake_depend
+mmake_test 1 false
+update_module "$module2" 2
+mmake_test 2 $test_should_fail
+check_err_file "$module1" 2
+check_err_file "$module2" 2
+cleanup_test
+
Index: tests/recompilation/type_qual_re.err_exp.2
===================================================================
RCS file: type_qual_re.err_exp.2
diff -N type_qual_re.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ type_qual_re.err_exp.2 Fri May 25 03:17:27 2001
@@ -0,0 +1,5 @@
+Recompiling module `type_qual_re':
+ type `type_qual_re_2:bar/0' was removed.
+type_qual_re.m:016: In explicit type qualification:
+type_qual_re.m:016: error: undefined type `bar'/0.
+For more information, try recompiling with `-E'.
Index: tests/recompilation/type_qual_re.exp.1
===================================================================
RCS file: type_qual_re.exp.1
diff -N type_qual_re.exp.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ type_qual_re.exp.1 Fri May 25 03:17:25 2001
@@ -0,0 +1 @@
+int
Index: tests/recompilation/type_qual_re.m.1
===================================================================
RCS file: type_qual_re.m.1
diff -N type_qual_re.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ type_qual_re.m.1 Fri May 25 03:16:39 2001
@@ -0,0 +1,18 @@
+:- module type_qual_re.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module type_qual_re_2.
+:- import_module std_util.
+
+main -->
+ % Type name used only in type qualification.
+ io__write_string(type_name(type_of(_ `with_type` bar))),
+ io__nl.
+
Index: tests/recompilation/type_qual_re_2.err_exp.2
===================================================================
RCS file: type_qual_re_2.err_exp.2
diff -N type_qual_re_2.err_exp.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ type_qual_re_2.err_exp.2 Mon May 28 15:15:39 2001
@@ -0,0 +1,2 @@
+Recompiling module `type_qual_re_2':
+ type_qual_re_2.used: file not found.
Index: tests/recompilation/type_qual_re_2.m.1
===================================================================
RCS file: type_qual_re_2.m.1
diff -N type_qual_re_2.m.1
--- /dev/null Mon Apr 16 11:57:05 2001
+++ type_qual_re_2.m.1 Fri May 25 03:10:23 2001
@@ -0,0 +1,9 @@
+:- module type_qual_re_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
+:- type bar == int.
Index: tests/recompilation/type_qual_re_2.m.2
===================================================================
RCS file: type_qual_re_2.m.2
diff -N type_qual_re_2.m.2
--- /dev/null Mon Apr 16 11:57:05 2001
+++ type_qual_re_2.m.2 Fri May 25 03:10:29 2001
@@ -0,0 +1,8 @@
+:- module type_qual_re_2.
+
+:- interface.
+
+:- type foo
+ ---> a
+ ; b(int).
+
--------------------------------------------------------------------------
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