WIP: got +test-alts working

This commit is contained in:
Elliot Glaysher 2018-07-20 14:53:13 -07:00
parent ca2fe7a543
commit 0bdabe2481
2 changed files with 97 additions and 86 deletions

View File

@ -75,10 +75,9 @@
test-ride-scry-block
test-ride-scry-promote
test-five-oh-fora
:: test-alts
:: test-alts-and-live
:: test-double-alts
test-alts
:: test-alts-and-live
:: test-double-alts
:: test-cache-reclamation-trivial
:: test-cache-reclamation-live-rebuild
:: test-cache-reclamation-live-promote
@ -1671,7 +1670,6 @@
::
=/ static=schematic:ford-gate [%same [%pin ~1234.5.6 autocons]]
::
~& %one---one
=^ results1 ford-gate
%- test-ford-call :*
ford-gate
@ -1687,7 +1685,6 @@
[%success [%scry %noun scry-type %it-does-in-fact-matter]]
== == ==
::
~& %two---two
=^ results2 ford-gate
%- test-ford-call :*
ford-gate
@ -1705,7 +1702,6 @@
%c %warp [~nul ~nul] %home
`[%mult [%da ~1234.5.7] (sy [%x /foo/bar] ~)]
== == ==
~& %three----three
::
=^ results3 ford-gate
%- test-ford-call :*
@ -1717,7 +1713,6 @@
::
moves=~
==
~& %four----four
::
=^ results4 ford-gate
%- test-ford-call :*
@ -2727,7 +2722,6 @@
=/ rendered-b=schematic:ford-gate [post-b sidebar]
:: first, ask ford to build rendered-a
::
~& %one-----one
=^ results1 ford-gate
%- test-ford-call-with-comparator :*
ford-gate
@ -2756,7 +2750,6 @@
%c %warp [~nul ~nul] %desk
`[%mult [%da ~1234.5.6] (sy [%x /posts/a] [%x /posts/b] ~)]
== ==
~& %two-----two
::
=^ results2 ford-gate
%- test-ford-call-with-comparator :*
@ -2786,7 +2779,6 @@
%c %warp [~nul ~nul] %desk
`[%mult [%da ~1234.5.7] (sy [%x /posts/a] [%x /posts/b] ~)]
== ==
~& %three-----three
::
=^ results3 ford-gate
%- test-ford-take-with-comparator :*
@ -2804,7 +2796,6 @@
|= moves=(list move:ford-gate)
^- tang
::
~& [%moves moves]
?> ?=([^ ^ ~] moves)
%+ welp
%- check-post-made :*
@ -2821,7 +2812,6 @@
%c %warp [~nul ~nul] %desk
`[%mult [%da ~1234.5.8] (sy [%x /posts/a] [%x /posts/b] ~)]
== ==
~& %four-----four
::
=^ results4 ford-gate
%- test-ford-take :*
@ -2837,7 +2827,6 @@
::
moves=~
==
~& %five-----five
::
=^ results5 ford-gate
%- test-ford-call :*
@ -2849,7 +2838,6 @@
::
moves=~
==
~& %six-----six
::
=^ results6 ford-gate
%- test-ford-call :*
@ -2881,26 +2869,26 @@
::
=/ scry-results=(map [term beam] (unit cage))
%- my :~
:- [%cx [[~nul %first %da ~1234.5.6] /one/scry]]
:- [%cx [[~nul %home %da ~1234.5.6] /one/scry]]
~
::
:- [%cx [[~nul %second %da ~1234.5.6] /two/scry]]
:- [%cx [[~nul %home %da ~1234.5.6] /two/scry]]
~
::
:- [%cx [[~nul %first %da ~1234.5.7] /one/scry]]
:- [%cx [[~nul %home %da ~1234.5.7] /one/scry]]
~
::
:- [%cx [[~nul %second %da ~1234.5.7] /two/scry]]
:- [%cx [[~nul %home %da ~1234.5.7] /two/scry]]
`[%noun scry-type 'scry-two']
::
:- [%cx [[~nul %first %da ~1234.5.8] /one/scry]]
:- [%cx [[~nul %home %da ~1234.5.8] /one/scry]]
`[%noun scry-type 'scry-one']
==
::
=/ scry (scry-with-results-and-failures scry-results)
::
=/ scry1=schematic:ford-gate [%scry [%c %x [~nul %first] /one/scry]]
=/ scry2=schematic:ford-gate [%scry [%c %x [~nul %second] /two/scry]]
=/ scry1=schematic:ford-gate [%scry [%c %x [~nul %home] /one/scry]]
=/ scry2=schematic:ford-gate [%scry [%c %x [~nul %home] /two/scry]]
=/ alts=schematic:ford-gate [%alts [scry1 scry2 ~]]
::
=^ results1 ford-gate
@ -2915,13 +2903,9 @@
:~ :* duct=~[/alts] %give %made ~1234.5.6 %complete
[%error [%leaf "%alts: all options failed"]~]
==
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/first
%c %warp [~nul ~nul] %first
`[%mult [%da ~1234.5.6] (sy [%x /scry/one] ~)]
==
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/second
%c %warp [~nul ~nul] %second
`[%mult [%da ~1234.5.6] (sy [%x /scry/two] ~)]
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/home/~1234.5.6
%c %warp [~nul ~nul] %home
`[%mult [%da ~1234.5.6] (sy [%x /scry/two] [%x /scry/one] ~)]
== == ==
::
=^ results2 ford-gate
@ -2931,7 +2915,7 @@
scry=scry
::
^= take-args
:* wire=/~nul/clay-sub/~nul/second duct=~[/alts]
:* wire=/~nul/clay-sub/~nul/home/~1234.5.6 duct=~[/alts]
^= wrapped-sign ^- (hypo sign:ford-gate) :- *type
[%c %wris [%da ~1234.5.7] (sy [%x /scry/two]~)]
==
@ -2940,9 +2924,9 @@
:~ :* duct=~[/alts] %give %made ~1234.5.7 %complete
%success %alts %success %scry %noun scry-type 'scry-two'
==
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/second
%c %warp [~nul ~nul] %second
`[%mult [%da ~1234.5.7] (sy [%x /scry/two] ~)]
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/home/~1234.5.7
%c %warp [~nul ~nul] %home
`[%mult [%da ~1234.5.7] (sy [%x /scry/two] [%x /scry/one] ~)]
== == ==
::
=^ results3 ford-gate
@ -2952,7 +2936,7 @@
scry=scry
::
^= take-args
:* wire=/~nul/clay-sub/~nul/first duct=~[/alts]
:* wire=/~nul/clay-sub/~nul/home/~1234.5.6 duct=~[/alts]
^= wrapped-sign ^- (hypo sign:ford-gate) :- *type
[%c %wris [%da ~1234.5.8] (sy [%x /scry/one]~)]
==
@ -2961,12 +2945,9 @@
:~ :* duct=~[/alts] %give %made ~1234.5.8 %complete
%success %alts %success %scry %noun scry-type 'scry-one'
==
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/first
%c %warp [~nul ~nul] %first
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/home/~1234.5.8
%c %warp [~nul ~nul] %home
`[%mult [%da ~1234.5.8] (sy [%x /scry/one] ~)]
==
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/second
%c %warp [~nul ~nul] %second ~
== == ==
::
=^ results4 ford-gate
@ -2978,8 +2959,8 @@
call-args=[duct=~[/alts] type=~ %kill ~nul]
::
^= moves
:~ :* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/first
%c %warp [~nul ~nul] %first ~
:~ :* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/home/~1234.5.8
%c %warp [~nul ~nul] %home ~
== == ==
::
;: weld
@ -3031,7 +3012,7 @@
:~ :* duct=~[/same] %give %made ~1234.5.6 %complete
%success %same %success %scry %noun scry-type 'scry-two'
==
:* duct=~[/same] %pass wire=/~nul/clay-sub/~nul/desk
:* duct=~[/same] %pass wire=/~nul/clay-sub/~nul/desk/~1234.5.6
%c %warp [~nul ~nul] %desk
`[%mult [%da ~1234.5.6] (sy [%x /scry/two] ~)]
== == ==
@ -3055,10 +3036,10 @@
:~ :* duct=~[/alts] %give %made ~1234.5.7 %complete
%success %alts %success %scry %noun scry-type 'scry-two'
==
:* duct=~[/same] %pass wire=/~nul/clay-sub/~nul/desk
:* duct=~[/same] %pass wire=/~nul/clay-sub/~nul/desk/~1234.5.6
%c %warp [~nul ~nul] %desk ~
==
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/desk
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/desk/~1234.5.7
%c %warp [~nul ~nul] %desk
`[%mult [%da ~1234.5.7] (sy [%x /scry/two] [%x /scry/one] ~)]
== == ==
@ -3072,7 +3053,7 @@
scry=scry
::
^= take-args
:* wire=/~nul/clay-sub/~nul/desk duct=~[/alts]
:* wire=/~nul/clay-sub/~nul/desk/~1234.5.7 duct=~[/alts]
^= wrapped-sign ^- (hypo sign:ford-gate) :- *type
[%c %wris [%da ~1234.5.8] (sy [%x /scry/one]~)]
==
@ -3083,7 +3064,7 @@
==
:: we subscribe to both paths because /same still exists.
::
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/desk
:* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/desk/~1234.5.8
%c %warp [~nul ~nul] %desk
`[%mult [%da ~1234.5.8] (sy [%x /scry/one] [%x /scry/two] ~)]
== == ==
@ -3102,10 +3083,10 @@
call-args=[duct=~[/same] type=~ %kill ~nul]
::
^= moves
:~ :* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/desk
:~ :* duct=~[/alts] %pass wire=/~nul/clay-sub/~nul/desk/~1234.5.8
%c %warp [~nul ~nul] %desk ~
==
:* duct=~[/same] %pass wire=/~nul/clay-sub/~nul/desk
:* duct=~[/same] %pass wire=/~nul/clay-sub/~nul/desk/~1234.5.8
%c %warp [~nul ~nul] %desk
`[%mult [%da ~1234.5.8] (sy [%x /scry/one] ~)]
== == ==
@ -3119,7 +3100,7 @@
call-args=[duct=~[/alts] type=~ %kill ~nul]
::
^= moves
:~ :* duct=~[/same] %pass wire=/~nul/clay-sub/~nul/desk
:~ :* duct=~[/same] %pass wire=/~nul/clay-sub/~nul/desk/~1234.5.8
%c %warp [~nul ~nul] %desk ~
== == ==
::

