(       Title:  Double-Ended List Structure
         File:  dendlist.fs
      Version:  1.2.3
       Author:  David N. Williams
      License:  LGPL
Last revision:  September 1, 2006
)
\ Copyright (C) 2000-2002, 2006  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 [IF] and [THEN] from the Programming-Tools extension word
set.

Please see the file NOTATION.
)

s" undef.fs" INCLUDED  \ ensure [UNDEFINED]
s" nodespace.fs" REQUIRED


\ *** WORDS
(
  Global value:
  CURRENT-LIST

  EMPTY-DEND-LIST  MAKE-DEND-LIST

  Uncommentable:
  DEND-LIST:
  LIST-EMPTY?  LIST-HEAD!  LIST-HEAD@  LIST-TAIL!  LIST-TAIL@
)

\ *** GLOBALS
(
Many list words read the value CURRENT-LIST, which holds the
address of the current list structure, whether single-ended or
double-ended.  When there is only one list, CURRENT-LIST needs
to be set only once, for example, in the phrase MAKE-DEND-LIST
TO CURRENT-LIST, where MAKE-DEND-LIST is defined below.  For
multiple lists, see the description of the uncommentable word
DEND-LIST:.

CURRENT-LIST is also conditionally defined in sendlist.fs.
)

[UNDEFINED] current-list
[IF] 0 value current-list [THEN]  \ user must initialize


\ *** DOUBLE-ENDED LIST STRUCTURE
(
Double-ended lists have a two-cell list structure:

  Head:  Address of first node, or zero if list is empty.
  Tail:  Address of last node, or zero if list is empty.

Instead of making it explicit, we treat this structure by simple
magic, like that used in the following five definitions. 
Uncomment them if you want explicit structure words.

Note that LIST-TAIL! and LIST-TAIL@ only work for double-ended
lists, whereas LIST-EMPTY?, LIST-HEAD!, and LIST-HEAD@ also work
for single-ended lists.

Remember the general rule that a zero node address means a
nonexistent node.
)

0 [IF]
: list-empty?  ( -- flag )   current-list @ 0= ;
: list-head!   ( first -- )  current-list ! ;
: list-head@   ( -- first )  current-list @ ;
: list-tail!   ( last -- )   current-list cell+ ! ; 
: list-tail@   ( -- last )   current-list cell+ @ ;
[THEN]


\ *** DOUBLE-ENDED LIST OPERATIONS
(
These words work for double-ended lists with either single or
double linking.
)

: make-dend-list  (  -- list )
(
Make an aligned, double-ended list structure instance,
initialized to empty.
)
  align here ( list)
  0 , 0 , ;  \ empty, no first or last node

0 [IF]
: dend-list:  ( "<listname>" -- )
(
Make an aligned, double-ended list structure instance,
initialized to empty.  CREATE a word that sets CURRENT-LIST to
the structure address.

The following code is a suggestion intended for customization
when there are multiple lists.  For example, when there are also
multiple nodespaces, one might want to have a nodespace input to
DEND-LIST:, and have the words it defines also set
CURRENT-NODES.
)
  create
  0 , 0 , \ empty, no first or last node
DOES>  ( -- )  ( list) to current-list ;
[THEN]

: empty-dend-list  ( -- )
(
Assume the current list to be double-ended, with any nodes
belonging to the current node space.  Unlink all the nodes and
link them into the unused chain in the space, leaving the list
empty.

The following code relies on the fact that UNUSE-NODE does not
care if the linking is more than single.

Note:  The code up to the last line is identical to that of
EMPTY-SEND-LIST.
)
  current-list @ ( first)
  BEGIN
    ( node) dup
  WHILE
    ( node) dup @ ( next) swap
    ( node) unuse-node ( next)
  REPEAT drop
  0 current-list ( head) !
  0 current-list cell+ ( tail) ! ;