Merge branch 'develop' into i/6103/abet-pure

This commit is contained in:
yosoyubik 2023-05-05 09:53:01 +02:00
commit df47808047
22 changed files with 711 additions and 621 deletions

View File

@ -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]. are tracked in the repository via [git LFS][git-lfs].
``` ```
$ git lfs init $ git lfs install
$ git lfs pull $ git lfs pull
``` ```
@ -185,7 +185,7 @@ directory as `urbit.pill`.
You can boot a new ship from your local pill with `-B`: 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 Release pills, i.e. those corresponding to vere releases, are cached at

View File

@ -13,15 +13,12 @@ also simple to reason about.
The branches and their corresponding moons that comprise the stages of the The branches and their corresponding moons that comprise the stages of the
release pipeline are: release pipeline are:
``` | Branch | Moon | Target Audience | Contains |
---------------------------------------------------------------------------------------------- |:---------:|:-----------------------:|:-----------------:|:------------------------------:|
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 |
`develop` | `~binnec-dozzod-marzod` | Kernel developers | Latest `develop` branch commit | `release` | `~doznec-dozzod-marzod` | App Developers | Latest release candidate |
`release` | `~marnec-dozzod-marzod` | Early Adopters | Latest `release` branch commit | `master` | `~zod` | Everyone Else | Latest release |
`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. **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.

View File

@ -831,7 +831,9 @@
|= keen-state |= keen-state
|^ ^- json |^ ^- json
%- pairs %- 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) 'nex'^a/(turn nex wants)
:: ::
:- 'hav' :- 'hav'

View File

