Although any expression in Joy can be considered to describe a tree with the quotes as compound nodes and the non-quote values as leaf nodes, in this page I want to talk about ordered binary trees and how to make and use them.
The basic structure, in a crude type notation, is:
Tree :: [] | [key value Tree Tree]
That says that a Tree is either the empty quote [] or a quote with four items: a key, a value, and two Trees representing the left and right branches of the tree.
We're going to derive some recursive functions to work with such datastructures:
Tree-add
Tree-delete
Tree-get
Tree-iter
Tree-iter-order
Once these functions are defined we have a new "type" to work with, and the Sufficiently Smart Compiler can be modified to use an optimized implementation under the hood. (Where does the "type" come from? It has a contingent existence predicated on the disciplined use of these functions on otherwise undistinguished Joy datastructures.)
from notebook_preamble import D, J, V, define, DefinitionWrapper
Let's consider adding nodes to a Tree structure.
Tree value key Tree-add
-----------------------------
Tree′If the current node is [] then you just return [key value [] []]:
Tree-add == [popop not] [[pop] dipd Tree-new] [R0] [R1] genrec
Tree-new¶Where Tree-new is defined as:
value key Tree-new
------------------------
[key value [] []]
Example:
value key swap [[] []] cons cons
key value [[] []] cons cons
key [value [] []] cons
[key value [] []]
Definition:
Tree-new == swap [[] []] cons consdefine('Tree-new == swap [[] []] cons cons')
J('"v" "k" Tree-new')
(As an implementation detail, the [[] []] literal used in the definition of Tree-new will be reused to supply the constant tail for all new nodes produced by it. This is one of those cases where you get amortized storage "for free" by using persistent datastructures. Because the tail, which is ((), ((), ())) in Python, is immutable and embedded in the definition body for Tree-new, all new nodes can reuse it as their own tail without fear that some other code somewhere will change it.)
We now have to derive R0 and R1, consider:
[key_n value_n left right] value key R0 [Tree-add] R1
In this case, there are three possibilites: the key can be greater or less than or equal to the node's key. In two of those cases we will need to apply a copy of Tree-add, so R0 is pretty much out of the picture.
[R0] == [][key_n value_n left right] value key [BTree-add] R1
The first thing we need to do is compare the the key we're adding to the node key and branch accordingly:
[key_n value_n left right] value key [BTree-add] [P] [T] [E] ifte
That would suggest something like:
[key_n value_n left right] value key [BTree-add] P
[key_n value_n left right] value key [BTree-add] pop roll> pop first >
[key_n value_n left right] value key roll> pop first >
key [key_n value_n left right] value roll> pop first >
key key_n >
Boolean
Let's abstract the predicate just a little to let us specify the comparison operator:
P > == pop roll> pop first >
P < == pop roll> pop first <
P == pop roll> pop firstdefine('P == pop roll> pop first')
J('["old_key" 23 [] []] 17 "new_key" ["..."] P')
Here the parentheses are meant to signify that the expression is not literal, the code in the parentheses is meant to have been evaluated:
[key_n value_n left right] value key [Tree-add] T
-------------------------------------------------------
[key_n value_n left (Tree-add key value right)]So how do we do this? We're going to want to use infra on some function K that has the key and value to work with, as well as the quoted copy of Tree-add to apply somehow. Considering the node as a stack:
right left value_n key_n value key [Tree-add] K
-----------------------------------------------------
right value key Tree-add left value_n key_n
Pretty easy:
right left value_n key_n value key [Tree-add] cons cons dipdd
right left value_n key_n [value key Tree-add] dipdd
right value key Tree-add left value_n key_n
So:
K == cons cons dipdd
Looking at it from the point-of-view of the node as node again:
[key_n value_n left right] [value key [Tree-add] K] infra
Expand K and evaluate a little:
[key_n value_n left right] [value key [Tree-add] K] infra
[key_n value_n left right] [value key [Tree-add] cons cons dipdd] infra
[key_n value_n left right] [[value key Tree-add] dipdd] infra
Then, working backwards:
[key_n value_n left right] [[value key Tree-add] dipdd] infra
[key_n value_n left right] [value key Tree-add] [dipdd] cons infra
[key_n value_n left right] value key [Tree-add] cons cons [dipdd] cons infraAnd so T is just:
T == cons cons [dipdd] cons infradefine('T == cons cons [dipdd] cons infra')
J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] T')
This is very very similar to the above:
[key_n value_n left right] value key [Tree-add] E
[key_n value_n left right] value key [Tree-add] [P <] [Te] [Ee] iftedefine('E == [P <] [Te] [Ee] ifte')
In this case Te works that same as T but on the left child tree instead of the right, so the only difference is that it must use dipd instead of dipdd:
Te == cons cons [dipd] cons infradefine('Te == cons cons [dipd] cons infra')
J('["old_k" "old_value" "left" "right"] "new_value" "new_key" ["Tree-add"] Te')
This means we must find:
[key old_value left right] new_value key [Tree-add] Ee
------------------------------------------------------------
[key new_value left right]This is another easy one:
Ee == pop swap roll< rest rest cons consExample:
[key old_value left right] new_value key [Tree-add] pop swap roll< rest rest cons cons
[key old_value left right] new_value key swap roll< rest rest cons cons
[key old_value left right] key new_value roll< rest rest cons cons
key new_value [key old_value left right] rest rest cons cons
key new_value [ left right] cons cons
[key new_value left right]define('Ee == pop swap roll< rest rest cons cons')
J('["k" "old_value" "left" "right"] "new_value" "k" ["Tree-add"] Ee')
Tree-add¶Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec
Putting it all together:
Tree-new == swap [[] []] cons cons
P == pop roll> pop first
T == cons cons [dipdd] cons infra
Te == cons cons [dipd] cons infra
Ee == pop swap roll< rest rest cons cons
E == [P <] [Te] [Ee] ifte
R == [P >] [T] [E] ifte
Tree-add == [popop not] [[pop] dipd Tree-new] [] [R] genrecdefine('Tree-add == [popop not] [[pop] dipd Tree-new] [] [[P >] [T] [E] ifte] genrec')
J('[] 23 "b" Tree-add') # Initial
J('["b" 23 [] []] 88 "c" Tree-add') # Greater than
J('["b" 23 [] []] 88 "a" Tree-add') # Less than
J('["b" 23 [] []] 88 "b" Tree-add') # Equal to
J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Series.
J('[] [[23 "b"] [88 "a"] [44 "c"]] [i Tree-add] step')
cmp combinator¶Instead of mucking about with nested ifte combinators let's use cmp which takes two values and three quoted programs on the stack and runs one of the three depending on the results of comparing the two values:
a b [G] [E] [L] cmp
------------------------- a > b
G
a b [G] [E] [L] cmp
------------------------- a = b
E
a b [G] [E] [L] cmp
------------------------- a < b
LJ("1 0 ['G'] ['E'] ['L'] cmp")
J("1 1 ['G'] ['E'] ['L'] cmp")
J("0 1 ['G'] ['E'] ['L'] cmp")
Tree-add¶We need a new non-destructive predicate P:
[node_key node_value left right] value key [Tree-add] P
------------------------------------------------------------------------
[node_key node_value left right] value key [Tree-add] key node_keyLet's start with over to get a copy of the key and then apply some function Q with the nullary combinator so it can dig out the node key (by throwing everything else away):
P == over [Q] nullary
[node_key node_value left right] value key [Tree-add] over [Q] nullary
[node_key node_value left right] value key [Tree-add] key [Q] nullaryAnd Q would be:
Q == popop popop first
[node_key node_value left right] value key [Tree-add] key Q
[node_key node_value left right] value key [Tree-add] key popop popop first
[node_key node_value left right] value key popop first
[node_key node_value left right] first
node_keyOr just:
P == over [popop popop first] nullarydefine('P == over [popop popop first] nullary')
Using cmp to simplify our code above at R1:
[node_key node_value left right] value key [Tree-add] R1
[node_key node_value left right] value key [Tree-add] P [T] [E] [Te] cmpThe line above becomes one of the three lines below:
[node_key node_value left right] value key [Tree-add] T
[node_key node_value left right] value key [Tree-add] E
[node_key node_value left right] value key [Tree-add] TeThe definition is a little longer but, I think, more elegant and easier to understand:
Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrecdefine('Tree-add == [popop not] [[pop] dipd Tree-new] [] [P [T] [Ee] [Te] cmp] genrec')
J('[] 23 "b" Tree-add 88 "a" Tree-add 44 "c" Tree-add') # Still works.
Let's take a crack at writing a function that can recursively iterate or traverse these trees.
[]¶The stopping predicate just has to detect the empty list:
Tree-iter == [not] [E] [R0] [R1] genrec
And since there's nothing at this node, we just pop it:
Tree-iter == [not] [pop] [R0] [R1] genrec[key value left right]¶Now we need to figure out R0 and R1:
Tree-iter == [not] [pop] [R0] [R1] genrec
== [not] [pop] [R0 [Tree-iter] R1] ifte
Let's look at it in situ:
[key value left right] R0 [Tree-iter] R1R0 is almost certainly going to use dup to make a copy of the node and then dip on some function to process the copy with it:
[key value left right] [F] dupdip [Tree-iter] R1
[key value left right] F [key value left right] [Tree-iter] R1
For example, if we're getting all the keys F would be first:
R0 == [first] dupdip
[key value left right] [first] dupdip [Tree-iter] R1
[key value left right] first [key value left right] [Tree-iter] R1
key [key value left right] [Tree-iter] R1Now R1 needs to apply [Tree-iter] to left and right. If we drop the key and value from the node using rest twice we are left with an interesting situation:
key [key value left right] [Tree-iter] R1
key [key value left right] [Tree-iter] [rest rest] dip
key [key value left right] rest rest [Tree-iter]
key [left right] [Tree-iter]
Hmm, will step do?
key [left right] [Tree-iter] step
key left Tree-iter [right] [Tree-iter] step
key left-keys [right] [Tree-iter] step
key left-keys right Tree-iter
key left-keys right-keys
Neat. So:
R1 == [rest rest] dip stepWe have:
Tree-iter == [not] [pop] [[F] dupdip] [[rest rest] dip step] genrec
When I was reading this over I realized rest rest could go in R0:
Tree-iter == [not] [pop] [[F] dupdip rest rest] [step] genrec
(And [step] genrec is such a cool and suggestive combinator!)
F per-node processing function.¶ [F] Tree-iter
------------------------------------------------------
[not] [pop] [[F] dupdip rest rest] [step] genrec
Working backward:
[not] [pop] [[F] dupdip rest rest] [step] genrec
[not] [pop] [F] [dupdip rest rest] cons [step] genrec
[F] [not] [pop] roll< [dupdip rest rest] cons [step] genrecTree-iter¶Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrecdefine('Tree-iter == [not] [pop] roll< [dupdip rest rest] cons [step] genrec')
J('[] [foo] Tree-iter') # It doesn't matter what F is as it won't be used.
J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [first] Tree-iter")
J("['b' 23 ['a' 88 [] []] ['c' 44 [] []]] [second] Tree-iter")
We can use this to make a set-like datastructure by just setting values to e.g. 0 and ignoring them. It's set-like in that duplicate items added to it will only occur once within it, and we can query it in $O(\log_2 N)$ time.
J('[] [3 9 5 2 8 6 7 8 4] [0 swap Tree-add] step')
define('to_set == [] swap [0 swap Tree-add] step')
J('[3 9 5 2 8 6 7 8 4] to_set')
And with that we can write a little program unique to remove duplicate items from a list.
define('unique == [to_set [first] Tree-iter] cons run')
J('[3 9 3 5 2 9 8 8 8 6 2 7 8 4 3] unique') # Filter duplicate items.
Tree-iter that does In-Order Traversal¶If you look back to the non-empty case of the Tree-iter function we can design a variant that first processes the left child, then the current node, then the right child. This will allow us to traverse the tree in sort order.
Tree-iter-order == [not] [pop] [R0] [R1] genrec
To define R0 and R1 it helps to look at them as they will appear when they run:
[key value left right] R0 [BTree-iter-order] R1Staring at this for a bit suggests dup third to start:
[key value left right] R0 [Tree-iter-order] R1
[key value left right] dup third [Tree-iter-order] R1
[key value left right] left [Tree-iter-order] R1Now maybe:
[key value left right] left [Tree-iter-order] [cons dip] dupdip
[key value left right] left [Tree-iter-order] cons dip [Tree-iter-order]
[key value left right] [left Tree-iter-order] dip [Tree-iter-order]
left Tree-iter-order [key value left right] [Tree-iter-order]So far, so good. Now we need to process the current node's values:
left Tree-iter-order [key value left right] [Tree-iter-order] [[F] dupdip] dip
left Tree-iter-order [key value left right] [F] dupdip [Tree-iter-order]
left Tree-iter-order [key value left right] F [key value left right] [Tree-iter-order]
If F needs items from the stack below the left stuff it should have cons'd them before beginning maybe? For functions like first it works fine as-is.
left Tree-iter-order [key value left right] first [key value left right] [Tree-iter-order]
left Tree-iter-order key [key value left right] [Tree-iter-order]First ditch the rest of the node and get the right child:
left Tree-iter-order key [key value left right] [Tree-iter-order] [rest rest rest first] dip
left Tree-iter-order key right [Tree-iter-order]
Then, of course, we just need i to run Tree-iter-order on the right side:
left Tree-iter-order key right [Tree-iter-order] i
left Tree-iter-order key right Tree-iter-orderTree-iter-order¶The result is a little awkward:
R1 == [cons dip] dupdip [[F] dupdip] dip [rest rest rest first] dip i
Let's do a little semantic factoring:
fourth == rest rest rest first
proc_left == [cons dip] dupdip
proc_current == [[F] dupdip] dip
proc_right == [fourth] dip i
Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
Now we can sort sequences.
#define('Tree-iter-order == [not] [pop] [dup third] [[cons dip] dupdip [[first] dupdip] dip [rest rest rest first] dip i] genrec')
DefinitionWrapper.add_definitions('''
fourth == rest rest rest first
proc_left == [cons dip] dupdip
proc_current == [[first] dupdip] dip
proc_right == [fourth] dip i
Tree-iter-order == [not] [pop] [dup third] [proc_left proc_current proc_right] genrec
''', D)
J('[3 9 5 2 8 6 7 8 4] to_set Tree-iter-order')
Parameterizing the [F] function is left as an exercise for the reader.
Let's derive a function that accepts a tree and a key and returns the value associated with that key.
tree key Tree-get
-----------------------
value
But what do we do if the key isn't in the tree? In Python we might raise a KeyError but I'd like to avoid exceptions in Joy if possible, and here I think it's possible. (Division by zero is an example of where I think it's probably better to let Python crash Joy. Sometimes the machinery fails and you have to "stop the line", I think.)
Let's pass the buck to the caller by making the base case a given, you have to decide for yourself what [E] should be.
tree key [E] Tree-get
---------------------------- key in tree
value
tree key [E] Tree-get
---------------------------- key not in tree
[] key E[]¶As before, the stopping predicate just has to detect the empty list:
Tree-get == [pop not] [E] [R0] [R1] genrec
So we define:
Tree-get == [pop not] swap [R0] [R1] genrec
Note that this Tree-get creates a slightly different function than itself and that function does the actual recursion. This kind of higher-level programming is unusual in most languages but natural in Joy.
tree key [E] [pop not] swap [R0] [R1] genrec
tree key [pop not] [E] [R0] [R1] genrec
The anonymous specialized recursive function that will do the real work.
[pop not] [E] [R0] [R1] genrec[key value left right]¶Now we need to figure out R0 and R1:
[key value left right] key R0 [BTree-get] R1
We want to compare the search key with the key in the node, and if they are the same return the value, otherwise recur on one of the child nodes. So it's very similar to the above funtion, with [R0] == [] and R1 == P [T>] [E] [T<] cmp:
[key value left right] key [BTree-get] P [T>] [E] [T<] cmpP == over [get-node-key] nullary
get-node-key == pop popop first
The only difference is that get-node-key does one less pop because there's no value to discard.
Now we have to derive the branches:
[key_n value_n left right] key [BTree-get] T>
[key_n value_n left right] key [BTree-get] E
[key_n value_n left right] key [BTree-get] T<The cases of T> and T< are similar to above but instead of using infra we have to discard the rest of the structure:
[key_n value_n left right] key [BTree-get] T>
---------------------------------------------------
right key BTree-get
And:
[key_n value_n left right] key [BTree-get] T<
---------------------------------------------------
left key BTree-get
So:
T> == [fourth] dipd i
T< == [third] dipd i
E.g.:
[key_n value_n left right] key [BTree-get] [fourth] dipd i
[key_n value_n left right] fourth key [BTree-get] i
right key [BTree-get] i
right key BTree-getReturn the node's value:
[key_n value_n left right] key [BTree-get] E == value_n
E == popop secondTree-get¶So:
fourth == rest rest rest first
get-node-key == pop popop first
P == over [get-node-key] nullary
T> == [fourth] dipd i
T< == [third] dipd i
E == popop second
Tree-get == [pop not] swap [] [P [T>] [E] [T<] cmp] genrec# I don't want to deal with name conflicts with the above so I'm inlining everything here.
# The original Joy system has "hide" which is a meta-command which allows you to use named
# definitions that are only in scope for a given definition. I don't want to implement
# that (yet) so...
define('''
Tree-get == [pop not] swap [] [
over [pop popop first] nullary
[[fourth] dipd i]
[popop second]
[[third] dipd i]
cmp
] genrec
''')
J('["gary" 23 [] []] "mike" [popd " not in tree" +] Tree-get')
J('["gary" 23 [] []] "gary" [popop "err"] Tree-get')
J('''
[] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
'c' [popop 'not found'] Tree-get
''')
J('''
[] [[0 'a'] [1 'b'] [2 'c']] [i Tree-add] step
'd' [popop 'not found'] Tree-get
''')
Now let's write a function that can return a tree datastructure with a key, value pair deleted:
tree key Tree-delete
---------------------------
tree
If the key is not in tree it just returns the tree unchanged.
Now we get to figure out the recursive case. We need the node's key to compare and we need to carry the key into recursive branches. Let D be shorthand for Tree-Delete:
D == Tree-Delete == [pop not] [pop] [R0] [R1] genrec
[node_key node_value left right] key R0 [D] R1
[node_key node_value left right] key over first swap dup [D] cons R1′
[node_key node_value left right] key [...] first swap dup [D] cons R1′
[node_key node_value left right] key node_key swap dup [D] cons R1′
[node_key node_value left right] node_key key dup [D] cons R1′
[node_key node_value left right] node_key key key [D] cons R1′
[node_key node_value left right] node_key key [key D] R1′And then:
[node_key node_value left right] node_key key [key D] R1′
[node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
[node_key node_value left right] node_key key [key D] roll> [T>] [E] [T<] cmp
[node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmpSo:
R0 == over first swap dup
R1 == cons roll> [T>] [E] [T<] cmpThe last line above:
[node_key node_value left right] [key D] node_key key [T>] [E] [T<] cmp
Then becomes one of these three:
[node_key node_value left right] [key D] T>
[node_key node_value left right] [key D] E
[node_key node_value left right] [key D] T< [node_key node_value left right] [F] T>
-------------------------------------------------
[node_key node_value (left F) right]
[node_key node_value left right] [F] T<
-------------------------------------------------
[node_key node_value left (right F)]First, treating the node as a stack:
right left node_value node_key [key D] dipd
right left key D node_value node_key
right left' node_value node_keyErgo:
[node_key node_value left right] [key D] [dipd] cons infraSo:
T> == [dipd] cons infra
T< == [dipdd] cons infraWe have found the node in the tree where key equals node_key. We need to replace the current node with something
[node_key node_value left right] [key D] E
------------------------------------------------
tree
We have to handle three cases, so let's use cond.
[]¶The first two cases are symmetrical: if we only have one non-empty child node return it. If both child nodes are empty return an empty node.
E == [
[[pop third not] pop fourth]
[[pop fourth not] pop third]
[default]
] condIf both child nodes are non-empty, we find the highest node in our lower sub-tree, take its key and value to replace (delete) our own, then get rid of it by recursively calling delete() on our lower sub-node with our new key.
(We could also find the lowest node in our higher sub-tree and take its key and value and delete it. I only implemented one of these two symmetrical options. Over a lot of deletions this might make the tree more unbalanced. Oh well.)
The initial structure of the default function:
default == [E′] cons infra
[node_key node_value left right] [key D] default
[node_key node_value left right] [key D] [E′] cons infra
[node_key node_value left right] [[key D] E′] infra
right left node_value node_key [key D] E′First things first, we no longer need this node's key and value:
right left node_value node_key [key D] roll> popop E″
right left [key D] node_value node_key popop E″
right left [key D] E″right left [key D] E″Ditch the key:
right left [key D] rest E‴
right left [D] E‴Find the right-most node:
right left [D] [dup W] dip E⁗
right left dup W [D] E⁗
right left left W [D] E⁗Consider:
left WWe know left is not empty:
[L_key L_value L_left L_right] WWe want to keep extracting the right node as long as it is not empty:
W.rightmost == [P] [B] while
left W.rightmost W′The predicate:
[L_key L_value L_left L_right] P
[L_key L_value L_left L_right] fourth
L_right
This can run on [] so must be guarded:
?fourth == [] [fourth] [] ifte( if_not_empty == [] swap [] ifte ?fourth == [fourth] if_not_empty )
The body is just fourth:
left [?fourth] [fourth] while W′
rightest W′So:
W.rightmost == [?fourth] [fourth] whileWe know rightest is not empty:
[R_key R_value R_left R_right] W′
[R_key R_value R_left R_right] W′
[R_key R_value R_left R_right] uncons uncons pop
R_key [R_value R_left R_right] uncons pop
R_key R_value [R_left R_right] pop
R_key R_valueSo:
W == [?fourth] [fourth] while uncons uncons popAnd:
right left left W [D] E⁗
right left R_key R_value [D] E⁗Final stretch. We want to end up with something like:
right left [R_key D] i R_value R_key
right left R_key D R_value R_key
right left′ R_value R_keyIf we adjust our definition of W to include over at the end:
W == [fourth] [fourth] while uncons uncons pop overThat will give us:
right left R_key R_value R_key [D] E⁗
right left R_key R_value R_key [D] cons dipd E⁗′
right left R_key R_value [R_key D] dipd E⁗′
right left R_key D R_key R_value E⁗′
right left′ R_key R_value E⁗′
right left′ R_key R_value swap
right left′ R_value R_keySo:
E′ == roll> popop E″
E″ == rest E‴
E‴ == [dup W] dip E⁗
E⁗ == cons dipdd swapSubstituting:
W == [fourth] [fourth] while uncons uncons pop over
E′ == roll> popop rest [dup W] dip cons dipd swap
E == [
[[pop third not] pop fourth]
[[pop fourth not] pop third]
[[E′] cons infra]
] condMinor rearrangement, move dup into W:
W == dup [fourth] [fourth] while uncons uncons pop over
E′ == roll> popop rest [W] dip cons dipd swap
E == [
[[pop third not] pop fourth]
[[pop fourth not] pop third]
[[E′] cons infra]
] condW.rightmost == [fourth] [fourth] while
W.unpack == uncons uncons pop
W == dup W.rightmost W.unpack over
E.clear_stuff == roll> popop rest
E.delete == cons dipd
E.0 == E.clear_stuff [W] dip E.delete swap
E == [
[[pop third not] pop fourth]
[[pop fourth not] pop third]
[[E.0] cons infra]
] cond
T> == [dipd] cons infra
T< == [dipdd] cons infra
R0 == over first swap dup
R1 == cons roll> [T>] [E] [T<] cmp
BTree-Delete == [pop not] swap [R0] [R1] genrec
By the standards of the code I've written so far, this is a huge Joy program.
DefinitionWrapper.add_definitions('''
first_two == uncons uncons pop
fourth == rest rest rest first
?fourth == [] [fourth] [] ifte
W.rightmost == [?fourth] [fourth] while
E.clear_stuff == roll> popop rest
E.delete == cons dipd
W == dup W.rightmost first_two over
E.0 == E.clear_stuff [W] dip E.delete swap
E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[E.0] cons infra]] cond
T> == [dipd] cons infra
T< == [dipdd] cons infra
R0 == over first swap dup
R1 == cons roll> [T>] [E] [T<] cmp
Tree-Delete == [pop not] [pop] [R0] [R1] genrec
''', D)
J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'c' Tree-Delete ")
J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'b' Tree-Delete ")
J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'a' Tree-Delete ")
J("['a' 23 [] ['b' 88 [] ['c' 44 [] []]]] 'der' Tree-Delete ")
J('[] [4 2 3 1 6 7 5 ] [0 swap Tree-add] step')
J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 3 Tree-Delete ")
J("[4 0 [2 0 [1 0 [] []] [3 0 [] []]] [6 0 [5 0 [] []] [7 0 [] []]]] 4 Tree-Delete ")
fourth == rest_two rest first
?fourth == [] [fourth] [] ifte
first_two == uncons uncons pop
ccons == cons cons
cinf == cons infra
rest_two == rest rest
_Tree_T> == [dipd] cinf
_Tree_T< == [dipdd] cinf
_Tree_add_P == over [popop popop first] nullary
_Tree_add_T> == ccons _Tree_T<
_Tree_add_T< == ccons _Tree_T>
_Tree_add_Ee == pop swap roll< rest_two ccons
_Tree_add_R == _Tree_add_P [_Tree_add_T>] [_Tree_add_Ee] [_Tree_add_T<] cmp
_Tree_add_E == [pop] dipd Tree-new
_Tree_iter_order_left == [cons dip] dupdip
_Tree_iter_order_current == [[F] dupdip] dip
_Tree_iter_order_right == [fourth] dip i
_Tree_iter_order_R == _Tree_iter_order_left _Tree_iter_order_current _Tree_iter_order_right
_Tree_get_P == over [pop popop first] nullary
_Tree_get_T> == [fourth] dipd i
_Tree_get_T< == [third] dipd i
_Tree_get_E == popop second
_Tree_get_R == _Tree_get_P [_Tree_get_T>] [_Tree_get_E] [_Tree_get_T<] cmp
_Tree_delete_rightmost == [?fourth] [fourth] while
_Tree_delete_clear_stuff == roll> popop rest
_Tree_delete_del == dip cons dipd swap
_Tree_delete_W == dup _Tree_delete_rightmost first_two over
_Tree_delete_E.0 == _Tree_delete_clear_stuff [_Tree_delete_W] _Tree_delete_del
_Tree_delete_E == [[[pop third not] pop fourth] [[pop fourth not] pop third] [[_Tree_delete_E.0] cinf]] cond
_Tree_delete_R0 == over first swap dup
_Tree_delete_R1 == cons roll> [_Tree_T>] [_Tree_delete_E] [_Tree_T<] cmp
Tree-new == swap [[] []] ccons
Tree-add == [popop not] [_Tree_add_E] [] [_Tree_add_R] genrec
Tree-iter == [not] [pop] roll< [dupdip rest_two] cons [step] genrec
Tree-iter-order == [not] [pop] [dup third] [_Tree_iter_order_R] genrec
Tree-get == [pop not] swap [] [_Tree_get_R] genrec
Tree-delete == [pop not] [pop] [_Tree_delete_R0] [_Tree_delete_R1] genrec