From db0afd056e1091b6ad642a49ea58c0b3b4ad9c2b Mon Sep 17 00:00:00 2001 From: ~wicrum-wicrun <99811688+wicrum-wicrun@users.noreply.github.com> Date: Mon, 24 Apr 2023 18:38:14 +0200 Subject: [PATCH] lull,zuse: move `+deq` to zuse --- pkg/arvo/sys/lull.hoon | 282 ----------------------------------------- pkg/arvo/sys/zuse.hoon | 282 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 282 insertions(+), 282 deletions(-) diff --git a/pkg/arvo/sys/lull.hoon b/pkg/arvo/sys/lull.hoon index 12f7d0cc6..2c4941395 100644 --- a/pkg/arvo/sys/lull.hoon +++ b/pkg/arvo/sys/lull.hoon @@ -65,288 +65,6 @@ [%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, :: val, and comparator gate :: diff --git a/pkg/arvo/sys/zuse.hoon b/pkg/arvo/sys/zuse.hoon index 166c6727b..58ebb9cf2 100644 --- a/pkg/arvo/sys/zuse.hoon +++ b/pkg/arvo/sys/zuse.hoon @@ -5593,6 +5593,288 @@ $(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 :: ::::