ANEW --AlphList-- DECIMAL \ Wil Baden 2003-02-23 \ ******************************************************************* \ * * \ * Wil Baden 2002-08-03 * \ * * \ * Alphabetic List * \ * * \ * Alphabetic list is a form of associative list. An alphabetic * \ * list is a set of sublists where each sublist is a linked list * \ * of nodes with alphanumeric identification and in alphabetic * \ * order. A hash function assigns items to the appropriate * \ * sublist. * \ * * \ ******************************************************************* \ ADD ALPHABETIC-LIST ITEMS \ ADD-ITEM FOR-EACH-ITEM PRUNE-LINKS \ ADD-NEW INIT-LIST RESERVED \ ADD-NEW-ITEM ITEM SIMPLE-ALPHABETIC-LIST \ Using: TOOLBELT 0 [IF] Alphabetic List and Sorting Alphabetic list is a form of associative list. An alphabetic list is a set of sublists where each sublist is a linked list of nodes with alphanumeric identification and in alphabetic order. A hash function assigns the alphanumeric identifications to the appropriate sublist. The default hash function is `hashpjw` from the dragon book by Aho, Sethi, and Uhlman. The default number of sublists is 31. These can be changed easily. For a large file, one or more thousand sublists can be used. The format of a node is... +-----+-------+-------------------+ |LINK |ITEM |INFO (optional) | +-----+-------+-------------------+ ITEM is used for the alphabetic identification and is variable length 1..255. INFO is managed by the user. The most used words... Alphabetic-List ( "list-name" -- ) ADD ( str len list-name -- ) Add-New ( str len list-name -- ) ITEM ( str len list-name -- item | 0 ) Add-Item ( str len list-name -- item ) >INFO ( item -- info ) Updating a sublist is done by insertion after the alphanumeric identification has been hashed. Comparison is case insensitive although the original alphanumeric identifications are kept at ITEM. The nodes are not moved - the links are adjusted. Two (or more) lists can be built at the same time. Lists may reference parts of other lists. Although each sublist is ordered alphanumerically, the entire list is not. Inside a definition, to display the entire list... list-name FOR-EACH-ITEM ( item) ... \ whatever. COUNT TYPE CR \ example. ... \ etc. ( ) REPEAT `UNTIL` and additional `WHILE`s can be used when searching. Balancing `THEN`s are needed for them. `FOR-EACH-ITEM` is a macro for... List->Heap BEGIN Traverse-Heap WHILE `List->Heap` builds a heap of ascending (rather than descending) values from the first word in each sublist. `Traverse-Heap` takes the item from the first entry in the heap. The first entry is replaced by the next node from the originating sublist, and the heap is re-established. When the originating sublist is emptied, the last entry in the heap is moved to the first entry in the heap and the heap is re-established. A listing heap is not part of an alphabetic list, but is temporarily assigned when needed. An alphabetic list is not sorted but the output is. This is the method I use for putting all goodies in order. I keep a scratch list, `Temp-List`, for that purpose. Here is a rough pattern for sorting a file... HERE >R Temp-List Init-List FOR-EACH-READ ( str len) Temp-List Add-New ( ) REPEAT Temp-List FOR-EACH-ITEM ( item) COUNT ... output ... REPEAT R> HERE - ALLOT `FOR-EACH-READ` is a macro for file input. Addresses in an alphabetic list are self-relative. Alphabetic lists built at one time can be saved to a disk file and loaded when needed. Save system also maintains alphabetic lists. `FOR-EACH-LINE` is a similar macro for a selection of lines in an edit window. This allows powerful formatting of the selection. Used with `FOR-EACH-ITEM`, glossaries can be extracted, sorted, and listed in Forth. All is written in Standard (ANS) Forth, of course. [THEN] \ Linked List - Node - Link - Head \ A *linked list* is a way of storing data as it is received. A \ linked list consists of a sequence of elements called *nodes*. In \ each node a cell, called the *link*, has the address of the next \ node in the list. The rest of the node contains the data to be \ stored. \ In the last node, 0 is used for the address of the next node. When \ stepping through the list to find values, the address 0 tells us \ that we have reached the end of the linked list. \ A linked list starts with a variable that holds the address of the \ first node in the list. This variable is the *head* of the list. \ As the data is read, you create a new node and insert it into the \ list. At the end of the input, the computer memory holds a list of \ nodes with each node containing data and the address of the next \ node. \ In the implementation given here, the first cell in the node will \ be used as the link. \ Creating and initializing a linked list of this kind is simply \ creating and initializing the list head. \ VARIABLE 0 ! \ or \ CREATE 0 , \ Other parameters to be used in processing the list may also be \ initialized. \ Area for a new node may be taken from a pool, or assigned by \ `ALLOCATE`, or obtained from data space by `ALLOT`. `ALLOT` is the \ simplest way. \ `RELINK` \ Given the address of a _node_ and the _head_ of a linked list... \ node head RELINK \ will insert the node as the first in the list. \ Given the address of a _node_ and the address of a \ _node-in-a-list_, \ node node-in-a-list RELINK \ will insert _node_ into the list just after _node-in-a-list_. \ `>LINK` \ When space for nodes is taken from data space, \ head >LINK \ adds a node at `HERE` to the top of the list. _head_ is set to the \ address `HERE`, and `HERE` is set to the address of the previous \ top node. In the same way \ node-in-a-list >LINK \ adds a node at `HERE` just after _node-in-a-list_. The contents of \ the node at `HERE` should then be filled. \ `!REL` `@REL` \ When storing an address into a linked list or fetching an address \ from a linked list, `!REL` or `@REL` should be used. In SwiftForth \ these are `!REL` and `@REL`. In Power MacForth they are `#!` and \ `#@`. \ If you are adding nodes without being concerned about what place \ they occupy in the list, simply add the node at the head. As each \ node is inserted, its link will get the value in the head, and the \ head will be updated to have the address of the new node. This \ method will also be used when you want the list to be in \ last-in-first-out order. \ Adding nodes to a list whose elements are in some kind of order \ requires more effort. You must provide a way to compare the data \ of two nodes to see which node should come before the other on the \ list. You must decide what to do when a new node is an equivalent \ of an existing node - should the new node be added, or should it \ be discarded, or should the existing node be modified? If the new \ node is to be added, should it be before or after the existing \ equivalent? \ When inserting a new node into a list where the order of nodes \ depends on the data, and you want the new node to come before an \ equivalent, skip over nodes that come before the new node. The \ insertion takes place between the previous node and the currently \ examined node. \ In the same way, when searching for a node in a list, skip over \ all nodes that would come before the node you want. \ ******************************************************************* \ Alphabetic List \ In the implementation here, *alphabetic list* is the term for a \ list of nodes with an alphanumeric identification and ordered \ alphabetically. For other than a short list, the data will be \ separated into *sublists*. \ In this implementation a hash function is used to classify the \ alphanumeric identifications. The character strings in data are \ kept in the original form, but the search function is case \ insensitive. \ Each classification is a sublist, and in a sublist the items are \ ordered alphanumerically \ There's nothing fundamentally complicated about hash values and \ hash tables. The simplest case is simply an alphabetically \ ordered list segregated by initial letter. To look up an entry, \ take your search key, pick up its first letter, and look at the \ part of the table for that initial letter. You can see how to do \ that easily, right? \ Now, we all know that letters aren't all used as initial letters \ with equal frequency, so some sections of your table will be \ very much bigger than others, and searching the big parts will \ take longer than searching the little parts. \ So, to equalize the section sizes and optimize the searching \ time, instead of using initial letters, you do something else, \ maybe fiddle with the bits a little, or use more than one \ letter, etc, to get a more even distribution, which you use to \ set up the table and determine which section to search. The kind \ of fiddling you do is called a "hashing algorithm". Some \ algorithms are simple, some are complicated, and you can best \ pick by taking advantage of something you know about the data. \ -- Elizabeth D. Rather 2001-01-24 \ The following TOOLBELT words are used: \ #Chars/Line ANEW Compare-Item STRING, \ 'th BOUNDS H# String->Upper \ 3DROP BUFFER: NOT TEMP \ ?CR C# OFFSET: [UNDEFINED] \ @++ COMPARE(NC) PLACE \\ \ ******************************************************************* \ !REL ( addr1 addr2 -- ) \ If addr1 = 0, store 0 at addr2, else store addr1 minus addr2. \ @REL ( addr1 -- 0 | addr2 ) \ If contents of addr1 = 0, return 0, else addr2 = addr1 + \ contents of addr1. \ ***************************** @REL ****************************** FALSE [IF] : @REL dup @ dup IF over + THEN NIP ; [THEN] CODE @REL ( addr1 -- 0 | addr2 ) rX 0 rTOS LWZ, rX TST, EQ IF, rTOS rX MOVE, ELSE, rTOS rX ADD, THEN, NEXT, END-CODE \ ***************************** !REL ****************************** FALSE [IF] : !REL >R dup IF R@ - THEN R> ! ; [THEN] CODE !REL ( addr1 addr2 -- ) rX 0 rDSP LWZ, rX TST, NE IF, rX rTOS rX SUBF, \ value = addr1 - addr2 then, rX 0 rTOS STW, rTOS 4 rDSP LWZ, rDSP 8 ADDI, NEXT, END-CODE \ ******************************************************************* \ CHAIN RELINK, >LINK \ \ For relocation of machine addresses, addresses are referenced \ self-relative. \ CHAIN ( "name" -- ) \ Define the head of a linked-list of addresses or values. \ The list must be pruned when elements are forgotten. In \ SwiftForth and PowerMacForth this will be done for you. \ RELINK ( node list-head -- ) \ Take _node_ and install it in list. Used in >LINK. \ >LINK ( list-head -- ) \ Add a link at `HERE` to _list-head_. _list-head_ is set to \ point to the new link, which is set to point to the \ previous top link. \ LINKS ( list-head -- list-tail ) \ Scan the linked list until it finds the last entry in the \ list (the one with a 0 link). Used in LINK are #! #@ CHAINADD ADDLINK in Power \ MacForth. `>LINK ,` is `LINKTOKEN`. \ : CHAIN CREATE 0 , ; \ **************************** RELINK ***************************** \ Add a new node onto the head of a linked list. : RELINK ( node list -- ) \ If node is 0, ignore it. over IF 2dup @REL SWAP !REL \ Chain new node onto old head node. !REL \ Save new node as head. ELSE 2DROP \ Ignore when node = 0. THEN ; \ ***************************** >LINK ***************************** \ Link HERE onto a list. : >LINK ( list -- ) align \ Force word-alignment. HERE 1 CELLS ALLOT \ Keep link in object-area. SWAP RELINK ; \ Chain HERE onto list. \ ***************************** LINKS ***************************** FALSE [IF] : LINKS ( list -- last-node ) BEGIN dup @ dup WHILE + REPEAT DROP ; [THEN] CODE LINKS BEGIN, RX 0 RTOS LWZ, RX 0 CMPI, RTOS RX ADD, EQ UNTIL, NEXT, END-CODE \ ***************************** LINK ; \ ***************************** ,LINK ***************************** : ,LINK ( addr -- ) dup IF HERE - THEN , ; \ In an alphabetic list or sublist the alphanumeric identification \ is by convention just after the link. The address of the \ alphanumeric identification is termed `ITEM`. `>ITEM` will go from \ the link to the item. Associated information is aligned after the \ alphanumeric identification. The length of the alphanumeric \ identification is variable. The function `>INFO` goes from the \ item to the address of the information. The naming convention is \ that `>` is pronounced "to". The information can reference other \ lists. \ +----+--------+----------------+ \ |LINK|ITEM |INFO (optional) | \ +----+--------+----------------+ \ ******************************************************************* \ An alphabetic list can be defined and initialized with \ `ALPHABETIC-LIST` or `SIMPLE-ALPHABETIC-LIST`. \ ALPHABETIC-LIST ( "name" -- ) \ Create and initialize alphabetic list _name_ with multiple \ sublists. \ SIMPLE-ALPHABETIC-LIST ( "name" -- ) \ Create and initialize alphabetic list _name_. This can be used \ when the total number of nodes is small. \ `ALPHABETIC-LIST` and `SIMPLE-ALPHABETIC-LIST` have a hashing \ function to select a sublist. In `SIMPLE-ALPHABETIC-LIST` the \ hashing function simply returns 0. \ >Info-Reserve ( list -- addr ) \ To the address of amount of space to reserve for information in a \ node. \ >Hash-Function ( list -- addr ) \ To the address of hashing function for alphabetic list. \ >#Sublists ( list -- addr ) \ To the address of number of sublists in alphabetic list. \ Alpha-List-Control-Size ( -- n ) \ Size of the control block of alphabetic lists. \ #Sublists ( -- n ) \ Number of sublists in usual alphabetic list. \ No-Hash ( str len modulus -- hash ) \ Hashing function for simple alphabetic list. _hash_ is always \ 0. \ Allot-Erase ( u -- ) \ ALLOT data space and then ERASE it. 0 1 CELLS BOUNDS OFFSET: >Info-Reserve 1 CELLS BOUNDS OFFSET: >Gimmick 1 CELLS BOUNDS OFFSET: >Hash-Function 1 CELLS BOUNDS OFFSET: >#SUBLISTS ( n) dup OFFSET: >SUBLISTS CONSTANT Alpha-List-Control-Size \ *************************** #SUBLISTS *************************** 31 CONSTANT Default#Sublists Default#Sublists VALUE #SUBLISTS \ Default number of sublists. \ ***************************** HASH ****************************** : HASH ( str len prime -- hash ) 0 2SWAP ( prime hash str len) BOUNDS ?DO ( . hash) 4 LSHIFT I C@ Char>Upper + dup H# F0000000 AND 24 RSHIFT XOR H# 0FFFFFFF AND LOOP SWAP MOD ; \ ************************** Allot-Erase ************************** : Allot-Erase ( u -- ) HERE SWAP dup ALLOT ERASE ; \ ************************ Alphabetic-List ************************ : Alphabetic-List ( "name" -- ) CREATE HERE ( addr) Alpha-List-Control-Size #SUBLISTS CELLS + Allot-Erase ['] HASH over >Hash-Function ! #SUBLISTS over >#SUBLISTS ! Default#Sublists to #SUBLISTS DROP ; \ **************************** No-Hash **************************** : No-Hash ( str len modulus -- hash ) 3DROP 0 ; \ ******************** Simple-Alphabetic-List ********************* : Simple-Alphabetic-List ( "name" -- ) CREATE HERE ( addr) Alpha-List-Control-Size CELL+ Allot-Erase ['] No-Hash over >Hash-Function ! 1 over >#SUBLISTS ! drop ; \ ******************************************************************* \ INIT-LIST ( list -- ) \ Initialize control block for alphabetic list. Zero space will \ be reserved for information in nodes. Use `n _list_ RESERVED` \ to assign amount of space to reserve. \ RESERVED ( n list -- ) \ Assign amount of space to reserve for information in nodes. \ Skip-Preceding-Items ( str len head -- prev item|0 ) \ Skip over nodes that would come before _str len_. \ Scan-List-for-Item ( str len list -- prev item|0 ) \ Given string _str len_ and alphabetic list _list_, search the \ appropriate sublist for the string. \ Place-New-Item ( str len prev -- item ) \ Given string _str len_ and a node or head _prev_ of a list, \ place the string in order in the list. \ *************************** RESERVED **************************** : RESERVED ( n list -- ) >R 0 MAX R> >Info-Reserve ! ; \ *************************** Init-List *************************** [UNDEFINED] @++ [IF] : @++ ( a -- a+cell x ) dup CELL+ SWAP @ ; [THEN] : Init-List ( list -- ) dup >#SUBLISTS @++ CELLS ERASE 0 SWAP RESERVED ; 1 CELLS OFFSET: >ITEM \ ********************* Skip-Preceding-Items ********************** CODE Compare-Item ( a n b m -- -1|0|1 ) \ Save local registers. r31 -4 rRSP STWU, r30 -4 rRSP STWU, r29 -4 rRSP STWU, r28 -4 rRSP STWU, \ R31= m R30= b R29= n R28= a r31 rTOS MOVE, r30 0 rDSP LWZ, r29 4 rDSP LWZ, r28 8 rDSP LWZ, rDSP 12 ADDI, \ R29= n-m R31= min(m,n) r29 r31 r29 SUBF., LT IF, r31 r29 ADD, THEN, \ RY= Uppercase-Map ['] Uppercase-Map info-find-token @infoDataOffset rY LiteralToRegister, rY RDBP ADD, \ Set back registers for looping. r30 1 SUBI, r28 1 SUBI, rTOS 0 LI, \ Compare over minimum length. BEGIN, r31 -1 ADDIC., rX 1 r30 LBZU, \ rX rY rX LBZX, GE WHILE, rTOS 1 r28 LBZU, rTOS rY rTOS LBZX, rTOS rX rTOS SUBF., NE UNTIL, \ If min len strings are equal, take n-m. rTOS 0 CMPI, EQ IF, rTOS r29 MOVE., THEN, \ t= signum(t) NE IF, rTOS rTOS 31 SRAWI, rTOS 1 ORI, THEN, \ Restore local registers. r28 0 rRSP LWZ, r29 4 rRSP LWZ, r30 8 rRSP LWZ, r31 12 rRSP LWZ, rRSP 16 ADDI, NEXT, END-CODE : Skip-Preceding-Items ( str len head -- prev item|0 ) dup 2SWAP 2>R ( prev head)( R: str len) BEGIN NIP dup @ dup WHILE over + dup >ITEM COUNT 2R@ Compare-Item 0< NOT UNTIL >ITEM dup COUNT 2R@ Compare-Item 0= AND THEN ( prev item|0) 2R> 2DROP ( R: ) ; \ ********************** Scan-List-for-Item *********************** 256 chars BUFFER: Verbatim-Item 256 chars BUFFER: Uppercase-Item : Scan-List-for-Item ( str len list -- prev item|0 ) >R 2dup verbatim-item place uppercase-item place uppercase-item count 2dup string->upper 2DUP R@ >Hash-Function 2@ EXECUTE 'th R> ( str len offset) >SUBLISTS ( str len sublist) Skip-Preceding-Items ; \ ************************ Place-New-Item ************************* : Place-New-Item ( str len prev -- item ) >LINK ( str len) HERE >R 2DROP Verbatim-Item COUNT STRING, HERE aligned HERE ?DO 0 C, LOOP R> ( item) ; \ ******************************************************************* \ All functions ending with "ITEM" return the address of the \ alphanumeric identification of a node. \ Functions with "NEW" add a new node. This will be before any \ existing node with the same alphanumeric identification. \ ITEM ( str len list -- item|0 ) \ Look up string _str len_ in _list_. If found, return _item_, \ the address of the alphanumeric identification. If not found, \ return 0. \ ADD-NEW-ITEM ( str len list -- item ) \ Add node with alphanumeric identification _str len_ to _list_. \ Return address where inserted. \ ADD-ITEM ( str len list -- item ) \ Look up string _str [en_ in _list_. If not found, add node. \ ADD-NEW ( str len list -- ) \ Add node with alphanumeric identification _str len_ to _list_. \ ADD ( str len list -- ) \ Add node with alphanumeric identification _str len_ to _list_ \ if not found. \ ***************************** ITEM ****************************** : ITEM ( str len list -- item|0 ) Scan-List-for-Item NIP ; \ *************************** Add-Item **************************** : Add-Item ( str len list -- item ) >R ( str len) 2dup R@ Scan-List-for-Item ( str len prev item) dup IF NIP NIP NIP ELSE DROP ( str len prev) Place-New-Item ( item) R@ >Info-Reserve @ Allot-Erase THEN R> DROP ; \ ************************* Add-New-Item ************************** : Add-New-Item ( str len list -- item ) >R 2dup R@ Scan-List-for-Item ( str len prev item) DROP ( str len prev) Place-New-Item ( item) R> >Info-Reserve @ Allot-Erase ; \ **************************** Add-New **************************** : Add-New ( str len list -- ) Add-New-Item DROP ; : ADD ( str len list -- ) Add-Item DROP ; \ ******************************************************************* \ FOR-EACH-ITEM ( list -- item )( C: orig dest ) \ Start of loop yielding address of alphanumeric identification \ of each node in _list_. \ OLDDEPTH ( -- addr ) \ Variable to save current `DEPTH`. \ SAVE-DEPTH ( -- ) \ Save current `DEPTH` in `OLDDEPTH`. \ CHECK-DEPTH ( -- ) \ Display message if `DEPTH` changed. \ BEGIN? ( C: -- dest ) \ `BEGIN` with check for unchanged depth of stack. \ ITEMS ( list -- ) \ Display alphanumeric identification of each node in _list_. \ SUBITEMS ( list -- ) \ Display alphanumeric identification of each node in the \ sublists of _list_. \ #ITEMS ( list -- n ) \ Number of items in _list_. \ PRUNE-LINKS ( lo hi head -- ) \ Remove nodes within addresses _lo hi_ in linked list at _head_. VARIABLE OLDDEPTH \ ************************** Save-Depth *************************** : Save-Depth ( -- ) DEPTH OLDDEPTH ! ; \ ************************** Check-Depth ************************** : Check-Depth ( ... -- same ) DEPTH OLDDEPTH @ < ABORT" Stack shrinking." DEPTH OLDDEPTH @ > ABORT" Stack growing." ; \ **************************** BEGIN? ***************************** : BEGIN? ( C: -- dest ) S" SAVE-DEPTH BEGIN CHECK-DEPTH " EVALUATE ; IMMEDIATE \ ********************** Choose-Listing-Heap ********************** 0 VALUE Listing-Heap CREATE Default-Listing-Heap #SUBLISTS 1+ CELLS ALLOT : Choose-Listing-Heap ( list -- ) dup >#SUBLISTS @ #SUBLISTS > IF align HERE over >#SUBLISTS @ 1+ CELLS ALLOT ELSE Default-Listing-Heap THEN to Listing-Heap DROP ; \ *********************** Add-Node-to-Heap ************************ : Add-Node-to-Heap ( n node -- n+1 ) >R 1+ dup ( n j) BEGIN dup 2/ ( n j i) dup WHILE dup 'th Listing-Heap @ >ITEM COUNT R@ >ITEM COUNT COMPARE(NC) 0> WHILE dup 'th Listing-Heap @ ROT 'th Listing-Heap ! REPEAT THEN DROP R> SWAP 'th Listing-Heap ! ; \ ************************** List->Heap *************************** : List->Heap ( list -- ) dup Choose-Listing-Heap 0 SWAP ( n list) >#SUBLISTS @++ ( n sublists #) CELLS BOUNDS DO ( n) I @REL ?dup IF ( n node) Add-Node-to-Heap THEN ( n) 1 CELLS +LOOP Listing-Heap ! ; \ ************************* Traverse-Heap ************************* : Traverse-Heap ( -- item true | 0 ) Listing-Heap @ 0= IF 0 EXIT THEN Listing-Heap CELL+ @ dup >ITEM SWAP @REL ( item node) dup 0= IF DROP Listing-Heap dup -1 SWAP +! @ dup 0= IF DROP TRUE EXIT THEN 1+ 'th Listing-Heap @ THEN >R 1 BEGIN ( . j) dup 2* ( . i j) dup Listing-Heap @ > NOT WHILE dup Listing-Heap @ < IF dup >R dup 1+ 'th Listing-Heap @ >ITEM COUNT R> 'th Listing-Heap @ >ITEM COUNT COMPARE(NC) 0< IF 1+ THEN THEN dup 'th Listing-Heap @ >ITEM COUNT R@ >ITEM COUNT COMPARE(NC) 0< WHILE dup 'th Listing-Heap @ ROT 'th Listing-Heap ! REPEAT THEN DROP ( . i) R> SWAP 'th Listing-Heap ! ( item) TRUE ; \ ************************* FOR-EACH-ITEM ************************* : FOR-EACH-ITEM ( list -- item ) S" List->Heap BEGIN? Traverse-Heap WHILE " EVALUATE ; IMMEDIATE \ ***************************** >INFO ***************************** : >INFO ( item -- addr ) COUNT chars + aligned ; \ ************************** Char-Break *************************** VARIABLE Initial-Char-in-Item \ VARIABLE C# \ : ?CR ( n -- ) \ dup C# @ + #Chars/Line > \ IF CR 0 C# ! THEN \ C# +! ; : Char-Break ( char -- ) Char>Upper Initial-Char-in-Item ( char addr) 2dup @ <> IF C# @ IF CR 0 C# ! THEN CR THEN ! ; \ ***************************** ITEMS ***************************** : ITEMS ( list -- ) 0 TEMP ! #Chars/Line C# ! FOR-EACH-ITEM COUNT ( str len) 1 TEMP +! over C@ Char-Break dup 3 + ?CR TYPE 3 SPACES ( ) REPEAT CR TEMP @ . ; \ *************************** SUBITEMS **************************** : SUBITEMS ( list -- n ) #CHARS/LINE C# ! >#SUBLISTS @++ 0 DO ( item) C# @ IF CR CR 0 C# ! THEN I 'th over @REL IF I . CR THEN I 'th over BEGIN @REL dup WHILE dup >ITEM COUNT dup 3 + ?CR TYPE 3 SPACES REPEAT DROP LOOP DROP ; \ **************************** #ITEMS ***************************** : #ITEMS ( list -- n ) 0 TEMP ! >#SUBLISTS @++ CELLS BOUNDS DO ( item) I BEGIN @REL DUP WHILE 1 TEMP +! REPEAT DROP 1 CELLS +LOOP TEMP @ ; \ ************************** Prune-Nodes ************************** : Prune-Nodes ( lo hi head -- ) ROT ROT 2>R ( prev)( R: lo hi) BEGIN dup @REL ( prev node) dup WHILE dup 2R@ WITHIN IF @REL over !REL ELSE NIP THEN ( node) REPEAT ( prev node) 2DROP ( ) 2R> 2DROP ; \\ ****************** Alphabetic-List Glossary ******************** ADD ( str len list -- ) ALPHLIST Add node with alphanumeric identification _str len_ to _list_ if not found. ADD-ITEM ( str len list -- item ) ALPHLIST Look up string _str [en_ in _list_. If not found, add node. ADD-NEW ( str len list -- ) ALPHLIST Add node with alphanumeric identification _str len_ to _list_. ADD-NEW-ITEM ( str len list -- item ) ALPHLIST Add node with alpham|0 ) ALPHLIST Look up string _str len_ in _list_. If found, return _item_, the address of the alphanumeric identification. If not found, return 0. ITEMS ( list -- ) ALPHLIST Display alphanumeric identification of each node in _list_. PRUNE-LINKS ( lo hi head -- ) ALPHLIST Remove nodes within addresses _lo hi_ in linked list at _head_. RESERVED ( n list -- ) ALPHLIST Assign amount of space to reserve for information in nodes. SIMPLE-ALPHABETIC-LIST ( "name" -- ) ALPHLIST Create and initialize alphabetic list _name_. This can be used when the total number of nodes is small. \\ // \\ // \\ // \\ // \\ // \\ // \\ // \\