mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 08:32:39 +03:00
Merge pull request #5858 from urbit/jb/behn-fix2
behn: refactor to use +abet pattern
This commit is contained in:
Joe Bryan
GitHub
commit
9db7cb7203
@ -45,159 +45,112 @@
|
|||||||
|= [[now=@da =duct] state=behn-state]
|
|= [[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)
|
++ this .
|
||||||
:: +crud: handle failure of previous arvo event
|
++ emit |=(m=move this(moves [m moves]))
|
||||||
::
|
++ abet
|
||||||
++ crud
|
|
||||||
|= [tag=@tas error=tang]
|
|
||||||
^+ [moves state]
|
^+ [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)
|
=. moves (flop moves)
|
||||||
~& %behn-crud-not-wake^tag
|
=/ new=(unit @da) (bind (pry:timer-map timers.state) head)
|
||||||
[[duct %slip %d %flog %crud tag error]~ state]
|
:: emit %doze if needed
|
||||||
::
|
::
|
||||||
?: =(~ timers.state)
|
=? ..this
|
||||||
~|(%behn-crud-no-timer^tag^error !!)
|
?~ 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)
|
[moves state]
|
||||||
:: +rest: cancel the timer at :date, then adjust unix wakeup
|
|
||||||
:: +wait: set a new timer at :date, then adjust unix wakeup
|
|
||||||
::
|
::
|
||||||
++ rest |=(date=@da set-unix-wake(timers.state (unset-timer [date duct])))
|
+| %entry-points
|
||||||
++ wait |=(date=@da set-unix-wake(timers.state (set-timer [date duct])))
|
|
||||||
:: +huck: give back immediately
|
|
||||||
::
|
::
|
||||||
:: 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
|
:: +take-drip: the future is now, %give the deferred move
|
||||||
|= 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
|
++ take-drip
|
||||||
|= [num=@ud error=(unit tang)]
|
|= [num=@ud error=(unit tang)]
|
||||||
=< [moves state]
|
^+ this
|
||||||
^+ event-core
|
|
||||||
=/ drip (~(got by movs.drips.state) num)
|
=/ drip (~(got by movs.drips.state) num)
|
||||||
=. movs.drips.state (~(del by movs.drips.state) num)
|
%- emit(movs.drips.state (~(del by movs.drips.state) num))
|
||||||
=/ =move
|
=/ card [%give %meta drip]
|
||||||
=/ card [%give %meta drip]
|
?~ error
|
||||||
?~ error
|
[duct card]
|
||||||
[duct card]
|
=/ =tang
|
||||||
=/ =tang
|
(weld u.error `tang`[leaf/"drip failed" ~])
|
||||||
(weld u.error `tang`[leaf/"drip failed" ~])
|
:: XX should be
|
||||||
:: XX should be
|
:: [duct %hurl fail/tang card]
|
||||||
:: [duct %hurl fail/tang card]
|
::
|
||||||
::
|
[duct %pass /drip-slog %d %flog %crud %drip-fail tang]
|
||||||
[duct %pass /drip-slog %d %flog %crud %drip-fail tang]
|
|
||||||
event-core(moves [move moves])
|
|
||||||
:: +trim: in response to memory pressue
|
|
||||||
::
|
::
|
||||||
++ trim [moves state]
|
+| %tasks
|
||||||
:: +vega: learn of a kernel upgrade
|
|
||||||
::
|
::
|
||||||
++ vega [moves state]
|
:: +drip: enqueue a future gift (as a vase), %pass ourselves a %wait
|
||||||
:: +wake: unix says wake up; process the elapsed timer and set :next-wake
|
::
|
||||||
|
++ 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
|
++ wake
|
||||||
|= error=(unit tang)
|
|= error=(unit tang)
|
||||||
^+ [moves state]
|
^+ this
|
||||||
=. next-wake.state ~
|
|
||||||
:: no-op on spurious but innocuous unix wakeups
|
|
||||||
::
|
|
||||||
?: =(~ timers.state)
|
?: =(~ timers.state)
|
||||||
|
:: no-op on spurious but innocuous unix wakeups
|
||||||
|
::
|
||||||
~? ?=(^ error) %behn-wake-no-timer^u.error
|
~? ?=(^ error) %behn-wake-no-timer^u.error
|
||||||
[moves state]
|
this
|
||||||
:: 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
|
|
||||||
::
|
|
||||||
=/ [=timer later-timers=_timers.state] pop-timer
|
=/ [=timer later-timers=_timers.state] pop-timer
|
||||||
?: (gth date.timer now)
|
?: (gth date.timer now)
|
||||||
set-unix-wake
|
:: no-op if timer is early, (+abet will reset)
|
||||||
:: pop first timer, tell vane it has elapsed, and adjust next unix wakeup
|
::
|
||||||
|
this
|
||||||
|
:: pop the first timer and notify client vane,
|
||||||
|
:: forwarding error if present
|
||||||
::
|
::
|
||||||
=< set-unix-wake
|
:: XX %wake errors should be signaled out-of-band
|
||||||
(emit-vane-wake(timers.state later-timers) duct.timer ~)
|
:: [duct.timer %hurl goof %give %wake ~]
|
||||||
:: %utilities
|
::
|
||||||
|
(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
|
|
||||||
::
|
|
||||||
%_ 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 not soon enough, reset it
|
|
||||||
::
|
|
||||||
?^ next-wake
|
|
||||||
?: =(date.u.first 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: dequeue and produce earliest timer
|
||||||
::
|
::
|
||||||
++ pop-timer
|
++ pop-timer
|
||||||
@ -265,27 +218,10 @@
|
|||||||
wrapped-task=(hobo task)
|
wrapped-task=(hobo task)
|
||||||
==
|
==
|
||||||
^- [(list move) _behn-gate]
|
^- [(list move) _behn-gate]
|
||||||
::
|
|
||||||
=/ =task ((harden task) wrapped-task)
|
=/ =task ((harden task) wrapped-task)
|
||||||
=/ event-core (per-event [now hen] state)
|
=/ event-core (per-event [now hen] state)
|
||||||
::
|
|
||||||
=^ moves state
|
=^ moves state
|
||||||
::
|
abet:(call:event-core task ?~(dud ~ `tang.u.dud))
|
||||||
:: 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=~)
|
|
||||||
==
|
|
||||||
[moves behn-gate]
|
[moves behn-gate]
|
||||||
:: +load: migrate an old state to a new behn version
|
:: +load: migrate an old state to a new behn version
|
||||||
::
|
::
|
||||||
@ -376,6 +312,6 @@
|
|||||||
?> ?=([%drip @ ~] tea)
|
?> ?=([%drip @ ~] tea)
|
||||||
=/ event-core (per-event [now hen] state)
|
=/ event-core (per-event [now hen] state)
|
||||||
=^ moves 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]
|
[moves behn-gate]
|
||||||
--
|
--
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user