Merge branch 'urbit:master' into eval

This commit is contained in:
mopfel-winrux 2022-07-14 14:53:37 -04:00 committed by GitHub
commit f8406bc723
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 358 additions and 161 deletions

View File

@ -532,10 +532,11 @@
?: ?=([%show %3] -.mad)
(dy-rash %tan (dy-show-source q.mad) ~)
?: ?=(%brev -.mad)
?: ?=(?(%eny %now %our) p.mad)
(dy-rash %tan (cat 3 p.mad ' is immutable') ~)
=. var (~(del by var) p.mad)
=< dy-amok
?+ p.mad .
$?(%eny %now %our) !!
%lib .(lib ~)
%sur .(sur ~)
%dir .(dir [[our.hid %base ud+0] /])
@ -543,13 +544,12 @@
=+ cay=(~(got by rez) p.q.mad)
?- -.p.mad
%verb
?: ?=(?(%eny %now %our) p.p.mad)
(dy-rash %tan (cat 3 p.p.mad ' is immutable') ~)
=. var (~(put by var) p.p.mad cay)
~| bad-set+[p.p.mad p.q.cay]
=< dy-amok
?+ p.p.mad .
%eny ~|(%entropy-is-eternal !!)
%now ~|(%time-is-immutable !!)
%our ~|(%self-is-immutable !!)
%lib
%_ .
lib
@ -568,6 +568,8 @@
?: ?=([@ ~] pax) ~[i.pax %base '0']
?: ?=([@ @ ~] pax) ~[i.pax i.t.pax '0']
pax
?: =(~ .^((list path) %ct pax))
+(..dy (he-diff %tan 'dojo: dir does not exist' ~))
=. dir (need (de-beam pax))
=- +>(..dy (he-diff %tan - ~))
rose+[" " `~]^~[leaf+"=%" (smyt (en-beam he-beak s.dir))]
@ -735,9 +737,9 @@
^+ +>+>
=^ dat say (~(transceive sole say) cal)
?: |(?=(^ per) ?=(^ pux) ?=(~ pro))
~& %dy-edit-busy
=^ lic say (~(transmit sole say) dat)
(dy-diff %mor [%det lic] [%bel ~] ~)
=/ tip=@t 'dojo: busy (press backspace to abort)'
(dy-diff %mor [%det lic] [%bel ~] [%tan [tip ~]] ~)
=> .(per `dat)
=/ res (mule |.((slam u.pro !>((tufa buf.say)))))
?: ?=(%| -.res)

View File

@ -9,7 +9,9 @@
:- %kiln-rein
:- desk
%+ roll arg
=| =rein:hood
=/ =rein:hood
=< rein.arak
.^(vat:hood %gx /(scot %p p.bec)/hood/(scot %da now)/kiln/vat/[desk]/noun)
|: [*[on=? =dude:gall] rein=rein(liv liv)]
?: on
rein(add (~(put in add.rein) dude))

View File

@ -8,5 +8,14 @@
++ grab
|%
+$ noun [ship binding]
++ json
=, dejs:format
|= jon=json
%. jon
%- ot
:~ [%ship |=(j=json ?>(?=([%s *] j) (rash +.j fed:ag)))]
[%address |=(j=json ?>(?=([%s *] j) [%if (rash +.j ip4:eyre)]))]
[%turf (ar so)]
==
--
--

View File

@ -0,0 +1,16 @@
/- *dns
|_ r=request
++ grad %noun
++ grow
|%
++ json
%- pairs:enjs:format
:~ ['ship' (ship:enjs:format ship.r)]
['address' s+(rsh 3 (scot %if +.address.r))]
==
--
++ grab
|%
++ noun request
--
--

View File

