spider: add process tree

This commit is contained in:
Philip Monk 2019-11-09 23:27:07 -08:00
parent ab8ac96702
commit 5c1d68bf44
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
33 changed files with 360 additions and 155 deletions

View File

@ -1,19 +1,114 @@
/- spider
/+ libthread=thread, default-agent
/+ libthread=thread, default-agent, verb
=, thread=thread:libthread
|%
+$ card card:agent:mall
+$ imp imp:spider
+$ imp-name term
+$ imput [=imp-name =cage]
+$ imp-thread imp:spider
+$ pid @udpid
+$ iid iid:spider
+$ imp (list pid)
+$ imput [=imp =cage]
+$ imp-form _*eval-form:eval:(thread ,vase)
+$ trie
$~ [*imp-form ~]
[=imp-form kid=(map pid trie)]
::
+$ state
$: started=(map imp-name vase)
running=(map imp-name _*eval-form:[~!(. eval)]:(thread ,vase))
$: started=(map imp vase)
running=trie
iid=(map iid imp)
count=pid
==
::
+$ clean-slate
$: started=(map imp vase)
running=(list imp)
iid=(map iid imp)
count=pid
==
::
+$ start-args
[parent=(unit iid) file=term =vase]
--
::
:: Trie operations
::
|%
++ get-imp
|= [=trie =imp]
^- (unit =imp-form)
?~ imp
`imp-form.trie
=/ son (~(get by kid.trie) i.imp)
?~ son
~
$(trie u.son, imp t.imp)
::
++ get-imp-children
|= [=trie =imp]
^- (list ^imp)
?~ imp
(turn (tap-imp trie) head)
=/ son (~(get by kid.trie) i.imp)
?~ son
~
$(trie u.son, imp t.imp)
::
::
++ has-imp
|= [=trie =imp]
!=(~ (get-imp trie imp))
::
++ put-imp
|= [=trie =imp =imp-form]
^+ trie
?~ imp
trie(imp-form imp-form)
=/ son (~(gut by kid.trie) i.imp [*^imp-form ~])
%= trie
kid
%+ ~(put by kid.trie) i.imp
$(trie son, imp t.imp)
==
::
++ del-imp
|= [=trie =imp]
^+ trie
?~ imp
trie
|-
?~ t.imp
trie(kid (~(del by kid.trie) i.imp))
=/ son (~(get by kid.trie) i.imp)
?~ son
trie
%= trie
kid
%+ ~(put by kid.trie) i.imp
$(trie u.son, imp t.imp)
==
::
++ tap-imp
=| =imp
|= =trie
^- (list [=^imp =imp-form])
%+ welp
?~ imp
~
[imp imp-form.trie]~
=/ kids ~(tap by kid.trie)
|- ^- (list [=^imp =imp-form])
?~ kids
~
=/ next-1 ^$(imp [p.i.kids imp], trie q.i.kids)
=/ next-2 $(kids t.kids)
(welp next-1 next-2)
--
::
^- agent:mall
=| =state
=<
%+ verb &
|_ =bowl:mall
+* this .
spider-core +>
@ -21,15 +116,19 @@
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save on-save:def
++ on-save clean-state:sc
++ on-load
|= old-state=vase
=/ runs ~(tap by running.state)
=+ !<(=clean-slate old-state)
=. count.state count.clean-slate
=. iid.state iid.clean-slate
|- ^- (quip card _this)
?~ runs
?~ running.clean-slate
`this
=^ cards-1 state (handle-stop-imp:sc p.i.runs |)
=^ cards-2 this $(runs t.runs)
=^ cards-1 state
(handle-stop-imp:sc (imp-to-iid i.running.clean-slate) |)
=^ cards-2 this
$(running.clean-slate t.running.clean-slate)
[(weld cards-1 cards-2) this]
::
++ on-poke
@ -38,8 +137,8 @@
=^ cards state
?+ mark (on-poke:def mark vase)
%spider-imput (on-poke-imput:sc !<(imput vase))
%spider-start (handle-start-imp:sc !<([imp-name term ^vase] vase))
%spider-stop (handle-stop-imp:sc !<([imp-name ?] vase))
%spider-start (handle-start-imp:sc !<(start-args vase))
%spider-stop (handle-stop-imp:sc !<([iid ?] vase))
==
[cards this]
::
@ -58,7 +157,14 @@
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %started @ ~] ``noun+!>((~(has by running.state) i.t.t.path))
[%x %tree ~]
``noun+!>((turn (tap-imp running.state) head))
::
[%x %started @ ~]
``noun+!>((has-imp running.state (~(got by iid.state) i.t.t.path)))
::
[%x %saxo @ ~]
``noun+!>((~(got by iid.state) i.t.t.path))
==
::
++ on-agent
@ -87,187 +193,259 @@
|_ =bowl:mall
++ on-poke-imput
|= imput
(take-input imp-name ~ %poke cage)
(take-input imp ~ %poke cage)
::
++ on-watch
|= [=imp-name =path]
(take-input imp-name ~ %watch path)
|= [=iid =path]
(take-input (~(got by iid.state) iid) ~ %watch path)
::
++ on-watch-result
|= =imp-name
|= =iid
^- (quip card ^state)
?> (~(has by started.state) imp-name)
?> (~(has by started.state) (~(got by iid.state) iid))
`state
::
++ handle-sign
|= [=imp-name =wire =sign-arvo]
(take-input imp-name ~ %sign wire sign-arvo)
|= [=iid =wire =sign-arvo]
=/ imp (~(get by iid.state) iid)
?~ imp
%- (slog leaf+"spider got sign for non-existent {<imp>}" ~)
`state
(take-input u.imp ~ %sign wire sign-arvo)
::
++ on-agent
|= [=imp-name =wire =sign:agent:mall]
(take-input imp-name ~ %agent wire sign)
|= [=iid =wire =sign:agent:mall]
=/ imp (~(get by iid.state) iid)
?~ imp
%- (slog leaf+"spider got agent for non-existent {<imp>}" ~)
`state
(take-input u.imp ~ %agent wire sign)
::
++ handle-start-imp
|= [=imp-name =term =vase]
|= [parent-iid=(unit iid) file=term =vase]
^- (quip card ^state)
?: (~(has by running.state) imp-name)
~| [%already-started imp-name]
=/ parent-imp=imp
?~ parent-iid
/
(~(got by iid.state) u.parent-iid)
=/ =imp (snoc parent-imp count.state)
::
?: (has-imp running.state imp)
~| [%already-started imp]
!!
?: (~(has by started.state) imp-name)
~| [%already-starting imp-name]
?: (~(has by started.state) imp)
~| [%already-starting imp]
!!
=. started.state (~(put by started.state) imp-name vase)
=/ new-iid (scot %ud count.state)
=: started.state (~(put by started.state) imp vase)
iid.state (~(put by iid.state) new-iid imp)
count.state +(count.state)
==
=/ =card
=/ =schematic:ford [%path [our.bowl %home] %imp term]
[%pass /find/[imp-name] %arvo %f %build live=%.n schematic]
=/ =schematic:ford [%path [our.bowl %home] %imp file]
[%pass /find/[new-iid] %arvo %f %build live=%.n schematic]
[[card ~] state]
::
++ handle-find
|= [=imp-name =sign-arvo]
|= [=iid =sign-arvo]
^- (quip card ^state)
?> (~(has by started.state) imp-name)
=/ =imp (~(got by iid.state) iid)
?> (~(has by started.state) imp)
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
%- (slog leaf+"{<imp-name>} find incomplete" tang.result.sign-arvo)
%- (slog leaf+"{<imp>} find incomplete" tang.result.sign-arvo)
`state
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
%- (slog leaf+"{<imp-name>} find error" message.build-result)
%- (slog leaf+"{<imp>} find error" message.build-result)
`state
?. ?=([%path *] +.build-result)
%- (slog leaf+"{<imp-name>} find strange" ~)
%- (slog leaf+"{<imp>} find strange" ~)
`state
=/ =card
=/ =schematic:ford [%core rail.build-result]
[%pass /build/[imp-name] %arvo %f %build live=%.y schematic]
[%pass /build/[iid] %arvo %f %build live=%.y schematic]
[[card ~] state]
::
++ handle-build
|= [=imp-name =sign-arvo]
|= [=iid =sign-arvo]
^- (quip card ^state)
?> (~(has by started.state) imp-name)
=/ =imp (~(got by iid.state) iid)
?> (~(has by started.state) imp)
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
%- (slog leaf+"{<imp-name>} build incomplete" tang.result.sign-arvo)
%- (slog leaf+"{<imp>} build incomplete" tang.result.sign-arvo)
`state
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
%- (slog leaf+"{<imp-name>} build error" message.build-result)
%- (slog leaf+"{<imp>} build error" message.build-result)
`state
=/ =cage (result-to-cage:ford build-result)
?. ?=(%noun p.cage)
%- (slog leaf+"{<imp-name>} build not noun, is {<p.cage>}" ~)
%- (slog leaf+"{<imp>} build not noun, is {<p.cage>}" ~)
`state
=/ maybe-imp (mule |.(!<(imp q.cage)))
=/ maybe-imp (mule |.(!<(imp-thread q.cage)))
?: ?=(%| -.maybe-imp)
%- (slog leaf+"{<imp-name>} not valid imp" p.maybe-imp)
%- (slog leaf+"{<imp>} not valid imp" p.maybe-imp)
`state
(start-imp imp-name p.maybe-imp)
(start-imp imp p.maybe-imp)
::
++ start-imp
|= [=imp-name =imp]
|= [=imp =imp-thread]
^- (quip card ^state)
=/ =vase (~(got by started.state) imp-name)
=/ =vase (~(got by started.state) imp)
=^ cards-1 state
?. (~(has by running.state) imp-name)
?. (has-imp running.state imp)
`state
(imp-fail imp-name %updated ~)
(imp-fail imp %updated ~)
=/ m (thread ,^vase)
=/ =eval-form:eval:m (from-form:eval:m (imp bowl vase))
=. running.state (~(put by running.state) imp-name eval-form)
=/ =bowl:spider (convert-bowl imp bowl)
=/ =eval-form:eval:m
(from-form:eval:m (imp-thread bowl vase))
=. running.state (put-imp running.state imp eval-form)
=^ cards-2 state
(take-input imp-name ~)
(take-input imp ~)
[(weld cards-1 cards-2) state]
::
++ handle-stop-imp
|= [=imp-name nice=?]
|= [=iid nice=?]
^- (quip card ^state)
~? !(~(has by running.state) imp-name)
[%not-started imp-name]
=/ =imp (~(got by iid.state) iid)
~? !(has-imp running.state imp)
[%not-started imp]
?: nice
(imp-done imp-name *vase)
(imp-fail imp-name %cancelled ~)
(imp-done imp *vase)
(imp-fail imp %cancelled ~)
::
++ take-input
|= [=imp-name input=(unit input:thread)]
|= [=imp input=(unit input:thread)]
^- (quip card ^state)
=/ m (thread ,vase)
?. (~(has by running.state) imp-name)
%- (slog leaf+"spider got input for non-existent {<imp-name>}" ~)
?. (has-imp running.state imp)
%- (slog leaf+"spider got input for non-existent {<imp>} 2" ~)
`state
=/ =eval-form:eval:m
(~(got by running.state) imp-name)
imp-form:(need (get-imp running.state imp))
=| cards=(list card)
|- ^- (quip card ^state)
=^ r=[cards=(list card) =eval-result:eval:m] eval-form
=/ out
%- mule |.
(take:eval:m eval-form bowl input)
(take:eval:m eval-form (convert-bowl imp bowl) input)
?- -.out
%& p.out
%| [[~ [%fail %crash p.out]] eval-form]
==
=. running.state (~(put by running.state) imp-name eval-form)
=. running.state (put-imp running.state imp eval-form)
=/ =iid (imp-to-iid imp)
=. cards.r
%+ turn cards.r
|= =card
^- ^card
?+ card card
[%pass * *] [%pass [%imp imp-name p.card] q.card]
[%pass * *] [%pass [%imp iid p.card] q.card]
[%give %fact *]
?~ path.p.card
card
card(path.p `[%imp imp-name u.path.p.card])
card(path.p `[%imp iid u.path.p.card])
::
[%give %kick *]
?~ path.p.card
card
card(path.p `[%imp imp-name u.path.p.card])
card(path.p `[%imp iid u.path.p.card])
==
=. cards (weld cards cards.r)
=^ final-cards=(list card) state
?- -.eval-result.r
%next `state
%fail (imp-fail imp-name err.eval-result.r)
%done (imp-done imp-name value.eval-result.r)
%fail (imp-fail imp err.eval-result.r)
%done (imp-done imp value.eval-result.r)
==
[(weld cards final-cards) state]
::
++ imp-fail
|= [=imp-name =term =tang]
|= [=imp =term =tang]
^- (quip card ^state)
%- (slog leaf+"thread {<imp-name>} failed" leaf+<term> tang)
%- (slog leaf+"thread {<imp>} failed" leaf+<term> tang)
=/ =iid (imp-to-iid imp)
=/ fail-cards=(list card)
:~ [%give %fact `/imp-result/[imp-name] %imp-fail !>([term tang])]
[%give %kick `/imp-result/[imp-name] ~]
:~ [%give %fact `/imp-result/[iid] %imp-fail !>([term tang])]
[%give %kick `/imp-result/[iid] ~]
==
=^ cards state (imp-clean imp-name)
=^ cards state (imp-clean imp)
[(weld fail-cards cards) state]
::
++ imp-done
|= [=imp-name =vase]
|= [=imp =vase]
^- (quip card ^state)
%- (slog leaf+"thread {<imp-name>} finished" (sell vase) ~)
%- (slog leaf+"thread {<imp>} finished" (sell vase) ~)
=/ =iid (imp-to-iid imp)
=/ done-cards=(list card)
:~ [%give %fact `/imp-result/[imp-name] %imp-done vase]
[%give %kick `/imp-result/[imp-name] ~]
:~ [%give %fact `/imp-result/[iid] %imp-done vase]
[%give %kick `/imp-result/[iid] ~]
==
=^ cards state (imp-clean imp-name)
=^ cards state (imp-clean imp)
[(weld done-cards cards) state]
::
++ imp-clean
|= =imp-name
|= =imp
^- (quip card ^state)
=. started.state (~(del by started.state) imp-name)
=. running.state (~(del by running.state) imp-name)
=/ children=(list ^imp)
[imp (get-imp-children running.state imp)]
|- ^- (quip card ^state)
?~ children
`state
=^ cards-children state $(children t.children)
=^ cards-our state
=/ =^imp i.children
=/ =iid (imp-to-iid imp)
=: started.state (~(del by started.state) imp)
running.state (del-imp running.state imp)
iid.state (~(del by iid.state) iid)
==
:_ state
:- [%pass /build/[imp-name] %arvo %f %kill ~]
:- [%pass /build/[iid] %arvo %f %kill ~]
%+ murn ~(tap by wex.bowl)
|= [[=wire =ship =term] [acked=? =path]]
^- (unit card)
?. ?& ?=([%imp @ *] wire)
=(imp-name i.t.wire)
=(iid i.t.wire)
==
~
`[%pass wire %agent [ship term] %leave ~]
[(welp cards-children cards-our) state]
::
++ convert-bowl
|= [=imp =bowl:mall]
^- bowl:spider
:* our.bowl
src.bowl
(imp-to-iid imp)
(imp-to-parent imp)
wex.bowl
sup.bowl
eny.bowl
now.bowl
byk.bowl
==
::
++ imp-to-iid
|= =imp
^- iid
=/ fimp (flop imp)
?> ?=([@ *] fimp)
(scot %ud i.fimp)
::
++ imp-to-parent
|= =imp
^- (unit iid)
=/ fimp (flop imp)
?> ?=([@ *] fimp)
?~ t.fimp
~
`(scot %ud i.t.fimp)
::
++ clean-state
!> ^- clean-slate
state(running (turn (tap-imp running.state) head))
--

View File

@ -1,3 +1,3 @@
:- %say
|= [* [name=term vase=$@(~ [vase ~])] ~]
[%spider-start name name ?~(vase *^vase -.vase)]
[%spider-start ~ name ?~(vase *^vase -.vase)]

View File

@ -5,7 +5,7 @@
:: For now, we broadcast every packet to every ship and rely on them
:: to drop them.
::
/- aquarium
/- aquarium, spider
/+ aqua-vane-imp
=, aquarium
=| ships=(list ship)
@ -36,7 +36,7 @@
--
::
%- aqua-vane-imp
|_ =bowl:mall
|_ =bowl:spider
+* this .
++ handle-unix-effect
|= [who=@p ue=unix-effect]

View File

@ -1,4 +1,4 @@
/- aquarium
/- aquarium, spider
/+ aqua-vane-imp
=, aquarium
|%
@ -9,7 +9,7 @@
::
|%
++ pe
|= [bowl:mall who=ship]
|= [bowl:spider who=ship]
=+ (~(gut by piers) who *pier)
=* pier-data -
=| cards=(list card:agent:mall)
@ -86,7 +86,7 @@
--
::
%- aqua-vane-imp
|_ =bowl:mall
|_ =bowl:spider
+* this .
++ handle-unix-effect
|= [who=@p ue=unix-effect:aquarium]

View File

@ -7,7 +7,7 @@
:: ships or otherwise making use of the fact that we can
:: programmatically send events.
::
/- aquarium
/- aquarium, spider
/+ aqua-vane-imp
|%
++ handle-blit
@ -31,7 +31,7 @@
--
::
%- aqua-vane-imp
|_ =bowl:mall
|_ =bowl:spider
+* this .
++ handle-unix-effect
|= [who=@p ue=unix-effect:aquarium]

View File

@ -20,7 +20,7 @@
--
=; core
^- imp:spider
|= =bowl:mall
|= =bowl:spider
=/ m (thread ,~)
^- form:m
;< ~ bind:m (subscribe-our:threadio /effects %aqua /effect)
@ -360,7 +360,7 @@
|- ^- form:m
=* loop $
;< [him=ship =unix-effect] bind:m take-unix-effect:ph-io
;< =bowl:mall bind:m get-bowl:ph-io
;< =bowl:spider bind:m get-bowl:ph-io
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/rift/(scot %da now.bowl)/(scot %p who)/noun

View File

@ -1,6 +1,6 @@
:: Pass-through Eyre driver
::
/- aquarium
/- aquarium, spider
/+ aqua-vane-imp
=, aquarium
|%
@ -11,7 +11,7 @@
::
|%
++ pe
|= [bowl:mall who=ship]
|= [bowl:spider who=ship]
=+ (~(gut by piers) who *pier)
=* pier-data -
=| cards=(list card:agent:mall)
@ -101,7 +101,7 @@
--
::
%- aqua-vane-imp
|_ =bowl:mall
|_ =bowl:spider
+* this .
++ handle-unix-effect
|= [who=@p ue=unix-effect:aquarium]

View File

@ -292,7 +292,7 @@
:: Main
::
^- imp:spider
|= =bowl:mall
|= =bowl:spider
=/ m (thread ,vase)
^- form:m
;< ~ bind:m

View File

@ -2,7 +2,7 @@
/+ *threadio
=, thread=thread:libthread
^- imp:spider
|= [=bowl:mall =vase]
|= [=bowl:spider =vase]
=/ m (thread ,vase)
^- form:m
~& > 'starting azt'

View File

@ -14,7 +14,7 @@
--
::
=< ^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
^- form:m
~& > 'Entering dns loop'

View File

@ -11,7 +11,7 @@
--
=; core
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
^- form:m
~& > 'entering main loop'

View File

@ -2,7 +2,7 @@
/+ threadio
=, thread=thread:spider
^- imp:spider
|= [bowl:mall vase]
|= [bowl:spider vase]
=/ m (thread ,vase)
^- form:m
~& > %first-starting

View File

@ -2,7 +2,7 @@
/+ *threadio
=, thread=thread:spider
=< ^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
^- form:m
~& > 'Entering pH loop'

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall args=vase]
|= [=bowl:spider args=vase]
=/ m (thread ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-azimuth
;< ~ bind:m (spawn ~bud)

View File

@ -2,7 +2,7 @@
/+ *ph-io
=, thread=thread:spider
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)

