: new-list ( -- list )  1 cells allocate throw  nil over ! ;

: cons ( y x -- addr )  2 cells allocate throw  dup >r  2!  r> ;
: free-cons ( addr -- )  ?dup if free throw then ;

: >car ( pair -- first-addr ) ; immediate
: >cdr ( pair -- second-addr )  cell+ ;

: car ( pair -- first )   dup if >car @ then ;
: cdr ( pair -- second )  dup if >cdr @ then ;

: delete-node ( node -- next-node )  dup cdr swap free-cons ;
: list-delete-first ( list -- )  dup @ delete-node swap ! ;

: list-push ( atom list -- )  tuck @  swap cons  swap ! ;
: list-pop ( list -- atom )  dup @ car swap list-delete-first ;

: delete-rest ( node -- nil )  begin dup while delete-node repeat ;
: list-delete ( list -- )  dup @ delete-rest swap ! ;

: join-nodes ( node2 node1 -- )  ?dup if  >cdr !  else drop then ;
: last-node ( node -- last-node )  begin dup cdr while cdr repeat ;
: lists-join ( list2 list1 -- )  swap @  swap @ last-node join-nodes ;