[m-rev.] for review: external pseudo-imported special preds bug fix

[Peter Ross]

Hi,

For Fergus to review.

This is one solution to the bug, I found below.  I am having trouble
describing the bug so a better review comment is needed.

I also am not convinced that this is the correct approach.



===================================================================


Estimated hours taken: 6
Branches: main

Fix a bug where the compiler was treating pseudo_imported external
definitions incorrectly.

compiler/hlds_pred.m:
	Change the defintion of external in import_status so that it
	records the original import status, not just whether it is
	exported or not.

compiler/ml_code_gen.m:
	Don't generate any mlds representation for special predicates
	whose definition is external and pseudo_imported.

compiler/assertion.m:
compiler/hlds_out.m:
compiler/hlds_pred.m:
compiler/intermod.m:
	Adapt to the changes of the definition of status.

tests/hard_coded/Mmakefile:
tests/hard_coded/external_unification_pred.exp:
tests/hard_coded/external_unification_pred.m:
	Test case.

Index: il_compiler/compiler/assertion.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.26
diff -u -r1.26 assertion.m
--- il_compiler/compiler/assertion.m	1 Dec 2003 15:55:29 -0000	1.26
+++ il_compiler/compiler/assertion.m	3 Dec 2003 11:49:08 -0000
@@ -875,18 +875,19 @@
 is_defined_in_implementation_section(exported_to_submodules, yes).
 is_defined_in_implementation_section(local, yes).
 is_defined_in_implementation_section(imported(implementation), yes).
-is_defined_in_implementation_section(external(implementation), yes).
 
 is_defined_in_implementation_section(imported(interface), no).
 is_defined_in_implementation_section(imported(ancestor), no).
 is_defined_in_implementation_section(imported(ancestor_private_interface), no).
-is_defined_in_implementation_section(external(interface), no).
 is_defined_in_implementation_section(opt_imported, no).
 is_defined_in_implementation_section(abstract_imported, no).
 is_defined_in_implementation_section(pseudo_imported, no).
 is_defined_in_implementation_section(exported, no).
 is_defined_in_implementation_section(opt_exported, yes).
 is_defined_in_implementation_section(pseudo_exported, no).
+
+is_defined_in_implementation_section(external(Status), IsDefined) :-
+	is_defined_in_implementation_section(Status, IsDefined).
 
 %-----------------------------------------------------------------------------%
 
Index: il_compiler/compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.320
diff -u -r1.320 hlds_out.m
--- il_compiler/compiler/hlds_out.m	1 Dec 2003 15:55:36 -0000	1.320
+++ il_compiler/compiler/hlds_out.m	3 Dec 2003 11:49:09 -0000
@@ -2736,10 +2736,10 @@
 	io__write_string("imported from an ancestor's private interface").
 hlds_out__write_import_status(imported(ancestor)) -->
 	io__write_string("imported by an ancestor").
-hlds_out__write_import_status(external(interface)) -->
-	io__write_string("external (and exported)").
-hlds_out__write_import_status(external(implementation)) -->
-	io__write_string("external (and local)").
+hlds_out__write_import_status(external(Status)) -->
+	io__write_string("external (and"),
+	hlds_out__write_import_status(Status),
+	io__write_string(")").
 hlds_out__write_import_status(abstract_imported) -->
 	io__write_string("abstract_imported").
 hlds_out__write_import_status(opt_imported) -->
Index: il_compiler/compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.136
diff -u -r1.136 hlds_pred.m
--- il_compiler/compiler/hlds_pred.m	1 Dec 2003 15:55:38 -0000	1.136
+++ il_compiler/compiler/hlds_pred.m	3 Dec 2003 11:49:09 -0000
@@ -275,7 +275,7 @@
 	% Only types can have status abstract_exported or abstract_imported.
 
 :- type import_status
