[m-rev.] private_builtin.m improvements & purity warning bugfix

[Fergus Henderson]

Estimated hours taken: 3
Branches: main

Implement some library code in Mercury, instead of and/or in addition to
`pragma foreign_proc', to improve the ease of porting to a new target
language, such as Java.

library/private_builtin.m:
	Implement var/1 and nonvar/1 using Mercury (with different clauses
	for the different modes) rather than using `pragma foreign_proc'.

	Also provide default Mercury implementations for free_heap,
	mark_hp, restore_hp, and the various trailing primitives.
	The default implementations just call error/1.

library/Mmakefile:
	Temporarily add `MCFLAGS-private_builtin = --no-halt-at-warn'.
	This is needed because otherwise the bug described below
	prevents bootstrapping.
	Also delete `MCFLAGS-int = --no-halt-at-warn', since this is
	no longer needed.

compiler/purity.m:
	Fix a bug where it was reporting spurious warnings about
	"predicate declared `impure' but actually `pure'"
	for predicates defined with both Mercury code and
	`pragma foreign_proc' declarations.
	If the user declares `pragma foreign_proc' code to be
	impure, then the compiler should always respect that.

Workspace: /home/earth/fjh/ws-earth3/mercury
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.38
diff -u -d -r1.38 purity.m
--- compiler/purity.m	20 Nov 2001 13:53:21 -0000	1.38
+++ compiler/purity.m	13 Dec 2001 08:54:18 -0000
@@ -435,7 +435,6 @@
 		% the changes requires to make foreign_proc impure by default
 	( { pred_info_get_goal_type(PredInfo0, pragmas) } ->
 		{ WorstPurity = (impure) },
-		{ IsPragmaCCode = yes },
 			% This is where we assume pragma foreign_proc is
 			% pure.
 		{ Purity = (pure) },
@@ -468,11 +467,10 @@
 				ClausesInfo) },
 		{ pred_info_set_clauses_info(PredInfo1, ClausesInfo,
 				PredInfo) },
