mirror of
https://github.com/urbit/shrub.git
synced 2024-12-25 13:04:17 +03:00
spider: add process tree
This commit is contained in:
parent
ab8ac96702
commit
5c1d68bf44
@ -1,35 +1,134 @@
|
||||
/- 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]
|
||||
+$ card card:agent:mall
|
||||
+$ 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 .
|
||||
+* this .
|
||||
spider-core +>
|
||||
sc ~(. spider-core bowl)
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
sc ~(. spider-core bowl)
|
||||
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]
|
||||
::
|
||||
@ -57,8 +156,15 @@
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
?+ path (on-peek:def path)
|
||||
[%x %started @ ~] ``noun+!>((~(has by running.state) i.t.t.path))
|
||||
?+ path (on-peek:def 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)
|
||||
:_ state
|
||||
:- [%pass /build/[imp-name] %arvo %f %kill ~]
|
||||
%+ murn ~(tap by wex.bowl)
|
||||
|= [[=wire =ship =term] [acked=? =path]]
|
||||
^- (unit card)
|
||||
?. ?& ?=([%imp @ *] wire)
|
||||
=(imp-name i.t.wire)
|
||||
=/ 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/[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))
|
||||
--
|
||||
|
@ -1,3 +1,3 @@
|
||||
:- %say
|
||||
|= [* [name=term vase=$@(~ [vase ~])] ~]
|
||||
[%spider-start name name ?~(vase *^vase -.vase)]
|
||||
[%spider-start ~ name ?~(vase *^vase -.vase)]
|
||||
|
@ -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]
|
||||
|
@ -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]
|
||||
|
@ -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]
|
||||
|
@ -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
|
||||
|
@ -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]
|
||||
|
@ -292,7 +292,7 @@
|
||||
:: Main
|
||||
::
|
||||
^- imp:spider
|
||||
|= =bowl:mall
|
||||
|= =bowl:spider
|
||||
=/ m (thread ,vase)
|
||||
^- form:m
|
||||
;< ~ bind:m
|
||||
|
@ -2,7 +2,7 @@
|
||||
/+ *threadio
|
||||
=, thread=thread:libthread
|
||||
^- imp:spider
|
||||
|= [=bowl:mall =vase]
|
||||
|= [=bowl:spider =vase]
|
||||
=/ m (thread ,vase)
|
||||
^- form:m
|
||||
~& > 'starting azt'
|
||||
|
@ -14,7 +14,7 @@
|
||||
--
|
||||
::
|
||||
=< ^- imp:spider
|
||||
|= [=bowl:mall vase]
|
||||
|= [=bowl:spider vase]
|
||||
=/ m (thread ,vase)
|
||||
^- form:m
|
||||
~& > 'Entering dns loop'
|
||||
|
@ -11,7 +11,7 @@
|
||||
--
|
||||
=; core
|
||||
^- imp:spider
|
||||
|= [=bowl:mall vase]
|
||||
|= [=bowl:spider vase]
|
||||
=/ m (thread ,vase)
|
||||
^- form:m
|
||||
~& > 'entering main loop'
|
||||
|
@ -2,7 +2,7 @@
|
||||
/+ threadio
|
||||
=, thread=thread:spider
|
||||
^- imp:spider
|
||||
|= [bowl:mall vase]
|
||||
|= [bowl:spider vase]
|
||||
=/ m (thread ,vase)
|
||||
^- form:m
|
||||
~& > %first-starting
|
||||
|
@ -2,7 +2,7 @@
|
||||
/+ *threadio
|
||||
=, thread=thread:spider
|
||||
=< ^- imp:spider
|
||||
|= [=bowl:mall vase]
|
||||
|= [=bowl:spider vase]
|
||||
=/ m (thread ,vase)
|
||||
^- form:m
|
||||
~& > 'Entering pH loop'
|
||||
|
@ -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 ~)
|
||||
|
@ -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)
|
||||
|
@ -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 ~)
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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 ~)
|
||||
|
@ -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 ~)
|
||||
|
@ -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)
|
||||
|
@ -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 ~)
|
||||
|
@ -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)
|
||||
|
@ -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 ~)
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
(pure:m ~)
|
||||
::
|
||||
++ spawn
|
||||
|= =ship
|
||||
|
@ -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
|
||||
|
@ -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
29
pkg/arvo/lib/trie.hoon
Normal 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)
|
||||
--
|
@ -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
|
||||
--
|
||||
|
Loading…
Reference in New Issue
Block a user