add AA-ITERATE for simple in-order iteration of an AA tree

startup.4th

@@ -2714,8 +2714,19 @@ UTILITY DEFINITIONS
 : AA-TRAVERSE  ( i*x node-xt null-xt aa-tree -- j*x )
    AA>ROOT @ AA-TRAVERSE-NODE ;
 
+: AA-ITERATE  ( i*x xt aa-tree -- j*x )
+   NULL >R AA>ROOT @
+   BEGIN ?DUP WHILE
+      DUP >R AA>LEFT @
+      BEGIN ?DUP 0= WHILE
+         R> ?DUP 0= IF DROP EXIT THEN
+         2DUP 2>R SWAP EXECUTE 2R>
+         AA>RIGHT @
+      REPEAT
+   REPEAT ▪ DROP ;
+
 : AA-#NODES  ( aa-tree -- u )
-   >R 0 { NIP >R EXECUTE R> EXECUTE 1+ } [[ ' ▪ ]] R> AA-TRAVERSE ;
+   >R 0 { DROP 1+ } R> AA-ITERATE ;
 
 LINUX DEFINITIONS
 

test/aa-tree.4th

@@ -5,6 +5,8 @@ STRUCT
    CELL%    FIELD SIMPLE>VALUE
 ENDSTRUCT SIMPLE%
 
+: NODE>SIMPLE  ( aa-node -- simple-node )  CONTAINEROF SIMPLE>NODE ;
+
 : MAKE-SIMPLE  ( x -- simple-addr )
    SIMPLE% %ALLOCATE TUCK SIMPLE>VALUE ! ;
 
@@ -23,7 +25,7 @@ ENDSTRUCT SIMPLE%
       THEN
 
       cpre EXECUTE "(" TYPE node AA>LEVEL @ . ") " TYPE
-         node CONTAINEROF SIMPLE>NODE SIMPLE>VALUE @ . EOL
+         node NODE>SIMPLE SIMPLE>VALUE @ . EOL
 
       node AA>LEFT @ IF
          lpre { " | " TYPE } COMPOSE
@@ -87,9 +89,8 @@ ENDSTRUCT SIMPLE%
 VARIABLE TREE
 
 "creating tree…\n" TYPE
-: SIMPLE-NODE-VALUE CONTAINEROF SIMPLE>NODE SIMPLE>VALUE @ ;
-' SIMPLE-NODE-VALUE ' <=> NEW-AA-TREE TREE !
-TREE @ SHOW-TREE
+{ NODE>SIMPLE SIMPLE>VALUE @ } ' <=> NEW-AA-TREE VALUE TREE
+TREE SHOW-TREE
 
 0xc43d7de6 CONSTANT SEED
 
@@ -97,58 +98,61 @@ TREE @ SHOW-TREE
    20 0 ?DO
       I SEED + HASHCELL 31 AND
       DUP "inserting " TYPE . "…\n" TYPE
-      MAKE-SIMPLE TREE @ AA-INSERT
-      TREE @ SHOW-TREE
-      TREE @ ?INVARIANTS
+      MAKE-SIMPLE TREE AA-INSERT
+      TREE SHOW-TREE
+      TREE ?INVARIANTS
    LOOP
 } EXECUTE
 
 "breaking invariant 1…\n" TYPE
-{ TREE @ SHOW-TREE ▪ { TREE @ ?INVARIANTS } CATCH DUP IF REPORT EOL THEN }
-   7 ▪ TREE @ AA>ROOT @ AA>LEFT @ AA>LEFT @ AA>LEFT @ AA>RIGHT @ AA>LEVEL ▪ !LOCALLY
+{ TREE SHOW-TREE ▪ { TREE ?INVARIANTS } CATCH DUP IF REPORT EOL THEN }
+   7 ▪ TREE AA>ROOT @ AA>LEFT @ AA>LEFT @ AA>LEFT @ AA>RIGHT @ AA>LEVEL ▪ !LOCALLY
 
 "breaking invariant 2…\n" TYPE
-{ TREE @ SHOW-TREE ▪ { TREE @ ?INVARIANTS } CATCH DUP IF REPORT EOL THEN }
-   4 ▪ TREE @ AA>ROOT @ AA>LEFT @ AA>LEVEL ▪ !LOCALLY
+{ TREE SHOW-TREE ▪ { TREE ?INVARIANTS } CATCH DUP IF REPORT EOL THEN }
+   4 ▪ TREE AA>ROOT @ AA>LEFT @ AA>LEVEL ▪ !LOCALLY
 
 "breaking invariant 3…\n" TYPE
-{ TREE @ SHOW-TREE ▪ { TREE @ ?INVARIANTS } CATCH DUP IF REPORT EOL THEN }
-   2 ▪ TREE @ AA>ROOT @ AA>RIGHT @ AA>LEVEL ▪ !LOCALLY
+{ TREE SHOW-TREE ▪ { TREE ?INVARIANTS } CATCH DUP IF REPORT EOL THEN }
+   2 ▪ TREE AA>ROOT @ AA>RIGHT @ AA>LEVEL ▪ !LOCALLY
 
 "breaking invariant 4…\n" TYPE
 DEFER BREAK-INV-4  ( aa-node -- )
 {
    DUP AA>LEVEL @ 1 = IF
-      DROP ▪ TREE @ SHOW-TREE ▪ { TREE @ ?INVARIANTS } CATCH ?DUP IF REPORT EOL THEN
+      DROP ▪ TREE SHOW-TREE ▪ { TREE ?INVARIANTS } CATCH ?DUP IF REPORT EOL THEN
    ELSE
       { { AA>RIGHT @ BREAK-INV-4 } OVER AA>LEVEL 1 SWAP !LOCALLY }
          OVER AA>LEFT NULL SWAP !LOCALLY
    THEN
 } IS BREAK-INV-4
 
-TREE @ AA>ROOT @ BREAK-INV-4
+TREE AA>ROOT @ BREAK-INV-4
 
 "breaking invariant 5…\n" TYPE
-{ TREE @ SHOW-TREE ▪ { TREE @ ?INVARIANTS } CATCH DUP IF REPORT EOL THEN }
-NULL ▪ TREE @ AA>ROOT @ AA>LEFT ▪ !LOCALLY
+{ TREE SHOW-TREE ▪ { TREE ?INVARIANTS } CATCH DUP IF REPORT EOL THEN }
+NULL ▪ TREE AA>ROOT @ AA>LEFT ▪ !LOCALLY
 
 "finding node with value 16…\n" TYPE
-16 TREE @ AA-LOOKUP
+16 TREE AA-LOOKUP
 DUP 0= [IF] "not found\n" TYPE [ELSE]
-"found\nvalue: " TYPE CONTAINEROF SIMPLE>NODE SIMPLE>VALUE @ . EOL
+"found\nvalue: " TYPE NODE>SIMPLE SIMPLE>VALUE @ . EOL
 [THEN]
 
-TREE @ SHOW-TREE
+TREE SHOW-TREE
 {
    10 0 ?DO
-      "count before: " TYPE TREE @ AA-#NODES DUP . EOL
+      "count before: " TYPE TREE AA-#NODES DUP . EOL
       I SEED + HASHCELL HASHCELL 31 AND
       DUP "deleting " TYPE . "…\n" TYPE
-      TREE @ AA-DELETE DUP FREE NULL<>
+      TREE AA-DELETE DUP FREE NULL<>
       IF 1- "removed\n" ELSE "not found\n" THEN TYPE
-      "count after: " TYPE TREE @ AA-#NODES DUP . EOL
+      "count after: " TYPE TREE AA-#NODES DUP . EOL
          <> "wrong count" ?FAIL
-      TREE @ SHOW-TREE
-      TREE @ ?INVARIANTS
+      TREE SHOW-TREE
+      TREE ?INVARIANTS
    LOOP
 } EXECUTE
+
+"iterating tree…\n" TYPE
+{ NODE>SIMPLE SIMPLE>VALUE @ . SPACE } TREE AA-ITERATE EOL

test/aa-tree.exp

@@ -1052,4 +1052,6 @@ count after: 15
        |  | 
        L-(1) 1
 
+iterating tree…
+1 2 4 6 7 8 11 11 13 16 16 17 21 30 30 
 exit-code: 0