mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-18 20:31:40 +03:00
lull,zuse: move +deq to zuse
This commit is contained in:
~wicrum-wicrun
parent
ba3a5b22e8
commit
db0afd056e
@ -65,288 +65,6 @@
|
|||||||
[%big p=(afx val) q=(pha val) r=(afx val)]
|
[%big p=(afx val) q=(pha val) r=(afx val)]
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
++ deq
|
|
||||||
|* val=mold
|
|
||||||
|%
|
|
||||||
::
|
|
||||||
:: +| %utilities
|
|
||||||
::
|
|
||||||
++ make-afx
|
|
||||||
|= ls=(list val)
|
|
||||||
?+ ls ~|(bad-finger/(lent ls) !!)
|
|
||||||
[* ~] [%1 ls]
|
|
||||||
[* * ~] [%2 ls]
|
|
||||||
[* * * ~] [%3 ls]
|
|
||||||
[* * * * ~] [%4 ls]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
++ wyt
|
|
||||||
|= a=(pha val)
|
|
||||||
^- @ud
|
|
||||||
?- -.a
|
|
||||||
%nul 0
|
|
||||||
%one 1
|
|
||||||
%big :(add (lent +.p.a) (lent +.r.a) $(a q.a))
|
|
||||||
==
|
|
||||||
::
|
|
||||||
++ afx-to-pha
|
|
||||||
|= =(afx val)
|
|
||||||
^- (pha val)
|
|
||||||
(apl *(pha val) +.afx)
|
|
||||||
::
|
|
||||||
:: +| %left-biased-operations
|
|
||||||
::
|
|
||||||
:: +pop-left: remove leftmost value from tree
|
|
||||||
::
|
|
||||||
++ pop-left
|
|
||||||
|= a=(pha val)
|
|
||||||
^- [val=(unit val) pha=(pha val)]
|
|
||||||
?- -.a
|
|
||||||
%nul ~^a
|
|
||||||
::
|
|
||||||
%one [`p.a nul/~]
|
|
||||||
::
|
|
||||||
%big
|
|
||||||
[`p.p.a (big-left +.+.p.a q.a r.a)]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
:: +peek-left: inspect leftmost value
|
|
||||||
::
|
|
||||||
++ peek-left
|
|
||||||
|= a=(pha val)
|
|
||||||
^- (unit val)
|
|
||||||
?- -.a
|
|
||||||
%nul ~
|
|
||||||
%one `p.a
|
|
||||||
%big `p.p.a
|
|
||||||
==
|
|
||||||
::
|
|
||||||
++ apl
|
|
||||||
|= [a=(pha val) vals=(list val)]
|
|
||||||
^- (pha val)
|
|
||||||
=. vals (flop vals)
|
|
||||||
|-
|
|
||||||
?~ vals a
|
|
||||||
$(a (cons a i.vals), vals t.vals)
|
|
||||||
::
|
|
||||||
::
|
|
||||||
++ dip-left
|
|
||||||
|* state=mold
|
|
||||||
|= $: a=(pha val)
|
|
||||||
=state
|
|
||||||
f=$-([state val] [(unit val) ? state])
|
|
||||||
==
|
|
||||||
^+ [state a]
|
|
||||||
=/ acc [stop=`?`%.n state=state]
|
|
||||||
=| new=(pha val)
|
|
||||||
|-
|
|
||||||
?: stop.acc
|
|
||||||
:: cat new and old
|
|
||||||
[state.acc (weld a new)]
|
|
||||||
=^ val=(unit val) a
|
|
||||||
(pop-left a)
|
|
||||||
?~ val
|
|
||||||
[state.acc new]
|
|
||||||
=^ res=(unit ^val) acc
|
|
||||||
(f state.acc u.val)
|
|
||||||
?~ res $
|
|
||||||
$(new (snoc new u.res))
|
|
||||||
::
|
|
||||||
++ big-left
|
|
||||||
|= [ls=(list val) a=(pha val) sf=(afx val)]
|
|
||||||
^- (pha val)
|
|
||||||
?. =(~ ls)
|
|
||||||
[%big (make-afx ls) a sf]
|
|
||||||
=/ [val=(unit val) inner=_a]
|
|
||||||
(pop-left a)
|
|
||||||
?~ val
|
|
||||||
(afx-to-pha sf)
|
|
||||||
[%big [%1 u.val ~] inner sf]
|
|
||||||
::
|
|
||||||
++ cons
|
|
||||||
=| b=(list val)
|
|
||||||
|= [a=(pha val) c=val]
|
|
||||||
^- (pha val)
|
|
||||||
=. b [c b]
|
|
||||||
|-
|
|
||||||
?~ b a
|
|
||||||
?- -.a
|
|
||||||
::
|
|
||||||
%nul
|
|
||||||
$(a [%one i.b], b t.b)
|
|
||||||
::
|
|
||||||
%one
|
|
||||||
%= $
|
|
||||||
b t.b
|
|
||||||
a [%big [%1 i.b ~] [%nul ~] [%1 p.a ~]]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
%big
|
|
||||||
?. ?=(%4 -.p.a)
|
|
||||||
%= $
|
|
||||||
b t.b
|
|
||||||
::
|
|
||||||
a
|
|
||||||
?- -.p.a
|
|
||||||
%1 big/[[%2 i.b p.p.a ~] q.a r.a]
|
|
||||||
%2 big/[[%3 i.b p.p.a q.p.a ~] q.a r.a]
|
|
||||||
%3 big/[[%4 i.b p.p.a q.p.a r.p.a ~] q.a r.a]
|
|
||||||
==
|
|
||||||
==
|
|
||||||
=/ inner
|
|
||||||
$(a q.a, b ~[s.p.a r.p.a q.p.a])
|
|
||||||
=. inner
|
|
||||||
$(a inner, b t.b)
|
|
||||||
big/[[%2 i.b p.p.a ~] inner r.a]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
:: +| %right-biased-operations
|
|
||||||
::
|
|
||||||
:: +snoc: append to end (right) of tree
|
|
||||||
::
|
|
||||||
++ snoc
|
|
||||||
|= [a=(pha val) b=val]
|
|
||||||
^+ a
|
|
||||||
?- -.a
|
|
||||||
%nul [%one b]
|
|
||||||
::
|
|
||||||
%one
|
|
||||||
:- %big
|
|
||||||
:* [%1 p.a ~]
|
|
||||||
[%nul ~]
|
|
||||||
[%1 b ~]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
%big
|
|
||||||
?- -.r.a
|
|
||||||
::
|
|
||||||
%1
|
|
||||||
:- %big
|
|
||||||
[p.a q.a [%2 p.r.a b ~]]
|
|
||||||
::
|
|
||||||
%2
|
|
||||||
:- %big
|
|
||||||
[p.a q.a [%3 p.r.a q.r.a b ~]]
|
|
||||||
::
|
|
||||||
%3
|
|
||||||
:- %big
|
|
||||||
[p.a q.a [%4 p.r.a q.r.a r.r.a b ~]]
|
|
||||||
::
|
|
||||||
%4
|
|
||||||
=/ inner
|
|
||||||
$(a q.a, b p.r.a)
|
|
||||||
=. inner
|
|
||||||
$(a inner, b q.r.a)
|
|
||||||
=. inner
|
|
||||||
$(a inner, b r.r.a)
|
|
||||||
:- %big
|
|
||||||
:* p.a
|
|
||||||
inner
|
|
||||||
[%2 s.r.a b ~]
|
|
||||||
==
|
|
||||||
==
|
|
||||||
==
|
|
||||||
:: +apr: append list to end (right) of tree
|
|
||||||
::
|
|
||||||
++ apr
|
|
||||||
|= [a=(pha val) vals=(list val)]
|
|
||||||
^- (pha val)
|
|
||||||
?~ vals a
|
|
||||||
$(a (snoc a i.vals), vals t.vals)
|
|
||||||
::
|
|
||||||
:: +big-right: construct a tree, automatically balancing the right
|
|
||||||
:: side
|
|
||||||
++ big-right
|
|
||||||
|= [pf=(afx val) a=(pha val) ls=(list val)]
|
|
||||||
^- (pha val)
|
|
||||||
?. =(~ ls)
|
|
||||||
[%big pf a (make-afx ls)]
|
|
||||||
=/ [val=(unit val) inner=_a]
|
|
||||||
(pop-right a)
|
|
||||||
?~ val
|
|
||||||
(afx-to-pha pf)
|
|
||||||
[%big pf inner [%1 u.val ~]]
|
|
||||||
::
|
|
||||||
:: +pop-right: remove rightmost value from tree
|
|
||||||
::
|
|
||||||
++ pop-right
|
|
||||||
|= a=(pha val)
|
|
||||||
^- [val=(unit val) pha=(pha val)]
|
|
||||||
?- -.a
|
|
||||||
%nul ~^a
|
|
||||||
::
|
|
||||||
%one [`p.a nul/~]
|
|
||||||
::
|
|
||||||
%big
|
|
||||||
=/ ls=(list val) +.r.a
|
|
||||||
=^ item ls (flop ls)
|
|
||||||
[`item (big-right p.a q.a (flop ls))]
|
|
||||||
==
|
|
||||||
::
|
|
||||||
++ peek-right
|
|
||||||
|= a=(pha val)
|
|
||||||
?- -.a
|
|
||||||
%nul ~
|
|
||||||
%one `p.a
|
|
||||||
%big (rear +.r.a)
|
|
||||||
==
|
|
||||||
::
|
|
||||||
:: +| %manipulation
|
|
||||||
::
|
|
||||||
:: +weld: concatenate two trees
|
|
||||||
::
|
|
||||||
:: O(log n)
|
|
||||||
++ weld
|
|
||||||
=| c=(list val)
|
|
||||||
|= [a=(pha val) b=(pha val)]
|
|
||||||
^- (pha val)
|
|
||||||
?- -.b
|
|
||||||
%nul (apr a c)
|
|
||||||
%one (snoc (apr a c) p.b)
|
|
||||||
::
|
|
||||||
%big
|
|
||||||
?- -.a
|
|
||||||
%nul (apl b c)
|
|
||||||
%one (cons (apl b c) p.a)
|
|
||||||
::
|
|
||||||
%big
|
|
||||||
:- %big
|
|
||||||
=- [p.a - r.b]
|
|
||||||
$(a q.a, b q.b, c :(welp +.r.a c +.p.b))
|
|
||||||
==
|
|
||||||
==
|
|
||||||
:: +tap: transform tree to list
|
|
||||||
::
|
|
||||||
++ tap
|
|
||||||
=| res=(list val)
|
|
||||||
|= a=(pha val)
|
|
||||||
!.
|
|
||||||
|^ ^+ res
|
|
||||||
?- -.a
|
|
||||||
%nul ~
|
|
||||||
%one ~[p.a]
|
|
||||||
::
|
|
||||||
%big
|
|
||||||
=/ fst=_res
|
|
||||||
(tap-afx p.a)
|
|
||||||
=/ lst=_res
|
|
||||||
(tap-afx r.a)
|
|
||||||
=/ mid=_res
|
|
||||||
$(a q.a)
|
|
||||||
:(welp fst mid lst)
|
|
||||||
==
|
|
||||||
++ tap-afx
|
|
||||||
|= ax=(afx val)
|
|
||||||
^+ res
|
|
||||||
?- -.ax
|
|
||||||
%1 +.ax
|
|
||||||
%2 +.ax
|
|
||||||
%3 +.ax
|
|
||||||
%4 +.ax
|
|
||||||
==
|
|
||||||
--
|
|
||||||
--
|
|
||||||
::
|
|
||||||
:: +mop: constructs and validates ordered ordered map based on key,
|
:: +mop: constructs and validates ordered ordered map based on key,
|
||||||
:: val, and comparator gate
|
:: val, and comparator gate
|
||||||
::
|
::
|
||||||
|
|||||||
@ -5593,6 +5593,288 @@
|
|||||||
$(pops [oldest pops])
|
$(pops [oldest pops])
|
||||||
--
|
--
|
||||||
--
|
--
|
||||||
|
::
|
||||||
|
++ deq
|
||||||
|
|* val=mold
|
||||||
|
|%
|
||||||
|
::
|
||||||
|
:: +| %utilities
|
||||||
|
::
|
||||||
|
++ make-afx
|
||||||
|
|= ls=(list val)
|
||||||
|
?+ ls ~|(bad-finger/(lent ls) !!)
|
||||||
|
[* ~] [%1 ls]
|
||||||
|
[* * ~] [%2 ls]
|
||||||
|
[* * * ~] [%3 ls]
|
||||||
|
[* * * * ~] [%4 ls]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ wyt
|
||||||
|
|= a=(pha val)
|
||||||
|
^- @ud
|
||||||
|
?- -.a
|
||||||
|
%nul 0
|
||||||
|
%one 1
|
||||||
|
%big :(add (lent +.p.a) (lent +.r.a) $(a q.a))
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ afx-to-pha
|
||||||
|
|= =(afx val)
|
||||||
|
^- (pha val)
|
||||||
|
(apl *(pha val) +.afx)
|
||||||
|
::
|
||||||
|
:: +| %left-biased-operations
|
||||||
|
::
|
||||||
|
:: +pop-left: remove leftmost value from tree
|
||||||
|
::
|
||||||
|
++ pop-left
|
||||||
|
|= a=(pha val)
|
||||||
|
^- [val=(unit val) pha=(pha val)]
|
||||||
|
?- -.a
|
||||||
|
%nul ~^a
|
||||||
|
::
|
||||||
|
%one [`p.a nul/~]
|
||||||
|
::
|
||||||
|
%big
|
||||||
|
[`p.p.a (big-left +.+.p.a q.a r.a)]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
:: +peek-left: inspect leftmost value
|
||||||
|
::
|
||||||
|
++ peek-left
|
||||||
|
|= a=(pha val)
|
||||||
|
^- (unit val)
|
||||||
|
?- -.a
|
||||||
|
%nul ~
|
||||||
|
%one `p.a
|
||||||
|
%big `p.p.a
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ apl
|
||||||
|
|= [a=(pha val) vals=(list val)]
|
||||||
|
^- (pha val)
|
||||||
|
=. vals (flop vals)
|
||||||
|
|-
|
||||||
|
?~ vals a
|
||||||
|
$(a (cons a i.vals), vals t.vals)
|
||||||
|
::
|
||||||
|
::
|
||||||
|
++ dip-left
|
||||||
|
|* state=mold
|
||||||
|
|= $: a=(pha val)
|
||||||
|
=state
|
||||||
|
f=$-([state val] [(unit val) ? state])
|
||||||
|
==
|
||||||
|
^+ [state a]
|
||||||
|
=/ acc [stop=`?`%.n state=state]
|
||||||
|
=| new=(pha val)
|
||||||
|
|-
|
||||||
|
?: stop.acc
|
||||||
|
:: cat new and old
|
||||||
|
[state.acc (weld a new)]
|
||||||
|
=^ val=(unit val) a
|
||||||
|
(pop-left a)
|
||||||
|
?~ val
|
||||||
|
[state.acc new]
|
||||||
|
=^ res=(unit ^val) acc
|
||||||
|
(f state.acc u.val)
|
||||||
|
?~ res $
|
||||||
|
$(new (snoc new u.res))
|
||||||
|
::
|
||||||
|
++ big-left
|
||||||
|
|= [ls=(list val) a=(pha val) sf=(afx val)]
|
||||||
|
^- (pha val)
|
||||||
|
?. =(~ ls)
|
||||||
|
[%big (make-afx ls) a sf]
|
||||||
|
=/ [val=(unit val) inner=_a]
|
||||||
|
(pop-left a)
|
||||||
|
?~ val
|
||||||
|
(afx-to-pha sf)
|
||||||
|
[%big [%1 u.val ~] inner sf]
|
||||||
|
::
|
||||||
|
++ cons
|
||||||
|
=| b=(list val)
|
||||||
|
|= [a=(pha val) c=val]
|
||||||
|
^- (pha val)
|
||||||
|
=. b [c b]
|
||||||
|
|-
|
||||||
|
?~ b a
|
||||||
|
?- -.a
|
||||||
|
::
|
||||||
|
%nul
|
||||||
|
$(a [%one i.b], b t.b)
|
||||||
|
::
|
||||||
|
%one
|
||||||
|
%= $
|
||||||
|
b t.b
|
||||||
|
a [%big [%1 i.b ~] [%nul ~] [%1 p.a ~]]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
%big
|
||||||
|
?. ?=(%4 -.p.a)
|
||||||
|
%= $
|
||||||
|
b t.b
|
||||||
|
::
|
||||||
|
a
|
||||||
|
?- -.p.a
|
||||||
|
%1 big/[[%2 i.b p.p.a ~] q.a r.a]
|
||||||
|
%2 big/[[%3 i.b p.p.a q.p.a ~] q.a r.a]
|
||||||
|
%3 big/[[%4 i.b p.p.a q.p.a r.p.a ~] q.a r.a]
|
||||||
|
==
|
||||||
|
==
|
||||||
|
=/ inner
|
||||||
|
$(a q.a, b ~[s.p.a r.p.a q.p.a])
|
||||||
|
=. inner
|
||||||
|
$(a inner, b t.b)
|
||||||
|
big/[[%2 i.b p.p.a ~] inner r.a]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
:: +| %right-biased-operations
|
||||||
|
::
|
||||||
|
:: +snoc: append to end (right) of tree
|
||||||
|
::
|
||||||
|
++ snoc
|
||||||
|
|= [a=(pha val) b=val]
|
||||||
|
^+ a
|
||||||
|
?- -.a
|
||||||
|
%nul [%one b]
|
||||||
|
::
|
||||||
|
%one
|
||||||
|
:- %big
|
||||||
|
:* [%1 p.a ~]
|
||||||
|
[%nul ~]
|
||||||
|
[%1 b ~]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
%big
|
||||||
|
?- -.r.a
|
||||||
|
::
|
||||||
|
%1
|
||||||
|
:- %big
|
||||||
|
[p.a q.a [%2 p.r.a b ~]]
|
||||||
|
::
|
||||||
|
%2
|
||||||
|
:- %big
|
||||||
|
[p.a q.a [%3 p.r.a q.r.a b ~]]
|
||||||
|
::
|
||||||
|
%3
|
||||||
|
:- %big
|
||||||
|
[p.a q.a [%4 p.r.a q.r.a r.r.a b ~]]
|
||||||
|
::
|
||||||
|
%4
|
||||||
|
=/ inner
|
||||||
|
$(a q.a, b p.r.a)
|
||||||
|
=. inner
|
||||||
|
$(a inner, b q.r.a)
|
||||||
|
=. inner
|
||||||
|
$(a inner, b r.r.a)
|
||||||
|
:- %big
|
||||||
|
:* p.a
|
||||||
|
inner
|
||||||
|
[%2 s.r.a b ~]
|
||||||
|
==
|
||||||
|
==
|
||||||
|
==
|
||||||
|
:: +apr: append list to end (right) of tree
|
||||||
|
::
|
||||||
|
++ apr
|
||||||
|
|= [a=(pha val) vals=(list val)]
|
||||||
|
^- (pha val)
|
||||||
|
?~ vals a
|
||||||
|
$(a (snoc a i.vals), vals t.vals)
|
||||||
|
::
|
||||||
|
:: +big-right: construct a tree, automatically balancing the right
|
||||||
|
:: side
|
||||||
|
++ big-right
|
||||||
|
|= [pf=(afx val) a=(pha val) ls=(list val)]
|
||||||
|
^- (pha val)
|
||||||
|
?. =(~ ls)
|
||||||
|
[%big pf a (make-afx ls)]
|
||||||
|
=/ [val=(unit val) inner=_a]
|
||||||
|
(pop-right a)
|
||||||
|
?~ val
|
||||||
|
(afx-to-pha pf)
|
||||||
|
[%big pf inner [%1 u.val ~]]
|
||||||
|
::
|
||||||
|
:: +pop-right: remove rightmost value from tree
|
||||||
|
::
|
||||||
|
++ pop-right
|
||||||
|
|= a=(pha val)
|
||||||
|
^- [val=(unit val) pha=(pha val)]
|
||||||
|
?- -.a
|
||||||
|
%nul ~^a
|
||||||
|
::
|
||||||
|
%one [`p.a nul/~]
|
||||||
|
::
|
||||||
|
%big
|
||||||
|
=/ ls=(list val) +.r.a
|
||||||
|
=^ item ls (flop ls)
|
||||||
|
[`item (big-right p.a q.a (flop ls))]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ peek-right
|
||||||
|
|= a=(pha val)
|
||||||
|
?- -.a
|
||||||
|
%nul ~
|
||||||
|
%one `p.a
|
||||||
|
%big (rear +.r.a)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
:: +| %manipulation
|
||||||
|
::
|
||||||
|
:: +weld: concatenate two trees
|
||||||
|
::
|
||||||
|
:: O(log n)
|
||||||
|
++ weld
|
||||||
|
=| c=(list val)
|
||||||
|
|= [a=(pha val) b=(pha val)]
|
||||||
|
^- (pha val)
|
||||||
|
?- -.b
|
||||||
|
%nul (apr a c)
|
||||||
|
%one (snoc (apr a c) p.b)
|
||||||
|
::
|
||||||
|
%big
|
||||||
|
?- -.a
|
||||||
|
%nul (apl b c)
|
||||||
|
%one (cons (apl b c) p.a)
|
||||||
|
::
|
||||||
|
%big
|
||||||
|
:- %big
|
||||||
|
=- [p.a - r.b]
|
||||||
|
$(a q.a, b q.b, c :(welp +.r.a c +.p.b))
|
||||||
|
==
|
||||||
|
==
|
||||||
|
:: +tap: transform tree to list
|
||||||
|
::
|
||||||
|
++ tap
|
||||||
|
=| res=(list val)
|
||||||
|
|= a=(pha val)
|
||||||
|
!.
|
||||||
|
|^ ^+ res
|
||||||
|
?- -.a
|
||||||
|
%nul ~
|
||||||
|
%one ~[p.a]
|
||||||
|
::
|
||||||
|
%big
|
||||||
|
=/ fst=_res
|
||||||
|
(tap-afx p.a)
|
||||||
|
=/ lst=_res
|
||||||
|
(tap-afx r.a)
|
||||||
|
=/ mid=_res
|
||||||
|
$(a q.a)
|
||||||
|
:(welp fst mid lst)
|
||||||
|
==
|
||||||
|
++ tap-afx
|
||||||
|
|= ax=(afx val)
|
||||||
|
^+ res
|
||||||
|
?- -.ax
|
||||||
|
%1 +.ax
|
||||||
|
%2 +.ax
|
||||||
|
%3 +.ax
|
||||||
|
%4 +.ax
|
||||||
|
==
|
||||||
|
--
|
||||||
|
--
|
||||||
:: ::
|
:: ::
|
||||||
:::: ++userlib :: (2u) non-vane utils
|
:::: ++userlib :: (2u) non-vane utils
|
||||||
:: ::::
|
:: ::::
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user