mercury/library/store.m

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1994-1997, 2000-2008, 2010-2011 The University of Melbourne.
% Copyright (C) 2013-2022, 2025-2026 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: store.m.
% Main author: fjh.
% Stability: medium.
%
% This file provides facilities for manipulating mutable stores.
% A store can be considered a mapping from abstract keys to their values.
% A store holds a set of nodes, each of which may contain a value of any
% type.
%
% Stores may be used to implement cyclic data structures such as circular
% linked lists, etc.
%
% Stores can have two different sorts of keys:
% mutable variables (mutvars) and references (refs).
% The difference between mutvars and refs is that mutvars can only be updated
% atomically, whereas it is possible to update individual fields of a
% reference one at a time (presuming the reference refers to a structured
% term).
%
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- module store.
:- interface.

:- import_module io.

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

    % Stores and keys are indexed by a type S of typeclass store(S) that
    % is used to distinguish between different stores. By using an
    % existential type declaration for `init'/1 (see below), we use the
    % type system to ensure at compile time that you never attempt to use
    % a key from one store to access a different store.
    %
:- typeclass store(T) where [].
:- type store(S).

:- instance store(io).
:- instance store(store(S)).

    % Initialize a new store.
    %
:- some [S] pred init(store(S)::uo) is det.

%---------------------------------------------------------------------------%
%
% Mutvars.
%

    % generic_mutvar(T, S):
    % A mutable variable holding a value of type T in store S.
    %
    % The mutable variable interface is inherently not thread-safe.
    % It is the programmer's responsibility to synchronise accesses to a
    % mutable variable from multiple threads where that is possible,
    % namely variables attached to the I/O state.
    %
:- type generic_mutvar(T, S).
:- type io_mutvar(T) == generic_mutvar(T, io).
:- type store_mutvar(T, S) == generic_mutvar(T, store(S)).

    % Create a new mutable variable, initialized with the specified value.
    %
:- pred new_mutvar(T::in, generic_mutvar(T, S)::out, S::di, S::uo)
    is det <= store(S).

    % copy_mutvar(OldMutvar, NewMutvar, S0, S) is equivalent to the sequence
    %   get_mutvar(OldMutvar, Value, S0, S1),
    %   new_mutvar(Value, NewMutvar, S1, S)
    %
:- pred copy_mutvar(generic_mutvar(T, S)::in, generic_mutvar(T, S)::out,
    S::di, S::uo) is det <= store(S).

    % Lookup the value stored in a given mutable variable.
    %
:- pred get_mutvar(generic_mutvar(T, S)::in, T::out,
    S::di, S::uo) is det <= store(S).

    % Replace the value stored in a given mutable variable.
    %
:- pred set_mutvar(generic_mutvar(T, S)::in, T::in,
    S::di, S::uo) is det <= store(S).

    % new_cyclic_mutvar(Func, Mutvar, !S):
    %
    % Create a new mutable variable, whose value is initialized with the value
    % returned from the specified function Func. The argument passed to the
    % function is the mutvar itself, whose value has not yet been initialized
    % (this is safe because the function does not get passed the store, so it
    % cannot examine the uninitialized value).
    %
    % This predicate is useful for creating self-referential values such as
    % circular linked lists. For example:
    %
    %   :- type clist(T, S)
    %       --->    node(T, generic_mutvar(clist(T, S), S)).
    %
    %   :- pred init_cl(T::in, clist(T, S)::out, S::di, S::uo)
    %       is det <= store(S).
    %
    %   init_cl(X, CList, !Store) :-
    %       new_cyclic_mutvar(func(CL) = node(X, CL), CListVar, !Store),
    %       get_mutvar(CListVar, CList, !Store).
    %
:- pred new_cyclic_mutvar((func(generic_mutvar(T, S)) = T)::in,
    generic_mutvar(T, S)::out, S::di, S::uo) is det <= store(S).

%---------------------------------------------------------------------------%
%
% References.
%

    % generic_ref(T, S):
    %
    % A reference to value of type T in store S.
    %
    % The reference interface is inherently not thread-safe.
    % It is the programmer's responsibility to synchronise accesses to a
    % reference from multiple threads where that is possible,
    % namely references attached to the I/O state.
    %
:- type generic_ref(T, S).
:- type io_ref(T, S) == generic_ref(T, io).
:- type store_ref(T, S) == generic_ref(T, store(S)).

    % new_ref(Val, Ref):
    %   /* In C: Ref = malloc(...); *Ref = Val; */
    %
    % Given a value of any type T, insert a copy of the term
    % into the store and return a new reference to that term.
    % (This does not actually perform a copy, it just returns a view
    % of the representation of that value.
    % It does however allocate one cell to hold the reference;
    % you can use new_arg_ref to avoid that.)
    %
:- pred new_ref(T::di, generic_ref(T, S)::out,
    S::di, S::uo) is det <= store(S).

    % ref_functor(Ref, Functor, Arity):
    %
    % Given a reference to a term, return the functor and arity of that term.
    %
:- pred ref_functor(generic_ref(T, S)::in, string::out, int::out,
    S::di, S::uo) is det <= store(S).

    % arg_ref(Ref, ArgNum, ArgRef):
    %   /* Pseudo-C code: ArgRef = &Ref[ArgNum]; */
    %
    % Given a reference to a term, return a reference to
    % the specified argument (field) of that term
    % (argument numbers start from zero).
    % It is an error if the argument number is out of range,
    % or if the argument reference has the wrong type.
    %
:- pred arg_ref(generic_ref(T, S)::in, int::in,
    generic_ref(ArgT, S)::out, S::di, S::uo) is det <= store(S).

    % new_arg_ref(Val, ArgNum, ArgRef):
    %   /* Pseudo-C code: ArgRef = &Val[ArgNum]; */
    %
    % Equivalent to `new_ref(Val, Ref), arg_ref(Ref, ArgNum, ArgRef)',
    % except that it is more efficient.
    % It is an error if the argument number is out of range,
    % or if the argument reference has the wrong type.
    %
