[m-rev.] diff: bug fix for smart recompilation
Simon Taylor
stayl at cs.mu.OZ.AU
Sat Jan 5 23:00:42 AEDT 2002
Estimated hours taken: 3
Branches: main
compiler/recompilation_version.m:
Fix unnecessary recompilations caused by bugs in the handling
of predicate type and `:- pragma type_spec' declarations
containing unnamed variables.
tests/recompilation/TESTS:
tests/recompilation/type_spec_unnname_var_r*:
tests/recompilation/unchanged_pred_nr*:
Add test cases.
Index: compiler/recompilation_version.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation_version.m,v
retrieving revision 1.10
diff -u -u -r1.10 recompilation_version.m
--- compiler/recompilation_version.m 12 Dec 2001 00:30:14 -0000 1.10
+++ compiler/recompilation_version.m 5 Jan 2002 10:41:10 -0000
@@ -555,12 +555,36 @@
item_is_unchanged(assertion(Goal, _VarSet), Item2) =
( Item2 = assertion(Goal, _) -> yes ; no ).
- % We do need to compare the varset in `:- pragma type_spec'
+ % We do need to compare the variable names in `:- pragma type_spec'
% declarations because the names of the variables are used
% to find the corresponding variables in the predicate or
% function type declaration.
-item_is_unchanged(pragma(PragmaType), Item2) =
- ( Item2 = pragma(PragmaType) -> yes ; no ).
+item_is_unchanged(pragma(PragmaType1), Item2) = Result :-
+ ( Item2 = pragma(PragmaType2) ->
+ (
+ PragmaType1 = type_spec(Name, SpecName, Arity, MaybePredOrFunc,
+ MaybeModes, TypeSubst1, TVarSet1, _),
+ PragmaType2 = type_spec(Name, SpecName, Arity, MaybePredOrFunc,
+ MaybeModes, TypeSubst2, TVarSet2, _)
+ ->
+ assoc_list__keys_and_values(TypeSubst1, TVars1, Types1),
+ var_list_to_term_list(TVars1, TVarTypes1),
+ assoc_list__keys_and_values(TypeSubst2, TVars2, Types2),
+ var_list_to_term_list(TVars2, TVarTypes2),
+ (
+ type_list_is_unchanged(TVarSet1, TVarTypes1 ++ Types1,
+ TVarSet2, TVarTypes2 ++ Types2, _, _, _)
+ ->
+ Result = yes
+ ;
+ Result = no
+ )
+ ;
+ Result = ( PragmaType1 = PragmaType2 -> yes ; no )
+ )
+ ;
+ Result = no
+ ).
item_is_unchanged(nothing(A), Item2) =
( Item2 = nothing(A) -> yes ; no ).
@@ -645,8 +669,6 @@
Constraints1, TVarSet2, ExistQVars2,
TypesAndModes2, Constraints2) :-
- varset__merge_subst(TVarSet1, TVarSet2, TVarSet, Subst),
-
GetArgTypes =
(func(TypeAndMode0) = Type :-
(
@@ -661,7 +683,39 @@
),
Types1 = list__map(GetArgTypes, TypesAndModes1),
Types2 = list__map(GetArgTypes, TypesAndModes2),
- term__apply_substitution_to_list(Types2, Subst, SubstTypes2),
+
+ type_list_is_unchanged(TVarSet1, Types1, TVarSet2, Types2,
+ _TVarSet, RenameSubst, Types2ToTypes1Subst),
+
+ %
+ % Check that the existentially quantified variables are equivalent.
+ %
+ SubstExistQVars2 =
+ term_list_to_var_list(
+ term__apply_rec_substitution_to_list(
+ apply_substitution_to_list(
+ var_list_to_term_list(ExistQVars2),
+ RenameSubst),
+ Types2ToTypes1Subst)),
+ ExistQVars1 = SubstExistQVars2,
+
+ %
+ % Check that the class constraints are identical.
+ %
+ apply_subst_to_constraints(RenameSubst,
+ Constraints2, RenamedConstraints2),
+ apply_rec_subst_to_constraints(Types2ToTypes1Subst,
+ RenamedConstraints2, SubstConstraints2),
+ Constraints1 = SubstConstraints2.
+
+:- pred type_list_is_unchanged(tvarset::in, list(type)::in,
+ tvarset::in, list(type)::in, tvarset::out,
+ tsubst::out, tsubst::out) is semidet.
+
+type_list_is_unchanged(TVarSet1, Types1, TVarSet2, Types2,
+ TVarSet, RenameSubst, Types2ToTypes1Subst) :-
+ varset__merge_subst(TVarSet1, TVarSet2, TVarSet, RenameSubst),
+ term__apply_substitution_to_list(Types2, RenameSubst, SubstTypes2),
%
% Check that the types are equivalent
@@ -691,30 +745,27 @@
)
=>
(
- varset__lookup_name(TVarSet, VarInItem1, VarName),
- varset__lookup_name(TVarSet, VarInItem2, VarName)
+ varset__lookup_name(TVarSet, VarInItem1, VarName1),
+ varset__lookup_name(TVarSet, VarInItem2, VarName2),
+ (
+ VarName1 = VarName2
+ ;
+ %
+ % Variables written to interface files are always
+ % named, even if the variable in the source code
+ % was not, so we can't just use varset__search_name
+ % to check whether the variables are named.
+ %
+ VarIsNotNamed =
+ (pred(VarName::in) is semidet :-
+ string__append("V_", VarNum, VarName),
+ string__to_int(VarNum, _)
+ ),
+ VarIsNotNamed(VarName1),
+ VarIsNotNamed(VarName2)
+ )
)
- ),
-
- %
- % Check that the existentially quantified variables are equivalent.
- %
- SubstExistQVars2 =
- term_list_to_var_list(
- term__apply_rec_substitution_to_list(
- apply_substitution_to_list(
- var_list_to_term_list(ExistQVars2),
- Subst),
- Types2ToTypes1Subst)),
- ExistQVars1 = SubstExistQVars2,
-
- %
- % Check that the class constraints are identical.
- %
- apply_subst_to_constraints(Subst, Constraints2, RenamedConstraints2),
- apply_rec_subst_to_constraints(Types2ToTypes1Subst,
- RenamedConstraints2, SubstConstraints2),
- Constraints1 = SubstConstraints2.
+ ).
:- pred pred_or_func_mode_is_unchanged(inst_varset::in, list(mode)::in,
inst_varset::in, list(mode)::in) is semidet.
Index: tests/recompilation/TESTS
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/TESTS,v
retrieving revision 1.8
diff -u -u -r1.8 TESTS
--- tests/recompilation/TESTS 5 Nov 2001 09:40:03 -0000 1.8
+++ tests/recompilation/TESTS 4 Jan 2002 01:59:09 -0000
@@ -24,6 +24,7 @@
pred_overloading_r \
typeclass_method_pragma_r \
type_spec_rename_var_r \
+ type_spec_unname_var_r \
unchanged_pred_nr"
# Parallel mmake with nested sub-modules is broken.
Index: tests/recompilation/type_spec_unname_var_r.err_exp.2
===================================================================
RCS file: tests/recompilation/type_spec_unname_var_r.err_exp.2
diff -N tests/recompilation/type_spec_unname_var_r.err_exp.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/type_spec_unname_var_r.err_exp.2 4 Jan 2002 08:05:49 -0000
@@ -0,0 +1,2 @@
+Recompiling module `type_spec_unname_var_r':
+ predicate `type_spec_unname_var_r_2:p/4' was modified.
Index: tests/recompilation/type_spec_unname_var_r.exp.1
===================================================================
RCS file: tests/recompilation/type_spec_unname_var_r.exp.1
diff -N tests/recompilation/type_spec_unname_var_r.exp.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/type_spec_unname_var_r.exp.1 4 Jan 2002 08:05:43 -0000
@@ -0,0 +1 @@
+[1] - 2.00000000000000
Index: tests/recompilation/type_spec_unname_var_r.exp.2
===================================================================
RCS file: tests/recompilation/type_spec_unname_var_r.exp.2
diff -N tests/recompilation/type_spec_unname_var_r.exp.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/type_spec_unname_var_r.exp.2 4 Jan 2002 08:05:49 -0000
@@ -0,0 +1 @@
+[1] - 2.00000000000000
Index: tests/recompilation/type_spec_unname_var_r.m.1
===================================================================
RCS file: tests/recompilation/type_spec_unname_var_r.m.1
diff -N tests/recompilation/type_spec_unname_var_r.m.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/type_spec_unname_var_r.m.1 4 Jan 2002 08:04:40 -0000
@@ -0,0 +1,17 @@
+:- module type_spec_unname_var_r.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module type_spec_unname_var_r_2.
+:- import_module list.
+
+main -->
+ { p([1], 2.0, 2, Result) },
+ io__write(Result),
+ io__nl.
Index: tests/recompilation/type_spec_unname_var_r_2.err_exp.2
===================================================================
RCS file: tests/recompilation/type_spec_unname_var_r_2.err_exp.2
diff -N tests/recompilation/type_spec_unname_var_r_2.err_exp.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/type_spec_unname_var_r_2.err_exp.2 4 Jan 2002 08:05:49 -0000
@@ -0,0 +1,2 @@
+Recompiling module `type_spec_unname_var_r_2':
+ file `type_spec_unname_var_r_2.m' has changed.
Index: tests/recompilation/type_spec_unname_var_r_2.m.1
===================================================================
RCS file: tests/recompilation/type_spec_unname_var_r_2.m.1
diff -N tests/recompilation/type_spec_unname_var_r_2.m.1
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/type_spec_unname_var_r_2.m.1 4 Jan 2002 08:03:33 -0000
@@ -0,0 +1,12 @@
+:- module type_spec_unname_var_r_2.
+
+:- interface.
+
+:- import_module list, std_util.
+
+:- pred p(T::in, U::in, V::in, pair(T, U)::out) is det.
+:- pragma type_spec(p/4, T = list(V)).
+
+:- implementation.
+
+p(T, U, _, T - U).
Index: tests/recompilation/type_spec_unname_var_r_2.m.2
===================================================================
RCS file: tests/recompilation/type_spec_unname_var_r_2.m.2
diff -N tests/recompilation/type_spec_unname_var_r_2.m.2
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/recompilation/type_spec_unname_var_r_2.m.2 4 Jan 2002 08:03:39 -0000
@@ -0,0 +1,12 @@
+:- module type_spec_unname_var_r_2.
+
+:- interface.
+
+:- import_module list, std_util.
+
+:- pred p(T::in, U::in, _::in, pair(T, U)::out) is det.
+:- pragma type_spec(p/4, T = list(V)).
+
+:- implementation.
+
+p(T, U, _, T - U).
Index: tests/recompilation/unchanged_pred_nr.m.1
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/unchanged_pred_nr.m.1,v
retrieving revision 1.1
diff -u -u -r1.1 unchanged_pred_nr.m.1
--- tests/recompilation/unchanged_pred_nr.m.1 4 Nov 2001 17:23:18 -0000 1.1
+++ tests/recompilation/unchanged_pred_nr.m.1 5 Jan 2002 10:43:50 -0000
@@ -9,8 +9,9 @@
:- implementation.
:- import_module unchanged_pred_nr_2.
+:- import_module list.
main -->
- { unchanged_pred("OK\n", Str) },
+ { unchanged_pred([1], [1], "OK\n", Str) },
io__write_string(Str).
Index: tests/recompilation/unchanged_pred_nr_2.m.1
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/unchanged_pred_nr_2.m.1,v
retrieving revision 1.1
diff -u -u -r1.1 unchanged_pred_nr_2.m.1
--- tests/recompilation/unchanged_pred_nr_2.m.1 4 Nov 2001 17:23:19 -0000 1.1
+++ tests/recompilation/unchanged_pred_nr_2.m.1 5 Jan 2002 10:59:17 -0000
@@ -2,10 +2,13 @@
:- interface.
-:- pred unchanged_pred(string, string) is det.
-:- mode unchanged_pred(in, out) is det.
+:- import_module list.
+
+:- pred unchanged_pred(T, list(_), string, string) is det.
+:- mode unchanged_pred(in, in, in, out) is det.
+:- pragma type_spec(unchanged_pred/4, T = list(_)).
:- implementation.
-unchanged_pred(X, X).
+unchanged_pred(_, _, X, X).
Index: tests/recompilation/unchanged_pred_nr_2.m.2
===================================================================
RCS file: /home/mercury1/repository/tests/recompilation/unchanged_pred_nr_2.m.2,v
retrieving revision 1.1
diff -u -u -r1.1 unchanged_pred_nr_2.m.2
--- tests/recompilation/unchanged_pred_nr_2.m.2 4 Nov 2001 17:23:19 -0000 1.1
+++ tests/recompilation/unchanged_pred_nr_2.m.2 5 Jan 2002 10:59:25 -0000
@@ -2,10 +2,13 @@
:- interface.
-:- pred unchanged_pred(string, string) is det.
-:- mode unchanged_pred(in, out) is det.
+:- import_module list.
+
+:- pred unchanged_pred(T, list(_), string, string) is det.
+:- mode unchanged_pred(in, in, in, out) is det.
+:- pragma type_spec(unchanged_pred/4, T = list(_)).
:- implementation.
-unchanged_pred(X, X).
+unchanged_pred(_, _, X, X).
--------------------------------------------------------------------------
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