[mercury-users] Destructive map_replace

[Michael Day]

Here is a C implementation of map_replace, changed to return a boolean 
result instead of a maybe, to simplify the C code and reduce allocation:

:- pred replace_foo(string, list(string), bool).
:- mode replace_foo(ui, uo, out) is det.

replace_foo(X, Xs, Res) :-
     ( if X = "foo" then
         copy(["bar"], Xs),
         Res = yes
     else
         Xs = [],
         Res = no
     ).

:- pred call_pred(pred(T, list(T), bool), T, list(T), bool).
:- mode call_pred(in(pred(ui, uo, out) is det), ui, uo, out) is det.

call_pred(Pred, X, Xs, Res) :- Pred(X, Xs, Res).

:- pragma foreign_export(c, call_pred(in(pred(ui, uo, out) is det), ui, 
uo, out), "call_pred").

:- pred map_replace(pred(T, list(T), bool), list(T), list(T)).
:- mode map_replace(in(pred(ui, uo, out) is det), di, uo) is det.

:- pragma foreign_proc(c,
         map_replace(Pred::in(pred(ui, uo, out) is det), Xs::di, Ys::uo),
         [will_not_call_mercury, thread_safe, promise_pure], "
     {
         MR_Word *AddrOfPrev;

         Ys = Xs;
         AddrOfPrev = &Ys;

         while (!MR_list_is_empty(Xs))
         {
             MR_Integer X = (MR_Integer) MR_list_head(Xs);
             MR_Word Xs0 = (MR_Word) MR_list_tail(Xs);
             MR_Word NewXs;
             MR_Word Res;
             MR_Word Fake;

             call_pred(Fake, Pred, X, &NewXs, &Res);

             if (Res != 0)
             {
                 if (MR_list_is_empty(NewXs))
                 {
                     *AddrOfPrev = Xs0;
                 }
                 else
                 {
                     *AddrOfPrev = NewXs;

                     do
                     {
                         Xs = NewXs;
                         NewXs = (MR_Word) MR_list_tail(NewXs);
                     }
                     while (!MR_list_is_empty(NewXs));

                     MR_list_tail(Xs) = Xs0;

                     AddrOfPrev = &(MR_list_tail(Xs));
                 }
             }
             else
             {
                 AddrOfPrev = &(MR_list_tail(Xs));
             }

             Xs = Xs0;
         }
     }
").

One question: I'm passing a fake type info to call_pred, and nothing 
seems to go wrong yet, but I feel guilty. Should I be?

Cheers,

Michael

-- 
Print XML with Prince!
http://www.princexml.com
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------