ll

\ linked list utilities

\ linked lists should be stored in a place it is
\ possible to get the address of, like a VARIABLE
\ this makes it easier to do things like insert an element at the start of the list

\ gforth extension, automatially allocate THROW code
[defined] exception [if]
s" linked list out-of-bounds" exception constant ll-oob
[then]

[defined] ll-oob [if] 
: ?ll-nil dup 0= if drop ll-oob throw then ;
[else]
: ?ll-nil dup 0= abort" linked list out-of-bounds" ;
-2 constant ll-oob
[then]

: ll-index ( ll u -- x ) 0 ?do ?ll-nil @ loop ;
: ll-length ( ll -- u ) 0 >r begin dup while r> 1+ >r @ repeat drop r> ;

: ll-insert ( elem ll -- ) 2dup @ swap ! ! ;
\ unlinks and returns the next element of the list,
\ pass the address of a variable containing the ll to insert at the start
: ll-shift ( ll -- elem ) dup @ dup >r @ swap ! r> ;
\ find the previous element, returns 0 if not found
: ll-find ( elem ll1 -- ll2 )
  begin dup while 2dup @ <> while @ repeat then nip ; 

\ find and remove specified element, returning 0 if the element was found
\ return value is suitable for throw
: ll-remove ( elem ll -- err )
  ll-find dup if ll-shift drop 0 else drop ll-oob then ;

\ create and link a new list element in data-space
: ll, ( ll -- ) here over @ , swap ll-insert ;

\ traverse a linked list.  xt has stack effect ( ... ll -- ... flag )
\ if xt returns false, traversal is halted.
: ll-traverse ( ... xt ll -- ... )
  2>r begin r@ while 2r@ swap execute while r> @ >r repeat then rdrop rdrop ;