mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-11-11 04:48:00 +03:00
Merge branch 'philip/behn-priority' (#2915)
* philip/behn-priority: zuse: add +ordered-map behn: switch to ordered-map Signed-off-by: Philip Monk <phil@pcmonk.me>
This commit is contained in:
Philip Monk
commit
1757b4e071
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:ecfe53c9e00d8cba244c85eb0ec0ed3b4e8ac07737bb0c6a7aa57d6c52f52c85
|
||||
size 15993675
|
||||
oid sha256:dcf42dc6de3a149a91677c3c8129f401b0c1f1a13338eaa1812ba32c25d37208
|
||||
size 12873778
|
||||
|
||||
@ -121,256 +121,6 @@
|
||||
=>
|
||||
~% %ames-generics ..is ~
|
||||
|%
|
||||
+| %generics
|
||||
:: $mk-item: constructor for +ordered-map item type
|
||||
::
|
||||
++ mk-item |$ [key val] [key=key val=val]
|
||||
:: +ordered-map: treap with user-specified horizontal order
|
||||
::
|
||||
:: Conceptually smaller items go on the left, so the item with the
|
||||
:: smallest key can be popped off the head. If $key is `@` and
|
||||
:: .compare is +lte, then the numerically smallest item is the head.
|
||||
::
|
||||
++ ordered-map
|
||||
|* [key=mold val=mold]
|
||||
=> |%
|
||||
+$ item (mk-item key val)
|
||||
--
|
||||
:: +compare: item comparator for horizontal order
|
||||
::
|
||||
|= compare=$-([key key] ?)
|
||||
|%
|
||||
:: +check-balance: verify horizontal and vertical orderings
|
||||
::
|
||||
++ check-balance
|
||||
=| [l=(unit key) r=(unit key)]
|
||||
|= a=(tree item)
|
||||
^- ?
|
||||
:: empty tree is valid
|
||||
::
|
||||
?~ a %.y
|
||||
:: nonempty trees must maintain several criteria
|
||||
::
|
||||
?& :: if .n.a is left of .u.l, assert horizontal comparator
|
||||
::
|
||||
?~(l %.y (compare key.n.a u.l))
|
||||
:: if .n.a is right of .u.r, assert horizontal comparator
|
||||
::
|
||||
?~(r %.y (compare u.r key.n.a))
|
||||
:: if .a is not leftmost element, assert vertical order between
|
||||
:: .l.a and .n.a and recurse to the left with .n.a as right
|
||||
:: neighbor
|
||||
::
|
||||
?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a)))
|
||||
:: if .a is not rightmost element, assert vertical order
|
||||
:: between .r.a and .n.a and recurse to the right with .n.a as
|
||||
:: left neighbor
|
||||
::
|
||||
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
|
||||
==
|
||||
:: +put: ordered item insert
|
||||
::
|
||||
++ put
|
||||
|= [a=(tree item) =key =val]
|
||||
^- (tree item)
|
||||
:: base case: replace null with single-item tree
|
||||
::
|
||||
?~ a [n=[key val] l=~ r=~]
|
||||
:: base case: overwrite existing .key with new .val
|
||||
::
|
||||
?: =(key.n.a key) a(val.n val)
|
||||
:: if item goes on left, recurse left then rebalance vertical order
|
||||
::
|
||||
?: (compare key key.n.a)
|
||||
=/ l $(a l.a)
|
||||
?> ?=(^ l)
|
||||
?: (mor key.n.a key.n.l)
|
||||
a(l l)
|
||||
l(r a(l r.l))
|
||||
:: item goes on right; recurse right then rebalance vertical order
|
||||
::
|
||||
=/ r $(a r.a)
|
||||
?> ?=(^ r)
|
||||
?: (mor key.n.a key.n.r)
|
||||
a(r r)
|
||||
r(l a(r l.r))
|
||||
:: +peek: produce head (smallest item) or null
|
||||
::
|
||||
++ peek
|
||||
|= a=(tree item)
|
||||
^- (unit item)
|
||||
::
|
||||
?~ a ~
|
||||
?~ l.a `n.a
|
||||
$(a l.a)
|
||||
:: +pop: produce .head (smallest item) and .rest or crash if empty
|
||||
::
|
||||
++ pop
|
||||
|= a=(tree item)
|
||||
^- [head=item rest=(tree item)]
|
||||
::
|
||||
?~ a !!
|
||||
?~ l.a [n.a r.a]
|
||||
::
|
||||
=/ l $(a l.a)
|
||||
:- head.l
|
||||
:: load .rest.l back into .a and rebalance
|
||||
::
|
||||
?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l))
|
||||
a(l rest.l)
|
||||
rest.l(r a(r r.rest.l))
|
||||
:: +del: delete .key from .a if it exists, producing value iff deleted
|
||||
::
|
||||
++ del
|
||||
|= [a=(tree item) =key]
|
||||
^- [(unit val) (tree item)]
|
||||
::
|
||||
?~ a [~ ~]
|
||||
:: we found .key at the root; delete and rebalance
|
||||
::
|
||||
?: =(key key.n.a)
|
||||
[`val.n.a (nip a)]
|
||||
:: recurse left or right to find .key
|
||||
::
|
||||
?: (compare key key.n.a)
|
||||
=+ [found lef]=$(a l.a)
|
||||
[found a(l lef)]
|
||||
=+ [found rig]=$(a r.a)
|
||||
[found a(r rig)]
|
||||
:: +nip: remove root; for internal use
|
||||
::
|
||||
++ nip
|
||||
|= a=(tree item)
|
||||
^- (tree item)
|
||||
::
|
||||
?> ?=(^ a)
|
||||
:: delete .n.a; merge and balance .l.a and .r.a
|
||||
::
|
||||
|- ^- (tree item)
|
||||
?~ l.a r.a
|
||||
?~ r.a l.a
|
||||
?: (mor key.n.l.a key.n.r.a)
|
||||
l.a(r $(l.a r.l.a))
|
||||
r.a(l $(r.a l.r.a))
|
||||
:: +traverse: stateful partial inorder traversal
|
||||
::
|
||||
:: Mutates .state on each run of .f. Starts at .start key, or if
|
||||
:: .start is ~, starts at the head (item with smallest key). Stops
|
||||
:: when .f produces .stop=%.y. Traverses from smaller to larger
|
||||
:: keys. Each run of .f can replace an item's value or delete the
|
||||
:: item.
|
||||
::
|
||||
++ traverse
|
||||
|* state=mold
|
||||
|= $: a=(tree item)
|
||||
=state
|
||||
f=$-([state item] [(unit val) ? state])
|
||||
==
|
||||
^+ [state a]
|
||||
:: acc: accumulator
|
||||
::
|
||||
:: .stop: set to %.y by .f when done traversing
|
||||
:: .state: threaded through each run of .f and produced by +abet
|
||||
::
|
||||
=/ acc [stop=`?`%.n state=state]
|
||||
=< abet =< main
|
||||
|%
|
||||
++ abet [state.acc a]
|
||||
:: +main: main recursive loop; performs a partial inorder traversal
|
||||
::
|
||||
++ main
|
||||
^+ .
|
||||
:: stop if empty or we've been told to stop
|
||||
::
|
||||
?~ a .
|
||||
?: stop.acc .
|
||||
:: inorder traversal: left -> node -> right, until .f sets .stop
|
||||
::
|
||||
=> left
|
||||
?: stop.acc .
|
||||
=> node
|
||||
?: stop.acc .
|
||||
right
|
||||
:: +node: run .f on .n.a, updating .a, .state, and .stop
|
||||
::
|
||||
++ node
|
||||
^+ .
|
||||
:: run .f on node, updating .stop.acc and .state.acc
|
||||
::
|
||||
=^ res acc
|
||||
?> ?=(^ a)
|
||||
(f state.acc n.a)
|
||||
:: apply update to .a from .f's product
|
||||
::
|
||||
=. a
|
||||
:: if .f requested node deletion, merge and balance .l.a and .r.a
|
||||
::
|
||||
?~ res (nip a)
|
||||
:: we kept the node; replace its .val; order is unchanged
|
||||
::
|
||||
?> ?=(^ a)
|
||||
a(val.n u.res)
|
||||
::
|
||||
..node
|
||||
:: +left: recurse on left subtree, copying mutant back into .l.a
|
||||
::
|
||||
++ left
|
||||
^+ .
|
||||
?~ a .
|
||||
=/ lef main(a l.a)
|
||||
lef(a a(l a.lef))
|
||||
:: +right: recurse on right subtree, copying mutant back into .r.a
|
||||
::
|
||||
++ right
|
||||
^+ .
|
||||
?~ a .
|
||||
=/ rig main(a r.a)
|
||||
rig(a a(r a.rig))
|
||||
--
|
||||
:: +tap: convert to list, smallest to largest
|
||||
::
|
||||
++ tap
|
||||
|= a=(tree item)
|
||||
^- (list item)
|
||||
::
|
||||
=| b=(list item)
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
::
|
||||
$(a l.a, b [n.a $(a r.a)])
|
||||
:: +gas: put a list of items
|
||||
::
|
||||
++ gas
|
||||
|= [a=(tree item) b=(list item)]
|
||||
^- (tree item)
|
||||
::
|
||||
?~ b a
|
||||
$(b t.b, a (put a i.b))
|
||||
:: +uni: unify two ordered maps
|
||||
::
|
||||
:: .b takes precedence over .a if keys overlap.
|
||||
::
|
||||
++ uni
|
||||
|= [a=(tree item) b=(tree item)]
|
||||
^- (tree item)
|
||||
::
|
||||
?~ b a
|
||||
?~ a b
|
||||
?: =(key.n.a key.n.b)
|
||||
::
|
||||
[n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)]
|
||||
::
|
||||
?: (mor key.n.a key.n.b)
|
||||
::
|
||||
?: (compare key.n.b key.n.a)
|
||||
$(l.a $(a l.a, r.b ~), b r.b)
|
||||
$(r.a $(a r.a, l.b ~), b l.b)
|
||||
::
|
||||
?: (compare key.n.a key.n.b)
|
||||
$(l.b $(b l.b, r.a ~), a r.a)
|
||||
$(r.b $(b r.b, l.a ~), a l.a)
|
||||
--
|
||||
::
|
||||
+| %atomics
|
||||
::
|
||||
+$ bone @udbone
|
||||
|
||||
@ -20,12 +20,20 @@
|
||||
==
|
||||
::
|
||||
+$ behn-state
|
||||
$: timers=(list timer)
|
||||
$: %1
|
||||
timers=(tree [timer ~])
|
||||
unix-duct=duct
|
||||
next-wake=(unit @da)
|
||||
drips=drip-manager
|
||||
==
|
||||
::
|
||||
:: use lth instead of lte so that if same date, goes after
|
||||
::
|
||||
++ timer-map
|
||||
%- (ordered-map ,timer ,~)
|
||||
|= [a=timer b=timer]
|
||||
(lth date.a date.b)
|
||||
::
|
||||
+$ drip-manager
|
||||
$: count=@ud
|
||||
movs=(map @ud vase)
|
||||
@ -119,22 +127,25 @@
|
||||
^+ [moves state]
|
||||
:: no-op on spurious but innocuous unix wakeups
|
||||
::
|
||||
?~ timers.state
|
||||
?: =(~ timers.state)
|
||||
~? ?=(^ error) %behn-wake-no-timer^u.error
|
||||
[moves state]
|
||||
:: if we errored, pop the timer and notify the client vane of the error
|
||||
::
|
||||
?^ error
|
||||
=< set-unix-wake
|
||||
(emit-vane-wake(timers.state t.timers.state) duct.i.timers.state error)
|
||||
=^ [=timer ~] timers.state (pop:timer-map timers.state)
|
||||
(emit-vane-wake duct.timer error)
|
||||
:: if unix woke us too early, retry by resetting the unix wakeup timer
|
||||
::
|
||||
?: (gth date.i.timers.state now)
|
||||
=/ [[=timer ~] timers-tail=(tree [timer ~])]
|
||||
(pop:timer-map timers.state)
|
||||
?: (gth date.timer now)
|
||||
set-unix-wake(next-wake.state ~)
|
||||
:: pop first timer, tell vane it has elapsed, and adjust next unix wakeup
|
||||
::
|
||||
=< set-unix-wake
|
||||
(emit-vane-wake(timers.state t.timers.state) duct.i.timers.state ~)
|
||||
(emit-vane-wake(timers.state timers-tail) duct.timer ~)
|
||||
:: +wegh: produce memory usage report for |mass
|
||||
::
|
||||
++ wegh
|
||||
@ -184,58 +195,40 @@
|
||||
::
|
||||
++ set-unix-wake
|
||||
=< [moves state]
|
||||
~% %set-unix-wake ..is ~ |-
|
||||
^+ event-core
|
||||
::
|
||||
=* next-wake next-wake.state
|
||||
=* timers timers.state
|
||||
:: if no timers, cancel existing wakeup timer or no-op
|
||||
::
|
||||
?~ timers
|
||||
=/ timer=(unit [timer ~]) (peek:timer-map timers.state)
|
||||
?~ timer
|
||||
?~ next-wake
|
||||
event-core
|
||||
(emit-doze ~)
|
||||
:: if :next-wake is in the past or not soon enough, reset it
|
||||
::
|
||||
?^ next-wake
|
||||
?: &((gte date.i.timers u.next-wake) (lte now u.next-wake))
|
||||
?: &((gte date.u.timer u.next-wake) (lte now u.next-wake))
|
||||
event-core
|
||||
(emit-doze `date.i.timers)
|
||||
(emit-doze `date.u.timer)
|
||||
:: there was no unix wakeup timer; set one
|
||||
::
|
||||
(emit-doze `date.i.timers)
|
||||
(emit-doze `date.u.timer)
|
||||
:: +set-timer: set a timer, maintaining the sort order of the :timers list
|
||||
::
|
||||
++ set-timer
|
||||
=* timers timers.state
|
||||
~% %set-timer ..is ~
|
||||
|= t=timer
|
||||
^+ timers
|
||||
::
|
||||
?~ timers
|
||||
~[t]
|
||||
:: ignore duplicates
|
||||
::
|
||||
?: =(t i.timers)
|
||||
timers
|
||||
:: timers at the same date form a fifo queue
|
||||
::
|
||||
?: (lth date.t date.i.timers)
|
||||
[t timers]
|
||||
::
|
||||
[i.timers $(timers t.timers)]
|
||||
^+ timers.state
|
||||
(put:timer-map timers.state t ~)
|
||||
:: +unset-timer: cancel a timer; if it already expired, no-op
|
||||
::
|
||||
++ unset-timer
|
||||
=* timers timers.state
|
||||
|= t=timer
|
||||
^+ timers
|
||||
:: if we don't have this timer, no-op
|
||||
::
|
||||
?~ timers
|
||||
~
|
||||
?: =(i.timers t)
|
||||
t.timers
|
||||
::
|
||||
[i.timers $(timers t.timers)]
|
||||
^+ timers.state
|
||||
+:(del:timer-map timers.state t)
|
||||
--
|
||||
--
|
||||
::
|
||||
@ -248,6 +241,7 @@
|
||||
:: +call: handle a +task:able:behn request
|
||||
::
|
||||
++ call
|
||||
~% %behn-call ..is ~
|
||||
|= $: hen=duct
|
||||
dud=(unit goof)
|
||||
type=*
|
||||
@ -283,10 +277,51 @@
|
||||
:: +load: migrate an old state to a new behn version
|
||||
::
|
||||
++ load
|
||||
|= old=behn-state
|
||||
|^
|
||||
|= old=state
|
||||
^+ behn-gate
|
||||
::
|
||||
=? old ?=(^ -.old)
|
||||
(ket-to-1 old)
|
||||
=? old ?=(~ -.old)
|
||||
(load-0-to-1 old)
|
||||
?> ?=(%1 -.old)
|
||||
behn-gate(state old)
|
||||
::
|
||||
++ state
|
||||
$^ behn-state-ket
|
||||
$% behn-state-0
|
||||
behn-state
|
||||
==
|
||||
::
|
||||
+$ behn-state-0
|
||||
$: ~
|
||||
unix-duct=duct
|
||||
next-wake=(unit @da)
|
||||
drips=drip-manager
|
||||
==
|
||||
::
|
||||
+$ behn-state-ket
|
||||
$: timers=(list timer)
|
||||
unix-duct=duct
|
||||
next-wake=(unit @da)
|
||||
drips=drip-manager
|
||||
==
|
||||
::
|
||||
++ ket-to-1
|
||||
|= old=behn-state-ket
|
||||
^- behn-state
|
||||
:- %1
|
||||
%= old
|
||||
timers
|
||||
%+ gas:timer-map *(tree [timer ~])
|
||||
(turn timers.old |=(=timer [timer ~]))
|
||||
==
|
||||
::
|
||||
++ load-0-to-1
|
||||
|= old=behn-state-0
|
||||
^- behn-state
|
||||
[%1 old]
|
||||
--
|
||||
:: +scry: view timer state
|
||||
::
|
||||
:: TODO: not referentially transparent w.r.t. elapsed timers,
|
||||
@ -298,7 +333,9 @@
|
||||
::
|
||||
?. ?=(%& -.why)
|
||||
~
|
||||
[~ ~ %tank !>(>timers<)]
|
||||
?. ?=(%timers syd)
|
||||
[~ ~]
|
||||
[~ ~ %noun !>((turn (tap:timer-map timers) head))]
|
||||
::
|
||||
++ stay state
|
||||
++ take
|
||||
@ -313,4 +350,3 @@
|
||||
(take-drip:event-core (slav %ud i.t.tea) error.q.hin)
|
||||
[moves behn-gate]
|
||||
--
|
||||
|
||||
|
||||
@ -7227,6 +7227,254 @@
|
||||
$(pops [oldest pops])
|
||||
--
|
||||
--
|
||||
:: $mk-item: constructor for +ordered-map item type
|
||||
::
|
||||
++ mk-item |$ [key val] [key=key val=val]
|
||||
:: +ordered-map: treap with user-specified horizontal order
|
||||
::
|
||||
:: Conceptually smaller items go on the left, so the item with the
|
||||
:: smallest key can be popped off the head. If $key is `@` and
|
||||
:: .compare is +lte, then the numerically smallest item is the head.
|
||||
::
|
||||
++ ordered-map
|
||||
|* [key=mold val=mold]
|
||||
=> |%
|
||||
+$ item (mk-item key val)
|
||||
--
|
||||
:: +compare: item comparator for horizontal order
|
||||
::
|
||||
|= compare=$-([key key] ?)
|
||||
|%
|
||||
:: +check-balance: verify horizontal and vertical orderings
|
||||
::
|
||||
++ check-balance
|
||||
=| [l=(unit key) r=(unit key)]
|
||||
|= a=(tree item)
|
||||
^- ?
|
||||
:: empty tree is valid
|
||||
::
|
||||
?~ a %.y
|
||||
:: nonempty trees must maintain several criteria
|
||||
::
|
||||
?& :: if .n.a is left of .u.l, assert horizontal comparator
|
||||
::
|
||||
?~(l %.y (compare key.n.a u.l))
|
||||
:: if .n.a is right of .u.r, assert horizontal comparator
|
||||
::
|
||||
?~(r %.y (compare u.r key.n.a))
|
||||
:: if .a is not leftmost element, assert vertical order between
|
||||
:: .l.a and .n.a and recurse to the left with .n.a as right
|
||||
:: neighbor
|
||||
::
|
||||
?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a)))
|
||||
:: if .a is not rightmost element, assert vertical order
|
||||
:: between .r.a and .n.a and recurse to the right with .n.a as
|
||||
:: left neighbor
|
||||
::
|
||||
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
|
||||
==
|
||||
:: +put: ordered item insert
|
||||
::
|
||||
++ put
|
||||
|= [a=(tree item) =key =val]
|
||||
^- (tree item)
|
||||
:: base case: replace null with single-item tree
|
||||
::
|
||||
?~ a [n=[key val] l=~ r=~]
|
||||
:: base case: overwrite existing .key with new .val
|
||||
::
|
||||
?: =(key.n.a key) a(val.n val)
|
||||
:: if item goes on left, recurse left then rebalance vertical order
|
||||
::
|
||||
?: (compare key key.n.a)
|
||||
=/ l $(a l.a)
|
||||
?> ?=(^ l)
|
||||
?: (mor key.n.a key.n.l)
|
||||
a(l l)
|
||||
l(r a(l r.l))
|
||||
:: item goes on right; recurse right then rebalance vertical order
|
||||
::
|
||||
=/ r $(a r.a)
|
||||
?> ?=(^ r)
|
||||
?: (mor key.n.a key.n.r)
|
||||
a(r r)
|
||||
r(l a(r l.r))
|
||||
:: +peek: produce head (smallest item) or null
|
||||
::
|
||||
++ peek
|
||||
|= a=(tree item)
|
||||
^- (unit item)
|
||||
::
|
||||
?~ a ~
|
||||
?~ l.a `n.a
|
||||
$(a l.a)
|
||||
:: +pop: produce .head (smallest item) and .rest or crash if empty
|
||||
::
|
||||
++ pop
|
||||
|= a=(tree item)
|
||||
^- [head=item rest=(tree item)]
|
||||
::
|
||||
?~ a !!
|
||||
?~ l.a [n.a r.a]
|
||||
::
|
||||
=/ l $(a l.a)
|
||||
:- head.l
|
||||
:: load .rest.l back into .a and rebalance
|
||||
::
|
||||
?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l))
|
||||
a(l rest.l)
|
||||
rest.l(r a(r r.rest.l))
|
||||
:: +del: delete .key from .a if it exists, producing value iff deleted
|
||||
::
|
||||
++ del
|
||||
|= [a=(tree item) =key]
|
||||
^- [(unit val) (tree item)]
|
||||
::
|
||||
?~ a [~ ~]
|
||||
:: we found .key at the root; delete and rebalance
|
||||
::
|
||||
?: =(key key.n.a)
|
||||
[`val.n.a (nip a)]
|
||||
:: recurse left or right to find .key
|
||||
::
|
||||
?: (compare key key.n.a)
|
||||
=+ [found lef]=$(a l.a)
|
||||
[found a(l lef)]
|
||||
=+ [found rig]=$(a r.a)
|
||||
[found a(r rig)]
|
||||
:: +nip: remove root; for internal use
|
||||
::
|
||||
++ nip
|
||||
|= a=(tree item)
|
||||
^- (tree item)
|
||||
::
|
||||
?> ?=(^ a)
|
||||
:: delete .n.a; merge and balance .l.a and .r.a
|
||||
::
|
||||
|- ^- (tree item)
|
||||
?~ l.a r.a
|
||||
?~ r.a l.a
|
||||
?: (mor key.n.l.a key.n.r.a)
|
||||
l.a(r $(l.a r.l.a))
|
||||
r.a(l $(r.a l.r.a))
|
||||
:: +traverse: stateful partial inorder traversal
|
||||
::
|
||||
:: Mutates .state on each run of .f. Starts at .start key, or if
|
||||
:: .start is ~, starts at the head (item with smallest key). Stops
|
||||
:: when .f produces .stop=%.y. Traverses from smaller to larger
|
||||
:: keys. Each run of .f can replace an item's value or delete the
|
||||
:: item.
|
||||
::
|
||||
++ traverse
|
||||
|* state=mold
|
||||
|= $: a=(tree item)
|
||||
=state
|
||||
f=$-([state item] [(unit val) ? state])
|
||||
==
|
||||
^+ [state a]
|
||||
:: acc: accumulator
|
||||
::
|
||||
:: .stop: set to %.y by .f when done traversing
|
||||
:: .state: threaded through each run of .f and produced by +abet
|
||||
::
|
||||
=/ acc [stop=`?`%.n state=state]
|
||||
=< abet =< main
|
||||
|%
|
||||
++ abet [state.acc a]
|
||||
:: +main: main recursive loop; performs a partial inorder traversal
|
||||
::
|
||||
++ main
|
||||
^+ .
|
||||
:: stop if empty or we've been told to stop
|
||||
::
|
||||
?~ a .
|
||||
?: stop.acc .
|
||||
:: inorder traversal: left -> node -> right, until .f sets .stop
|
||||
::
|
||||
=> left
|
||||
?: stop.acc .
|
||||
=> node
|
||||
?: stop.acc .
|
||||
right
|
||||
:: +node: run .f on .n.a, updating .a, .state, and .stop
|
||||
::
|
||||
++ node
|
||||
^+ .
|
||||
:: run .f on node, updating .stop.acc and .state.acc
|
||||
::
|
||||
=^ res acc
|
||||
?> ?=(^ a)
|
||||
(f state.acc n.a)
|
||||
:: apply update to .a from .f's product
|
||||
::
|
||||
=. a
|
||||
:: if .f requested node deletion, merge and balance .l.a and .r.a
|
||||
::
|
||||
?~ res (nip a)
|
||||
:: we kept the node; replace its .val; order is unchanged
|
||||
::
|
||||
?> ?=(^ a)
|
||||
a(val.n u.res)
|
||||
::
|
||||
..node
|
||||
:: +left: recurse on left subtree, copying mutant back into .l.a
|
||||
::
|
||||
++ left
|
||||
^+ .
|
||||
?~ a .
|
||||
=/ lef main(a l.a)
|
||||
lef(a a(l a.lef))
|
||||
:: +right: recurse on right subtree, copying mutant back into .r.a
|
||||
::
|
||||
++ right
|
||||
^+ .
|
||||
?~ a .
|
||||
=/ rig main(a r.a)
|
||||
rig(a a(r a.rig))
|
||||
--
|
||||
:: +tap: convert to list, smallest to largest
|
||||
::
|
||||
++ tap
|
||||
|= a=(tree item)
|
||||
^- (list item)
|
||||
::
|
||||
=| b=(list item)
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
::
|
||||
$(a l.a, b [n.a $(a r.a)])
|
||||
:: +gas: put a list of items
|
||||
::
|
||||
++ gas
|
||||
|= [a=(tree item) b=(list item)]
|
||||
^- (tree item)
|
||||
::
|
||||
?~ b a
|
||||
$(b t.b, a (put a i.b))
|
||||
:: +uni: unify two ordered maps
|
||||
::
|
||||
:: .b takes precedence over .a if keys overlap.
|
||||
::
|
||||
++ uni
|
||||
|= [a=(tree item) b=(tree item)]
|
||||
^- (tree item)
|
||||
::
|
||||
?~ b a
|
||||
?~ a b
|
||||
?: =(key.n.a key.n.b)
|
||||
::
|
||||
[n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)]
|
||||
::
|
||||
?: (mor key.n.a key.n.b)
|
||||
::
|
||||
?: (compare key.n.b key.n.a)
|
||||
$(l.a $(a l.a, r.b ~), b r.b)
|
||||
$(r.a $(a r.a, l.b ~), b l.b)
|
||||
::
|
||||
?: (compare key.n.a key.n.b)
|
||||
$(l.b $(b l.b, r.a ~), a r.a)
|
||||
$(r.b $(b r.b, l.a ~), a l.a)
|
||||
--
|
||||
:: ::
|
||||
:::: ++userlib :: (2u) non-vane utils
|
||||
:: ::::
|
||||
|
||||
Loading…
Reference in New Issue
Block a user