diff: split mercury_builtin.m

Fergus Henderson fjh at cs.mu.OZ.AU
Tue May 26 07:34:40 AEST 1998


Estimated hours taken: 5

Fix various invasions of the user's namespace by `mercury_builtin.m',
by splitting mercury_builtin.m into two modules, called builtin.m and
private_builtin.m, and ensuring that the latter is imported as if
by `:- use_module' rather than `:- import_module'.

library/builtin.m:
library/private_builtin.m:
	Split mercury_builtin.m into two modules, builtin.m,
	which contains stuff intended to be public,
	and private_builtin.m, which contains implementation
	details that are not supposed to be public.
	
library/mercury_builtin.m:
	Add a comment saying that this module is no longer used, and
	should eventually be removed.  I have not removed it yet, since
	that would prevent bootstrapping with the current compiler.  It
	will be removed as a seperate change later, once all the
	changes have propagated.

compiler/prog_util.m:
	Change the definition of mercury_private_builtin_module/1 and
	mercury_public_builtin_module so that instead of automatically
	importing mercury_builtin.m as if by `import_module', the
	copiler will now automatically import builtin.m as if by
	`import_module' and private_builtin.m as if by `use_module'.

compiler/polymorphism.m:
	Change a call to mercury_private_builtin_module/1 for
	unsafe_promise_unique to instead call mercury_public_builtin_module/1.

compiler/unify_proc.m:
	Avoid hard-coding "mercury_builtin" by instead
	calling one of  mercury_{private,public}_builtin_module/1.

runtime/mercury_type_info.[ch]:
library/term.m:
library/std_util.m:
compiler/code_util.m:
	Change a few hard-coded instances of "mercury_builtin"
	to "builtin" or "private_builtin" as appropriate.

runtime/mercury_trace_util.c:
runtime/mercury_trace_internal.c:
library/prolog.m:
compiler/*.m:
	Update comments that refer to "mercury_builtin" to instead
	refer to either "builtin" or "private_builtin".

doc/Mmakefile:
	Don't include the interface to private_builtin.m in the
	library reference manual.

tools/bootcheck:
	Add `-p'/`--copy-profiler' option.  This is needed to get
	the above changes to bootstrap.

tools/test_mercury:
	Pass `-p' to tools/bootcheck.

cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing bytecode
cvs diff: Diffing bytecode/test
cvs diff: Diffing compiler
Index: compiler/base_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_type_info.m,v
retrieving revision 1.16
diff -u -u -r1.16 base_type_info.m
--- base_type_info.m	1998/03/03 17:33:31	1.16
+++ base_type_info.m	1998/05/25 19:05:43
@@ -141,13 +141,12 @@
 	ArityArg = yes(const(int_const(TypeArity))),
 	( 	
 		( Status = exported ; Status = abstract_exported
-		; Status = imported 	% XXX this is a hack to make it work
-					% for `term__context', which is defined
-					% in mercury_builtin.m, but whose
-					% base_type_info is generated in
-					% term.m.  Apart from special cases
-					% in mercury_builtin.m, this should
-					% never happen.
+		; Status = imported 	% XXX this is an old hack to make it
+					% work for `term__context', which was
+					% once defined in mercury_builtin.m,
+					% but whose base_type_info was
+					% generated in term.m. 
+					% It's probably not needed anymore.
 		)
 	->
 		Exported = yes
@@ -205,7 +204,7 @@
 		module_info_globals(ModuleInfo, Globals),
 		
 			% If eliminated, make procs point to
-			% mercury_builtin__unused.  (Or, if static code
+			% private_builtin__unused.  (Or, if static code
 			% addresses are not available, use NULL
 			% pointers).
 		(
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_type_layout.m,v
retrieving revision 1.29
diff -u -u -r1.29 base_type_layout.m
--- base_type_layout.m	1998/05/15 07:06:58	1.29
+++ base_type_layout.m	1998/05/25 19:06:59
@@ -32,7 +32,7 @@
 % 					  solutions
 % 		array.m			- array type
 % 		io.m			- io__stream type
-% 		mercury_builtin.m	- builtin types
+% 		builtin.m		- builtin types
 %
 % runtime:	mercury_type_info.h	- defines layout macros
 % 		mercury_deep_copy.{c,h}	- deep_copy
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.96
diff -u -u -r1.96 code_util.m
--- code_util.m	1998/04/08 11:31:23	1.96
+++ code_util.m	1998/05/25 18:28:20
@@ -368,14 +368,14 @@
 	maybe(rval), maybe(pair(var, rval))).
 :- mode code_util__translate_builtin_2(in, in, in, in, out, out) is semidet.
 
-code_util__translate_builtin_2("mercury_builtin", "unsafe_type_cast", 0,
+code_util__translate_builtin_2("private_builtin", "unsafe_type_cast", 0,
 		[X, Y], no, yes(Y - var(X))).
-code_util__translate_builtin_2("mercury_builtin", "unsafe_promise_unique", 0,
+code_util__translate_builtin_2("builtin", "unsafe_promise_unique", 0,
 		[X, Y], no, yes(Y - var(X))).
 
-code_util__translate_builtin_2("mercury_builtin", "builtin_int_gt", 0, [X, Y],
+code_util__translate_builtin_2("private_builtin", "builtin_int_gt", 0, [X, Y],
 	yes(binop((>), var(X), var(Y))), no).
-code_util__translate_builtin_2("mercury_builtin", "builtin_int_lt", 0, [X, Y],
+code_util__translate_builtin_2("private_builtin", "builtin_int_lt", 0, [X, Y],
 	yes(binop((<), var(X), var(Y))), no).
 
 code_util__translate_builtin_2("int", "builtin_plus", 0, [X, Y, Z],
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.38
diff -u -u -r1.38 dead_proc_elim.m
--- dead_proc_elim.m	1998/03/03 17:33:56	1.38
+++ dead_proc_elim.m	1998/05/25 19:07:32
@@ -692,8 +692,9 @@
 			% polymorphism.
 			code_util__compiler_generated(PredInfo)
 		;
-			% Don't eliminate preds from mercury_builtin.m since
-			% polymorphism.m needs unify/2 and friends.
+			% Don't eliminate preds from builtin.m or
+			% private_builtin.m, since polymorphism.m
+			% needs unify/2 and friends.
 			mercury_public_builtin_module(PredModule)
 		;
 			mercury_private_builtin_module(PredModule)
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.80
diff -u -u -r1.80 llds_out.m
--- llds_out.m	1998/05/16 07:30:19	1.80
+++ llds_out.m	1998/05/25 19:08:20
@@ -2495,8 +2495,8 @@
 		)
 		% The conditions above define which labels are printed without
 		% module qualification.  XXX Changes to runtime/* are necessary
-		% to allow `mercury_builtin' labels to be qualified/
-		% overloaded.
+		% to allow `builtin' or `private_builtin' labels to be
+		% qualified.
 	->
 		LabelName0 = Name0
 	;
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.108
diff -u -u -r1.108 mode_util.m
--- mode_util.m	1998/03/03 17:35:15	1.108
+++ mode_util.m	1998/05/25 19:08:49
@@ -135,7 +135,7 @@
 :- mode get_arg_lives(in, in, out) is det.
 
 	% Predicates to make error messages more readable by stripping
-	% "mercury_builtin" module qualifiers from modes.
+	% "builtin:" module qualifiers from modes.
 
 :- pred strip_builtin_qualifier_from_cons_id(cons_id, cons_id).
 :- mode strip_builtin_qualifier_from_cons_id(in, out) is det.
@@ -1357,7 +1357,7 @@
 
 	% 
 	% Predicates to make error messages more readable by stripping
-	% "mercury_builtin" module qualifiers from modes and insts.
+	% "builtin:" module qualifiers from modes and insts.
 	% The interesting part is strip_builtin_qualifier_from_sym_name;
 	% the rest is basically just recursive traversals.
 	%
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.70
diff -u -u -r1.70 modules.m
--- modules.m	1998/05/18 03:18:37	1.70
+++ modules.m	1998/05/25 19:09:17
@@ -918,7 +918,8 @@
 		% following this do not need module qualifiers.
 	{ append_pseudo_decl(Module1, imported, Module2) },
 
-		% Add `mercury_builtin' to the list of imported modules
+		% Add `builtin' and `private_builtin' to the
+		% list of imported modules
 	{ add_implicit_imports(ImportedModules1, UsedModules1,
 			ImportedModules2, UsedModules2) },
 
@@ -962,7 +963,7 @@
 	{ init_module_imports(ModuleName, Items0, [], [], Module0) },
 	{ append_pseudo_decl(Module0, imported, Module1) },
 
-		% Add `mercury_builtin' to the imported modules.
+		% Add `builtin' and `private_builtin' to the imported modules.
 	{ add_implicit_imports(ImportDeps0, UseDeps0, ImportDeps1, UseDeps1) },
 
 		%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.133
diff -u -u -r1.133 polymorphism.m
--- polymorphism.m	1998/04/08 15:23:25	1.133
+++ polymorphism.m	1998/05/25 19:10:05
@@ -139,7 +139,7 @@
 %			<base_type_layout for int/0>,
 %			<base_type_functors for int/0>,
 %			"int",
-%			"mercury_builtin"),
+%			"builtin"),
 %		r(TypeInfoT3, 0).
 %
 % Note that base_type_infos are actually generated as references to a
@@ -392,7 +392,7 @@
 	mercury_private_builtin_module(MercuryBuiltin).
 polymorphism__no_type_info_builtin(MercuryBuiltin,
 		"unsafe_promise_unique", 2) :-
-	mercury_private_builtin_module(MercuryBuiltin).
+	mercury_public_builtin_module(MercuryBuiltin).
 
 %---------------------------------------------------------------------------%
 
@@ -660,7 +660,7 @@
 			->
 				PredId = CallPredId
 			;
-				error("polymorphism.m: can't find `mercury_builtin:unify/2'")
+				error("polymorphism.m: can't find `builtin:unify/2'")
 			},
 			% XXX Bug! - we should check that the mode is (in, in),
 			%     and report an error (e.g. "unification of
@@ -714,7 +714,7 @@
 			->
 				PredId = PredId0
 			;
-				error("can't locate mercury_builtin:builtin_unify_pred/2")
+				error("can't locate private_builtin:builtin_unify_pred/2")
 			},
 			{ hlds_pred__in_in_unification_proc_id(ProcId) },
 			{ CallContext = call_unify_context(XVar, Y, Context) },
@@ -1382,7 +1382,7 @@
 				% We extract the superclass typeclass_info by
 				% inserting a call to
 				% superclass_from_typeclass_info in
-				% mercury_builtin.
+				% private_builtin.
 
 				% Make the goal for the call
 			varset__init(Empty),
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.40
diff -u -u -r1.40 prog_util.m
--- prog_util.m	1998/04/27 04:02:15	1.40
+++ prog_util.m	1998/05/25 16:59:40
@@ -19,15 +19,16 @@
 %-----------------------------------------------------------------------------%
 
 	% Returns the name of the module containing public builtins;
-	% traditionally this was "mercury_builtin", but it may eventually
-	% be renamed "std:builtin".
+	% originally this was "mercury_builtin", but it later became
+	% just "builtin", and it may eventually be renamed "std:builtin".
 
 :- pred mercury_public_builtin_module(sym_name).
 :- mode mercury_public_builtin_module(out) is det.
 
 	% Returns the name of the module containing private builtins;
-	% traditionally this was "mercury_builtin", but it may eventually
-	% be renamed "std:private_builtin".
+	% traditionally this was "mercury_builtin", but it later became
+	% "private_builtin", and it may eventually be renamed
+	% "std:private_builtin".
 
 :- pred mercury_private_builtin_module(sym_name).
 :- mode mercury_private_builtin_module(out) is det.
@@ -118,13 +119,13 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-% -- not yet:
+% We may eventually want to put the standard library into a package "std":
 %	mercury_public_builtin_module(M) :-
 % 		M = qualified(unqualified("std"), "builtin"))).
 %	mercury_private_builtin_module(M) :-
 % 		M = qualified(unqualified("std"), "private_builtin"))).
-mercury_public_builtin_module(unqualified("mercury_builtin")).
-mercury_private_builtin_module(unqualified("mercury_builtin")).
+mercury_public_builtin_module(unqualified("builtin")).
+mercury_private_builtin_module(unqualified("private_builtin")).
 
 unqualify_name(unqualified(PredName), PredName).
 unqualify_name(qualified(_ModuleName, PredName), PredName).
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.21
diff -u -u -r1.21 special_pred.m
--- special_pred.m	1998/03/03 17:36:00	1.21
+++ special_pred.m	1998/05/25 19:10:30
@@ -34,7 +34,7 @@
 	% special_pred_name_arity(SpecialPredType, GenericPredName,
 	%		TypeSpecificVersionPredName, Arity):
 	%	true iff there is a special predicate of category
-	%	SpecialPredType, called mercury_builtin:GenericPredName/Arity,
+	%	SpecialPredType, called builtin:GenericPredName/Arity,
 	%	for which the type-specific versions will be called
 	%	TypeSpecificVersionPredName.
 :- pred special_pred_name_arity(special_pred_id, string, string, int).
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.11
diff -u -u -r1.11 termination.m
--- termination.m	1998/03/18 08:07:47	1.11
+++ termination.m	1998/05/25 19:13:31
@@ -459,8 +459,12 @@
 %----------------------------------------------------------------------------%
 
 % This predicate checks each ProcId in the list to see if it is a compiler
-% generated predicate, or a mercury_builtin predicate.  If it is, then the
-% compiler sets the termination property of the ProcIds accordingly.
+% generated predicate, or a predicate from builtin.m or private_builtin.m.
+% If it is, then the compiler sets the termination property of the ProcIds
+% accordingly.
+
+% XXX This does the wrong thing for calls to unify/2,
+% which might not terminate in the case of user-defined equality predicates.
 
 :- pred set_compiler_gen_terminates(pred_info, list(proc_id), pred_id,
 	module_info, proc_table, proc_table).
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.53
diff -u -u -r1.53 type_util.m
--- type_util.m	1998/05/20 17:58:03	1.53
+++ type_util.m	1998/05/25 19:15:04
@@ -107,7 +107,7 @@
 	% check whether that type is a no_tag type
 	% (i.e. one with only one constructor, and
 	% whose one constructor has only one argument,
-	% and which is not mercury_builtin:type_info/1),
+	% and which is not private_builtin:type_info/1),
 	% and if so, return its constructor symbol and argument type.
 
 :- pred type_is_no_tag_type(list(constructor), sym_name, type).
@@ -378,9 +378,9 @@
 	% The checks for type_info and base_type_info
 	% are needed because those types lie about their
 	% arity; it might be cleaner to change that in
-	% mercury_builtin.m, but that would cause some
+	% private_builtin.m, but that would cause some
 	% bootstrapping difficulties.
-	% It might be slightly better to check for mercury_builtin:type_info
+	% It might be slightly better to check for private_builtin:type_info
 	% etc. rather than just checking the unqualified type name,
 	% but I found it difficult to verify that the constructors
 	% would always be fully module-qualified at points where
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.237
diff -u -u -r1.237 typecheck.m
--- typecheck.m	1998/05/07 06:41:50	1.237
+++ typecheck.m	1998/05/25 19:15:18
@@ -4767,7 +4767,7 @@
 	type_list_subsumes(TypesList2, TypesList1, _).
 
 
-	% Make error messages more readable by removing "mercury_builtin"
+	% Make error messages more readable by removing "builtin:"
 	% qualifiers.
 
 :- pred strip_builtin_qualifiers_from_type((type), (type)).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.67
diff -u -u -r1.67 unify_proc.m
--- unify_proc.m	1998/04/27 04:02:24	1.67
+++ unify_proc.m	1998/05/25 18:17:32
@@ -940,7 +940,16 @@
 	unify_proc__info_get_module_info(ModuleInfo),
 	{ module_info_get_predicate_table(ModuleInfo, PredicateTable) },
 	{ list__length(ArgVars, Arity) },
-	{ MercuryBuiltin = unqualified("mercury_builtin") },
+	%
+	% We assume that the special preds compare/3, index/2, and unify/2
+	% are the only public builtins called by code generated
+	% by this module.
+	%
+	{ special_pred_name_arity(_, Name, _, Arity) ->
+		mercury_public_builtin_module(MercuryBuiltin)
+	;
+		mercury_private_builtin_module(MercuryBuiltin)
+	},
 	{
 		predicate_table_search_pred_m_n_a(PredicateTable,
 			MercuryBuiltin, Name, Arity, [PredId])
cvs diff: Diffing compiler/notes
cvs diff: Diffing doc
Index: doc/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/Mmakefile,v
retrieving revision 1.8
diff -u -u -r1.8 Mmakefile
--- Mmakefile	1998/04/08 11:22:53	1.8
+++ Mmakefile	1998/05/25 20:30:44
@@ -97,6 +97,7 @@
 # by extracting the module interfaces from the library source code.
 # Note that the debugger_interface.m module is just an implementation
 # detail of the library, so it is not documented.
+# Same goes for private_builtin.m.
 
 library-menu.texi: $(LIBRARY_DIR)/*.m
 	{								\
@@ -105,6 +106,8 @@
 		case $$filename in					\
 			$(LIBRARY_DIR)/debugger_interface.m)		\
 				;;					\
+			$(LIBRARY_DIR)/private_builtin.m)		\
+				;;					\
 			*)						\
 				echo "* `basename $$filename .m`::"; 	\
 				;;					\
@@ -116,6 +119,8 @@
 	for filename in $(LIBRARY_DIR)/*.m; do 				\
 		case $$filename in					\
 			$(LIBRARY_DIR)/debugger_interface.m)		\
+				;;					\
+			$(LIBRARY_DIR)/private_builtin.m)		\
 				;;					\
 			*)						\
 				file="`basename $$filename .m`"; 	\
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/clpr
cvs diff: Diffing extras/clpr/clpr
cvs diff: Diffing extras/clpr/samples
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/Togl-1.2
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/references
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing library
cvs diff: library/builtin.m is a new entry, no comparison available
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/mercury_builtin.m,v
retrieving revision 1.97
diff -u -u -r1.97 mercury_builtin.m
--- mercury_builtin.m	1998/05/18 05:30:37	1.97
+++ mercury_builtin.m	1998/05/25 16:49:01
@@ -8,10 +8,11 @@
 % Main author: fjh.
 % Stability: low.
 
-% This file is automatically imported into every module.
-% It is intended for things that are part of the language,
-% but which are implemented just as normal user-level code
-% rather than with special coding in the compiler.
+% IMPORTANT NOTE!  This file is no longer used.
+% Its contents have been moved to builtin.m and private_builtin.m.
+% The stuff that is here remains here only for bootstrapping
+% reasons; once the changes to compiler/modules.m have been installed
+% everywhere, we should delete this file.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
cvs diff: library/private_builtin.m is a new entry, no comparison available
Index: library/prolog.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/prolog.m,v
retrieving revision 1.9
diff -u -u -r1.9 prolog.m
--- prolog.m	1998/01/23 12:33:28	1.9
+++ prolog.m	1998/05/25 19:01:15
@@ -21,7 +21,7 @@
 % if all your cuts are green cuts.
 
 /********
-cut is currently defined in mercury_builtin.m, for historical reasons.
+cut is currently defined in builtin.m, for historical reasons.
 
 :- pred ! is det.
 
@@ -97,7 +97,7 @@
 :- import_module require, int.
 
 /*********
-% !/0 and !/2 currently defined in mercury_builtin.m, for historical reasons.
+% !/0 and !/2 currently defined in builtin.m, for historical reasons.
 !.
 !(X, X).
 *********/
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.118
diff -u -u -r1.118 std_util.m
--- std_util.m	1998/05/15 07:08:45	1.118
+++ std_util.m	1998/05/25 19:03:38
@@ -222,7 +222,7 @@
 	% type_name(Type) returns the name of the specified type
 	% (e.g. type_name(type_of([2,3])) = "list:list(int)").
 	% Any equivalence types will be fully expanded.