View File

@ -4,7 +4,7 @@
|%
++ vane-handler
$_ ^|
|_ bowl:mall
|_ bowl:spider
++ handle-unix-effect
|~ [ship unix-effect]
*(quip card:agent:mall _^|(..handle-unix-effect))
@ -18,7 +18,7 @@
=; core
|= handler=vane-handler
^- imp:spider
|= [=bowl:mall vase]
|= [=bowl:spider vase]
=/ m (thread ,vase)
^- form:m
;< ~ bind:m (watch-our:threadio /effects %aqua /effect)
@ -37,7 +37,7 @@
^- form:m
;< [her=ship =unix-effect] bind:m
((handle:threadio ,[ship unix-effect]) take-unix-effect:ph-io)
;< =bowl:mall bind:m get-bowl:threadio
;< =bowl:spider bind:m get-bowl:threadio
=^ cards handler
(~(handle-unix-effect handler bowl) her unix-effect)
?~ cards
@ -55,7 +55,7 @@
^- form:m
;< [=wire =sign-arvo] bind:m
((handle:threadio ,[wire sign-arvo]) take-sign-arvo:threadio)
;< =bowl:mall bind:m get-bowl:threadio
;< =bowl:spider bind:m get-bowl:threadio
=^ cards handler
(~(handle-arvo-response handler bowl) wire sign-arvo)
;< ~ bind:m (send-raw-cards:threadio cards)

