\ -*- mode: forth -*-
\ $Id: lists.bigforth,v 1.1 2001/06/19 16:20:46 doug Exp $
\ http://www.bagley.org/~doug/shootout/
\ from Anton Ertl

0. argc @ 1- arg >number 2drop drop constant NUM

10000 constant SIZE

struct
    cell% field list-next
    cell% field list-val
end-struct list%

: make-list 
    0 0 SIZE -do 
    list% %alloc
    i over list-val !
    tuck list-next !
    1 -loop
;

: copy-list 
    0 { w^ list2 }
    list2 begin 
    over
    while
    list% %alloc dup >r swap ! 
    dup list-val @ r@ list-val !
    list-next @ r> list-next 
    repeat
    off drop list2 @ ;

: move-head-to-tail 
    \ somehow this is an expensive noop
    0 { w^ list2 }
    list2 begin 
    over
    while
    \ move one element
    over list-next dup @ 2>r 
    over list-next off
    ! r> r>
    repeat
    off drop list2 @ ;

: nreverse 
    \ destructive reverse
    0 swap begin 
    dup
    while
    dup list-next @ >r 
    tuck list-next ! r> 
    repeat
    drop ;

: move-tail-to-tail 
    \ use head-to-tail instead of head-to-head nreverse
    nreverse move-head-to-tail ;

: list-equals 
    begin 
    dup
    while
    over
    while
    over list-val @ over list-val @ <> if
        2drop false exit
    endif
    list-next @ swap list-next @ 
    repeat then
    = ;

: list-length 
    0 begin 
    over
    while
    1+ swap list-next @ swap
    repeat
    nip ;

s" wrong result" exception constant wrong-result

: main 
    0 NUM 0 ?do
    drop
    make-list dup copy-list 
    move-head-to-tail move-tail-to-tail swap nreverse 
    dup list-val @ SIZE <> wrong-result and throw
    tuck list-equals 0= wrong-result and throw
    list-length
    loop ;

main 0 .r cr bye