-	% Builtin types (those defined in mercury_builtin.m) will
+	% Builtin types (those defined in builtin.m) will
 	% not have a module qualifier.
 	%
 :- func type_name(type_info) = string.
@@ -267,8 +267,7 @@
 
 	% type_ctor_module_name(TypeCtor) returns the module name of specified
 	% type constructor.
-	% (e.g. type_ctor_module_name(type_ctor(type_of(2))) =
-	% 		"mercury_builtin").
+	% (e.g. type_ctor_module_name(type_ctor(type_of(2))) = "builtin").
 	%
 :- func type_ctor_module_name(type_ctor_info) = string.
 
@@ -1323,9 +1322,13 @@
 	( Arity = 0 ->
 		UnqualifiedTypeName = Name
 	;
+		% XXX the test for mercury_builtin is for bootstrapping
+		% only; it should eventually be deleted.
 		( ModuleName = "mercury_builtin", Name = "func" -> 
 			IsFunc = yes 
-		 ; 
+		; ModuleName = "builtin", Name = "func" -> 
+			IsFunc = yes 
+		;
 		 	IsFunc = no 
 		),
 		(
@@ -1342,7 +1345,9 @@
 				UnqualifiedTypeName)
 		)
 	),
-	( ModuleName = "mercury_builtin" ->
+		% XXX the test for mercury_builtin is for bootstrapping
+		% only; it should eventually be deleted.
+	( (ModuleName = "mercury_builtin" ; ModuleName = "builtin") ->
 		TypeName = UnqualifiedTypeName
 	;
 		string__append_list([ModuleName, ":", 
Index: library/term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.81
diff -u -u -r1.81 term.m
--- term.m	1998/04/02 07:40:16	1.81
+++ term.m	1998/05/25 19:00:00
@@ -367,6 +367,10 @@
 		term::in(bound(term__functor(ground, ground, ground))),
 		type_info::in, term_to_type_context::in,
 		term_to_type_result(univ)::out) is semidet.
+/*
+** XXX the following clauses for mercury_builtin:* are
+** for bootstrapping only, and should eventually be deleted
+*/
 term__term_to_univ_special_case("mercury_builtin", "character", [],
 		Term, _, _, ok(Univ)) :-
 	Term = term__functor(term__atom(FunctorName), [], _),
@@ -384,6 +388,24 @@
 		Term, _, _, ok(Univ)) :-
 	Term = term__functor(term__float(Float), [], _),
 	type_to_univ(Float, Univ).
+
+term__term_to_univ_special_case("builtin", "character", [],
+		Term, _, _, ok(Univ)) :-
+	Term = term__functor(term__atom(FunctorName), [], _),
+	string__first_char(FunctorName, Char, ""),
+	type_to_univ(Char, Univ).
+term__term_to_univ_special_case("builtin", "int", [],
+		Term, _, _, ok(Univ)) :-
+	Term = term__functor(term__integer(Int), [], _),
+	type_to_univ(Int, Univ).
+term__term_to_univ_special_case("builtin", "string", [],
+		Term, _, _, ok(Univ)) :-
+	Term = term__functor(term__string(String), [], _),
+	type_to_univ(String, Univ).
+term__term_to_univ_special_case("builtin", "float", [],
+		Term, _, _, ok(Univ)) :-
+	Term = term__functor(term__float(Float), [], _),
+	type_to_univ(Float, Univ).
 term__term_to_univ_special_case("array", "array", [ElemType], Term, _Type,
 		PrevContext, Result) :-
 	%
@@ -425,7 +447,7 @@
 		ArgResult = error(Error),
 		Result = error(Error)
 	).
-term__term_to_univ_special_case("mercury_builtin", "c_pointer", _, _, _, 
+term__term_to_univ_special_case("builtin", "c_pointer", _, _, _, 
 		_, _) :-
 	fail.
 term__term_to_univ_special_case("std_util", "univ", _, _, _, _, _) :-
@@ -581,6 +603,10 @@
 		list(type_info)::in, univ::in, term__context::in,
 		term::out) is semidet.
 
+/*
+** XXX the following clauses for mercury_builtin:* are
+** for bootstrapping only, and should eventually be deleted
+*/
 term__univ_to_term_special_case("mercury_builtin", "int", [], Univ, Context,
 		term__functor(term__integer(Int), [], Context)) :-
 	det_univ_to_type(Univ, Int).
@@ -594,6 +620,20 @@
 term__univ_to_term_special_case("mercury_builtin", "string", [], Univ, Context,
 		term__functor(term__string(String), [], Context)) :-
 	det_univ_to_type(Univ, String).
+
+term__univ_to_term_special_case("builtin", "int", [], Univ, Context,
+		term__functor(term__integer(Int), [], Context)) :-
+	det_univ_to_type(Univ, Int).
+term__univ_to_term_special_case("builtin", "float", [], Univ, Context,
+		term__functor(term__float(Float), [], Context)) :-
+	det_univ_to_type(Univ, Float).
+term__univ_to_term_special_case("builtin", "character", [], Univ, 
+		Context, term__functor(term__atom(CharName), [], Context)) :-
+	det_univ_to_type(Univ, Character),
+	string__char_to_string(Character, CharName).
+term__univ_to_term_special_case("builtin", "string", [], Univ, Context,
+		term__functor(term__string(String), [], Context)) :-
+	det_univ_to_type(Univ, String).
 term__univ_to_term_special_case("std_util", "type_info", [], Univ, Context,
 		term__functor(term__atom("type_info"), [Term], Context)) :-
 	det_univ_to_type(Univ, TypeInfo),
@@ -652,10 +692,14 @@
 	ModuleName = type_ctor_name(TypeCtor),
 	list__map(type_info_to_term(Context), ArgTypes, ArgTerms),
 
-	( ModuleName = "mercury_builtin" ->
+	/*
+	** XXX the test for mercury_builtin is for bootstrapping only,
+	** and should eventually be deleted
+	*/
+	( (ModuleName = "mercury_builtin" ; ModuleName = "builtin") ->
 		Term = term__functor(term__atom(TypeName), ArgTerms, Context)
 	;
-		Term = term__functor(term__atom(":"), % TYPE_QUAL_OP
+		Term = term__functor(term__atom(":"),
 			[term__functor(term__atom(ModuleName), [], Context),
 			 term__functor(term__atom(TypeName), 
 			 	ArgTerms, Context)], Context)
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing runtime
Index: runtime/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_internal.c,v
retrieving revision 1.2
diff -u -u -r1.2 mercury_trace_internal.c
--- mercury_trace_internal.c	1998/05/19 05:15:10	1.2
+++ mercury_trace_internal.c	1998/05/25 18:50:45
@@ -283,7 +283,7 @@
 
 	/*
 	** XXX The printing of type_infos is buggy at the moment
-	** due to the fake arity of the type mercury_builtin:typeinfo/1.
+	** due to the fake arity of the type private_builtin:typeinfo/1.
 	**
 	** XXX The printing of large data structures is painful
 	** at the moment due to the lack of a true browser.
Index: runtime/mercury_trace_util.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_util.c,v
retrieving revision 1.1
diff -u -u -r1.1 mercury_trace_util.c
--- mercury_trace_util.c	1998/05/16 07:28:31	1.1
+++ mercury_trace_util.c	1998/05/25 18:50:50
@@ -103,7 +103,7 @@
 
 		/*
 		** XXX The printing of type_infos is buggy at the moment
-		** due to the fake arity of mercury_builtin:typeinfo/1.
+		** due to the fake arity of private_builtin:typeinfo/1.
 		**
 		** XXX The printing of large data structures is painful
 		** at the moment due to the lack of a true browser.
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.5
diff -u -u -r1.5 mercury_type_info.c
--- mercury_type_info.c	1998/05/15 07:09:28	1.5
+++ mercury_type_info.c	1998/05/25 18:52:09
@@ -126,7 +126,7 @@
 
 /* code for predicate 'builtin_unify_pred'/2 in mode 0 */
 Define_entry(mercury__builtin_unify_pred_2_0);
-	incr_sp_push_msg(2, "mercury_builtin:builtin_unify_pred");
+	incr_sp_push_msg(2, "private_builtin:builtin_unify_pred");
 	fatal_error("attempted unification of higher-order terms");
 END_MODULE
 
@@ -147,7 +147,7 @@
 
 /* code for predicate 'builtin_compare_pred'/3 in mode 0 */
 Define_entry(mercury__builtin_compare_pred_3_0);
-	incr_sp_push_msg(2, "mercury_builtin:builtin_compare_pred");
+	incr_sp_push_msg(2, "private_builtin:builtin_compare_pred");
 	fatal_error("attempted comparison of higher-order terms");
 END_MODULE
 
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.6
diff -u -u -r1.6 mercury_type_info.h
--- mercury_type_info.h	1998/05/15 07:09:29	1.6
+++ mercury_type_info.h	1998/05/25 18:53:06
@@ -141,7 +141,7 @@
 /*
 ** Code intended for defining type_layouts for handwritten code.
 **
-** See library/io.m or library/mercury_builtin.m for details.
+** See library/io.m or library/builtin.m for details.
 */
 #if TAGBITS >= 2
 	typedef const Word *TypeLayoutField;
@@ -281,7 +281,7 @@
 #define MR_TYPECTOR_GET_HOT_NAME(T)				\
 	((ConstString) ( ( ((Integer) (T)) % 2 ) ? "func" : "pred" ))
 #define MR_TYPECTOR_GET_HOT_MODULE_NAME(T)				\
-	((ConstString) "mercury_builtin")
+	((ConstString) "builtin")
 #define MR_TYPECTOR_GET_HOT_BASE_TYPE_INFO(T)			\
 	((Word) ( ( ((Integer) (T)) % 2 ) ?		\
 		(const Word *) &mercury_data___base_type_info_func_0 :	\
@@ -347,7 +347,7 @@
 
 /*
 ** Macros are provided here to initialize base_type_infos, both for
-** builtin types (such as in library/mercury_builtin.m) and user
+** builtin types (such as in library/builtin.m) and user
 ** defined C types (like library/array.m). Also, the automatically
 ** generated code uses these initializers.
 **
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/general
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
Index: tools/bootcheck
===================================================================
RCS file: /home/mercury1/repository/mercury/tools/bootcheck,v
retrieving revision 1.54
diff -u -u -r1.54 bootcheck
--- bootcheck	1998/05/18 09:51:16	1.54
+++ bootcheck	1998/05/25 20:56:29
@@ -24,6 +24,10 @@
 		Copy the runtime directory instead of linking it.
 		This is necessary if one wants to bootcheck a grade
 		that is not compatible with the standard one.
+	-p, --copy-profiler
+		Copy the profiler directory instead of linking it.
+		This is sometimes necessary for bootstrapping
+		changes.
 	-s, --sicstus
 		As well as running the normal bootcheck, also build a SICStus
 		Prolog version of the compiler and check it against the
@@ -58,6 +62,7 @@
 runtests=true
 do_bootcheck=true
 copy_runtime=false
+copy_profiler=false
 keep_stage_2=false
 keep_stage_3=false
 keep_stage_2_sicstus=false
@@ -94,6 +99,9 @@
 	-o*)
 		outfile="` expr $1 : '-o\(.*\)' `"; ;;
 
+	-p|--copy-profiler)
+		copy_profiler=true ;;
+
 	-r|--copy-runtime)
 		copy_runtime=true ;;
 
@@ -241,7 +249,16 @@
 	ln -s $root/doc .
 	ln -s $root/scripts .
 	ln -s $root/util .
-	ln -s $root/profiler .
+	if test "$copy_profiler" = "true"
+	then
+		mkdir profiler
+		cd profiler
+		ln -s $root/profiler/*.m .
+		cp $root/profiler/Mmake* .
+		cd $root/stage2_sicstus
+	else
+		ln -s $root/profiler .
+	fi
 	ln -s $root/conf* .
 	ln -s $root/VERSION .
 	ln -s $root/.README.in .
@@ -259,7 +276,8 @@
 
 	if
 		cd stage2_sicstus &&
-		mmake $mmake_opts depend_library depend_compiler &&
+		mmake $mmake_opts depend_library depend_compiler \
+			depend_profiler &&
 		cd $root
 	then
 		echo "building of SICStus stage 2 dependencies successful"
@@ -343,6 +361,8 @@
 		mmake depend
 		cd $root/compiler;
 		mmake depend
+		cd $root/profiler;
+		mmake depend
 		cd $root
 		if mmake $mmake_opts MMAKEFLAGS=$jfactor all
 		then
@@ -417,7 +437,16 @@
 	ln -s $root/doc .
 	ln -s $root/scripts .
 	ln -s $root/util .
-	ln -s $root/profiler .
+	if test "$copy_profiler" = "true"
+	then
+		mkdir profiler
+		cd profiler
+		ln -s $root/profiler/*.m .
+		cp $root/profiler/Mmake* .
+		cd $root/stage2
+	else
+		ln -s $root/profiler .
+	fi
 	ln -s $root/conf* .
 	ln -s $root/VERSION .
 	ln -s $root/.README.in .
@@ -441,7 +470,8 @@
 		exit 1
 	fi
 
-	if (cd stage2 && mmake $mmake_opts depend_library depend_compiler)
+	if (cd stage2 && mmake $mmake_opts depend_library depend_compiler \
+		depend_profiler)
 	then
 		echo "building of stage 2 dependencies successful"
 	else
Index: tools/test_mercury
===================================================================
RCS file: /home/mercury1/repository/mercury/tools/test_mercury,v
retrieving revision 1.69
diff -u -u -r1.69 test_mercury
--- test_mercury	1998/05/25 07:50:14	1.69
+++ test_mercury	1998/05/25 20:57:27
@@ -188,7 +188,7 @@
 mmake realclean MMAKEFLAGS=$PARALLEL || { false; exit 1; }
 ./configure --prefix=$INSTALL_DIR $CONFIG_OPTS || { false; exit 1; }
 mmake depend $PARALLEL || { false; exit 1; }
-tools/bootcheck -r -t $PARALLEL || $install_anyway || { false; exit 1; }
+tools/bootcheck -r -p -t $PARALLEL || $install_anyway || { false; exit 1; }
 cd .. || { false; exit 1; }
 
 #-----------------------------------------------------------------------------#
cvs diff: Diffing trial
cvs diff: Diffing util

===============================================================================
library/builtin.m:
===============================================================================
%---------------------------------------------------------------------------%
% Copyright (C) 1994-1998 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%

% File: builtin.m.
% Main author: fjh.
% Stability: low.

% This file is automatically imported into every module.
% It is intended for things that are part of the language,
% but which are implemented just as normal user-level code
% rather than with special coding in the compiler.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- module builtin.
:- interface.

%-----------------------------------------------------------------------------%

% TYPES.

% The types `character', `int', `float', and `string',
% and the types `pred', `pred(T)', `pred(T1, T2)', `pred(T1, T2, T3)', ...
% and `func(T1) = T2', `func(T1, T2) = T3', `func(T1, T2, T3) = T4', ...
% are builtin and are implemented using special code in the
% type-checker.  (XXX TODO: report an error for attempts to redefine
% these types.)

% The type c_pointer can be used by predicates which use the C interface.
:- type c_pointer.

%-----------------------------------------------------------------------------%

% INSTS.

% The standard insts `free', `ground', and `bound(...)' are builtin
% and are implemented using special code in the parser and mode-checker.

% So are the standard unique insts `unique', `unique(...)',
% `mostly_unique', `mostly_unique(...)', and `clobbered'.
% The name `dead' is allowed as a synonym for `clobbered'.
% Similarly `mostly_dead' is a synonym for `mostly_clobbered'.

:- inst dead = clobbered.
:- inst mostly_dead = mostly_clobbered.

% The `any' inst used for the constraint solver interface is also builtin.

% Higher-order predicate insts `pred(<modes>) is <detism>'
% and higher-order functions insts `func(<modes>) = <mode> is det'
% are also builtin.

%-----------------------------------------------------------------------------%

% MODES.

% The standard modes.

:- mode unused :: (free -> free).
:- mode output :: (free -> ground).
:- mode input :: (ground -> ground).

:- mode in :: (ground -> ground).
:- mode out :: (free -> ground).

:- mode in(Inst) :: (Inst -> Inst).
:- mode out(Inst) :: (free -> Inst).
:- mode di(Inst) :: (Inst -> clobbered).
:- mode mdi(Inst) :: (Inst -> mostly_clobbered).

% Unique modes.  These are still not fully implemented.

% unique output
:- mode uo :: free -> unique.

% unique input
:- mode ui :: unique -> unique.

% destructive input
:- mode di :: unique -> clobbered.

% "Mostly" unique modes (unique except that that may be referenced
% again on backtracking).

% mostly unique output
:- mode muo :: free -> mostly_unique.

% mostly unique input
:- mode mui :: mostly_unique -> mostly_unique.

% mostly destructive input
:- mode mdi :: mostly_unique -> mostly_clobbered.

% Higher-order predicate modes are builtin.

%-----------------------------------------------------------------------------%

% PREDICATES.

% Most of these probably ought to be moved to another
% module in the standard library such as std_util.m.

% copy/2 makes a deep copy of a data structure.  The resulting copy is a
% `unique' value, so you can use destructive update on it.

:- pred copy(T, T).
:- mode copy(ui, uo) is det.
:- mode copy(in, uo) is det.

% unsafe_promise_unique/2 is used to promise the compiler that you have a
% `unique' copy of a data structure, so that you can use destructive update.
% It is used to work around limitations in the current support for unique
% modes.  `unsafe_promise_unique(X, Y)' is the same as `Y = X' except that
% the compiler will assume that `Y' is unique.

:- pred unsafe_promise_unique(T, T).
:- mode unsafe_promise_unique(in, uo) is det.

% We define !/0 (and !/2 for dcgs) to be equivalent to `true'.  This is for
% backwards compatibility with Prolog systems.  But of course it only works
% if all your cuts are green cuts.

:- pred ! is det.

:- pred !(T, T).
:- mode !(di, uo) is det.
:- mode !(in, out) is det.

%-----------------------------------------------------------------------------%

	% unify(X, Y) is true iff X = Y.
:- pred unify(T::in, T::in) is semidet.

:- type comparison_result ---> (=) ; (<) ; (>).

	% compare(Res, X, Y) binds Res to =, <, or >
	% depending on wheither X is =, <, or > Y in the
	% standard ordering.
:- pred compare(comparison_result, T, T).
:- mode compare(uo, ui, ui) is det.
:- mode compare(uo, ui, in) is det.
:- mode compare(uo, in, ui) is det.
:- mode compare(uo, in, in) is det.

	% index(X, N): if X is a discriminated union type, this is
	% true iff the top-level functor of X is the (N-1)th functor in its
	% type.  If X is of type int, then it is true iff N = X.
	% Otherwise, it is true iff N = -1.
:- pred index(T::in, int::out) is det.

% In addition, the following predicate-like constructs are builtin:
%
%	:- pred (T = T).
%	:- pred (T \= T).
%	:- pred (pred , pred).
%	:- pred (pred ; pred).
%	:- pred (\+ pred).
%	:- pred (not pred).
%	:- pred (pred -> pred).
%	:- pred (if pred then pred).
%	:- pred (if pred then pred else pred).
%	:- pred (pred => pred).
%	:- pred (pred <= pred).
%	:- pred (pred <=> pred).
%
%	(pred -> pred ; pred).
%	some Vars pred
%	all Vars pred
%	call/N

%-----------------------------------------------------------------------------%

:- implementation.
:- import_module require, string, std_util, int, float, char, string, list.

%-----------------------------------------------------------------------------%

!.
!(X, X).

%-----------------------------------------------------------------------------%

:- external(unify/2).
:- external(index/2).
:- external(compare/3).

%-----------------------------------------------------------------------------%

:- pragma c_header_code("#include ""mercury_type_info.h""").

:- pragma c_code("


#ifdef  USE_TYPE_LAYOUT

	/* base_type_layout definitions */ 

	/* base_type_layout for `int' */

const struct mercury_data___base_type_layout_int_0_struct {
	TYPE_LAYOUT_FIELDS
} mercury_data___base_type_layout_int_0 = {
	make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
		mkbody(TYPELAYOUT_INT_VALUE))
};

	/* base_type_layout for `character' */

const struct mercury_data___base_type_layout_character_0_struct {
	TYPE_LAYOUT_FIELDS
} mercury_data___base_type_layout_character_0 = {
	make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
		mkbody(TYPELAYOUT_CHARACTER_VALUE))
};

	/* base_type_layout for `string' */

const struct mercury_data___base_type_layout_string_0_struct {
	TYPE_LAYOUT_FIELDS
} mercury_data___base_type_layout_string_0 = {
	make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
		mkbody(TYPELAYOUT_STRING_VALUE))
};

	/* base_type_layout for `float' */

const struct mercury_data___base_type_layout_float_0_struct {
	TYPE_LAYOUT_FIELDS
} mercury_data___base_type_layout_float_0 = {
	make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
		mkbody(TYPELAYOUT_FLOAT_VALUE))
};

	/* base_type_layout for `void' */

const struct mercury_data___base_type_layout_void_0_struct {
	TYPE_LAYOUT_FIELDS
} mercury_data___base_type_layout_void_0 = {
	make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
		mkbody(TYPELAYOUT_VOID_VALUE))
};

	/* base_type_functors definitions */

	/* base_type_functors for `int' */

const struct mercury_data___base_type_functors_int_0_struct {
	Integer f1;
} mercury_data___base_type_functors_int_0 = {
	MR_TYPEFUNCTORS_SPECIAL
};

	/* base_type_functors for `character' */

const struct mercury_data___base_type_functors_character_0_struct {
	Integer f1;
} mercury_data___base_type_functors_character_0 = {
	MR_TYPEFUNCTORS_SPECIAL
};

	/* base_type_functors for `string' */

const struct mercury_data___base_type_functors_string_0_struct {
	Integer f1;
} mercury_data___base_type_functors_string_0 = {
	MR_TYPEFUNCTORS_SPECIAL
};

	/* base_type_functors for `float' */

const struct mercury_data___base_type_functors_float_0_struct {
	Integer f1;
} mercury_data___base_type_functors_float_0 = {
	MR_TYPEFUNCTORS_SPECIAL
};

	/* base_type_functors for `void' */

const struct mercury_data___base_type_functors_void_0_struct {
	Integer f1;
} mercury_data___base_type_functors_void_0 = {
	MR_TYPEFUNCTORS_SPECIAL
};

#endif /* USE_TYPE_LAYOUT */

	/* base_type_infos definitions */

	/* base_type_info for `int' */

Declare_entry(mercury__builtin_unify_int_2_0);
Declare_entry(mercury__builtin_index_int_2_0);
Declare_entry(mercury__builtin_compare_int_3_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_int_0_struct {
	Integer f1;
	Code *f2;
	Code *f3;
	Code *f4;
#ifdef USE_TYPE_LAYOUT
	const Word *f5;
	const Word *f6;
	const Word *f7;
	const Word *f8;
#endif
} mercury_data___base_type_info_int_0 = {
	((Integer) 0),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_int_2_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_int_2_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_int_3_0)),
#ifdef  USE_TYPE_LAYOUT
	(const Word *) & mercury_data___base_type_layout_int_0,
	(const Word *) & mercury_data___base_type_functors_int_0,
	(const Word *) string_const(""builtin"", 15),
	(const Word *) string_const(""int"", 3)
#endif
};

	/* base_type_info for `character' */

