[m-rev.] for review: fix testing of `ground' matches `bound'
David Overton
dmo at cs.mu.OZ.AU
Thu Jul 17 15:46:04 AEST 2003
On Mon, Jul 14, 2003 at 04:56:08PM +1000, Fergus Henderson wrote:
> On 14-Jul-2003, David Overton <dmo at cs.mu.OZ.AU> wrote:
> > On Tue, Jul 08, 2003 at 04:46:30PM +1000, Fergus Henderson wrote:
> > > On 08-Jul-2003, David Overton <dmo at cs.mu.OZ.AU> wrote:
> > > > compiler/modules.m:
> > > > When writing discriminated union types to the .int2 file, write
> > > > out the full type definition rather than an abstract type
> > > > declaration.
> > >
> > > Won't that cause problems for types with user-defined equality or
> > > comparison procedures? The .int2 file would then contain a reference
> > > to a procedure which had not been declared.
> >
> > What is the best way to handle this?
>
> Good question. I'm not sure.
>
> But whichever way is used, there should be some test cases to test this.
>
> Also, the documentation at the top of modules.m should be updated to
> explain whichever approach is taken. For example the current statement
> in modules.m that "the .int2 file is just a fully qualified version of
> the .int3 file." would no longer be true after you change.
I've fixed this comment.
>
> > Should I just ensure that the
> > user-defined equality/comparison annotation does not appear on the type?
>
> Hmm. I don't think that would be a good idea, because then the type
> would appear to be a canonical type, but in fact it would actually be
> a non-canonical type. This has consequences for determinism analysis
> (and potentially other consequences if/when we try to evaluate RTTI calls
> at compile time). In particular, determinism analysis of procedures
> in .opt files that happen to deconstruct such types might infer the wrong
> determinism if the type is thought to be canonical when it isn't.
>
> Perhaps we could use some special syntax in `.int2' files which
> indicates that a type has user-defined equality or comparison,
> without specifying the equality or comparison predicate?
I've implemented this approach. Here is a relative diff.
--- CVSLOG.old Thu Jul 17 15:18:00 2003
+++ CVSLOG Thu Jul 17 15:42:40 2003
@@ -1,5 +1,5 @@
-Estimated hours taken: 1.0
+Estimated hours taken: 10
Branches: main
Fixes to allow testing of `ground' matches `bound'.
@@ -11,7 +11,35 @@
transitively imports the .int2 file may need to know the
constructors to allow `ground' to be compared with `bound'
insts. See the new test case `transitive_inst_type' for an
- example.
+ example. If the type has user-defined equality and/or comparison
+ predicates then we write "... where type_is_abstract_noncanonical"
+ to the .int2 file instead of giving the predicate names.
+
+compiler/make_hlds.m:
+ If a discriminated union type is imported from a .int2 file, mark it
+ as `abstract_imported'.
+
+compiler/typecheck.m:
+ When type checking var-functor unifications, do not allow functors
+ whose types are `abstract_imported', unless we are type checking an
+ `opt_imported' predicate.
+
+compiler/prog_data.m:
+ Add a new alternative `abstract_noncanonical_type' to the type
+ `unify_compare' to represent "where type_is_abstract_noncanonical"
+ annotations read from .int2 files.
+
+compiler/prog_io.m:
+ Parse "where type_is_abstract_noncanonical" annotations on
+ discriminated union types.
+
+compiler/special_pred.m:
+compiler/unify_proc.m:
+ Avoid creating unification and comparison predicates
+ for types with `type_is_abstract_noncanonical' annotations.
+
+compiler/intermod.m:
+ Handle the change to the `unify_compare' type.
compiler/type_util.m:
Do not remove module qualifiers from constructors before looking
@@ -19,12 +47,13 @@
qualified version in the table.
tests/hard_coded/Mmakefile:
+tests/hard_coded/Mercury.options:
tests/hard_coded/transitive_inst_type.exp:
tests/hard_coded/transitive_inst_type.m:
tests/hard_coded/transitive_inst_type2.m:
tests/hard_coded/transitive_inst_type3.m:
- Add a test case.
+tests/hard_coded/trans_intermod_user_equality.m:
+tests/hard_coded/trans_intermod_user_equality2.m:
+tests/hard_coded/trans_intermod_user_equality3.m:
+ Add some test cases.
-tests/invalid/undef_symbol.err_exp:
- Adjust output to remove an error message that no longer occurs
- now that the .int2 file contains the full type definition.
diff -u compiler/make_hlds.m compiler/make_hlds.m
--- compiler/make_hlds.m 14 Jul 2003 03:08:24 -0000
+++ compiler/make_hlds.m 16 Jul 2003 23:39:23 -0000
@@ -3702,7 +3702,8 @@
->
Module = Module0
;
- can_generate_special_pred_clauses_for_type(TypeCtor, Body)
+ can_generate_special_pred_clauses_for_type(Module0, TypeCtor,
+ Body)
->
add_special_pred(unify, Module0, TVarSet, Type, TypeCtor,
Body, Context, Status, Module1),
diff -u compiler/modules.m compiler/modules.m
--- compiler/modules.m 7 Jul 2003 23:55:19 -0000
+++ compiler/modules.m 15 Jul 2003 23:13:47 -0000
@@ -22,8 +22,10 @@
% gives the last time the .int3 file was checked for consistency.
%
% 2. The .int and .int2 files are created, using the .int3 files
-% of imported modules to fully module qualify all items. Therefore
-% the .int2 file is just a fully qualified version of the .int3 file.
+% of imported modules to fully module qualify all items.
+% The .int2 file is mostly just a fully qualified version of the .int3 file,
+% however it also includes some extra information, such as functors for
+% discriminated union types, which may be needed for mode analysis.
% The .int3 file must be kept for datestamping purposes. The datestamp
% on the .date file gives the last time the .int and .int2 files
% were checked.
@@ -6370,6 +6372,10 @@
Imports1 = Imports0,
Items1 = [Item1 - Context | Items0],
NeedsImports1 = NeedsImports0
+ ; make_abstract_unify_compare(Item0, Kind, Item1) ->
+ Imports1 = Imports0,
+ Items1 = [Item1 - Context | Items0],
+ NeedsImports1 = NeedsImports0
; include_in_short_interface(Item0) ->
Imports1 = Imports0,
Items1 = [ItemAndContext | Items0],
@@ -6422,6 +6428,15 @@
make_abstract_instance(Item0, Item).
make_abstract_defn(typeclass(A, B, C, _, E), _,
typeclass(A, B, C, abstract, E)).
+
+:- pred make_abstract_unify_compare(item, short_interface_kind, item).
+:- mode make_abstract_unify_compare(in, in, out) is semidet.
+
+make_abstract_unify_compare(type_defn(VarSet, Name, Args, TypeDefn0, Cond),
+ int2,
+ type_defn(VarSet, Name, Args, TypeDefn, Cond)) :-
+ TypeDefn0 = du_type(Constructors, yes(_UnifyCompare)),
+ TypeDefn = du_type(Constructors, yes(abstract_noncanonical_type)).
% All instance declarations must be written
diff -u tests/hard_coded/Mmakefile tests/hard_coded/Mmakefile
--- tests/hard_coded/Mmakefile 14 Jul 2003 05:57:50 -0000
+++ tests/hard_coded/Mmakefile 17 Jul 2003 05:12:47 -0000
@@ -151,6 +151,7 @@
test_imported_no_tag \
tim_qual1 \
time_test \
+ trans_intermod_user_equality \
transitive_inst_type \
tuple_test \
tuple_test \
only in patch2:
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/trans_intermod_user_equality3.m 17 Jul 2003 05:16:18 -0000
@@ -0,0 +1,14 @@
+:- module trans_intermod_user_equality3.
+
+:- interface.
+
+:- type foo
+ ---> ctor1(int, int)
+ ; ctor2(int, int)
+ where equality is foo_unify.
+
+:- pred foo_unify(foo::in, foo::in) is semidet.
+
+:- implementation.
+
+foo_unify(X, X).
only in patch2:
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/trans_intermod_user_equality2.m 17 Jul 2003 04:13:38 -0000
@@ -0,0 +1,17 @@
+:- module trans_intermod_user_equality2.
+:- interface.
+
+:- import_module trans_intermod_user_equality3.
+
+:- type bar == foo.
+
+:- pred make_bar(int::in, int::in, bar::out) is det.
+
+:- pred use_bar(bar::in, int::out) is cc_multi.
+
+:- implementation.
+
+make_bar(M, N, ctor1(M, N)).
+
+use_bar(ctor1(_, N), N).
+use_bar(ctor2(_, N), N).
only in patch2:
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/trans_intermod_user_equality.m 17 Jul 2003 04:56:06 -0000
@@ -0,0 +1,15 @@
+:- module trans_intermod_user_equality.
+:- interface.
+
+:- import_module io.
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module trans_intermod_user_equality2.
+
+main -->
+ { make_bar(0, 1, Bar) },
+ { use_bar(Bar, N) },
+ io__write_int(N),
+ io__nl.
only in patch2:
--- tests/hard_coded/Mercury.options 12 Jun 2003 04:06:01 -0000 1.6
+++ tests/hard_coded/Mercury.options 17 Jul 2003 05:01:19 -0000
@@ -28,6 +28,12 @@
MCFLAGS-redoip_clobber = --no-inlining
MCFLAGS-rnd = -O6
MCFLAGS-split_c_files = --trace deep
+MCFLAGS-trans_intermod_user_equality = --intermodule-optimization \
+ --transitive-intermodule-optimization
+MCFLAGS-trans_intermod_user_equality2 = --intermodule-optimization \
+ --transitive-intermodule-optimization
+MCFLAGS-trans_intermod_user_equality3 = --intermodule-optimization \
+ --transitive-intermodule-optimization
MCFLAGS-type_qual = --infer-all
MCFLAGS-type_spec = --user-guided-type-specialization
MCFLAGS-existential_types_test = --infer-all
only in patch2:
--- compiler/unify_proc.m 3 Jul 2003 12:11:18 -0000 1.123
+++ compiler/unify_proc.m 16 Jul 2003 23:39:23 -0000
@@ -583,7 +583,10 @@
),
% Call make_hlds.m to construct the unification predicate.
- ( can_generate_special_pred_clauses_for_type(TypeCtor, TypeBody) ->
+ (
+ can_generate_special_pred_clauses_for_type(ModuleInfo0,
+ TypeCtor, TypeBody)
+ ->
% If the unification predicate has another status it should
% already have been generated.
UnifyPredStatus = pseudo_imported,
@@ -774,6 +777,9 @@
prog_var::in, prog_var::in, prog_context::in, list(clause)::out,
unify_proc_info::in, unify_proc_info::out) is det.
+unify_proc__generate_user_defined_unify_clauses(abstract_noncanonical_type,
+ _, _, _, _) -->
+ { error("trying to create unify proc for abstract noncanonical type") }.
unify_proc__generate_user_defined_unify_clauses(UserEqCompare, H1, H2,
Context, Clauses) -->
{ UserEqCompare = unify_compare(MaybeUnify, MaybeCompare) },
@@ -965,6 +971,10 @@
prog_context::in, list(clause)::out,
unify_proc_info::in, unify_proc_info::out) is det.
+generate_user_defined_compare_clauses(abstract_noncanonical_type,
+ _, _, _, _, _) -->
+ { error(
+ "trying to create compare proc for abstract noncanonical type") }.
generate_user_defined_compare_clauses(unify_compare(_, MaybeCompare),
Res, H1, H2, Context, Clauses) -->
{ ArgVars = [Res, H1, H2] },
only in patch2:
--- compiler/special_pred.m 3 Jul 2003 12:11:16 -0000 1.38
+++ compiler/special_pred.m 17 Jul 2003 02:55:37 -0000
@@ -104,8 +104,9 @@
% its special predicates. This will fail for abstract
% types and types for which the RTTI information is
% defined by hand.
-:- pred can_generate_special_pred_clauses_for_type(type_ctor, hlds_type_body).
-:- mode can_generate_special_pred_clauses_for_type(in, in) is semidet.
+:- pred can_generate_special_pred_clauses_for_type(module_info, type_ctor,
+ hlds_type_body).
+:- mode can_generate_special_pred_clauses_for_type(in, in, in) is semidet.
:- implementation.
@@ -210,7 +211,8 @@
special_pred_for_type_needs_typecheck(ModuleInfo, Body) :-
(
- type_body_has_user_defined_equality_pred(ModuleInfo, Body, _)
+ type_body_has_user_defined_equality_pred(ModuleInfo, Body,
+ unify_compare(_, _))
;
Body = du_type(Ctors, _, _, _, _, _),
list__member(Ctor, Ctors),
@@ -218,8 +220,10 @@
ExistQTVars \= []
).
-can_generate_special_pred_clauses_for_type(TypeCtor, Body) :-
+can_generate_special_pred_clauses_for_type(ModuleInfo, TypeCtor, Body) :-
Body \= abstract_type,
- \+ type_ctor_has_hand_defined_rtti(TypeCtor, Body).
+ \+ type_ctor_has_hand_defined_rtti(TypeCtor, Body),
+ \+ type_body_has_user_defined_equality_pred(ModuleInfo, Body,
+ abstract_noncanonical_type).
%-----------------------------------------------------------------------------%
only in patch2:
--- compiler/prog_io.m 19 May 2003 14:24:26 -0000 1.220
+++ compiler/prog_io.m 15 Jul 2003 03:45:25 -0000
@@ -1653,6 +1653,12 @@
->
Body = Body1,
(
+ EqCompTerm = term__functor(
+ term__atom("type_is_abstract_noncanonical"),
+ [], _Context2)
+ ->
+ MaybeEqComp = ok(yes(abstract_noncanonical_type))
+ ;
parse_equality_or_comparison_pred_term("equality",
EqCompTerm, PredName)
->
only in patch2:
--- compiler/prog_data.m 17 Jun 2003 07:53:28 -0000 1.94
+++ compiler/prog_data.m 15 Jul 2003 23:21:05 -0000
@@ -920,11 +920,20 @@
:- type ctor_field_name == sym_name.
+ % unify_compare gives the user-defined unification and/or comparison
+ % predicates for a noncanonical type, if they are known.
+ % The value `abstract_noncanonical_type' represents a discriminated
+ % union type whose definition uses the syntax
+ % `where type_is_abstract_noncanonical' and has been read from a .int2
+ % file. This means we know that the type has a noncanonical
+ % representation, but we don't know what the unification/comparison
+ % predicates are.
:- type unify_compare
---> unify_compare(
unify :: maybe(equality_pred),
compare :: maybe(comparison_pred)
- ).
+ )
+ ; abstract_noncanonical_type.
% An equality_pred specifies the name of a user-defined predicate
% used for equality on a type. See the chapter on them in the
only in patch2:
--- compiler/mercury_to_mercury.m 24 Jun 2003 14:20:49 -0000 1.231
+++ compiler/mercury_to_mercury.m 15 Jul 2003 00:56:47 -0000
@@ -1785,6 +1785,8 @@
;
[]
).
+mercury_output_equality_compare_preds(yes(abstract_noncanonical_type)) -->
+ io__write_string("where type_is_abstract_noncanonical").
:- pred mercury_output_ctors(list(constructor), tvarset,
io__state, io__state).
only in patch2:
--- compiler/intermod.m 27 May 2003 05:57:11 -0000 1.142
+++ compiler/intermod.m 15 Jul 2003 04:29:31 -0000
@@ -1103,6 +1103,9 @@
intermod_info::in, intermod_info::out) is det.
intermod__resolve_unify_compare_overloading(_, _, no, no, Info, Info).
+intermod__resolve_unify_compare_overloading(_, _,
+ yes(abstract_noncanonical_type), yes(abstract_noncanonical_type),
+ Info, Info).
intermod__resolve_unify_compare_overloading(ModuleInfo, TypeCtor,
yes(unify_compare(MaybeUserEq0, MaybeUserCompare0)),
yes(unify_compare(MaybeUserEq, MaybeUserCompare)),
--
David Overton Uni of Melbourne +61 3 8344 1354
dmo at cs.mu.oz.au Monash Uni (Clayton) +61 3 9905 5779
http://www.cs.mu.oz.au/~dmo Mobile Phone +61 4 0337 4393
--------------------------------------------------------------------------
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