[m-dev.] For review: add support for statically-allocated reference types
Warwick Harvey
wharvey at cs.monash.edu.au
Mon Jan 24 17:40:41 AEDT 2000
Estimated hours taken: unknown (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'.
Index: README
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/references/README,v
retrieving revision 1.2
diff -u -r1.2 README
--- README 1999/11/18 05:44:56 1.2
+++ README 2000/01/24 05:53:30
@@ -18,6 +18,9 @@
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 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
Index: nb_reference.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/references/nb_reference.m,v
retrieving revision 1.1
diff -u -r1.1 nb_reference.m
--- nb_reference.m 1998/06/18 04:30:24 1.1
+++ nb_reference.m 2000/01/24 05:53:30
@@ -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""").
@@ -84,4 +87,21 @@
restore_transient_registers();
#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).
Index: reference.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/references/reference.m,v
retrieving revision 1.2
diff -u -r1.2 reference.m
--- reference.m 1999/11/18 05:44:56 1.2
+++ reference.m 2000/01/24 05:53:30
@@ -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();
+").
+
Index: tests/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/references/tests/Mmakefile,v
retrieving revision 1.3
diff -u -r1.3 Mmakefile
--- tests/Mmakefile 1999/09/16 04:46:16 1.3
+++ tests/Mmakefile 2000/01/24 05:53:30
@@ -26,7 +26,7 @@
#-----------------------------------------------------------------------------#
-PROGS = ref_test
+PROGS = ref_test glob_test
DEPENDS = $(PROGS:%=%.depend)
CS = $(PROGS:%=%.c)
===================================================================
New file: c_reference.h
/*
** 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 */
===================================================================
New file: tests/glob_test.m
%-----------------------------------------------------------------------------%
% 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 at 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.
===================================================================
New file: tests/glob_test.exp
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
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list