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

View File

@ -1,3 +1,3 @@
:- %say :- %say
|= [* [name=term vase=$@(~ [vase ~])] ~] |= [* [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 :: For now, we broadcast every packet to every ship and rely on them
:: to drop them. :: to drop them.
:: ::
/- aquarium /- aquarium, spider
/+ aqua-vane-imp /+ aqua-vane-imp
=, aquarium =, aquarium
=| ships=(list ship) =| ships=(list ship)
@ -36,7 +36,7 @@
-- --
:: ::
%- aqua-vane-imp %- aqua-vane-imp
|_ =bowl:mall |_ =bowl:spider
+* this . +* this .
++ handle-unix-effect ++ handle-unix-effect
|= [who=@p ue=unix-effect] |= [who=@p ue=unix-effect]

View File

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

View File

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

View File

@ -20,7 +20,7 @@
-- --
=; core =; core
^- imp:spider ^- imp:spider
|= =bowl:mall |= =bowl:spider
=/ m (thread ,~) =/ m (thread ,~)
^- form:m ^- form:m
;< ~ bind:m (subscribe-our:threadio /effects %aqua /effect) ;< ~ bind:m (subscribe-our:threadio /effects %aqua /effect)
@ -360,7 +360,7 @@
|- ^- form:m |- ^- form:m
=* loop $ =* loop $
;< [him=ship =unix-effect] bind:m take-unix-effect:ph-io ;< [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 =/ aqua-pax
:- %i :- %i
/(scot %p her)/j/(scot %p her)/rift/(scot %da now.bowl)/(scot %p who)/noun /(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 :: Pass-through Eyre driver
:: ::
/- aquarium /- aquarium, spider
/+ aqua-vane-imp /+ aqua-vane-imp
=, aquarium =, aquarium
|% |%
@ -11,7 +11,7 @@
:: ::
|% |%
++ pe ++ pe
|= [bowl:mall who=ship] |= [bowl:spider who=ship]
=+ (~(gut by piers) who *pier) =+ (~(gut by piers) who *pier)
=* pier-data - =* pier-data -
=| cards=(list card:agent:mall) =| cards=(list card:agent:mall)
@ -101,7 +101,7 @@
-- --
:: ::
%- aqua-vane-imp %- aqua-vane-imp
|_ =bowl:mall |_ =bowl:spider
+* this . +* this .
++ handle-unix-effect ++ handle-unix-effect
|= [who=@p ue=unix-effect:aquarium] |= [who=@p ue=unix-effect:aquarium]

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -6,7 +6,19 @@
[%agent =wire =sign:agent:mall] [%agent =wire =sign:agent:mall]
[%watch =path] [%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 :: cards: cards to send immediately. These will go out even if a
:: later stage of the computation fails, so they shouldn't have :: later stage of the computation fails, so they shouldn't have

View File

@ -20,7 +20,7 @@
`[%fail %ignore ~] `[%fail %ignore ~]
:: ::
++ get-bowl ++ get-bowl
=/ m (thread ,bowl:mall) =/ m (thread ,bowl:thread)
^- form:m ^- form:m
|= tin=thread-input:thread |= tin=thread-input:thread
`[%done bowl.tin] `[%done bowl.tin]
@ -389,7 +389,7 @@
|^ (continue bowl.tin) |^ (continue bowl.tin)
:: ::
++ continue ++ continue
|= =bowl:mall |= =bowl:thread
^- output:m ^- output:m
?> =(~ active) ?> =(~ active)
?: =(~ queue) ?: =(~ 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 /+ libthread=thread
=, thread=thread:libthread =, thread=thread:libthread
|% |%
+$ imp $-([bowl:mall vase] _*form:(thread ,vase)) +$ imp $-([bowl vase] _*form:(thread ,vase))
+$ iid iid:thread
+$ bowl bowl:thread
-- --