naive: wip add ordered-map for points

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])
+      ^-  [=^ship =address:ethereum]
-      ?.  =(star (^sein:title ship))  ~
-      %-  some
       :-  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

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=?]
@@ -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=?]

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)
 --