[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