mirror of
https://github.com/urbit/shrub.git
synced 2024-12-24 20:47:27 +03:00
Merge branch 'develop' into i/6103/abet-pure
This commit is contained in:
commit
df47808047
@ -167,7 +167,7 @@ should be accompanied by an updated [solid pill](#the-kernel-and-pills). Pills
|
||||
are tracked in the repository via [git LFS][git-lfs].
|
||||
|
||||
```
|
||||
$ git lfs init
|
||||
$ git lfs install
|
||||
$ git lfs pull
|
||||
```
|
||||
|
||||
@ -185,7 +185,7 @@ directory as `urbit.pill`.
|
||||
You can boot a new ship from your local pill with `-B`:
|
||||
|
||||
```
|
||||
$ urbit -F zod -B path/to/urbit.pill my-fake-zod
|
||||
$ urbit -F zod -B path/to/urbit.pill -c my-fake-zod
|
||||
```
|
||||
|
||||
Release pills, i.e. those corresponding to vere releases, are cached at
|
||||
|
@ -13,15 +13,12 @@ also simple to reason about.
|
||||
|
||||
The branches and their corresponding moons that comprise the stages of the
|
||||
release pipeline are:
|
||||
```
|
||||
----------------------------------------------------------------------------------------------
|
||||
Branch | Moon | Target audience | Contains
|
||||
----------------------------------------------------------------------------------------------
|
||||
`develop` | `~binnec-dozzod-marzod` | Kernel developers | Latest `develop` branch commit
|
||||
`release` | `~marnec-dozzod-marzod` | Early Adopters | Latest `release` branch commit
|
||||
`release` | `~doznec-dozzod-marzod` | App Developers | Latest release candidate
|
||||
`master` | `~zod` | Everyone else | Latest release
|
||||
```
|
||||
| Branch | Moon | Target Audience | Contains |
|
||||
|:---------:|:-----------------------:|:-----------------:|:------------------------------:|
|
||||
| `develop` | `~binnec-dozzod-marzod` | Kernel Developers | Latest `develop` branch commit |
|
||||
| `release` | `~marnec-dozzod-marzod` | Early Adopters | Latest `release` branch commit |
|
||||
| `release` | `~doznec-dozzod-marzod` | App Developers | Latest release candidate |
|
||||
| `master` | `~zod` | Everyone Else | Latest release |
|
||||
|
||||
**WARNING**: If you lack the requisite skills to troubleshoot and fix kernel issues, you should not sync from develop/~binnec. If you're not prepared to breach your ship in response to an issue stemming from an early release, do not use pre-release moons.
|
||||
|
||||
|
@ -831,7 +831,9 @@
|
||||
|= keen-state
|
||||
|^ ^- json
|
||||
%- pairs
|
||||
:~ 'wan'^a/(turn (tap:(deq want) wan) wants)
|
||||
:~ :- %wan
|
||||
a/(turn (tap:((on @ud want) lte) wan) |=([@ a=_+6:wants] (wants a)))
|
||||
::
|
||||
'nex'^a/(turn nex wants)
|
||||
::
|
||||
:- 'hav'
|
||||
|
@ -15,7 +15,7 @@
|
||||
running=(axal thread-form)
|
||||
tid=(map tid yarn)
|
||||
serving=(map tid [(unit @ta) =mark =desk])
|
||||
scries=(map tid [=ship =path])
|
||||
scrying=(jug tid [=wire =ship =path])
|
||||
==
|
||||
::
|
||||
+$ clean-slate-any
|
||||
@ -25,16 +25,26 @@
|
||||
clean-slate-2
|
||||
clean-slate-3
|
||||
clean-slate-4
|
||||
clean-slate-5
|
||||
clean-slate
|
||||
==
|
||||
::
|
||||
+$ clean-slate
|
||||
$: %6
|
||||
starting=(map yarn [=trying =vase])
|
||||
running=(list yarn)
|
||||
tid=(map tid yarn)
|
||||
serving=(map tid [(unit @ta) =mark =desk])
|
||||
scrying=(jug tid [wire ship path])
|
||||
==
|
||||
::
|
||||
+$ clean-slate-5
|
||||
$: %5
|
||||
starting=(map yarn [=trying =vase])
|
||||
running=(list yarn)
|
||||
tid=(map tid yarn)
|
||||
serving=(map tid [(unit @ta) =mark =desk])
|
||||
scries=(map tid [ship path])
|
||||
scrying=(map tid [ship path])
|
||||
==
|
||||
::
|
||||
+$ clean-slate-4
|
||||
@ -110,7 +120,8 @@
|
||||
=. any (old-to-3 any)
|
||||
=. any (old-to-4 any)
|
||||
=. any (old-to-5 any)
|
||||
?> ?=(%5 -.any)
|
||||
=. any (old-to-6 any)
|
||||
?> ?=(%6 -.any)
|
||||
::
|
||||
=. tid.state tid.any
|
||||
=/ yarns=(list yarn)
|
||||
@ -120,7 +131,11 @@
|
||||
?~ yarns
|
||||
[~[bind-eyre:sc] this]
|
||||
=^ cards-1 state
|
||||
(handle-stop-thread:sc (yarn-to-tid i.yarns) |)
|
||||
%. [(yarn-to-tid i.yarns) nice=%.n]
|
||||
:: the |sc core needs to now about the previous
|
||||
:: scrying state in order to send $yawns to %ames
|
||||
::
|
||||
%*(handle-stop-thread sc scrying.state scrying.any)
|
||||
=^ cards-2 this
|
||||
$(yarns t.yarns)
|
||||
[:(weld upgrade-cards cards-1 cards-2) this]
|
||||
@ -133,8 +148,8 @@
|
||||
++ old-to-2
|
||||
|= old=clean-slate-any
|
||||
^- (quip card clean-slate-any)
|
||||
?> ?=(?(%1 %2 %3 %4 %5) -.old)
|
||||
?: ?=(?(%2 %3 %4 %5) -.old)
|
||||
?> ?=(?(%1 %2 %3 %4 %5 %6) -.old)
|
||||
?: ?=(?(%2 %3 %4 %5 %6) -.old)
|
||||
`old
|
||||
:- ~[bind-eyre:sc]
|
||||
:* %2
|
||||
@ -147,8 +162,8 @@
|
||||
++ old-to-3
|
||||
|= old=clean-slate-any
|
||||
^- clean-slate-any
|
||||
?> ?=(?(%2 %3 %4 %5) -.old)
|
||||
?: ?=(?(%3 %4 %5) -.old)
|
||||
?> ?=(?(%2 %3 %4 %5 %6) -.old)
|
||||
?: ?=(?(%3 %4 %5 %6) -.old)
|
||||
old
|
||||
:* %3
|
||||
starting.old
|
||||
@ -156,11 +171,12 @@
|
||||
tid.old
|
||||
(~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl]))
|
||||
==
|
||||
::
|
||||
++ old-to-4
|
||||
|= old=clean-slate-any
|
||||
^- clean-slate-any
|
||||
?> ?=(?(%3 %4 %5) -.old)
|
||||
?: ?=(?(%4 %5) -.old)
|
||||
?> ?=(?(%3 %4 %5 %6) -.old)
|
||||
?: ?=(?(%4 %5 %6) -.old)
|
||||
old
|
||||
:* %4
|
||||
starting.old
|
||||
@ -171,10 +187,27 @@
|
||||
::
|
||||
++ old-to-5
|
||||
|= old=clean-slate-any
|
||||
^- clean-slate
|
||||
?> ?=(?(%4 %5) -.old)
|
||||
?: ?=(%5 -.old) old
|
||||
^- clean-slate-any
|
||||
?> ?=(?(%4 %5 %6) -.old)
|
||||
?: ?=(?(%5 %6) -.old) old
|
||||
[%5 +.old(serving [serving.old ~])]
|
||||
::
|
||||
++ old-to-6
|
||||
|= old=clean-slate-any
|
||||
^- clean-slate
|
||||
?> ?=(?(%5 %6) -.old)
|
||||
?: ?=(%6 -.old) old
|
||||
:- %6
|
||||
%= +.old
|
||||
scrying
|
||||
%- ~(run by scrying.old)
|
||||
|= [=ship =path]
|
||||
%- ~(gas in *(set [wire ^ship ^path]))
|
||||
:: XX +keen:strandio used /keen as the default wire
|
||||
:: this assumes that any old thread used that as well
|
||||
::
|
||||
[/keen ship path]~
|
||||
==
|
||||
--
|
||||
::
|
||||
++ on-poke
|
||||
@ -421,14 +454,13 @@
|
||||
?: (~(has of running.state) u.yarn)
|
||||
?. nice
|
||||
(thread-fail u.yarn %cancelled ~)
|
||||
=^ cancel-cards state (cancel-scry tid &)
|
||||
=^ done-cards state (thread-done u.yarn *vase)
|
||||
[(weld cancel-cards done-cards) state]
|
||||
=^ done-cards state (thread-done u.yarn *vase silent=%.n)
|
||||
[done-cards state]
|
||||
?: (~(has by starting.state) u.yarn)
|
||||
(thread-fail-not-running tid %stopped-before-started ~)
|
||||
~& [%thread-not-started u.yarn]
|
||||
?: nice
|
||||
(thread-done u.yarn *vase)
|
||||
(thread-done u.yarn *vase silent=%.y)
|
||||
(thread-fail u.yarn %cancelled ~)
|
||||
::
|
||||
++ take-input
|
||||
@ -457,8 +489,8 @@
|
||||
^- [(list card) _state]
|
||||
%+ roll cards.r
|
||||
|= [=card cards=(list card) s=_state]
|
||||
:_ =? scries.s ?=([%pass ^ %arvo %a %keen @ *] card)
|
||||
(~(put by scries.s) tid &6.card +>+>+>.card)
|
||||
:_ =? scrying.s ?=([%pass ^ %arvo %a %keen @ *] card)
|
||||
(~(put ju scrying.s) tid [&2 &6 |6]:card)
|
||||
s
|
||||
:_ cards
|
||||
^- ^card
|
||||
@ -476,7 +508,7 @@
|
||||
?- -.eval-result.r
|
||||
%next `state
|
||||
%fail (thread-fail yarn err.eval-result.r)
|
||||
%done (thread-done yarn value.eval-result.r)
|
||||
%done (thread-done yarn value.eval-result.r silent=%.y)
|
||||
==
|
||||
[(weld cards final-cards) state]
|
||||
::
|
||||
@ -500,12 +532,15 @@
|
||||
++ cancel-scry
|
||||
|= [=tid silent=?]
|
||||
^- (quip card _state)
|
||||
?~ scry=(~(get by scries.state) tid)
|
||||
?~ scrying=(~(get ju scrying.state) tid)
|
||||
`state
|
||||
:_ state(scries (~(del by scries.state) tid))
|
||||
:_ state(scrying (~(del by scrying.state) tid))
|
||||
?: silent ~
|
||||
%- (slog leaf+"cancelling {<tid>}: [{<[ship path]:u.scry>}]" ~)
|
||||
[%pass /thread/[tid]/keen %arvo %a %yawn [ship path]:u.scry]~
|
||||
%- ~(rep in `(set [wire ship path])`scrying)
|
||||
|= [[=wire =ship =path] cards=(list card)]
|
||||
%- (slog leaf+"cancelling {<tid>}: [{<[wire ship path]>}]" ~)
|
||||
:_ cards
|
||||
[%pass (welp /thread/[tid] wire) %arvo %a %yawn ship path]
|
||||
::
|
||||
++ thread-http-fail
|
||||
|= [=tid =term =tang]
|
||||
@ -535,9 +570,9 @@
|
||||
::%- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
|
||||
=/ =tid (yarn-to-tid yarn)
|
||||
=/ fail-cards (thread-say-fail tid term tang)
|
||||
=^ cards state (thread-clean yarn)
|
||||
=^ cards state (thread-clean yarn)
|
||||
=^ http-cards state (thread-http-fail tid term tang)
|
||||
=^ scry-card state (cancel-scry tid |)
|
||||
=^ scry-card state (cancel-scry tid silent=%.n)
|
||||
:_ state
|
||||
:(weld fail-cards cards http-cards scry-card)
|
||||
::
|
||||
@ -556,7 +591,7 @@
|
||||
(json-response:gen:server !<(json (tube vase)))
|
||||
::
|
||||
++ thread-done
|
||||
|= [=yarn =vase]
|
||||
|= [=yarn =vase silent=?]
|
||||
^- (quip card ^state)
|
||||
:: %- (slog leaf+"strand {<yarn>} finished" (sell vase) ~)
|
||||
=/ =tid (yarn-to-tid yarn)
|
||||
@ -566,8 +601,8 @@
|
||||
==
|
||||
=^ http-cards state
|
||||
(thread-http-response tid vase)
|
||||
=^ scry-card state (cancel-scry tid &)
|
||||
=^ cards state (thread-clean yarn)
|
||||
=^ scry-card state (cancel-scry tid silent)
|
||||
=^ cards state (thread-clean yarn)
|
||||
[:(weld done-cards cards http-cards scry-card) state]
|
||||
::
|
||||
++ thread-clean
|
||||
@ -640,7 +675,7 @@
|
||||
::
|
||||
++ clean-state
|
||||
!> ^- clean-slate
|
||||
5+state(running (turn ~(tap of running.state) head))
|
||||
6+state(running (turn ~(tap of running.state) head))
|
||||
::
|
||||
++ convert-tube
|
||||
|= [from=mark to=mark =desk =bowl:gall]
|
||||
|
@ -1,7 +1,7 @@
|
||||
/- *hood
|
||||
:- %say
|
||||
|= [[now=@da eny=@uvJ bec=beak] [syd=desk ~] verb=_&]
|
||||
:~ %tang
|
||||
:* %tang
|
||||
leaf+"Notice: +vat is deprecated as +vats now takes lists of one or more desks"
|
||||
(report-vat (report-prep p.bec now) p.bec now syd verb)
|
||||
==
|
||||
|
@ -1,21 +1,28 @@
|
||||
:: Print diagnostic information about desks.
|
||||
:: Print diagnostic information about desks.
|
||||
::
|
||||
:: Accepts an optional argument of a list of one or more desks, returns info
|
||||
:: Accepts an optional argument of a list of one or more desks, returns info
|
||||
:: on all desks if no desks are specified.
|
||||
::
|
||||
:: Keyword arguments include =filt and =verb. =filt takes one of %running,
|
||||
:: Keyword arguments include =filt and =verb. =filt takes one of %running,
|
||||
:: %suspended, %exists, %exists-not, or %blocking; =verb takes either & or |
|
||||
::
|
||||
::
|
||||
:: If both a list of desks and a filter are provided, the output will include
|
||||
:: the desks from the list that match the filter, with the exception of the
|
||||
:: the desks from the list that match the filter, with the exception of the
|
||||
:: %blocking filter which always returns all desks that match.
|
||||
::
|
||||
/- *hood
|
||||
:- %say
|
||||
|= [[now=@da * bec=beak] deks=$@(~ (list desk)) filt=@tas verb=_|]
|
||||
?: &(=(~ deks) =(%$ filt))
|
||||
:- %tang
|
||||
%+ turn
|
||||
~(tap in .^((set desk) %cd /(scot %p p.bec)/base/(scot %da now)))
|
||||
|=(syd=desk (report-vat (report-prep p.bec now) p.bec now syd verb))
|
||||
[%tang (report-vats p.bec now deks filt verb)]
|
||||
|= $: [now=@da * bec=beak]
|
||||
deks=(list desk)
|
||||
[filt=@tas verb=_|]
|
||||
==
|
||||
:- %tang ^- tang
|
||||
?. &(=(~ deks) =(%$ filt))
|
||||
(report-vats p.bec now deks filt verb)
|
||||
%- zing
|
||||
%+ turn
|
||||
%+ sort
|
||||
=/ sed .^((set desk) %cd /(scot %p p.bec)/base/(scot %da now))
|
||||
(sort ~(tap in sed) |=([a=@ b=@] !(aor a b)))
|
||||
|=([a=desk b=desk] ?|(=(a %kids) =(b %base)))
|
||||
|=(syd=desk (report-vat (report-prep p.bec now) p.bec now syd verb))
|
||||
|
@ -11470,9 +11470,15 @@
|
||||
:: 5d: parser
|
||||
+| %parser
|
||||
::
|
||||
++ vang :: set ++vast params
|
||||
|= [bug=? wer=path] :: bug: debug mode
|
||||
%*(. vast bug bug, wer wer) :: wer: where we are
|
||||
:: +vang: set +vast params
|
||||
::
|
||||
:: bug: debug mode
|
||||
:: doc: doccord parsing
|
||||
:: wer: where we are
|
||||
::
|
||||
++ vang
|
||||
|= [f=$@(? [bug=? doc=?]) wer=path]
|
||||
%*(. vast bug ?@(f f bug.f), doc ?@(f & doc.f), wer wer)
|
||||
::
|
||||
++ vast :: main parsing core
|
||||
=+ [bug=`?`| wer=*path doc=`?`&]
|
||||
@ -13486,7 +13492,7 @@
|
||||
;~ pose
|
||||
%+ ifix
|
||||
[;~(plug lus tar muck) muck]
|
||||
(most muck ;~(gunk sym loaf))
|
||||
(most muck ;~(gunk sym loll))
|
||||
::
|
||||
(easy ~)
|
||||
==
|
||||
@ -13563,6 +13569,7 @@
|
||||
++ hunk (most mush loan) :: gapped specs
|
||||
++ jump ;~(pose leap:docs gap) :: gap before docs
|
||||
++ loaf ?:(tol tall wide) :: hoon
|
||||
++ loll ?:(tol tall(doc |) wide(doc |)) :: hoon without docs
|
||||
++ loan ?:(tol till wyde) :: spec
|
||||
++ lore (sear |=(=hoon ~(flay ap hoon)) loaf) :: skin
|
||||
++ lomp ;~(plug sym (punt ;~(pfix tis wyde))) :: typeable name
|
||||
@ -13612,7 +13619,7 @@
|
||||
++ expd |.(;~(goop loaf loaf loaf loaf)) :: four hoons
|
||||
++ expe |.(wisp) :: core tail
|
||||
++ expf |.(;~(goop ;~(pfix cen sym) loaf)) :: %term and hoon
|
||||
++ expg |.(;~(goop lomp loaf loaf)) :: term/spec, two hoons
|
||||
++ expg |.(;~(gunk lomp loll loaf)) :: term/spec, two hoons
|
||||
++ exph |.((butt ;~(gunk rope rick))) :: wing, [wing hoon]s
|
||||
++ expi |.((butt ;~(goop loaf hank))) :: one or more hoons
|
||||
++ expj |.(;~(goop lore loaf)) :: skin and hoon
|
||||
|
@ -36,27 +36,6 @@
|
||||
max-size=_2.048
|
||||
depth=_1
|
||||
==
|
||||
::
|
||||
:: +afx: polymorphic node type for finger trees
|
||||
::
|
||||
++ afx
|
||||
|$ [val]
|
||||
$% [%1 p=val ~]
|
||||
[%2 p=val q=val ~]
|
||||
[%3 p=val q=val r=val ~]
|
||||
[%4 p=val q=val r=val s=val ~]
|
||||
==
|
||||
::
|
||||
:: +pha: finger tree
|
||||
::
|
||||
++ pha
|
||||
|$ [val]
|
||||
$~ [%nul ~]
|
||||
$% [%nul ~]
|
||||
[%one p=val]
|
||||
[%big p=(afx val) q=(pha val) r=(afx val)]
|
||||
==
|
||||
::
|
||||
:: +mop: constructs and validates ordered ordered map based on key,
|
||||
:: val, and comparator gate
|
||||
::
|
||||
@ -461,6 +440,13 @@
|
||||
?: (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)
|
||||
:: +wyt: measure size
|
||||
::
|
||||
++ wyt
|
||||
~/ %wyt
|
||||
|= a=(tree item)
|
||||
^- @ud
|
||||
?~(a 0 +((add $(a l.a) $(a r.a))))
|
||||
--
|
||||
::
|
||||
+$ deco ?(~ %bl %br %un) :: text decoration
|
||||
@ -1029,9 +1015,9 @@
|
||||
keens=(map path keen-state)
|
||||
==
|
||||
+$ keen-state
|
||||
$: wan=(pha want) :: request packets, sent
|
||||
nex=(list want) :: request packets, unsent
|
||||
hav=(list have) :: response packets, backward
|
||||
$: wan=((mop @ud want) lte) :: request packets, sent
|
||||
nex=(list want) :: request packets, unsent
|
||||
hav=(list have) :: response packets, backward
|
||||
num-fragments=@ud
|
||||
num-received=@ud
|
||||
next-wake=(unit @da)
|
||||
@ -1182,7 +1168,6 @@
|
||||
?: (gth message-num.a message-num.b)
|
||||
%.n
|
||||
(lte fragment-num.a fragment-num.b)
|
||||
::
|
||||
:: $pump-metrics: congestion control state for a |packet-pump
|
||||
::
|
||||
:: This is an Ames adaptation of TCP's Reno congestion control
|
||||
|
@ -777,6 +777,301 @@
|
||||
++ com |~(a=pass ^?(..nu))
|
||||
--
|
||||
--
|
||||
::
|
||||
+$ ames-state-13
|
||||
$: peers=(map ship ship-state-13)
|
||||
=unix=duct
|
||||
=life
|
||||
=rift
|
||||
crypto-core=acru:ames
|
||||
=bug
|
||||
snub=[form=?(%allow %deny) ships=(set ship)]
|
||||
cong=[msg=@ud mem=@ud]
|
||||
==
|
||||
::
|
||||
+$ ship-state-13
|
||||
$% [%alien alien-agenda]
|
||||
[%known peer-state-13]
|
||||
==
|
||||
::
|
||||
+$ peer-state-13
|
||||
$: $: =symmetric-key
|
||||
=life
|
||||
=rift
|
||||
=public-key
|
||||
sponsor=ship
|
||||
==
|
||||
route=(unit [direct=? =lane])
|
||||
=qos
|
||||
=ossuary
|
||||
snd=(map bone message-pump-state)
|
||||
rcv=(map bone message-sink-state)
|
||||
nax=(set [=bone =message-num])
|
||||
heeds=(set duct)
|
||||
closing=(set bone)
|
||||
corked=(set bone)
|
||||
keens=(map path keen-state-13)
|
||||
==
|
||||
::
|
||||
++ keen-state-13
|
||||
=< $: wan=(pha want) :: request packts, sent
|
||||
nex=(list want) :: request packets, unsent
|
||||
hav=(list have) :: response packets, backward
|
||||
num-fragments=@ud
|
||||
num-received=@ud
|
||||
next-wake=(unit @da)
|
||||
listeners=(set duct)
|
||||
metrics=pump-metrics
|
||||
==
|
||||
|%
|
||||
:: +afx: polymorphic node type for finger trees
|
||||
::
|
||||
++ afx
|
||||
|$ [val]
|
||||
$% [%1 p=val ~]
|
||||
[%2 p=val q=val ~]
|
||||
[%3 p=val q=val r=val ~]
|
||||
[%4 p=val q=val r=val s=val ~]
|
||||
==
|
||||
:: +pha: finger tree
|
||||
::
|
||||
:: DO NOT USE THIS
|
||||
:: It's wrong and only kept around for state migration purposes.
|
||||
::
|
||||
++ pha
|
||||
|$ [val]
|
||||
$~ [%nul ~]
|
||||
$% [%nul ~]
|
||||
[%one p=val]
|
||||
[%big p=(afx val) q=(pha val) r=(afx val)]
|
||||
==
|
||||
:: +deq: deque
|
||||
::
|
||||
:: DO NOT USE THIS
|
||||
:: It's wrong and only kept around for state migration purposes.
|
||||
::
|
||||
++ 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
|
||||
::
|
||||
++ 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
|
||||
==
|
||||
--
|
||||
--
|
||||
--
|
||||
:: $bug: debug printing configuration
|
||||
::
|
||||
:: veb: verbosity toggles
|
||||
@ -909,7 +1204,8 @@
|
||||
[%10 ames-state-10]
|
||||
[%11 ames-state-11]
|
||||
[%12 ames-state-12]
|
||||
[%13 ^ames-state]
|
||||
[%13 ames-state-13]
|
||||
[%14 ^ames-state]
|
||||
==
|
||||
::
|
||||
|= [now=@da eny=@ rof=roof]
|
||||
@ -1032,7 +1328,7 @@
|
||||
:: lifecycle arms; mostly pass-throughs to the contained adult ames
|
||||
::
|
||||
++ scry scry:adult-core
|
||||
++ stay [%13 %larva queued-events ames-state.adult-gate]
|
||||
++ stay [%14 %larva queued-events ames-state.adult-gate]
|
||||
++ load
|
||||
|= $= old
|
||||
$% $: %4
|
||||
@ -1099,6 +1395,13 @@
|
||||
[%adult state=ames-state-12]
|
||||
== ==
|
||||
$: %13
|
||||
$% $: %larva
|
||||
events=(qeu queued-event)
|
||||
state=ames-state-13
|
||||
==
|
||||
[%adult state=ames-state-13]
|
||||
== ==
|
||||
$: %14
|
||||
$% $: %larva
|
||||
events=(qeu queued-event)
|
||||
state=_ames-state.adult-gate
|
||||
@ -1113,7 +1416,7 @@
|
||||
=. state.old (state-4-to-5:load:adult-core state.old)
|
||||
$(-.old %5)
|
||||
::
|
||||
[%5 %adult *]
|
||||
[%5 %adult *]
|
||||
=. cached-state `[%5 state.old]
|
||||
~> %slog.0^leaf/"ames: larva reload"
|
||||
larval-gate
|
||||
@ -1201,14 +1504,24 @@
|
||||
=. queued-events events.old
|
||||
larval-gate
|
||||
::
|
||||
[%13 %adult *] (load:adult-core %13 state.old)
|
||||
[%13 %adult *]
|
||||
=. cached-state `[%13 state.old]
|
||||
~> %slog.0^leaf/"ames: larva reload"
|
||||
larval-gate
|
||||
::
|
||||
[%13 %larva *]
|
||||
~> %slog.1^leaf/"ames: larva: load"
|
||||
=. cached-state `[%13 state.old]
|
||||
=. queued-events events.old
|
||||
=. adult-gate (load:adult-core %13 state.old)
|
||||
larval-gate
|
||||
::
|
||||
[%14 %adult *] (load:adult-core %14 state.old)
|
||||
::
|
||||
[%14 %larva *]
|
||||
~> %slog.1^leaf/"ames: larva: load"
|
||||
=. queued-events events.old
|
||||
=. adult-gate (load:adult-core %14 state.old)
|
||||
larval-gate
|
||||
==
|
||||
::
|
||||
++ event-11-to-12
|
||||
@ -1250,7 +1563,9 @@
|
||||
12+(state-11-to-12:load:adult-core +.u.cached-state)
|
||||
=? u.cached-state ?=(%12 -.u.cached-state)
|
||||
13+(state-12-to-13:load:adult-core +.u.cached-state)
|
||||
?> ?=(%13 -.u.cached-state)
|
||||
=? u.cached-state ?=(%13 -.u.cached-state)
|
||||
14+(state-13-to-14:load:adult-core +.u.cached-state)
|
||||
?> ?=(%14 -.u.cached-state)
|
||||
=. ames-state.adult-gate +.u.cached-state
|
||||
[moz larval-core(cached-state ~)]
|
||||
--
|
||||
@ -3829,8 +4144,8 @@
|
||||
(trace %fine verb her ships.bug.ames-state print)
|
||||
::
|
||||
++ fi-emit |=(move fine(event-core (emit +<)))
|
||||
++ fi-deq (deq want)
|
||||
++ fi-gauge (ga metrics.keen (wyt:fi-deq wan.keen))
|
||||
++ fi-mop ((on @ud want) lte)
|
||||
++ fi-gauge (ga metrics.keen (wyt:fi-mop wan.keen))
|
||||
++ fi-wait |=(tim=@da (fi-pass-timer %b %wait tim))
|
||||
++ fi-rest |=(tim=@da (fi-pass-timer %b %rest tim))
|
||||
::
|
||||
@ -3854,7 +4169,7 @@
|
||||
=/ fra=@ 1
|
||||
=/ req=hoot (fi-etch-wail fra)
|
||||
=/ =want [fra req last=now tries=1 skips=0]
|
||||
=. wan.keen (cons:fi-deq *(pha ^want) want)
|
||||
=. wan.keen (put:fi-mop ~ [fra .]:want)
|
||||
(fi-send `@ux`req)
|
||||
::
|
||||
++ fi-rcv
|
||||
@ -3924,12 +4239,12 @@
|
||||
=| marked=(list want)
|
||||
|= fra=@ud
|
||||
^- [? _fine]
|
||||
=; [[found=? cor=_fine] wan=(pha want)]
|
||||
=; [[found=? cor=_fine] wan=_wan.keen]
|
||||
:- found
|
||||
?.(found fine cor(wan.keen wan))
|
||||
%^ (dip-left:fi-deq ,[found=? cor=_fine]) wan.keen
|
||||
%^ (dip:fi-mop ,[found=? cor=_fine]) wan.keen
|
||||
[| fine]
|
||||
|= [[found=? cor=_fine] =want]
|
||||
|= [[found=? cor=_fine] @ud =want]
|
||||
^- [(unit _want) stop=? [found=? cor=_fine]]
|
||||
=. fine cor
|
||||
?: =(fra fra.want)
|
||||
@ -3980,7 +4295,7 @@
|
||||
=^ =want nex.keen nex.keen
|
||||
=. last-sent.want now
|
||||
=. tries.want +(tries.want)
|
||||
=. wan.keen (snoc:fi-deq wan.keen want)
|
||||
=. wan.keen (put:fi-mop wan.keen [fra .]:want)
|
||||
=. fine (fi-send `@ux`hoot.want)
|
||||
$(inx +(inx))
|
||||
::
|
||||
@ -3996,11 +4311,11 @@
|
||||
::
|
||||
++ fi-fast-retransmit
|
||||
|= fra=@ud
|
||||
=; [cor=_fine wants=(pha want)]
|
||||
=; [cor=_fine wants=_wan.keen]
|
||||
cor(wan.keen wants)
|
||||
%^ (dip-left:fi-deq ,cor=_fine) wan.keen
|
||||
%^ (dip:fi-mop ,cor=_fine) wan.keen
|
||||
fine
|
||||
|= [cor=_fine =want]
|
||||
|= [cor=_fine @ud =want]
|
||||
^- [(unit ^want) stop=? cor=_fine]
|
||||
?. (lte fra.want fra)
|
||||
[`want & cor]
|
||||
@ -4018,9 +4333,9 @@
|
||||
++ fi-set-wake
|
||||
^+ fine
|
||||
=/ next-wake=(unit @da)
|
||||
?~ want=(peek-left:fi-deq wan.keen)
|
||||
?~ want=(pry:fi-mop wan.keen)
|
||||
~
|
||||
`(next-expiry:fi-gauge +>:u.want)
|
||||
`(next-expiry:fi-gauge +>:val.u.want)
|
||||
?: =(next-wake next-wake.keen)
|
||||
fine
|
||||
=? fine !=(~ next-wake.keen)
|
||||
@ -4042,13 +4357,14 @@
|
||||
=. peer-state (update-peer-route her peer-state)
|
||||
=. metrics.keen on-timeout:fi-gauge
|
||||
=^ want=(unit want) wan.keen
|
||||
(pop-left:fi-deq wan.keen)
|
||||
?~ res=(pry:fi-mop wan.keen) `wan.keen
|
||||
(del:fi-mop wan.keen key.u.res)
|
||||
~| %took-wake-for-empty-want
|
||||
?> ?=(^ want)
|
||||
=: tries.u.want +(tries.u.want)
|
||||
last-sent.u.want now
|
||||
==
|
||||
=. wan.keen (cons:fi-deq wan.keen u.want)
|
||||
=. wan.keen (put:fi-mop wan.keen [fra .]:u.want)
|
||||
(fi-send `@ux`hoot.u.want)
|
||||
--
|
||||
:: +ga: constructor for |pump-gauge congestion control core
|
||||
@ -4267,15 +4583,15 @@
|
||||
[moves ames-gate]
|
||||
:: +stay: extract state before reload
|
||||
::
|
||||
++ stay [%13 %adult ames-state]
|
||||
++ stay [%14 %adult ames-state]
|
||||
:: +load: load in old state after reload
|
||||
::
|
||||
++ load
|
||||
=< |= $= old-state
|
||||
$% [%13 ^ames-state]
|
||||
$% [%14 ^ames-state]
|
||||
==
|
||||
^+ ames-gate
|
||||
?> ?=(%13 -.old-state)
|
||||
?> ?=(%14 -.old-state)
|
||||
ames-gate(ames-state +.old-state)
|
||||
:: all state transitions are called from larval ames
|
||||
::
|
||||
@ -4394,7 +4710,7 @@
|
||||
::
|
||||
++ state-12-to-13
|
||||
|= old=ames-state-12
|
||||
^- ^ames-state
|
||||
^- ames-state-13
|
||||
=+ !< =rift
|
||||
q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])))
|
||||
=+ pk=sec:ex:crypto-core.old
|
||||
@ -4412,10 +4728,27 @@
|
||||
::
|
||||
++ ship-state-12-to-13
|
||||
|= old=ship-state-12
|
||||
^- ship-state
|
||||
^- ship-state-13
|
||||
?: ?=(%alien -.old)
|
||||
old(heeds [heeds.old ~])
|
||||
old(corked [corked.old ~])
|
||||
::
|
||||
++ state-13-to-14
|
||||
|= old=ames-state-13
|
||||
^- ^ames-state
|
||||
=- old(peers -)
|
||||
%- ~(run by peers.old)
|
||||
|= old=ship-state-13
|
||||
?: ?=(%alien -.old) old
|
||||
old(keens (~(run by keens.old) keen-state-13-to-14))
|
||||
::
|
||||
++ keen-state-13-to-14
|
||||
|= old=keen-state-13
|
||||
^- keen-state
|
||||
=- old(wan -)
|
||||
%+ gas:((on @ud want) lte) ~
|
||||
%+ turn (tap:(deq:keen-state-13 want) wan.old)
|
||||
|= =want [fra .]:want
|
||||
--
|
||||
:: +scry: dereference namespace
|
||||
::
|
||||
|
@ -925,7 +925,9 @@
|
||||
~/ %parse-pile
|
||||
|= [pax=path tex=tape]
|
||||
^- pile
|
||||
=/ [=hair res=(unit [=pile =nail])] ((pile-rule pax) [1 1] tex)
|
||||
=/ [=hair res=(unit [=pile =nail])]
|
||||
%- road |.
|
||||
((pile-rule pax) [1 1] tex)
|
||||
?^ res pile.u.res
|
||||
%- mean %- flop
|
||||
=/ lyn p.hair
|
||||
@ -4243,7 +4245,7 @@
|
||||
:: +read-s: produce miscellaneous
|
||||
::
|
||||
++ read-s
|
||||
|= [tak=tako pax=path]
|
||||
|= [tak=tako pax=path =case]
|
||||
^- (unit (unit cage))
|
||||
?: ?=([%subs ~] pax)
|
||||
?. =([%da now] case) ~
|
||||
@ -4514,7 +4516,7 @@
|
||||
%f (read-f tak path.mun)
|
||||
%p [(read-p path.mun) ..park]
|
||||
%r (read-r tak path.mun)
|
||||
%s [(read-s tak path.mun) ..park]
|
||||
%s [(read-s tak path.mun case.mun) ..park]
|
||||
%t [(read-t tak path.mun) ..park]
|
||||
%u [(read-u tak path.mun) ..park]
|
||||
%v [(read-v tak path.mun) ..park]
|
||||
@ -4558,7 +4560,8 @@
|
||||
|* [her=ship syd=desk yon=(unit aeon) res=* =state:ford:fusion]
|
||||
=^ moves ruf
|
||||
=/ den ((de now rof hen ruf) her syd)
|
||||
abet:+:(tako-flow:den ?~(yon let.dom:den u.yon) res cache.state &2.state)
|
||||
=/ tak (aeon-to-tako:ze:den ?~(yon let.dom:den u.yon))
|
||||
abet:+:(tako-flow:den tak res cache.state &2.state)
|
||||
[res (emil moves)]
|
||||
::
|
||||
++ trace
|
||||
|
@ -656,7 +656,8 @@
|
||||
=/ connection=outstanding-connection
|
||||
[action [authenticated secure address request] ~ 0]
|
||||
=. connections.state
|
||||
:: XX pretty sure this is superfluous - done in +handle-response
|
||||
:: NB: required by +handle-response. XX optimize
|
||||
::
|
||||
(~(put by connections.state) duct connection)
|
||||
:: redirect to https if insecure, redirects enabled
|
||||
:: and secure port live
|
||||
@ -1986,7 +1987,10 @@
|
||||
|= =tang
|
||||
^- [(list move) server-state]
|
||||
::
|
||||
=+ connection=(~(got by connections.state) duct)
|
||||
?~ connection-state=(~(get by connections.state) duct)
|
||||
%. `state
|
||||
(trace 0 |.("{<duct>} error on invalid outstanding connection"))
|
||||
=* connection u.connection-state
|
||||
=/ moves-1=(list move)
|
||||
?. ?=(%app -.action.connection)
|
||||
~
|
||||
@ -2055,8 +2059,8 @@
|
||||
(session-cookie-string u.session-id &)
|
||||
headers.response-header.http-event
|
||||
::
|
||||
=/ connection=outstanding-connection
|
||||
(~(got by connections.state) duct)
|
||||
=* connection u.connection-state
|
||||
::
|
||||
:: if the request was a simple cors request from an approved origin
|
||||
:: append the necessary cors headers to the response
|
||||
::
|
||||
@ -2073,16 +2077,18 @@
|
||||
::
|
||||
=. response-header.http-event response-header
|
||||
=. connections.state
|
||||
?: complete.http-event
|
||||
:: XX optimize by not requiring +put:by in +request
|
||||
::
|
||||
(~(del by connections.state) duct)
|
||||
::
|
||||
%- (trace 2 |.("{<duct>} start"))
|
||||
%+ ~(put by connections.state) duct
|
||||
%_ connection
|
||||
%= connection
|
||||
response-header `response-header
|
||||
bytes-sent ?~(data.http-event 0 p.u.data.http-event)
|
||||
==
|
||||
::
|
||||
=? state complete.http-event
|
||||
log-complete-request
|
||||
::
|
||||
pass-response
|
||||
::
|
||||
%continue
|
||||
@ -2091,14 +2097,18 @@
|
||||
(trace 0 |.("{<duct>} error continue without start"))
|
||||
::
|
||||
=. connections.state
|
||||
%- (trace 2 |.("{<duct>} continuing "))
|
||||
%+ ~(jab by connections.state) duct
|
||||
|= connection=outstanding-connection
|
||||
=+ size=?~(data.http-event 0 p.u.data.http-event)
|
||||
connection(bytes-sent (add bytes-sent.connection size))
|
||||
::
|
||||
=? state complete.http-event
|
||||
log-complete-request
|
||||
?: complete.http-event
|
||||
%- (trace 2 |.("{<duct>} completed"))
|
||||
(~(del by connections.state) duct)
|
||||
::
|
||||
%- (trace 2 |.("{<duct>} continuing"))
|
||||
?~ data.http-event
|
||||
connections.state
|
||||
::
|
||||
%+ ~(put by connections.state) duct
|
||||
=* size p.u.data.http-event
|
||||
=* conn u.connection-state
|
||||
conn(bytes-sent (add size bytes-sent.conn))
|
||||
::
|
||||
pass-response
|
||||
::
|
||||
@ -2112,16 +2122,6 @@
|
||||
^- [(list move) server-state]
|
||||
[[duct %give %response http-event]~ state]
|
||||
::
|
||||
++ log-complete-request
|
||||
:: todo: log the complete request
|
||||
::
|
||||
:: remove all outstanding state for this connection
|
||||
::
|
||||
=. connections.state
|
||||
%. (~(del by connections.state) duct)
|
||||
(trace 2 |.("{<duct>} completed"))
|
||||
state
|
||||
::
|
||||
++ error-connection
|
||||
:: todo: log application error
|
||||
::
|
||||
|
@ -42,9 +42,9 @@
|
||||
:: $move: Arvo-level move
|
||||
::
|
||||
+$ move [=duct move=(wind note-arvo gift-arvo)]
|
||||
:: $state-12: overall gall state, versioned
|
||||
:: $state-13: overall gall state, versioned
|
||||
::
|
||||
+$ state-12 [%12 state]
|
||||
+$ state-13 [%13 state]
|
||||
:: $state: overall gall state
|
||||
::
|
||||
:: system-duct: TODO document
|
||||
@ -82,6 +82,7 @@
|
||||
:: beak: compilation source
|
||||
:: marks: mark conversion requests
|
||||
:: sky: scry bindings
|
||||
:: ken: open keen requests
|
||||
::
|
||||
+$ yoke
|
||||
$% [%nuke sky=(map spur @ud)]
|
||||
@ -98,6 +99,7 @@
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur path-state)
|
||||
ken=(jug spar:ames wire)
|
||||
== ==
|
||||
::
|
||||
+$ path-state
|
||||
@ -160,7 +162,7 @@
|
||||
:: $spore: structures for update, produced by +stay
|
||||
::
|
||||
+$ spore
|
||||
$: %12
|
||||
$: %13
|
||||
system-duct=duct
|
||||
outstanding=(map [wire duct] (qeu remote-request))
|
||||
contacts=(set ship)
|
||||
@ -185,11 +187,12 @@
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur path-state)
|
||||
ken=(jug spar:ames wire)
|
||||
== ==
|
||||
--
|
||||
:: adult gall vane interface, for type compatibility with pupa
|
||||
::
|
||||
=| state=state-12
|
||||
=| state=state-13
|
||||
|= [now=@da eny=@uvJ rof=roof]
|
||||
=* gall-payload .
|
||||
~% %gall-top ..part ~
|
||||
@ -955,9 +958,20 @@
|
||||
moves moves
|
||||
==
|
||||
::
|
||||
++ ap-yawn-all
|
||||
^- (list card:agent)
|
||||
%- zing
|
||||
%+ turn ~(tap by ken.yoke)
|
||||
|= [=spar:ames wyz=(set wire)]
|
||||
%+ turn ~(tap in wyz)
|
||||
|= =wire
|
||||
[%pass wire %arvo %a %yawn spar]
|
||||
::
|
||||
++ ap-idle
|
||||
^+ ap-core
|
||||
?: ?=(%| -.agent.yoke) ap-core
|
||||
ap-core(agent.yoke |+on-save:ap-agent-core)
|
||||
=> [ken=ken.yoke (ap-ingest ~ |.([ap-yawn-all *agent]))]
|
||||
ap-core(ken.yoke ken, agent.yoke |+on-save:ap-agent-core)
|
||||
::
|
||||
++ ap-nuke
|
||||
^+ ap-core
|
||||
@ -967,13 +981,17 @@
|
||||
|= [=duct =ship =path]
|
||||
path
|
||||
=/ will=(list card:agent)
|
||||
%+ welp
|
||||
;: welp
|
||||
?: =(~ inbound-paths)
|
||||
~
|
||||
[%give %kick ~(tap in inbound-paths) ~]~
|
||||
%+ turn ~(tap by boat.yoke)
|
||||
|= [[=wire =dock] ? =path]
|
||||
[%pass wire %agent dock %leave ~]
|
||||
::
|
||||
%+ turn ~(tap by boat.yoke)
|
||||
|= [[=wire =dock] ? =path]
|
||||
[%pass wire %agent dock %leave ~]
|
||||
::
|
||||
ap-yawn-all
|
||||
==
|
||||
=^ maybe-tang ap-core (ap-ingest ~ |.([will *agent]))
|
||||
ap-core
|
||||
:: +ap-grow: bind a path in the agent's scry namespace
|
||||
@ -1310,6 +1328,12 @@
|
||||
?: ?=(%& -.agent.yoke)
|
||||
on-save:ap-agent-core
|
||||
p.agent.yoke
|
||||
=? ap-core &(?=(%| -.agent.yoke) ?=(^ ken.yoke))
|
||||
=- +:(ap-ingest ~ |.([+< agent]))
|
||||
%- zing
|
||||
%+ turn ~(tap by `(jug spar:ames wire)`ken.yoke)
|
||||
|= [=spar:ames wyz=(set wire)]
|
||||
(turn ~(tap in wyz) |=(=wire [%pass wire %arvo %a %keen spar]))
|
||||
=^ error ap-core
|
||||
(ap-install(agent.yoke &+agent) `old-state)
|
||||
?~ error
|
||||
@ -1365,6 +1389,8 @@
|
||||
=^ maybe-tang ap-core
|
||||
%+ ap-ingest ~ |.
|
||||
(on-arvo:ap-agent-core wire sign-arvo)
|
||||
=? ken.yoke ?=([%ames %tune spar=* *] sign-arvo)
|
||||
(~(del ju ken.yoke) spar.sign-arvo wire)
|
||||
?^ maybe-tang
|
||||
(ap-error %arvo-response u.maybe-tang)
|
||||
ap-core
|
||||
@ -1714,6 +1740,7 @@
|
||||
::
|
||||
=. agent.yoke &++.p.result
|
||||
=^ fex ap-core (ap-handle-sky -.p.result)
|
||||
=. ken.yoke (ap-handle-ken fex)
|
||||
=/ moves (zing (turn fex ap-from-internal))
|
||||
=. bitt.yoke (ap-handle-kicks moves)
|
||||
(ap-handle-peers moves)
|
||||
@ -1732,6 +1759,17 @@
|
||||
[%give *] $(caz t.caz, fex [i.caz fex])
|
||||
[%slip *] !!
|
||||
==
|
||||
:: +ap-handle-ken
|
||||
::
|
||||
++ ap-handle-ken
|
||||
|= fex=(list carp)
|
||||
^+ ken.yoke
|
||||
%+ roll fex
|
||||
|= [=carp ken=_ken.yoke]
|
||||
?+ carp ken
|
||||
[%pass * %arvo %a %keen spar=*] (~(put ju ken) [spar.q p]:carp)
|
||||
[%pass * %arvo %a %yawn spar=*] (~(del ju ken) [spar.q p]:carp)
|
||||
==
|
||||
:: +ap-handle-kicks: handle cancels of bitt.watches
|
||||
::
|
||||
++ ap-handle-kicks
|
||||
@ -1875,10 +1913,36 @@
|
||||
=? old ?=(%9 -.old) (spore-9-to-10 old)
|
||||
=? old ?=(%10 -.old) (spore-10-to-11 old)
|
||||
=? old ?=(%11 -.old) (spore-11-to-12 old)
|
||||
?> ?=(%12 -.old)
|
||||
=? old ?=(%12 -.old) (spore-12-to-13 old)
|
||||
?> ?=(%13 -.old)
|
||||
gall-payload(state old)
|
||||
::
|
||||
+$ spore-any $%(spore spore-7 spore-8 spore-9 spore-10 spore-11)
|
||||
+$ spore-any $%(spore spore-7 spore-8 spore-9 spore-10 spore-11 spore-12)
|
||||
+$ spore-12
|
||||
$: %12
|
||||
system-duct=duct
|
||||
outstanding=(map [wire duct] (qeu remote-request))
|
||||
contacts=(set ship)
|
||||
eggs=(map term egg-12)
|
||||
blocked=(map term (qeu blocked-move))
|
||||
=bug
|
||||
==
|
||||
+$ egg-12
|
||||
$% [%nuke sky=(map spur @ud)]
|
||||
$: %live
|
||||
control-duct=duct
|
||||
run-nonce=@t
|
||||
sub-nonce=@
|
||||
=stats
|
||||
=bitt
|
||||
=boat
|
||||
=boar
|
||||
code=~
|
||||
old-state=[%| vase]
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur path-state)
|
||||
== ==
|
||||
+$ spore-11
|
||||
$: %11
|
||||
system-duct=duct
|
||||
@ -2010,20 +2074,6 @@
|
||||
%+ murn ~(tap to q)
|
||||
|=(r=remote-request-9 ?:(?=(%cork r) ~ `r))
|
||||
::
|
||||
:: added sky
|
||||
::
|
||||
++ spore-11-to-12
|
||||
|= old=spore-11
|
||||
^- spore
|
||||
%= old
|
||||
- %12
|
||||
eggs
|
||||
%- ~(urn by eggs.old)
|
||||
|= [a=term e=egg-11]
|
||||
^- egg
|
||||
live/e(marks [marks.e sky:*$>(%live egg)])
|
||||
==
|
||||
::
|
||||
:: removed live
|
||||
:: changed old-state from (each vase vase) to [%| vase]
|
||||
:: added code
|
||||
@ -2039,6 +2089,35 @@
|
||||
^- egg-11
|
||||
e(|3 |4.e(|4 `|8.e(old-state [%| p.old-state.e])))
|
||||
==
|
||||
::
|
||||
:: added sky
|
||||
::
|
||||
++ spore-11-to-12
|
||||
|= old=spore-11
|
||||
^- spore-12
|
||||
%= old
|
||||
- %12
|
||||
eggs
|
||||
%- ~(urn by eggs.old)
|
||||
|= [a=term e=egg-11]
|
||||
^- egg-12
|
||||
live/e(marks [marks.e sky:*$>(%live egg)])
|
||||
==
|
||||
::
|
||||
:: added ken
|
||||
::
|
||||
++ spore-12-to-13
|
||||
|= old=spore-12
|
||||
^- spore
|
||||
%= old
|
||||
- %13
|
||||
eggs
|
||||
%- ~(urn by eggs.old)
|
||||
|= [a=term e=egg-12]
|
||||
^- egg
|
||||
?: ?=(%nuke -.e) e
|
||||
e(sky [sky.e ken:*$>(%live egg)])
|
||||
==
|
||||
--
|
||||
:: +scry: standard scry
|
||||
::
|
||||
|
@ -336,7 +336,7 @@
|
||||
=. pos.zim.pki
|
||||
%+ ~(put by pos.zim.pki)
|
||||
our
|
||||
[rift=1 life=1 (my [`@ud`1 [`life`1 pub:ex:cub]] ~) `(^sein:title our)]
|
||||
[rift=0 life=1 (my [`@ud`1 [`life`1 pub:ex:cub]] ~) `(^sein:title our)]
|
||||
:: our private key
|
||||
::
|
||||
:: Private key updates are disallowed for fake ships,
|
||||
@ -825,7 +825,7 @@
|
||||
%+ turn passes
|
||||
|= [who=ship =pass]
|
||||
^- [who=ship =point]
|
||||
[who [rift=1 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
|
||||
[who [rift=0 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
|
||||
=. moz [[hen %give %public-keys %full (my points)] moz]
|
||||
..feel
|
||||
--
|
||||
@ -1140,10 +1140,10 @@
|
||||
[~ ~]
|
||||
=/ who (slaw %p i.tyl)
|
||||
?~ who [~ ~]
|
||||
:: fake ships always have rift=1
|
||||
:: fake ships always have rift=0
|
||||
::
|
||||
?: fak.own.pki.lex
|
||||
``[%atom !>(1)]
|
||||
``[%atom !>(0)]
|
||||
=/ pos (~(get by pos.zim.pki.lex) u.who)
|
||||
?~ pos ~
|
||||
``[%atom !>(rift.u.pos)]
|
||||
@ -1154,10 +1154,10 @@
|
||||
[~ ~]
|
||||
=/ who (slaw %p i.tyl)
|
||||
?~ who [~ ~]
|
||||
:: fake ships always have rift=1
|
||||
:: fake ships always have rift=0
|
||||
::
|
||||
?: fak.own.pki.lex
|
||||
``[%noun !>((some 1))]
|
||||
``[%noun !>((some 0))]
|
||||
=/ pos (~(get by pos.zim.pki.lex) u.who)
|
||||
?~ pos ``[%noun !>(~)]
|
||||
``[%noun !>((some rift.u.pos))]
|
||||
|
@ -5593,288 +5593,6 @@
|
||||
$(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
|
||||
:: ::::
|
||||
|
@ -6,19 +6,20 @@
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
=+ !<([~ =spar:ames] arg)
|
||||
;< dat=(unit roar:ames) bind:m
|
||||
(keen:strandio spar)
|
||||
?~ dat
|
||||
;< ~ bind:m
|
||||
(keen:strandio /keen spar)
|
||||
;< [* roar=(unit roar:ames)] bind:m
|
||||
(take-tune:strandio /keen)
|
||||
?~ roar
|
||||
(pure:m !>(~))
|
||||
?~ data=q.dat.u.roar
|
||||
(pure:m !>(~))
|
||||
::
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
=/ [=path data=(unit (cask))] dat.u.dat
|
||||
?~ data
|
||||
(pure:m !>(~))
|
||||
=+ .^ =dais:clay %cb
|
||||
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.data]
|
||||
==
|
||||
=/ res (mule |.((vale.dais q.u.data)))
|
||||
?: ?=(%| -.res)
|
||||
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))
|
||||
(pure:m p.res)
|
||||
|
||||
?. ?=(%| -.res)
|
||||
(pure:m p.res)
|
||||
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))
|
||||
|
@ -114,7 +114,7 @@
|
||||
:_ `octs
|
||||
[200 [['content-type' 'image/svg+xml'] ?:(cache [max-1-wk ~] ~)]]
|
||||
::
|
||||
++ ico-response
|
||||
++ ico-response
|
||||
|= =octs
|
||||
^- simple-payload:http
|
||||
[[200 [['content-type' 'image/x-icon'] max-1-wk ~]] `octs]
|
||||
|
@ -82,8 +82,6 @@
|
||||
`[%done q.cage.u.in.tin]
|
||||
==
|
||||
::
|
||||
::
|
||||
::
|
||||
++ take-sign-arvo
|
||||
=/ m (strand ,[wire sign-arvo])
|
||||
^- form:m
|
||||
@ -184,21 +182,20 @@
|
||||
`[%done ~]
|
||||
`[%fail %timer-error u.error.sign-arvo.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ take-tune
|
||||
|= =wire
|
||||
=/ m (strand ,~)
|
||||
=/ m (strand ,[spar:ames (unit roar:ames)])
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
[~ %agent * %poke-ack *]
|
||||
::
|
||||
[~ %sign * %ames %tune ^ *]
|
||||
?. =(wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
?~ p.sign.u.in.tin
|
||||
`[%done ~]
|
||||
`[%fail %poke-fail u.p.sign.u.in.tin]
|
||||
`[%done +>.sign-arvo.u.in.tin]
|
||||
==
|
||||
|
||||
::
|
||||
++ take-poke-ack
|
||||
|= =wire
|
||||
@ -335,14 +332,10 @@
|
||||
(take-wake `until)
|
||||
::
|
||||
++ keen
|
||||
|= =spar:ames
|
||||
=/ m (strand ,(unit roar:ames))
|
||||
|= [=wire =spar:ames]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
=/ =card:agent:gall [%pass /keen %arvo %a %keen spar]
|
||||
;< ~ bind:m (send-raw-card card)
|
||||
;< [wire sign=sign-arvo] bind:m take-sign-arvo
|
||||
?> ?=([%ames %tune *] sign)
|
||||
(pure:m roar.sign)
|
||||
(send-raw-card %pass wire %arvo %a %keen spar)
|
||||
::
|
||||
++ sleep
|
||||
|= for=@dr
|
||||
|
@ -17,7 +17,7 @@
|
||||
--
|
||||
++ grab
|
||||
|% :: convert from
|
||||
++ mime |=([p=mite q=octs] (fall (rush (@t q.q) apex:de:json) *^json))
|
||||
++ mime |=([p=mite q=octs] (fall (de:json (@t q.q)) *^json))
|
||||
++ noun ^json :: clam from %noun
|
||||
++ numb numb:enjs
|
||||
++ time time:enjs
|
||||
|
@ -1,3 +1,4 @@
|
||||
/% kelvin %kelvin
|
||||
=, clay
|
||||
=* dude dude:gall
|
||||
|%
|
||||
@ -16,6 +17,12 @@
|
||||
::
|
||||
+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
|
||||
+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
|
||||
:: +truncate-hash: get last 5 digits of hash and convert to tape
|
||||
::
|
||||
++ truncate-hash
|
||||
|= hash=@uv
|
||||
^- tape
|
||||
(slag 2 <`@uv`(mod hash 0v1.00000)>)
|
||||
:: +report-prep: get data required for reports
|
||||
::
|
||||
++ report-prep
|
||||
@ -33,55 +40,63 @@
|
||||
::
|
||||
++ report-vats
|
||||
|= [our=@p now=@da desks=(list desk) filt=@tas verb=?]
|
||||
^- tang
|
||||
=/ ego (scot %p our)
|
||||
=/ wen (scot %da now)
|
||||
=/ prep (report-prep our now)
|
||||
=/ prep (report-prep our now)
|
||||
?~ filt
|
||||
%- zing
|
||||
%+ turn (flop desks)
|
||||
|=(syd=@tas (report-vat prep our now syd verb))
|
||||
=/ deks
|
||||
?~ desks ~(tap in -.prep)
|
||||
%+ skip ~(tap in -.prep)
|
||||
=/ deks
|
||||
?~ desks
|
||||
%+ sort
|
||||
(sort ~(tap in -.prep) |=([[a=@ *] b=@ *] !(aor a b)))
|
||||
|=([[a=@ *] [b=@ *]] ?|(=(a %kids) =(b %base)))
|
||||
%+ skip ~(tap in -.prep)
|
||||
|=([syd=@tas *] =(~ (find ~[syd] desks)))
|
||||
?: =(filt %blocking)
|
||||
?: =(filt %blocking)
|
||||
=/ base-wic
|
||||
%+ sort ~(tap by wic:(~(got by -.prep) %base))
|
||||
|=([[* a=@ud] [* b=@ud]] (gth a b))
|
||||
?~ base-wic ~[leaf+"%base already up-to-date"]
|
||||
|=([[* a=@ud] [* b=@ud]] (gth a b))
|
||||
?~ base-wic ~[leaf+"%base already up-to-date"]
|
||||
=/ blockers=(list desk)
|
||||
%+ turn
|
||||
%+ skip ~(tap in -.prep)
|
||||
|= [* [zest=@tas wic=(set weft)]]
|
||||
?. =(zest %live) &
|
||||
(~(has in wic) i.base-wic)
|
||||
|=([syd=desk *] syd)
|
||||
|= [* [zest=@tas wic=(set weft)]]
|
||||
?. =(zest %live) &
|
||||
(~(has in wic) i.base-wic)
|
||||
|=([syd=desk *] syd)
|
||||
?~ blockers ~[leaf+"No desks blocking upgrade, run |bump to apply"]
|
||||
:- [%rose [" %" "To unblock upgrade run |suspend %" ""] blockers]
|
||||
%- zing
|
||||
%+ turn (flop blockers)
|
||||
|=(syd=desk (report-vat prep our now syd verb))
|
||||
|=(syd=desk (report-vat prep our now syd verb))
|
||||
::
|
||||
%- zing
|
||||
%+ turn
|
||||
?+ filt !!
|
||||
::
|
||||
%exists
|
||||
%+ skip deks
|
||||
|=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
|
||||
::
|
||||
%running
|
||||
%+ skim deks
|
||||
?+ filt !!
|
||||
::
|
||||
%exists
|
||||
%+ skip deks
|
||||
|=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
|
||||
::
|
||||
%running
|
||||
%+ skim deks
|
||||
|=([* [zest=@tas *]] =(zest %live))
|
||||
::
|
||||
%suspended
|
||||
%+ skip deks
|
||||
|= [syd=@tas [zest=@tas *]]
|
||||
?| =(syd %kids)
|
||||
::
|
||||
%suspended
|
||||
%+ skip deks
|
||||
|= [syd=@tas [zest=@tas *]]
|
||||
?| =(syd %kids)
|
||||
=(zest %live)
|
||||
=(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0)
|
||||
==
|
||||
::
|
||||
%exists-not
|
||||
==
|
||||
::
|
||||
%exists-not
|
||||
%+ skim deks
|
||||
|=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
|
||||
==
|
||||
==
|
||||
|=([syd=desk *] (report-vat prep our now syd verb))
|
||||
:: +report-vat: report on a single desk installation
|
||||
::
|
||||
@ -91,6 +106,15 @@
|
||||
==
|
||||
our=ship now=@da syd=desk verb=?
|
||||
==
|
||||
^- tang
|
||||
=- :: hack to force wrapped rendering
|
||||
::
|
||||
:: edg=6 empirically prevents dedent
|
||||
::
|
||||
%+ roll
|
||||
(~(win re -) [0 6])
|
||||
|=([a=tape b=(list @t)] [(crip a) b])
|
||||
::
|
||||
^- tank
|
||||
=/ ego (scot %p our)
|
||||
=/ wen (scot %da now)
|
||||
@ -118,9 +142,6 @@
|
||||
?~ sink [hash]~
|
||||
(mergebase-hashes our syd now her.u.sink sud.u.sink)
|
||||
=/ dek (~(got by tyr) syd)
|
||||
=/ =dome (~(got by cone) our syd)
|
||||
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
|
||||
(skid ~(tap by ren.dome) |=([* ?] +<+))
|
||||
=/ sat
|
||||
?- zest.dek
|
||||
%live "running"
|
||||
@ -138,20 +159,29 @@
|
||||
|= [=weft =tape]
|
||||
(welp " {<[lal num]:weft>}" tape)
|
||||
?. verb
|
||||
=/ base-hash ?.(=(1 (lent meb)) <meb> <(head meb)>)
|
||||
=/ cut=(list tape) (turn meb truncate-hash)
|
||||
=/ len (lent cut)
|
||||
=/ base-hash
|
||||
?: =(0 len) "~"
|
||||
?: =(1 len) (head cut)
|
||||
"~[{`tape`(zing (join " " `(list tape)`cut))}]"
|
||||
:~ leaf/"/sys/kelvin: {kul}"
|
||||
leaf/"base hash ends in: {(slag (sub (lent base-hash) 5) base-hash)}"
|
||||
leaf/"%cz hash ends in: {(slag (sub (lent <hash>) 5) <hash>)}"
|
||||
leaf/"base hash ends in: {base-hash}"
|
||||
leaf/"%cz hash ends in: {(truncate-hash hash)}"
|
||||
leaf/"app status: {sat}"
|
||||
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
|
||||
==
|
||||
==
|
||||
::
|
||||
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
|
||||
=/ =dome (~(got by cone) our syd)
|
||||
(skid ~(tap by ren.dome) |=([* ?] +<+))
|
||||
:~ leaf/"/sys/kelvin: {kul}"
|
||||
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
|
||||
leaf/"%cz hash: {<hash>}"
|
||||
::
|
||||
leaf/"app status: {sat}"
|
||||
leaf/"force on: {?:(=(~ on) "~" <on>)}"
|
||||
leaf/"force off: {?:(=(~ of) "~" <of>)}"
|
||||
leaf/"force on: {<(sort (turn on head) aor)>}"
|
||||
leaf/"force off: {<(sort (turn of head) aor)>}"
|
||||
::
|
||||
leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}"
|
||||
leaf/"updates: {?~(sink "local" "remote")}"
|
||||
|
@ -41,7 +41,7 @@
|
||||
:_ this
|
||||
:_ ~
|
||||
=/ dms=(list resource)
|
||||
?. .^(? %gu (scry:io %graph-store ~))
|
||||
?. .^(? %gu (scry:io %graph-store /$))
|
||||
~
|
||||
%+ skim ~(tap in get-keys:gra)
|
||||
|=([ship name=term] ?=(^ (rush name ;~(pfix (jest 'dm--') fed:ag))))
|
||||
|
@ -1,3 +1 @@
|
||||
[%zuse 416]
|
||||
[%zuse 415]
|
||||
[%zuse 414]
|
||||
[%zuse 413]
|
@ -1,98 +0,0 @@
|
||||
/+ *test
|
||||
=/ big-num
|
||||
100
|
||||
=/ de (deq ,@)
|
||||
=/ big-list
|
||||
(gulf 1 big-num)
|
||||
=/ big
|
||||
(apl:de *(pha @) big-list)
|
||||
=/ foo-list (gulf 1 8)
|
||||
|%
|
||||
++ foo
|
||||
(apl:de *(pha @) 1 2 3 4 5 6 7 8 ~)
|
||||
++ bar
|
||||
`(pha @)`(apl:de *(pha @) 8 9 10 11 12 13 14 15 ~)
|
||||
::
|
||||
++ test-tap
|
||||
=/ ls
|
||||
~> %bout.[1 %tap]
|
||||
(tap:de big)
|
||||
(expect-eq !>(ls) !>(big-list))
|
||||
::
|
||||
++ test-wyt
|
||||
=/ le
|
||||
~> %bout.[1 %wyt]
|
||||
(wyt:de big)
|
||||
(expect-eq !>(le) !>(big-num))
|
||||
::
|
||||
++ test-left
|
||||
^- tang
|
||||
=/ bar
|
||||
~> %bout.[1 %cons]
|
||||
(cons:de bar 7)
|
||||
=. bar
|
||||
~> %bout.[1 %apl]
|
||||
(apl:de bar 1 2 3 4 5 6 ~)
|
||||
%- zing
|
||||
:-
|
||||
~> %bout.[1 %eq-1]
|
||||
(expect-eq !>((tap:de bar)) !>((gulf 1 15)))
|
||||
=^ val=(unit @) bar
|
||||
~> %bout.[1 %pop-left]
|
||||
(pop-left:de bar)
|
||||
~> %bout.[1 %eq-2]
|
||||
:~ (expect-eq !>(1) !>((need val)))
|
||||
(expect-eq !>((gulf 2 15)) !>((tap:de bar)))
|
||||
==
|
||||
::
|
||||
++ test-cons-tree
|
||||
=/ foo
|
||||
(cons:de foo 1)
|
||||
~
|
||||
::
|
||||
++ test-cons-list
|
||||
=/ big-list
|
||||
[1 big-list]
|
||||
~
|
||||
::
|
||||
++ test-rear-tree
|
||||
=/ big big
|
||||
=/ res (peek-right:de big)
|
||||
~
|
||||
::
|
||||
++ test-rear-list
|
||||
=/ last (rear big-list)
|
||||
~
|
||||
::
|
||||
++ test-right
|
||||
^- tang
|
||||
=/ foo
|
||||
~> %bout.[1 %snoc]
|
||||
(snoc:de foo 9)
|
||||
=. foo
|
||||
(apr:de foo 10 11 12 13 14 15 ~)
|
||||
%- zing
|
||||
:- (expect-eq !>((tap:de foo)) !>((gulf 1 15)))
|
||||
=^ val=(unit @) foo
|
||||
(pop-right:de foo)
|
||||
:~ (expect-eq !>((need val)) !>(15))
|
||||
(expect-eq !>((gulf 1 14)) !>((tap:de foo)))
|
||||
==
|
||||
++ test-queue
|
||||
^- tang
|
||||
=/ foo foo
|
||||
=. foo
|
||||
(apr:de foo 9 10 11 12 13 14 15 ~)
|
||||
=/ expected (gulf 1 15)
|
||||
%- zing
|
||||
|- ^- (list tang)
|
||||
=^ val=(unit @) foo
|
||||
(pop-left:de foo)
|
||||
?~ val
|
||||
(expect-eq !>(~) !>(expected))^~
|
||||
~& got/u.val
|
||||
?~ expected
|
||||
~[leaf/"queue mismatch"]
|
||||
:- (expect-eq !>(i.expected) !>(u.val))
|
||||
$(expected t.expected)
|
||||
--
|
Loading…
Reference in New Issue
Block a user