(       Title:  Double-Ended, Single-Linked Lists
         File:  dslist.fs
      Version:  1.2.3
       Author:  David N. Williams
      License:  LGPL
Last revision:  September 29, 2002
)
\ Copyright (C) 2000-2002  David N. Williams
(
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or at your option any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

Please see the file POLITENESS included with this distribution.

ANS Forth compatible except for:
- Case sensitivity.
- REQUIRED loads Forth source if it's not already loaded.
- Assumption that zero does not occur as an address.

Uses LOCALS| from the Locals extension word set.

Please see the file NOTATION.

The only words from the following files that are actually used
here are mentioned in the accompanying comments.  The rest
complete the glossary so that only this file need be loaded for
double-ended, single-linked list applications.
)

s" nodespace.fs" REQUIRED  \ for UNUSE-NODE
s" dendlist.fs"  REQUIRED  \ for CURRENT-LIST
s" snode.fs"     REQUIRED  \ but not used here


\ *** WORDS
(
  DSAPPEND  DSINSERT-AFTER  DSPREPEND  DSUNLINK-FIRST 
  DSUNLINK-NEXT  DSUNUSE-FIRST  DSUNUSE-NEXT
)

\ *** DOUBLE-ENDED, SINGLE-LINKED LIST OPERATIONS
(
These words assume that the current list is double-ended and
single-linked, and that all nodes have headers for single
linking and belong to the current node space.
)

: dsinsert-after  ( node node.before -- )
(
Assume that node.before is in the current list, and that node is
unlinked.  Insert node into the list just after node.before.
)
  ( before) dup @
  LOCALS| after before node |
  node before !                \ before -> node
  after node !                 \ node -> after
  after IF EXIT THEN  \ EXIT if after is not last
  after current-list cell+ ! ;  \ after is new last

: dsprepend  ( node  -- )
(
Assume that node is unlinked.  Prepend it to the beginning of
the current list.
)
  current-list ( head) @
  LOCALS| first node |
  first node !                         \ node -> first
  node current-list ( head) !          \ node is new first
  first IF EXIT THEN  \ EXIT if list already had a last
  node current-list cell+ ( tail) ! ;  \ node is last

\  ( node) dup
\  current-list @ ( first)
\  over ( first node) !            \ node -> first
\  ( node) current-list ( head) !  \ node is new first
\  ( node) dup @ IF  \ list already had a last
\     ( node) drop
\  ELSE  \ node is last
\    ( node) current-list cell+ ( tail) !
\  THEN ;

: dsappend  ( node -- )
(
Assume that node is unlinked.  Append it to the end of the
current list.
)
  ( node) current-list cell+ ( tail) dup @
  LOCALS| last tail node |
  0 node !                       \ node -> zero
  node tail !                    \ node is new last
  last IF  \ list was nonempty
    node last !                  \ last -> node
  ELSE \ list was empty
    node current-list ( head) !  \ node is first
  THEN ;

\  ( node) >r
\  0 r@ !  \ node -> zero
\  r@ ( node) current-list dup
\  ( list) @ ( nonempty?) IF
\    ( node list) cell+ @ ( last) !  \ last -> node  
\  ELSE  \ list was empty
\    ( node head) !  \ node is new first
\  THEN
\  r> ( node) current-list cell+ ( tail) ! ;  \ node is new last


\ NOTE:  If the application only builds lists but never removes
\ any nodes from them, all words beyond this point can be omitted.


: dsunlink-next  ( node.before -- node|0 )
(
Assume that node.before is in the current list.  Unlink and
leave the following node, or just leave zero if node.before is
last in the list.
)
  ( before) dup @ ( node)
  LOCALS| node before |
  node IF  \ before is not last
    node @ ( after) dup
    ( after) before !              \ before -> after
    ( after) 0= IF  \ node was last
      before current-list cell+ !  \ before is new last
    THEN
    node
  ELSE 0 THEN ;

: dsunuse-next  ( node.before -- )
(
Assume that node.before is in the current list.  If there is a
following node, unlink it, and link it into the unused chain in
the current node space.  Otherwise do nothing.
)
  ( before) dsunlink-next ( node|0) unuse-node ;


\ *** STACK AND QUEUE OPERATIONS
(
Together with DSPREPEND, the two words DSUNLINK-FIRST and
DSUNUSE-FIRST below implement the basic push, pop, and drop
operations for a stack, i.e., a LIFO list.

Together with DSAPPEND, they implement the basic append,
pop-first, and drop-first operations for a queue, i.e, a FIFO
list.
)

: dsunlink-first  ( -- node|0 )
(
If the current list is not empty, unlink and leave its first
node.  Otherwise leave zero.
)
  current-list ( head) @ ( first) dup
  ( nonempty?) IF
    ( first) dup @ ( second) dup current-list ( head) !
    ( second) 0= IF  \ list now empty
      0 current-list cell+ ( tail) !
    THEN ( first)
  THEN ( first) ;

: dsunuse-first  ( -- )
(
If the current list is not empty, unlink its first node, and
link it into the unused chain in the current node space.  
Otherwise do nothing.
)
  dsunlink-first ( node|0) unuse-node ;