khan: support inline threads

This allows you to pass a thread directly into khan, instead of passing
a filename.  This has several implications:

- The friction for using threads from an app is significantly lower.
  Consider:

    =/  shed
      =/  m  (strand ,vase)
      ;<  ~  bind:m  (poke:strandio [our %hood] %helm-hi !>('hi'))
      ;<  ~  bind:m  (poke:strandio [our %hood] %helm-hi !>('there'))
      (pure:m !>('product'))
    [%pass /wire %arvo %k %lard %base shed]

- These threads close over their subject, so you don't need to parse
  arguments out from a vase -- you can just refer to them.  The produced
  value must still be a vase.

    ++  hi-ship
      |=  [=ship msg1=@t msg2=@t]
      =/  shed
        =/  m  (strand ,vase)
        ;<  ~  bind:m  (poke:strandio [ship %hood] %helm-hi !>(msg1))
        ;<  ~  bind:m  (poke:strandio [ship %hood] %helm-hi !>(msg2))
        (pure:m !>('product'))
      [%pass /wire %arvo %k %lard %base shed]

- Inline threads can be added to the dojo, though this PR does not add
  any sugar for this.

    =strandio -build-file %/lib/strandio/hoon
    =sh |=  message=@t
        =/  m  (strand:rand ,vase)
        ;<  ~  bind:m  (poke:strandio [our %hood] %helm-hi !>('hi'))
        ;<  ~  bind:m  (poke:strandio [our %hood] %helm-hi !>(message))
        (pure:m !>('product'))
    |pass [%k %lard %base (sh 'the message')]

Implementation notes:
- Review the commits separately: the first is small and implements the
  real feature.  The second moves the strand types into lull so khan can
  refer to them.

- In lull, I wanted to put +rand inside +khan, but this fails to that
  issue that puts the compiler in a loop.  +rand depends on +gall, which
  depends on +sign-arvo, which depends on +khan.  If +rand is in +khan,
  this spins the compiler.  The usual solution is to either move
  everything into the same battery (very ugly here) or break the
  recursion (which we do here).
This commit is contained in:
Philip Monk 2022-08-29 20:35:14 -08:00
parent 0e14eedb50
commit e3a8cab943
5 changed files with 228 additions and 200 deletions

View File

@ -307,12 +307,12 @@
::
++ handle-inline-thread
~/ %handle-inline-thread
|= [parent-tid=(unit tid) use=(unit tid) =beak =shred:spider]
(prep-thread parent-tid use beak %& shred)
|= [parent-tid=(unit tid) use=(unit tid) =beak =shed:khan]
(prep-thread parent-tid use beak %& shed)
::
++ prep-thread
|= $: parent-tid=(unit tid) use=(unit tid) =beak
source=(each shred:spider [file=term =vase])
source=(each shed:khan [file=term =vase])
==
^- (quip card ^state)
=/ parent-yarn=yarn
@ -385,10 +385,10 @@
(begin-thread yarn p.res)
::
++ begin-thread
|= [=yarn =shred:spider]
|= [=yarn =shed:khan]
?< (~(has of running.state) yarn)
=/ m (strand ,vase)
=/ =eval-form:eval:m (from-form:eval:m shred)
=/ =eval-form:eval:m (from-form:eval:m shed)
=. running.state (~(put of running.state) yarn eval-form)
(take-input yarn ~)
::

View File