View File

@ -177,8 +177,20 @@
$= live
$% [%once in-progress=@da]
$: %live
::
::
in-progress=(unit @da)
last-sent=(unit [date=@da resources=(jug disc resource)])
:: the last subscription we made
::
:: This can possibly have an empty set of resources, in which
:: we never sent a move.
::
:: NOTE: This implies that a single live build can only depend
:: on live resources from a single disc. We don't have a
:: working plan for fixing this and will need to think very
:: hard about the future.
::
last-sent=(unit [date=@da subscription=(unit subscription)])
== ==
:: root-schematic: the requested build for this duct
::
@ -1036,15 +1048,9 @@
=. state (remove-duct-from-root root-build)
::
::
=/ resources ~(tap by resources.u.last-sent.live.u.duct-status)
|- ^+ ..execute
?~ resources ..execute
::
:: TODO: Also add scry cancels here.
::
=. ..execute (cancel-clay-subscription date.root-build i.resources)
::
$(resources t.resources)
?~ subscription.u.last-sent.live.u.duct-status
..execute
(cancel-clay-subscription u.subscription.u.last-sent.live.u.duct-status)
:: +remove-duct-from-root: remove :duct from a build tree
::
++ remove-duct-from-root
@ -1363,8 +1369,13 @@
?!
?& ?=(%live -.live.duct-status)
?=(^ last-sent.live.duct-status)
%+ ~(has ju resources.u.last-sent.live.duct-status)
(extract-disc resource.schematic.build)
::
=/ subscription=(unit subscription)
subscription.u.last-sent.live.duct-status
::
?~ subscription
%.n
%- ~(has in resources.u.subscription)
resource.schematic.build
== == ==
(add-build-to-next build)
@ -4752,24 +4763,7 @@
..execute
::
%live
=/ resources (collect-live-resources build)
::
=. ..execute
=/ resource-list ~(tap by resources)
|-
^+ ..execute
~& %starting-resource-loop
::
?~ resource-list
~& %exiting-resource-loop
..execute
::
=. ..execute (start-clay-subscription date.build i.resource-list)
~& %finished-start-clay-subscription
::
$(resource-list t.resource-list)
~& %finished-resource-loop
:: ~& [%duct-status duct-status]
=/ resources=(jug disc resource) (collect-live-resources build)
:: clean up previous build
::
=? state ?=(^ last-sent.live.duct-status)
@ -4777,15 +4771,53 @@
::
:: ~& [%remove-previous-duct-from-root duct duct-status (build-to-tape old-build)]
(remove-duct-from-root old-build)
~& %about-add-to-ducts
::
=/ resource-list=(list [=disc resources=(set resource)])
~(tap by resources)
:: we can only handle a single subscription
::
:: In the long term, we need Clay's interface to change so we can
:: subscribe to multiple desks at the same time.
::
?: (lth 1 (lent resource-list))
=. ..execute (send-incomplete build)
=. ducts.state (~(del by ducts.state) duct)
=. state (remove-duct-from-root build)
..execute
::
=/ subscription=(unit subscription)
?~ resource-list
~
`[date.build disc.i.resource-list resources.i.resource-list]
::
=? ..execute ?=(^ subscription)
(start-clay-subscription u.subscription)
::
=. ducts.state
%+ ~(put by ducts.state) duct
duct-status(live [%live in-progress=~ last-sent=`[date.build resources]])
%_ duct-status
live
[%live in-progress=~ last-sent=`[date.build subscription]]
==
::
~& %end-of-on-root-build-complete
..execute
==
:: +send-incomplete:
::
++ send-incomplete
|= =build
^+ ..execute
::
=. moves
:_ moves
^- move
:* duct %give %made date.build
^- made-result
:- %incomplete
[%leaf "build tried to subscribe to multiple discs"]~
==
::
..execute
:: +cleanup-orphaned-provisional-builds: delete extraneous sub-builds
::
:: Remove unverified linkages to sub builds. If a sub-build has no other
@ -5208,13 +5240,11 @@
::
:: ~& [%pending-subscriptions pending-subscriptions.ship-state]
=/ =subscription
:+ date disc
^- (set resource)
::
=/ =duct-status (~(got by ducts.ship-state) duct)
?> ?=(%live -.live.duct-status)
?> ?=(^ last-sent.live.duct-status)
(~(got by resources.u.last-sent.live.duct-status) disc)
?> ?=(^ subscription.u.last-sent.live.duct-status)
u.subscription.u.last-sent.live.duct-status
:: ~& [%subscription subscription]
::
=/ ducts=(list ^duct)