Declare_entry(mercury__builtin_unify_character_2_0);
Declare_entry(mercury__builtin_index_character_2_0);
Declare_entry(mercury__builtin_compare_character_3_0);
MR_STATIC_CODE_CONST struct 
mercury_data___base_type_info_character_0_struct {
	Integer f1;
	Code *f2;
	Code *f3;
	Code *f4;
#ifdef USE_TYPE_LAYOUT
	const Word *f5;
	const Word *f6;
	const Word *f7;
	const Word *f8;
#endif
} mercury_data___base_type_info_character_0 = {
	((Integer) 0),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_character_2_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_character_2_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_character_3_0)),
#ifdef  USE_TYPE_LAYOUT
	(const Word *) & mercury_data___base_type_layout_character_0,
	(const Word *) & mercury_data___base_type_functors_character_0,
	(const Word *) string_const(""builtin"", 15),
	(const Word *) string_const(""character"", 9)
#endif
};

	/* base_type_info for `string' */

Declare_entry(mercury__builtin_unify_string_2_0);
Declare_entry(mercury__builtin_index_string_2_0);
Declare_entry(mercury__builtin_compare_string_3_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_string_0_struct {
	Integer f1;
	Code *f2;
	Code *f3;
	Code *f4;
#ifdef USE_TYPE_LAYOUT
	const Word *f5;
	const Word *f6;
	const Word *f7;
	const Word *f8;
#endif
} mercury_data___base_type_info_string_0 = {
	((Integer) 0),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_string_2_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_string_2_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_string_3_0)),