@ -1,6 +1,6 @@
:: /sys/lull
:: %lull: arvo structures
::
!:
=> ..part
|%
++ lull %329
@ -2126,10 +2126,11 @@
$~ [%vega ~] ::
$% $>(%born vane-task) :: new unix process
[%done ~] :: socket closed
:: XX mark ignored
::
:: TODO mark ignored ::
:: ::
[%fard p=(fyrd cage)] :: in-arvo thread
[%fyrd p=(fyrd cast)] :: external thread
[%lard =bear =shed] :: inline thread
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
== ::
@ -2138,8 +2139,200 @@
+$ bear $@(desk beak) :: partial $beak
+$ cast (pair mark page) :: output mark + input
++ fyrd |$ [a] [=bear name=term args=a] :: thread run request
:: ::
+$ shed _*form:(strand:rand ,vase) :: compute vase
-- ::khan
::
++ rand :: computation
|%
+$ 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]
==
::
++ validate-mark
|= [in=* =mark =bowl]
^- cage
=+ .^ =dais:clay %cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[mark]
==
=/ res (mule |.((vale.dais in)))
?: ?=(%| -.res)
~| %spider-mark-fail
(mean leaf+"spider: ames vale fail {<mark>}" p.res)
[mark p.res]
::
:: 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 $
=. in.strand-input
?~ in.strand-input ~
=/ in u.in.strand-input
?. ?=(%agent -.in) `in
?. ?=(%fact -.sign.in) `in
::
:- ~
:^ %agent wire.in %fact
(validate-mark q.q.cage.sign.in p.cage.sign.in bowl.strand-input)
:: 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 [[cards %next ~] eval-form]
%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 ~]
==
==
--
--
-- ::strand
::
+$ gift-arvo :: out result <-$
$~ [%doze ~]
$% gift:ames

View File

@ -102,10 +102,10 @@
=/ =beam (need (de-beam t.wire))
?>(?=([@ ~] s.beam) beam(s i.s.beam))
::
++ start-spider
|= =vase
++ poke-spider
|= =cage
^- note
[%g %deal [our our] %spider %poke %spider-start vase]
[%g %deal [our our] %spider %poke cage]
::
++ watch-spider
|= =path
@ -146,7 +146,7 @@
:_ khan-gate
%+ turn
:~ (watch-spider /thread-result/[tid])
(start-spider !>(args))
(poke-spider %spider-start !>(args))
==
|=(=note ^-(move [hen %pass //g note]))
::
@ -159,6 +159,21 @@
(slap (vale.dais q.q.args.fyd) !,(*hoon [~ u=.]))
=- [[hen %pass wire -]~ khan-gate]
[%k %fard bear.fyd name.fyd p.q.args.fyd vase]
::
%lard
=/ tid=@ta
%^ cat 3
'khan-lard--'
(scot %uv (sham (mix tic eny)))
=. tic +(tic)
=/ =beak (get-beak bear.task now)
=/ args [~ `tid beak shed.task]
:_ khan-gate
%+ turn
:~ (watch-spider /thread-result/[tid])
(poke-spider %spider-inline !>(args))
==
|=(=note ^-(move [hen %pass //g note]))
==
:: +load: migrate an old state to a new khan version
::

View File

@ -1,187 +1 @@
|%
+$ 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]
==
::
++ validate-mark
|= [in=* =mark =bowl]
^- cage
=+ .^ =dais:clay %cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[mark]
==
=/ res (mule |.((vale.dais in)))
?: ?=(%| -.res)
~|(%spider-mark-fail (mean leaf+"spider: ames vale fail {<mark>}" p.res))
[mark p.res]
::
:: 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 $
=. in.strand-input
?~ in.strand-input ~
=/ in u.in.strand-input
?. ?=(%agent -.in) `in
?. ?=(%fact -.sign.in) `in
::
:- ~
:+ %agent wire.in
[%fact (validate-mark q.q.cage.sign.in p.cage.sign.in bowl.strand-input)]
:: 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 [[cards %next ~] eval-form]
%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 ~]
==
==
--
--
--
rand

View File

@ -1,7 +1,7 @@
/+ libstrand=strand
=, strand=strand:libstrand
|%
+$ thread $-(vase _*form:(strand ,vase))
+$ thread $-(vase shed:khan)
+$ input [=tid =cage]
+$ tid tid:strand
+$ bowl bowl:strand
@ -18,4 +18,10 @@
file=term
=vase
==
+$ inline-args
$: parent=(unit tid)
use=(unit tid)
=beak
=shed:khan
==
--