/samples/dict3.fth
https://github.com/jephthai/EvilVM · Forth · 174 lines · 140 code · 34 blank · 0 comment · 15 complexity · d8d23c635b72dd8a9bf0bdf2dd8d29ce MD5 · raw file
- 0 !echo
- \ This is an example of building and using a "dictionary" in EvilForth.
- \ The implementation is via a binary search tree (BST). This is not as
- \ efficient as a more complex hash table, but does quite well at making
- \ insertions and retrievals speedy, without the complexity of handling
- \ collisions, etc.
- \ Constructors for two types of elements in a list. We allocate the
- \ nodes in the dictionary, which does mean they cannot easily be
- \ reclaimed.
- : node here >r 0 , , , , r> ;
- : leaf 0 0 rot node ;
- \ offsets into a node structure that we can use to refer to each of the
- \ components by name. This makes code later on much more readable.
- : >value ;
- : >data cell + ;
- : >right cell + cell + ;
- : >left cell + cell + cell + ;
- \ A simple in-order traversal of the tree.
- : inorder
- dup 0= if 2drop return then
- 2dup >left @ recurse
- 2dup >data @ swap execute
- >right @ tail ;
- \ Comparing a value against a node -- this hard-codes "2@" as an
- \ "accessor" function for node keys. In a more generalized solution, we
- \ might make this configurable (or make it live with the definition of
- \ the tree), in case we wanted to key our objects differently.
- : node-cmp >r 2@ r> >data @ 2@ strcmp ;
- \ Now we get to insertions. This may appear a little odd, but it turns
- \ out to be convenient to use three parameters to an insert. We have
- \ the new key, the branch pointer we just took, and the current node
- \ for examination. This allows us to insert the node when we reach a
- \ leaf, instead of recursing expensively and handling the addition in
- \ post.
- \ These two will turn a key and a node into a key, branch pointer, and
- \ child node prior to recursion.
- : go-left dup >r >left r> >left @ ;
- : go-right dup >r >right r> >right @ ;
- : insert ( key branch node -- node )
- \ hit a leaf? make a new node, and grow the branch
- dup 0= if drop >r leaf dup r> ! return then
- \ ignore the branch we came from; compare and tail
- nip 2dup node-cmp
- dup equal = if drop nip return then
- less = if go-left tail then
- go-right tail
- ;
- \ When we search the tree, we recurse until we either find a matching
- \ node, or fail. We leave a pointer to the tree node that matched if
- \ we are successul, which simplifies access to the node's data and
- \ setting values.
- : tree-get ( key tree -- node )
- dup 0= if nip return then
- 2dup node-cmp
- dup equal = if drop nip return then
- dup less = if drop >left @ tail then
- more = if >right @ tail then
- 2drop 0 ;
- \ We encourage storing a pointer to a tree, so this wrapper makes the
- \ interface consistent with that model.
- : tree-get @ tree-get ;
- : tree-set ( value key tree -- )
- dup @ insert >value ! ;
- \ ------------------------------------------------------------------------
- \ Demo / test code follows
- \ ------------------------------------------------------------------------
- \ We will define a pointer to a tree; it starts as an empty tree (NULL)
- variable tree tree off
- \ We will define keys as pointers to strings using this convenient parser
- : name
- create readline trim ( addr u )
- here 16 allot over here swap rot 2! here over allot swap move ;
- \ Some of our most favorite fantasy heroes
- name n1 Gandalf
- name n2 Aragorn
- name n3 Gimli
- name n4 Legolas
- name n5 Frodo
- name f0 The Balrog
- name n6 Sam
- name n7 Merry
- name n8 Pippin
- name n9 Boromir
- name e0 Smaug
- name e1 Eowyn
- name e2 Arwen
- \ We'll build a dictionary mapping the character names to my own personal
- \ wildly inaccurate estimate of their weights in pounds.
- 180 n1 tree tree-set
- 190 n2 tree tree-set
- 165 n3 tree tree-set
- 135 n4 tree tree-set
- 90 n5 tree tree-set
- 105 n6 tree tree-set
- 87 n7 tree tree-set
- 950 f0 tree tree-set
- 99 n8 tree tree-set
- 210 n9 tree tree-set
- 22150 e0 tree tree-set
- \ Demonstrate an in-order traversal
- { ." Here are our heroes in alphabetical order:\n" }!
- cr magenta { 2@ type space } tree @ inorder clear
- cr cr
- \ Check to see if an entry is in the dictionary
- : test
- ." Is " dup 2@ blue type clear ." in list? "
- tree tree-get if
- green ." Yes"
- else
- red ." No"
- then
- clear cr ;
- \ Show the current weight of a character
- : weighs
- dup 2@ blue type clear ." weighs "
- tree tree-get
- dup 0= if
- red ." UNKNOWN " clear ." pounds\n"
- else
- >value @ cyan . clear ." pounds\n"
- then ;
- \ Do some testing to see if it all works
- e1 test
- n3 test
- e2 test
- n7 test
- cr
- n1 weighs
- n7 weighs
- e0 weighs
- n8 weighs
- e1 weighs
- n9 weighs
- \ And if iterating through the contents of the dictionary is of any use,
- \ here's an example of doing that...
- cr
- { ." Actually, let's see all of them!\n\n" }!
- { weighs } tree @ inorder
- cr
- bye