/samples/dict3.fth

https://github.com/jephthai/EvilVM · Forth · 174 lines · 140 code · 34 blank · 0 comment · 15 complexity · d8d23c635b72dd8a9bf0bdf2dd8d29ce MD5 · raw file

  1. 0 !echo
  2. \ This is an example of building and using a "dictionary" in EvilForth.
  3. \ The implementation is via a binary search tree (BST). This is not as
  4. \ efficient as a more complex hash table, but does quite well at making
  5. \ insertions and retrievals speedy, without the complexity of handling
  6. \ collisions, etc.
  7. \ Constructors for two types of elements in a list. We allocate the
  8. \ nodes in the dictionary, which does mean they cannot easily be
  9. \ reclaimed.
  10. : node here >r 0 , , , , r> ;
  11. : leaf 0 0 rot node ;
  12. \ offsets into a node structure that we can use to refer to each of the
  13. \ components by name. This makes code later on much more readable.
  14. : >value ;
  15. : >data cell + ;
  16. : >right cell + cell + ;
  17. : >left cell + cell + cell + ;
  18. \ A simple in-order traversal of the tree.
  19. : inorder
  20. dup 0= if 2drop return then
  21. 2dup >left @ recurse
  22. 2dup >data @ swap execute
  23. >right @ tail ;
  24. \ Comparing a value against a node -- this hard-codes "2@" as an
  25. \ "accessor" function for node keys. In a more generalized solution, we
  26. \ might make this configurable (or make it live with the definition of
  27. \ the tree), in case we wanted to key our objects differently.
  28. : node-cmp >r 2@ r> >data @ 2@ strcmp ;
  29. \ Now we get to insertions. This may appear a little odd, but it turns
  30. \ out to be convenient to use three parameters to an insert. We have
  31. \ the new key, the branch pointer we just took, and the current node
  32. \ for examination. This allows us to insert the node when we reach a
  33. \ leaf, instead of recursing expensively and handling the addition in
  34. \ post.
  35. \ These two will turn a key and a node into a key, branch pointer, and
  36. \ child node prior to recursion.
  37. : go-left dup >r >left r> >left @ ;
  38. : go-right dup >r >right r> >right @ ;
  39. : insert ( key branch node -- node )
  40. \ hit a leaf? make a new node, and grow the branch
  41. dup 0= if drop >r leaf dup r> ! return then
  42. \ ignore the branch we came from; compare and tail
  43. nip 2dup node-cmp
  44. dup equal = if drop nip return then
  45. less = if go-left tail then
  46. go-right tail
  47. ;
  48. \ When we search the tree, we recurse until we either find a matching
  49. \ node, or fail. We leave a pointer to the tree node that matched if
  50. \ we are successul, which simplifies access to the node's data and
  51. \ setting values.
  52. : tree-get ( key tree -- node )
  53. dup 0= if nip return then
  54. 2dup node-cmp
  55. dup equal = if drop nip return then
  56. dup less = if drop >left @ tail then
  57. more = if >right @ tail then
  58. 2drop 0 ;
  59. \ We encourage storing a pointer to a tree, so this wrapper makes the
  60. \ interface consistent with that model.
  61. : tree-get @ tree-get ;
  62. : tree-set ( value key tree -- )
  63. dup @ insert >value ! ;
  64. \ ------------------------------------------------------------------------
  65. \ Demo / test code follows
  66. \ ------------------------------------------------------------------------
  67. \ We will define a pointer to a tree; it starts as an empty tree (NULL)
  68. variable tree tree off
  69. \ We will define keys as pointers to strings using this convenient parser
  70. : name
  71. create readline trim ( addr u )
  72. here 16 allot over here swap rot 2! here over allot swap move ;
  73. \ Some of our most favorite fantasy heroes
  74. name n1 Gandalf
  75. name n2 Aragorn
  76. name n3 Gimli
  77. name n4 Legolas
  78. name n5 Frodo
  79. name f0 The Balrog
  80. name n6 Sam
  81. name n7 Merry
  82. name n8 Pippin
  83. name n9 Boromir
  84. name e0 Smaug
  85. name e1 Eowyn
  86. name e2 Arwen
  87. \ We'll build a dictionary mapping the character names to my own personal
  88. \ wildly inaccurate estimate of their weights in pounds.
  89. 180 n1 tree tree-set
  90. 190 n2 tree tree-set
  91. 165 n3 tree tree-set
  92. 135 n4 tree tree-set
  93. 90 n5 tree tree-set
  94. 105 n6 tree tree-set
  95. 87 n7 tree tree-set
  96. 950 f0 tree tree-set
  97. 99 n8 tree tree-set
  98. 210 n9 tree tree-set
  99. 22150 e0 tree tree-set
  100. \ Demonstrate an in-order traversal
  101. { ." Here are our heroes in alphabetical order:\n" }!
  102. cr magenta { 2@ type space } tree @ inorder clear
  103. cr cr
  104. \ Check to see if an entry is in the dictionary
  105. : test
  106. ." Is " dup 2@ blue type clear ." in list? "
  107. tree tree-get if
  108. green ." Yes"
  109. else
  110. red ." No"
  111. then
  112. clear cr ;
  113. \ Show the current weight of a character
  114. : weighs
  115. dup 2@ blue type clear ." weighs "
  116. tree tree-get
  117. dup 0= if
  118. red ." UNKNOWN " clear ." pounds\n"
  119. else
  120. >value @ cyan . clear ." pounds\n"
  121. then ;
  122. \ Do some testing to see if it all works
  123. e1 test
  124. n3 test
  125. e2 test
  126. n7 test
  127. cr
  128. n1 weighs
  129. n7 weighs
  130. e0 weighs
  131. n8 weighs
  132. e1 weighs
  133. n9 weighs
  134. \ And if iterating through the contents of the dictionary is of any use,
  135. \ here's an example of doing that...
  136. cr
  137. { ." Actually, let's see all of them!\n\n" }!
  138. { weighs } tree @ inorder
  139. cr
  140. bye