@ -45,161 +45,112 @@
|= [[now=@da =duct] state=behn-state]
::
|%
:: %entry-points
::
:: +born: urbit restarted; refresh :next-wake and store wakeup timer duct
+| %helpers
::
++ born set-unix-wake(next-wake.state ~, unix-duct.state duct)
:: +crud: handle failure of previous arvo event
::
++ crud
|= [tag=@tas error=tang]
++ this .
++ emit |=(m=move this(moves [m moves]))
++ abet
^+ [moves state]
:: behn must get activated before other vanes in a %wake
:: moves are statefully pre-flopped to ensure that
:: any prepended %doze is emitted first
::
?. =(%wake tag)
~& %behn-crud-not-wake^tag
[[duct %slip %d %flog %crud tag error]~ state]
=. moves (flop moves)
=/ new=(unit @da) (bind (pry:timer-map timers.state) head)
:: emit %doze if needed
::
?: =(~ timers.state)
~|(%behn-crud-no-timer^tag^error !!)
=? ..this
?~ unix-duct.state |
=/ dif=[old=(unit @da) new=(unit @da)] [next-wake.state new]
?+ dif ~|([%unpossible dif] !!)
[~ ~] | :: no-op
[~ ^] & :: set
[^ ~] & :: clear
[^ ^] !=(u.old.dif u.new.dif) :: set if changed
==
(emit(next-wake.state new) [unix-duct.state %give %doze new])
::
(wake `error)
:: +rest: cancel the timer at :date, then adjust unix wakeup
:: +wait: set a new timer at :date, then adjust unix wakeup
[moves state]
::
++ rest |=(date=@da set-unix-wake(timers.state (unset-timer [date duct])))
++ wait |=(date=@da set-unix-wake(timers.state (set-timer [date duct])))
:: +huck: give back immediately
+| %entry-points
::
:: Useful if you want to continue working after other moves finish.
++ call
|= [=task error=(unit tang)]
^+ this
?: ?& ?=(^ error)
!?=(%wake -.task)
==
:: XX more and better error handling
::
~& %behn-crud-not-wake^-.task
(emit [duct %slip %d %flog %crud -.task u.error])
::
?- -.task
%born this(next-wake.state ~, unix-duct.state duct)
%drip (drip p.task)
%huck (emit [duct %give %heck syn.task])
%rest this(timers.state (unset-timer [p.task duct]))
%trim this
%vega this
%wait this(timers.state (set-timer [p.task duct]))
%wake (wake(next-wake.state ~) error)
==
::
++ huck
|= syn=sign-arvo
=< [moves state]
event-core(moves [duct %give %heck syn]~)
:: +drip: XX
::
++ drip
|= mov=vase
=< [moves state]
^+ event-core
=. moves
[duct %pass /drip/(scot %ud count.drips.state) %b %wait +(now)]~
=. movs.drips.state
(~(put by movs.drips.state) count.drips.state mov)
=. count.drips.state +(count.drips.state)
event-core
:: +take-drip: XX
:: +take-drip: the future is now, %give the deferred move
::
++ take-drip
|= [num=@ud error=(unit tang)]
=< [moves state]
^+ event-core
^+ this
=/ drip (~(got by movs.drips.state) num)
=. movs.drips.state (~(del by movs.drips.state) num)
=/ =move
=/ card [%give %meta drip]
?~ error
[duct card]
=/ =tang
(weld u.error `tang`[leaf/"drip failed" ~])
:: XX should be
:: [duct %hurl fail/tang card]
::
[duct %pass /drip-slog %d %flog %crud %drip-fail tang]
event-core(moves [move moves])
:: +trim: in response to memory pressue
%- emit(movs.drips.state (~(del by movs.drips.state) num))
=/ card [%give %meta drip]
?~ error
[duct card]
=/ =tang
(weld u.error `tang`[leaf/"drip failed" ~])
:: XX should be
:: [duct %hurl fail/tang card]
::
[duct %pass /drip-slog %d %flog %crud %drip-fail tang]
::
++ trim [moves state]
:: +vega: learn of a kernel upgrade
+| %tasks
::
++ vega [moves state]
:: +wake: unix says wake up; process the elapsed timer and set :next-wake
:: +drip: enqueue a future gift (as a vase), %pass ourselves a %wait
::
++ drip
|= vax=vase
^+ this
%. [duct %pass /drip/(scot %ud count.drips.state) %b %wait +(now)]
%= emit
movs.drips.state (~(put by movs.drips.state) count.drips.state vax)
count.drips.state +(count.drips.state)
==
::
:: +wake: unix says wake up; process the elapsed timer (or forward error)
::
++ wake
|= error=(unit tang)
^+ [moves state]
:: no-op on spurious but innocuous unix wakeups
::
^+ this
?: =(~ timers.state)
:: no-op on spurious but innocuous unix wakeups
::
~? ?=(^ error) %behn-wake-no-timer^u.error
[moves state]
:: if we errored, pop the timer and notify the client vane of the error
::
?^ error
=< set-unix-wake
=^ =timer timers.state pop-timer
(emit-vane-wake duct.timer error)
:: if unix woke us too early, retry by resetting the unix wakeup timer
::
this
=/ [=timer later-timers=_timers.state] pop-timer
?: (gth date.timer now)
set-unix-wake(next-wake.state ~)
:: pop first timer, tell vane it has elapsed, and adjust next unix wakeup
:: no-op if timer is early, (+abet will reset)
::
this
:: pop the first timer and notify client vane,
:: forwarding error if present
::
=< set-unix-wake
(emit-vane-wake(timers.state later-timers) duct.timer ~)
:: %utilities
:: XX %wake errors should be signaled out-of-band
:: [duct.timer %hurl goof %give %wake ~]
::
(emit(timers.state later-timers) [duct.timer %give %wake error])
::
::+|
+| %implementation
::
++ event-core .
:: +emit-vane-wake: produce a move to wake a vane; assumes no prior moves
::
++ emit-vane-wake
|= [=^duct error=(unit tang)]
event-core(moves [duct %give %wake error]~)
:: +emit-doze: set new unix wakeup timer in state and emit move to unix
::
:: We prepend the unix %doze event so that it is handled first. Arvo must
:: handle this first because the moves %behn emits will get handled in
:: depth-first order. If we're handling a %wake which causes a move to a
:: different vane and a %doze event to send to unix, Arvo needs to process
:: the %doze first because otherwise if the move to the other vane calls
:: back into %behn and emits a second %doze, the second %doze would be
:: handled by unix first which is incorrect.
::
++ emit-doze
|= =date=(unit @da)
^+ event-core
:: no-op if .unix-duct has not yet been set
::
?~ unix-duct.state
event-core
:: make sure we don't try to wake up in the past
::
=? date-unit ?=(^ date-unit) `(max now u.date-unit)
::
%_ event-core
next-wake.state date-unit
moves [[unix-duct.state %give %doze date-unit] moves]
==
:: +set-unix-wake: set or unset next unix wakeup timer based on :i.timers
::
++ set-unix-wake
=< [moves state]
~% %set-unix-wake ..part ~ |-
^+ event-core
::
=* next-wake next-wake.state
=* timers timers.state
:: if no timers, cancel existing wakeup timer or no-op
::
=/ first=(unit [date=@da *]) (pry:timer-map timers.state)
?~ first
?~ next-wake
event-core
(emit-doze ~)
:: if :next-wake is in the past or not soon enough, reset it
::
?^ next-wake
?: &((gte date.u.first u.next-wake) (lte now u.next-wake))
event-core
(emit-doze `date.u.first)
:: there was no unix wakeup timer; set one
::
(emit-doze `date.u.first)
:: +pop-timer: dequeue and produce earliest timer
::
++ pop-timer
@ -267,27 +218,10 @@
wrapped-task=(hobo task)
==
^- [(list move) _behn-gate]
::
=/ =task ((harden task) wrapped-task)
=/ event-core (per-event [now hen] state)
::
=^ moves state
::
:: handle error notifications
::
?^ dud
(crud:event-core -.task tang.u.dud)
::
?- -.task
%born born:event-core
%rest (rest:event-core date=p.task)
%drip (drip:event-core move=p.task)
%huck (huck:event-core syn.task)
%trim trim:event-core
%vega vega:event-core
%wait (wait:event-core date=p.task)
%wake (wake:event-core error=~)
==
abet:(call:event-core task ?~(dud ~ `tang.u.dud))
[moves behn-gate]
:: +load: migrate an old state to a new behn version
::
@ -378,6 +312,6 @@
?> ?=([%drip @ ~] tea)
=/ event-core (per-event [now hen] state)
=^ moves state
(take-drip:event-core (slav %ud i.t.tea) error.hin)
abet:(take-drip:event-core (slav %ud i.t.tea) error.hin)
[moves behn-gate]
--

View File

@ -251,7 +251,7 @@
;meta(charset "utf-8");
;meta(name "viewport", content "width=device-width, initial-scale=1, shrink-to-fit=no");
;link(rel "icon", type "image/svg+xml", href (weld "data:image/svg+xml;utf8," favicon));
;title:"OS1"
;title:"Urbit"
;style:'''
@import url("https://rsms.me/inter/inter.css");
@font-face {

View File

@ -25,7 +25,7 @@
|= if=@if
=/ m (strand ,~)
^- form:m
=/ collector-app `dock`[~zod %dns-collector]
=/ collector-app `dock`[~deg %dns-collector]
;< good=? bind:m (self-check-http:libdns |+if 2)
?. good
%+ strand-fail:strandio %bail-early-self-check

View File

@ -0,0 +1,234 @@
/+ *test
/= behn-raw /sys/vane/behn
=/ behn-gate (behn-raw ~bus)
=/ scry *roof
=* move move:behn-gate
::
|%
++ test-wake-no
^- tang
=/ wen ~1111.1.1
=/ arg [~[/vere] [%wake ~]]
-:(call ~ wen arg ~)
::
++ test-wake-no-wait
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/vere] [%born ~]]
=/ a-out ~
=^ a behn-gate (call `%a wen a-arg a-out)
::
=/ b-arg [~[/vere] [%wake ~]]
=/ b-out ~
=^ b behn-gate (call `%b wen b-arg b-out)
::
(weld a b)
::
++ test-wake-no-born
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/foo] [%wait +(wen)]]
=/ a-out ~
=^ a behn-gate (call `%a wen a-arg a-out)
::
=/ b-arg [~[/vere] [%wake ~]]
=/ b-out ~
=^ b behn-gate (call `%b wen b-arg b-out)
::
(weld a b)
::
++ test-wake
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/vere] [%born ~]]
=/ a-out ~
=^ a behn-gate
(call ~ wen a-arg a-out)
::
=/ b-arg [~[/foo] [%wait +(wen)]]
=/ b-out=(list move) [~[/vere] [%give [%doze `+(wen)]]]~
=^ b behn-gate (call `%b wen b-arg b-out)
::
=/ c-arg [~[/vere] [%wake ~]]
=/ c-out=(list move) [~[/foo] [%give [%wake ~]]]~
=^ c behn-gate (call `%c +(wen) c-arg c-out)
::
:(weld a b c)
::
++ test-born
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/foo] [%wait +(wen)]]
=/ a-out ~
=^ a behn-gate (call `%a wen a-arg a-out)
::
=/ b-arg [~[/vere] [%born ~]]
=/ b-out=(list move) [~[/vere] [%give [%doze `+(wen)]]]~
=^ b behn-gate (call `%b wen b-arg b-out)
::
(weld a b)
::
++ test-many-ordered
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/vere] [%born ~]]
=/ a-out ~
=^ a behn-gate (call `%a wen a-arg a-out)
::
=/ b-arg [~[/foo] [%wait +(wen)]]
=/ b-out=(list move) [~[/vere] [%give [%doze `+(wen)]]]~
=^ b behn-gate (call `%b wen b-arg b-out)
::
=/ c-arg [~[/foo] [%wait (add 2 wen)]]
=/ c-out ~
=^ c behn-gate (call `%c wen c-arg c-out)
::
=/ d-arg [~[/foo] [%wait (add 3 wen)]]
=/ d-out ~
=^ d behn-gate (call `%d wen d-arg d-out)
::
=/ e-arg [~[/vere] [%wake ~]]
=/ e-out=(list move)
:~ [~[/vere] [%give [%doze `(add 2 wen)]]]
[~[/foo] [%give [%wake ~]]]
==
=^ e behn-gate (call `%e (add 4 wen) e-arg e-out)
::
:(weld a b c d e)
::
++ test-many-ordered-lag
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/vere] [%born ~]]
=/ a-out ~
=^ a behn-gate (call `%a wen a-arg a-out)
::
=/ b-arg [~[/foo] [%wait +(wen)]]
=/ b-out=(list move) [~[/vere] [%give [%doze `+(wen)]]]~
=^ b behn-gate (call `%b wen b-arg b-out)
::
=/ c-arg [~[/foo] [%wait (add 2 wen)]]
=/ c-out ~
=^ c behn-gate (call `%c wen c-arg c-out)
::
=/ d-arg [~[/foo] [%wait (add 3 wen)]]
=/ d-out ~
=^ d behn-gate (call `%d wen d-arg d-out)
::
=/ e-arg [~[/vere] [%wake ~]]
=/ e-out=(list move)
:~ [~[/vere] [%give [%doze `(add 2 wen)]]]
[~[/foo] [%give [%wake ~]]]
==
=^ e behn-gate (call `%e +(wen) e-arg e-out)
::
:(weld a b c d e)
::
++ test-many-unordered
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/vere] [%born ~]]
=/ a-out ~
=^ a behn-gate (call `%a wen a-arg a-out)
::
=/ b-arg [~[/foo] [%wait (add 2 wen)]]
=/ b-out=(list move) [~[/vere] [%give [%doze `(add 2 wen)]]]~
=^ b behn-gate (call `%b wen b-arg b-out)
::
=/ c-arg [~[/foo] [%wait (add 3 wen)]]
=/ c-out ~
=^ c behn-gate (call `%c wen c-arg c-out)
::
=/ d-arg [~[/foo] [%wait +(wen)]]
=/ d-out=(list move) [~[/vere] [%give [%doze `+(wen)]]]~
=^ d behn-gate (call `%d wen d-arg d-out)
::
=/ e-arg [~[/vere] [%wake ~]]
=/ e-out=(list move)
:~ [~[/vere] [%give [%doze `(add 2 wen)]]]
[~[/foo] [%give [%wake ~]]]
==
=^ e behn-gate (call `%e (add 4 wen) e-arg e-out)
::
:(weld a b c d e)
::
++ test-same-ordered-lag
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/vere] [%born ~]]
=/ a-out ~
=^ a behn-gate (call `%a wen a-arg a-out)
::
=/ b-arg [~[/foo] [%wait (add 2 wen)]]
=/ b-out=(list move) [~[/vere] [%give [%doze `(add 2 wen)]]]~
=^ b behn-gate (call `%b wen b-arg b-out)
::
=/ c-arg [~[/foo] [%wait (add 2 wen)]]
=/ c-out ~
=^ c behn-gate (call `%c wen c-arg c-out)
::
=/ d-arg [~[/foo] [%wait (add 2 wen)]]
=/ d-out ~
=^ d behn-gate (call `%d wen d-arg d-out)
::
=/ e-arg [~[/vere] [%wake ~]]
=/ e-out=(list move)
:~ [~[/vere] [%give [%doze `(add 2 wen)]]]
[~[/foo] [%give [%wake ~]]]
==
=^ e behn-gate (call `%e (add 3 wen) e-arg e-out)
::
:(weld a b c d e)
::
++ test-rest
^- tang
=/ wen ~1111.1.1
::
=/ a-arg [~[/vere] [%born ~]]
=/ a-out ~
=^ a behn-gate (call `%a wen a-arg a-out)
::
=/ b-arg [~[/foo] [%wait (add 2 wen)]]
=/ b-out=(list move) [~[/vere] [%give [%doze `(add 2 wen)]]]~
=^ b behn-gate (call `%b wen b-arg b-out)
::
=/ c-arg [~[/foo] [%wait (add 3 wen)]]
=/ c-out ~
=^ c behn-gate (call `%c wen c-arg c-out)
::
=/ d-arg [~[/foo] [%rest (add 2 wen)]]
=/ d-out=(list move) [~[/vere] [%give [%doze `(add 3 wen)]]]~
=^ d behn-gate (call `%d wen d-arg d-out)
::
=/ e-arg [~[/vere] [%wake ~]]
=/ e-out=(list move) [~[/foo] [%give [%wake ~]]]~
=^ e behn-gate (call `%e (add 4 wen) e-arg e-out)
::
:(weld a b c d e)
::
++ call
=| lac=?
|= $: label=(unit @tas)
now=@da
args=[=duct task=(hobo task:behn)]
expected-moves=(list move)
==
=/ behn-core (behn-gate now=now eny=`@`0xdead.beef scry=scry)
=^ moves behn-gate
(call:behn-core duct.args dud=~ task.args)
::
~? !lac moves
=/ output=tang
%+ expect-eq
!> expected-moves
!> moves
[?~(label output ?~(output ~ [u.label output])) behn-gate]
--

View File

@ -4,7 +4,7 @@
glob-http+['https://bootstrap.urbit.org/glob-0v5.kgrq2.gp725.bo5bk.dmr7d.h41qk.glob' 0v5.kgrq2.gp725.bo5bk.dmr7d.h41qk]
::glob-ames+~zod^0v0
base+'grid'
version+[1 1 3]
version+[1 1 6]
website+'https://tlon.io'
license+'MIT'
==

View File

@ -1,10 +1,10 @@
:~ title+'Groups'
info+'A suite of applications to communicate on Urbit'
color+0xee.5432
glob-http+['https://bootstrap.urbit.org/glob-0v4.2se6m.fvv67.nn5e8.vfrv9.mmi88.glob' 0v4.2se6m.fvv67.nn5e8.vfrv9.mmi88]
glob-http+['https://bootstrap.urbit.org/glob-0v3.mtkm8.77bad.7j793.jtnl4.pi1mm.glob' 0v3.mtkm8.77bad.7j793.jtnl4.pi1mm]
base+'landscape'
version+[1 0 11]
version+[1 1 0]
website+'https://tlon.io'
license+'MIT'
==