-		{ WorstPurity = Purity },
-		{ IsPragmaCCode = no }
+		{ WorstPurity = Purity }
 	),
 	{ perform_pred_purity_checks(PredInfo, Purity, DeclPurity,
-		PromisedPurity, IsPragmaCCode, PurityCheckResult) },
+		PromisedPurity, PurityCheckResult) },
 	( { PurityCheckResult = inconsistent_promise },
 		{ NumErrors is NumErrors0 + 1 },
 		error_inconsistent_promise(ModuleInfo, PredInfo, PredId,
@@ -867,9 +865,9 @@
 	% InPragmaCCode: Is this a pragma c code?
 	% Promised: Did we promise this pred as pure?
 :- pred perform_pred_purity_checks(pred_info::in, purity::in, purity::in,
-	purity::in, bool::in, purity_check_result::out) is det.
+	purity::in, purity_check_result::out) is det.
 perform_pred_purity_checks(PredInfo, ActualPurity, DeclaredPurity,
-		PromisedPurity, IsPragmaCCode, PurityCheckResult) :-
+		PromisedPurity, PurityCheckResult) :-
 	( 
 		% The declared purity must match any promises.
 		% (A promise of impure means no promise was made).
@@ -907,8 +905,11 @@
 			% assume they are pure, but you can declare them
 			% to be impure.
 		pred_info_get_markers(PredInfo, Markers),
+		pred_info_get_goal_type(PredInfo, GoalType),
 		( 
-			IsPragmaCCode = yes
+			GoalType = pragmas
+		;
+			GoalType = clauses_and_pragmas
 		;
 			check_marker(Markers, class_method) 
 		;
Index: library/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.79
diff -u -d -r1.79 Mmakefile
--- library/Mmakefile	14 Aug 2001 14:36:05 -0000	1.79
+++ library/Mmakefile	13 Dec 2001 08:56:48 -0000
@@ -24,10 +24,10 @@
 #-----------------------------------------------------------------------------#
 #
 # XXX The following is needed only for bootstrapping
-# the new modes of int__xor.
+# the fix to compiler/purity.m.
 #
 
-MCFLAGS-int = --no-halt-at-warn
+MCFLAGS-private_builtin = --no-halt-at-warn
 
 # Modules which use user-guided type specialization need to be
 # compiled with these flags to make sure all calls
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.83
diff -u -d -r1.83 private_builtin.m
--- library/private_builtin.m	26 Nov 2001 09:31:06 -0000	1.83
+++ library/private_builtin.m	13 Dec 2001 09:03:41 -0000
@@ -33,16 +33,6 @@
 
 :- interface.
 
-	% free_heap/1 is used internally by the compiler to implement
-	% compile-time garbage collection. Don't use it in programs.
-	% The `di' mode on the argument is overly conservative -- only
-	% the top-level cell is clobbered. This is handled correctly by
-	% mode_util__recompute_instmap_delta.
-:- pred free_heap(_T).
-:- mode free_heap(di) is det.
-
-%-----------------------------------------------------------------------------%
-
 	% This section of the module contains predicates that are used
 	% by the compiler, to implement polymorphism. These predicates
 	% should not be used by user programs directly.
@@ -131,19 +121,6 @@
 :- pragma inline(builtin_compare_string/3).
 :- pragma inline(builtin_compare_float/3).
 
-:- pragma foreign_decl("C", "
-	#include ""mercury_heap.h""	/* for MR_free_heap() */
-").
-
-:- pragma foreign_proc("C", free_heap(Val::di),
-	[will_not_call_mercury, thread_safe],
-	"MR_free_heap((void *) Val);").
-
-:- pragma foreign_proc("MC++", free_heap(_Val::di),
-	[will_not_call_mercury, thread_safe], "
-	mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
-
 builtin_unify_int(X, X).
 
 builtin_compare_int(R, X, Y) :-
@@ -856,6 +833,30 @@
 
 :- implementation.
 
+% Default (Mercury) implementations.
+% These should be overridden by the appropriate foreign language implementation.
+store_ticket(_Ticket::out) :-
+	sorry("private_builtin__store_ticket/1").
+reset_ticket_undo(_Ticket::in) :-
+	sorry("private_builtin__reset_ticket_undo/1").
+reset_ticket_commit(_Ticket::in) :-
+	sorry("private_builtin__reset_ticket_commit/1").
+reset_ticket_solve(_Ticket::in) :-
+	sorry("private_builtin__reset_ticket_solve/1").
+mark_ticket_stack(_TicketCounter::out) :-
+	sorry("private_builtin__mark_ticket_stack/1").
+prune_tickets_to(_TicketCounter::in) :-
+	sorry("private_builtin__prune_tickets_to/1").
+/****
+% XXX we can't give default Mercury implementations for these,
+% because you can't write a mode-specific clause for a zero-arity
+% procedure.
+discard_ticket :-
+	sorry("private_builtin__discard_ticket/0").
+prune_ticket :-
+	sorry("private_builtin__prune_ticket/0").
+****/
+
 :- pragma foreign_proc("C", store_ticket(Ticket::out),
 	[will_not_call_mercury, thread_safe],
 "
@@ -1013,19 +1014,38 @@
 %-----------------------------------------------------------------------------%
 
 	% This section of the module contains predicates that are used
-	% by the MLDS back-end, to implement heap reclamation on failure.
-	% (The LLDS back-end does not use these; instead it inserts
-	% the corresponding LLDS instructions directly during code
-	% generation.)
+	% internally by the compiler for manipulating the heap.
 	% These predicates should not be used by user programs directly.
 
 :- interface.
 
-:- type heap_pointer == c_pointer.
+	% free_heap/1 is used internally by the compiler to implement
+	% compile-time garbage collection.
+	% (Note that currently compile-time garbage collection
+	% is not yet fully implemented.)
+	% free_heap/1 explicitly deallocates a cell on the heap.
+	% It works by calling GC_free(), which will put the cell
+	% on the appropriate free list.
+	% It can only be used when doing conservative GC,
+	% since with `--gc none' or `--gc accurate',
+	% allocation does not use a free list.
+	% The `di' mode on the argument is overly conservative -- only
+	% the top-level cell is clobbered. This is handled correctly by
+	% mode_util__recompute_instmap_delta.
+	% XXX Why isn't this marked as `impure'?
+:- pred free_heap(_T).
+:- mode free_heap(di) is det.
 
+	% mark_hp/1 and restore_hp/1 are used by the MLDS back-end,
+	% to implement heap reclamation on failure.
+	% (The LLDS back-end does not use these; instead it inserts
+	% the corresponding LLDS instructions directly during code
+	% generation.)
 	% For documentation, see the corresponding LLDS instructions
 	% in compiler/llds.m.  See also compiler/notes/trailing.html.
 
+:- type heap_pointer == c_pointer.
+
 :- impure pred mark_hp(heap_pointer::out) is det.
 :- impure pred restore_hp(heap_pointer::in) is det.
 
@@ -1039,6 +1059,31 @@
 
 :- implementation.
 
+:- pragma foreign_decl("C", "
+	#include ""mercury_heap.h""	/* for MR_free_heap() */
+").
+
+% default (Mercury) implementation for free_heap/1
+% This should be overridden by the appropriate foreign language implementation.
+free_heap(_::di) :-
+	error("private_builtin__free_heap/1").
+
+:- pragma foreign_proc("C", free_heap(Val::di),
+	[will_not_call_mercury, thread_safe],
+	"MR_free_heap((void *) Val);").
+
+:- pragma foreign_proc("MC++", free_heap(_Val::di),
+	[will_not_call_mercury, thread_safe], "
+	mercury::runtime::Errors::SORRY(""foreign code for free_heap/1"");
+").
+
+% default (Mercury) implementations for mark_hp/1 and restore_hp/1.
+% This should be overridden by the appropriate foreign language implementation.
+mark_hp(_::out) :-
+	sorry("private_builtin__mark_hp/1").
+restore_hp(_::in) :-
+	sorry("private_builtin__restore_hp/1").
+
 :- pragma foreign_proc("C", mark_hp(SavedHeapPointer::out),
 	[will_not_call_mercury, thread_safe],
 "
@@ -1098,6 +1143,8 @@
 
 :- pred unused is det.
 
+	% N.B. interface continued below.
+
 :- implementation.
 
 % unsafe_type_cast is a builtin; the compiler generates inline code for it
@@ -1132,46 +1179,20 @@
 
 :- implementation.
 
-:- pragma foreign_proc("C", var(_X::ui),
-		[thread_safe, will_not_call_mercury], "
-	SUCCESS_INDICATOR = FALSE;
-").
-:- pragma foreign_proc("C", var(_X::in),
-		[thread_safe, will_not_call_mercury], "
-	SUCCESS_INDICATOR = FALSE;
-").
-:- pragma foreign_proc("C", var(_X::unused),
-		[thread_safe, will_not_call_mercury], "").
-
-:- pragma foreign_proc("C", nonvar(_X::ui),
-		[thread_safe, will_not_call_mercury], "").
-:- pragma foreign_proc("C", nonvar(_X::in),
-		[thread_safe, will_not_call_mercury], "").
-:- pragma foreign_proc("C", nonvar(_X::unused),
-		[thread_safe, will_not_call_mercury], "
-	SUCCESS_INDICATOR = FALSE;
-").
+var(_::ui) :- fail.
+var(_::in) :- fail.
+var(_::unused) :- true.
 
-:- pragma foreign_proc("MC++", var(_X::ui),
-		[thread_safe, will_not_call_mercury], "
-	SUCCESS_INDICATOR = FALSE;
-").
-:- pragma foreign_proc("MC++", var(_X::in),
-		[thread_safe, will_not_call_mercury], "
-	SUCCESS_INDICATOR = FALSE;
-").
-:- pragma foreign_proc("MC++", var(_X::unused),
-		[thread_safe, will_not_call_mercury], "").
+nonvar(_::ui) :- true.
+nonvar(_::in) :- true.
+nonvar(_::unused) :- fail.
 
-:- pragma foreign_proc("MC++", nonvar(_X::ui),
-		[thread_safe, will_not_call_mercury], "").
-:- pragma foreign_proc("MC++", nonvar(_X::in),
-		[thread_safe, will_not_call_mercury], "").
-:- pragma foreign_proc("MC++", nonvar(_X::unused),
-		[thread_safe, will_not_call_mercury], "
-	SUCCESS_INDICATOR = FALSE;
-").
+%-----------------------------------------------------------------------------%
 
+:- pred sorry(string::in) is erroneous.
+sorry(PredName) :-
+	error("sorry, `" ++ PredName ++ "' not implemented\n" ++
+		"for this target language (or compiler back-end).").
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------