#ifdef  USE_TYPE_LAYOUT
	(const Word *) & mercury_data___base_type_layout_string_0,
	(const Word *) & mercury_data___base_type_functors_string_0,
	(const Word *) string_const(""builtin"", 15),
	(const Word *) string_const(""string"", 6)
#endif
};

	/* base_type_info for `float' */

Declare_entry(mercury__builtin_unify_float_2_0);
Declare_entry(mercury__builtin_index_float_2_0);
Declare_entry(mercury__builtin_compare_float_3_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_float_0_struct {
	Integer f1;
	Code *f2;
	Code *f3;
	Code *f4;
#ifdef USE_TYPE_LAYOUT
	const Word *f5;
	const Word *f6;
	const Word *f7;
	const Word *f8;
#endif
} mercury_data___base_type_info_float_0 = {
	((Integer) 0),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_float_2_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_float_2_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_float_3_0)),
#ifdef  USE_TYPE_LAYOUT
	(const Word *) & mercury_data___base_type_layout_float_0,
	(const Word *) & mercury_data___base_type_functors_float_0,
	(const Word *) string_const(""builtin"", 15),
	(const Word *) string_const(""float"", 5)
#endif
};

	/* base_type_info for `void' */

Declare_entry(mercury__unused_0_0);
MR_STATIC_CODE_CONST struct mercury_data___base_type_info_void_0_struct {
	Integer f1;
	Code *f2;
	Code *f3;
	Code *f4;
#ifdef USE_TYPE_LAYOUT
	const Word *f5;
	const Word *f6;
	const Word *f7;
	const Word *f8;
#endif
} mercury_data___base_type_info_void_0 = {
	((Integer) 0),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__unused_0_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__unused_0_0)),
	MR_MAYBE_STATIC_CODE(ENTRY(mercury__unused_0_0)),
#ifdef  USE_TYPE_LAYOUT
	(const Word *) & mercury_data___base_type_layout_void_0,
	(const Word *) & mercury_data___base_type_functors_void_0,
	(const Word *) string_const(""builtin"", 15),
	(const Word *) string_const(""void"", 4)
#endif
};

BEGIN_MODULE(builtin_types_module)

BEGIN_CODE

END_MODULE

/*
INIT sys_init_builtin_types_module
*/
extern ModuleFunc builtin_types_module;
extern void mercury__builtin__init(void);
void sys_init_builtin_types_module(void);
void sys_init_builtin_types_module(void) {

	builtin_types_module();

	/* 
	** We had better call this init() because we use the
	** labels for the special preds of int, float, pred, 
	** character and string. If they aren't initialized,
	** we might initialize the base_type_info with
	** garbage
	*/
	mercury__builtin__init();

	MR_INIT_BUILTIN_BASE_TYPE_INFO(
		mercury_data___base_type_info_int_0, _int_);
	MR_INIT_BUILTIN_BASE_TYPE_INFO(
		mercury_data___base_type_info_float_0, _float_);
	MR_INIT_BUILTIN_BASE_TYPE_INFO(
		mercury_data___base_type_info_character_0, _character_);
	MR_INIT_BUILTIN_BASE_TYPE_INFO(
		mercury_data___base_type_info_string_0, _string_);
	MR_INIT_BASE_TYPE_INFO_WITH_PRED(
		mercury_data___base_type_info_void_0, mercury__unused_0_0);
}

").

%-----------------------------------------------------------------------------%

% unsafe_promise_unique/2 is a compiler builtin.

%-----------------------------------------------------------------------------%

/* copy/2
	:- pred copy(T, T).
	:- mode copy(ui, uo) is det.
	:- mode copy(in, uo) is det.
*/

