[mercury-users] Question

[Ralph Becket]

doug.auclair at logicaltypes.com, Wednesday, 11 October 2006:
> >Anthony Lee Senyard did a PhD here at Melbourne a few years ago on just
> >this topic and used Mercury for his work.  He would be a good person to
> >talk to if you want to track him down.
> 
> Can I get in touch with Anthony and is the work available for perusal?

Anthony's University web page is
http://www.cs.mu.oz.au/~anthls/php/home.php
which should tell you how to contact him.  I don't know about the status
of his code.

> >For Anthony I implemented a special unboxed, full-precision float array
> >type which sped his programs up substantially.  I'd be happy to let you
> >have a copy.
> 
> Would you please provide me a copy as well? I will be using it immediately.

Attached, usual disclaimers of no warranty etc. apply.

> >but it has not been highly
> >optimized for floating point intensive applications.  (Of course, that
> >could change if enough users make the request...)
> 
> Even though there is not this optimization, so far Mercury has been
> more than up to the task for our needs (a floating-point enhancement
> will be icing on the cake).

As I say, on a 64 bit machine Mercury should perform about as well as
any other general purpose language in this regard.  As far as I know,
it's only the boxing issue that can affect performance on 32 bit
machines.

-- Ralph
-------------- next part --------------
%------------------------------------------------------------------------------%
% farray.m
% Ralph Becket <rbeck at microsoft.com>
% Mon Oct  8 15:20:35 EST 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
%
% Basic unboxed float array ADT.
%
%------------------------------------------------------------------------------%

:- module farray.

:- interface.

:- import_module int, float, list, string.



:- type farray.
:- inst farray == ground.               % XXX A hack: should not be public...
:- mode farray_uo == out(farray).       % XXX )
:- mode farray_ui == in(farray).        % XXX ) To be fixed when unique modes
:- mode farray_di == in(farray).        % XXX ) get sorted out.



    % new(N): a new array of N floats indexed from 0 to N-1
    % initialized to 0.0.  An exception is thrown if N is
    % negative.
    %
:- func new(int) = farray.
:- mode new(in) = farray_uo is det.

    % Construct a new farray from a list of floats.
    %
:- func farray(list(float)) = farray.
:- mode farray(in) = farray_uo is det.

    % Copy an farray.
    %
:- func copy(farray) = farray.
:- mode copy(farray_ui) = farray_uo is det.

    % Resize an farray.  Any new members are initialized to 0.0.
    % An exception is thrown if the new size is negative.
    %
:- func resize(farray, int) = farray.
:- mode resize(farray_ui, in) = farray_uo is det.

    % size(A): the number of elements in the farray A.
    %
:- func size(farray) = int.
:- mode size(farray_ui) = out is det.

    % A ^ elem(I): the element of farray A with index I.  An exception
    % is raised if I is outside the range 0..size(A).
    %
:- func elem(int, farray) = float.
:- mode elem(in, farray_ui) = out is det.

    % A version of the above that does not perform bounds checking.
    %
:- func unsafe_elem(int, farray) = float.
:- mode unsafe_elem(in, farray_ui) = out is det.

    % lookup(A, I, X): succeeds with X = A ^ elem(I) iff 0 =< I < size(A).
    %
:- pred lookup(farray, int, float).
:- mode lookup(farray_ui, in, out) is semidet.

    % A ^ elem(I) := X: the farray A destructively updated s.t.
    % element I now contains X.  An exception is thrown if I is outside
    % the range 0..size(A).
    %
:- func 'elem :='(int, farray, float) = farray.
:- mode 'elem :='(in, farray_di, in) = farray_uo is det.

    % A version of the above that does not perform bounds checking.
    %
:- func 'unsafe_elem :='(int, farray, float) = farray.
:- mode 'unsafe_elem :='(in, farray_di, in) = farray_uo is det.

    % to_str(A): a string representation of farray A.
    %
:- func to_str(farray) = string.
:- mode to_str(farray_ui) = out is det.

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

:- implementation.

:- import_module exception, string, pprint.



