gall: miscellaneous cleanup

This commit is contained in:
Jared Tobin 2019-05-29 15:46:55 +08:00 committed by Jared Tobin
parent aec215b3a8
commit 38474fbadf
No known key found for this signature in database
GPG Key ID: 0E4647D58F8A69E4

View File

@ -198,9 +198,9 @@
duct-map=(map @ud duct) duct-map=(map @ud duct)
== ==
:: ::
:: +opaque-ducts: opaque input. :: +ducts: opaque input.
:: ::
++ opaque-ducts ++ ducts
$: $:
:: bone sequence :: bone sequence
:: ::
@ -260,10 +260,10 @@
required-trans=(map bone mark) required-trans=(map bone mark)
:: opaque ducts :: opaque ducts
:: ::
ducts=opaque-ducts ducts=ducts
== ==
:: ::
:: +blocked: blocked kisses. :: +blocked: blocked tasks.
:: ::
++ blocked (qeu (trel duct privilege agent-action)) ++ blocked (qeu (trel duct privilege agent-action))
:: ::
@ -369,6 +369,7 @@
[%f %build live=%.y schematic] [%f %build live=%.y schematic]
:: ::
=/ pass [path note-arvo] =/ pass [path note-arvo]
~& [%mo-passing pass]
(mo-pass pass) (mo-pass pass)
:: ::
:: +mo-pass: prepend a standard %pass move to the move state. :: +mo-pass: prepend a standard %pass move to the move state.
@ -387,6 +388,7 @@
^+ mo-state ^+ mo-state
:: ::
=/ =move [hen [%give gift]] =/ =move [hen [%give gift]]
~& [%mo-giving move]
mo-state(moves [move moves]) mo-state(moves [move moves])
:: ::
:: +mo-contains-valid-bowl: check that a vase contains a valid bowl. :: +mo-contains-valid-bowl: check that a vase contains a valid bowl.
@ -452,6 +454,7 @@
:: ::
=/ old mo-state =/ old mo-state
:: ::
~& [%mo-initialising term]
=/ wag =/ wag
=/ =routes [disclosing=~ attributing=our] =/ =routes [disclosing=~ attributing=our]
=/ =privilege [%high routes] =/ =privilege [%high routes]
@ -462,21 +465,27 @@
=/ new +.wag =/ new +.wag
:: ::
?^ maybe-tang ?^ maybe-tang
~& [%mo-got-tang u.maybe-tang]
=. mo-state old =. mo-state old
(mo-give %onto %.n u.maybe-tang) (mo-give %onto %.n u.maybe-tang)
:: ::
~& %mo-abetting-new
=. mo-state ap-abet:new =. mo-state ap-abet:new
:: ::
~& %mo-clearing-queue
=/ cleared (mo-clear-queue term) =/ cleared (mo-clear-queue term)
(mo-give:cleared %onto %.y term %boot now) =/ =suss [term %boot now]
~& [%mo-giving-boot suss]
(mo-give:cleared %onto [%.y suss])
:: ::
:: +mo-new-agent: create a new agent and add it to state. :: +mo-new-agent: create a new agent and add it to state.
:: ::
:: FIXME add some printfs to check and see if this is working alright
++ mo-new-agent ++ mo-new-agent
|= [=term =beak =vase] |= [=term =beak =vase]
^+ mo-state ^+ mo-state
:: ::
=/ =opaque-ducts =/ =ducts
:+ bone=1 :+ bone=1
bone-map=[[[~ ~] 0] ~ ~] bone-map=[[[~ ~] 0] ~ ~]
duct-map=[[0 [~ ~]] ~ ~] duct-map=[[0 [~ ~]] ~ ~]
@ -487,7 +496,7 @@
control-duct hen control-duct hen
beak beak beak beak
running-state vase running-state vase
ducts opaque-ducts ducts ducts
== ==
:: ::
=/ running (~(put by running.ship-state.gall) term agent) =/ running (~(put by running.ship-state.gall) term agent)
@ -885,18 +894,17 @@
=/ =ship (slav %p i.t.path) =/ =ship (slav %p i.t.path)
=/ =routes [disclosing=~ attributing=ship] =/ =routes [disclosing=~ attributing=ship]
[%high routes] [%high routes]
::
(ap-abed:ap term privilege) (ap-abed:ap term privilege)
:: ::
=/ =vase (slot 3 hin)
=/ =sign-arvo q.hin =/ =sign-arvo q.hin
:: ::
?- i.t.t.path ?- i.t.t.path
:: ::
%inn %inn
:: ::
=/ poured (ap-generic-take:initialised t.t.t.path vase) =/ =vase (slot 3 hin)
ap-abet:poured =/ taken (ap-generic-take:initialised t.t.t.path vase)
ap-abet:taken
:: ::
%cay %cay
:: ::
@ -905,11 +913,11 @@
~& [%mo-handle-use-weird-path path] ~& [%mo-handle-use-weird-path path]
mo-state mo-state
:: ::
=/ purred =/ taken
=/ =cage +>.sign-arvo =/ =cage +>.sign-arvo
(ap-unwrap-take:initialised %sigh t.t.t.path cage) (ap-unwrap-take:initialised %sigh t.t.t.path cage)
:: ::
ap-abet:purred ap-abet:taken
:: ::
%out %out
:: ::
@ -918,25 +926,29 @@
~& [%mo-handle-use-weird-path path] ~& [%mo-handle-use-weird-path path]
mo-state mo-state
:: ::
=/ pouted =/ taken
=/ =internal-gift +>.sign-arvo =/ =internal-gift +>.sign-arvo
(ap-specific-take:initialised t.t.t.path internal-gift) (ap-specific-take:initialised t.t.t.path internal-gift)
:: ::
ap-abet:pouted ap-abet:taken
== ==
:: ::
:: +mo-clear-queue: clear blocked kisses. :: +mo-clear-queue: clear blocked tasks.
:: ::
++ mo-clear-queue ++ mo-clear-queue
|= =term |= =term
^+ mo-state ^+ mo-state
:: ::
~& [%mo-clearing-queue-for term]
::
?. (~(has by running.ship-state.gall) term) ?. (~(has by running.ship-state.gall) term)
~& %mo-nothing-running
mo-state mo-state
:: ::
=/ maybe-blocked (~(get by waiting.ship-state.gall) term) =/ maybe-blocked (~(get by waiting.ship-state.gall) term)
:: ::
?~ maybe-blocked ?~ maybe-blocked
~& %mo-nothing-blocked
mo-state mo-state
:: ::
=/ =blocked u.maybe-blocked =/ =blocked u.maybe-blocked
@ -949,11 +961,12 @@
waiting.ship-state.gall waiting waiting.ship-state.gall waiting
== ==
:: ::
=^ kiss blocked [p q]:~(get to blocked) =^ task blocked [p q]:~(get to blocked)
~& [%mo-found-task task]
:: ::
=/ =duct p.kiss =/ =duct p.task
=/ =privilege q.kiss =/ =privilege q.task
=/ =agent-action r.kiss =/ =agent-action r.task
:: ::
=/ move =/ move
=/ =sock [attributing.routes.privilege our] =/ =sock [attributing.routes.privilege our]
@ -961,6 +974,7 @@
=/ card [%slip %g %deal sock internal-task] =/ card [%slip %g %deal sock internal-task]
[duct card] [duct card]
:: ::
~& [%mo-prepending-move move]
$(moves [move moves]) $(moves [move moves])
:: ::
:: +mo-beak: assemble a beak for the provided app. :: +mo-beak: assemble a beak for the provided app.
@ -1038,9 +1052,9 @@
:: ::
=/ =blocked =/ =blocked
=/ waiting (~(get by waiting.ship-state.gall) term) =/ waiting (~(get by waiting.ship-state.gall) term)
=/ kisses (fall waiting *blocked) =/ tasks (fall waiting *blocked)
=/ kiss [hen privilege agent-action] =/ task [hen privilege agent-action]
(~(put to kisses) kiss) (~(put to tasks) task)
:: ::
=/ waiting (~(put by waiting.ship-state.gall) term blocked) =/ waiting (~(put by waiting.ship-state.gall) term blocked)
:: ::
@ -1178,7 +1192,8 @@
ost bone ost bone
== ==
:: ::
=/ =opaque-ducts :: FIXME check
=/ =ducts
=/ bone +(bone.ducts.agent) =/ bone +(bone.ducts.agent)
:+ bone=bone :+ bone=bone
bone-map=(~(put by bone-map.ducts.agent) hen bone) bone-map=(~(put by bone-map.ducts.agent) hen bone)
@ -1186,7 +1201,7 @@
:: ::
%= ap-state %= ap-state
ost bone.ducts.agent ost bone.ducts.agent
ducts.sat opaque-ducts ducts.sat ducts
== ==
:: ::
:: +ap-abet: resolve moves. :: +ap-abet: resolve moves.
@ -1449,9 +1464,9 @@
^+ ap-state ^+ ap-state
:: ::
=/ rest +.path =/ rest +.path
=/ diff [%diff p.cage rest] =/ pax [p.cage rest]
:: ::
=^ maybe-arm ap-state (ap-find-arm diff) =^ maybe-arm ap-state (ap-find-arm %diff pax)
:: ::
?~ maybe-arm ?~ maybe-arm
=/ target [%.n ship rest] =/ target [%.n ship rest]
@ -1605,7 +1620,6 @@
|= [=term =path] |= [=term =path]
^- [(unit (pair @ud @tas)) _ap-state] ^- [(unit (pair @ud @tas)) _ap-state]
:: ::
::
=/ maybe-cached (~(get by arm-cache.sat) [term path]) =/ maybe-cached (~(get by arm-cache.sat) [term path])
?^ maybe-cached ?^ maybe-cached
[u.maybe-cached ap-state] [u.maybe-cached ap-state]
@ -2644,6 +2658,7 @@
~& [%gall-not-ours ship] ~& [%gall-not-ours ship]
[~ gall-payload] [~ gall-payload]
:: ::
~& [%gall-booting q.dock q.task]
=> (mo-boot:initialised q.dock q.task) => (mo-boot:initialised q.dock q.task)
mo-abet mo-abet
:: ::
@ -2782,11 +2797,12 @@
?> ?=([?(%sys %use) *] wire) ?> ?=([?(%sys %use) *] wire)
:: ::
=/ initialised (mo-abed:mo duct) =/ initialised (mo-abed:mo duct)
=/ =sign-arvo q.hin
:: ::
=> =>
:: ::
?- i.wire ?- i.wire
%sys (mo-handle-sys:initialised t.wire q.hin) %sys (mo-handle-sys:initialised t.wire sign-arvo)
%use (mo-handle-use:initialised t.wire hin) %use (mo-handle-use:initialised t.wire hin)
== ==
:: ::