From e3a8cab943c5a50f899079a11f0173eb5570f8cc Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 29 Aug 2022 20:35:14 -0800 Subject: [PATCH] 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). --- pkg/arvo/app/spider.hoon | 10 +- pkg/arvo/sys/lull.hoon | 199 ++++++++++++++++++++++++++++++++++- pkg/arvo/sys/vane/khan.hoon | 23 +++- pkg/base-dev/lib/strand.hoon | 188 +-------------------------------- pkg/base-dev/sur/spider.hoon | 8 +- 5 files changed, 228 insertions(+), 200 deletions(-) diff --git a/pkg/arvo/app/spider.hoon b/pkg/arvo/app/spider.hoon index aabb395c1..26184d96f 100644 --- a/pkg/arvo/app/spider.hoon +++ b/pkg/arvo/app/spider.hoon @@ -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 ~) :: diff --git a/pkg/arvo/sys/lull.hoon b/pkg/arvo/sys/lull.hoon index 4d657f989..51bd7fc77 100644 --- a/pkg/arvo/sys/lull.hoon +++ b/pkg/arvo/sys/lull.hoon @@ -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 {}" 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 diff --git a/pkg/arvo/sys/vane/khan.hoon b/pkg/arvo/sys/vane/khan.hoon index 62b1999b9..64b8a35fa 100644 --- a/pkg/arvo/sys/vane/khan.hoon +++ b/pkg/arvo/sys/vane/khan.hoon @@ -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 :: diff --git a/pkg/base-dev/lib/strand.hoon b/pkg/base-dev/lib/strand.hoon index b52651432..b0db35b27 100644 --- a/pkg/base-dev/lib/strand.hoon +++ b/pkg/base-dev/lib/strand.hoon @@ -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 {}" 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 diff --git a/pkg/base-dev/sur/spider.hoon b/pkg/base-dev/sur/spider.hoon index 2a6a8207e..7c212681f 100644 --- a/pkg/base-dev/sur/spider.hoon +++ b/pkg/base-dev/sur/spider.hoon @@ -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 + == --