:- pragma foreign_decl("C",
"
    typedef struct {
        MR_Integer  size;
        MR_Float*   elem;
    } farray;

#define FARRAY(A)   ((farray *) A)
").

    % This helps avoid confusing farrays with other types defined
    % via c_pointer.
    %
:- type farray ---> farray(c_pointer).

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

new(N) = unsafe_new(N) :-
    ( if N < 0 then throw("farray__new: negative array size") else true ).



:- func unsafe_new(int::in) = (farray::farray_uo) is det.

:- pragma foreign_proc(
    "C",
    unsafe_new(N::in) = (A::farray_uo),
    [will_not_call_mercury, thread_safe],
"
    {
        int i;

        FARRAY(A)       = FARRAY(malloc(sizeof(farray)));
        FARRAY(A)->size = N;
        FARRAY(A)->elem = (MR_Float *) calloc(N, sizeof(MR_Float));

        for(i = 0; i < N; i++)
            FARRAY(A)->elem[i] = 0.0;
    }
").

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

resize(A0, N) = copy_elems(0, min(N, size(A0)), A0, farray__new(N)).



:- func copy_elems(int, int, farray, farray) = farray.
:- mode copy_elems(in, in, farray_ui, farray_di) = farray_uo is det.

copy_elems(I, Hi, A, B) =
    ( if I < Hi then copy_elems(I + 1, Hi, A, B ^ elem(I) := A ^ elem(I))
                else B
    ).

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

:- pragma foreign_proc(
    "C",
    copy(A0::farray_ui) = (A::farray_uo),
    [will_not_call_mercury, thread_safe],
"
    {
        int i;
        MR_Integer N = FARRAY(A0)->size;

        FARRAY(A)       = FARRAY(malloc(sizeof(farray)));
        FARRAY(A)->size = N;
        FARRAY(A)->elem = (MR_Float *) calloc(N, sizeof(MR_Float));

        for(i = 0; i < N; i++)
            FARRAY(A)->elem[i] = FARRAY(A0)->elem[i];
    }
").

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

farray(Xs) = assign_elems(Xs, 0, farray__new(length(Xs))).



:- func assign_elems(list(float), int, farray) = farray.
:- mode assign_elems(in, in, farray_di) = farray_uo is det.

assign_elems([],       _, A) = A.
assign_elems([X | Xs], I, A) = assign_elems(Xs, I + 1, A ^ elem(I) := X).

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

:- pragma foreign_proc(
    "C",
    size(A::farray_ui) = (N::out),
    [will_not_call_mercury, thread_safe],
"
    N = FARRAY(A)->size;
").

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

elem(I, A) = unsafe_elem(I, A) :-
    range_check("farray__elem", A, I).



:- pragma foreign_proc(
    "C",
    unsafe_elem(I::in, A::farray_ui) = (X::out),
    [will_not_call_mercury, thread_safe],
"
    X = FARRAY(A)->elem[I];
").



lookup(A, I, X) :-
    0 =< I,
    I =< size(A),
    X =  A ^ unsafe_elem(I).

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

'elem :='(I, A, X) = 'unsafe_elem :='(I, A, X) :-
    range_check("farray__'elem :='", A, I).



:- pragma foreign_proc(
    "C",
    'unsafe_elem :='(I::in, A0::farray_di, X::in) = (A::farray_uo),
    [will_not_call_mercury, thread_safe],
"
    FARRAY(A0)->elem[I] = X;
    A = A0;
").

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

:- pred range_check(string::in, farray::farray_ui, int::in) is det.

range_check(Str, A, I) :-
    ( if I < 0 ; size(A) =< I then throw(Str ++ ": index out of bounds")
                              else true
    ).

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

to_str(A) = S :-
    Xs = elems(0, A),
    S  =
        to_string(80,
            text("farray") `<>` parentheses(
                brackets(separated(to_doc, group(comma_space_line), Xs))
            )
        ).



:- func elems(int, farray) = list(float).
:- mode elems(in, farray_ui) = out is det.

elems(I, A) =
    ( if I < size(A) then [A ^ elem(I) | elems(I + 1, A)] else [] ).

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