This change basically exposes the C types used for implementing the

Estimated hours taken: 12 (this figure a wild guess, because most of this
stuff was done about 6 months ago and left to rot).

This change basically exposes the C types used for implementing the
`reference' and `nb_reference' types in extras/references, so that if the
user wishes to allocate these types somewhere other than on the heap, they
can.  This is needed by HAL in order to implement global variables.

extras/references/c_reference.h:
        New file, intended to expose the C types used by the `reference'
        and `nb_reference' modules, so that the user can allocate them
        somewhere other than on the heap if they need to.

extras/references/nb_reference.m:
        Added a new predicate `init/2' for initialising a user-allocated
        `nb_reference'.

extras/references/reference.m:
        Moved the `ME_Reference' type to c_reference.h, and added a new
        predicate `init/2' for initialising a user-allocated `reference'.

extras/references/README:
        Added entries for the new `c_reference.h' and `tests/glob_test.m'
        files, as well as correcting the name of `tests/ref_test.m'.

extras/references/tests/Mmakefile:
        Added `glob_test' to the list of programs to build.

extras/references/tests/glob_test.m:
        Test case for statically-allocated reference types, implementing
        global variables.  Adapted from output from the HAL compiler.

extras/references/tests/glob_test.exp:
        Expected output from `glob_test'.

extras/references/README

@@ -18,6 +18,9 @@ This directory contains
 	global.m		a wrapper module used for building a
 				library containing the above modules
 
+	c_reference.h		C types used to implement the reference
+				types
+
 The samples directory contains
 
 	max_of.m		an example of non-backtrackable references
@@ -25,6 +28,8 @@ The samples directory contains
 
 The tests directory contains
 
-	test_refs.m		tests of reference.m, nb_reference.m
+	ref_test.m		tests of reference.m, nb_reference.m
 				and scoped_update.m
+	glob_test.m		tests use of c_reference.h to implement
+				global variables
 

extras/references/c_reference.h

@@ -0,0 +1,55 @@
+/*
+** Copyright (C) 1999-2000 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.
+*/
+
+/*
+** This file exposes the C types used by the reference and nb_reference
+** modules, so that one can allocate them somewhere other than the heap if
+** one so desires.  Normally this should not be necessary, and the cleaner,
+** safer interfaces provided by reference.m and nb_reference.m should be
+** used instead.  However, sometimes it is useful; for example, the HAL
+** compiler would like to be able to allocate them at compile-time-known
+** locations, in order to implement global variables.
+**
+** These types should be treated as abstract in case their implementation
+** changes in the future.
+**
+** Sample usage:
+**
+** The following example declares an ME_Reference `foo' at a
+** compile-time-known location, and provides a zero-arity function for
+** returning the corresponding Mercury object of type `reference/1'.  Note
+** that this reference should be initialised with the `reference:init/2'
+** predicate before use: see the documentation of that predicate in
+** reference.m for more caveats.
+**
+** :- pragma c_header_code("
+** #include ""c_reference.h""
+** extern ME_Reference foo;
+** ").
+**
+** :- pragma c_code("
+** ME_Reference foo;
+** ").
+**
+** :- pragma c_code(foo_reference = (X::out), will_not_call_mercury, "
+**         X = (Word) &foo;
+** ").
+*/
+
+#ifndef	C_REFERENCE_H
+#define	C_REFERENCE_H
+
+#include "mercury_trail.h"
+
+typedef struct {
+	void *value;
+	MR_ChoicepointId id;
+} ME_Reference;
+
+typedef Word ME_NbReference;
+
+#endif	/* not C_REFERENCE_H */
+

extras/references/nb_reference.m

@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1998 University of Melbourne.
+% Copyright (C) 1998-2000 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.
 %-----------------------------------------------------------------------------%
@@ -51,6 +51,9 @@
 :- implementation.
 
 %  This type is implemented in C.
+%  Note that if the C type used to implement nb_references changes (from
+%  something equivalent to `Word'), then `c_reference.h' should also be
+%  updated.
 :- type nb_reference(T) ---> nb_reference(c_pointer).
 
 :- pragma c_header_code("#include ""mercury_deep_copy.h""").
@@ -85,3 +88,20 @@
 #endif
 ").
 
+:- interface.
+
+% init(Ref, Value)
+%	Initialise a reference Ref to have value Value.
+%	This is for use with user-declared ME_NbReferences (see
+%	c_reference.h), and must be called before using such a reference.
+%	Attempting to access the reference before it is initialised is
+%	undefined.
+
+:- impure pred init(nb_reference(T)::in, T::in) is det.
+
+:- implementation.
+
+:- pragma inline(init/2).
+init(Ref, X) :-
+	impure update(Ref, X).
+

extras/references/reference.m

@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1998 University of Melbourne.
+% Copyright (C) 1998-2000 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.
 %-----------------------------------------------------------------------------%
@@ -51,13 +51,7 @@
 %  This type is implemented in C.
 :- type reference(T) ---> reference(c_pointer).
 
-:- pragma c_header_code("#include ""mercury_trail.h""").
-:- pragma c_header_code("
-	typedef struct {
-		void *value;
-		MR_ChoicepointId id;
-	} ME_Reference;
-").
+:- pragma c_header_code("#include ""c_reference.h""").
 
 :- pragma inline(new_reference/2).
 :- pragma c_code(new_reference(X::in, Ref::out), will_not_call_mercury, "
@@ -81,3 +75,23 @@
 	}
 	ref->value = (void *) X;
 ").
+
+:- interface.
+
+% init(Ref, Value)
+%	Initialise a reference Ref to have value Value.
+%	This is for use with user-declared ME_References (see
+%	c_reference.h), and must be called before using such a reference.
+%	Attempting to access the reference before it is initialised or
+%	after the init call is backtracked is undefined.
+
+:- impure pred init(reference(T)::in, T::in) is det.
+
+:- implementation.
+
+:- pragma inline(init/2).
+:- pragma c_code(init(Ref::in, X::in), will_not_call_mercury, "
+	((ME_Reference *) Ref)->value = (void *) X;
+	((ME_Reference *) Ref)->id = MR_current_choicepoint_id();
+").
+

extras/references/tests/Mmakefile

@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------#
-# Copyright (C) 1997-1999 The University of Melbourne.
+# Copyright (C) 1997-2000 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.
 #-----------------------------------------------------------------------------#
@@ -26,7 +26,7 @@ C2INITARGS = ../global.init
 
 #-----------------------------------------------------------------------------#
 
-PROGS	=	ref_test
+PROGS	=	ref_test glob_test
 
 DEPENDS =	$(PROGS:%=%.depend)
 CS	=	$(PROGS:%=%.c)

extras/references/tests/glob_test.exp

@@ -0,0 +1,10 @@
+Initial value of $Optimise: yes
+Setting $Optimise to `no'.
+New value of $Optimise: no
+Setting $Optimise to `yes' in failing branch.
+New value of $Optimise: no
+Initial value of $TargetLang: sicstus
+Setting $TargetLang to `mercury'.
+New value of $TargetLang: mercury
+Setting $TargetLang to `sicstus' in failing branch.
+New value of $TargetLang: sicstus

extras/references/tests/glob_test.m

@@ -0,0 +1,132 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1999-2000 Monash University, University of Melbourne &
+% KU Leuven.
+% 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.
+%-----------------------------------------------------------------------------%
+
+% Module to test "statically" allocated references.
+% This code is adapted from output of the HAL compiler.
+% Main author: wharvey@cs.monash.edu.au (Warwick Harvey)
+
+:- module glob_test.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module std_util.
+:- import_module list.
+:- import_module require.
+:- import_module io.
+:- import_module reference.
+:- import_module nb_reference.
+
+:- type yesno ---> yes ; no.
+:- type target_lang  ---> mercury ; sicstus.
+
+:- func glob_Optimise = reference(yesno).
+:- func glob_TargetLang = nb_reference(target_lang).
+
+
+
+:- func glob_var_init_Optimise_mode_proc_1=yesno.
+:- mode glob_var_init_Optimise_mode_proc_1=out is det.
+
+:- func glob_var_init_TargetLang_mode_proc_1=target_lang.
+:- mode glob_var_init_TargetLang_mode_proc_1=out is det.
+
+
+:- implementation.
+
+:- pragma c_header_code("
+#include ""c_reference.h""
+extern ME_Reference HAL_glob_Optimise;
+extern ME_NbReference HAL_glob_TargetLang;
+").
+
+:- pragma c_code("
+ME_Reference HAL_glob_Optimise;
+ME_NbReference HAL_glob_TargetLang;
+").
+
+:- pragma c_code(glob_Optimise = (X::out), will_not_call_mercury, "
+	X = (Word) &HAL_glob_Optimise;
+").
+
+:- pragma c_code(glob_TargetLang = (X::out), will_not_call_mercury, "
+	X = (Word) &HAL_glob_TargetLang;
+").
+
+:- impure pred glob_var_init is det.
+
+glob_var_init :-
+        =(ResultTargetLang,glob_var_init_TargetLang_mode_proc_1),
+        impure (init(glob_TargetLang,ResultTargetLang)),
+        =(ResultOptimise,glob_var_init_Optimise_mode_proc_1),
+        impure (init(glob_Optimise,ResultOptimise)).
+
+% :- func glob_var_init_Optimise_mode_proc_1=yesno.
+% :- mode glob_var_init_Optimise_mode_proc_1=out is det.
+
+=(glob_var_init_Optimise_mode_proc_1,Y76) :-
+        =(Y76,yes).
+
+% :- func glob_var_init_TargetLang_mode_proc_1=glob:target_lang.
+% :- mode glob_var_init_TargetLang_mode_proc_1=out is det.
+
+=(glob_var_init_TargetLang_mode_proc_1,Y76) :-
+        =(Y76,sicstus).
+
+
+:- pragma promise_pure(main/2).
+
+main -->
+	{ impure glob_var_init },
+        { semipure value(glob_Optimise, Opt0) },
+	io__write_string("Initial value of $Optimise: "),
+	io__write(Opt0),
+	nl,
+	io__write_string("Setting $Optimise to `no'.\n"),
+        { impure update(glob_Optimise, no) },
+        { semipure value(glob_Optimise, Opt1) },
+	io__write_string("New value of $Optimise: "),
+	io__write(Opt1),
+	nl,
+	io__write_string("Setting $Optimise to `yes' in failing branch.\n"),
+	{
+		impure update(glob_Optimise, yes),
+		fail
+	;
+		true
+	},
+        { semipure value(glob_Optimise, Opt2) },
+	io__write_string("New value of $Optimise: "),
+	io__write(Opt2),
+	nl,
+	{ semipure value(glob_TargetLang, Lang0) },
+	io__write_string("Initial value of $TargetLang: "),
+	io__write(Lang0),
+	nl,
+	io__write_string("Setting $TargetLang to `mercury'.\n"),
+	{ impure update(glob_TargetLang, mercury) },
+	{ semipure value(glob_TargetLang, Lang1) },
+	io__write_string("New value of $TargetLang: "),
+	io__write(Lang1),
+	nl,
+	io__write_string("Setting $TargetLang to `sicstus' in failing branch.\n"),
+	{
+		impure update(glob_TargetLang, sicstus),
+		fail
+	;
+		true
+	},
+	{ semipure value(glob_TargetLang, Lang2) },
+	io__write_string("New value of $TargetLang: "),
+	io__write(Lang2),
+	nl.
+