diff --git a/pkg/arvo/app/aggregator.hoon b/pkg/arvo/app/aggregator.hoon index 370008a26..7a9671a9c 100644 --- a/pkg/arvo/app/aggregator.hoon +++ b/pkg/arvo/app/aggregator.hoon @@ -130,6 +130,7 @@ :: /x/pending/[0xadd.ress] -> %noun (list pend-tx) :: /x/tx/[0xke.ccak]/status -> %noun tx-status :: /x/nonce/[~ship]/[0xadd.ress] -> %atom @ + :: /x/spawned/[~ship] -> %noun (list [ship address) :: /x/next-batch -> %atom time :: ++ on-peek @@ -202,11 +203,15 @@ :- %noun !> ^- (list [=^ship =address:ethereum]) ?~ star=(slaw %p wat) ~ - %+ murn ~(tap by points.nas) + =/ range + %+ subset:orm:naive points.pre + :: range exclusive [star first-planet-next-star] + :: TODO: make range inclusive? [first-planet last-planet] + :: + [`u.star `(cat 3 +(u.star) 0x1)] + %+ turn (tap:orm:naive range) |= [=ship =point:naive] - ^- (unit [=^ship =address:ethereum]) - ?. =(star (^sein:title ship)) ~ - %- some + ^- [=^ship =address:ethereum] :- ship address:(proxy-from-point:naive %own point) -- @@ -480,7 +485,7 @@ ++ get-l1-pointer |= [=tx:naive nas=^state:naive] ^- l1-tx-pointer - ?~ point=(~(get by points.nas) ship.from.tx) + ?~ point=(get:orm:naive points.nas ship.from.tx) !! :_ next-nonce =< address diff --git a/pkg/arvo/lib/naive.hoon b/pkg/arvo/lib/naive.hoon index c3bea2de5..7944b16f0 100644 --- a/pkg/arvo/lib/naive.hoon +++ b/pkg/arvo/lib/naive.hoon @@ -129,6 +129,7 @@ +$ nonce @ud +$ dominion ?(%l1 %l2 %spawn) +$ keys [=life suite=@ud auth=@ crypt=@] +++ orm ((ordered-map ship point) aor) ++ point $: :: domain :: @@ -177,7 +178,7 @@ =operators dns=(list @t) == -+$ points (map ship point) ++$ points (tree [ship point]) +$ operators (jug address address) +$ effects (list diff) +$ proxy ?(%own %spawn %manage %vote %transfer) @@ -445,7 +446,7 @@ ++ get-point |= [=state =ship] ^- (unit point) - =/ existing (~(get by points.state) ship) + =/ existing (get:orm points.state ship) ?^ existing `u.existing =| =point @@ -507,7 +508,7 @@ =/ the-point (get-point state ship) ?> ?=(^ the-point) =* point u.the-point - =- [effects state(points (~(put by points.state) ship new-point))] + =- [effects state(points (put:orm points.state ship new-point))] ^- [=effects new-point=^point] :: ?: =(log-name changed-spawn-proxy:log-names) @@ -661,7 +662,7 @@ == :: :- [%nonce ship proxy nonce]~ - (~(put by points.state) ship u.point) + (put:orm points.state ship u.point) :: :: Receive an individual L2 transaction :: @@ -695,7 +696,7 @@ =/ res=(unit [=effects new-point=^point]) (fun u.point rest) ?~ res ~ - `[effects.u.res state(points (~(put by points.state) ship new-point.u.res))] + `[effects.u.res state(points (put:orm points.state ship new-point.u.res))] :: ++ process-transfer-point |= [=point to=address reset=?] @@ -726,7 +727,7 @@ ?: =(0 life.keys.net.point) `rift.net.point :- [%point ship %rift +(rift.net.point)]~ - +(rift.net.point) + +(rift.net.point) =/ effects-4 :~ [%point ship %spawn-proxy *address] [%point ship %management-proxy *address] @@ -759,7 +760,7 @@ :: :: TODO: verify this means the ship exists on neither L1 nor L2 :: - ?: (~(has by points.state) ship) (debug %spawn-exists ~) + ?^ (get:orm points.state ship) (debug %spawn-exists ~) :: Assert one-level-down :: ?. =(+((ship-rank parent)) (ship-rank ship)) (debug %bad-rank ~) @@ -791,7 +792,7 @@ address.owner.own address.owner.own.u.parent-point address.transfer-proxy.own to == - `[effects state(points (~(put by points.state) ship new-point))] + `[effects state(points (put:orm points.state ship new-point))] :: ++ process-configure-keys |= [=point crypt=@ auth=@ suite=@ breach=?] diff --git a/pkg/arvo/lib/std.hoon b/pkg/arvo/lib/std.hoon index 92915d158..64e399383 100644 --- a/pkg/arvo/lib/std.hoon +++ b/pkg/arvo/lib/std.hoon @@ -615,4 +615,347 @@ =+ d=(get b) (~(put by a) b (~(put in d) c)) -- +:: $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. +:: +:: WARNING: ordered-map will not work properly if two keys can be +:: unequal under noun equality but equal via the compare gate +:: +++ 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 + |% + ++ 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)) + -- + :: +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)]) + :: +bap: convert to list, largest to smallest + :: + ++ bap + |= a=(tree item) + ^- (list item) + :: + =| b=(list item) + |- ^+ b + ?~ a b + :: + $(a r.a, b [n.a $(a l.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) + :: + :: +get: get val at key or return ~ + :: + ++ 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) + :: + :: +subset: take a range excluding start and/or end and all elements + :: outside the range + :: + ++ subset + |= $: 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 ~))) + == + -- + -- +:: ++$ mold + :: normalizing gate + :: + :: a gate that accepts any noun, and validates its shape, producing the + :: input if it fits or a default value if it doesn't. + :: + :: examples: * @ud ,[p=time q=?(%a %b)] + $~(* $-(* *)) +:: +++ aor + ~/ %aor + |= [a=* b=*] + ^- ? + ?: =(a b) & + ?. ?=(@ a) + ?: ?=(@ b) | + ?: =(-.a -.b) + $(a +.a, b +.b) + $(a -.a, b -.b) + ?. ?=(@ b) & + |- + =+ [c=(end 3 a) d=(end 3 b)] + ?: =(c d) + $(a (rsh 3 a), b (rsh 3 b)) + (lth c d) --