Re: [Caml-list] @, List.append, and tail recursion

[Brian Hurt <brian.hurt@qlogic.com>]

[-- Attachment #1: Type: TEXT/PLAIN, Size: 3095 bytes --]


For short lists, this is the worst performer overall.  I whipped up a 
quick microbenchmark to compare the various implementations- the three 
implementations are included in this email.  The three programs are:

list1.ml: lappend uses the @ operator to append the list

list2.ml: uses local rev_append and rev functions (similiar to those in 
List) to append the list

list3.ml: uses Olivier's set_cdr function.

The results I saw (compiling with ocamlopt -o list list.ml on a 1.4GHz P4
running Linux and ocaml 3.06) are:

list1: 1.462s
list2: 1.757s
list3: 1.824s

List2 is about 17% slower than list1, while list3 is almost 20% slower 
than list1, and 4% slower than list2.

Brian


On Thu, 30 Jan 2003, Olivier Andrieu wrote:

>  Brian Hurt [Thursday 23 January 2003] :
>  > I hit a bug recently wiith @ and List.append.  Since they're recursive, 
>  > not tail-recursive, on long enough lists Ocaml thinks you've gone 
>  > infinitely recursive and aborts. 
> 
>  > List.append x [] ;;
>  > Exits with:
>  > Stack overflow during evaluation (looping recursion?).
>  > 
>  > So does:
>  > x @ [] ;;
> (not surprising, List.append 's definition is (@))
> 
>  > And it has occured to me that all of these forms *should* be
>  > optimizable into loops.  The general case would work something like
>  > this in C:
>  > 
>  > struct list_t {
>  >     void * datum;
>  >     struct list_t * next_p;
>  > }
>  > 
>  > struct list_t * foo (struct list_t * x) {
>  >     struct list_t * retval = NULL;
>  >     struct list_t ** ptr_pp = &retval;
>  > 
>  >     while (x != NULL) {
>  >         struct list_t * temp = alloc(sizeof(struct list_t));
>  >         *ptr_pp = temp;
>  >         temp->datum = expr(x->datum);
>  >         temp->next_p = NULL; /* be nice to the GC */
>  >         ptr_pp = &(temp->next_p);
>  >         x = x->next_p;
>  >     }
>  >     return retval;
>  > }
> 
> Well, all of this can be translated directly to caml, using the famous
> Obj module. All you need is a lispish setcdr function :
> 
> ,----
> | let setcdr : 'a list -> 'a list -> unit = fun c v -> 
> |   let c = Obj.repr c in
> |   assert(Obj.is_block c) ;
> |   Obj.set_field c 1 (Obj.repr v)
> `----
> 
> Then one can write a tail-recursive append or a tail-recursive map :
> ,----
> | let tr_append l1 l2 =
> |   let rec proc cell = function
> |     | [] ->
> | 	setcdr cell l2
> |     | x :: l -> 
> | 	let nxt = [ x ] in
> | 	setcdr cell nxt ;
> | 	proc nxt l
> |   in
> |   match l1 with
> |   | [] -> l2
> |   | x :: l ->
> |       let head = [ x ] in
> |       proc head l ;
> |       head
> | 	
> | let tr_map f l = 
> |   let rec proc cell = function
> |     | [] -> ()
> |     | x :: l -> 
> | 	let nxt = [ f x ] in
> | 	setcdr cell nxt ;
> | 	proc nxt l
> |   in
> |   match l with
> |   | [] -> [] 
> |   | x :: l ->
> |       let head = [ f x ] in
> |       proc head l ;
> |       head
> `----
> This seems safe to me, as setcdr is only called on new cons cells, so
> it shouldn't mess up the arguments.
> 
> Anyway, the hole abstraction thing is cleaner but needs compiler
> support. 
> 
> 


[-- Attachment #2: uses @ operator --]
[-- Type: TEXT/PLAIN, Size: 271 bytes --]


let lappend x y = x @ [ y ] ;;

let makelist c =
    let rec makelist_int c accum =
        if (c > 0) then
            makelist_int (c - 1) (lappend accum c)
        else 
            (lappend accum c)
in
    makelist_int c []
;;

let _ = makelist 5000;;

[-- Attachment #3: uses List.rev --]
[-- Type: TEXT/PLAIN, Size: 581 bytes --]


let rec rev_append x y =
    match x with
        [] -> y
        | h :: t -> rev_append t (h :: y)
;;

let rev x =
    let rec rev_int x accum =
        match x with
            [] -> accum
            | h :: t -> rev_int t (h :: accum)
    in
        rev_int x []
;;

let lappend x y = 
    rev_append (rev x) ( [ y ] ) ;;

let makelist c =
    let rec makelist_int c accum =
        if (c > 0) then
            makelist_int (c - 1) (lappend accum c)
        else 
            (lappend accum c)
in
    makelist_int c []
;;

let _ = makelist 5000;;

[-- Attachment #4: uses Olivier's set_cdr --]
[-- Type: TEXT/PLAIN, Size: 778 bytes --]



let setcdr : 'a list -> 'a list -> unit = fun c v -> 
    let c = Obj.repr c in
    assert(Obj.is_block c) ;
    Obj.set_field c 1 (Obj.repr v)
;;

let lappend l1 l2 =
    let rec proc cell = function
        | [] ->
            setcdr cell l2
        | x :: l -> 
            let nxt = [ x ] in
                setcdr cell nxt ;
                proc nxt l
    in
    match l1 with
        | [] -> l2
        | x :: l ->
            let head = [ x ] in
                proc head l ;
                head
;;

let makelist c =
    let rec makelist_int c accum =
        if (c > 0) then
            makelist_int (c - 1) (lappend accum [ c ])
        else 
            (lappend accum [ c ])
in
    makelist_int c []
;;

let _ = makelist 5000;;