diff --git a/startup.4th b/startup.4th index 574a627..deb7599 100644 --- a/startup.4th +++ b/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 diff --git a/test/aa-tree.4th b/test/aa-tree.4th index 17de7b9..49a1e20 100644 --- a/test/aa-tree.4th +++ b/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 diff --git a/test/aa-tree.exp b/test/aa-tree.exp index 07f23f7..14536ac 100644 --- a/test/aa-tree.exp +++ b/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