[m-dev.] for review: write abstract instances to .int files

[Simon Taylor]

Estimated hours taken: 0.25

compiler/modules.m:
	Strip the bodies from instance declarations written to `.int0' and
	`.int' files - the method names have not been qualified
	at this stage, so the code to perform optimization of method
	lookups could choose the wrong method in a module importing an
	instance declaration. This did not actually happen because the
	optimization was not being performed due to other bugs.

tests/hard_coded/typeclasses/Mmakefile:
tests/hard_coded/typeclasses/unqualified_method.m:
tests/hard_coded/typeclasses/unqualified_method2.m:
tests/hard_coded/typeclasses/unqualified_method3.m:
	Test case.


Index: compiler/modules.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modules.m,v
retrieving revision 1.112
diff -u -u -r1.112 modules.m
--- modules.m	1999/11/23 02:37:54	1.112
+++ modules.m	1999/12/01 05:15:18
@@ -698,7 +698,17 @@
 				% Write out the `.int0' file.
 				%
 			{ strip_imported_items(Items2, [], Items3) },
-			{ strip_clauses_from_interface(Items3, Items) },
+			{ strip_clauses_from_interface(Items3, Items4) },
+			{ list__map(
+			    (pred(Item0::in, Item::out) is det :-
+				Item0 = Item1 - Context,
+				( make_abstract_instance(Item1, Item2) ->
+					Item = Item2 - Context
+				;
+					Item = Item0
+				)
+			    ), Items4, Items) },
+				
 			write_interface_file(ModuleName, ".int0", Items),
 			touch_interface_datestamp(ModuleName, ".date0")
 		)
@@ -3993,7 +4003,12 @@
 		InInterface1 = no
 	;
 		( InInterface0 = yes ->
-			Items1 = [Item - Context | Items0]
+			( make_abstract_instance(Item, Item1) ->
+				ItemToWrite = Item1
+			;
+				ItemToWrite = Item
+			),
+			Items1 = [ItemToWrite - Context | Items0]
 		;
 			Items1 = Items0
 		),
@@ -4077,10 +4092,22 @@
 make_abstract_type_defn(type_defn(VarSet, abstract_type(Name, Args), Cond),
 			type_defn(VarSet, abstract_type(Name, Args), Cond)).
 
-	% Given a module (well, a list of items), extract the interface
-	% part of that module, i.e. all the items between `:- interface'
-	% and `:- implementation'. If IncludeImported is yes, also
-	% include all items after a `:- imported'. This is useful for
-	% making the .int file.
+:- pred make_abstract_instance(item, item).
+:- mode make_abstract_instance(in, out) is semidet.
+
+make_abstract_instance(Item, Item1) :-
+	Item = instance(Constraints, Class, ClassTypes, Body0, TVarSet),
+	Body0 = concrete(_),
+
+	%
+	% All instance declarations must be written
+	% to `.int' files as abstract instance
+	% declarations because the method names
+	% have not yet been module qualified.
+	% This could cause the wrong predicate to be
+	% used if calls to the method are specialized.
+	%
+	Body = abstract,
+	Item1 = instance(Constraints, Class, ClassTypes, Body, TVarSet).
 
 %-----------------------------------------------------------------------------%
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.23
diff -u -u -r1.23 Mmakefile
--- Mmakefile	1999/10/30 09:22:59	1.23
+++ Mmakefile	1999/12/01 23:58:12
@@ -34,6 +34,7 @@
 	typeclass_exist_method \
 	typeclass_test_5 \
 	typeclass_test_6 \
+	unqualified_method \
 	use_abstract_instance
 
 # The following tests are not enabled:
@@ -64,6 +65,9 @@
 MCFLAGS-existential_type_classes = --infer-all
 MCFLAGS-lambda_multi_constraint_same_tvar = --infer-all
 MCFLAGS-abstract_instance = --infer-all
+MCFLAGS-unqualified_method = --intermodule-optimization
+MCFLAGS-unqualified_method2 = --intermodule-optimization
+MCFLAGS-unqualified_method3 = --intermodule-optimization
 
 #-----------------------------------------------------------------------------#
 
Index: tests/hard_coded/typeclasses/unqualified_method.exp
===================================================================
RCS file: unqualified_method.exp
diff -N unqualified_method.exp
--- /dev/null	Thu Dec  2 11:46:34 1999
+++ unqualified_method.exp	Wed Dec  1 13:00:02 1999
@@ -0,0 +1 @@
+This is the right method.
Index: tests/hard_coded/typeclasses/unqualified_method.m
===================================================================
RCS file: unqualified_method.m
diff -N unqualified_method.m
--- /dev/null	Thu Dec  2 11:46:34 1999
+++ unqualified_method.m	Thu Dec  2 11:30:39 1999
@@ -0,0 +1,21 @@
+:- module unqualified_method.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module unqualified_method2.
+
+main -->
+	print_modified(1).
+
+
+:- pred print_modified_int(int::in, io__state::di, io__state::uo) is det.
+
+print_modified_int(_) -->
+	io__write_string("This is the wrong method.\n").
+
Index: tests/hard_coded/typeclasses/unqualified_method2.m
===================================================================
RCS file: unqualified_method2.m
diff -N unqualified_method2.m
--- /dev/null	Thu Dec  2 11:46:34 1999
+++ unqualified_method2.m	Thu Dec  2 11:30:39 1999
@@ -0,0 +1,16 @@
+:- module unqualified_method2.
+
+:- interface.
+
+:- import_module io.
+:- import_module unqualified_method3.
+
+:- typeclass class(T) where [
+		pred print_modified(T, io__state, io__state),
+		mode print_modified(in, di, uo) is det
+	].
+
+:- instance class(int) where [
+		pred(print_modified/3) is print_modified_int
+	].	
+
Index: tests/hard_coded/typeclasses/unqualified_method3.m
===================================================================
RCS file: unqualified_method3.m
diff -N unqualified_method3.m
--- /dev/null	Thu Dec  2 11:46:34 1999
+++ unqualified_method3.m	Thu Dec  2 11:30:39 1999
@@ -0,0 +1,12 @@
+:- module unqualified_method3.
+
+:- interface.
+
+:- import_module io.
+
+:- pred print_modified_int(int::in, io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+print_modified_int(_) -->
+	io__write_string("This is the right method.\n").
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------