/*************
Using `pragma c_code' doesn't work, due to the lack of support for
aliasing, and in particular the lack of support for `ui' modes.
:- pragma c_code(copy(Value::ui, Copy::uo), "
	save_transient_registers();
	Copy = deep_copy(Value, TypeInfo_for_T, NULL, NULL);
	restore_transient_registers();
").
:- pragma c_code(copy(Value::in, Copy::uo), "
	save_transient_registers();
	Copy = deep_copy(Value, TypeInfo_for_T, NULL, NULL);
	restore_transient_registers();
").
*************/

:- external(copy/2).

:- pragma c_header_code("#include ""mercury_deep_copy.h""").

:- pragma c_code("
Define_extern_entry(mercury__copy_2_0);
Define_extern_entry(mercury__copy_2_1);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__copy_2_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__copy_2_1);

BEGIN_MODULE(copy_module)
	init_entry(mercury__copy_2_0);
	init_entry(mercury__copy_2_1);
BEGIN_CODE

#ifdef PROFILE_CALLS
  #define fallthru(target, caller) { tailcall((target), (caller)); }
#else
  #define fallthru(target, caller)
#endif

Define_entry(mercury__copy_2_0);
fallthru(ENTRY(mercury__copy_2_1), ENTRY(mercury__copy_2_0))
Define_entry(mercury__copy_2_1);
{
	Word value, copy, type_info;

	type_info = r1;
	value = r2;

	save_transient_registers();
	copy = deep_copy(value, (Word *) type_info, NULL, NULL);
	restore_transient_registers();

#ifdef	COMPACT_ARGS
	r1 = copy;
#else
	r3 = copy;
#endif

	proceed();
}
END_MODULE

/* Ensure that the initialization code for the above module gets run. */

/*
INIT sys_init_copy_module
*/
extern ModuleFunc copy_module;
void sys_init_copy_module(void);
	/* extra declaration to suppress gcc -Wmissing-decl warning */
void sys_init_copy_module(void) {
	copy_module();
}

").

%-----------------------------------------------------------------------------%

% The type c_pointer can be used by predicates which use the C interface.

:- pragma c_code("

/*
 * c_pointer has a special value reserved for its layout, since it needs to
 * be handled as a special case.
 */

#ifdef  USE_TYPE_LAYOUT

const struct mercury_data_builtin__base_type_layout_c_pointer_0_struct {
	TYPE_LAYOUT_FIELDS
} mercury_data_builtin__base_type_layout_c_pointer_0 = {
	make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
		mkbody(TYPELAYOUT_C_POINTER_VALUE))
};

const struct
mercury_data_builtin__base_type_functors_c_pointer_0_struct {
	Integer f1;
} mercury_data_builtin__base_type_functors_c_pointer_0 = {
	MR_TYPEFUNCTORS_SPECIAL
};

#endif

Define_extern_entry(mercury____Unify___builtin__c_pointer_0_0);
Define_extern_entry(mercury____Index___builtin__c_pointer_0_0);
Define_extern_entry(mercury____Compare___builtin__c_pointer_0_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Unify___builtin__c_pointer_0_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Index___builtin__c_pointer_0_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Compare___builtin__c_pointer_0_0);

BEGIN_MODULE(unify_c_pointer_module)
	init_entry(mercury____Unify___builtin__c_pointer_0_0);
	init_entry(mercury____Index___builtin__c_pointer_0_0);
	init_entry(mercury____Compare___builtin__c_pointer_0_0);

BEGIN_CODE
Define_entry(mercury____Unify___builtin__c_pointer_0_0);
	/*
	** For c_pointer, we assume that equality and comparison
	** can be based on object identity (i.e. using address comparisons).
	** This is correct for types like io__stream, and necessary since
	** the io__state contains a map(io__stream, filename).
	** However, it might not be correct in general...
	*/
	unify_output = (unify_input1 == unify_input2);
	proceed();

Define_entry(mercury____Index___builtin__c_pointer_0_0);
	index_output = -1;
	proceed();

Define_entry(mercury____Compare___builtin__c_pointer_0_0);
	compare_output = (compare_input1 == compare_input2 ? COMPARE_EQUAL :
			  compare_input1 < compare_input2 ? COMPARE_LESS :
			  COMPARE_GREATER);
	proceed();

END_MODULE

/* Ensure that the initialization code for the above module gets run. */
/*
INIT sys_init_unify_c_pointer_module
*/
extern ModuleFunc unify_c_pointer_module;
void sys_init_unify_c_pointer_module(void);
	/* duplicate declaration to suppress gcc -Wmissing-decl warning */
void sys_init_unify_c_pointer_module(void) {
	unify_c_pointer_module();
}

").

:- end_module builtin.

%-----------------------------------------------------------------------------%

===============================================================================
library/private_builtin.m:
===============================================================================
%---------------------------------------------------------------------------%
% Copyright (C) 1994-1998 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%

% File: private_builtin.m.
% Main authors: fjh, ohutch.
% Stability: low.

% This file is automatically imported, as if via `use_module', into every
% module.  It is intended for builtins that are just implementation details,
% such as procedures that the compiler generates implicit calls to when
% implementing polymorphism, unification, compare/3, tabling, etc.

% This module is a private part of the Mercury implementation;
% user modules should never explicitly import this module.
% The interface for this module does not get included in the
% Mercury library library reference manual.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- module private_builtin.
:- interface.

%-----------------------------------------------------------------------------%

	% unsafe_type_cast/2 is used internally by the compiler. Bad things
	% will happen if this is used in programs. This is generated inline
	% by the compiler.

:- pred unsafe_type_cast(T1, T2).
:- mode unsafe_type_cast(in, out) is det.

% The following are used by the compiler, to implement polymorphism.
% They should not be used in programs.

:- pred builtin_unify_int(int::in, int::in) is semidet.
:- pred builtin_index_int(int::in, int::out) is det.
:- pred builtin_compare_int(comparison_result::uo, int::in, int::in) is det.

:- pred builtin_unify_character(character::in, character::in) is semidet.
:- pred builtin_index_character(character::in, int::out) is det.
:- pred builtin_compare_character(comparison_result::uo, character::in,
	character::in) is det.

:- pred builtin_unify_string(string::in, string::in) is semidet.
:- pred builtin_index_string(string::in, int::out) is det.
:- pred builtin_compare_string(comparison_result::uo, string::in, string::in)
	is det.

:- pred builtin_unify_float(float::in, float::in) is semidet.
:- pred builtin_index_float(float::in, int::out) is det.
:- pred builtin_compare_float(comparison_result::uo, float::in, float::in)
	is det.

:- pred builtin_unify_pred((pred)::in, (pred)::in) is semidet.
:- pred builtin_index_pred((pred)::in, int::out) is det.
:- pred builtin_compare_pred(comparison_result::uo, (pred)::in, (pred)::in)
	is det.

% The following two preds are used for index/1 or compare/3 on
% non-canonical types (types for which there is a `where equality is ...'
% declaration).
:- pred builtin_index_non_canonical_type(T::in, int::out) is det.
:- pred builtin_compare_non_canonical_type(comparison_result::uo,
		T::in, T::in) is det.

:- pred unused is det.

	% compare_error is used in the code generated for compare/3 preds
:- pred compare_error is erroneous.

	% The code generated by polymorphism.m always requires
	% the existence of a type_info functor, and requires
	% the existence of a base_type_info functor as well
	% when using --type-info {shared-,}one-or-two-cell.
	%
	% The actual arities of these two function symbols are variable;
	% they depend on the number of type parameters of the type represented
	% by the type_info, and how many predicates we associate with each
	% type.
	%
	% Note that, since these types look to the compiler as though they
	% are candidates to become no_tag types, special code is required in
	% type_util:type_is_no_tag_type/3.

:- type type_info(T) ---> type_info(base_type_info(T) /*, ... */).
:- type base_type_info(T) ---> base_type_info(int /*, ... */).

	% Note that, since these types look to the compiler as though they
	% are candidates to become no_tag types, special code is required in
	% type_util:type_is_no_tag_type/3.

:- type typeclass_info ---> typeclass_info(base_typeclass_info /*, ... */). 
:- type base_typeclass_info ---> typeclass_info(int /*, ... */). 

	% type_info_from_typeclass_info(TypeClassInfo, Index, TypeInfo)  
	% extracts TypeInfo from TypeClassInfo, where TypeInfo is the Indexth
	% type_info in the typeclass_info
	% 
	% Note: Index must be equal to the number of the desired type_info 
	% plus the number of superclasses for this class.
:- pred type_info_from_typeclass_info(typeclass_info, int, type_info(T)).
:- mode type_info_from_typeclass_info(in, in, out) is det.

	% superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass)  
	% extracts SuperClass from TypeClassInfo where TypeInfo is the Indexth
	% superclass of the class.
:- pred superclass_from_typeclass_info(typeclass_info, int, typeclass_info).
:- mode superclass_from_typeclass_info(in, in, out) is det.

	% the builtin < operator on ints, used in the code generated
	% for compare/3 preds
:- pred builtin_int_lt(int, int).
:- mode builtin_int_lt(in, in) is semidet.
:- external(builtin_int_lt/2).

	% the builtin > operator on ints, used in the code generated
	% for compare/3 preds
:- pred builtin_int_gt(int, int).
:- mode builtin_int_gt(in, in) is semidet.
:- external(builtin_int_gt/2).

%
% The following predicates are used in code transformed by the table_gen pass
% of the compiler. The predicates fall into three categories :
% 1) 	Predicates to do lookups or insertions into the tables. This group
%	also contains function to create and initialise tables. There are
% 	currently two types of table used by the tabling system. 1) A subgoal
%	table, this is a table containing all of the subgoal calls that have
%	or are being processed for a given predicate. 2) An answer table, 
%	this is a table of all the answers a subgoal has returned. It is used
%	for duplicate answer elimination in the minimal model tabling 
%	scheme.
%
% 2)	Predicates to test and set the status of the tables. These predicates
%	expect either a subgoal or answer table node depending on their 
%	functionality.
%
% 3) 	Predicates to save answers into the tables. Answers are saved in
% 	an answer block, which is a vector of n elements where n is the number 
%	of output arguments of the predicate it belongs to. For	det and 
%	semidet tabling the answer block is connected directly to subgoal 
%	table nodes. In the case of nondet tabling answer blocks are connected 
%	to answered slots which are strung together to form a list. 
%
% All of the predicates with the impure declaration modify the table
% structures. Because the tables are persistent through backtracking, this
% causes the predicates to become impure. The predicates with the semipure
% directive only examine the trees but do not have any side effects.
% 

	% This type is used as a generic table: it can in fact represent two
	% types, either a subgoal_table or an answer_table. The subgoal_table
	% and answer_table types are differentiated by what they have at the
	% table nodes but not by the actual underling trie structure.
:- type ml_table.

	% This type is used in contexts where a node of a subgoal table is
	% expected.
:- type ml_subgoal_table_node.

	% This type is used in contexts where a node of an answer table is
	% expected.
:- type ml_answer_table_node.

	% This type is used in contexts where an answer slot is expected.
:- type ml_answer_slot.

	% This type is used in contexts where an answer block is expected.
:- type ml_answer_block.



	% This is a dummy predicate: its pred_proc_id, but not its code, 
	% is used. See the comment in compiler/table_gen.m for more 
	% information. 
:- impure pred get_table(ml_table).
:- mode get_table(out) is det.

	% Save important information in nondet table and initialise all of
	% its fields. If called on an already initialised table do nothing.
:- impure pred table_setup(ml_subgoal_table_node, ml_subgoal_table_node).
:- mode table_setup(in, out) is det.



	% Return all of the answer blocks stored in the given table.
:- semipure pred table_return_all_ans(ml_subgoal_table_node, ml_answer_block).
:- mode table_return_all_ans(in, out) is nondet.



	% Returns true if the given nondet table has returned some of its
	% answers.
:- semipure pred table_have_some_ans(ml_subgoal_table_node).
:- mode table_have_some_ans(in) is semidet.

	% Return true if the given nondet table has returned all of its
	% answers. 
:- semipure pred table_have_all_ans(ml_subgoal_table_node).
:- mode table_have_all_ans(in) is semidet.


	% Mark a table as having some answers.