@ -15,7 +15,7 @@
running=(axal thread-form) running=(axal thread-form)
tid=(map tid yarn) tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk]) serving=(map tid [(unit @ta) =mark =desk])
scries=(map tid [=ship =path]) scrying=(jug tid [=wire =ship =path])
== ==
:: ::
+$ clean-slate-any +$ clean-slate-any
@ -25,16 +25,26 @@
clean-slate-2 clean-slate-2
clean-slate-3 clean-slate-3
clean-slate-4 clean-slate-4
clean-slate-5
clean-slate clean-slate
== ==
:: ::
+$ 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 $: %5
starting=(map yarn [=trying =vase]) starting=(map yarn [=trying =vase])
running=(list yarn) running=(list yarn)
tid=(map tid yarn) tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk]) serving=(map tid [(unit @ta) =mark =desk])
scries=(map tid [ship path]) scrying=(map tid [ship path])
== ==
:: ::
+$ clean-slate-4 +$ clean-slate-4
@ -110,7 +120,8 @@
=. any (old-to-3 any) =. any (old-to-3 any)
=. any (old-to-4 any) =. any (old-to-4 any)
=. any (old-to-5 any) =. any (old-to-5 any)
?> ?=(%5 -.any) =. any (old-to-6 any)
?> ?=(%6 -.any)
:: ::
=. tid.state tid.any =. tid.state tid.any
=/ yarns=(list yarn) =/ yarns=(list yarn)
@ -120,7 +131,11 @@
?~ yarns ?~ yarns
[~[bind-eyre:sc] this] [~[bind-eyre:sc] this]
=^ cards-1 state =^ 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 =^ cards-2 this
$(yarns t.yarns) $(yarns t.yarns)
[:(weld upgrade-cards cards-1 cards-2) this] [:(weld upgrade-cards cards-1 cards-2) this]
@ -133,8 +148,8 @@
++ old-to-2 ++ old-to-2
|= old=clean-slate-any |= old=clean-slate-any
^- (quip card clean-slate-any) ^- (quip card clean-slate-any)
?> ?=(?(%1 %2 %3 %4 %5) -.old) ?> ?=(?(%1 %2 %3 %4 %5 %6) -.old)
?: ?=(?(%2 %3 %4 %5) -.old) ?: ?=(?(%2 %3 %4 %5 %6) -.old)
`old `old
:- ~[bind-eyre:sc] :- ~[bind-eyre:sc]
:* %2 :* %2
@ -147,8 +162,8 @@
++ old-to-3 ++ old-to-3
|= old=clean-slate-any |= old=clean-slate-any
^- clean-slate-any ^- clean-slate-any
?> ?=(?(%2 %3 %4 %5) -.old) ?> ?=(?(%2 %3 %4 %5 %6) -.old)
?: ?=(?(%3 %4 %5) -.old) ?: ?=(?(%3 %4 %5 %6) -.old)
old old
:* %3 :* %3
starting.old starting.old
@ -156,11 +171,12 @@
tid.old tid.old
(~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl])) (~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl]))
== ==
::
++ old-to-4 ++ old-to-4
|= old=clean-slate-any |= old=clean-slate-any
^- clean-slate-any ^- clean-slate-any
?> ?=(?(%3 %4 %5) -.old) ?> ?=(?(%3 %4 %5 %6) -.old)
?: ?=(?(%4 %5) -.old) ?: ?=(?(%4 %5 %6) -.old)
old old
:* %4 :* %4
starting.old starting.old
@ -171,10 +187,27 @@
:: ::
++ old-to-5 ++ old-to-5
|= old=clean-slate-any |= old=clean-slate-any
^- clean-slate ^- clean-slate-any
?> ?=(?(%4 %5) -.old) ?> ?=(?(%4 %5 %6) -.old)
?: ?=(%5 -.old) old ?: ?=(?(%5 %6) -.old) old
[%5 +.old(serving [serving.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 ++ on-poke
@ -421,14 +454,13 @@
?: (~(has of running.state) u.yarn) ?: (~(has of running.state) u.yarn)
?. nice ?. nice
(thread-fail u.yarn %cancelled ~) (thread-fail u.yarn %cancelled ~)
=^ cancel-cards state (cancel-scry tid &) =^ done-cards state (thread-done u.yarn *vase silent=%.n)
=^ done-cards state (thread-done u.yarn *vase) [done-cards state]
[(weld cancel-cards done-cards) state]
?: (~(has by starting.state) u.yarn) ?: (~(has by starting.state) u.yarn)
(thread-fail-not-running tid %stopped-before-started ~) (thread-fail-not-running tid %stopped-before-started ~)
~& [%thread-not-started u.yarn] ~& [%thread-not-started u.yarn]
?: nice ?: nice
(thread-done u.yarn *vase) (thread-done u.yarn *vase silent=%.y)
(thread-fail u.yarn %cancelled ~) (thread-fail u.yarn %cancelled ~)
:: ::
++ take-input ++ take-input
@ -457,8 +489,8 @@
^- [(list card) _state] ^- [(list card) _state]
%+ roll cards.r %+ roll cards.r
|= [=card cards=(list card) s=_state] |= [=card cards=(list card) s=_state]
:_ =? scries.s ?=([%pass ^ %arvo %a %keen @ *] card) :_ =? scrying.s ?=([%pass ^ %arvo %a %keen @ *] card)
(~(put by scries.s) tid &6.card +>+>+>.card) (~(put ju scrying.s) tid [&2 &6 |6]:card)
s s
:_ cards :_ cards
^- ^card ^- ^card
@ -476,7 +508,7 @@
?- -.eval-result.r ?- -.eval-result.r
%next `state %next `state
%fail (thread-fail yarn err.eval-result.r) %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] [(weld cards final-cards) state]
:: ::
@ -500,12 +532,15 @@
++ cancel-scry ++ cancel-scry
|= [=tid silent=?] |= [=tid silent=?]
^- (quip card _state) ^- (quip card _state)
?~ scry=(~(get by scries.state) tid) ?~ scrying=(~(get ju scrying.state) tid)
`state `state
:_ state(scries (~(del by scries.state) tid)) :_ state(scrying (~(del by scrying.state) tid))
?: silent ~ ?: silent ~
%- (slog leaf+"cancelling {<tid>}: [{<[ship path]:u.scry>}]" ~) %- ~(rep in `(set [wire ship path])`scrying)
[%pass /thread/[tid]/keen %arvo %a %yawn [ship path]:u.scry]~ |= [[=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 ++ thread-http-fail
|= [=tid =term =tang] |= [=tid =term =tang]
@ -537,7 +572,7 @@
=/ fail-cards (thread-say-fail tid term tang) =/ 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) =^ http-cards state (thread-http-fail tid term tang)
=^ scry-card state (cancel-scry tid |) =^ scry-card state (cancel-scry tid silent=%.n)
:_ state :_ state
:(weld fail-cards cards http-cards scry-card) :(weld fail-cards cards http-cards scry-card)
:: ::
@ -556,7 +591,7 @@
(json-response:gen:server !<(json (tube vase))) (json-response:gen:server !<(json (tube vase)))
:: ::
++ thread-done ++ thread-done
|= [=yarn =vase] |= [=yarn =vase silent=?]
^- (quip card ^state) ^- (quip card ^state)
:: %- (slog leaf+"strand {<yarn>} finished" (sell vase) ~) :: %- (slog leaf+"strand {<yarn>} finished" (sell vase) ~)
=/ =tid (yarn-to-tid yarn) =/ =tid (yarn-to-tid yarn)
@ -566,7 +601,7 @@
== ==
=^ http-cards state =^ http-cards state
(thread-http-response tid vase) (thread-http-response tid vase)
=^ scry-card state (cancel-scry tid &) =^ scry-card state (cancel-scry tid silent)
=^ cards state (thread-clean yarn) =^ cards state (thread-clean yarn)
[:(weld done-cards cards http-cards scry-card) state] [:(weld done-cards cards http-cards scry-card) state]
:: ::
@ -640,7 +675,7 @@
:: ::
++ clean-state ++ clean-state
!> ^- clean-slate !> ^- clean-slate
5+state(running (turn ~(tap of running.state) head)) 6+state(running (turn ~(tap of running.state) head))
:: ::
++ convert-tube ++ convert-tube
|= [from=mark to=mark =desk =bowl:gall] |= [from=mark to=mark =desk =bowl:gall]

View File

@ -1,7 +1,7 @@
/- *hood /- *hood
:- %say :- %say
|= [[now=@da eny=@uvJ bec=beak] [syd=desk ~] verb=_&] |= [[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" 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) (report-vat (report-prep p.bec now) p.bec now syd verb)
== ==

View File

@ -12,10 +12,17 @@
:: ::
/- *hood /- *hood
:- %say :- %say
|= [[now=@da * bec=beak] deks=$@(~ (list desk)) filt=@tas verb=_|] |= $: [now=@da * bec=beak]
?: &(=(~ deks) =(%$ filt)) deks=(list desk)
:- %tang [filt=@tas verb=_|]
%+ turn ==
~(tap in .^((set desk) %cd /(scot %p p.bec)/base/(scot %da now))) :- %tang ^- tang
|=(syd=desk (report-vat (report-prep p.bec now) p.bec now syd verb)) ?. &(=(~ deks) =(%$ filt))
[%tang (report-vats p.bec now deks filt verb)] (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))

View File

@ -11470,9 +11470,15 @@
:: 5d: parser :: 5d: parser
+| %parser +| %parser
:: ::
++ vang :: set ++vast params :: +vang: set +vast params
|= [bug=? wer=path] :: bug: debug mode ::
%*(. vast bug bug, wer wer) :: wer: where we are :: 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 ++ vast :: main parsing core
=+ [bug=`?`| wer=*path doc=`?`&] =+ [bug=`?`| wer=*path doc=`?`&]
@ -13486,7 +13492,7 @@
;~ pose ;~ pose
%+ ifix %+ ifix
[;~(plug lus tar muck) muck] [;~(plug lus tar muck) muck]
(most muck ;~(gunk sym loaf)) (most muck ;~(gunk sym loll))
:: ::
(easy ~) (easy ~)
== ==
@ -13563,6 +13569,7 @@
++ hunk (most mush loan) :: gapped specs ++ hunk (most mush loan) :: gapped specs
++ jump ;~(pose leap:docs gap) :: gap before docs ++ jump ;~(pose leap:docs gap) :: gap before docs
++ loaf ?:(tol tall wide) :: hoon ++ loaf ?:(tol tall wide) :: hoon
++ loll ?:(tol tall(doc |) wide(doc |)) :: hoon without docs
++ loan ?:(tol till wyde) :: spec ++ loan ?:(tol till wyde) :: spec
++ lore (sear |=(=hoon ~(flay ap hoon)) loaf) :: skin ++ lore (sear |=(=hoon ~(flay ap hoon)) loaf) :: skin
++ lomp ;~(plug sym (punt ;~(pfix tis wyde))) :: typeable name ++ lomp ;~(plug sym (punt ;~(pfix tis wyde))) :: typeable name
@ -13612,7 +13619,7 @@
++ expd |.(;~(goop loaf loaf loaf loaf)) :: four hoons ++ expd |.(;~(goop loaf loaf loaf loaf)) :: four hoons
++ expe |.(wisp) :: core tail ++ expe |.(wisp) :: core tail
++ expf |.(;~(goop ;~(pfix cen sym) loaf)) :: %term and hoon ++ 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 ++ exph |.((butt ;~(gunk rope rick))) :: wing, [wing hoon]s
++ expi |.((butt ;~(goop loaf hank))) :: one or more hoons ++ expi |.((butt ;~(goop loaf hank))) :: one or more hoons
++ expj |.(;~(goop lore loaf)) :: skin and hoon ++ expj |.(;~(goop lore loaf)) :: skin and hoon

View File

@ -36,27 +36,6 @@
max-size=_2.048 max-size=_2.048
depth=_1 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, :: +mop: constructs and validates ordered ordered map based on key,
:: val, and comparator gate :: val, and comparator gate
:: ::
@ -461,6 +440,13 @@
?: (compare key.n.a key.n.b) ?: (compare key.n.a key.n.b)
$(l.b $(b l.b, r.a ~), a r.a) $(l.b $(b l.b, r.a ~), a r.a)
$(r.b $(b r.b, l.a ~), a l.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 +$ deco ?(~ %bl %br %un) :: text decoration
@ -1029,7 +1015,7 @@
keens=(map path keen-state) keens=(map path keen-state)
== ==
+$ keen-state +$ keen-state
$: wan=(pha want) :: request packets, sent $: wan=((mop @ud want) lte) :: request packets, sent
nex=(list want) :: request packets, unsent nex=(list want) :: request packets, unsent
hav=(list have) :: response packets, backward hav=(list have) :: response packets, backward
num-fragments=@ud num-fragments=@ud
@ -1182,7 +1168,6 @@
?: (gth message-num.a message-num.b) ?: (gth message-num.a message-num.b)
%.n %.n
(lte fragment-num.a fragment-num.b) (lte fragment-num.a fragment-num.b)
::
:: $pump-metrics: congestion control state for a |packet-pump :: $pump-metrics: congestion control state for a |packet-pump
:: ::
:: This is an Ames adaptation of TCP's Reno congestion control :: This is an Ames adaptation of TCP's Reno congestion control

View File

@ -777,6 +777,301 @@
++ com |~(a=pass ^?(..nu)) ++ 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 :: $bug: debug printing configuration
:: ::
:: veb: verbosity toggles :: veb: verbosity toggles
@ -909,7 +1204,8 @@
[%10 ames-state-10] [%10 ames-state-10]
[%11 ames-state-11] [%11 ames-state-11]
[%12 ames-state-12] [%12 ames-state-12]
[%13 ^ames-state] [%13 ames-state-13]
[%14 ^ames-state]
== ==
:: ::
|= [now=@da eny=@ rof=roof] |= [now=@da eny=@ rof=roof]
@ -1032,7 +1328,7 @@
:: lifecycle arms; mostly pass-throughs to the contained adult ames :: lifecycle arms; mostly pass-throughs to the contained adult ames
:: ::
++ scry scry:adult-core ++ scry scry:adult-core
++ stay [%13 %larva queued-events ames-state.adult-gate] ++ stay [%14 %larva queued-events ames-state.adult-gate]
++ load ++ load
|= $= old |= $= old
$% $: %4 $% $: %4
@ -1099,6 +1395,13 @@
[%adult state=ames-state-12] [%adult state=ames-state-12]
== == == ==
$: %13 $: %13
$% $: %larva
events=(qeu queued-event)
state=ames-state-13
==
[%adult state=ames-state-13]
== ==
$: %14
$% $: %larva $% $: %larva
events=(qeu queued-event) events=(qeu queued-event)
state=_ames-state.adult-gate state=_ames-state.adult-gate
@ -1201,14 +1504,24 @@
=. queued-events events.old =. queued-events events.old
larval-gate 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 *] [%13 %larva *]
~> %slog.1^leaf/"ames: larva: load" ~> %slog.1^leaf/"ames: larva: load"
=. cached-state `[%13 state.old]
=. queued-events events.old =. queued-events events.old
=. adult-gate (load:adult-core %13 state.old)
larval-gate 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 ++ event-11-to-12
@ -1250,7 +1563,9 @@
12+(state-11-to-12:load:adult-core +.u.cached-state) 12+(state-11-to-12:load:adult-core +.u.cached-state)
=? u.cached-state ?=(%12 -.u.cached-state) =? u.cached-state ?=(%12 -.u.cached-state)
13+(state-12-to-13:load:adult-core +.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 =. ames-state.adult-gate +.u.cached-state
[moz larval-core(cached-state ~)] [moz larval-core(cached-state ~)]
-- --
@ -3829,8 +4144,8 @@
(trace %fine verb her ships.bug.ames-state print) (trace %fine verb her ships.bug.ames-state print)
:: ::
++ fi-emit |=(move fine(event-core (emit +<))) ++ fi-emit |=(move fine(event-core (emit +<)))
++ fi-deq (deq want) ++ fi-mop ((on @ud want) lte)
++ fi-gauge (ga metrics.keen (wyt:fi-deq wan.keen)) ++ fi-gauge (ga metrics.keen (wyt:fi-mop wan.keen))
++ fi-wait |=(tim=@da (fi-pass-timer %b %wait tim)) ++ fi-wait |=(tim=@da (fi-pass-timer %b %wait tim))
++ fi-rest |=(tim=@da (fi-pass-timer %b %rest tim)) ++ fi-rest |=(tim=@da (fi-pass-timer %b %rest tim))
:: ::
@ -3854,7 +4169,7 @@
=/ fra=@ 1 =/ fra=@ 1
=/ req=hoot (fi-etch-wail fra) =/ req=hoot (fi-etch-wail fra)
=/ =want [fra req last=now tries=1 skips=0] =/ =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-send `@ux`req)
:: ::
++ fi-rcv ++ fi-rcv
@ -3924,12 +4239,12 @@
=| marked=(list want) =| marked=(list want)
|= fra=@ud |= fra=@ud
^- [? _fine] ^- [? _fine]
=; [[found=? cor=_fine] wan=(pha want)] =; [[found=? cor=_fine] wan=_wan.keen]
:- found :- found
?.(found fine cor(wan.keen wan)) ?.(found fine cor(wan.keen wan))
%^ (dip-left:fi-deq ,[found=? cor=_fine]) wan.keen %^ (dip:fi-mop ,[found=? cor=_fine]) wan.keen
[| fine] [| fine]
|= [[found=? cor=_fine] =want] |= [[found=? cor=_fine] @ud =want]
^- [(unit _want) stop=? [found=? cor=_fine]] ^- [(unit _want) stop=? [found=? cor=_fine]]
=. fine cor =. fine cor
?: =(fra fra.want) ?: =(fra fra.want)
@ -3980,7 +4295,7 @@
=^ =want nex.keen nex.keen =^ =want nex.keen nex.keen
=. last-sent.want now =. last-sent.want now
=. tries.want +(tries.want) =. 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) =. fine (fi-send `@ux`hoot.want)
$(inx +(inx)) $(inx +(inx))
:: ::
@ -3996,11 +4311,11 @@
:: ::
++ fi-fast-retransmit ++ fi-fast-retransmit
|= fra=@ud |= fra=@ud
=; [cor=_fine wants=(pha want)] =; [cor=_fine wants=_wan.keen]
cor(wan.keen wants) cor(wan.keen wants)
%^ (dip-left:fi-deq ,cor=_fine) wan.keen %^ (dip:fi-mop ,cor=_fine) wan.keen
fine fine
|= [cor=_fine =want] |= [cor=_fine @ud =want]
^- [(unit ^want) stop=? cor=_fine] ^- [(unit ^want) stop=? cor=_fine]
?. (lte fra.want fra) ?. (lte fra.want fra)
[`want & cor] [`want & cor]
@ -4018,9 +4333,9 @@
++ fi-set-wake ++ fi-set-wake
^+ fine ^+ fine
=/ next-wake=(unit @da) =/ 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) ?: =(next-wake next-wake.keen)
fine fine
=? fine !=(~ next-wake.keen) =? fine !=(~ next-wake.keen)
@ -4042,13 +4357,14 @@
=. peer-state (update-peer-route her peer-state) =. peer-state (update-peer-route her peer-state)
=. metrics.keen on-timeout:fi-gauge =. metrics.keen on-timeout:fi-gauge
=^ want=(unit want) wan.keen =^ 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 ~| %took-wake-for-empty-want
?> ?=(^ want) ?> ?=(^ want)
=: tries.u.want +(tries.u.want) =: tries.u.want +(tries.u.want)
last-sent.u.want now 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) (fi-send `@ux`hoot.u.want)
-- --
:: +ga: constructor for |pump-gauge congestion control core :: +ga: constructor for |pump-gauge congestion control core
@ -4267,15 +4583,15 @@
[moves ames-gate] [moves ames-gate]
:: +stay: extract state before reload :: +stay: extract state before reload
:: ::
++ stay [%13 %adult ames-state] ++ stay [%14 %adult ames-state]
:: +load: load in old state after reload :: +load: load in old state after reload
:: ::
++ load ++ load
=< |= $= old-state =< |= $= old-state
$% [%13 ^ames-state] $% [%14 ^ames-state]
== ==
^+ ames-gate ^+ ames-gate
?> ?=(%13 -.old-state) ?> ?=(%14 -.old-state)
ames-gate(ames-state +.old-state) ames-gate(ames-state +.old-state)
:: all state transitions are called from larval ames :: all state transitions are called from larval ames
:: ::
@ -4394,7 +4710,7 @@
:: ::
++ state-12-to-13 ++ state-12-to-13
|= old=ames-state-12 |= old=ames-state-12
^- ^ames-state ^- ames-state-13
=+ !< =rift =+ !< =rift
q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)]))) q:(need (need (rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])))
=+ pk=sec:ex:crypto-core.old =+ pk=sec:ex:crypto-core.old
@ -4412,10 +4728,27 @@
:: ::
++ ship-state-12-to-13 ++ ship-state-12-to-13
|= old=ship-state-12 |= old=ship-state-12
^- ship-state ^- ship-state-13
?: ?=(%alien -.old) ?: ?=(%alien -.old)
old(heeds [heeds.old ~]) old(heeds [heeds.old ~])
old(corked [corked.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 :: +scry: dereference namespace
:: ::

View File

@ -925,7 +925,9 @@
~/ %parse-pile ~/ %parse-pile
|= [pax=path tex=tape] |= [pax=path tex=tape]
^- pile ^- 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 ?^ res pile.u.res
%- mean %- flop %- mean %- flop
=/ lyn p.hair =/ lyn p.hair
@ -4243,7 +4245,7 @@
:: +read-s: produce miscellaneous :: +read-s: produce miscellaneous
:: ::
++ read-s ++ read-s
|= [tak=tako pax=path] |= [tak=tako pax=path =case]
^- (unit (unit cage)) ^- (unit (unit cage))
?: ?=([%subs ~] pax) ?: ?=([%subs ~] pax)
?. =([%da now] case) ~ ?. =([%da now] case) ~
@ -4514,7 +4516,7 @@
%f (read-f tak path.mun) %f (read-f tak path.mun)
%p [(read-p path.mun) ..park] %p [(read-p path.mun) ..park]
%r (read-r tak path.mun) %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] %t [(read-t tak path.mun) ..park]
%u [(read-u tak path.mun) ..park] %u [(read-u tak path.mun) ..park]
%v [(read-v 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] |* [her=ship syd=desk yon=(unit aeon) res=* =state:ford:fusion]
=^ moves ruf =^ moves ruf
=/ den ((de now rof hen ruf) her syd) =/ 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)] [res (emil moves)]
:: ::
++ trace ++ trace

View File

@ -656,7 +656,8 @@
=/ connection=outstanding-connection =/ connection=outstanding-connection
[action [authenticated secure address request] ~ 0] [action [authenticated secure address request] ~ 0]
=. connections.state =. 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) (~(put by connections.state) duct connection)
:: redirect to https if insecure, redirects enabled :: redirect to https if insecure, redirects enabled
:: and secure port live :: and secure port live
@ -1986,7 +1987,10 @@
|= =tang |= =tang
^- [(list move) server-state] ^- [(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) =/ moves-1=(list move)
?. ?=(%app -.action.connection) ?. ?=(%app -.action.connection)
~ ~
@ -2055,8 +2059,8 @@
(session-cookie-string u.session-id &) (session-cookie-string u.session-id &)
headers.response-header.http-event headers.response-header.http-event
:: ::
=/ connection=outstanding-connection =* connection u.connection-state
(~(got by connections.state) duct) ::
:: if the request was a simple cors request from an approved origin :: if the request was a simple cors request from an approved origin
:: append the necessary cors headers to the response :: append the necessary cors headers to the response
:: ::
@ -2073,16 +2077,18 @@
:: ::
=. response-header.http-event response-header =. response-header.http-event response-header
=. connections.state =. connections.state
?: complete.http-event
:: XX optimize by not requiring +put:by in +request
::
(~(del by connections.state) duct)
::
%- (trace 2 |.("{<duct>} start")) %- (trace 2 |.("{<duct>} start"))
%+ ~(put by connections.state) duct %+ ~(put by connections.state) duct
%_ connection %= connection
response-header `response-header response-header `response-header
bytes-sent ?~(data.http-event 0 p.u.data.http-event) bytes-sent ?~(data.http-event 0 p.u.data.http-event)
== ==
:: ::
=? state complete.http-event
log-complete-request
::
pass-response pass-response
:: ::
%continue %continue
@ -2091,14 +2097,18 @@
(trace 0 |.("{<duct>} error continue without start")) (trace 0 |.("{<duct>} error continue without start"))
:: ::
=. connections.state =. connections.state
%- (trace 2 |.("{<duct>} continuing ")) ?: complete.http-event
%+ ~(jab by connections.state) duct %- (trace 2 |.("{<duct>} completed"))
|= connection=outstanding-connection (~(del by connections.state) duct)
=+ size=?~(data.http-event 0 p.u.data.http-event)
connection(bytes-sent (add bytes-sent.connection size))
:: ::
=? state complete.http-event %- (trace 2 |.("{<duct>} continuing"))
log-complete-request ?~ 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 pass-response
:: ::
@ -2112,16 +2122,6 @@
^- [(list move) server-state] ^- [(list move) server-state]
[[duct %give %response http-event]~ 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 ++ error-connection
:: todo: log application error :: todo: log application error
:: ::

View File

@ -42,9 +42,9 @@
:: $move: Arvo-level move :: $move: Arvo-level move
:: ::
+$ move [=duct move=(wind note-arvo gift-arvo)] +$ 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 :: $state: overall gall state
:: ::
:: system-duct: TODO document :: system-duct: TODO document
@ -82,6 +82,7 @@
:: beak: compilation source :: beak: compilation source
:: marks: mark conversion requests :: marks: mark conversion requests
:: sky: scry bindings :: sky: scry bindings
:: ken: open keen requests
:: ::
+$ yoke +$ yoke
$% [%nuke sky=(map spur @ud)] $% [%nuke sky=(map spur @ud)]
@ -98,6 +99,7 @@
=beak =beak
marks=(map duct mark) marks=(map duct mark)
sky=(map spur path-state) sky=(map spur path-state)
ken=(jug spar:ames wire)
== == == ==
:: ::
+$ path-state +$ path-state
@ -160,7 +162,7 @@
:: $spore: structures for update, produced by +stay :: $spore: structures for update, produced by +stay
:: ::
+$ spore +$ spore
$: %12 $: %13
system-duct=duct system-duct=duct
outstanding=(map [wire duct] (qeu remote-request)) outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship) contacts=(set ship)
@ -185,11 +187,12 @@
=beak =beak
marks=(map duct mark) marks=(map duct mark)
sky=(map spur path-state) sky=(map spur path-state)
ken=(jug spar:ames wire)
== == == ==
-- --
:: adult gall vane interface, for type compatibility with pupa :: adult gall vane interface, for type compatibility with pupa
:: ::
=| state=state-12 =| state=state-13
|= [now=@da eny=@uvJ rof=roof] |= [now=@da eny=@uvJ rof=roof]
=* gall-payload . =* gall-payload .
~% %gall-top ..part ~ ~% %gall-top ..part ~
@ -955,9 +958,20 @@
moves moves 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-idle
^+ ap-core
?: ?=(%| -.agent.yoke) 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-nuke
^+ ap-core ^+ ap-core
@ -967,13 +981,17 @@
|= [=duct =ship =path] |= [=duct =ship =path]
path path
=/ will=(list card:agent) =/ will=(list card:agent)
%+ welp ;: welp
?: =(~ inbound-paths) ?: =(~ inbound-paths)
~ ~
[%give %kick ~(tap in inbound-paths) ~]~ [%give %kick ~(tap in inbound-paths) ~]~
::
%+ turn ~(tap by boat.yoke) %+ turn ~(tap by boat.yoke)
|= [[=wire =dock] ? =path] |= [[=wire =dock] ? =path]
[%pass wire %agent dock %leave ~] [%pass wire %agent dock %leave ~]
::
ap-yawn-all
==
=^ maybe-tang ap-core (ap-ingest ~ |.([will *agent])) =^ maybe-tang ap-core (ap-ingest ~ |.([will *agent]))
ap-core ap-core
:: +ap-grow: bind a path in the agent's scry namespace :: +ap-grow: bind a path in the agent's scry namespace
@ -1310,6 +1328,12 @@
?: ?=(%& -.agent.yoke) ?: ?=(%& -.agent.yoke)
on-save:ap-agent-core on-save:ap-agent-core
p.agent.yoke 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 =^ error ap-core
(ap-install(agent.yoke &+agent) `old-state) (ap-install(agent.yoke &+agent) `old-state)
?~ error ?~ error
@ -1365,6 +1389,8 @@
=^ maybe-tang ap-core =^ maybe-tang ap-core
%+ ap-ingest ~ |. %+ ap-ingest ~ |.
(on-arvo:ap-agent-core wire sign-arvo) (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 ?^ maybe-tang
(ap-error %arvo-response u.maybe-tang) (ap-error %arvo-response u.maybe-tang)
ap-core ap-core
@ -1714,6 +1740,7 @@
:: ::
=. agent.yoke &++.p.result =. agent.yoke &++.p.result
=^ fex ap-core (ap-handle-sky -.p.result) =^ fex ap-core (ap-handle-sky -.p.result)
=. ken.yoke (ap-handle-ken fex)
=/ moves (zing (turn fex ap-from-internal)) =/ moves (zing (turn fex ap-from-internal))
=. bitt.yoke (ap-handle-kicks moves) =. bitt.yoke (ap-handle-kicks moves)
(ap-handle-peers moves) (ap-handle-peers moves)
@ -1732,6 +1759,17 @@
[%give *] $(caz t.caz, fex [i.caz fex]) [%give *] $(caz t.caz, fex [i.caz fex])
[%slip *] !! [%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: handle cancels of bitt.watches
:: ::
++ ap-handle-kicks ++ ap-handle-kicks
@ -1875,10 +1913,36 @@
=? old ?=(%9 -.old) (spore-9-to-10 old) =? old ?=(%9 -.old) (spore-9-to-10 old)
=? old ?=(%10 -.old) (spore-10-to-11 old) =? old ?=(%10 -.old) (spore-10-to-11 old)
=? old ?=(%11 -.old) (spore-11-to-12 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) 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 +$ spore-11
$: %11 $: %11
system-duct=duct system-duct=duct
@ -2010,20 +2074,6 @@
%+ murn ~(tap to q) %+ murn ~(tap to q)
|=(r=remote-request-9 ?:(?=(%cork r) ~ `r)) |=(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 :: removed live
:: changed old-state from (each vase vase) to [%| vase] :: changed old-state from (each vase vase) to [%| vase]
:: added code :: added code
@ -2039,6 +2089,35 @@
^- egg-11 ^- egg-11
e(|3 |4.e(|4 `|8.e(old-state [%| p.old-state.e]))) 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 :: +scry: standard scry
:: ::

View File

@ -336,7 +336,7 @@
=. pos.zim.pki =. pos.zim.pki
%+ ~(put by pos.zim.pki) %+ ~(put by pos.zim.pki)
our 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 :: our private key
:: ::
:: Private key updates are disallowed for fake ships, :: Private key updates are disallowed for fake ships,
@ -825,7 +825,7 @@
%+ turn passes %+ turn passes
|= [who=ship =pass] |= [who=ship =pass]
^- [who=ship =point] ^- [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] =. moz [[hen %give %public-keys %full (my points)] moz]
..feel ..feel
-- --
@ -1140,10 +1140,10 @@
[~ ~] [~ ~]
=/ who (slaw %p i.tyl) =/ who (slaw %p i.tyl)
?~ who [~ ~] ?~ who [~ ~]
:: fake ships always have rift=1 :: fake ships always have rift=0
:: ::
?: fak.own.pki.lex ?: fak.own.pki.lex
``[%atom !>(1)] ``[%atom !>(0)]
=/ pos (~(get by pos.zim.pki.lex) u.who) =/ pos (~(get by pos.zim.pki.lex) u.who)
?~ pos ~ ?~ pos ~
``[%atom !>(rift.u.pos)] ``[%atom !>(rift.u.pos)]
@ -1154,10 +1154,10 @@
[~ ~] [~ ~]
=/ who (slaw %p i.tyl) =/ who (slaw %p i.tyl)
?~ who [~ ~] ?~ who [~ ~]
:: fake ships always have rift=1 :: fake ships always have rift=0
:: ::
?: fak.own.pki.lex ?: fak.own.pki.lex
``[%noun !>((some 1))] ``[%noun !>((some 0))]
=/ pos (~(get by pos.zim.pki.lex) u.who) =/ pos (~(get by pos.zim.pki.lex) u.who)
?~ pos ``[%noun !>(~)] ?~ pos ``[%noun !>(~)]
``[%noun !>((some rift.u.pos))] ``[%noun !>((some rift.u.pos))]

View File

@ -5593,288 +5593,6 @@
$(pops [oldest pops]) $(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 :::: ++userlib :: (2u) non-vane utils
:: :::: :: ::::

View File

@ -6,19 +6,20 @@
=/ m (strand ,vase) =/ m (strand ,vase)
^- form:m ^- form:m
=+ !<([~ =spar:ames] arg) =+ !<([~ =spar:ames] arg)
;< dat=(unit roar:ames) bind:m ;< ~ bind:m
(keen:strandio spar) (keen:strandio /keen spar)
?~ dat ;< [* roar=(unit roar:ames)] bind:m
(take-tune:strandio /keen)
?~ roar
(pure:m !>(~)) (pure:m !>(~))
?~ data=q.dat.u.roar
(pure:m !>(~))
::
;< =bowl:spider bind:m get-bowl:strandio ;< =bowl:spider bind:m get-bowl:strandio
=/ [=path data=(unit (cask))] dat.u.dat
?~ data
(pure:m !>(~))
=+ .^ =dais:clay %cb =+ .^ =dais:clay %cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.data] /(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.data]
== ==
=/ res (mule |.((vale.dais q.u.data))) =/ res (mule |.((vale.dais q.u.data)))
?: ?=(%| -.res) ?. ?=(%| -.res)
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res)) (pure:m p.res)
(pure:m p.res) ~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))

View File

@ -82,8 +82,6 @@
`[%done q.cage.u.in.tin] `[%done q.cage.u.in.tin]
== ==
:: ::
::
::
++ take-sign-arvo ++ take-sign-arvo
=/ m (strand ,[wire sign-arvo]) =/ m (strand ,[wire sign-arvo])
^- form:m ^- form:m
@ -184,21 +182,20 @@
`[%done ~] `[%done ~]
`[%fail %timer-error u.error.sign-arvo.u.in.tin] `[%fail %timer-error u.error.sign-arvo.u.in.tin]
== ==
::
++ take-tune ++ take-tune
|= =wire |= =wire
=/ m (strand ,~) =/ m (strand ,[spar:ames (unit roar:ames)])
^- form:m ^- form:m
|= tin=strand-input:strand |= tin=strand-input:strand
?+ in.tin `[%skip ~] ?+ in.tin `[%skip ~]
~ `[%wait ~] ~ `[%wait ~]
[~ %agent * %poke-ack *] ::
[~ %sign * %ames %tune ^ *]
?. =(wire wire.u.in.tin) ?. =(wire wire.u.in.tin)
`[%skip ~] `[%skip ~]
?~ p.sign.u.in.tin `[%done +>.sign-arvo.u.in.tin]
`[%done ~]
`[%fail %poke-fail u.p.sign.u.in.tin]
== ==
:: ::
++ take-poke-ack ++ take-poke-ack
|= =wire |= =wire
@ -335,14 +332,10 @@
(take-wake `until) (take-wake `until)
:: ::
++ keen ++ keen
|= =spar:ames |= [=wire =spar:ames]
=/ m (strand ,(unit roar:ames)) =/ m (strand ,~)
^- form:m ^- form:m
=/ =card:agent:gall [%pass /keen %arvo %a %keen spar] (send-raw-card %pass wire %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)
:: ::
++ sleep ++ sleep
|= for=@dr |= for=@dr

View File

@ -17,7 +17,7 @@
-- --
++ grab ++ grab
|% :: convert from |% :: 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 ++ noun ^json :: clam from %noun
++ numb numb:enjs ++ numb numb:enjs
++ time time:enjs ++ time time:enjs

View File

@ -1,3 +1,4 @@
/% kelvin %kelvin
=, clay =, clay
=* dude dude:gall =* dude dude:gall
|% |%
@ -16,6 +17,12 @@
:: ::
+$ sync-state [nun=@ta kid=(unit desk) let=@ud] +$ sync-state [nun=@ta kid=(unit desk) let=@ud]
+$ sink (unit [her=@p sud=desk 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: get data required for reports
:: ::
++ report-prep ++ report-prep
@ -33,14 +40,19 @@
:: ::
++ report-vats ++ report-vats
|= [our=@p now=@da desks=(list desk) filt=@tas verb=?] |= [our=@p now=@da desks=(list desk) filt=@tas verb=?]
^- tang
=/ ego (scot %p our) =/ ego (scot %p our)
=/ wen (scot %da now) =/ wen (scot %da now)
=/ prep (report-prep our now) =/ prep (report-prep our now)
?~ filt ?~ filt
%- zing
%+ turn (flop desks) %+ turn (flop desks)
|=(syd=@tas (report-vat prep our now syd verb)) |=(syd=@tas (report-vat prep our now syd verb))
=/ deks =/ deks
?~ desks ~(tap in -.prep) ?~ desks
%+ sort
(sort ~(tap in -.prep) |=([[a=@ *] b=@ *] !(aor a b)))
|=([[a=@ *] [b=@ *]] ?|(=(a %kids) =(b %base)))
%+ skip ~(tap in -.prep) %+ skip ~(tap in -.prep)
|=([syd=@tas *] =(~ (find ~[syd] desks))) |=([syd=@tas *] =(~ (find ~[syd] desks)))
?: =(filt %blocking) ?: =(filt %blocking)
@ -57,8 +69,11 @@
|=([syd=desk *] syd) |=([syd=desk *] syd)
?~ blockers ~[leaf+"No desks blocking upgrade, run |bump to apply"] ?~ blockers ~[leaf+"No desks blocking upgrade, run |bump to apply"]
:- [%rose [" %" "To unblock upgrade run |suspend %" ""] blockers] :- [%rose [" %" "To unblock upgrade run |suspend %" ""] blockers]
%- zing
%+ turn (flop blockers) %+ turn (flop blockers)
|=(syd=desk (report-vat prep our now syd verb)) |=(syd=desk (report-vat prep our now syd verb))
::
%- zing
%+ turn %+ turn
?+ filt !! ?+ filt !!
:: ::
@ -91,6 +106,15 @@
== ==
our=ship now=@da syd=desk verb=? 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 ^- tank
=/ ego (scot %p our) =/ ego (scot %p our)
=/ wen (scot %da now) =/ wen (scot %da now)
@ -118,9 +142,6 @@
?~ sink [hash]~ ?~ sink [hash]~
(mergebase-hashes our syd now her.u.sink sud.u.sink) (mergebase-hashes our syd now her.u.sink sud.u.sink)
=/ dek (~(got by tyr) syd) =/ dek (~(got by tyr) syd)
=/ =dome (~(got by cone) our syd)
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
(skid ~(tap by ren.dome) |=([* ?] +<+))
=/ sat =/ sat
?- zest.dek ?- zest.dek
%live "running" %live "running"
@ -138,20 +159,29 @@
|= [=weft =tape] |= [=weft =tape]
(welp " {<[lal num]:weft>}" tape) (welp " {<[lal num]:weft>}" tape)
?. verb ?. 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/"/sys/kelvin: {kul}"
leaf/"base hash ends in: {(slag (sub (lent base-hash) 5) base-hash)}" leaf/"base hash ends in: {base-hash}"
leaf/"%cz hash ends in: {(slag (sub (lent <hash>) 5) <hash>)}" leaf/"%cz hash ends in: {(truncate-hash hash)}"
leaf/"app status: {sat}" leaf/"app status: {sat}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}" 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/"/sys/kelvin: {kul}"
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}" leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
leaf/"%cz hash: {<hash>}" leaf/"%cz hash: {<hash>}"
:: ::
leaf/"app status: {sat}" leaf/"app status: {sat}"
leaf/"force on: {?:(=(~ on) "~" <on>)}" leaf/"force on: {<(sort (turn on head) aor)>}"
leaf/"force off: {?:(=(~ of) "~" <of>)}" leaf/"force off: {<(sort (turn of head) aor)>}"
:: ::
leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}" leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}"
leaf/"updates: {?~(sink "local" "remote")}" leaf/"updates: {?~(sink "local" "remote")}"

View File

@ -41,7 +41,7 @@
:_ this :_ this
:_ ~ :_ ~
=/ dms=(list resource) =/ dms=(list resource)
?. .^(? %gu (scry:io %graph-store ~)) ?. .^(? %gu (scry:io %graph-store /$))
~ ~
%+ skim ~(tap in get-keys:gra) %+ skim ~(tap in get-keys:gra)
|=([ship name=term] ?=(^ (rush name ;~(pfix (jest 'dm--') fed:ag)))) |=([ship name=term] ?=(^ (rush name ;~(pfix (jest 'dm--') fed:ag))))

View File

@ -1,3 +1 @@
[%zuse 416] [%zuse 413]
[%zuse 415]
[%zuse 414]

View File

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