:- pred new_arg_ref(T::di, int::in, generic_ref(ArgT, S)::out,
    S::di, S::uo) is det <= store(S).

    % set_ref(Ref, ValueRef):
    %   /* Pseudo-C code: *Ref = *ValueRef; */
    %
    % Given a reference to a term (Ref),
    % a reference to another term (ValueRef),
    % update the store so that the term referred to by Ref
    % is replaced with the term referenced by ValueRef.
    %
:- pred set_ref(generic_ref(T, S)::in, generic_ref(T, S)::in,
    S::di, S::uo) is det <= store(S).

    % set_ref_value(Ref, Value):
    %   /* Pseudo-C code: *Ref = Value; */
    %
    % Given a reference to a term (Ref), and a value (Value),
    % update the store so that the term referred to by Ref
    % is replaced with Value.
    %
:- pred set_ref_value(generic_ref(T, S)::in, T::di,
    S::di, S::uo) is det <= store(S).

    % Given a reference to a term, return that term.
    % Note that this requires making a copy, so this pred may
    % be inefficient if used to return large terms; it
    % is most efficient with atomic terms.
    % XXX current implementation buggy (does shallow copy)
    %
:- pred copy_ref_value(generic_ref(T, S)::in, T::uo,
    S::di, S::uo) is det <= store(S).

    % Same as above, but without making a copy. Destroys the store.
    %
:- pred extract_ref_value(S::di, generic_ref(T, S)::in, T::out)
    is det <= store(S).

%---------------------------------------------------------------------------%
%
% Nasty unsafe performance hacks.
%
% WARNING: any use of these procedures is dangerous!
% Use them only as a last resort, only if performance is critical, and
% only if profiling shows that using the safe versions is a bottleneck.
%
% These procedures may vanish in some future version of Mercury.
%

    % unsafe_arg_ref is the same as arg_ref,
    % and unsafe_new_arg_ref is the same as new_arg_ref
    % except that
    %
    % - they do not check for errors,
    % - they do not work for no_tag types (types with exactly one functor
    %   which has exactly one argument),
    % - they do not work for arguments which occupy a word
    %   with other arguments, and
    % - they do not work for types with >4 functors.
    %
    % If the argument number is out of range,
    % or if the argument reference has the wrong type,
    % or if the argument is a no_tag type,
    % or if the argument uses a packed representation,
    % then the behaviour is undefined, and probably harmful.

:- pred unsafe_arg_ref(generic_ref(T, S)::in, int::in,
    generic_ref(ArgT, S)::out, S::di, S::uo) is det <= store(S).

:- pred unsafe_new_arg_ref(T::di, int::in, generic_ref(ArgT, S)::out,
    S::di, S::uo) is det <= store(S).

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

:- implementation.

:- import_module deconstruct.
:- import_module require.

:- instance store(store(S)) where [].
:- instance store(io) where [].