:- impure pred table_mark_have_some_ans(ml_subgoal_table_node).
:- mode table_mark_have_some_ans(in) is det.

	% Make a table as having all of its answers.
:- impure pred table_mark_have_all_ans(ml_subgoal_table_node).
:- mode table_mark_have_all_ans(in) is det.


	% currently being evaluated (working on an answer).
:- semipure pred table_working_on_ans(ml_subgoal_table_node).
:- mode table_working_on_ans(in) is semidet.

	% Return false if the subgoal represented by the given table is
	% currently being evaluated (working on an answer).
:- semipure pred table_not_working_on_ans(ml_subgoal_table_node).
:- mode table_not_working_on_ans(in) is semidet.


	% Mark the subgoal represented by the given table as currently 
	% being evaluated (working on an answer).
:- impure pred table_mark_as_working(ml_subgoal_table_node).
:- mode table_mark_as_working(in) is det.

	% Mark the subgoal represented by the given table as currently 
	% not being evaluated (working on an answer).
:- impure pred table_mark_done_working(ml_subgoal_table_node).
:- mode table_mark_done_working(in) is det.
	


	% Report an error message about the current subgoal looping. 
:- pred table_loopcheck_error(string).
:- mode table_loopcheck_error(in) is erroneous.



%
% The following table_lookup_insert... predicates lookup or insert the second
% argument into the trie pointed to by the first argument. The value returned
% is a pointer to the leaf of the trie reached by the lookup. From the 
% returned leaf another trie may be connected.
% 
	% Lookup or insert an integer in the given table.
:- impure pred table_lookup_insert_int(ml_table, int, ml_table).
:- mode table_lookup_insert_int(in, in, out) is det.

	% Lookup or insert a character in the given trie.
:- impure pred table_lookup_insert_char(ml_table, character, ml_table).
:- mode table_lookup_insert_char(in, in, out) is det.

	% Lookup or insert a string in the given trie.
:- impure pred table_lookup_insert_string(ml_table, string, ml_table).
:- mode table_lookup_insert_string(in, in, out) is det.

	% Lookup or insert a float in the current trie.
:- impure pred table_lookup_insert_float(ml_table, float, ml_table).
:- mode table_lookup_insert_float(in, in, out) is det.

	% Lookup or inert an enumeration type in the given trie.
:- impure pred table_lookup_insert_enum(ml_table, int, T, ml_table).
:- mode table_lookup_insert_enum(in, in, in, out) is det.

	% Lookup or insert a monomorphic user defined type in the given trie.
:- impure pred table_lookup_insert_user(ml_table, T, ml_table).
:- mode table_lookup_insert_user(in, in, out) is det.

	% Lookup or insert a polymorphic user defined type in the given trie.
:- impure pred table_lookup_insert_poly(ml_table, T, ml_table).
:- mode table_lookup_insert_poly(in, in, out) is det.


	% Return true if the subgoal represented by the given table has an
	% answer. NOTE : this is only used for det and semidet procedures.
:- semipure pred table_have_ans(ml_subgoal_table_node).
:- mode table_have_ans(in) is semidet. 


	% Save the fact the the subgoal has succeeded in the given table.
:- impure pred table_mark_as_succeeded(ml_subgoal_table_node).
:- mode table_mark_as_succeeded(in) is det.

	% Save the fact the the subgoal has failed in the given table.
:- impure pred table_mark_as_failed(ml_subgoal_table_node).
:- mode table_mark_as_failed(in) is det.


	% Return true if the subgoal represented by the given table has a
	% true answer. NOTE : this is only used for det and semidet 
	% procedures.
:- semipure pred table_has_succeeded(ml_subgoal_table_node).
:- mode table_has_succeeded(in) is semidet. 

	% Return true if the subgoal represented by the given table has
	% failed. NOTE : this is only used for semidet procedures.
:- semipure pred table_has_failed(ml_subgoal_table_node).
:- mode table_has_failed(in) is semidet.


	% Create an answer block with the given number of slots and add it
	% to the given table.
:- impure pred table_create_ans_block(ml_subgoal_table_node, int, 
		ml_answer_block).
:- mode table_create_ans_block(in, in, out) is det.

	% Create a new slot in the answer list.
:- impure pred table_new_ans_slot(ml_subgoal_table_node, ml_answer_slot).
:- mode table_new_ans_slot(in, out) is det.

	% Save an integer answer in the given answer block at the given 
	% offset.
:- impure pred table_save_int_ans(ml_answer_block, int, int).
:- mode table_save_int_ans(in, in, in) is det.

	% Save a character answer in the given answer block at the given
	% offset.
:- impure pred table_save_char_ans(ml_answer_block, int, character).
:- mode table_save_char_ans(in, in, in) is det.

	% Save a string answer in the given answer block at the given
	% offset.
:- impure pred table_save_string_ans(ml_answer_block, int, string).
:- mode table_save_string_ans(in, in, in) is det.

	% Save a float answer in the given answer block at the given
	% offset.
:- impure pred table_save_float_ans(ml_answer_block, int, float).
:- mode table_save_float_ans(in, in, in) is det.

	% Save any type of answer in the given answer block at the given
	% offset.
:- impure pred table_save_any_ans(ml_answer_block, int, T).
:- mode table_save_any_ans(in, in, in) is det.


	% Restore an integer answer from the given answer block at the 
	% given offset. 
:- semipure pred table_restore_int_ans(ml_answer_block, int, int).
:- mode table_restore_int_ans(in, in, out) is det.

	% Restore a character answer from the given answer block at the     
	% given offset.
:- semipure pred table_restore_char_ans(ml_answer_block, int, character).
:- mode table_restore_char_ans(in, in, out) is det.

	% Restore a string answer from the given answer block at the
	% given offset.
:- semipure pred table_restore_string_ans(ml_answer_block, int, string).
:- mode table_restore_string_ans(in, in, out) is det.

	% Restore a float answer from the given answer block at the
	% given offset.
:- semipure pred table_restore_float_ans(ml_answer_block, int, float).
:- mode table_restore_float_ans(in, in, out) is det.

	% Restore any type of answer from the given answer block at the
	% given offset.
:- semipure pred table_restore_any_ans(ml_answer_block, int, T).
:- mode table_restore_any_ans(in, in, out) is det.


	% Return the table of answers already return to the given nondet
	% table. 
:- impure pred table_get_ans_table(ml_subgoal_table_node, ml_table).
:- mode table_get_ans_table(in, out) is det.

	% Return true if the answer represented by the given answer
	% table has not been returned to its parent nondet table.
:- semipure pred table_has_not_returned(ml_answer_table_node).
:- mode table_has_not_returned(in) is semidet.

	% Make the answer represented by the given answer table as
	% having been return to its parent nondet table.
:- impure pred table_mark_as_returned(ml_answer_table_node).
:- mode table_mark_as_returned(in) is det.

	% Save the state of the current subgoal and fail. When this subgoal 
	% is resumed answers are returned through the second argument.
	% The saved state will be used by table_resume/1 to resume the
	% subgoal.
:- impure pred table_suspend(ml_subgoal_table_node, ml_answer_block).
:- mode table_suspend(in, out) is nondet.

	% Resume all suspended subgoal calls. This predicate will resume each
	% of the suspended subgoals in turn until it reaches a fixed point at 
	% which all suspended subgoals have had all available answers returned
	% to them.
:- impure pred table_resume(ml_subgoal_table_node).
:- mode table_resume(in) is det. 

%-----------------------------------------------------------------------------%

:- implementation.
:- import_module require, string, std_util, int, float, char, string, list.

% Many of the predicates defined in this module are builtin -
% the compiler generates code for them inline.

:- pragma c_code(type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
	TypeInfo::out), will_not_call_mercury,
" 
	TypeInfo = MR_typeclass_info_type_info(TypeClassInfo, Index);
").

:- pragma c_code(superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
	TypeClassInfo::out), will_not_call_mercury,
" 
	TypeClassInfo = 
		MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
").

%-----------------------------------------------------------------------------%

builtin_unify_int(X, X).

builtin_index_int(X, X).

builtin_compare_int(R, X, Y) :-
	( X < Y ->
		R = (<)
	; X = Y ->
		R = (=)
	;
		R = (>)
	).

builtin_unify_character(C, C).

builtin_index_character(C, N) :-
	char__to_int(C, N).

builtin_compare_character(R, X, Y) :-
	char__to_int(X, XI),
	char__to_int(Y, YI),
	( XI < YI ->
		R = (<)
	; XI = YI ->
		R = (=)
	;
		R = (>)
	).

builtin_unify_string(S, S).

builtin_index_string(_, -1).

builtin_compare_string(R, S1, S2) :-
	builtin_strcmp(Res, S1, S2),
	( Res < 0 ->
		R = (<)
	; Res = 0 ->
		R = (=)
	;
		R = (>)
	).

builtin_unify_float(F, F).

builtin_index_float(_, -1).

builtin_compare_float(R, F1, F2) :-
	( F1 < F2 ->
		R = (<)
	; F1 > F2 ->
		R = (>)
	;
		R = (=)
	).

:- pred builtin_strcmp(int, string, string).
:- mode builtin_strcmp(out, in, in) is det.

:- pragma c_code(builtin_strcmp(Res::out, S1::in, S2::in),
	will_not_call_mercury,
	"Res = strcmp(S1, S2);").

builtin_index_non_canonical_type(_, -1).

builtin_compare_non_canonical_type(Res, X, _Y) :-
	% suppress determinism warning
	( semidet_succeed ->
		string__append_list([
			"call to compare/3 for non-canonical type `",
			type_name(type_of(X)),
			"'"],
			Message),
		error(Message)
	;
		% the following is never executed
		Res = (<)
	).

:- external(builtin_unify_pred/2).
:- external(builtin_index_pred/2).
:- external(builtin_compare_pred/3).

unused :-
	( semidet_succeed ->
		error("attempted use of dead predicate")
	;
		% the following is never executed 
		true
	).

	% This is used by the code that the compiler generates for compare/3.
compare_error :-
	error("internal error in compare/3").

:- pragma c_header_code("#include ""mercury_type_info.h"""). % XXX needed?

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- type ml_table == c_pointer.
:- type ml_subgoal_table_node == c_pointer.
:- type ml_answer_table_node == c_pointer.
:- type ml_answer_slot == c_pointer.
:- type ml_answer_block == c_pointer.

