[m-rev.] for review: mix non mode-specific mercury and foreign procs

[Peter Ross]

Hi,

For trd to review.


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


Estimated hours taken: 8
Branches: main

Allow one to mix non mode-specific Mercury clauses and foreign procs.

compiler/make_hlds.m:
    Handle clauses defined in both Mercury and foreign code by turning
    all non mode-specific Mercury clauses into mode-specific Mercury
    clauses.

tests/hard_coded/Mmakefile:
tests/hard_coded/foreign_and_mercury.exp:
tests/hard_coded/foreign_and_mercury.m:
    Add a test case for mixing foreign and non mode-specific Mercury
    clauses.
    


Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.149
diff -u -r1.149 Mmakefile
--- tests/hard_coded/Mmakefile	29 Apr 2002 05:50:44 -0000	1.149
+++ tests/hard_coded/Mmakefile	1 May 2002 15:31:27 -0000
@@ -55,6 +55,7 @@
 	float_map \
 	float_reg \
 	float_rounding_bug \
+	foreign_and_mercury \
 	foreign_import_module \
 	frameopt_pragma_redirect \
 	free_free_mode \
Index: tests/hard_coded/foreign_and_mercury.exp
===================================================================
RCS file: tests/hard_coded/foreign_and_mercury.exp
diff -N tests/hard_coded/foreign_and_mercury.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_and_mercury.exp	1 May 2002 15:31:27 -0000
@@ -0,0 +1,2 @@
+2
+2
Index: tests/hard_coded/foreign_and_mercury.m
===================================================================
RCS file: tests/hard_coded/foreign_and_mercury.m
diff -N tests/hard_coded/foreign_and_mercury.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/foreign_and_mercury.m	1 May 2002 15:31:27 -0000
@@ -0,0 +1,31 @@
+% Test that we can use non-mode specific mercury implementations in
+% conjunction with foreign code procs.
+:- module foreign_and_mercury.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+main -->
+	{ f(2, Y) },
+	io__write_int(Y),
+	io__nl,
+	{ g(2, Z) },
+	io__write_int(Z),
+	io__nl.
+
+:- pred f(int::in, int::out) is det.
+f(X, X).
+:- pragma foreign_proc(c, f(X::in, Y::out), [promise_pure], "
+	Y = X;
+").
+
+:- pred g(int::in, int::out) is det.
+:- pragma foreign_proc(c, g(X::in, Y::out), [promise_pure], "
+	Y = X;
+").
+g(X, X).
Index: il_compiler/compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.408
diff -u -r1.408 make_hlds.m
--- il_compiler/compiler/make_hlds.m	7 Apr 2002 10:22:34 -0000	1.408
+++ il_compiler/compiler/make_hlds.m	1 May 2002 15:31:35 -0000
@@ -3659,22 +3659,6 @@
 		PredInfo1 = PredInfo0
 	},
 	(
-		{ pred_info_pragma_goal_type(PredInfo1) },
-		{ get_mode_annotations(Args, _, empty, ModeAnnotations) },
-		{ ModeAnnotations = empty ; ModeAnnotations = none }
-	->
-			% If we have a pragma foreign_proc for this procedure
-			% already, and we are trying to add a non-mode specific
-			% Mercury clause 
-		{ module_info_incr_errors(ModuleInfo1, ModuleInfo) },
-		prog_out__write_context(Context),
-		io__write_string("Error: non mode-specific clause for "),
-		hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
-		io__write_string("\n"),
-		prog_out__write_context(Context),
-		io__write_string("  with `:- pragma foreign_proc' declaration preceding.\n"),
-		{ Info = Info0 }
-	;
 		%
 		% User-supplied clauses for field access functions are
 		% not allowed -- the clauses are always generated by the
@@ -3841,12 +3825,28 @@
 		)
 	;
 		{ ModeAnnotations = empty },
-		{ ProcIds = [] }, % this means the clauses applies to all modes
+		{ pred_info_pragma_goal_type(PredInfo) ->
+			% We are only allowed to mix foreign procs and
+			% mode specific clauses, so make this clause
+			% mode specific but apply to all modes.
+			pred_info_all_procids(PredInfo, ProcIds)
+		;
+			% this means the clauses applies to all modes
+			ProcIds = []
+		},
 		{ ModuleInfo = ModuleInfo0 },
 		{ Info = Info0 }
 	;
 		{ ModeAnnotations = none },
-		{ ProcIds = [] }, % this means the clauses applies to all modes
+		{ pred_info_pragma_goal_type(PredInfo) ->
+			% We are only allowed to mix foreign procs and
+			% mode specific clauses, so make this clause
+			% mode specific but apply to all modes.
+			pred_info_all_procids(PredInfo, ProcIds)
+		;
+			% this means the clauses applies to all modes
+			ProcIds = []
+		},
 		{ ModuleInfo = ModuleInfo0 },
 		{ Info = Info0 }
 	;
@@ -4238,9 +4238,31 @@
 	% tagged as opt_imported only if/when we see a clause (including
 	% a `pragma c_code' clause) for them
 	{ Status = opt_imported ->
-		pred_info_set_import_status(PredInfo0, opt_imported, PredInfo1)
+		pred_info_set_import_status(PredInfo0, opt_imported, PredInfo1a)
 	;
-		PredInfo1 = PredInfo0
+		PredInfo1a = PredInfo0
+	},
+	{
+		% If this procedure was previously defined as clauses only
+		% then we need to turn all the non mode-specific clauses
+		% into mode-specific clauses.
+		pred_info_clause_goal_type(PredInfo1a)
+	->
+		pred_info_clauses_info(PredInfo1a, CInfo0),
+		clauses_info_clauses(CInfo0, ClauseList0),
+		ClauseList = list__map(
+			(func(C) =
+				( C = clause([], Goal, mercury, Ctxt) ->
+					clause(AllProcIds, Goal, mercury, Ctxt)
+				;
+					C
+				) :-
+				pred_info_all_procids(PredInfo1a, AllProcIds)
+			), ClauseList0),
+		clauses_info_set_clauses(CInfo0, ClauseList, CInfo),
+		pred_info_set_clauses_info(PredInfo1a, CInfo, PredInfo1)
+	;
+		PredInfo1 = PredInfo1a
 	},
 	( 
 		{ pred_info_is_imported(PredInfo1) }
@@ -4254,23 +4276,6 @@
 		io__write_string(".\n"),
 		{ Info = Info0 }
 	;	
-		{ pred_info_clause_goal_type(PredInfo1) },
-		{ pred_info_clauses_info(PredInfo1, CInfo) },
-		{ clauses_info_clauses(CInfo, ClauseList) },
-		{ list__member(clause([], _, mercury, _), ClauseList) }
-
-	->
-		{ module_info_incr_errors(ModuleInfo1, ModuleInfo) },
-		prog_out__write_context(Context),
-		io__write_string("Error: `:- pragma foreign_proc' (or `pragma c_code')\n"),
-		prog_out__write_context(Context),
-		io__write_string("declaration for "),
-		hlds_out__write_simple_call_id(PredOrFunc, PredName/Arity),
-		io__write_string("\n"),
-		prog_out__write_context(Context),
-		io__write_string("  with preceding non-mode specific clauses.\n"),
-		{ Info = Info0 }
-	;
 			% Don't add clauses for foreign languages other
 			% than the ones we can generate code for.
 		{ not list__member(PragmaForeignLanguage, BackendForeignLangs) }

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------