mirror of
https://github.com/urbit/shrub.git
synced 2024-12-04 14:58:10 +03:00
1711 lines
44 KiB
Plaintext
1711 lines
44 KiB
Plaintext
|
!: :: %gall, agent execution
|
||
|
!? 163
|
||
|
!:
|
||
|
::::
|
||
|
|= pit=vase
|
||
|
=, gall
|
||
|
=> =~
|
||
|
|%
|
||
|
:: +coke: cook
|
||
|
::
|
||
|
++ coke
|
||
|
$? %inn
|
||
|
%out
|
||
|
%cay
|
||
|
==
|
||
|
:: +reverse-ames: reverse ames message
|
||
|
::
|
||
|
++ reverse-ames
|
||
|
$% :: diff
|
||
|
::
|
||
|
[%d p=mark q=*]
|
||
|
:: etc.
|
||
|
::
|
||
|
[%x ~]
|
||
|
==
|
||
|
:: +forward-ames: forward ames message
|
||
|
::
|
||
|
++ forward-ames
|
||
|
$% :: message
|
||
|
::
|
||
|
[%m =mark noun=*]
|
||
|
:: "peel" subscribe
|
||
|
::
|
||
|
[%l =mark =path]
|
||
|
:: subscribe
|
||
|
::
|
||
|
[%s =path]
|
||
|
:: cancel+unsubscribe
|
||
|
::
|
||
|
[%u ~]
|
||
|
==
|
||
|
:: +foreign-response: foreign response
|
||
|
::
|
||
|
++ foreign-response
|
||
|
$? %peer
|
||
|
%peel
|
||
|
%poke
|
||
|
%pull
|
||
|
==
|
||
|
--
|
||
|
|%
|
||
|
:: +internal-note: +ap note
|
||
|
::
|
||
|
++ internal-note
|
||
|
$% [%meta =term =vase]
|
||
|
[%send =ship =internal-task]
|
||
|
==
|
||
|
:: +internal-move: agent-level move
|
||
|
::
|
||
|
:: Analogous to an Arvo move, except these are routed by bone, instead of
|
||
|
:: duct.
|
||
|
::
|
||
|
++ internal-move
|
||
|
$: =bone
|
||
|
move=(wind internal-note internal-gift)
|
||
|
==
|
||
|
:: +move: Arvo-level move
|
||
|
::
|
||
|
++ move
|
||
|
$: =duct
|
||
|
move=(wind note-arvo gift-arvo)
|
||
|
==
|
||
|
--
|
||
|
|%
|
||
|
:: +state-old: upgrade path
|
||
|
::
|
||
|
++ state-old ?(state)
|
||
|
:: +state: all state
|
||
|
::
|
||
|
++ state
|
||
|
$: :: state version
|
||
|
::
|
||
|
%0
|
||
|
:: agents by ship
|
||
|
::
|
||
|
=agents
|
||
|
==
|
||
|
:: +subscribers: subscriber data
|
||
|
::
|
||
|
++ subscribers
|
||
|
$: :: incoming subscribers
|
||
|
::
|
||
|
incoming=bitt
|
||
|
:: outgoing subscribers
|
||
|
::
|
||
|
outgoing=boat
|
||
|
:: queue meter
|
||
|
::
|
||
|
meter=(map bone @ud)
|
||
|
==
|
||
|
:: +agents: ship state
|
||
|
::
|
||
|
++ agents
|
||
|
$: :: system duct
|
||
|
::
|
||
|
system-duct=duct
|
||
|
:: foreign contacts
|
||
|
::
|
||
|
contacts=(map ship foreign)
|
||
|
:: running agents
|
||
|
::
|
||
|
running=(map term running-agent)
|
||
|
:: waiting queue
|
||
|
::
|
||
|
blocked=(map term blocked)
|
||
|
==
|
||
|
:: +routes: new cuff
|
||
|
::
|
||
|
++ routes
|
||
|
$: :: disclosing to
|
||
|
::
|
||
|
disclosing=(unit (set ship))
|
||
|
:: attributed to
|
||
|
::
|
||
|
attributing=ship
|
||
|
==
|
||
|
:: +foreign: foreign connections
|
||
|
::
|
||
|
++ foreign
|
||
|
$: :: index
|
||
|
::
|
||
|
index=@ud
|
||
|
:: by duct
|
||
|
::
|
||
|
index-map=(map duct @ud)
|
||
|
:: by index
|
||
|
::
|
||
|
duct-map=(map @ud duct)
|
||
|
==
|
||
|
:: +ducts: opaque input
|
||
|
::
|
||
|
++ ducts
|
||
|
$: :: bone sequence
|
||
|
::
|
||
|
bone=@ud
|
||
|
:: by duct
|
||
|
::
|
||
|
bone-map=(map duct bone)
|
||
|
:: by bone
|
||
|
::
|
||
|
duct-map=(map bone duct)
|
||
|
==
|
||
|
:: +running-agent: agent state
|
||
|
::
|
||
|
++ running-agent
|
||
|
$: :: cache
|
||
|
::
|
||
|
cache=worm
|
||
|
:: control duct
|
||
|
::
|
||
|
control-duct=duct
|
||
|
:: unstopped
|
||
|
::
|
||
|
live=?
|
||
|
:: statistics
|
||
|
::
|
||
|
=stats
|
||
|
:: subscribers
|
||
|
::
|
||
|
=subscribers
|
||
|
:: agent core
|
||
|
::
|
||
|
=agent
|
||
|
:: running state
|
||
|
::
|
||
|
state=vase
|
||
|
:: update control
|
||
|
::
|
||
|
=beak
|
||
|
:: req'd translations
|
||
|
::
|
||
|
marks=(map bone mark)
|
||
|
:: opaque ducts
|
||
|
::
|
||
|
=ducts
|
||
|
==
|
||
|
:: +agent: app core
|
||
|
::
|
||
|
++ agent
|
||
|
=> |%
|
||
|
+$ move cove
|
||
|
:: [bone (wind note=vase gift=vase)]
|
||
|
+$ step (quip move new-state=vase)
|
||
|
--
|
||
|
$_ ^|
|
||
|
|_ [bowl:gall state=vase]
|
||
|
++ handle-init
|
||
|
*step
|
||
|
::
|
||
|
++ handle-prep
|
||
|
|~ old-state=vase
|
||
|
*step
|
||
|
::
|
||
|
++ handle-poke
|
||
|
|~ in-poke-data=cage
|
||
|
*step
|
||
|
::
|
||
|
++ handle-peer
|
||
|
|~ path
|
||
|
*step
|
||
|
::
|
||
|
++ handle-peek
|
||
|
|~ path
|
||
|
*(unit (unit cage))
|
||
|
::
|
||
|
++ handle-gall
|
||
|
|~ [wire internal-gift:gall]
|
||
|
*step
|
||
|
::
|
||
|
++ handle-take
|
||
|
|~ [wire sign=vase]
|
||
|
*step
|
||
|
::
|
||
|
++ handle-pull
|
||
|
|~ path
|
||
|
*step
|
||
|
--
|
||
|
:: +blocked: blocked tasks
|
||
|
::
|
||
|
++ blocked (qeu (trel duct routes agent-action))
|
||
|
:: +stats: statistics
|
||
|
::
|
||
|
++ stats
|
||
|
$: :: change number
|
||
|
::
|
||
|
change=@ud
|
||
|
:: entropy
|
||
|
::
|
||
|
eny=@uvJ
|
||
|
:: time
|
||
|
::
|
||
|
time=@da
|
||
|
==
|
||
|
--
|
||
|
. ==
|
||
|
=| =state
|
||
|
|= $: :: identity
|
||
|
::
|
||
|
our=ship
|
||
|
:: urban time
|
||
|
::
|
||
|
now=@da
|
||
|
:: entropy
|
||
|
::
|
||
|
eny=@uvJ
|
||
|
:: activate
|
||
|
::
|
||
|
ska=sley
|
||
|
==
|
||
|
~% %gall-top ..is ~
|
||
|
|%
|
||
|
:: +gall-payload: gall payload
|
||
|
::
|
||
|
++ gall-payload +
|
||
|
:: +mo: Arvo-level move handling
|
||
|
::
|
||
|
:: An outer core responsible for routing moves to and from Arvo; it calls
|
||
|
:: an inner core, +ap, to route internal moves to and from agents.
|
||
|
::
|
||
|
++ mo
|
||
|
~% %gall-mo +> ~
|
||
|
|_
|
||
|
$: hen=duct
|
||
|
moves=(list move)
|
||
|
==
|
||
|
++ mo-core .
|
||
|
:: +mo-abed: initialise state with the provided duct.
|
||
|
::
|
||
|
++ mo-abed
|
||
|
|= =duct
|
||
|
^+ mo-core
|
||
|
::
|
||
|
mo-core(hen duct)
|
||
|
:: +mo-abet: resolve moves.
|
||
|
::
|
||
|
++ mo-abet
|
||
|
^- [(list move) _gall-payload]
|
||
|
::
|
||
|
=/ resolved (flop moves)
|
||
|
[resolved gall-payload]
|
||
|
::
|
||
|
:: +mo-boot: ask %ford to build us a core for the specified agent.
|
||
|
::
|
||
|
++ mo-boot
|
||
|
|= [=term =ship =desk]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=/ =case [%da now]
|
||
|
=/ =path
|
||
|
=/ ship (scot %p ship)
|
||
|
=/ case (scot case)
|
||
|
/sys/core/[term]/[ship]/[desk]/[case]
|
||
|
::
|
||
|
=/ =note-arvo
|
||
|
=/ =schematic:ford [%core [ship desk] /hoon/[term]/app]
|
||
|
[%f %build live=%.y schematic]
|
||
|
::
|
||
|
=/ pass [path note-arvo]
|
||
|
(mo-pass pass)
|
||
|
::
|
||
|
:: +mo-pass: prepend a standard %pass to the current list of moves.
|
||
|
::
|
||
|
++ mo-pass
|
||
|
|= pass=(pair path note-arvo)
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=/ =move [hen [%pass pass]]
|
||
|
mo-core(moves [move moves])
|
||
|
:: +mo-give: prepend a standard %give to the current list of moves.
|
||
|
::
|
||
|
++ mo-give
|
||
|
|= =gift:able
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=/ =move [hen [%give gift]]
|
||
|
mo-core(moves [move moves])
|
||
|
:: +mo-contains-valid-bowl: check that a vase contains a valid bowl.
|
||
|
::
|
||
|
++ mo-contains-valid-bowl
|
||
|
~/ %mo-contains-valid-bowl
|
||
|
|= =vase
|
||
|
^- ?
|
||
|
::
|
||
|
=/ maybe-vase (slew 12 vase)
|
||
|
?~ maybe-vase
|
||
|
%.n
|
||
|
=/ =type p.u.maybe-vase
|
||
|
(~(nest ut type) %.n -:!>(*bowl))
|
||
|
:: +mo-receive-core: receives an app core built by %ford.
|
||
|
::
|
||
|
:: Presuming we receive a good core, we first check to see if the agent
|
||
|
:: is already running. If so, we update its beak in %gall's state,
|
||
|
:: initialise an +ap core for the agent, install the core we got from
|
||
|
:: %ford, and then resolve any moves associated with it.
|
||
|
::
|
||
|
:: If we're dealing with a new agent, we create one using the result we
|
||
|
:: got from %ford, add it to the collection of agents %gall is keeping
|
||
|
:: track of, and then do more or less the same procedure as we did for the
|
||
|
:: running agent case.
|
||
|
::
|
||
|
++ mo-receive-core
|
||
|
~/ %mo-receive-core
|
||
|
|= [=term =beak =made-result:ford]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?: ?=([%incomplete *] made-result)
|
||
|
(mo-give %onto %.n tang.made-result)
|
||
|
::
|
||
|
=/ build-result build-result.made-result
|
||
|
::
|
||
|
?: ?=([%error *] build-result)
|
||
|
(mo-give %onto %.n message.build-result)
|
||
|
::
|
||
|
=/ =cage (result-to-cage:ford build-result)
|
||
|
=/ result-vase q.cage
|
||
|
=/ maybe-agent=(unit running-agent)
|
||
|
(~(get by running.agents.state) term)
|
||
|
::
|
||
|
?^ maybe-agent
|
||
|
=/ agent u.maybe-agent(beak beak)
|
||
|
=. running.agents.state
|
||
|
(~(put by running.agents.state) term agent)
|
||
|
=/ =routes [disclosing=~ attributing=our]
|
||
|
=/ app (ap-abed:ap term routes)
|
||
|
=. app (ap-reinstall:app result-vase)
|
||
|
ap-abet:app
|
||
|
::
|
||
|
?. (mo-contains-valid-bowl result-vase)
|
||
|
=/ err [[%leaf "{<term>}: bogus core"] ~]
|
||
|
(mo-give %onto %.n err)
|
||
|
::
|
||
|
=. mo-core (mo-new-agent term beak result-vase)
|
||
|
=/ old mo-core
|
||
|
=/ wag
|
||
|
=/ =routes [disclosing=~ attributing=our]
|
||
|
=/ app (ap-abed:ap term routes)
|
||
|
(ap-prep:app ~)
|
||
|
::
|
||
|
=/ maybe-tang -.wag
|
||
|
=/ app +.wag
|
||
|
?^ maybe-tang
|
||
|
=. mo-core old
|
||
|
(mo-give %onto %.n u.maybe-tang)
|
||
|
::
|
||
|
=. mo-core ap-abet:app
|
||
|
=. mo-core (mo-clear-queue term)
|
||
|
=/ =suss [term %boot now]
|
||
|
(mo-give %onto [%.y suss])
|
||
|
:: +mo-new-agent: create a new agent and add it to %gall's state.
|
||
|
::
|
||
|
:: %gall maintains a collection of running agents. This arm creates a
|
||
|
:: new one with the provided name, beak, and state (held in a vase).
|
||
|
::
|
||
|
++ mo-new-agent
|
||
|
|= [=term =beak =vase]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=/ =ducts
|
||
|
:+ bone=1
|
||
|
bone-map=[[[~ ~] 0] ~ ~]
|
||
|
duct-map=[[0 [~ ~]] ~ ~]
|
||
|
::
|
||
|
=/ running-agent
|
||
|
=/ default-agent *running-agent
|
||
|
%_ default-agent
|
||
|
control-duct hen
|
||
|
beak beak
|
||
|
running-state vase
|
||
|
agent !<(agent vase)
|
||
|
state !>(~)
|
||
|
ducts ducts
|
||
|
==
|
||
|
::
|
||
|
%_ mo-core
|
||
|
running.agents.state (~(put by running.agents.state) term agent)
|
||
|
==
|
||
|
:: +mo-handle-foreign-request: handle a foreign request.
|
||
|
::
|
||
|
:: Handles tasks received on a +call that have come from another ship.
|
||
|
::
|
||
|
++ mo-handle-foreign-request
|
||
|
~/ %mo-handle-foreign-request
|
||
|
|= [=ship =internal-task]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=/ =term p.internal-task
|
||
|
=/ =agent-action q.internal-task
|
||
|
?: ?=(%pump -.agent-action)
|
||
|
::
|
||
|
:: you'd think this would send an ack for the diff
|
||
|
:: that caused this pump. it would, but we already
|
||
|
:: sent it when we got the diff in +mo-handle-sys. then
|
||
|
:: we'd have to save the network duct and connect it
|
||
|
:: to this returning pump.
|
||
|
::
|
||
|
mo-core
|
||
|
::
|
||
|
?: ?=(%peer-not -.agent-action)
|
||
|
=/ =tang p.agent-action
|
||
|
(mo-give %unto %reap (some tang))
|
||
|
::
|
||
|
=^ bone mo-core (mo-assign-bone ship)
|
||
|
=/ =forward-ames
|
||
|
?- -.agent-action
|
||
|
%poke [%m p.p.agent-action q.q.p.agent-action]
|
||
|
%pull [%u ~]
|
||
|
%puff !!
|
||
|
%punk !!
|
||
|
%peel [%l agent-action]
|
||
|
%peer [%s p.agent-action]
|
||
|
==
|
||
|
::
|
||
|
=/ sys-path
|
||
|
=/ action -.agent-action
|
||
|
/sys/way/[action]
|
||
|
::
|
||
|
=/ =note-arvo
|
||
|
=/ =path /g/ge/[term]
|
||
|
=/ =noun [bone forward-ames]
|
||
|
[%a %want ship path noun]
|
||
|
::
|
||
|
(mo-pass sys-path note-arvo)
|
||
|
:: +mo-handle-foreign-response: handle foreign response.
|
||
|
::
|
||
|
:: Handle a received %woot from %ames.
|
||
|
::
|
||
|
++ mo-handle-foreign-response
|
||
|
++ mo-handle-foreign-response
|
||
|
|= [=foreign-response art=(unit ares)]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=/ to-tang
|
||
|
|= =ares
|
||
|
^- tang
|
||
|
?~ ares
|
||
|
~
|
||
|
=/ tape (trip p.u.ares)
|
||
|
[[%leaf tape] q.u.ares]
|
||
|
::
|
||
|
=/ result (bind art to-tang)
|
||
|
?- foreign-response
|
||
|
%peel (mo-give %unto %reap result)
|
||
|
%peer (mo-give %unto %reap result)
|
||
|
%poke (mo-give %unto %coup result)
|
||
|
%pull mo-core
|
||
|
==
|
||
|
:: +mo-assign-bone: assign an outbone to a ship.
|
||
|
::
|
||
|
:: If we know about the ship, we simply use its existing bone. Otherwise
|
||
|
:: we register a new entry for the ship, and use a default bone for it.
|
||
|
::
|
||
|
++ mo-assign-bone
|
||
|
|= =ship
|
||
|
^- [bone _mo-core]
|
||
|
::
|
||
|
=/ =foreign
|
||
|
=/ existing (~(get by contacts.agents.state) ship)
|
||
|
(fall existing [1 ~ ~])
|
||
|
::
|
||
|
=/ existing (~(get by index-map.foreign) hen)
|
||
|
?^ existing
|
||
|
[u.existing mo-core]
|
||
|
::
|
||
|
=/ index index.foreign
|
||
|
=/ contacts
|
||
|
=/ new-foreign
|
||
|
%_ foreign
|
||
|
index +(index)
|
||
|
index-map (~(put by index-map.foreign) hen index)
|
||
|
duct-map (~(put by duct-map.foreign) index hen)
|
||
|
==
|
||
|
(~(put by contacts.agents.state) ship new-foreign)
|
||
|
::
|
||
|
=/ next mo-core(contacts.agents.state contacts)
|
||
|
[index next]
|
||
|
:: +mo-retrieve-duct: retrieve a duct by index.
|
||
|
::
|
||
|
++ mo-retrieve-duct
|
||
|
|= [=ship index=@ud]
|
||
|
^- duct
|
||
|
::
|
||
|
=/ =foreign (~(got by contacts.agents.state) ship)
|
||
|
(~(got by duct-map.foreign) index)
|
||
|
:: +mo-handle-sys: handle a +sign incoming over /sys.
|
||
|
::
|
||
|
:: (Note that /sys implies the +sign should be routed to a vane.)
|
||
|
::
|
||
|
++ mo-handle-sys
|
||
|
~/ %mo-handle-sys
|
||
|
|= [=path =sign-arvo]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?+ -.path !!
|
||
|
%core (mo-handle-sys-core path sign-arvo)
|
||
|
%pel (mo-handle-sys-pel path sign-arvo)
|
||
|
%red (mo-handle-sys-red path sign-arvo)
|
||
|
%rep (mo-handle-sys-rep path sign-arvo)
|
||
|
%req (mo-handle-sys-req path sign-arvo)
|
||
|
%val (mo-handle-sys-val path sign-arvo)
|
||
|
%way (mo-handle-sys-way path sign-arvo)
|
||
|
==
|
||
|
:: +mo-handle-sys-core: receive a core from %ford.
|
||
|
::
|
||
|
++ mo-handle-sys-core
|
||
|
|= [=path =sign-arvo]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?> ?=([%f %made *] sign-arvo)
|
||
|
?> ?=([@ @ @ @ @ ~] path)
|
||
|
=/ beak-path t.t.path
|
||
|
=/ =beak
|
||
|
=/ =ship (slav %p i.beak-path)
|
||
|
=/ =desk i.t.beak-path
|
||
|
=/ =case [%da (slav %da i.t.t.beak-path)]
|
||
|
[ship desk case]
|
||
|
(mo-receive-core i.t.path beak result.sign-arvo)
|
||
|
:: +mo-handle-sys-pel: translated peer.
|
||
|
::
|
||
|
:: Validates a received %ford result and %gives an internal %diff.
|
||
|
::
|
||
|
++ mo-handle-sys-pel
|
||
|
|= [=path =sign-arvo]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?> ?=([%f %made *] sign-arvo)
|
||
|
?> ?=([@ @ ~] path)
|
||
|
::
|
||
|
?: ?=([%incomplete *] result.sign-arvo)
|
||
|
=/ err (some tang.result.sign-arvo)
|
||
|
(mo-give %unto %coup err)
|
||
|
::
|
||
|
=/ build-result build-result.result.sign-arvo
|
||
|
::
|
||
|
?: ?=([%error *] build-result)
|
||
|
=/ err (some message.build-result)
|
||
|
(mo-give %unto %coup err)
|
||
|
::
|
||
|
=/ =cage (result-to-cage:ford build-result)
|
||
|
(mo-give %unto %diff cage)
|
||
|
:: +mo-handle-sys-red: diff ack.
|
||
|
::
|
||
|
:: On receipt of a valid +sign from %ames, we simply pass a %pump
|
||
|
:: acknowledgement internally; otherwise we pass both an internal
|
||
|
:: unsubscribing %pull, plus a %want to %ames, before complaining about a
|
||
|
:: bad message acknowledgment.
|
||
|
::
|
||
|
++ mo-handle-sys-red
|
||
|
|= [=path =sign-arvo]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?> ?=([@ @ @ @ ~] path)
|
||
|
?. ?=([%a %woot *] sign-arvo)
|
||
|
~& [%red-want path]
|
||
|
mo-core
|
||
|
::
|
||
|
=/ him (slav %p i.t.path)
|
||
|
=/ dap i.t.t.path
|
||
|
=/ num (slav %ud i.t.t.t.path)
|
||
|
=/ =coop q.+>.sign-arvo
|
||
|
=/ sys-path
|
||
|
=/ pax [%req t.path]
|
||
|
[%sys pax]
|
||
|
::
|
||
|
?~ coop
|
||
|
=/ =note-arvo
|
||
|
=/ =sock [him our]
|
||
|
=/ =internal-task [dap %pump ~]
|
||
|
=/ =task:able [%deal sock internal-task]
|
||
|
[%g task]
|
||
|
(mo-pass sys-path note-arvo)
|
||
|
::
|
||
|
=/ gall-move=note-arvo
|
||
|
=/ =sock [him our]
|
||
|
=/ =internal-task [dap %pull ~]
|
||
|
=/ =task:able [%deal sock internal-task]
|
||
|
[%g task]
|
||
|
::
|
||
|
=/ ames-move=note-arvo
|
||
|
=/ path [%g %gh dap ~]
|
||
|
=/ =noun [num %x ~]
|
||
|
=/ =task:able:ames [%want him path noun]
|
||
|
[%a task]
|
||
|
::
|
||
|
=. mo-core (mo-pass sys-path gall-move)
|
||
|
=. mo-core (mo-pass sys-path ames-move)
|
||
|
::
|
||
|
?. ?=([~ ~ %mack *] coop)
|
||
|
~& [%diff-bad-ack coop]
|
||
|
mo-core
|
||
|
::
|
||
|
~& [%diff-bad-ack %mack]
|
||
|
=/ print (slog (flop q.,.+>.coop))
|
||
|
(print mo-core)
|
||
|
:: +mo-handle-sys-rep: reverse request.
|
||
|
::
|
||
|
:: On receipt of a valid +sign from %ford, sets state to the appropriate
|
||
|
:: duct and gives an internal %diff containing the +sign payload.
|
||
|
::
|
||
|
++ mo-handle-sys-rep
|
||
|
|= [=path =sign-arvo]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?> ?=([@ @ @ @ ~] path)
|
||
|
?> ?=([%f %made *] sign-arvo)
|
||
|
=/ him (slav %p i.t.path)
|
||
|
=/ dap i.t.t.path
|
||
|
=/ num (slav %ud i.t.t.t.path)
|
||
|
::
|
||
|
?: ?=([%incomplete *] result.sign-arvo)
|
||
|
=/ err (some tang.result.sign-arvo)
|
||
|
(mo-give %mack err)
|
||
|
::
|
||
|
=/ build-result build-result.result.sign-arvo
|
||
|
?: ?=([%error *] build-result)
|
||
|
:: XX should crash
|
||
|
=/ err (some message.build-result)
|
||
|
(mo-give %mack err)
|
||
|
:: XX pump should ack
|
||
|
=. mo-core (mo-give %mack ~)
|
||
|
=/ duct (mo-retrieve-duct him num)
|
||
|
=. mo-core (mo-abed duct)
|
||
|
=/ =cage (result-to-cage:ford build-result)
|
||
|
=/ move [%unto [%diff cage]]
|
||
|
(mo-give move)
|
||
|
:: +mo-handle-sys-req: process an inbound request.
|
||
|
::
|
||
|
++ mo-handle-sys-req
|
||
|
|= [=path =sign-arvo]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?> ?=([@ @ @ @ ~] path)
|
||
|
=/ him (slav %p i.t.path)
|
||
|
=/ dap i.t.t.path
|
||
|
=/ num (slav %ud i.t.t.t.path)
|
||
|
::
|
||
|
?: ?=([%f %made *] sign-arvo)
|
||
|
?: ?=([%incomplete *] result.sign-arvo)
|
||
|
=/ err (some tang.result.sign-arvo)
|
||
|
(mo-give %mack err)
|
||
|
::
|
||
|
=/ build-result build-result.result.sign-arvo
|
||
|
?: ?=([%error *] build-result)
|
||
|
=/ err (some message.build-result)
|
||
|
(mo-give %mack err)
|
||
|
::
|
||
|
=/ sys-path [%sys path]
|
||
|
=/ =note-arvo
|
||
|
=/ =cage (result-to-cage:ford build-result)
|
||
|
[%g %deal [him our] i.t.t.path %poke cage]
|
||
|
(mo-pass sys-path note-arvo)
|
||
|
::
|
||
|
?: ?=([%a %woot *] sign-arvo)
|
||
|
mo-core
|
||
|
::
|
||
|
?> ?=([%g %unto *] sign-arvo)
|
||
|
=/ =internal-gift +>.sign-arvo
|
||
|
::
|
||
|
?- -.internal-gift
|
||
|
%coup
|
||
|
(mo-give %mack p.internal-gift)
|
||
|
::
|
||
|
%diff
|
||
|
=/ sys-path [%sys %red t.path]
|
||
|
=/ =note-arvo
|
||
|
=/ path [%g %gh dap ~]
|
||
|
=/ noun [num %d p.p.internal-gift q.q.p.internal-gift]
|
||
|
[%a %want him path noun]
|
||
|
(mo-pass sys-path note-arvo)
|
||
|
::
|
||
|
%quit
|
||
|
=/ sys-path [%sys path]
|
||
|
=/ =note-arvo
|
||
|
=/ path [%g %gh dap ~]
|
||
|
=/ noun [num %x ~]
|
||
|
[%a %want him path noun]
|
||
|
(mo-pass sys-path note-arvo)
|
||
|
::
|
||
|
%reap
|
||
|
(mo-give %mack p.internal-gift)
|
||
|
::
|
||
|
%http-response
|
||
|
!!
|
||
|
==
|
||
|
:: +mo-handle-sys-val: inbound validate.
|
||
|
::
|
||
|
:: Validates an incoming +sign from %ford and applies it to the specified
|
||
|
:: agent.
|
||
|
::
|
||
|
++ mo-handle-sys-val
|
||
|
|= [=path =sign-arvo]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?> ?=([%f %made *] sign-arvo)
|
||
|
?> ?=([@ @ @ ~] path)
|
||
|
=/ =ship (slav %p i.t.path)
|
||
|
=/ =term i.t.t.path
|
||
|
?: ?=([%incomplete *] result.sign-arvo)
|
||
|
=/ err (some tang.result.sign-arvo)
|
||
|
(mo-give %unto %coup err)
|
||
|
::
|
||
|
=/ build-result build-result.result.sign-arvo
|
||
|
?: ?=([%error *] build-result)
|
||
|
=/ err (some message.build-result)
|
||
|
(mo-give %unto %coup err)
|
||
|
::
|
||
|
=/ =routes [disclosing=~ attributing=ship]
|
||
|
=/ =cage (result-to-cage:ford build-result)
|
||
|
=/ =agent-action [%poke cage]
|
||
|
(mo-apply term routes agent-action)
|
||
|
:: +mo-handle-sys-way: outbound request.
|
||
|
::
|
||
|
++ mo-handle-sys-way
|
||
|
|= [=path =sign-arvo]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?> ?=([%a %woot *] sign-arvo)
|
||
|
?> ?=([@ @ ~] path)
|
||
|
=/ =foreign-response (foreign-response i.t.path)
|
||
|
=/ maybe-ares +>+.sign-arvo
|
||
|
(mo-handle-foreign-response foreign-response maybe-ares)
|
||
|
:: +mo-handle-use: handle a typed +sign incoming on /use.
|
||
|
::
|
||
|
:: (Note that /use implies the +sign should be routed to an agent.)
|
||
|
::
|
||
|
:: Initialises the specified agent and then performs an agent-level +take
|
||
|
:: on the supplied +sign.
|
||
|
::
|
||
|
++ mo-handle-use
|
||
|
~/ %mo-handle-use
|
||
|
|= [=path hin=(hypo sign-arvo)]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?. ?=([@ @ coke *] path)
|
||
|
~& [%mo-handle-use-bad-path path]
|
||
|
!!
|
||
|
::
|
||
|
=/ app
|
||
|
=/ =term i.path
|
||
|
=/ =ship (slav %p i.t.path)
|
||
|
=/ =routes [disclosing=~ attributing=ship]
|
||
|
(ap-abed:ap term routes)
|
||
|
::
|
||
|
=/ =sign-arvo q.hin
|
||
|
?- i.t.t.path
|
||
|
%inn
|
||
|
=/ =vase (slot 3 hin)
|
||
|
=. app (ap-generic-take:app t.t.t.path vase)
|
||
|
ap-abet:app
|
||
|
::
|
||
|
%cay
|
||
|
~& [%mo-handle-use-weird sign-arvo]
|
||
|
~& [%mo-handle-use-weird-path path]
|
||
|
mo-core
|
||
|
::
|
||
|
%out
|
||
|
?. ?=([%g %unto *] sign-arvo)
|
||
|
~& [%mo-handle-use-weird sign-arvo]
|
||
|
~& [%mo-handle-use-weird-path path]
|
||
|
mo-core
|
||
|
=. app
|
||
|
=/ =internal-gift +>.sign-arvo
|
||
|
(ap-specific-take:app t.t.t.path internal-gift)
|
||
|
ap-abet:app
|
||
|
==
|
||
|
:: +mo-clear-queue: clear blocked tasks from the specified running agent.
|
||
|
::
|
||
|
++ mo-clear-queue
|
||
|
|= =term
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?. (~(has by running.agents.state) term)
|
||
|
mo-core
|
||
|
=/ maybe-blocked (~(get by blocked.agents.state) term)
|
||
|
?~ maybe-blocked
|
||
|
mo-core
|
||
|
::
|
||
|
=/ =blocked u.maybe-blocked
|
||
|
::
|
||
|
|- ^+ mo-core
|
||
|
?: =(~ blocked)
|
||
|
=/ blocked (~(del by blocked.agents.state) term)
|
||
|
%_ mo-core
|
||
|
blocked.agents.state blocked
|
||
|
==
|
||
|
=^ task blocked [p q]:~(get to blocked)
|
||
|
=/ =duct p.task
|
||
|
=/ =routes q.task
|
||
|
=/ =agent-action r.task
|
||
|
::
|
||
|
=/ move
|
||
|
=/ =sock [attributing.routes our]
|
||
|
=/ =internal-task [term agent-action]
|
||
|
=/ card [%slip %g %deal sock internal-task]
|
||
|
[duct card]
|
||
|
$(moves [move moves])
|
||
|
:: +mo-beak: assemble a beak for the specified agent.
|
||
|
::
|
||
|
++ mo-beak
|
||
|
|= =term
|
||
|
^- beak
|
||
|
::
|
||
|
?~ running=(~(get by running.agents.state) term)
|
||
|
:: XX this fallback is necessary, as .term could be either the source
|
||
|
:: or the destination app. ie, it might not exist locally ...
|
||
|
::
|
||
|
[our %home %da now]
|
||
|
beak.u.running
|
||
|
:: +mo-peek: call to +ap-peek (which is not accessible outside of +mo).
|
||
|
::
|
||
|
++ mo-peek
|
||
|
~/ %mo-peek
|
||
|
|= [agent=term =routes =term =path]
|
||
|
^- (unit (unit cage))
|
||
|
::
|
||
|
=/ app (ap-abed:ap agent routes)
|
||
|
(ap-peek:app term path)
|
||
|
:: +mo-apply: apply the supplied action to the specified agent.
|
||
|
::
|
||
|
++ mo-apply
|
||
|
|= [=term =routes =agent-action]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=/ =path
|
||
|
=/ ship (scot %p attributing.routes)
|
||
|
/sys/val/[ship]/[term]
|
||
|
::
|
||
|
=/ ship-desk
|
||
|
=/ =beak (mo-beak term)
|
||
|
[p q]:beak
|
||
|
::
|
||
|
?: ?=(%puff -.agent-action)
|
||
|
=/ =schematic:ford [%vale ship-desk +.agent-action]
|
||
|
=/ =note-arvo [%f %build live=%.n schematic]
|
||
|
(mo-pass path note-arvo)
|
||
|
::
|
||
|
?: ?=(%punk -.agent-action)
|
||
|
=/ =schematic:ford [%cast ship-desk p.agent-action [%$ q.agent-action]]
|
||
|
=/ =note-arvo [%f %build live=%.n schematic]
|
||
|
(mo-pass path note-arvo)
|
||
|
::
|
||
|
?: ?=(%peer-not -.agent-action)
|
||
|
=/ err (some p.agent-action)
|
||
|
(mo-give %unto %reap err)
|
||
|
::
|
||
|
=/ app (ap-abed:ap term routes)
|
||
|
=. app (ap-apply:app agent-action)
|
||
|
ap-abet:app
|
||
|
:: +mo-handle-local: handle locally.
|
||
|
::
|
||
|
:: If the agent is running or blocked, assign it the supplied +task.
|
||
|
:: Otherwise simply apply the action to the agent.
|
||
|
::
|
||
|
++ mo-handle-local
|
||
|
|= [=ship =internal-task]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=/ =routes [disclosing=~ attributing=ship]
|
||
|
=/ =term p.internal-task
|
||
|
=/ =agent-action q.internal-task
|
||
|
=/ is-running (~(has by running.agents.state) term)
|
||
|
=/ is-blocked (~(has by blocked.agents.state) term)
|
||
|
::
|
||
|
?: |(!is-running is-blocked)
|
||
|
=/ =blocked
|
||
|
=/ waiting (~(get by blocked.agents.state) term)
|
||
|
=/ tasks (fall waiting *blocked)
|
||
|
=/ task [hen routes agent-action]
|
||
|
(~(put to tasks) task)
|
||
|
::
|
||
|
%_ mo-core
|
||
|
blocked.agents.state (~(put by blocked.agents.state) term blocked)
|
||
|
==
|
||
|
(mo-apply term routes agent-action)
|
||
|
:: +mo-handle-forward: handle forward %ames message.
|
||
|
::
|
||
|
++ mo-handle-forward
|
||
|
|= [=ship =term =bone =forward-ames]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=. mo-core
|
||
|
?. ?=(%u -.forward-ames)
|
||
|
mo-core
|
||
|
(mo-give %mack ~)
|
||
|
::
|
||
|
=/ =path
|
||
|
=/ him (scot %p ship)
|
||
|
=/ num (scot %ud bone)
|
||
|
/sys/req/[him]/[term]/[num]
|
||
|
::
|
||
|
=/ =sock [ship our]
|
||
|
=/ =note-arvo
|
||
|
?- -.forward-ames
|
||
|
%m
|
||
|
=/ =task:able
|
||
|
=/ =internal-task [term %puff [mark noun]:forward-ames]
|
||
|
[%deal sock internal-task]
|
||
|
[%g task]
|
||
|
::
|
||
|
%l
|
||
|
=/ =task:able
|
||
|
=/ =internal-task [term %peel [mark path]:forward-ames]
|
||
|
[%deal sock internal-task]
|
||
|
[%g task]
|
||
|
::
|
||
|
%s
|
||
|
=/ =task:able
|
||
|
=/ =internal-task [term %peer path.forward-ames]
|
||
|
[%deal sock internal-task]
|
||
|
[%g task]
|
||
|
::
|
||
|
%u
|
||
|
=/ =task:able
|
||
|
=/ =internal-task [term %pull ~]
|
||
|
[%deal sock internal-task]
|
||
|
[%g task]
|
||
|
==
|
||
|
(mo-pass path note-arvo)
|
||
|
:: +mo-handle-backward: handle reverse %ames message.
|
||
|
::
|
||
|
++ mo-handle-backward
|
||
|
|= [=ship =term =bone =reverse-ames]
|
||
|
^+ mo-core
|
||
|
::
|
||
|
?- -.reverse-ames
|
||
|
%d
|
||
|
=/ =path
|
||
|
=/ him (scot %p ship)
|
||
|
=/ num (scot %ud bone)
|
||
|
/sys/rep/[him]/[term]/[num]
|
||
|
::
|
||
|
=/ =note-arvo
|
||
|
=/ beak (mo-beak term)
|
||
|
=/ info [p q]:beak
|
||
|
=/ =schematic:ford [%vale info p.reverse-ames q.reverse-ames]
|
||
|
[%f %build live=%.n schematic]
|
||
|
::
|
||
|
(mo-pass path note-arvo)
|
||
|
::
|
||
|
%x
|
||
|
:: XX should crash
|
||
|
=. mo-core (mo-give %mack ~)
|
||
|
=/ initialised
|
||
|
=/ out (mo-retrieve-duct ship bone)
|
||
|
(mo-abed out)
|
||
|
(mo-give:initialised %unto %quit ~)
|
||
|
==
|
||
|
:: +ap: agent engine
|
||
|
::
|
||
|
:: An inner, agent-level core. The sample refers to the agent we're
|
||
|
:: currently focused on.
|
||
|
::
|
||
|
++ ap
|
||
|
~% %gall-ap +> ~
|
||
|
|_ $: agent-name=term
|
||
|
agent-routes=routes
|
||
|
agent-bone=bone
|
||
|
agent-moves=(list internal-move)
|
||
|
agent-config=(list (each suss tang))
|
||
|
current-agent=running-agent
|
||
|
==
|
||
|
++ ap-core .
|
||
|
:: +ap-abed: initialise state for an agent, with the supplied routes.
|
||
|
::
|
||
|
:: The agent must already be running in +gall -- here we simply update
|
||
|
:: +ap's state to focus on it.
|
||
|
::
|
||
|
++ ap-abed
|
||
|
~/ %ap-abed
|
||
|
|= [=term =routes]
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=/ =running-agent
|
||
|
=/ running (~(got by running.agents.state) term)
|
||
|
=/ =stats
|
||
|
:+ +(change.stats.running)
|
||
|
(shaz (mix (add term change.stats.running) eny))
|
||
|
now
|
||
|
running(stats stats)
|
||
|
::
|
||
|
=. agent-name term
|
||
|
=. agent-routes routes
|
||
|
=. current-agent running-agent
|
||
|
=/ maybe-bone (~(get by bone-map.ducts.running-agent) hen)
|
||
|
?^ maybe-bone
|
||
|
ap-core(agent-bone u.maybe-bone)
|
||
|
::
|
||
|
=/ =ducts
|
||
|
:+ +(bone.ducts.running-agent)
|
||
|
(~(put by bone-map.ducts.running-agent) hen bone.ducts.running-agent)
|
||
|
(~(put by duct-map.ducts.running-agent) bone.ducts.running-agent hen)
|
||
|
::
|
||
|
%_ ap-core
|
||
|
agent-bone bone.ducts.running-agent
|
||
|
ducts.current-agent ducts
|
||
|
==
|
||
|
:: +ap-abet: resolve moves.
|
||
|
::
|
||
|
++ ap-abet
|
||
|
^+ mo-core
|
||
|
::
|
||
|
=> ap-track-queue
|
||
|
=/ running (~(put by running.agents.state) agent-name current-agent)
|
||
|
=/ moves
|
||
|
=/ giver |=(report=(each suss tang) [hen %give %onto report])
|
||
|
=/ from-internal (turn agent-moves ap-from-internal)
|
||
|
=/ from-suss (turn agent-config giver)
|
||
|
:(weld from-internal from-suss moves)
|
||
|
::
|
||
|
%_ mo-core
|
||
|
running.agents.state running
|
||
|
moves moves
|
||
|
==
|
||
|
:: +ap-track-queue: track queue.
|
||
|
::
|
||
|
++ ap-track-queue
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=/ internal-moves agent-moves
|
||
|
=/ bones *(set bone)
|
||
|
|- ^+ ap-core
|
||
|
?^ internal-moves
|
||
|
=/ =internal-move i.internal-moves
|
||
|
?. ?=([%give %diff *] move.internal-move)
|
||
|
$(internal-moves t.internal-moves)
|
||
|
::
|
||
|
=^ filled ap-core ap-enqueue(agent-bone bone.internal-move)
|
||
|
=/ new-bones
|
||
|
?: filled
|
||
|
bones
|
||
|
(~(put in bones) bone.internal-move)
|
||
|
$(internal-moves t.internal-moves, bones new-bones)
|
||
|
::
|
||
|
=/ bones ~(tap in bones)
|
||
|
::
|
||
|
|- ^+ ap-core
|
||
|
?~ bones
|
||
|
ap-core
|
||
|
::
|
||
|
=> $(bones t.bones, agent-bone i.bones)
|
||
|
=/ incoming
|
||
|
(~(get by incoming.subscribers.current-agent) agent-bone)
|
||
|
?~ incoming
|
||
|
~& [%ap-track-queue-bad-bone agent-name agent-bone]
|
||
|
ap-core
|
||
|
::
|
||
|
=/ =ship p.u.incoming
|
||
|
ap-kill(attributing.agent-routes ship)
|
||
|
:: +ap-from-internal: internal move to move.
|
||
|
::
|
||
|
:: We convert from bone-indexed moves to duct-indexed moves when
|
||
|
:: resolving them in Arvo.
|
||
|
::
|
||
|
++ ap-from-internal
|
||
|
~/ %ap-from-internal
|
||
|
|= =internal-move
|
||
|
^- move
|
||
|
::
|
||
|
~| [%gall-move-conversion-failed internal-move]
|
||
|
=/ =duct
|
||
|
(~(got by duct-map.ducts.current-agent) bone.internal-move)
|
||
|
::
|
||
|
=/ card
|
||
|
?- -.move.internal-move
|
||
|
%slip !!
|
||
|
::
|
||
|
%give
|
||
|
?< =(0 bone.internal-move)
|
||
|
::
|
||
|
=/ =internal-gift p.move.internal-move
|
||
|
?. ?=(%diff -.internal-gift)
|
||
|
[%give %unto internal-gift]
|
||
|
::
|
||
|
=/ =cage p.internal-gift
|
||
|
=/ =mark
|
||
|
=/ mark (~(get by marks.current-agent) bone.internal-move)
|
||
|
(fall mark p.cage)
|
||
|
::
|
||
|
?: =(mark p.cage)
|
||
|
[%give %unto internal-gift]
|
||
|
=/ =path /sys/pel/[agent-name]
|
||
|
=/ =note-arvo
|
||
|
=/ =schematic:ford
|
||
|
=/ =beak (mo-beak agent-name)
|
||
|
[%cast [p q]:beak mark [%$ cage]]
|
||
|
[%f %build live=%.n schematic]
|
||
|
::
|
||
|
[%pass path note-arvo]
|
||
|
::
|
||
|
%pass
|
||
|
=/ =path p.move.internal-move
|
||
|
=/ =internal-note q.move.internal-move
|
||
|
=/ use-path [%use agent-name path]
|
||
|
=/ =note-arvo
|
||
|
?- -.internal-note
|
||
|
%send
|
||
|
=/ =task:able
|
||
|
=/ =sock [our ship.internal-note]
|
||
|
=/ =internal-task internal-task.internal-note
|
||
|
[%deal sock internal-task]
|
||
|
[%g task]
|
||
|
::
|
||
|
%meta
|
||
|
=/ =term term.internal-note
|
||
|
=/ =vase vase.internal-note
|
||
|
[term %meta vase]
|
||
|
==
|
||
|
[%pass use-path note-arvo]
|
||
|
==
|
||
|
[duct card]
|
||
|
:: +ap-agent-core: agent core with current bowl and state
|
||
|
::
|
||
|
++ ap-agent-core
|
||
|
~(. agent.current-agent ap-construct-bowl state.current-agent)
|
||
|
:: +ap-apply: apply effect.
|
||
|
::
|
||
|
++ ap-apply
|
||
|
|= =agent-action
|
||
|
^+ ap-core
|
||
|
::
|
||
|
?- -.agent-action
|
||
|
%peel (ap-peel +.agent-action)
|
||
|
%poke (ap-poke +.agent-action)
|
||
|
%peer (ap-peer +.agent-action)
|
||
|
%puff !!
|
||
|
%punk !!
|
||
|
%peer-not !!
|
||
|
%pull ap-load-delete
|
||
|
%pump ap-dequeue
|
||
|
==
|
||
|
:: +ap-peek: peek.
|
||
|
::
|
||
|
++ ap-peek
|
||
|
~/ %ap-peek
|
||
|
|= [=term tyl=path]
|
||
|
^- (unit (unit cage))
|
||
|
::
|
||
|
=/ peek-result=(each (unit (unit cage)) tang)
|
||
|
(mule |.((handle-peek:ap-agent-core [term tyl])))
|
||
|
::
|
||
|
?- -.peek-result
|
||
|
%& p.peek-result
|
||
|
%| ((slog leaf+"peek bad result" p.peek-result) [~ ~])
|
||
|
--
|
||
|
:: +ap-update-subscription: update subscription.
|
||
|
::
|
||
|
++ ap-update-subscription
|
||
|
~/ %ap-update-subscription
|
||
|
|= [is-ok=? =ship =path]
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=/ way [(scot %p ship) %out path]
|
||
|
::
|
||
|
?: is-ok
|
||
|
=/ =internal-note [%send ship -.path %pump ~]
|
||
|
(ap-pass way internal-note)
|
||
|
=. ap-core (ap-give %quit ~)
|
||
|
=/ =internal-note [%send ship -.path %pull ~]
|
||
|
(ap-pass way internal-note)
|
||
|
:: +ap-dequeue: drop from queue.
|
||
|
::
|
||
|
:: Dequeues along the current bone, deleting the queue entirely if it
|
||
|
:: drops to zero.
|
||
|
::
|
||
|
++ ap-dequeue
|
||
|
^+ ap-core
|
||
|
::
|
||
|
?. (~(has by incoming.subscribers.current-agent) agent-bone)
|
||
|
ap-core
|
||
|
=/ level (~(get by meter.subscribers.current-agent) agent-bone)
|
||
|
?: |(?=(~ level) =(0 u.level))
|
||
|
ap-core
|
||
|
::
|
||
|
=. u.level (dec u.level)
|
||
|
?: =(0 u.level)
|
||
|
=/ deleted (~(del by meter.subscribers.current-agent) agent-bone)
|
||
|
ap-core(meter.subscribers.current-agent deleted)
|
||
|
::
|
||
|
=/ dequeued
|
||
|
(~(put by meter.subscribers.current-agent) agent-bone u.level)
|
||
|
ap-core(meter.subscribers.current-agent dequeued)
|
||
|
:: +ap-enqueue: add to queue.
|
||
|
::
|
||
|
:: Every agent has a 'meter', that tracks the number of incoming
|
||
|
:: subscribers by bone. We get both the meter and ship associated with
|
||
|
:: the current bone; if the meter has hit twenty for another ship, we
|
||
|
:: don't enqueue the subscriber. Otherwise we increment the meter for
|
||
|
:: the current bone and update the agent's state with it.
|
||
|
::
|
||
|
:: Returns a yes if the meter has been incremented, and no otherwise.
|
||
|
::
|
||
|
++ ap-enqueue
|
||
|
^- [? _ap-core]
|
||
|
::
|
||
|
=/ meter (~(gut by meter.subscribers.current-agent) agent-bone 0)
|
||
|
=/ subscriber=(unit (pair ship path))
|
||
|
(~(get by incoming.subscribers.current-agent) agent-bone)
|
||
|
::
|
||
|
?: ?& =(20 meter)
|
||
|
?| ?=(~ subscriber)
|
||
|
!=(our p.u.subscriber)
|
||
|
==
|
||
|
==
|
||
|
=/ incoming (~(get by incoming.subscribers.current-agent) agent-bone)
|
||
|
=/ duct (~(get by duct-map.ducts.current-agent) agent-bone)
|
||
|
~& [%gall-pulling-20 agent-bone incoming duct]
|
||
|
[%.n ap-core]
|
||
|
::
|
||
|
=/ next
|
||
|
=/ meter
|
||
|
(~(put by meter.subscribers.current-agent) agent-bone +(meter))
|
||
|
ap-core(meter.subscribers.current-agent meter)
|
||
|
::
|
||
|
[%.y next]
|
||
|
:: +ap-give: return result.
|
||
|
::
|
||
|
++ ap-give
|
||
|
|= =internal-gift
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=/ internal-moves
|
||
|
=/ move [%give internal-gift]
|
||
|
=/ =internal-move [agent-bone move]
|
||
|
[internal-move agent-moves]
|
||
|
ap-core(agent-moves internal-moves)
|
||
|
:: +ap-construct-bowl: set up bowl.
|
||
|
::
|
||
|
++ ap-construct-bowl
|
||
|
^- bowl
|
||
|
:* :* our :: host
|
||
|
attributing.agent-routes :: guest
|
||
|
agent-name :: agent
|
||
|
== ::
|
||
|
:* :: NB (jtobin): see urbit/urbit#1466
|
||
|
wex=~ :: outgoing
|
||
|
sup=incoming.subscribers.current-agent :: incoming
|
||
|
== ::
|
||
|
:* agent-bone=agent-bone :: cause
|
||
|
act=change.stats.current-agent :: tick
|
||
|
eny=eny.stats.current-agent :: nonce
|
||
|
now=time.stats.current-agent :: time
|
||
|
byk=beak.current-agent :: source
|
||
|
== ==
|
||
|
:: +ap-pass: request action.
|
||
|
::
|
||
|
++ ap-pass
|
||
|
|= [=path =internal-note]
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=/ =internal-move
|
||
|
=/ move [%pass path internal-note]
|
||
|
[agent-bone move]
|
||
|
=/ internal-moves [internal-move agent-moves]
|
||
|
ap-core(agent-moves internal-moves)
|
||
|
:: +ap-reinstall: reinstall.
|
||
|
::
|
||
|
++ ap-reinstall
|
||
|
~/ %ap-reinstall
|
||
|
|= =vase
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=/ prep
|
||
|
=/ =agent !<(agent vase)
|
||
|
=/ installed ap-install(agent.current-agent agent)
|
||
|
=/ running (some state.current-agent)
|
||
|
(installed running)
|
||
|
::
|
||
|
=^ maybe-tang ap-core prep
|
||
|
?~ maybe-tang
|
||
|
ap-core
|
||
|
(ap-lame %prep-failed u.maybe-tang)
|
||
|
:: +ap-peel: apply %peel.
|
||
|
::
|
||
|
++ ap-peel
|
||
|
|= [=mark =path]
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=. marks.current-agent (~(put by marks.current-agent) agent-bone mark)
|
||
|
(ap-peer path)
|
||
|
:: +ap-peer: apply %peer.
|
||
|
::
|
||
|
++ ap-peer
|
||
|
~/ %ap-peer
|
||
|
|= pax=path
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=/ incoming [attributing.agent-routes pax]
|
||
|
=. incoming.subscribers.current-agent
|
||
|
(~(put by incoming.subscribers.current-agent) agent-bone incoming)
|
||
|
::
|
||
|
=^ maybe-tang ap-core
|
||
|
%+ ap-ingest %reap |.
|
||
|
(handle-peer:ap-agent-core pax)
|
||
|
?^ maybe-tang
|
||
|
ap-silent-delete
|
||
|
ap-core
|
||
|
:: +ap-poke: apply %poke.
|
||
|
::
|
||
|
++ ap-poke
|
||
|
~/ %ap-poke
|
||
|
|= =cage
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=^ maybe-tang ap-core
|
||
|
%+ ap-ingest %coup |.
|
||
|
(handle-poke:ap-agent-core cage)
|
||
|
ap-core
|
||
|
:: +ap-lame: pour error.
|
||
|
::
|
||
|
:: !! wat do
|
||
|
++ ap-lame
|
||
|
|= [=term =tang]
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=^ maybe-arm ap-core (ap-find-arm /lame)
|
||
|
=/ form |=(=tank [%rose [~ "! " ~] tank ~])
|
||
|
?~ maybe-arm
|
||
|
=/ tang [>%ap-lame agent-name term< (turn tang form)]
|
||
|
~> %slog.`rose+[" " "[" "]"]^(flop tang)
|
||
|
ap-core
|
||
|
::
|
||
|
=/ arm u.maybe-arm
|
||
|
=/ =vase !>([term tang])
|
||
|
=^ maybe-tang ap-core (ap-call q.arm vase)
|
||
|
?^ maybe-tang
|
||
|
=/ tang u.maybe-tang
|
||
|
=/ etc (flop [>%ap-lame-lame< (turn tang form)])
|
||
|
~> %slog.`rose+[" " "[" "]"]^(welp etc [%leaf "." (flop tang)])
|
||
|
ap-core
|
||
|
::
|
||
|
ap-core
|
||
|
:: +ap-generic-take: generic take.
|
||
|
::
|
||
|
++ ap-generic-take
|
||
|
~/ %ap-generic-take
|
||
|
|= [=wire =vase]
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=^ maybe-tang ap-core
|
||
|
%+ ap-ingest ~ |.
|
||
|
(handle-take:ap-agent-core wire vase)
|
||
|
?^ maybe-tang
|
||
|
(ap-lame ktake u.maybe-tang)
|
||
|
ap-core
|
||
|
:: +ap-specific-take: specific take.
|
||
|
::
|
||
|
++ ap-specific-take
|
||
|
|= [=path =internal-gift]
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=^ maybe-tang ap-core
|
||
|
%+ ap-ingest ~ |.
|
||
|
(handle-gall:ap-agent-core +.path internal-gift)
|
||
|
?: ?=(%diff -.internal-gift)
|
||
|
(ap-update-subscription =(~ maybe-tang) ship +.path)
|
||
|
?^ maybe-tang
|
||
|
(ap-lame -.internal-gift u.maybe-tang)
|
||
|
ap-core
|
||
|
:: +ap-install: install wrapper.
|
||
|
::
|
||
|
++ ap-install
|
||
|
|= maybe-vase=(unit vase)
|
||
|
^- [(unit tang) _ap-core]
|
||
|
::
|
||
|
=^ maybe-tang ap-core (ap-prep maybe-vase)
|
||
|
::
|
||
|
=/ new-agent-config
|
||
|
=/ =term ?~(maybe-vase %boot %bump)
|
||
|
=/ possibly-suss
|
||
|
?~ maybe-tang
|
||
|
=/ =suss [agent-name term now]
|
||
|
[%.y suss]
|
||
|
[%.n u.maybe-tang]
|
||
|
[possibly-suss agent-config]
|
||
|
::
|
||
|
=/ next
|
||
|
%= ap-core
|
||
|
agent-config new-agent-config
|
||
|
arm-cache.current-agent ~
|
||
|
==
|
||
|
::
|
||
|
[maybe-tang next]
|
||
|
:: +ap-prep: low-level install.
|
||
|
::
|
||
|
++ ap-prep
|
||
|
~/ %ap-prep
|
||
|
|= maybe-vase=(unit vase)
|
||
|
^- [(unit tang) _ap-core]
|
||
|
::
|
||
|
=^ maybe-tang ap-core
|
||
|
%+ ap-ingest ~
|
||
|
?~ maybe-vase
|
||
|
|. handle-init:ap-agent-core
|
||
|
|. (handle-prep:ap-agent-core u.maybe-vase)
|
||
|
[maybe-tang ap-core]
|
||
|
:: +ap-silent-delete: silent delete.
|
||
|
::
|
||
|
++ ap-silent-delete
|
||
|
^+ ap-core
|
||
|
::
|
||
|
?~ (~(get by incoming.subscribers.current-agent) agent-bone)
|
||
|
ap-core
|
||
|
::
|
||
|
=/ incoming (~(del by incoming.subscribers.current-agent) agent-bone)
|
||
|
=/ meter (~(del by meter.subscribers.current-agent) agent-bone)
|
||
|
%_ ap-core
|
||
|
incoming.subscribers.current-agent incoming
|
||
|
meter.subscribers.current-agent meter
|
||
|
==
|
||
|
:: +ap-load-delete: load delete.
|
||
|
::
|
||
|
++ ap-load-delete
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=/ maybe-incoming
|
||
|
(~(get by incoming.subscribers.current-agent) agent-bone)
|
||
|
?~ maybe-incoming
|
||
|
ap-core
|
||
|
::
|
||
|
=/ incoming u.maybe-incoming
|
||
|
=. incoming.subscribers.current-agent
|
||
|
(~(del by incoming.subscribers.current-agent) agent-bone)
|
||
|
=. meter.subscribers.current-agent
|
||
|
(~(del by meter.subscribers.current-agent) agent-bone)
|
||
|
::
|
||
|
=^ maybe-tang ap-core
|
||
|
%+ ap-ingest ~ |.
|
||
|
(handle-pull:ap-agent-core q.incoming)
|
||
|
?^ maybe-tang
|
||
|
(ap-lame q.arm u.maybe-tang)
|
||
|
ap-core
|
||
|
:: +ap-kill: queue kill.
|
||
|
::
|
||
|
++ ap-kill
|
||
|
^+ ap-core
|
||
|
::
|
||
|
=> ap-load-delete
|
||
|
(ap-give %quit ~)
|
||
|
:: +ap-ingest: call agent arm
|
||
|
::
|
||
|
:: Handle acks here because they need to be emitted before the
|
||
|
:: rest of the moves.
|
||
|
::
|
||
|
++ ap-ingest
|
||
|
|= $: ack=?(%coup %reap ~)
|
||
|
result=_^?(|.(each [moves=(list move:agent) new-state=vase] tang))
|
||
|
==
|
||
|
^- [(unit tang) _ap-core]
|
||
|
=^ new-moves ap-core (ap-handle-result (mule result))
|
||
|
=/ maybe-tang=(unit tang)
|
||
|
?: =(%& -.peer-result)
|
||
|
~
|
||
|
`p.peer-result
|
||
|
=/ ack-moves
|
||
|
?- ack
|
||
|
~ ~
|
||
|
%coup [agent-bone %give %coup maybe-tang]~
|
||
|
%reap [agent-bone %give %reap maybe-tang]~
|
||
|
==
|
||
|
::
|
||
|
=. agent-moves
|
||
|
:(weld new-moves ack-moves agent-moves)
|
||
|
[maybe-tang ap-core]
|
||
|
:: +ap-handle-result: handle result.
|
||
|
::
|
||
|
++ ap-handle-result
|
||
|
~/ %ap-handle-result
|
||
|
|= result=(each [moves=(list move:agent) new-state=vase] tang)
|
||
|
^- [(list move:agent) ap-core]
|
||
|
?: ?=(%| -.result)
|
||
|
(ap-lame %diff-crash p.result)
|
||
|
::
|
||
|
=/ new-subs (ap-handle-quits moves.p.result)
|
||
|
::
|
||
|
:- (flop moves.p.result)
|
||
|
%_ +>.$
|
||
|
state.current-agent new-state.p.result
|
||
|
incoming.subscribers.current-agent new-subs
|
||
|
==
|
||
|
:: +ap-handle-quits: handle cancels of incoming subscriptions
|
||
|
::
|
||
|
++ ap-handle-quits
|
||
|
~/ %ap-handle-quits
|
||
|
|= moves=(list move:agent)
|
||
|
^- bitt
|
||
|
=/ quits=(list bone)
|
||
|
%+ murn moves.p.result
|
||
|
|= =move:agent
|
||
|
?. ?=([%give %quit *] move.internal-move)
|
||
|
~
|
||
|
bone.internal-move
|
||
|
::
|
||
|
=/ quit-map=bitt
|
||
|
(malt (turn quits |=(=bone [=bone *[ship path]])))
|
||
|
(~(dif by incoming.subscribers.current-agent) quit-map)
|
||
|
:: +ap-tang: standard tang.
|
||
|
::
|
||
|
++ ap-tang
|
||
|
|= =tape
|
||
|
^- tang
|
||
|
::
|
||
|
=/ =tank [%leaf (weld "gall: {<agent-name>}: " tape)]
|
||
|
[tank ~]
|
||
|
--
|
||
|
--
|
||
|
:: +call: request
|
||
|
::
|
||
|
++ call
|
||
|
~% %gall-call +> ~
|
||
|
|= [=duct hic=(hypo (hobo task:able))]
|
||
|
^- [(list move) _gall-payload]
|
||
|
::
|
||
|
~| [%gall-call-failed duct q.hic]
|
||
|
:: make sure our task is hard
|
||
|
::
|
||
|
=/ =task:able
|
||
|
?. ?=(%soft -.q.hic)
|
||
|
q.hic
|
||
|
;; task:able p.q.hic
|
||
|
::
|
||
|
=/ initialised (mo-abed:mo duct)
|
||
|
?- -.task
|
||
|
%conf
|
||
|
=/ =dock p.task
|
||
|
=/ =ship p.dock
|
||
|
?. =(our ship)
|
||
|
~& [%gall-not-ours ship]
|
||
|
[~ gall-payload]
|
||
|
::
|
||
|
=> (mo-boot:initialised q.dock q.task)
|
||
|
mo-abet
|
||
|
::
|
||
|
%deal
|
||
|
=/ =sock p.task
|
||
|
=/ =internal-task q.task
|
||
|
?. =(q.sock our)
|
||
|
?> =(p.sock our)
|
||
|
=> (mo-handle-foreign-request:initialised q.sock internal-task)
|
||
|
mo-abet
|
||
|
::
|
||
|
=> (mo-handle-local:initialised p.sock internal-task)
|
||
|
mo-abet
|
||
|
::
|
||
|
%init
|
||
|
=/ payload gall-payload(system-duct.agents.state duct)
|
||
|
[~ payload]
|
||
|
::
|
||
|
%vega
|
||
|
[~ gall-payload]
|
||
|
::
|
||
|
%west
|
||
|
=/ =ship p.task
|
||
|
=/ =path q.task
|
||
|
=/ =noun r.task
|
||
|
::
|
||
|
?> ?=([?(%ge %gh) @ ~] path)
|
||
|
=/ agent-name i.t.path
|
||
|
::
|
||
|
?: ?=(%ge i.path)
|
||
|
=/ mes ;;((pair @ud forward-ames) noun)
|
||
|
=> (mo-handle-forward:initialised ship agent-name mes)
|
||
|
mo-abet
|
||
|
::
|
||
|
=/ mes ;;((pair @ud reverse-ames) noun)
|
||
|
=> (mo-handle-backward:initialised ship agent-name mes)
|
||
|
mo-abet
|
||
|
::
|
||
|
%wash
|
||
|
=. running.agents.state
|
||
|
%- ~(run by running.agents.state)
|
||
|
|= =running-agent
|
||
|
running-agent(cache *worm)
|
||
|
[~ gall-payload]
|
||
|
::
|
||
|
%wegh
|
||
|
=/ blocked
|
||
|
=/ queued (~(run by blocked.agents.state) |=(blocked [%.y +<]))
|
||
|
(sort ~(tap by queued) aor)
|
||
|
::
|
||
|
=/ running
|
||
|
=/ active (~(run by running.agents.state) |=(agent [%.y +<]))
|
||
|
(sort ~(tap by active) aor)
|
||
|
::
|
||
|
=/ =mass
|
||
|
:+ %gall %.n
|
||
|
:~ [%foreign %.y contacts.agents.state]
|
||
|
[%blocked %.n blocked]
|
||
|
[%active %.n running]
|
||
|
[%dot %.y state]
|
||
|
==
|
||
|
::
|
||
|
=/ moves
|
||
|
=/ =move [duct %give %mass mass]
|
||
|
[move ~]
|
||
|
::
|
||
|
[moves gall-payload]
|
||
|
==
|
||
|
:: +load: recreate vane
|
||
|
::
|
||
|
++ load
|
||
|
|= =state-old
|
||
|
^+ gall-payload
|
||
|
::
|
||
|
?- -.state-old
|
||
|
%0 gall-payload(state state-old)
|
||
|
==
|
||
|
:: +scry: standard scry
|
||
|
::
|
||
|
++ scry
|
||
|
~/ %gall-scry
|
||
|
|= [fur=(unit (set monk)) =term =shop =desk =coin =path]
|
||
|
^- (unit (unit cage))
|
||
|
?. ?=(%.y -.shop)
|
||
|
~
|
||
|
::
|
||
|
=/ =ship p.shop
|
||
|
?: ?& =(%u term)
|
||
|
=(~ path)
|
||
|
=([%$ %da now] coin)
|
||
|
=(our ship)
|
||
|
==
|
||
|
=/ =vase !>((~(has by running.agents.state) desk))
|
||
|
=/ =cage [%noun vase]
|
||
|
(some (some cage))
|
||
|
::
|
||
|
?. =(our ship)
|
||
|
~
|
||
|
::
|
||
|
?. =([%$ %da now] coin)
|
||
|
~
|
||
|
::
|
||
|
?. (~(has by running.agents.state) desk)
|
||
|
(some ~)
|
||
|
::
|
||
|
?. ?=(^ path)
|
||
|
~
|
||
|
::
|
||
|
=/ initialised mo-abed:mo
|
||
|
=/ =routes [~ ship]
|
||
|
(mo-peek:initialised desk routes term path)
|
||
|
:: +stay: save without cache
|
||
|
::
|
||
|
++ stay state
|
||
|
:: +take: response
|
||
|
::
|
||
|
++ take
|
||
|
~/ %gall-take
|
||
|
|= [=wire =duct hin=(hypo sign-arvo)]
|
||
|
^- [(list move) _gall-payload]
|
||
|
::
|
||
|
~| [%gall-take-failed wire]
|
||
|
?> ?=([?(%sys %use) *] wire)
|
||
|
=/ initialised (mo-abed:mo duct)
|
||
|
=/ =sign-arvo q.hin
|
||
|
=>
|
||
|
?- i.wire
|
||
|
%sys (mo-handle-sys:initialised t.wire sign-arvo)
|
||
|
%use (mo-handle-use:initialised t.wire hin)
|
||
|
==
|
||
|
mo-abet
|
||
|
--
|