Singly Linked List implementation using gforth's structs, less commented

sllist-less-comments.fs

\ sllist-less-comments.fs - Singly Linked List implementation in forth using gforth's structs, less comments.

struct
    cell% field node-text               \ address of counted string
    cell% field node-next               \ address of next node
end-struct node%

: node-init ( text-addr next-addr node-addr -- ) tuck   node-next !   node-text ! ;

: node-type ( node-addr -- )   node-text @ count type ;

: node-traverse ( first-addr -- ) 
    begin dup @ 0<> while cr dup @ node-type @ node-next repeat drop
;

: node-text-compare ( node1-addr node2-addr -- flag )
    node-text @ count rot node-text @ count 2swap compare
;

: node-insert ( new-node-addr p-addr )
    dup @ 0= if ! exit then             
    2dup @ node-text-compare -1 = if 2dup @   swap node-next !   !   exit then
    begin
        dup @ node-next @ 0<>
    while 
        2dup @ node-text-compare 1 =
    while
        @ node-next
    repeat then
    2dup   @ node-next @  swap  
    node-next ! 
    @ node-next !
;

\ Build the initial list manually.
\ Create some strings.
create s1 ," a"
create s2 ," m"
create s3 ," x"

\ Create some nodes and initialize them, making links between them.
node% %allot constant n3   s3  0 n3 node-init
node% %allot constant n2   s2 n3 n2 node-init
node% %allot constant n1   s1 n2 n1 node-init

variable l1  n1 l1 !              \ original list

\ Create some other nodes for later use with the l2 list.
create s4 ," o"
create s5 ," x"
create s6 ," h"
create s7 ," a"
create s8 ," m"
create s9 ," z"

node% %allot constant n4    s4  0 n4  node-init
node% %allot constant n5    s5  0 n5  node-init
node% %allot constant n6    s6  0 n6  node-init
node% %allot constant n7    s7  0 n7  node-init
node% %allot constant n8    s8  0 n8  node-init
node% %allot constant n9    s9  0 n9  node-init
node% %allot constant n10   s8  0 n10 node-init
node% %allot constant n11   s7  0 n11 node-init
node% %allot constant n12   s9  0 n12 node-init

variable l2   0 l2 !                  \ the other list

\ Use hex when debugging, because you'll be looking at long 8 byte addresses.
hex


\ Words for debugging
: type-data ( -- )
    cr ." l2: " l2 .
    cr ." n4 : " n4  . n4  node-type  space n4  node-next @ .
    cr ." n5 : " n5  . n5  node-type  space n5  node-next @ .
    cr ." n6 : " n6  . n6  node-type  space n6  node-next @ .
    cr ." n7 : " n7  . n7  node-type  space n7  node-next @ .
    cr ." n8 : " n8  . n8  node-type  space n8  node-next @ .
    cr ." n9 : " n9  . n9  node-type  space n9  node-next @ .
    cr ." n10: " n10 . n10 node-type  space n10 node-next @ .
    cr ." n11: " n11 . n11 node-type  space n11 node-next @ .
    cr ." n12: " n12 . n12 node-type  space n12 node-next @ .
;

: node-next-clear ( node-addr -- )  node-next 0 swap !  ;

: clear-data ( -- )
    n4  node-next-clear
    n5  node-next-clear
    n6  node-next-clear
    n7  node-next-clear
    n8  node-next-clear
    n9  node-next-clear
    n10 node-next-clear
    n11 node-next-clear
    n12 node-next-clear
    0 l2 !
;

: add ( node list s-addr n )
    cr ." Add " 3 pick  node-type  space  type 
    dup node-insert
    cr l2 node-traverse cr
;

: add ( node list s-addr n )
    cr ." Add " 3 pick  node-type  space  type 
    tuck node-insert
    cr node-traverse cr
;

cr .( ==== First list, l1, built manually ==========================================)
l1 node-traverse cr

1 [IF] 
cr .( ==== Second list, l2 =========================================================)

clear-data
cr ." Before adds: " .s
n4  l2 s" to empty list using n4 " add
cr ." After first add: " .s
n6  l2 s" to list using n6" add 
n5  l2 s" to list using n5" add 
n7  l2 s" to list using n7" add
n8  l2 s" to list using n8" add
n9  l2 s" to list using n9" add
n10 l2 s" to list using n10" add
n11 l2 s" to list using n11" add
n12 l2 s" to list using n12" add

cr .( ==== Second list, build 2  ===================================================)
clear-data

n4  l2 s" to empty list using n4" add
n5  l2 s" to list after existing node using n5" add
n6  l2 s" to list at front using n6" add

cr .( ==== Third list, build 3 ======================================================)
clear-data

n4  l2 s" to empty list using n4" add
n6  l2 s" to list before existing node n6" add
n9  l2 s" to list at end using n9" add
[THEN]