mirror of
https://github.com/urbit/shrub.git
synced 2024-12-24 11:24:21 +03:00
169 lines
4.0 KiB
Plaintext
169 lines
4.0 KiB
Plaintext
|%
|
|
+$ card card:agent:gall
|
|
+$ input
|
|
$% [%poke =cage]
|
|
[%sign =wire =sign-arvo]
|
|
[%agent =wire =sign:agent:gall]
|
|
[%watch =path]
|
|
==
|
|
+$ strand-input [=bowl in=(unit input)]
|
|
+$ tid @tatid
|
|
+$ bowl
|
|
$: our=ship
|
|
src=ship
|
|
tid=tid
|
|
mom=(unit tid)
|
|
wex=boat:gall
|
|
sup=bitt:gall
|
|
eny=@uvJ
|
|
now=@da
|
|
byk=beak
|
|
==
|
|
::
|
|
:: cards: cards to send immediately. These will go out even if a
|
|
:: later stage of the computation fails, so they shouldn't have
|
|
:: any semantic effect on the rest of the system.
|
|
:: Alternately, they may record an entry in contracts with
|
|
:: enough information to undo the effect if the computation
|
|
:: fails.
|
|
:: wait: don't move on, stay here. The next sign should come back
|
|
:: to this same callback.
|
|
:: skip: didn't expect this input; drop it down to be handled
|
|
:: elsewhere
|
|
:: cont: continue computation with new callback.
|
|
:: fail: abort computation; don't send effects
|
|
:: done: finish computation; send effects
|
|
::
|
|
++ strand-output-raw
|
|
|* a=mold
|
|
$~ [~ %done *a]
|
|
$: cards=(list card)
|
|
$= next
|
|
$% [%wait ~]
|
|
[%skip ~]
|
|
[%cont self=(strand-form-raw a)]
|
|
[%fail err=(pair term tang)]
|
|
[%done value=a]
|
|
==
|
|
==
|
|
::
|
|
++ strand-form-raw
|
|
|* a=mold
|
|
$-(strand-input (strand-output-raw a))
|
|
::
|
|
:: Abort strand computation with error message
|
|
::
|
|
++ strand-fail
|
|
|= err=(pair term tang)
|
|
|= strand-input
|
|
[~ %fail err]
|
|
::
|
|
:: Asynchronous transcaction monad.
|
|
::
|
|
:: Combo of four monads:
|
|
:: - Reader on input
|
|
:: - Writer on card
|
|
:: - Continuation
|
|
:: - Exception
|
|
::
|
|
++ strand
|
|
|* a=mold
|
|
|%
|
|
++ output (strand-output-raw a)
|
|
::
|
|
:: Type of an strand computation.
|
|
::
|
|
++ form (strand-form-raw a)
|
|
::
|
|
:: Monadic pure. Identity computation for bind.
|
|
::
|
|
++ pure
|
|
|= arg=a
|
|
^- form
|
|
|= strand-input
|
|
[~ %done arg]
|
|
::
|
|
:: Monadic bind. Combines two computations, associatively.
|
|
::
|
|
++ bind
|
|
|* b=mold
|
|
|= [m-b=(strand-form-raw b) fun=$-(b form)]
|
|
^- form
|
|
|= input=strand-input
|
|
=/ b-res=(strand-output-raw b)
|
|
(m-b input)
|
|
^- output
|
|
:- cards.b-res
|
|
?- -.next.b-res
|
|
%wait [%wait ~]
|
|
%skip [%skip ~]
|
|
%cont [%cont ..$(m-b self.next.b-res)]
|
|
%fail [%fail err.next.b-res]
|
|
%done [%cont (fun value.next.b-res)]
|
|
==
|
|
::
|
|
:: The strand monad must be evaluted in a particular way to maintain
|
|
:: its monadic character. +take:eval implements this.
|
|
::
|
|
++ eval
|
|
|%
|
|
:: Indelible state of a strand
|
|
::
|
|
+$ eval-form
|
|
$: =form
|
|
==
|
|
::
|
|
:: Convert initial form to eval-form
|
|
::
|
|
++ from-form
|
|
|= =form
|
|
^- eval-form
|
|
form
|
|
::
|
|
:: The cases of results of +take
|
|
::
|
|
+$ eval-result
|
|
$% [%next ~]
|
|
[%fail err=(pair term tang)]
|
|
[%done value=a]
|
|
==
|
|
::
|
|
:: Take a new sign and run the strand against it
|
|
::
|
|
++ take
|
|
:: cards: accumulate throughout recursion the cards to be
|
|
:: produced now
|
|
=| cards=(list card)
|
|
|= [=eval-form =strand-input]
|
|
^- [[(list card) =eval-result] _eval-form]
|
|
=* take-loop $
|
|
:: run the strand callback
|
|
::
|
|
=/ =output (form.eval-form strand-input)
|
|
:: add cards to cards
|
|
::
|
|
=. cards
|
|
%+ welp
|
|
cards
|
|
:: XX add tag to wires?
|
|
cards.output
|
|
:: case-wise handle next steps
|
|
::
|
|
?- -.next.output
|
|
%wait [[cards %next ~] eval-form]
|
|
%skip ~| [%take-got-skip ?~(in.strand-input ~ [+< +>-]:u.in.strand-input)]
|
|
!!
|
|
%fail [[cards %fail err.next.output] eval-form]
|
|
%done [[cards %done value.next.output] eval-form]
|
|
%cont
|
|
:: recurse to run continuation with initialization input
|
|
::
|
|
%_ take-loop
|
|
form.eval-form self.next.output
|
|
strand-input [bowl.strand-input ~]
|
|
==
|
|
==
|
|
--
|
|
--
|
|
--
|