% The store type itself is just a dummy type,
% with no real representation.

:- pragma foreign_type("C", store(S), "MR_Word", [can_pass_as_mercury_type])
    where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("C#", store(S), "int", [can_pass_as_mercury_type])
    where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("Java", store(S), "int", [can_pass_as_mercury_type])
    where equality is store_equal, comparison is store_compare.

:- pred store_equal(store(S)::in, store(S)::in) is semidet.

:- pragma no_determinism_warning(pred(store_equal/2)).
store_equal(_, _) :-
    error("attempt to unify two stores").

:- pred store_compare(comparison_result::uo, store(S)::in, store(S)::in)
    is det.

:- pragma no_determinism_warning(pred(store_compare/3)).
store_compare(_, _, _) :-
    error("attempt to compare two stores").

    % Mutvars and references are each represented as a pointer
    % to a single word on the heap.
:- type generic_mutvar(T, S)
    --->    mutvar(private_builtin.ref(T)).
:- type generic_ref(T, S)
    --->    ref(private_builtin.ref(T)).

init(S) :-
    store.do_init(S).

:- some [S] pred do_init(store(S)::uo) is det.

:- pragma foreign_proc("C",
    do_init(_S0::uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    TypeInfo_for_S = 0;
").
:- pragma foreign_proc("C#",
    do_init(_S0::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    TypeInfo_for_S = null;
").
:- pragma foreign_proc("Java",
    do_init(_S0::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    TypeInfo_for_S = null;
").

% Note -- the syntax for the operations on stores
% might be nicer if we used some new operators, e.g.
%
%   :- op(.., xfx, ('<-')).
%   :- op(.., fy, ('!')).
%   :- op(.., xfx, (':=')).
%
% Then we could do something like this:
%
%   Ptr <- new(Val) -->   new_mutvar(Val, Ptr).
%   Val <- !Ptr     -->   get_mutvar(Ptr, Val).
%   !Ptr := Val     -->   set_mutvar(Ptr, Val).
%
% I wonder whether it is worth it? Hmm, probably not.

:- pragma foreign_type("C#", generic_mutvar(T, S), "object[]").
:- pragma foreign_type("Java", generic_mutvar(T, S), "mutvar.Mutvar").

:- pragma foreign_proc("C",
    new_mutvar(Val::in, Mutvar::out, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    MR_offset_incr_hp_msg(Mutvar, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
        MR_ALLOC_ID, ""store.mutvar/2"");
    MR_define_size_slot(0, Mutvar, 1);
    * (MR_Word *) Mutvar = Val;
    S = S0;
").
:- pragma foreign_proc("C#",
    new_mutvar(Val::in, Mutvar::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Mutvar = new object[] { Val };
").
:- pragma foreign_proc("Java",
    new_mutvar(Val::in, Mutvar::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Mutvar = new mutvar.Mutvar(Val);
").

:- pragma foreign_proc("C",
    get_mutvar(Mutvar::in, Val::out, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    Val = * (MR_Word *) Mutvar;
    S = S0;
").
:- pragma foreign_proc("C#",
    get_mutvar(Mutvar::in, Val::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Val = Mutvar[0];
").
:- pragma foreign_proc("Java",
    get_mutvar(Mutvar::in, Val::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Val = Mutvar.object;
").

:- pragma foreign_proc("C",
    set_mutvar(Mutvar::in, Val::in, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    * (MR_Word *) Mutvar = Val;
    S = S0;
").
:- pragma foreign_proc("C#",
    set_mutvar(Mutvar::in, Val::in, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Mutvar[0] = Val;
").
:- pragma foreign_proc("Java",
    set_mutvar(Mutvar::in, Val::in, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Mutvar.object = Val;
").

copy_mutvar(Mutvar, Copy, !S) :-
    get_mutvar(Mutvar, Value, !S),
    new_mutvar(Value, Copy, !S).

:- pred unsafe_new_uninitialized_mutvar(generic_mutvar(T, S)::out,
    S::di, S::uo) is det <= store(S).

:- pragma foreign_proc("C",
    unsafe_new_uninitialized_mutvar(Mutvar::out, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    MR_offset_incr_hp_msg(Mutvar, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
        MR_ALLOC_ID, ""store.mutvar/2"");
    MR_define_size_slot(0, Mutvar, 1);
    S = S0;
").

:- pragma foreign_proc("C#",
    unsafe_new_uninitialized_mutvar(Mutvar::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Mutvar = new object[1];
").

:- pragma foreign_proc("Java",
    unsafe_new_uninitialized_mutvar(Mutvar::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Mutvar = new mutvar.Mutvar();
").

new_cyclic_mutvar(Func, MutVar, !Store) :-
    store.unsafe_new_uninitialized_mutvar(MutVar, !Store),
    Value = apply(Func, MutVar),
    store.set_mutvar(MutVar, Value, !Store).

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

:- pragma foreign_type("C#", generic_ref(T, S), "store.Ref").
:- pragma foreign_code("C#",
"
    public class Ref {
        // Object referenced.
        public object   obj;

        // Specific field of object referenced, or null to
        // specify the object itself.
        // XXX GetFields does not return fields in any particular order so
        // this is not really usable.
        public System.Reflection.FieldInfo  field;

        // Constructors
        public Ref(object init) {
            obj     = init;
            field   = null;
        }
        public Ref(object init, int num) {
            obj = init;
            setField(num);
        }

        // Set the field according to a given index.
        public void setField(int num) {
            field = obj.GetType().GetFields()[num];
        }

        // Return the value of the reference.
        public object getValue() {
            if (field == null) {
                return obj;
            } else {
                return field.GetValue(obj);
            }
        }

        // Update the value of the reference.
        public void setValue(object value) {
            field.SetValue(obj, value);
        }
    } // class Ref
").

:- pragma foreign_type(java, generic_ref(T, S), "store.Ref").
:- pragma foreign_code("Java",
"
    public static class Ref {
        // Object referenced.
        public java.lang.Object         object;

        // Specific field of object referenced, or null to
        // specify the object itself.
        // XXX getDeclaredFields does not return fields in any particular
        // order so this is not really usable.
        public java.lang.reflect.Field  field;

        // Constructors
        public Ref(java.lang.Object init) {
            object  = init;
            field   = null;
        }
        public Ref(java.lang.Object init, int num) {
            object  = init;
            setField(num);
        }

        // Set the field according to a given index.
        public void setField(int num) {
            try {
                field = object.getClass().getDeclaredFields()[num];
            } catch (java.lang.SecurityException se) {
                throw new java.lang.RuntimeException(
                    ""Security manager denied access to object fields"");
            } catch (java.lang.ArrayIndexOutOfBoundsException e) {
                throw new java.lang.RuntimeException(
                    ""No such field in object"");
            } catch (java.lang.Exception e) {
                throw new java.lang.RuntimeException(
                    ""Unable to set field: "" + e.getMessage());
            }
        }

        // Return the value of the reference.
        public java.lang.Object getValue() {
            if (field == null) {
                return object;
            } else {
                try {
                    return field.get(object);
                } catch (java.lang.IllegalAccessException e) {
                    throw new java.lang.RuntimeException(
                        ""Field inaccessible"");
                } catch (java.lang.IllegalArgumentException e)
                {
                    throw new java.lang.RuntimeException(
                        ""Field-object mismatch"");
                } catch (java.lang.NullPointerException e) {
                    throw new java.lang.RuntimeException(
                        ""Object is null"");
                } catch (java.lang.Exception e) {
                    throw new java.lang.RuntimeException(
                        ""Unable to access field: "" + e.getMessage());
                }
            }
        }

        // Update the value of the reference.
        public void setValue(java.lang.Object value) {
            try {
                field.set(object, value);
            } catch (java.lang.IllegalAccessException e) {
                throw new java.lang.RuntimeException(""Field inaccessible"");
            } catch (java.lang.IllegalArgumentException e) {
                throw new java.lang.RuntimeException(
                    ""Field-object mismatch"");
            } catch (java.lang.NullPointerException e) {
                throw new java.lang.RuntimeException(""Object is null"");
            } catch (java.lang.Exception e) {
                throw new java.lang.RuntimeException(
                        ""Unable to access field: "" + e.getMessage());
            }
        }
    } // class Ref
").

:- pragma foreign_proc("C",
    new_ref(Val::di, Ref::out, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    MR_offset_incr_hp_msg(Ref, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
        MR_ALLOC_ID, ""store.ref/2"");
    MR_define_size_slot(0, Ref, 1);
    * (MR_Word *) Ref = Val;
    S = S0;
").

:- pragma foreign_proc("C#",
    new_ref(Val::di, Ref::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Ref = new store.Ref(Val);
").

:- pragma foreign_proc("Java",
    new_ref(Val::di, Ref::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Ref = new store.Ref(Val);
").

ref_functor(Ref, Functor, Arity, !Store) :-
    unsafe_ref_value(Ref, Val, !Store),
    functor(Val, canonicalize, Functor, Arity).

copy_ref_value(Ref, Val) -->
    % XXX Need to deep-copy non-atomic types.
    unsafe_ref_value(Ref, Val).

    % Unsafe_ref_value extracts the value that a reference refers to, without
    % making a copy; it is unsafe because the store could later be modified,
    % changing the returned value.
    %
:- pred unsafe_ref_value(generic_ref(T, S)::in, T::uo, S::di, S::uo) is det
    <= store(S).

:- pragma foreign_proc("C",
    unsafe_ref_value(Ref::in, Val::uo, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
    Val = * (MR_Word *) Ref;
    S = S0;
").

:- pragma foreign_proc("C#",
    unsafe_ref_value(Ref::in, Val::uo, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Val = Ref.getValue();
").

:- pragma foreign_proc("Java",
    unsafe_ref_value(Ref::in, Val::uo, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Val = Ref.getValue();
").

:- pragma foreign_decl("C",
"
    #include ""mercury_type_info.h""
    #include ""mercury_heap.h""
    #include ""mercury_misc.h""         // for MR_fatal_error()
    #include ""mercury_deconstruct.h""  // for MR_arg()
").

:- pragma foreign_proc("C",
    arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
"{
    MR_TypeInfo         type_info;
    MR_TypeInfo         arg_type_info;
    MR_TypeInfo         exp_arg_type_info;
    MR_Word             arg_value;
    MR_Word             *word_sized_arg_ptr;

    type_info = (MR_TypeInfo) TypeInfo_for_T;
    exp_arg_type_info = (MR_TypeInfo) TypeInfo_for_ArgT;

    MR_save_transient_registers();

    if (!MR_arg(type_info, (MR_Word *) Ref, MR_NONCANON_ABORT, ArgNum,
        &arg_type_info, &arg_value, &word_sized_arg_ptr))
    {
        MR_fatal_error(""store.arg_ref: argument number out of range"");
    }

    if (MR_compare_type_info(arg_type_info, exp_arg_type_info) !=
        MR_COMPARE_EQUAL)
    {
        MR_fatal_error(""store.arg_ref: argument has wrong type"");
    }

    MR_restore_transient_registers();

    if (word_sized_arg_ptr == NULL) {
        MR_offset_incr_hp_msg(ArgRef, MR_SIZE_SLOT_SIZE,
            MR_SIZE_SLOT_SIZE + 1, MR_ALLOC_ID, ""store.ref/2"");
        MR_define_size_slot(0, ArgRef, 1);
        * (MR_Word *) ArgRef = arg_value;
    } else {
        ArgRef = (MR_Word) word_sized_arg_ptr;
    }
    S = S0;
}").

:- pragma foreign_proc("C#",
    arg_ref(Ref::in, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    // XXX Some dynamic type-checking should be done here to check that
    // the type of the specified Arg matches the type supplied by the caller.
    // This will require RTTI.

    ArgRef = new store.Ref(Ref.getValue(), ArgNum);
").

:- pragma foreign_proc("Java",
    arg_ref(Ref::in, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    // XXX Some dynamic type-checking should be done here to check that
    // the type of the specified Arg matches the type supplied by the caller.
    // This will require RTTI.

    ArgRef = new store.Ref(Ref.getValue(), ArgNum);
").

:- pragma foreign_proc("C",
    new_arg_ref(Val::di, ArgNum::in, ArgRef::out, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
"{
    MR_TypeInfo         type_info;
    MR_TypeInfo         arg_type_info;
    MR_TypeInfo         exp_arg_type_info;
    MR_Word             arg_value;
    MR_Word             *word_sized_arg_ptr;

    type_info = (MR_TypeInfo) TypeInfo_for_T;
    exp_arg_type_info = (MR_TypeInfo) TypeInfo_for_ArgT;

    MR_save_transient_registers();

    if (!MR_arg(type_info, (MR_Word *) &Val, MR_NONCANON_ABORT, ArgNum,
        &arg_type_info, &arg_value, &word_sized_arg_ptr))
    {
        MR_fatal_error(""store.new_arg_ref: argument number out of range"");
    }

    if (MR_compare_type_info(arg_type_info, exp_arg_type_info) !=
        MR_COMPARE_EQUAL)
    {
        MR_fatal_error(""store.new_arg_ref: argument has wrong type"");
    }

    MR_restore_transient_registers();

    if (word_sized_arg_ptr == NULL) {
        MR_offset_incr_hp_msg(ArgRef, MR_SIZE_SLOT_SIZE,
            MR_SIZE_SLOT_SIZE + 1, MR_ALLOC_ID, ""store.ref/2"");
        MR_define_size_slot(0, ArgRef, 1);
        * (MR_Word *) ArgRef = arg_value;
    } else if (word_sized_arg_ptr == &Val) {
        // For no_tag types, the argument may have the same address as the
        // term. Since the term (Val) is currently on the C stack, we can't
        // return a pointer to it; so if that is the case, then we need
        // to copy it to the heap before returning.

        MR_offset_incr_hp_msg(ArgRef, MR_SIZE_SLOT_SIZE,
            MR_SIZE_SLOT_SIZE + 1, MR_ALLOC_ID, ""store.ref/2"");
        MR_define_size_slot(0, ArgRef, 1);
        * (MR_Word *) ArgRef = Val;
    } else {
        ArgRef = (MR_Word) word_sized_arg_ptr;
    }
    S = S0;
}").

:- pragma foreign_proc("C#",
    new_arg_ref(Val::di, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    // XXX Some dynamic type-checking should be done here to check that
    // the type of the specified Arg matches the type supplied by the caller.
    // This will require RTTI.

    ArgRef = new store.Ref(Val, ArgNum);
").

:- pragma foreign_proc("Java",
    new_arg_ref(Val::di, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    // XXX Some dynamic type-checking should be done here to check that
    // the type of the specified Arg matches the type supplied by the caller.
    // This will require RTTI.

    ArgRef = new store.Ref(Val, ArgNum);
").

:- pragma foreign_proc("C",
    set_ref(Ref::in, ValRef::in, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    * (MR_Word *) Ref = * (MR_Word *) ValRef;
    S = S0;
").

:- pragma foreign_proc("C#",
    set_ref(Ref::in, ValRef::in, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Ref.setValue(ValRef.getValue());
").

:- pragma foreign_proc("Java",
    set_ref(Ref::in, ValRef::in, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Ref.setValue(ValRef.getValue());
").

:- pragma foreign_proc("C",
    set_ref_value(Ref::in, Val::di, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    * (MR_Word *) Ref = Val;
    S = S0;
").

:- pragma foreign_proc("C#",
    set_ref_value(Ref::in, Val::di, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Ref.setValue(Val);
").

:- pragma foreign_proc("Java",
    set_ref_value(Ref::in, Val::di, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Ref.setValue(Val);
").

:- pragma foreign_proc("C",
    extract_ref_value(_S::di, Ref::in, Val::out),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Val = * (MR_Word *) Ref;
").

:- pragma foreign_proc("C#",
    extract_ref_value(_S::di, Ref::in, Val::out),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Val = Ref.getValue();
").

:- pragma foreign_proc("Java",
    extract_ref_value(_S::di, Ref::in, Val::out),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    Val = Ref.getValue();
").

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

:- pragma foreign_proc("C",
    unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"{
    // Unsafe - does not check type & arity, won't handle no_tag types.
    MR_Word *Ptr;

    Ptr = (MR_Word *) MR_strip_tag((MR_Word) Ref);
    ArgRef = (MR_Word) &Ptr[Arg];
    S = S0;
}").

:- pragma foreign_proc("C#",
    unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    ArgRef = new store.Ref(Ref.getValue(), Arg);
").

:- pragma foreign_proc("Java",
    unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    ArgRef = new store.Ref(Ref.getValue(), Arg);
").

:- pragma foreign_proc("C",
    unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, S0::di, S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"{
    // Unsafe - does not check type & arity, won't handle no_tag types.
    MR_Word *Ptr;

    Ptr = (MR_Word *) MR_strip_tag((MR_Word) Val);
    ArgRef = (MR_Word) &Ptr[Arg];
    S = S0;
}").

:- pragma foreign_proc("C#",
    unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    ArgRef = new store.Ref(Val, Arg);
").

:- pragma foreign_proc("Java",
    unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, _S0::di, _S::uo),
    [will_not_call_mercury, promise_pure, thread_safe],
"
    ArgRef = new store.Ref(Val, Arg);
").

%---------------------------------------------------------------------------%
:- end_module store.
%---------------------------------------------------------------------------%