2019-09-26 22:00:11 +03:00
|
|
|
/- spider
|
|
|
|
/+ libthread=thread, default-agent
|
2019-09-26 07:12:58 +03:00
|
|
|
=, thread=thread:libthread
|
|
|
|
|%
|
|
|
|
+$ card card:agent:mall
|
|
|
|
+$ state (map imp-name _*eval-form:[~!(. eval)]:(thread ,~))
|
2019-09-26 22:00:11 +03:00
|
|
|
+$ imp imp:spider
|
2019-09-26 07:12:58 +03:00
|
|
|
+$ imp-name term
|
|
|
|
+$ imput [=imp-name =cage]
|
|
|
|
--
|
|
|
|
^- agent:mall
|
2019-11-07 09:19:32 +03:00
|
|
|
=| =state
|
|
|
|
=<
|
2019-09-26 07:12:58 +03:00
|
|
|
|_ =bowl:mall
|
|
|
|
+* this .
|
2019-11-07 09:19:32 +03:00
|
|
|
spider-core +>
|
|
|
|
sc ~(. spider-core bowl)
|
2019-11-09 00:56:35 +03:00
|
|
|
def ~(. (default-agent this %|) bowl)
|
2019-09-26 07:12:58 +03:00
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
++ on-init on-init:def
|
|
|
|
++ on-save on-save:def
|
|
|
|
++ on-load on-load:def
|
|
|
|
++ on-poke
|
2019-09-26 07:12:58 +03:00
|
|
|
|= [=mark =vase]
|
|
|
|
^- (quip card _this)
|
|
|
|
=^ cards state
|
2019-11-07 09:19:32 +03:00
|
|
|
?+ mark (on-poke:def mark vase)
|
|
|
|
%spider-imput (on-poke-imput:sc !<(imput vase))
|
2019-09-26 22:13:01 +03:00
|
|
|
%spider-start (handle-start-imp:sc !<([imp-name term] vase))
|
2019-10-01 06:53:02 +03:00
|
|
|
%spider-stop (handle-stop-imp:sc !<([imp-name ?] vase))
|
2019-09-26 07:12:58 +03:00
|
|
|
==
|
|
|
|
[cards this]
|
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
++ on-watch
|
2019-10-11 01:30:24 +03:00
|
|
|
|= =path
|
|
|
|
^- (quip card _this)
|
|
|
|
=^ cards state
|
2019-11-07 09:19:32 +03:00
|
|
|
?+ path (on-watch:def path)
|
|
|
|
[%imp @ *] (on-watch:sc t.path)
|
2019-10-11 01:30:24 +03:00
|
|
|
==
|
|
|
|
[cards this]
|
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
++ on-leave on-leave:def
|
|
|
|
++ on-peek
|
2019-09-29 07:44:31 +03:00
|
|
|
|= =path
|
|
|
|
^- (unit (unit cage))
|
2019-11-07 09:19:32 +03:00
|
|
|
?+ path (on-peek:def path)
|
2019-09-29 07:44:31 +03:00
|
|
|
[%x %started @ ~] ``noun+!>((~(has by state) i.t.t.path))
|
|
|
|
==
|
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
++ on-agent
|
2019-09-29 07:44:31 +03:00
|
|
|
|= [=wire =gift:agent:mall]
|
|
|
|
^- (quip card _this)
|
|
|
|
=^ cards state
|
|
|
|
?+ wire !!
|
2019-11-07 09:19:32 +03:00
|
|
|
[%imp @ *] (on-agent:sc i.t.wire t.t.wire gift)
|
2019-09-29 07:44:31 +03:00
|
|
|
==
|
|
|
|
[cards this]
|
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
++ on-arvo
|
2019-09-26 07:12:58 +03:00
|
|
|
|= [=wire =sign-arvo]
|
|
|
|
^- (quip card _this)
|
|
|
|
=^ cards state
|
2019-11-07 09:19:32 +03:00
|
|
|
?+ wire (on-arvo:def wire sign-arvo)
|
2019-09-26 22:00:11 +03:00
|
|
|
[%imp @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo)
|
2019-09-29 07:44:31 +03:00
|
|
|
[%find @ ~] (handle-find:sc i.t.wire sign-arvo)
|
2019-09-26 22:00:11 +03:00
|
|
|
[%build @ ~] (handle-build:sc i.t.wire sign-arvo)
|
2019-09-26 07:12:58 +03:00
|
|
|
==
|
|
|
|
[cards this]
|
2019-09-29 07:44:31 +03:00
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
++ on-fail on-fail:def
|
2019-09-26 07:12:58 +03:00
|
|
|
--
|
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
|_ =bowl:mall
|
|
|
|
++ on-poke-imput
|
2019-09-26 07:12:58 +03:00
|
|
|
|= imput
|
|
|
|
(take-input imp-name ~ %poke cage)
|
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
++ on-watch
|
2019-10-11 01:30:24 +03:00
|
|
|
|= [=imp-name =path]
|
2019-11-07 09:19:32 +03:00
|
|
|
(take-input imp-name ~ %watch path)
|
2019-10-11 01:30:24 +03:00
|
|
|
::
|
2019-09-26 07:12:58 +03:00
|
|
|
++ handle-sign
|
|
|
|
|= [=imp-name =wire =sign-arvo]
|
|
|
|
(take-input imp-name ~ %sign wire sign-arvo)
|
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
++ on-agent
|
2019-09-29 07:44:31 +03:00
|
|
|
|= [=imp-name =wire =gift:agent:mall]
|
|
|
|
(take-input imp-name ~ %agent wire gift)
|
|
|
|
::
|
2019-09-26 07:12:58 +03:00
|
|
|
++ handle-start-imp
|
2019-09-26 22:13:01 +03:00
|
|
|
|= [=imp-name =term]
|
2019-09-26 07:12:58 +03:00
|
|
|
^- (quip card ^state)
|
|
|
|
?: (~(has by state) imp-name)
|
|
|
|
~| [%already-started imp-name]
|
|
|
|
!!
|
2019-09-26 22:00:11 +03:00
|
|
|
=/ =card
|
2019-09-29 07:44:31 +03:00
|
|
|
=/ =schematic:ford [%path [our.bowl %home] %imp term]
|
|
|
|
[%pass /find/[imp-name] %arvo %f %build live=%.n schematic]
|
|
|
|
[[card ~] state]
|
|
|
|
::
|
|
|
|
++ handle-find
|
|
|
|
|= [=imp-name =sign-arvo]
|
|
|
|
^- (quip card ^state)
|
|
|
|
?> ?=([%f %made *] sign-arvo)
|
|
|
|
?: ?=(%incomplete -.result.sign-arvo)
|
|
|
|
%- (slog leaf+"{<imp-name>} 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)
|
|
|
|
`state
|
|
|
|
?. ?=([%path *] +.build-result)
|
|
|
|
%- (slog leaf+"{<imp-name>} find strange" ~)
|
|
|
|
`state
|
|
|
|
=/ =card
|
|
|
|
=/ =schematic:ford [%core rail.build-result]
|
2019-09-26 22:00:11 +03:00
|
|
|
[%pass /build/[imp-name] %arvo %f %build live=%.y schematic]
|
|
|
|
[[card ~] state]
|
|
|
|
::
|
|
|
|
++ handle-build
|
|
|
|
|= [=imp-name =sign-arvo]
|
|
|
|
^- (quip card ^state)
|
|
|
|
?> ?=([%f %made *] sign-arvo)
|
|
|
|
?: ?=(%incomplete -.result.sign-arvo)
|
2019-09-27 20:40:22 +03:00
|
|
|
%- (slog leaf+"{<imp-name>} build incomplete" tang.result.sign-arvo)
|
2019-09-26 22:00:11 +03:00
|
|
|
`state
|
|
|
|
=/ =build-result:ford build-result.result.sign-arvo
|
|
|
|
?: ?=(%error -.build-result)
|
2019-09-27 20:40:22 +03:00
|
|
|
%- (slog leaf+"{<imp-name>} build error" message.build-result)
|
2019-09-26 22:00:11 +03:00
|
|
|
`state
|
|
|
|
=/ =cage (result-to-cage:ford build-result)
|
|
|
|
?. ?=(%noun p.cage)
|
2019-09-27 20:40:22 +03:00
|
|
|
%- (slog leaf+"{<imp-name>} build not noun, is {<p.cage>}" ~)
|
2019-09-26 22:00:11 +03:00
|
|
|
`state
|
|
|
|
=/ maybe-imp (mule |.(!<(imp q.cage)))
|
|
|
|
?: ?=(%| -.maybe-imp)
|
2019-09-27 20:40:22 +03:00
|
|
|
%- (slog leaf+"{<imp-name>} not valid imp" p.maybe-imp)
|
2019-09-26 22:00:11 +03:00
|
|
|
`state
|
|
|
|
(start-imp imp-name p.maybe-imp)
|
|
|
|
::
|
|
|
|
++ start-imp
|
|
|
|
|= [=imp-name =imp]
|
|
|
|
^- (quip card ^state)
|
2019-10-01 06:53:02 +03:00
|
|
|
=^ cards-1 state
|
|
|
|
?. (~(has by state) imp-name)
|
|
|
|
`state
|
|
|
|
(imp-done imp-name)
|
2019-09-26 07:12:58 +03:00
|
|
|
=/ m (thread ,~)
|
2019-09-26 22:00:11 +03:00
|
|
|
=/ =eval-form:eval:m (from-form:eval:m (imp bowl))
|
2019-09-26 07:12:58 +03:00
|
|
|
=. state (~(put by state) imp-name eval-form)
|
2019-10-01 06:53:02 +03:00
|
|
|
=^ cards-2 state
|
|
|
|
(take-input imp-name ~)
|
|
|
|
[(weld cards-1 cards-2) state]
|
2019-09-26 07:12:58 +03:00
|
|
|
::
|
2019-09-29 07:44:31 +03:00
|
|
|
++ handle-stop-imp
|
2019-10-01 06:53:02 +03:00
|
|
|
|= [=imp-name nice=?]
|
2019-09-29 07:44:31 +03:00
|
|
|
^- (quip card ^state)
|
2019-10-01 06:53:02 +03:00
|
|
|
~? !(~(has by state) imp-name)
|
|
|
|
[%not-started imp-name]
|
|
|
|
?: nice
|
|
|
|
(imp-done imp-name)
|
2019-09-29 07:44:31 +03:00
|
|
|
(imp-fail imp-name %cancelled ~)
|
|
|
|
::
|
2019-09-26 07:12:58 +03:00
|
|
|
++ take-input
|
|
|
|
|= [=imp-name input=(unit input:thread)]
|
|
|
|
^- (quip card ^state)
|
|
|
|
=/ m (thread ,~)
|
2019-10-01 06:53:02 +03:00
|
|
|
?. (~(has by state) imp-name)
|
2019-10-02 01:06:12 +03:00
|
|
|
:: %- (slog leaf+"spider got input for non-existent {<imp-name>}" ~)
|
2019-10-01 06:53:02 +03:00
|
|
|
`state
|
2019-09-26 07:12:58 +03:00
|
|
|
=/ =eval-form:eval:m
|
|
|
|
(~(got by state) imp-name)
|
|
|
|
=| 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)
|
|
|
|
?- -.out
|
|
|
|
%& p.out
|
|
|
|
%| [[~ [%fail %crash p.out]] eval-form]
|
|
|
|
==
|
|
|
|
=. state (~(put by state) imp-name eval-form)
|
|
|
|
=. cards.r
|
|
|
|
%+ turn cards.r
|
|
|
|
|= =card
|
|
|
|
^- ^card
|
|
|
|
?+ card card
|
|
|
|
[%pass * *] [%pass [%imp imp-name p.card] q.card]
|
2019-11-07 09:19:32 +03:00
|
|
|
[%give %fact *]
|
2019-09-26 07:12:58 +03:00
|
|
|
?~ path.p.card
|
|
|
|
card
|
|
|
|
card(path.p `[%imp imp-name u.path.p.card])
|
|
|
|
::
|
2019-11-07 09:19:32 +03:00
|
|
|
[%give %kick *]
|
2019-09-26 07:12:58 +03:00
|
|
|
?~ path.p.card
|
|
|
|
card
|
|
|
|
card(path.p `[%imp imp-name 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)
|
|
|
|
==
|
|
|
|
[(weld cards final-cards) state]
|
|
|
|
::
|
|
|
|
++ imp-fail
|
|
|
|
|= [=imp-name =term =tang]
|
|
|
|
^- (quip card ^state)
|
|
|
|
%- (slog leaf+"thread {<imp-name>} failed" leaf+<term> tang)
|
2019-10-01 06:53:02 +03:00
|
|
|
(imp-clean imp-name)
|
2019-09-26 07:12:58 +03:00
|
|
|
::
|
|
|
|
++ imp-done
|
|
|
|
|= =imp-name
|
|
|
|
^- (quip card ^state)
|
|
|
|
%- (slog leaf+"thread {<imp-name>} finished" ~)
|
2019-10-01 06:53:02 +03:00
|
|
|
(imp-clean imp-name)
|
|
|
|
::
|
|
|
|
++ imp-clean
|
|
|
|
|= =imp-name
|
|
|
|
^- (quip card ^state)
|
|
|
|
:_ (~(del by state) imp-name)
|
|
|
|
:- [%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)
|
|
|
|
==
|
|
|
|
~
|
2019-11-07 09:19:32 +03:00
|
|
|
`[%pass wire %agent [ship term] %leave ~]
|
2019-09-26 07:12:58 +03:00
|
|
|
--
|