From f32a78f6e6408a72e66935d57fad444a31cde89c Mon Sep 17 00:00:00 2001 From: Ted Blackman Date: Fri, 30 Mar 2018 16:55:43 -0700 Subject: [PATCH] send %mades for future builds --- gen/ford-turbo.hoon | 78 +++++++++++++ lib/ford-turbo.hoon | 262 ++++++++++++++++++++++++-------------------- 2 files changed, 223 insertions(+), 117 deletions(-) diff --git a/gen/ford-turbo.hoon b/gen/ford-turbo.hoon index 7116b2ccaa..94a88fb7aa 100644 --- a/gen/ford-turbo.hoon +++ b/gen/ford-turbo.hoon @@ -19,6 +19,7 @@ test-scry-clay-block test-scry-clay-live test-pinned-in-live + test-live-build-that-blocks == ++ test-is-schematic-live ~& %test-is-schematic-live @@ -321,6 +322,7 @@ :- state-by-ship.+>+<.ford (my [~nul *ford-state:ford-turbo]~) == +:: ++ test-pinned-in-live ~& %test-pinned-in-live :: @@ -375,6 +377,82 @@ (my [~nul *ford-state:ford-turbo]~) == :: +++ test-live-build-that-blocks + ~& %test-live-build-that-blocks + :: + =/ scry-blocked (scry-block ~1234.5.6) + =/ scry-42 (scry-succeed ~1234.5.6 [%noun !>(42)]) + =/ scry-43 (scry-succeed ~1234.5.7 [%noun !>(43)]) + :: + =/ ford (ford-turbo now=~1234.5.6 eny=0xdead.beef scry=scry-blocked) + :: + =^ moves ford + %- call:ford + :* duct=~ type=~ %make ~nul + [%scry %c care=%x rail=[[~nul %desk] /bar/foo]] + == + ;: welp + %- expect-eq !> + :- moves + :~ :* duct=~ %pass + wire=/~nul/dependency/c/x/~nul/desk/0/foo/bar + %c %warp [~nul ~nul] %desk + ~ %sing %x [%da ~1234.5.6] /bar/foo + == + :: + :* duct=~ %pass wire=/~nul/clay-sub/~nul/desk + %c %warp [~nul ~nul] %desk + `[%mult [%da ~1234.5.6] (sy [%x /foo/bar]~)] + == == + :: + =. ford (ford now=~1234.5.7 eny=0xbeef.dead scry=scry-43) + =^ moves2 ford + %- take:ford + :* wire=/~nul/clay-sub/~nul/desk duct=~ + ^= wrapped-sign ^- (hypo sign:ford) :- *type + [%c %wris [%da ~1234.5.7] (sy [%x /foo/bar]~)] + == + %+ welp + %- expect-eq !> + :- moves2 + :~ :* duct=~ %pass wire=/~nul/clay-sub/~nul/desk + %c %warp [~nul ~nul] %desk + `[%mult [%da ~1234.5.7] (sy [%x /foo/bar]~)] + == == + :: + =. ford (ford now=~1234.5.8 eny=0xbeef.dead scry=scry-42) + =^ moves3 ford + %- take:ford + :* wire=/~nul/dependency/c/x/~nul/desk/0/foo/bar duct=~ + ^= wrapped-sign ^- (hypo sign:ford) :- *type :: ^- sign:ford + [%c %writ ~ [%x [%da ~1234.5.6] %desk] /bar/foo %noun !>(42)] + == + %+ welp + %- expect-eq !> + :- moves3 + :~ :* duct=~ %give %made ~1234.5.6 %complete %result + [%scry %noun !>(42)] + == + :* duct=~ %give %made ~1234.5.7 %complete %result + [%scry %noun !>(43)] + == == + :: + =. ford (ford now=~1234.5.9 eny=0xbeef.dead scry=scry-is-forbidden) + =^ moves4 ford + (call:ford [duct=~ type=~ %kill ~nul]) + :: + %+ welp + %- expect-eq !> + :- moves4 + :~ :* duct=~ %pass wire=/~nul/clay-sub/~nul/desk + %c %warp [~nul ~nul] %desk ~ + == == + :: + %- expect-eq !> + :- state-by-ship.+>+<.ford + (my [~nul *ford-state:ford-turbo]~) + == +:: :: |utilities: helper arms :: ::+| utilities diff --git a/lib/ford-turbo.hoon b/lib/ford-turbo.hoon index d41a1f5f44..0c17fe0bc3 100644 --- a/lib/ford-turbo.hoon +++ b/lib/ford-turbo.hoon @@ -1192,8 +1192,13 @@ :: %+ roll dependencies |= [=dependency that=_this] + :: =/ build=build [date `schematic`[%scry dependency]] - (execute:that build from=~) + :: + =/ previous-build=^build + (need (~(find-previous by-schematic builds-by-schematic.state) build)) + :: + (execute:that build from=`previous-build) :: +unblock: continue builds that had blocked on :dependency :: ++ unblock @@ -1343,9 +1348,12 @@ :: =~ store-result update-live-tracking - promote-live-listeners + :: + ?< ?=(~ previous-build) + =. state (promote-live-listeners u.previous-build build) + :: link-rebuilds - (send-mades current-once-listeners) + =. ..execute (send-mades build current-once-listeners) delete-once-listeners == :: the build isn't complete, so try running +make on it @@ -1362,8 +1370,11 @@ :: => store-result => update-live-tracking - => promote-live-listeners - => (send-mades root-once-listeners) + :: + =? state &(?=(^ previous-build) ?=(^ previous-result)) + (promote-live-listeners u.previous-build build) + :: + =. ..execute (send-mades build (root-once-listeners build)) => delete-once-listeners :: if result is same as previous, note sameness :: @@ -1378,17 +1389,40 @@ :: link-rebuilds :: - => (send-mades root-live-listeners) + =. ..execute (send-mades build (root-live-listeners build)) => ?~(previous-build this (cleanup u.previous-build)) => (cleanup build) - :: recurse "upward" into client builds now that :build is done - :: - =/ clients=(list ^build) - ~(tap in (fall (~(get by client-builds.components.state) build) ~)) + => :: recurse "upward" into client builds now that :build is done + :: + =/ clients=(list ^build) + ~(tap in (fall (~(get by client-builds.components.state) build) ~)) + :: + |- ^+ this + ?~ clients this + $(clients t.clients, ..execute (execute i.clients from=`build)) :: |- ^+ this - ?~ clients this - $(clients t.clients, ..execute (execute i.clients from=`build)) + =/ next (~(find-next by-schematic builds-by-schematic.state) build) + ?~ next + :: no future build + :: + this + :: + =^ next-result results.state (access-cache u.next) + ?~ next-result + :: unfinished future build + :: + this + ?: ?=(%result -.u.next-result) + :: + =. state (promote-live-listeners build u.next) + =. this (cleanup build) + :: + =. ..execute (send-mades u.next (root-live-listeners u.next)) + :: + $(build u.next) + :: + this(..execute (execute u.next from=~)) :: :: %blocks: build got stuck and produced a list of blocks :: @@ -1456,56 +1490,6 @@ =/ updates (fall (~(get by dependency-updates.state) date.build) ~) :: (~(has in updates) dependency) - :: +promote-live-listeners: move live listeners :previous-build -> :build - :: - :: We don't have to promote the listeners of old sub-builds - :: because they will have already been run at :date.build - :: by the time this code gets run. - :: - ++ promote-live-listeners ^+ this - :: - ?~ previous-build - this - =. state - %+ roll previous-live-listeners - |= [=listener state=_state] - :: if :listener ain't live, we wrote this wrong - :: - ?> live.listener - :: move :listener off :previous-build onto :build - :: - %_ state - listeners - =- (~(put ju -) build listener) - (~(del ju listeners.state) u.previous-build listener) - :: - builds-by-listener - (~(put by builds-by-listener.state) duct.listener [build &]) - == - :: - =. state - %+ roll - ~(tap in (fall (~(get by root-builds.state) u.previous-build) ~)) - |= [=listener state=_state] - =? root-builds.state - (is-listener-live listener) - =- (~(put ju -) build listener) - (~(del ju root-builds.state) u.previous-build listener) - state - :: - this - :: +root-listeners: listeners that treat :build as a root build - :: - ++ root-listeners ^- (list listener) - ~(tap in (fall (~(get by root-builds.state) build) ~)) - :: +root-once-listeners: once listeners that treat :build as a root build - :: - ++ root-once-listeners ^- (list listener) - (skip root-listeners is-listener-live) - :: +root-live-listeners: live listeners that treat :build as a root build - :: - ++ root-live-listeners ^- (list listener) - (skim root-listeners is-listener-live) :: +current-once-listeners: once listeners on :build :: ++ current-once-listeners ^- (list listener) @@ -1518,17 +1502,6 @@ :: ++ current-listeners ^- (list listener) ~(tap in (fall (~(get by listeners.state) build) ~)) - :: +previous-live-listeners: live listeners on :previous-build - :: - ++ previous-live-listeners ^- (list listener) - :: even if :previous-result is a %tombstone, still grab its listeners - :: - =/ previous-listeners=(set listener) - ?~ previous-build ~ - ?~ previous-result ~ - (fall (~(get by listeners.state) u.previous-build) ~) - :: - (skim ~(tap in previous-listeners) is-listener-live) :: +link-rebuilds: link old and new same build in :rebuilds.state :: ++ link-rebuilds ^+ this @@ -1556,29 +1529,12 @@ =/ disc=disc disc.rail.dependency :: this(dirty-discs (~(put in dirty-discs) disc)) - :: +send-mades: send one %made move per listener in :listeners - :: - ++ send-mades - |= [listeners=(list listener)] ^+ this - :: - ?< ?=(~ result) - :: - %_ this - moves - %+ roll listeners - |= [=listener moves=_moves] - :: - :_ moves - :* duct.listener %give - %made date.build %complete u.result - == - == :: +delete-once-listeners: remove once listeners on :build from :state :: ++ delete-once-listeners ^+ this %_ this state - %+ roll root-once-listeners + %+ roll (root-once-listeners build) |= [=listener accumulator=_state] =. state accumulator (remove-listener-from-build listener build) @@ -1717,12 +1673,29 @@ :: =/ disc=disc (extract-disc dependency) :: - =/ live=? (is-build-live build) + =/ is-live-clay=? &((is-build-live build) ?=(%c -.dependency)) :: link :disc to :dependency :: =? dependencies.state - &(live ?=(%c -.dependency)) + is-live-clay (~(put ju dependencies.state) [disc dependency]) + :: update :latest-by-disc.state if :date.build is later + :: + =? latest-by-disc.state + ?& is-live-clay + :: + =/ latest-date (~(get by latest-by-disc.state) disc) + :: + ?| ?=(~ latest-date) + (gth date.build u.latest-date) + == == + :: + (~(put by latest-by-disc.state) disc date.build) + :: mark :disc as dirty if we're building a live dependency + :: + =? dirty-discs + is-live-clay + (~(put in dirty-discs) disc) :: perform scry operation if we don't already know the result :: :: Look up :dependency in :scry-results.per-event to avoid @@ -1756,25 +1729,6 @@ :: =. moves [[duct=~ [%pass wire note]] moves] [[%blocks ~] this] - :: update :latest-by-disc.state if :date.build is later - :: - =? latest-by-disc.state - ?& live - :: - ?=(%c -.dependency) - :: - =/ latest-date (~(get by latest-by-disc.state) disc) - :: - ?| ?=(~ latest-date) - (gth date.build u.latest-date) - == == - :: - (~(put by latest-by-disc.state) disc date.build) - :: mark :disc as dirty if we're building a live dependency - :: - =? dirty-discs - &(live ?=(%c -.dependency)) - (~(put in dirty-discs) disc) :: scry failed :: ?~ u.scry-response @@ -1827,6 +1781,85 @@ ::+| utilities :: ++ this . + :: +send-mades: send one %made move for :build per listener in :listeners + :: + ++ send-mades + |= [=build listeners=(list listener)] ^+ this + :: + =^ result results.state (access-cache build) + :: + ?> ?=([~ %result *] result) + :: + %_ this + moves + %+ roll listeners + |= [=listener moves=_moves] + :: + :_ moves + :* duct.listener %give + %made date.build %complete build-result.u.result + == + == + :: +promote-live-listeners: move live listeners from :old to :new + :: + ++ promote-live-listeners + |= [old=build new=build] + ^+ state + :: + =/ old-live-listeners=(list listener) + =- (skim - is-listener-live) + =- ~(tap in `(set listener)`(fall - ~)) + (~(get by listeners.state) old) + :: + =. state + %+ roll old-live-listeners + |= [=listener state=_state] + :: if :listener ain't live, we wrote this wrong + :: + ?> live.listener + :: move :listener off :previous-build onto :build + :: + %_ state + listeners + =- (~(put ju -) new listener) + (~(del ju listeners.state) old listener) + :: + builds-by-listener + (~(put by builds-by-listener.state) duct.listener [new &]) + == + :: + %+ roll ~(tap in (fall (~(get by root-builds.state) old) ~)) + |= [=listener state=_state] + :: + =? root-builds.state + (is-listener-live listener) + :: + =- (~(put ju -) new listener) + (~(del ju root-builds.state) old listener) + :: + state + :: +root-live-listeners: live listeners for which :build is the root build + :: + ++ root-live-listeners + |= =build + ^- (list listener) + :: + (skim (root-listeners build) is-listener-live) + :: +root-once-listeners: once listeners for which :build is the root build + :: + ++ root-once-listeners + |= =build + ^- (list listener) + :: + (skip (root-listeners build) is-listener-live) + :: +root-listeners: listeners for which :build is the root build + :: + ++ root-listeners + |= =build + ^- (list listener) + :: + =- ~(tap in `(set listener)`(fall - ~)) + (~(get by root-builds.state) build) :: +is-build-live: whether this is a live or a once build :: ++ is-build-live @@ -1926,11 +1959,6 @@ $(discs t.discs) :: $(discs t.discs) - :: TODO: We keep track of the original dependencies. Check that if the - :: dependency is in original and not in current dependencies. If - :: so, then unsubscribe. - :: - :: :: prevent thrashing; don't unsubscribe then immediately resubscribe :: :: When we send a request to a foreign ship, that ship may have