-	--->	external(section)
+	--->	external(import_status)
 				% Declared `:- external'.
 				% This means that the implementation
 				% for this procedure will be provided
@@ -1197,18 +1197,13 @@
 		hlds_pred__in_in_unification_proc_id(ProcId)
 	;
 		pred_info_import_status(PredInfo, ImportStatus),
-		ImportStatus = external(interface)
+		ImportStatus = external(ImportStatus),
+		status_is_exported(ImportStatus, yes)
 	).
 
 pred_info_mark_as_external(PredInfo0, PredInfo) :-
-	status_is_exported(PredInfo0 ^ import_status, Exported),
-	(
-		Exported = yes,
-		PredInfo = PredInfo0 ^ import_status := external(interface)
-	;
-		Exported = no,
-		PredInfo = PredInfo0 ^ import_status := external(implementation)
-	).
+	PredInfo = PredInfo0 ^ import_status :=
+			external(PredInfo0 ^ import_status).
 
 pred_info_set_import_status(X, PredInfo, PredInfo ^ import_status := X).
 
Index: il_compiler/compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.153
diff -u -r1.153 intermod.m
--- il_compiler/compiler/intermod.m	2 Dec 2003 20:49:17 -0000	1.153
+++ il_compiler/compiler/intermod.m	3 Dec 2003 11:49:10 -0000
@@ -690,7 +690,10 @@
 		% calls a predicate which is exported, then we don't
 		% need to do anything special.
 		%
-		{ Status = exported ; Status = external(interface) }
+		{ Status = exported
+		; Status = external(ExternalStatus),
+			status_is_exported(ExternalStatus, yes)
+		}
 	->
 		{ DoWrite = yes }
 	;
@@ -2194,9 +2197,9 @@
 		->
 			NewStatus = pseudo_exported
 		;
-			Status = external(implementation)
+			Status = external(_)
 		->
-			NewStatus = external(interface)
+			NewStatus = external(opt_exported)
 		;
 			NewStatus = opt_exported
 		),
@@ -2216,8 +2219,6 @@
 
 :- func import_status_to_write(import_status) = bool.
 
-import_status_to_write(external(interface)) = no.
-import_status_to_write(external(implementation)) = yes.
 import_status_to_write(imported(_)) = no.
 import_status_to_write(abstract_imported) = no.
 import_status_to_write(pseudo_imported) = no.
@@ -2228,6 +2229,12 @@
 import_status_to_write(pseudo_exported) = no.
 import_status_to_write(exported_to_submodules) = yes.
 import_status_to_write(local) = yes.
+import_status_to_write(external(Status)) = ToWrite :-
+	( status_is_exported(Status, yes) ->
+		ToWrite = no
+	;
+		ToWrite = yes
+	).
 
 %-----------------------------------------------------------------------------%
 	% Read in and process the optimization interfaces.
Index: il_compiler/compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.132
diff -u -r1.132 ml_code_gen.m
--- il_compiler/compiler/ml_code_gen.m	24 Oct 2003 06:17:42 -0000	1.132
+++ il_compiler/compiler/ml_code_gen.m	3 Dec 2003 11:49:10 -0000
@@ -980,6 +980,8 @@
 		(
 			{ ImportStatus = imported(_)
 			; pred_info_is_aditi_relation(PredInfo)
+			; is_unify_or_compare_pred(PredInfo),
+				ImportStatus = external(pseudo_imported)
 			}
 		->
 			{ MLDS_Defns1 = MLDS_Defns0 }
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.209
diff -u -r1.209 Mmakefile
--- tests/hard_coded/Mmakefile	1 Dec 2003 22:31:36 -0000	1.209
+++ tests/hard_coded/Mmakefile	3 Dec 2003 11:49:25 -0000
@@ -56,6 +56,7 @@
 	expand \
 	export_test \
 	export_test2 \
+	external_unification_pred \
 	failure_unify \
 	field_syntax \
 	float_field \
Index: tests/hard_coded/external_unification_pred.exp
===================================================================
RCS file: tests/hard_coded/external_unification_pred.exp
diff -N tests/hard_coded/external_unification_pred.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/external_unification_pred.exp	3 Dec 2003 11:49:25 -0000
@@ -0,0 +1 @@
+false.
Index: tests/hard_coded/external_unification_pred.m
===================================================================
RCS file: tests/hard_coded/external_unification_pred.m
diff -N tests/hard_coded/external_unification_pred.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/external_unification_pred.m	3 Dec 2003 11:49:25 -0000
@@ -0,0 +1,58 @@
+% The mercury compiler from 2003-12-01 generated uncompilable il code for this
+% test case.
+:- module external_unification_pred.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+    :- module external_unification_pred.sub.
+
+    :- interface.
+
+    :- type ft.
+    :- func create_ft(int) = ft.
+
+    :- implementation.
+
+    :- pragma foreign_type(c, ft, "int") where equality is unify_ft.
+    :- pragma foreign_type(il, ft, "valuetype [mscorlib]System.Int32")
+		    where equality is unify_ft.
+
+    :- pred unify_ft(ft::in, ft::in) is semidet.
+
+    :- pragma foreign_proc("C", unify_ft(X::in, Y::in), [promise_pure],
+    "
+	    SUCCESS_INDICATOR = (X == Y);
+    ").
+    :- pragma foreign_proc("C#", unify_ft(X::in, Y::in), [promise_pure],
+    "
+	    SUCCESS_INDICATOR = (X == Y);
+    ").
+
+    :- pragma foreign_proc("C", create_ft(X::in) = (Y::out), [promise_pure],
+    "
+	    Y = X;
+    ").
+    :- pragma foreign_proc("C#", create_ft(X::in) = (Y::out), [promise_pure],
+    "
+	    Y = X;
+    ").
+    :- end_module external_unification_pred.sub.
+
+:- import_module external_unification_pred.sub.
+
+main(!IO) :-
+    X = create_ft(1),
+    Y = create_ft(2),
+    ( X = Y ->
+    	io__write_string("true.\n", !IO)
+    ;
+    	io__write_string("false.\n", !IO)
+    ).
+
+:- end_module external_unification_pred.


-- 
Peter Ross		
Software Engineer                                (Work)   +32 2 757 10 15
Mission Critical                                 (Mobile) +32 485 482 559
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------