:- pragma c_header_code("
	
	/* Used to mark the status of the table */
#define ML_UNINITIALIZED	0
#define ML_WORKING_ON_ANS	1
#define ML_FAILED		2
	/* The values 3..TYPELAYOUT_MAX_VARINT are reserved for future use */
#define ML_SUCCEEDED		TYPELAYOUT_MAX_VARINT 
	/* This or any greater value indicate that the subgoal has 
	** succeeded. */

").
	
	% This is a dummy procedure that never actually gets called.
	% See the comments in table_gen.m for its purpose.
:- pragma c_code(get_table(_T::out), will_not_call_mercury, "").

:- pragma c_code(table_working_on_ans(T::in), will_not_call_mercury, "
	SUCCESS_INDICATOR = (*((Word*) T) == ML_WORKING_ON_ANS);
").

:- pragma c_code(table_not_working_on_ans(T::in), will_not_call_mercury, "
	SUCCESS_INDICATOR = (*((Word*) T) != ML_WORKING_ON_ANS);
").

:- pragma c_code(table_mark_as_working(T::in), will_not_call_mercury, "
	*((Word*) T) = ML_WORKING_ON_ANS;
").

:- pragma c_code(table_mark_done_working(T::in), will_not_call_mercury, "
	*((Word*) T) = ML_UNINITIALIZED;
").


table_loopcheck_error(Message) :-
	error(Message).


:- pragma c_code(table_lookup_insert_int(T0::in, I::in, T::out), 
		will_not_call_mercury, "
	T = (Word) MR_TABLE_INT((Word**)T0, I);
").

:- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out), 
		will_not_call_mercury, "
	T = (Word) MR_TABLE_CHAR((Word **) T0, C);
").

:- pragma c_code(table_lookup_insert_string(T0::in, S::in, T::out), 
		will_not_call_mercury, "
	T = (Word) MR_TABLE_STRING((Word **) T0, S);
").

:- pragma c_code(table_lookup_insert_float(T0::in, F::in, T::out), 
		will_not_call_mercury, "
	T = (Word) MR_TABLE_FLOAT((Word **) T0, F);
").

:- pragma c_code(table_lookup_insert_enum(T0::in, R::in, V::in, T::out), 
		will_not_call_mercury, "
	T = (Word) MR_TABLE_ENUM((Word **) T0, R, V);
").

:- pragma c_code(table_lookup_insert_user(T0::in, V::in, T::out), 
		will_not_call_mercury, "
	T = (Word) MR_TABLE_ANY((Word **) T0, TypeInfo_for_T, V);
").

:- pragma c_code(table_lookup_insert_poly(T0::in, V::in, T::out), 
		will_not_call_mercury, "
	Word T1 = (Word) MR_TABLE_TYPE_INFO((Word **) T0, TypeInfo_for_T);
	T = (Word) MR_TABLE_ANY((Word **) T1, TypeInfo_for_T, V);
").

:- pragma c_code(table_have_ans(T::in), will_not_call_mercury, "
	if (*((Word*) T) == ML_FAILED || *((Word*) T) >= ML_SUCCEEDED) {
		SUCCESS_INDICATOR = TRUE;
	} else {
		SUCCESS_INDICATOR = FALSE;
	}
").

:- pragma c_code(table_has_succeeded(T::in), will_not_call_mercury, "
	SUCCESS_INDICATOR = (*((Word*) T) >= ML_SUCCEEDED)
").

:- pragma c_code(table_has_failed(T::in), will_not_call_mercury, "
	SUCCESS_INDICATOR = (*((Word*) T) == ML_FAILED);
").

:- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out) ,"
	MR_TABLE_CREATE_ANSWER_BLOCK(T0, Size);
	T = T0;
").

:- pragma c_code(table_save_int_ans(T::in, Offset::in, I::in), 
		will_not_call_mercury, "
	MR_TABLE_SAVE_ANSWER(Offset, T, I,
		mercury_data___base_type_info_int_0);
").

:- pragma c_code(table_save_char_ans(T::in, Offset::in, C::in), 
		will_not_call_mercury, "
	MR_TABLE_SAVE_ANSWER(Offset, T, C,
		mercury_data___base_type_info_character_0);
").

:- pragma c_code(table_save_string_ans(T::in, Offset::in, S::in), 
		will_not_call_mercury, "
	MR_TABLE_SAVE_ANSWER(Offset, T, (Word) S,
		mercury_data___base_type_info_string_0);
").

:- pragma c_code(table_save_float_ans(T::in, Offset::in, F::in), 
		will_not_call_mercury, "
	MR_TABLE_SAVE_ANSWER(Offset, T, float_to_word(F),
		mercury_data___base_type_info_float_0);
").

:- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in), 
		will_not_call_mercury, "
	MR_TABLE_SAVE_ANSWER(Offset, T, V, TypeInfo_for_T);
").

:- pragma c_code(table_mark_as_succeeded(T::in), will_not_call_mercury, "
	*((Word*) T) = ML_SUCCEEDED;
").

:- pragma c_code(table_mark_as_failed(T::in), will_not_call_mercury, "
	*((Word*) T) = ML_FAILED;
").


:- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out), 
		will_not_call_mercury, "
	I = (Integer) MR_TABLE_GET_ANSWER(Offset, T);
").

:- pragma c_code(table_restore_char_ans(T::in, Offset::in, C::out), 
		will_not_call_mercury, "
	C = (Char) MR_TABLE_GET_ANSWER(Offset, T);
").

:- pragma c_code(table_restore_string_ans(T::in, Offset::in, S::out), 
		will_not_call_mercury, "
	S = (String) MR_TABLE_GET_ANSWER(Offset, T);
").

:- pragma c_code(table_restore_float_ans(T::in, Offset::in, F::out), 
		will_not_call_mercury, "
	F = word_to_float(MR_TABLE_GET_ANSWER(Offset, T));
").

:- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out), 
		will_not_call_mercury, "
	V = (Word) MR_TABLE_GET_ANSWER(Offset, T);
").


:- pragma c_header_code("

/*
** The following structures are used by the code for non deterministic tabling.
*/ 

/* Used to hold a single answer. */
typedef struct {
	Word ans_num;
	Word ans;
} AnswerListNode;

/* Used to save the state of a subgoal */
typedef struct {
	Word *last_ret_ans;		/* Pointer to the last answer returned
					   to the node */
	Code *succ_ip;			/* Saved succip */
	Word *s_p;			/* Saved SP */
	Word *cur_fr;			/* Saved curfr */
	Word *max_fr;			/* Saved maxfr */
	Word non_stack_block_size;	/* Size of saved non stack block */
	Word *non_stack_block;		/* Saved non stack */
	Word det_stack_block_size;	/* Size of saved det stack block */
	Word *det_stack_block;		/* Saved det stack */
} SuspendListNode;

typedef enum {
   	have_no_ans,
	have_some_ans,
	have_all_ans
} TableStatus;

/* Used to save info about a single subgoal in the table */  
typedef struct {
	TableStatus status;		/* Status of subgoal */
	Word answer_table;		/* Table of answers returned by the
					   subgoal */
	Word num_ans;			/* Number of answers returned by the
					   subgoal */
	Word answer_list;		/* List of answers returned by the
					   subgoal */
	Word *answer_list_tail;		/* Pointer to the tail of the answer
					   list. This is used to update the
					   tail rather than the head of the
					   ans list. */
	Word suspend_list;		/* List of suspended calls to the
					   subgoal */
	Word *suspend_list_tail;	/* Ditto for answer_list_tail */
	Word *non_stack_bottom;		/* Pointer to the bottom point of
					   the nondet stack from which to
					   copy */
	Word *det_stack_bottom;		/* Pointer to the bottom point of
					   the det stack from which to copy */
					   
} NondetTable;

	/* Flag used to indicate the answer has been returned */
#define ML_ANS_NOT_RET  0
#define ML_ANS_RET      1

	/* 
	** Cast a Word to a NondetTable*: saves on typing and improves 
	** readability. 
	*/
#define NON_TABLE(T)  (*(NondetTable **)T)
").


:- pragma c_code(table_setup(T0::in, T::out), will_not_call_mercury, "
	/* Init the table if this is the first time me see it */
	if (NON_TABLE(T0) == NULL) {
		NON_TABLE(T0) = (NondetTable *) table_allocate(
			sizeof(NondetTable));
		NON_TABLE(T0)->status = have_no_ans;
		NON_TABLE(T0)->answer_table = (Word) NULL;
		NON_TABLE(T0)->num_ans = 0;
		NON_TABLE(T0)->answer_list = list_empty();
		NON_TABLE(T0)->answer_list_tail =
			&NON_TABLE(T0)->answer_list;
		NON_TABLE(T0)->suspend_list = list_empty();
		NON_TABLE(T0)->suspend_list_tail =
			&NON_TABLE(T0)->suspend_list;
		NON_TABLE(T0)->non_stack_bottom = curprevfr;
		NON_TABLE(T0)->det_stack_bottom = MR_sp;
	}
	T = T0;
").


table_return_all_ans(T, A) :-
	semipure table_return_all_ans_list(T, AnsList),
	list__member(Node, AnsList),
	semipure table_return_all_ans_2(Node, A).

:- semipure pred table_return_all_ans_list(ml_table, list(ml_table)).
:- mode table_return_all_ans_list(in, out) is det.

:- pragma c_code(table_return_all_ans_list(T::in, A::out),
		 will_not_call_mercury, "
	A = NON_TABLE(T)->answer_list;
").

:- semipure pred table_return_all_ans_2(ml_table, ml_table).
:- mode table_return_all_ans_2(in, out) is det.

:- pragma c_code(table_return_all_ans_2(P::in, A::out), 
		will_not_call_mercury, "
	A = (Word) &((AnswerListNode*) P)->ans;
").

:- pragma c_code(table_get_ans_table(T::in, AT::out), 
		will_not_call_mercury, "
	AT = (Word) &(NON_TABLE(T)->answer_table);
").

:- pragma c_code(table_have_all_ans(T::in),"
	SUCCESS_INDICATOR = (NON_TABLE(T)->status == have_all_ans);
").

:- pragma c_code(table_have_some_ans(T::in), will_not_call_mercury, "
	SUCCESS_INDICATOR = (NON_TABLE(T)->status == have_some_ans);
").

:- pragma c_code(table_has_not_returned(T::in), will_not_call_mercury, "
	SUCCESS_INDICATOR = (*((Word*) T) == ML_ANS_NOT_RET);
").



:- pragma c_code(table_mark_have_all_ans(T::in), will_not_call_mercury, "
	NON_TABLE(T)->status = have_all_ans; 
").

:- pragma c_code(table_mark_have_some_ans(T::in), will_not_call_mercury, "
	NON_TABLE(T)->status = have_some_ans; 
").

:- pragma c_code(table_mark_as_returned(T::in), will_not_call_mercury, "
	*((Word *) T) = ML_ANS_RET;
").


:- external(table_suspend/2).
:- external(table_resume/1).

:- pragma c_code("

/* 
** The following procedure saves the state of the mercury runtime 
** so that it may be used in the table_resume procedure below to return 
** answers through this saved state. The procedure table_suspend is 
** declared as nondet but the code below is obviously of detism failure, 
** the reason for this is quite simple. Normally when a nondet proc
** is called it will first return all of its answers and then fail. In the 
** case of calls to this procedure this is reversed first the call will fail
** then later on, when the answers are found, answers will be returned.
** It is also important to note that the answers are returned not from the 
** procedure that was originally called (table_suspend) but from the procedure
** table_resume. So essentially what is below is the code to do the initial 
** fail; the code to return the answers is in table_resume.  
*/ 	
Define_extern_entry(mercury__table_suspend_2_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__table_suspend_2_0);
BEGIN_MODULE(table_suspend_module)
	init_entry_sl(mercury__table_suspend_2_0);
BEGIN_CODE

Define_entry(mercury__table_suspend_2_0);
	mkframe(mercury__table_suspend/2, 0, ENTRY(do_fail));
{
	Word *non_stack_top =  MR_maxfr;
	Word *det_stack_top =  MR_sp;
	Word *non_stack_bottom = NON_TABLE(r1)->non_stack_bottom;
	Word *det_stack_bottom = NON_TABLE(r1)->det_stack_bottom;
	Word non_stack_delta = non_stack_top - non_stack_bottom;
	Word det_stack_delta = det_stack_top - det_stack_bottom;
	Word ListNode;
	SuspendListNode *Node = table_allocate(sizeof(SuspendListNode));

	Node->last_ret_ans = &(NON_TABLE(r1)->answer_list);
	
	Node->non_stack_block_size = non_stack_delta;
	Node->non_stack_block = table_allocate(non_stack_delta);
	table_copy_mem((void *)Node->non_stack_block, (void *)non_stack_bottom, 
		non_stack_delta);	
		
	Node->det_stack_block_size = det_stack_delta;
	Node->det_stack_block = table_allocate(det_stack_delta);
	table_copy_mem((void *)Node->det_stack_block, (void *)det_stack_bottom, 
		det_stack_delta);

	Node->succ_ip = MR_succip;
	Node->s_p = MR_sp;
	Node->cur_fr = MR_curfr;
	Node->max_fr = MR_maxfr;

	ListNode = MR_table_list_cons(Node, *NON_TABLE(r1)->suspend_list_tail);
	*NON_TABLE(r1)->suspend_list_tail = ListNode;
	NON_TABLE(r1)->suspend_list_tail = &list_tail(ListNode);
}
	fail();	
END_MODULE

/*
** The following structure is used to hold the state and variables used in 
** the table_resume procedure. The state and variables must be held in a 
** globally rooted structure as the process of resuming overwrites the mercury 
** and C stacks. A new stack is used to avoid this overwriting. This stack is
** defined and accessed by the following macros and global variables. 
*/
typedef struct {
	NondetTable *table;
	Word non_stack_block_size;
	Word *non_stack_block;
	Word det_stack_block_size;
	Word *det_stack_block;
	
	Code *succ_ip;
	Word *s_p;
	Word *cur_fr;
	Word *max_fr;

	Word changed;
	Word num_ans, new_num_ans;
	Word suspend_list;
	SuspendListNode *suspend_node;
	Word ans_list;
	AnswerListNode *ansNode;
} ResumeStackNode;


Integer ML_resumption_sp = -1;
Word ML_resumption_stack_size = 4;	/* Half the initial size of 
					   the stack in ResumeStackNode's */

ResumeStackNode** ML_resumption_stack = NULL;

#define ML_RESUME_PUSH()						\
	do {								\
		++ML_resumption_sp;					\
		if (ML_resumption_sp >= ML_resumption_stack_size ||	\
				ML_resumption_stack == NULL) 		\
		{							\
			ML_resumption_stack_size =			\
				ML_resumption_stack_size*2;		\
			ML_resumption_stack = table_reallocate(		\
				ML_resumption_stack,			\
				ML_resumption_stack_size*sizeof(	\
					ResumeStackNode*));		\
		}							\
		ML_resumption_stack[ML_resumption_sp] = table_allocate(	\
			sizeof(ResumeStackNode));			\
	} while (0)
	
#define ML_RESUME_POP()							\
	do {								\
		if (ML_resumption_sp < 0) {				\
			fatal_error(""resumption stack underflow"");	\
		}							\
		table_free(ML_resumption_stack[ML_resumption_sp]);	\
		--ML_resumption_sp;					\
	} while (0)

#define ML_RESUME_VAR							\
	ML_resumption_stack[ML_resumption_sp]

/*
** The procedure defined below restores answers to suspended nodes. It 
** works by restoring the states saved when calls to table_suspend were
** made. By restoring the states saved in table_suspend and then returning
** answers it is essentially returning answers out of the call to table_suspend
** not out of the call to table_resume. 
** This procedure iterates until it has returned all answers to all
** suspend nodes. The iteration is a fixpoint type as each time an answer
** is returned to a suspended node it has the chance of introducing more
** answers and/or suspended nodes.  
*/
Define_extern_entry(mercury__table_resume_1_0);
Declare_label(mercury__table_resume_1_0_ChangeLoop);
Declare_label(mercury__table_resume_1_0_ChangeLoopDone);
Declare_label(mercury__table_resume_1_0_SolutionsListLoop);
Declare_label(mercury__table_resume_1_0_AnsListLoop);
Declare_label(mercury__table_resume_1_0_AnsListLoopDone1);
Declare_label(mercury__table_resume_1_0_AnsListLoopDone2);
Declare_label(mercury__table_resume_1_0_SkipAns);
Declare_label(mercury__table_resume_1_0_RedoPoint);

MR_MAKE_STACK_LAYOUT_ENTRY(mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
	mercury__table_resume_1_0_ChangeLoop, mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
	mercury__table_resume_1_0_ChangeLoopDone, mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
	mercury__table_resume_1_0_SolutionsListLoop, mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
	mercury__table_resume_1_0_AnsListLoop, mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
	mercury__table_resume_1_0_AnsListLoopDone1, mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
	mercury__table_resume_1_0_AnsListLoopDone2, mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
	mercury__table_resume_1_0_SkipAns, mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
	mercury__table_resume_1_0_RedoPoint, mercury__table_resume_1_0);

BEGIN_MODULE(table_resume_module)
	init_entry_sl(mercury__table_resume_1_0);
	init_label_sl(mercury__table_resume_1_0_ChangeLoop);
	init_label_sl(mercury__table_resume_1_0_ChangeLoopDone);
	init_label_sl(mercury__table_resume_1_0_SolutionsListLoop);
	init_label_sl(mercury__table_resume_1_0_AnsListLoop);
	init_label_sl(mercury__table_resume_1_0_AnsListLoopDone1);
	init_label_sl(mercury__table_resume_1_0_AnsListLoopDone2);
	init_label_sl(mercury__table_resume_1_0_SkipAns);
	init_label_sl(mercury__table_resume_1_0_RedoPoint);
BEGIN_CODE

Define_entry(mercury__table_resume_1_0);
	/* Check that we have answers to return and nodes to return 
	   them to. */
	if (list_is_empty(NON_TABLE(r1)->answer_list) ||
			list_is_empty(NON_TABLE(r1)->suspend_list)) 
		proceed(); 
	

	/* Save the current state. */	
	ML_RESUME_PUSH();
	ML_RESUME_VAR->table = NON_TABLE(r1);
	ML_RESUME_VAR->non_stack_block_size = (char *) MR_maxfr -
		(char *) ML_RESUME_VAR->table->non_stack_bottom;
	ML_RESUME_VAR->det_stack_block_size = (char *) MR_sp - 
		(char *) ML_RESUME_VAR->table->det_stack_bottom;
	ML_RESUME_VAR->succ_ip = MR_succip;
	ML_RESUME_VAR->s_p = MR_sp;
	ML_RESUME_VAR->cur_fr = MR_curfr;
	ML_RESUME_VAR->max_fr = MR_maxfr;

	ML_RESUME_VAR->changed = 1;
	
	ML_RESUME_VAR->non_stack_block = (Word *) table_allocate(
		ML_RESUME_VAR->non_stack_block_size);
	table_copy_mem(ML_RESUME_VAR->non_stack_block, 
		ML_RESUME_VAR->table->non_stack_bottom, 
		ML_RESUME_VAR->non_stack_block_size);
	
	ML_RESUME_VAR->det_stack_block = (Word *) table_allocate(
		ML_RESUME_VAR->det_stack_block_size);
	table_copy_mem(ML_RESUME_VAR->det_stack_block, 
		ML_RESUME_VAR->table->det_stack_bottom, 
		ML_RESUME_VAR->det_stack_block_size);

	/* If the number of ans or suspended nodes has changed. */
Define_label(mercury__table_resume_1_0_ChangeLoop);
	if (! ML_RESUME_VAR->changed)
		GOTO_LABEL(mercury__table_resume_1_0_ChangeLoopDone);
		
	ML_RESUME_VAR->suspend_list = ML_RESUME_VAR->table->suspend_list;

	ML_RESUME_VAR->changed = 0;
	ML_RESUME_VAR->num_ans = ML_RESUME_VAR->table->num_ans;

	/* For each of the suspended nodes */	
Define_label(mercury__table_resume_1_0_SolutionsListLoop);
	if (list_is_empty(ML_RESUME_VAR->suspend_list))
		GOTO_LABEL(mercury__table_resume_1_0_ChangeLoop);

	ML_RESUME_VAR->suspend_node = (SuspendListNode *)list_head(
		ML_RESUME_VAR->suspend_list);
	
	ML_RESUME_VAR->ans_list = *ML_RESUME_VAR->suspend_node->
			last_ret_ans;
	
	if (list_is_empty(ML_RESUME_VAR->ans_list))
		GOTO_LABEL(mercury__table_resume_1_0_AnsListLoopDone2);
			
	ML_RESUME_VAR->ansNode = (AnswerListNode *)list_head(
		ML_RESUME_VAR->ans_list);


	/* 
	** Restore the state of the suspended node and return the answer 
	** through the redoip we saved when the node was originally 
	** suspended 
	*/ 
	
								
	table_copy_mem(ML_RESUME_VAR->table->non_stack_bottom, 
		ML_RESUME_VAR->suspend_node->non_stack_block,
		ML_RESUME_VAR->suspend_node->non_stack_block_size);
				
	table_copy_mem(ML_RESUME_VAR->table->det_stack_bottom, 
		ML_RESUME_VAR->suspend_node->det_stack_block,
		ML_RESUME_VAR->suspend_node->det_stack_block_size);

	MR_succip = ML_RESUME_VAR->suspend_node->succ_ip;
	MR_sp = ML_RESUME_VAR->suspend_node->s_p;
	MR_curfr = ML_RESUME_VAR->suspend_node->cur_fr;
	MR_maxfr = ML_RESUME_VAR->suspend_node->max_fr;

	bt_redoip(maxfr) = LABEL(mercury__table_resume_1_0_RedoPoint);

	/* 
	** For each answer not returned to the node whose state we are
	** currently in.
	*/
Define_label(mercury__table_resume_1_0_AnsListLoop);
#ifdef COMPACT_ARGS	
	r1 = (Word) &ML_RESUME_VAR->ansNode->ans;
#else
	r2 = (word) &ML_RESUME_VAR->ansNode->ans;
#endif

	/* 
	** Return the answer though the point where suspend should have
	** returned.
	*/
	succeed();

Define_label(mercury__table_resume_1_0_RedoPoint);
	update_prof_current_proc(LABEL(mercury__table_resume_1_0));
	
	ML_RESUME_VAR->ans_list = list_tail(ML_RESUME_VAR->ans_list);

	if (list_is_empty(ML_RESUME_VAR->ans_list))
		GOTO_LABEL(mercury__table_resume_1_0_AnsListLoopDone1);

	ML_RESUME_VAR->ansNode = (AnswerListNode *)list_head(
		ML_RESUME_VAR->ans_list);

	GOTO_LABEL(mercury__table_resume_1_0_AnsListLoop);

Define_label(mercury__table_resume_1_0_AnsListLoopDone1);
	if (ML_RESUME_VAR->num_ans == ML_RESUME_VAR->table->num_ans)
		ML_RESUME_VAR->changed = 0;
	else 
		ML_RESUME_VAR->changed = 1;
	

	ML_RESUME_VAR->suspend_node->last_ret_ans =
		 &ML_RESUME_VAR->ans_list;

Define_label(mercury__table_resume_1_0_AnsListLoopDone2);
	ML_RESUME_VAR->suspend_list = list_tail(ML_RESUME_VAR->suspend_list);
	GOTO_LABEL(mercury__table_resume_1_0_SolutionsListLoop);

Define_label(mercury__table_resume_1_0_SkipAns);
	ML_RESUME_VAR->ans_list = list_tail(ML_RESUME_VAR->ans_list);
	GOTO_LABEL(mercury__table_resume_1_0_AnsListLoop);
	
Define_label(mercury__table_resume_1_0_ChangeLoopDone);
	/* Restore the original state we had when this proc was called */ 
	
	table_copy_mem(ML_RESUME_VAR->table->non_stack_bottom, 
		ML_RESUME_VAR->non_stack_block,
		ML_RESUME_VAR->non_stack_block_size);
	table_free(ML_RESUME_VAR->non_stack_block);

	table_copy_mem(ML_RESUME_VAR->table->det_stack_bottom, 
		ML_RESUME_VAR->det_stack_block,
		ML_RESUME_VAR->det_stack_block_size);
	table_free(ML_RESUME_VAR->det_stack_block);

	MR_succip = ML_RESUME_VAR->succ_ip;
	MR_sp = ML_RESUME_VAR->s_p;
	MR_curfr = ML_RESUME_VAR->cur_fr;
	MR_maxfr = ML_RESUME_VAR->max_fr;

	ML_RESUME_POP();
	
	proceed();
END_MODULE

/* Ensure that the initialization code for the above module gets run. */
/*
INIT sys_init_table_suspend_module
INIT sys_init_table_resume_module
*/
void sys_init_table_suspend_module(void);
	/* extra declaration to suppress gcc -Wmissing-decl warning */
void sys_init_table_suspend_module(void) {
	extern ModuleFunc table_suspend_module;
	table_suspend_module();
}
void sys_init_table_resume_module(void);
	/* extra declaration to suppress gcc -Wmissing-decl warning */
void sys_init_table_resume_module(void) {
	extern ModuleFunc table_resume_module;
	table_resume_module();
}

").

:- pragma c_code(table_new_ans_slot(T::in, Slot::out), 
		will_not_call_mercury, "
	Word ListNode;
	Word ans_num;
	AnswerListNode *n = table_allocate(sizeof(AnswerListNode));
	
	++(NON_TABLE(T)->num_ans);
	ans_num = NON_TABLE(T)->num_ans;
	n->ans_num = ans_num;
	n->ans = 0;
	ListNode = MR_table_list_cons(n, *NON_TABLE(T)->answer_list_tail);
	*NON_TABLE(T)->answer_list_tail = ListNode; 
	NON_TABLE(T)->answer_list_tail = &list_tail(ListNode);

	Slot = (Word) &n->ans;
").


:- end_module private_builtin.

%-----------------------------------------------------------------------------%
-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- the last words of T. S. Garp.



More information about the developers mailing list