[mercury-users] Destructive list operations

[Mark Brown]

Hi Michael,

On 04-Jan-2009, Michael Day <mikeday at yeslogic.com> wrote:
> Ideally, the standard library would include a version of map that updated 
> the list in place to reuse the list skeleton, and the compiler could 
> specialise it for the given function and avoid touching the list at all in 
> the common case where no change is necessary. But since we do not yet live 
> in such a declarative nirvana, is it possible to write a predicate by hand 
> that does this?

It is indeed possible to do this in Mercury using the store module.  Below
are two functions that destructively update the head/tail of a non-empty
list, re-using the cons cell of the original.  These could be used to
implement destructively updating versions of list.append and list.map,
among other things.

Note that this still has the problem with static data that you mentioned
earlier.

Cheers,
Mark.


:- module s.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.

:- import_module exception.
:- import_module list.
:- import_module store.
:- import_module string.

    % Update the head of a non-empty list.  Throws an exception if the list
    % is empty.
    %
:- func update_head(list(T), T) = list(T).
:- mode update_head(di, di) = uo is det.

update_head(Xs0, NewHead) = Xs :-
    some [!S] (
        store.new(!:S),
        store.new_ref(Xs0, Ref, !S),
        store.ref_functor(Ref, _, Arity, !S),
        ( if Arity = 2 then
            % Argument numbers start from 0.
            HeadArgNum = 0,
            store.arg_ref(Ref, HeadArgNum, HeadRef, !S),
            store.set_ref_value(HeadRef, NewHead, !S)
        else
            % This is the empty list
            throw("update_head: empty list cannot be updated")
        ),
        store.extract_ref_value(!.S, Ref, Xs1),
        % We didn't do anything tricky with the reference, so Xs1 is unique
        % just as Xs0 and NewHead were.
        Xs = unsafe_promise_unique(Xs1)
    ).

    % Update the tail of a non-empty list.  Throws an exception if the list
    % is empty.
    %
:- func update_tail(list(T), list(T)) = list(T).
:- mode update_tail(di, di) = uo is det.

update_tail(Xs0, NewTail) = Xs :-
    some [!S] (
        store.new(!:S),
        store.new_ref(Xs0, Ref, !S),
        store.ref_functor(Ref, _, Arity, !S),
        ( if Arity = 2 then
            % Argument numbers start from 0.
            TailArgNum = 1,
            store.arg_ref(Ref, TailArgNum, TailRef, !S),
            store.set_ref_value(TailRef, NewTail, !S)
        else
            % This is the empty list
            throw("update_tail: empty list cannot be updated")
        ),
        store.extract_ref_value(!.S, Ref, Xs1),
        % We didn't do anything tricky with the reference, so Xs1 is unique
        % just as Xs0 and NewTail were.
        Xs = unsafe_promise_unique(Xs1)
    ).

/*

The code below (compiled with default optimisation) outputs something like the
following.  Note that append creates a new cons cell, but update_head and
update_tail don't.  The exception at the end comes from the incorrect use of
update_head on the empty list.

(0x804d251)  [1, 2, 3]
(0x8116ef9)  [1, 2, 3, 4, 5]
(0x8116ef9)  [-42, 2, 3, 4, 5]
(0x8116ef9)  [-42, 123]
Uncaught Mercury exception:
"update_head: empty list cannot be updated"
Stack dump not available in this grade.

*/


main(!IO) :-
    Xs0 = [1, 2, 3],
    test_output(Xs0, !IO),
    append(Xs0, [4, 5], Xs1),
    test_output(Xs1, !IO),
    Xs2 = update_head(Xs1, -42),
    test_output(Xs2, !IO),
    Xs = update_tail(Xs2, [123]),
    test_output(Xs, !IO),

    % BAD:
    Ys = update_head([], 4),
    test_output(Ys, !IO).

:- pred test_output(T::ui, io::di, io::uo) is det.

test_output(T, !IO) :-
    unsafe_peek_inside(T, Cell, Value),
    io.format("(%p)  ", [i(Cell)], !IO),
    io.write(Value, !IO),
    io.nl(!IO).

    % This is just so we can show which cells are re-used.
    %
:- pred unsafe_peek_inside(T::ui, int::out, T::out) is det.

:- pragma foreign_proc("C",
    unsafe_peek_inside(T::ui, Cell::out, Value::out),
    [promise_pure, will_not_call_mercury, will_not_modify_trail],
"
    Cell = (MR_Integer) T;
    Value = T;
").

--------------------------------------------------------------------------
mercury-users mailing list
Post messages to:       mercury-users at csse.unimelb.edu.au
Administrative Queries: owner-mercury-users at csse.unimelb.edu.au
Subscriptions:          mercury-users-request at csse.unimelb.edu.au
--------------------------------------------------------------------------