behn: refactor to use +abet pattern

This commit is contained in:
Joe Bryan 2022-06-17 02:11:49 -04:00
parent 5482d3ff93
commit 1b6d4f0fc5

View File

@ -45,159 +45,109 @@
|= [[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
|= [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
::
:: +drip: XX
::
++ 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)
==
::
++ vega [moves state]
:: +wake: unix says wake up; process the elapsed timer and set :next-wake
::
++ wake
|= error=(unit tang)
^+ [moves state]
=. next-wake.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
:: 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
(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
@ -265,27 +215,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
::
@ -376,6 +309,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]
--