View File

@ -1,4 +1,4 @@
/- *aquarium
/- *aquarium, spider
/+ libthread=thread, *threadio, util=ph-util
=, thread=thread:libthread
|%
@ -58,17 +58,13 @@
|= imps=(list term)
=/ m (thread ,~)
^- form:m
;< our=@p bind:m get-our
;< =bowl:spider bind:m get-bowl
|- ^- form:m
=* loop $
?~ imps
(pure:m ~)
;< now=@da bind:m get-time
=/ imp-started
.^(? %mx /(scot %p our)/spider/(scot %da now)/started/[i.imps]/noun)
?: imp-started
loop(imps t.imps)
=/ poke-vase !>([i.imps i.imps *vase])
=/ poke-vase !>([`iid.bowl i.imps *vase])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
loop(imps t.imps)
::
@ -76,19 +72,7 @@
|= imps=(list term)
=/ m (thread ,~)
^- form:m
;< our=@p bind:m get-our
|- ^- form:m
=* loop $
?~ imps
(pure:m ~)
;< now=@da bind:m get-time
=/ imp-started
.^(? %mx /(scot %p our)/spider/(scot %da now)/started/[i.imps]/noun)
?. imp-started
loop(imps t.imps)
=/ poke-vase !>([i.imps &])
;< ~ bind:m (poke-our %spider %spider-stop poke-vase)
loop(imps t.imps)
::
++ spawn
|= =ship

View File

@ -6,7 +6,19 @@
[%agent =wire =sign:agent:mall]
[%watch =path]
==
+$ thread-input [=bowl:mall in=(unit input)]
+$ thread-input [=bowl in=(unit input)]
+$ iid @taiid
+$ bowl
$: our=ship
src=ship
iid=iid
mom=(unit iid)
wex=boat:mall
sup=bitt:mall
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

View File

@ -20,7 +20,7 @@
`[%fail %ignore ~]
::
++ get-bowl
=/ m (thread ,bowl:mall)
=/ m (thread ,bowl:thread)
^- form:m
|= tin=thread-input:thread
`[%done bowl.tin]
@ -389,7 +389,7 @@
|^ (continue bowl.tin)
::
++ continue
|= =bowl:mall
|= =bowl:thread
^- output:m
?> =(~ active)
?: =(~ queue)

29
pkg/arvo/lib/trie.hoon Normal file
View File

@ -0,0 +1,29 @@
|%
++ trie
|$ [key-t val-t]
[val=(unit val-t) kid=(map key-t (trie key-t val-t))]
--
::
=| a=(trie * *)
=* val-t ?>(?=(^ val.a) val.a)
|@
++ put
|* [b=(list *) c=*]
=> .(b (homo b))
|- ^+ a
?~ b
a(val `c)
=/ son (~(gut by kid.a) i.b [~ ~])
a(kid (~(put by kid.a) i.b $(a son, b t.b)))
::
++ get
|* b=(list *)
=> .(b (homo b))
|-
?~ b
[~ val.a]
=/ son (~(get by kid.a) i.b)
?~ son
[b val.a]
$(a u.son, b t.b)
--

View File

@ -1,5 +1,7 @@
/+ libthread=thread
=, thread=thread:libthread
|%
+$ imp $-([bowl:mall vase] _*form:(thread ,vase))
+$ imp $-([bowl vase] _*form:(thread ,vase))
+$ iid iid:thread
+$ bowl bowl:thread
--