0 constant nil
: cons ( n lst-addr -- lst-addr' ) here rot , here swap , swap , ;
: list ( <data> lst-addr n -- lst-addr' ) 0 ?do cons loop ;
: list ( <data> n -- lst-addr' ) nil swap list ;
variable list-start                    \ previous values saved for nested lists
: (list list-start @ sp@ list-start ! ;
: list) sp@ list-start @ swap - cell / list swap list-start ! ;
: car @ @ ;
: cdr cell+ @ ;
: rplaca ( n lst-addr -- ) @ ! ;
: rplacd ( new-lst-addr place-lst-addr -- ) cell+ ! ;
: elt ( lst-addr n -- lst-addr[n] ) 0 ?do cdr loop ;
: elt@ ( lst-addr n -- lst[n] ) elt car ;
: elt! ( n' lst-addr n -- ) elt rplaca ;
: last dup 0<> if begin dup cdr 0<> while cdr repeat then ;
: nconc ( lst-addr1 lst-addr2 -- lst-addr1 ) over last rplacd ;
: copy-list dup 0<> if dup car swap cdr recurse cons then ;
: append ( lst-addr1 lst-addr2 -- lst-addr ) swap copy-list swap nconc ;
: length 0 begin swap ?dup while cdr swap 1+ repeat ;
: mapc ( xt lst-addr -- )
    begin ?dup while 2dup car swap execute cdr repeat drop ;
: mapc swap mapc ;
: list. ['] . mapc ;
: mapcar ( xt lst-addr -- lst-addr' )
    dup 0= if nip else 2dup car swap execute -rot cdr recurse cons then ;
: mapcar swap mapcar ;
: reverse ( dest-lst-addr src-lst-addr -- dest-lst-addr' )
    ?dup 0<> if dup car rot cons swap cdr recurse then ;
: reverse nil swap reverse ;
: list-swap ( lst-addr i j -- )
    >r over r> 2dup 2>r elt@ -rot 2dup elt@ 2r> elt! elt! ;
: nreverse dup length dup 1+ 2 / 0 ?do 1- 2dup i list-swap loop drop ;

\ Example use
(list 1 2 3 4 5 6 list) constant mylist
mylist length .                         \ prints 6
mylist 3 elt@ .                         \ prints 4
mylist (list 7 8 9 list) append list.   \ prints 1 2 3 4 5 6 7 8 9
mylist nreverse list.                   \ prints 6 5 4 3 2 1
mylist :noname dup * ; mapcar list.     \ prints 36 25 16 9 4 1
(list 1 (list 2 3 list) 4 list) constant nested-list
nested-list 1 elt@ list.                \ prints 2 3