(       Title:  Single/Double-Ended, Double-Linked List Examples
         File:  dexample.fs
      Version:  1.2.3
       Author:  David N. Williams
      License:  Public Domain
Last revision:  September 29, 2002

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.

We use "m" and ".m" to indicate the address of a cell-counted
string, a case of what we call a "measured string".  Please also
see the file NOTATION.

Either of the following files loads the node structure words in
dnode.fs.
)

s" sdlist.fs" REQUIRED
s" ddlist.fs" REQUIRED
decimal


\ *** GENERAL USE

: m>s  ( m -- s )
(
Cell-counted version of COUNT.
)
  >r r@ cell+ ( addr) r> @  ( len) ;

: mplace  ( s m -- )
(
Cell-counted version of PLACE in Wil Baden's Tool Belt.  Store
the Forth string as a cell-counted string at m.
)
  ( len target.m) 2dup 2>r
  ( target.m) cell+ ( s.body len target.body) swap move
  2r> ( len target.m) ! ;

: ?mplace  ( s buf /buf -- )
  ( /buf) >r over ( slen) cell+ r> >
  ABORT" ***Buffer too small for cell-counted string"
  mplace ;

: buf-field:  ( "name" offset size -- offset+size )
(
Define a structure field word that converts a structure address
into the field address and also leaves its size.
)
  create   2dup ( size) , ( offset) ,   +
DOES>  ( struc -- struc+offset size )
  2@ ( struc offset size) >r   + ( struc+offset)   r> ( size) ;

: .buf  ( buf /buf -- )
(
Print the cell-counted string stored at buf.
)
  drop m>s type ;


\ *** DNODES
(
Like the single-linked examples, these examples use standard
strings, but we store them directly in the nodes.

Double-linked node structure continuation for liquid meal
strings data:
)
  /dnode-header
  36 buf-field:  >juice
  36 buf-field:  >soup
  36 buf-field:  >beverage
   /dnode-data:  /liq-meal

(
We use the same node space for the single-ended [stack] example
and the double-ended [queue] example.
)
  6 ( nodes) /liq-meal /dnode-header
      make-nodes constant liq-meal-nodes
  liq-meal-nodes to current-nodes


\ *** SINGLE-ENDED, DOUBLE-LINKED EXAMPLE

make-send-list constant liq-meal-stack
liq-meal-stack to current-list

: list-head@  ( -- first )  current-list @ ;

?new-node sdprepend
s" grapefruit juice" list-head@ >juice    ?mplace
    s" chicken soup" list-head@ >soup     ?mplace
         s" hot tea" list-head@ >beverage ?mplace

?new-node sdprepend
        s" lemonade" list-head@ >juice    ?mplace 
        s" pea soup" list-head@ >soup     ?mplace
   s" Doctor Pepper" list-head@ >beverage ?mplace

?new-node sdprepend
      s" tuna juice" list-head@ >juice    ?mplace
  s" bird nest soup" list-head@ >soup     ?mplace
   s" hot prune tea" list-head@ >beverage ?mplace

: .liq-meal-stack  ( -- )
(
Make LIQ-MEAL-STACK the current list and print it from most
recent to earliest.
)
  liq-meal-stack to current-list
  list-head@ ( first) >r  \ This time we avoid locals.
  BEGIN
  r@ WHILE
    cr ." Juice: " r@ >juice .buf
    ." ; Soup: " r@ >soup .buf
    ." ; Beverage: " r@ >beverage .buf
    r> >nxnode @ >r
  REPEAT r> drop ;


\ *** DOUBLE-ENDED, DOUBLE-LINKED EXAMPLE

make-dend-list constant liq-meal-queue
liq-meal-queue to current-list

: list-tail@  ( -- last )  current-list cell+ @ ;

?new-node ddappend
s" grapefruit juice" list-tail@ >juice    ?mplace
    s" chicken soup" list-tail@ >soup     ?mplace
         s" hot tea" list-tail@ >beverage ?mplace

?new-node ddappend
        s" lemonade" list-tail@ >juice    ?mplace 
        s" pea soup" list-tail@ >soup     ?mplace
   s" Doctor Pepper" list-tail@ >beverage ?mplace

?new-node ddappend
      s" tuna juice" list-tail@ >juice    ?mplace
  s" bird nest soup" list-tail@ >soup     ?mplace
   s" hot prune tea" list-tail@ >beverage ?mplace

: .liq-meal-queue<  ( -- )
(
Make LIQ-MEAL-QUEUE the current list and print it from last to
first.
)
  liq-meal-queue to current-list
  list-tail@ ( last) >r  \ This time we avoid locals.
  BEGIN
  r@ ( node) WHILE
    cr ." Juice: " r@ >juice .buf
    ." ; Soup: " r@ >soup .buf
    ." ; Beverage: " r@ >beverage .buf
    r> >prevnode @ >r
  REPEAT r> drop ;

: .liq-meal-queue>  ( -- )
(
Make LIQ-MEAL-QUEUE the current list and print it from first to
last.
)
  liq-meal-queue to current-list
  list-head@ ( first)
  LOCALS| node |	\ locals again, for comparison,
  BEGIN
  node WHILE
    cr ." Juice: " node >juice .buf
    ." ; Soup: " node >soup .buf
    ." ; Beverage: " node >beverage .buf
    node >nxnode @ to node
  REPEAT ;