mirror of
https://github.com/urbit/shrub.git
synced 2024-12-01 06:35:32 +03:00
Merge branch 'release/next-sys'
This commit is contained in:
Matilde Park
commit
0d68f3f901
@ -492,11 +492,11 @@
|
||||
++ v-ames
|
||||
|%
|
||||
++ peers
|
||||
(scry (map ship ?(%alien %known)) %a %peers ~)
|
||||
(scry (map ship ?(%alien %known)) %ax %$ /peers)
|
||||
::
|
||||
++ peer
|
||||
|= who=ship
|
||||
(scry ship-state:ames %a %peer /(scot %p who))
|
||||
(scry ship-state:ames %ax %$ /peers/(scot %p who))
|
||||
::
|
||||
++ peer-to-json
|
||||
=, ames
|
||||
@ -768,7 +768,7 @@
|
||||
++ v-behn
|
||||
|%
|
||||
++ timers
|
||||
(scry ,(list [date=@da =duct]) %b %timers ~)
|
||||
(scry ,(list [date=@da =duct]) %bx %$ /debug/timers)
|
||||
--
|
||||
::
|
||||
:: clay
|
||||
|
||||
@ -1,5 +1,9 @@
|
||||
:: Find list of currently running Behn timers
|
||||
:- %say
|
||||
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
|
||||
:- %tang
|
||||
[>.^((list [date=@da =duct]) %b (en-beam:format [p.bec %timers r.bec] /))< ~]
|
||||
=; timers
|
||||
[%tang >timers< ~]
|
||||
.^ (list [date=@da =duct])
|
||||
%bx
|
||||
(en-beam:format [p.bec %$ r.bec] /debug/timers)
|
||||
==
|
||||
|
||||
@ -190,7 +190,7 @@
|
||||
?. ?=({@ @ @ @ *} u.pux) ~
|
||||
=+ :* hyr=(slaw %tas i.u.pux)
|
||||
fal=(slaw %p i.t.u.pux)
|
||||
dyc=(slaw %tas i.t.t.u.pux)
|
||||
dyc=?~(i.t.t.u.pux (some %$) (slaw %tas i.t.t.u.pux))
|
||||
ved=(slay i.t.t.t.u.pux)
|
||||
tyl=t.t.t.t.u.pux
|
||||
==
|
||||
|
||||
@ -738,42 +738,72 @@
|
||||
--
|
||||
:: +scry: dereference namespace
|
||||
::
|
||||
:: The ones producing vases are expected to be used like this:
|
||||
::
|
||||
:: &tang [(sell .^(vase %a /=peer=/~zod)) ~]
|
||||
::
|
||||
++ scry
|
||||
|= [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path]
|
||||
^- (unit (unit cage))
|
||||
?. =(lot [%$ %da now]) ~
|
||||
?. =(%$ ren) [~ ~]
|
||||
?. =([%& our] why)
|
||||
[~ ~]
|
||||
?: =(tyl /whey)
|
||||
::TODO don't special-case whey scry
|
||||
::
|
||||
?: &(=(%$ ren) =(tyl /whey))
|
||||
=/ maz=(list mass)
|
||||
=+ [known alien]=(skid ~(val by peers.ames-state) |=(^ =(%known +<-)))
|
||||
:~ peers-known+&+known
|
||||
peers-alien+&+alien
|
||||
==
|
||||
``mass+!>(maz)
|
||||
?+ syd ~
|
||||
%peers
|
||||
?^ tyl [~ ~]
|
||||
:: only respond for the local identity, %$ desk, current timestamp
|
||||
::
|
||||
?. ?& =(&+our why)
|
||||
=([%$ %da now] lot)
|
||||
=(%$ syd)
|
||||
==
|
||||
~
|
||||
:: /ax/protocol/version @
|
||||
:: /ax/peers (map ship ?(%alien %known))
|
||||
:: /ax/peers/[ship] ship-state
|
||||
:: /ax/peers/[ship]/forward-lane (list lane)
|
||||
:: /ax/bones/[ship] [snd=(set bone) rcv=(set bone)]
|
||||
:: /ax/snd-bones/[ship]/[bone] vase
|
||||
::
|
||||
?. ?=(%x ren) ~
|
||||
?+ tyl ~
|
||||
[%protocol %version ~]
|
||||
``noun+!>(protocol-version)
|
||||
::
|
||||
[%peers ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (map ship ?(%alien %known))
|
||||
(~(run by peers.ames-state) head)
|
||||
::
|
||||
%peer
|
||||
?. ?=([@ ~] tyl) [~ ~]
|
||||
=/ who (slaw %p i.tyl)
|
||||
[%peers @ *]
|
||||
=/ who (slaw %p i.t.tyl)
|
||||
?~ who [~ ~]
|
||||
?~ peer=(~(get by peers.ames-state) u.who)
|
||||
[~ ~]
|
||||
``noun+!>(u.peer)
|
||||
?+ t.t.tyl [~ ~]
|
||||
~ ``noun+!>(u.peer)
|
||||
::
|
||||
[%forward-lane ~]
|
||||
:: find lane for u.who, or their galaxy
|
||||
::
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (list lane)
|
||||
=/ ship-state (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] ship-state)
|
||||
~
|
||||
=/ peer-state +.u.ship-state
|
||||
?. =(~ route.peer-state) ::NOTE avoid tmi
|
||||
[lane:(need route.peer-state)]~
|
||||
|- ^- (list lane)
|
||||
?: ?=(%czar (clan:title sponsor.peer-state))
|
||||
[%& sponsor.peer-state]~
|
||||
=/ next (~(get by peers.ames-state) sponsor.peer-state)
|
||||
?. ?=([~ %known *] next)
|
||||
~
|
||||
$(peer-state +.u.next)
|
||||
==
|
||||
::
|
||||
%bones
|
||||
?. ?=([@ ~] tyl) [~ ~]
|
||||
=/ who (slaw %p i.tyl)
|
||||
[%bones @ ~]
|
||||
=/ who (slaw %p i.t.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
@ -782,11 +812,10 @@
|
||||
[snd=~(key by snd) rcv=~(key by rcv)]
|
||||
``noun+!>(res)
|
||||
::
|
||||
%snd-bone
|
||||
?. ?=([@ @ ~] tyl) [~ ~]
|
||||
=/ who (slaw %p i.tyl)
|
||||
[%snd-bones @ @ ~]
|
||||
=/ who (slaw %p i.t.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ ost (slaw %ud i.t.tyl)
|
||||
=/ ost (slaw %ud i.t.t.tyl)
|
||||
?~ ost [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
|
||||
@ -378,23 +378,63 @@
|
||||
++ scry
|
||||
|= [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path]
|
||||
^- (unit (unit cage))
|
||||
::TODO don't special-case whey scry
|
||||
::
|
||||
?. ?=(%& -.why)
|
||||
~
|
||||
?: &(=(ren %$) =(tyl /whey))
|
||||
=/ maz=(list mass)
|
||||
:~ timers+&+timers.state
|
||||
==
|
||||
``mass+!>(maz)
|
||||
?. ?=(%timers syd)
|
||||
[~ ~]
|
||||
=/ tiz=(list [@da duct])
|
||||
:: only respond for the local identity, %$ desk, current timestamp
|
||||
::
|
||||
?. ?& =(&+our why)
|
||||
=([%$ %da now] lot)
|
||||
=(%$ syd)
|
||||
==
|
||||
~
|
||||
:: /bx/debug/timers (list [@da duct]) all timers and their ducts
|
||||
:: /bx/timers (list @da) all timer timestamps
|
||||
:: /bx/timers/next (unit @da) the very next timer to fire
|
||||
:: /bx/timers/[da] (list @da) all timers up to and including da
|
||||
::
|
||||
?. ?=(%x ren) ~
|
||||
?+ tyl [~ ~]
|
||||
[%debug %timers ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (list [@da duct])
|
||||
%- zing
|
||||
%+ turn (tap:timer-map timers)
|
||||
|= [date=@da q=(qeu duct)]
|
||||
%+ turn ~(tap to q)
|
||||
|=(d=duct [date d])
|
||||
[~ ~ %noun !>(tiz)]
|
||||
::
|
||||
[%timers ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (list @da)
|
||||
%- zing
|
||||
%+ turn (tap:timer-map timers)
|
||||
|= [date=@da q=(qeu duct)]
|
||||
(reap ~(wyt in q) date)
|
||||
::
|
||||
[%timers %next ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (unit @da)
|
||||
(bind (peek:timer-map timers) head)
|
||||
::
|
||||
[%timers @ ~]
|
||||
?~ til=(slaw %da i.t.tyl)
|
||||
[~ ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (list @da)
|
||||
=/ tiz=(list [date=@da q=(qeu duct)])
|
||||
(tap:timer-map timers)
|
||||
|- ^- (list @da)
|
||||
?~ tiz ~
|
||||
?: (gth date.i.tiz u.til) ~
|
||||
%+ weld
|
||||
(reap ~(wyt in q.i.tiz) date.i.tiz)
|
||||
$(tiz t.tiz)
|
||||
==
|
||||
::
|
||||
++ stay state
|
||||
++ take
|
||||
|
||||
@ -7085,6 +7085,18 @@
|
||||
$(pops [oldest pops])
|
||||
--
|
||||
--
|
||||
::
|
||||
:: +mop: constructs and validates ordered ordered map based on key,
|
||||
:: val, and comparator gate
|
||||
::
|
||||
++ mop
|
||||
|* [key=mold value=mold]
|
||||
|= ord=$-([key key] ?)
|
||||
|= a=*
|
||||
=/ b ;;((tree [key=key val=value]) a)
|
||||
?> (check-balance:((ordered-map key value) ord) b)
|
||||
b
|
||||
::
|
||||
:: $mk-item: constructor for +ordered-map item type
|
||||
::
|
||||
++ mk-item |$ [key val] [key=key val=val]
|
||||
@ -7094,6 +7106,9 @@
|
||||
:: 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]
|
||||
=> |%
|
||||
@ -7166,6 +7181,7 @@
|
||||
?~ a ~
|
||||
?~ l.a `n.a
|
||||
$(a l.a)
|
||||
::
|
||||
:: +pop: produce .head (smallest item) and .rest or crash if empty
|
||||
::
|
||||
++ pop
|
||||
@ -7332,6 +7348,68 @@
|
||||
?: (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 ~)))
|
||||
==
|
||||
--
|
||||
--
|
||||
:: ::
|
||||
:::: ++userlib :: (2u) non-vane utils
|
||||
|
||||
@ -1,8 +1,4 @@
|
||||
:: TODO: move +ordered-map to zuse
|
||||
::
|
||||
/+ *test
|
||||
/= ames /sys/vane/ames
|
||||
::
|
||||
=/ items-from-keys
|
||||
|= keys=(list @ud)
|
||||
%+ turn keys
|
||||
@ -12,7 +8,7 @@
|
||||
=/ test-items=(list [@ud @tas])
|
||||
(items-from-keys (gulf 0 6))
|
||||
::
|
||||
=/ atom-map ((ordered-map:ames @ud @tas) lte)
|
||||
=/ atom-map ((ordered-map @ud @tas) lte)
|
||||
::
|
||||
|%
|
||||
++ test-ordered-map-gas ^- tang
|
||||
@ -57,6 +53,56 @@
|
||||
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e] [5^%f]])
|
||||
!> b
|
||||
::
|
||||
++ test-ordered-map-subset ^- tang
|
||||
::
|
||||
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
|
||||
::
|
||||
=/ b (subset:atom-map a `0 `4)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (gas:atom-map ~ ~[[1^%b] [2^%c] [3^%d]])
|
||||
!> b
|
||||
::
|
||||
++ test-ordered-map-null-start-subset ^- tang
|
||||
::
|
||||
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
|
||||
::
|
||||
=/ b (subset:atom-map a ~ `5)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e]])
|
||||
!> b
|
||||
::
|
||||
++ test-ordered-map-null-end-subset ^- tang
|
||||
::
|
||||
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
|
||||
::
|
||||
=/ b (subset:atom-map a `1 ~)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (gas:atom-map ~ ~[[2^%c] [3^%d] [4^%e] [5^%f] [6^%g]])
|
||||
!> b
|
||||
::
|
||||
++ test-ordered-map-double-null-subset ^- tang
|
||||
::
|
||||
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
|
||||
::
|
||||
=/ b (subset:atom-map a ~ ~)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (gas:atom-map ~ ~[[0^%a] [1^%b] [2^%c] [3^%d] [4^%e] [5^%f] [6^%g]])
|
||||
!> b
|
||||
::
|
||||
++ test-ordered-map-not-found-start-subset ^- tang
|
||||
::
|
||||
=/ a=(tree [@ud @tas]) (gas:atom-map ~ ~[[1^%b]])
|
||||
::
|
||||
=/ b (subset:atom-map a `0 ~)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> (gas:atom-map ~ ~[[1^%b]])
|
||||
!> b
|
||||
::
|
||||
++ test-ordered-map-traverse ^- tang
|
||||
::
|
||||
=/ a=(tree [@ud @tas]) (gas:atom-map ~ test-items)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user