From c03c3dc13be3d69cd69554265e44a0588ee14566 Mon Sep 17 00:00:00 2001 From: ~wicrum-wicrun <99811688+wicrum-wicrun@users.noreply.github.com> Date: Tue, 2 May 2023 17:01:53 +0200 Subject: [PATCH] ames: migration uses `+tap:deq` instead of `+dip-left:deq` --- pkg/arvo/sys/vane/ames.hoon | 401 +++++++++++++++++++----------------- 1 file changed, 214 insertions(+), 187 deletions(-) diff --git a/pkg/arvo/sys/vane/ames.hoon b/pkg/arvo/sys/vane/ames.hoon index 7b793053d0..f154de9ab5 100644 --- a/pkg/arvo/sys/vane/ames.hoon +++ b/pkg/arvo/sys/vane/ames.hoon @@ -853,193 +853,223 @@ ++ deq |* val=mold |% +:: :: +:: :: +| %utilities +:: :: +:: ++ make-afx +:: |= ls=(list val) +:: ?+ ls ~|(bad-finger/(lent ls) !!) +:: [* ~] [%1 ls] +:: [* * ~] [%2 ls] +:: [* * * ~] [%3 ls] +:: [* * * * ~] [%4 ls] +:: == +:: ++ 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)] +:: == +:: ++ 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) +:: :: +| %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 :: - :: +| %utilities - :: - ++ make-afx - |= ls=(list val) - ?+ ls ~|(bad-finger/(lent ls) !!) - [* ~] [%1 ls] - [* * ~] [%2 ls] - [* * * ~] [%3 ls] - [* * * * ~] [%4 ls] - == - ++ afx-to-pha - |= =(afx val) - ^- (pha val) - (apl *(pha val) +.afx) - :: - :: +| %left-biased-operations - :: - :: +pop-left: remove leftmost value from tree - :: - ++ pop-left + ++ tap + =| res=(list val) |= a=(pha val) - ^- [val=(unit val) pha=(pha val)] + !. + |^ ^+ res ?- -.a - %nul ~^a - :: - %one [`p.a nul/~] + %nul ~ + %one ~[p.a] :: %big - [`p.p.a (big-left +.+.p.a q.a r.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] + =/ fst=_res + (tap-afx p.a) + =/ lst=_res + (tap-afx r.a) + =/ mid=_res + $(a q.a) + :(welp fst mid lst) == - :: - :: +| %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 ~] + ++ tap-afx + |= ax=(afx val) + ^+ res + ?- -.ax + %1 +.ax + %2 +.ax + %3 +.ax + %4 +.ax == - :: - %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) - :: +| %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)) - == - == + -- -- -- :: $bug: debug printing configuration @@ -4699,13 +4729,10 @@ ++ keen-state-13-to-14 |= old=keen-state-13 ^- keen-state - =- old(wan wan) - %^ (dip-left:(deq:keen-state-13 want) ,wan=((mop @ud want) lte)) - wan.old - ~ - |= [wan=((mop @ud want) lte) =want] - ^- [(unit ^want) ? _wan] - [~ | (put:((on @ud ^want) lte) wan [fra .]:want)] + =- old(wan -) + %+ gas:((on @ud want) lte) ~ + %+ turn (tap:(deq:keen-state-13 want) wan.old) + |= =want [fra .]:want -- :: +scry: dereference namespace ::