mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-21 05:41:43 +03:00
lull: move ordered-map from zuse
This commit is contained in:
Liam Fitzgerald
parent
a86664076d
commit
67105a854b
@ -36,6 +36,413 @@
|
|||||||
depth=_1
|
depth=_1
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
|
:: +mop: constructs and validates ordered ordered map based on key,
|
||||||
|
:: val, and comparator gate
|
||||||
|
::
|
||||||
|
++ mop
|
||||||
|
|* [key=mold value=mold]
|
||||||
|
|= ord=$-([key key] ?)
|
||||||
|
|= a=*
|
||||||
|
=/ b ;;((tree [key=key val=value]) a)
|
||||||
|
?> (apt:((on key value) ord) b)
|
||||||
|
b
|
||||||
|
::
|
||||||
|
::
|
||||||
|
++ ordered-map on
|
||||||
|
:: +on: treap with user-specified horizontal order, ordered-map
|
||||||
|
::
|
||||||
|
:: WARNING: ordered-map will not work properly if two keys can be
|
||||||
|
:: unequal under noun equality but equal via the compare gate
|
||||||
|
::
|
||||||
|
++ on
|
||||||
|
~/ %on
|
||||||
|
|* [key=mold val=mold]
|
||||||
|
=> |%
|
||||||
|
+$ item [key=key val=val]
|
||||||
|
--
|
||||||
|
:: +compare: item comparator for horizontal order
|
||||||
|
::
|
||||||
|
~% %comp +>+ ~
|
||||||
|
|= compare=$-([key key] ?)
|
||||||
|
~% %core + ~
|
||||||
|
|%
|
||||||
|
:: +all: apply logical AND boolean test on all values
|
||||||
|
::
|
||||||
|
++ all
|
||||||
|
~/ %all
|
||||||
|
|= [a=(tree item) b=$-(item ?)]
|
||||||
|
^- ?
|
||||||
|
|-
|
||||||
|
?~ a
|
||||||
|
&
|
||||||
|
?&((b n.a) $(a l.a) $(a r.a))
|
||||||
|
:: +any: apply logical OR boolean test on all values
|
||||||
|
::
|
||||||
|
++ any
|
||||||
|
~/ %any
|
||||||
|
|= [a=(tree item) b=$-(item ?)]
|
||||||
|
|- ^- ?
|
||||||
|
?~ a
|
||||||
|
|
|
||||||
|
?|((b n.a) $(a l.a) $(a r.a))
|
||||||
|
:: +apt: verify horizontal and vertical orderings
|
||||||
|
::
|
||||||
|
++ apt
|
||||||
|
~/ %apt
|
||||||
|
|= a=(tree item)
|
||||||
|
=| [l=(unit key) r=(unit key)]
|
||||||
|
|- ^- ?
|
||||||
|
:: 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)))
|
||||||
|
==
|
||||||
|
:: +bap: convert to list, right to left
|
||||||
|
::
|
||||||
|
++ bap
|
||||||
|
~/ %bap
|
||||||
|
|= a=(tree item)
|
||||||
|
^- (list item)
|
||||||
|
=| b=(list item)
|
||||||
|
|- ^+ b
|
||||||
|
?~ a b
|
||||||
|
$(a r.a, b [n.a $(a l.a)])
|
||||||
|
:: +del: delete .key from .a if it exists, producing value iff deleted
|
||||||
|
::
|
||||||
|
++ del
|
||||||
|
~/ %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)]
|
||||||
|
:: +dip: stateful partial inorder traversal
|
||||||
|
::
|
||||||
|
:: Mutates .state on each run of .f. Starts at .start key, or if
|
||||||
|
:: .start is ~, starts at the head. Stops when .f produces .stop=%.y.
|
||||||
|
:: Traverses from left to right keys.
|
||||||
|
:: Each run of .f can replace an item's value or delete the item.
|
||||||
|
::
|
||||||
|
++ dip
|
||||||
|
~/ %dip
|
||||||
|
|* 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
|
||||||
|
|%
|
||||||
|
++ this .
|
||||||
|
++ abet [state.acc a]
|
||||||
|
:: +main: main recursive loop; performs a partial inorder traversal
|
||||||
|
::
|
||||||
|
++ main
|
||||||
|
^+ this
|
||||||
|
:: stop if empty or we've been told to stop
|
||||||
|
::
|
||||||
|
?: =(~ a) this
|
||||||
|
?: stop.acc this
|
||||||
|
:: inorder traversal: left -> node -> right, until .f sets .stop
|
||||||
|
::
|
||||||
|
=. this left
|
||||||
|
?: stop.acc this
|
||||||
|
=^ del this node
|
||||||
|
=? this !stop.acc right
|
||||||
|
=? a del (nip a)
|
||||||
|
this
|
||||||
|
:: +node: run .f on .n.a, updating .a, .state, and .stop
|
||||||
|
::
|
||||||
|
++ node
|
||||||
|
^+ [del=*? this]
|
||||||
|
:: run .f on node, updating .stop.acc and .state.acc
|
||||||
|
::
|
||||||
|
?> ?=(^ a)
|
||||||
|
=^ res acc (f state.acc n.a)
|
||||||
|
?~ res
|
||||||
|
[del=& this]
|
||||||
|
[del=| this(val.n.a u.res)]
|
||||||
|
:: +left: recurse on left subtree, copying mutant back into .l.a
|
||||||
|
::
|
||||||
|
++ left
|
||||||
|
^+ this
|
||||||
|
?~ a this
|
||||||
|
=/ lef main(a l.a)
|
||||||
|
lef(a a(l a.lef))
|
||||||
|
:: +right: recurse on right subtree, copying mutant back into .r.a
|
||||||
|
::
|
||||||
|
++ right
|
||||||
|
^+ this
|
||||||
|
?~ a this
|
||||||
|
=/ rig main(a r.a)
|
||||||
|
rig(a a(r a.rig))
|
||||||
|
--
|
||||||
|
:: +gas: put a list of items
|
||||||
|
::
|
||||||
|
++ gas
|
||||||
|
~/ %gas
|
||||||
|
|= [a=(tree item) b=(list item)]
|
||||||
|
^- (tree item)
|
||||||
|
?~ b a
|
||||||
|
$(b t.b, a (put a i.b))
|
||||||
|
:: +get: get val at key or return ~
|
||||||
|
::
|
||||||
|
++ get
|
||||||
|
~/ %get
|
||||||
|
|= [a=(tree item) b=key]
|
||||||
|
^- (unit val)
|
||||||
|
?~ a ~
|
||||||
|
?: =(b key.n.a)
|
||||||
|
`val.n.a
|
||||||
|
?: (compare b key.n.a)
|
||||||
|
$(a l.a)
|
||||||
|
$(a r.a)
|
||||||
|
:: +got: need value at key
|
||||||
|
::
|
||||||
|
++ got
|
||||||
|
|= [a=(tree item) b=key]
|
||||||
|
^- val
|
||||||
|
(need (get a b))
|
||||||
|
:: +has: check for key existence
|
||||||
|
::
|
||||||
|
++ has
|
||||||
|
~/ %has
|
||||||
|
|= [a=(tree item) b=key]
|
||||||
|
^- ?
|
||||||
|
!=(~ (get a b))
|
||||||
|
:: +lot: take a subset range excluding start and/or end and all elements
|
||||||
|
:: outside the range
|
||||||
|
::
|
||||||
|
++ lot
|
||||||
|
~/ %lot
|
||||||
|
|= $: tre=(tree item)
|
||||||
|
start=(unit key)
|
||||||
|
end=(unit key)
|
||||||
|
==
|
||||||
|
^- (tree item)
|
||||||
|
|^
|
||||||
|
?: ?&(?=(~ start) ?=(~ end))
|
||||||
|
tre
|
||||||
|
?~ start
|
||||||
|
(del-span tre %end end)
|
||||||
|
?~ end
|
||||||
|
(del-span tre %start start)
|
||||||
|
?> (compare u.start u.end)
|
||||||
|
=. tre (del-span tre %start start)
|
||||||
|
(del-span tre %end end)
|
||||||
|
::
|
||||||
|
++ del-span
|
||||||
|
|= [a=(tree item) b=?(%start %end) c=(unit key)]
|
||||||
|
^- (tree item)
|
||||||
|
?~ a a
|
||||||
|
?~ c a
|
||||||
|
?- b
|
||||||
|
%start
|
||||||
|
:: found key
|
||||||
|
?: =(key.n.a u.c)
|
||||||
|
(nip a(l ~))
|
||||||
|
:: traverse to find key
|
||||||
|
?: (compare key.n.a u.c)
|
||||||
|
:: found key to the left of start
|
||||||
|
$(a (nip a(l ~)))
|
||||||
|
:: found key to the right of start
|
||||||
|
a(l $(a l.a))
|
||||||
|
::
|
||||||
|
%end
|
||||||
|
:: found key
|
||||||
|
?: =(u.c key.n.a)
|
||||||
|
(nip a(r ~))
|
||||||
|
:: traverse to find key
|
||||||
|
?: (compare key.n.a u.c)
|
||||||
|
:: found key to the left of end
|
||||||
|
a(r $(a r.a))
|
||||||
|
:: found key to the right of end
|
||||||
|
$(a (nip a(r ~)))
|
||||||
|
==
|
||||||
|
--
|
||||||
|
:: +nip: remove root; for internal use
|
||||||
|
::
|
||||||
|
++ nip
|
||||||
|
~/ %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))
|
||||||
|
::
|
||||||
|
:: +pop: produce .head (leftmost item) and .rest or crash if empty
|
||||||
|
::
|
||||||
|
++ pop
|
||||||
|
~/ %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))
|
||||||
|
:: +pry: produce head (leftmost item) or null
|
||||||
|
::
|
||||||
|
++ pry
|
||||||
|
~/ %pry
|
||||||
|
|= a=(tree item)
|
||||||
|
^- (unit item)
|
||||||
|
?~ a ~
|
||||||
|
|-
|
||||||
|
?~ l.a `n.a
|
||||||
|
$(a l.a)
|
||||||
|
:: +put: ordered item insert
|
||||||
|
::
|
||||||
|
++ put
|
||||||
|
~/ %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))
|
||||||
|
:: +ram: produce tail (rightmost item) or null
|
||||||
|
::
|
||||||
|
++ ram
|
||||||
|
~/ %ram
|
||||||
|
|= a=(tree item)
|
||||||
|
^- (unit item)
|
||||||
|
?~ a ~
|
||||||
|
|-
|
||||||
|
?~ r.a `n.a
|
||||||
|
$(a r.a)
|
||||||
|
:: +run: apply gate to transform all values in place
|
||||||
|
::
|
||||||
|
++ run
|
||||||
|
~/ %run
|
||||||
|
|* [a=(tree item) b=$-(val *)]
|
||||||
|
|-
|
||||||
|
?~ a a
|
||||||
|
[n=[key.n.a (b val.n.a)] l=$(a l.a) r=$(a r.a)]
|
||||||
|
:: +tab: tabulate a subset excluding start element with a max count
|
||||||
|
::
|
||||||
|
++ tab
|
||||||
|
~/ %tab
|
||||||
|
|= [a=(tree item) b=(unit key) c=@]
|
||||||
|
^- (list item)
|
||||||
|
|^
|
||||||
|
(flop e:(tabulate (del-span a b) b c))
|
||||||
|
::
|
||||||
|
++ tabulate
|
||||||
|
|= [a=(tree item) b=(unit key) c=@]
|
||||||
|
^- [d=@ e=(list item)]
|
||||||
|
?: ?&(?=(~ b) =(c 0))
|
||||||
|
[0 ~]
|
||||||
|
=| f=[d=@ e=(list item)]
|
||||||
|
|- ^+ f
|
||||||
|
?: ?|(?=(~ a) =(d.f c)) f
|
||||||
|
=. f $(a l.a)
|
||||||
|
?: =(d.f c) f
|
||||||
|
=. f [+(d.f) [n.a e.f]]
|
||||||
|
?:(=(d.f c) f $(a r.a))
|
||||||
|
::
|
||||||
|
++ del-span
|
||||||
|
|= [a=(tree item) b=(unit key)]
|
||||||
|
^- (tree item)
|
||||||
|
?~ a a
|
||||||
|
?~ b a
|
||||||
|
?: =(key.n.a u.b)
|
||||||
|
r.a
|
||||||
|
?: (compare key.n.a u.b)
|
||||||
|
$(a r.a)
|
||||||
|
a(l $(a l.a))
|
||||||
|
--
|
||||||
|
:: +tap: convert to list, left to right
|
||||||
|
::
|
||||||
|
++ tap
|
||||||
|
~/ %tap
|
||||||
|
|= a=(tree item)
|
||||||
|
^- (list item)
|
||||||
|
=| b=(list item)
|
||||||
|
|- ^+ b
|
||||||
|
?~ a b
|
||||||
|
$(a l.a, b [n.a $(a r.a)])
|
||||||
|
:: +uni: unify two ordered maps
|
||||||
|
::
|
||||||
|
:: .b takes precedence over .a if keys overlap.
|
||||||
|
::
|
||||||
|
++ uni
|
||||||
|
~/ %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)
|
||||||
|
--
|
||||||
|
|
||||||
|
::
|
||||||
+$ deco ?(~ %bl %br %un) :: text decoration
|
+$ deco ?(~ %bl %br %un) :: text decoration
|
||||||
+$ json :: normal json value
|
+$ json :: normal json value
|
||||||
$@ ~ :: null
|
$@ ~ :: null
|
||||||
|
|||||||
@ -5184,412 +5184,6 @@
|
|||||||
$(pops [oldest pops])
|
$(pops [oldest pops])
|
||||||
--
|
--
|
||||||
--
|
--
|
||||||
::
|
|
||||||
:: +mop: constructs and validates ordered ordered map based on key,
|
|
||||||
:: val, and comparator gate
|
|
||||||
::
|
|
||||||
++ mop
|
|
||||||
|* [key=mold value=mold]
|
|
||||||
|= ord=$-([key key] ?)
|
|
||||||
|= a=*
|
|
||||||
=/ b ;;((tree [key=key val=value]) a)
|
|
||||||
?> (apt:((on key value) ord) b)
|
|
||||||
b
|
|
||||||
::
|
|
||||||
::
|
|
||||||
++ ordered-map on
|
|
||||||
:: +on: treap with user-specified horizontal order, ordered-map
|
|
||||||
::
|
|
||||||
:: WARNING: ordered-map will not work properly if two keys can be
|
|
||||||
:: unequal under noun equality but equal via the compare gate
|
|
||||||
::
|
|
||||||
++ on
|
|
||||||
~/ %on
|
|
||||||
|* [key=mold val=mold]
|
|
||||||
=> |%
|
|
||||||
+$ item [key=key val=val]
|
|
||||||
--
|
|
||||||
:: +compare: item comparator for horizontal order
|
|
||||||
::
|
|
||||||
~% %comp +>+ ~
|
|
||||||
|= compare=$-([key key] ?)
|
|
||||||
~% %core + ~
|
|
||||||
|%
|
|
||||||
:: +all: apply logical AND boolean test on all values
|
|
||||||
::
|
|
||||||
++ all
|
|
||||||
~/ %all
|
|
||||||
|= [a=(tree item) b=$-(item ?)]
|
|
||||||
^- ?
|
|
||||||
|-
|
|
||||||
?~ a
|
|
||||||
&
|
|
||||||
?&((b n.a) $(a l.a) $(a r.a))
|
|
||||||
:: +any: apply logical OR boolean test on all values
|
|
||||||
::
|
|
||||||
++ any
|
|
||||||
~/ %any
|
|
||||||
|= [a=(tree item) b=$-(item ?)]
|
|
||||||
|- ^- ?
|
|
||||||
?~ a
|
|
||||||
|
|
|
||||||
?|((b n.a) $(a l.a) $(a r.a))
|
|
||||||
:: +apt: verify horizontal and vertical orderings
|
|
||||||
::
|
|
||||||
++ apt
|
|
||||||
~/ %apt
|
|
||||||
|= a=(tree item)
|
|
||||||
=| [l=(unit key) r=(unit key)]
|
|
||||||
|- ^- ?
|
|
||||||
:: 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)))
|
|
||||||
==
|
|
||||||
:: +bap: convert to list, right to left
|
|
||||||
::
|
|
||||||
++ bap
|
|
||||||
~/ %bap
|
|
||||||
|= a=(tree item)
|
|
||||||
^- (list item)
|
|
||||||
=| b=(list item)
|
|
||||||
|- ^+ b
|
|
||||||
?~ a b
|
|
||||||
$(a r.a, b [n.a $(a l.a)])
|
|
||||||
:: +del: delete .key from .a if it exists, producing value iff deleted
|
|
||||||
::
|
|
||||||
++ del
|
|
||||||
~/ %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)]
|
|
||||||
:: +dip: stateful partial inorder traversal
|
|
||||||
::
|
|
||||||
:: Mutates .state on each run of .f. Starts at .start key, or if
|
|
||||||
:: .start is ~, starts at the head. Stops when .f produces .stop=%.y.
|
|
||||||
:: Traverses from left to right keys.
|
|
||||||
:: Each run of .f can replace an item's value or delete the item.
|
|
||||||
::
|
|
||||||
++ dip
|
|
||||||
~/ %dip
|
|
||||||
|* 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
|
|
||||||
|%
|
|
||||||
++ this .
|
|
||||||
++ abet [state.acc a]
|
|
||||||
:: +main: main recursive loop; performs a partial inorder traversal
|
|
||||||
::
|
|
||||||
++ main
|
|
||||||
^+ this
|
|
||||||
:: stop if empty or we've been told to stop
|
|
||||||
::
|
|
||||||
?: =(~ a) this
|
|
||||||
?: stop.acc this
|
|
||||||
:: inorder traversal: left -> node -> right, until .f sets .stop
|
|
||||||
::
|
|
||||||
=. this left
|
|
||||||
?: stop.acc this
|
|
||||||
=^ del this node
|
|
||||||
=? this !stop.acc right
|
|
||||||
=? a del (nip a)
|
|
||||||
this
|
|
||||||
:: +node: run .f on .n.a, updating .a, .state, and .stop
|
|
||||||
::
|
|
||||||
++ node
|
|
||||||
^+ [del=*? this]
|
|
||||||
:: run .f on node, updating .stop.acc and .state.acc
|
|
||||||
::
|
|
||||||
?> ?=(^ a)
|
|
||||||
=^ res acc (f state.acc n.a)
|
|
||||||
?~ res
|
|
||||||
[del=& this]
|
|
||||||
[del=| this(val.n.a u.res)]
|
|
||||||
:: +left: recurse on left subtree, copying mutant back into .l.a
|
|
||||||
::
|
|
||||||
++ left
|
|
||||||
^+ this
|
|
||||||
?~ a this
|
|
||||||
=/ lef main(a l.a)
|
|
||||||
lef(a a(l a.lef))
|
|
||||||
:: +right: recurse on right subtree, copying mutant back into .r.a
|
|
||||||
::
|
|
||||||
++ right
|
|
||||||
^+ this
|
|
||||||
?~ a this
|
|
||||||
=/ rig main(a r.a)
|
|
||||||
rig(a a(r a.rig))
|
|
||||||
--
|
|
||||||
:: +gas: put a list of items
|
|
||||||
::
|
|
||||||
++ gas
|
|
||||||
~/ %gas
|
|
||||||
|= [a=(tree item) b=(list item)]
|
|
||||||
^- (tree item)
|
|
||||||
?~ b a
|
|
||||||
$(b t.b, a (put a i.b))
|
|
||||||
:: +get: get val at key or return ~
|
|
||||||
::
|
|
||||||
++ get
|
|
||||||
~/ %get
|
|
||||||
|= [a=(tree item) b=key]
|
|
||||||
^- (unit val)
|
|
||||||
?~ a ~
|
|
||||||
?: =(b key.n.a)
|
|
||||||
`val.n.a
|
|
||||||
?: (compare b key.n.a)
|
|
||||||
$(a l.a)
|
|
||||||
$(a r.a)
|
|
||||||
:: +got: need value at key
|
|
||||||
::
|
|
||||||
++ got
|
|
||||||
|= [a=(tree item) b=key]
|
|
||||||
^- val
|
|
||||||
(need (get a b))
|
|
||||||
:: +has: check for key existence
|
|
||||||
::
|
|
||||||
++ has
|
|
||||||
~/ %has
|
|
||||||
|= [a=(tree item) b=key]
|
|
||||||
^- ?
|
|
||||||
!=(~ (get a b))
|
|
||||||
:: +lot: take a subset range excluding start and/or end and all elements
|
|
||||||
:: outside the range
|
|
||||||
::
|
|
||||||
++ lot
|
|
||||||
~/ %lot
|
|
||||||
|= $: tre=(tree item)
|
|
||||||
start=(unit key)
|
|
||||||
end=(unit key)
|
|
||||||
==
|
|
||||||
^- (tree item)
|
|
||||||
|^
|
|
||||||
?: ?&(?=(~ start) ?=(~ end))
|
|
||||||
tre
|
|
||||||
?~ start
|
|
||||||
(del-span tre %end end)
|
|
||||||
?~ end
|
|
||||||
(del-span tre %start start)
|
|
||||||
?> (compare u.start u.end)
|
|
||||||
=. tre (del-span tre %start start)
|
|
||||||
(del-span tre %end end)
|
|
||||||
::
|
|
||||||
++ del-span
|
|
||||||
|= [a=(tree item) b=?(%start %end) c=(unit key)]
|
|
||||||
^- (tree item)
|
|
||||||
?~ a a
|
|
||||||
?~ c a
|
|
||||||
?- b
|
|
||||||
%start
|
|
||||||
:: found key
|
|
||||||
?: =(key.n.a u.c)
|
|
||||||
(nip a(l ~))
|
|
||||||
:: traverse to find key
|
|
||||||
?: (compare key.n.a u.c)
|
|
||||||
:: found key to the left of start
|
|
||||||
$(a (nip a(l ~)))
|
|
||||||
:: found key to the right of start
|
|
||||||
a(l $(a l.a))
|
|
||||||
::
|
|
||||||
%end
|
|
||||||
:: found key
|
|
||||||
?: =(u.c key.n.a)
|
|
||||||
(nip a(r ~))
|
|
||||||
:: traverse to find key
|
|
||||||
?: (compare key.n.a u.c)
|
|
||||||
:: found key to the left of end
|
|
||||||
a(r $(a r.a))
|
|
||||||
:: found key to the right of end
|
|
||||||
$(a (nip a(r ~)))
|
|
||||||
==
|
|
||||||
--
|
|
||||||
:: +nip: remove root; for internal use
|
|
||||||
::
|
|
||||||
++ nip
|
|
||||||
~/ %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))
|
|
||||||
::
|
|
||||||
:: +pop: produce .head (leftmost item) and .rest or crash if empty
|
|
||||||
::
|
|
||||||
++ pop
|
|
||||||
~/ %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))
|
|
||||||
:: +pry: produce head (leftmost item) or null
|
|
||||||
::
|
|
||||||
++ pry
|
|
||||||
~/ %pry
|
|
||||||
|= a=(tree item)
|
|
||||||
^- (unit item)
|
|
||||||
?~ a ~
|
|
||||||
|-
|
|
||||||
?~ l.a `n.a
|
|
||||||
$(a l.a)
|
|
||||||
:: +put: ordered item insert
|
|
||||||
::
|
|
||||||
++ put
|
|
||||||
~/ %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))
|
|
||||||
:: +ram: produce tail (rightmost item) or null
|
|
||||||
::
|
|
||||||
++ ram
|
|
||||||
~/ %ram
|
|
||||||
|= a=(tree item)
|
|
||||||
^- (unit item)
|
|
||||||
?~ a ~
|
|
||||||
|-
|
|
||||||
?~ r.a `n.a
|
|
||||||
$(a r.a)
|
|
||||||
:: +run: apply gate to transform all values in place
|
|
||||||
::
|
|
||||||
++ run
|
|
||||||
~/ %run
|
|
||||||
|* [a=(tree item) b=$-(val *)]
|
|
||||||
|-
|
|
||||||
?~ a a
|
|
||||||
[n=[key.n.a (b val.n.a)] l=$(a l.a) r=$(a r.a)]
|
|
||||||
:: +tab: tabulate a subset excluding start element with a max count
|
|
||||||
::
|
|
||||||
++ tab
|
|
||||||
~/ %tab
|
|
||||||
|= [a=(tree item) b=(unit key) c=@]
|
|
||||||
^- (list item)
|
|
||||||
|^
|
|
||||||
(flop e:(tabulate (del-span a b) b c))
|
|
||||||
::
|
|
||||||
++ tabulate
|
|
||||||
|= [a=(tree item) b=(unit key) c=@]
|
|
||||||
^- [d=@ e=(list item)]
|
|
||||||
?: ?&(?=(~ b) =(c 0))
|
|
||||||
[0 ~]
|
|
||||||
=| f=[d=@ e=(list item)]
|
|
||||||
|- ^+ f
|
|
||||||
?: ?|(?=(~ a) =(d.f c)) f
|
|
||||||
=. f $(a l.a)
|
|
||||||
?: =(d.f c) f
|
|
||||||
=. f [+(d.f) [n.a e.f]]
|
|
||||||
?:(=(d.f c) f $(a r.a))
|
|
||||||
::
|
|
||||||
++ del-span
|
|
||||||
|= [a=(tree item) b=(unit key)]
|
|
||||||
^- (tree item)
|
|
||||||
?~ a a
|
|
||||||
?~ b a
|
|
||||||
?: =(key.n.a u.b)
|
|
||||||
r.a
|
|
||||||
?: (compare key.n.a u.b)
|
|
||||||
$(a r.a)
|
|
||||||
a(l $(a l.a))
|
|
||||||
--
|
|
||||||
:: +tap: convert to list, left to right
|
|
||||||
::
|
|
||||||
++ tap
|
|
||||||
~/ %tap
|
|
||||||
|= a=(tree item)
|
|
||||||
^- (list item)
|
|
||||||
=| b=(list item)
|
|
||||||
|- ^+ b
|
|
||||||
?~ a b
|
|
||||||
$(a l.a, b [n.a $(a r.a)])
|
|
||||||
:: +uni: unify two ordered maps
|
|
||||||
::
|
|
||||||
:: .b takes precedence over .a if keys overlap.
|
|
||||||
::
|
|
||||||
++ uni
|
|
||||||
~/ %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
|
:::: ++userlib :: (2u) non-vane utils
|
||||||
:: ::::
|
:: ::::
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user