ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2025-01-01 19:46:36 +03:00
Code Issues Packages Projects Releases Wiki Activity

most of proper cache restoration

Browse Source
This commit is contained in:
Philip Monk 2019-02-11 18:46:36 -08:00
parent 11adf30c72
commit 3336699660
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
4 changed files with 160 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
app/aqua.hoon
View File

@ -546,18 +546,8 @@
this
::
[%restore-fleet lab=@tas]
=. this
%+ turn-ships (turn ~(tap by piers) head)
|= [who=ship thus=_this]
=. this thus
sleep:(pe who)
=. piers (~(got by fleet-snaps) lab.val)
=. this
%+ turn-ships (turn ~(tap by piers) head)
|= [who=ship thus=_this]
=. this thus
restore:(pe who)
this
=^ ms this (poke-aqua-events [%restore-snap lab.val]~)
(emit-moves ms)
==
::
:: Apply a list of events tagged by ship
@ -599,6 +589,33 @@
::
%pause-events
stop-processing-events:(pe who.ovo)
::
%snap-ships
=. fleet-snaps
%+ ~(put by fleet-snaps) lab.ovo
%- malt
%+ murn hers.ovo
|= her=ship
^- (unit (pair ship pier))
=+ per=(~(get by piers) her)
?~ per
~
`[her u.per]
(pe -.hers.ovo)
::
%restore-snap
=. this
%+ turn-ships (turn ~(tap by piers) head)
|= [who=ship thus=_this]
=. this thus
sleep:(pe who)
=. piers (~(got by fleet-snaps) lab.ovo)
=. this
%+ turn-ships (turn ~(tap by piers) head)
|= [who=ship thus=_this]
=. this thus
restore:(pe who)
(pe ~bud) :: XX why ~bud? need an example
::
%event
~& ev=-.q.ovo.ovo
@ -711,6 +728,17 @@
=. this thus
(take-sigh-tang:(pe who) t.way tan)
::
:: Handle scry to aqua
::
++ peek-x-fleet-snap
|= pax=path
^- (unit (unit [%noun noun]))
~& [%peeking pax]
?. ?=([@ ~] pax)
~
:^ ~ ~ %noun
(~(has by fleet-snaps) i.pax)
::
:: Trivial scry for mock
::
++ scry |=([* *] ~)
@ -720,6 +748,7 @@
++ prep
|= old/(unit noun)
^- [(list move) _+>.$]
~& prep=%aqua
?~ old
`+>.$
=+ new=((soft state) u.old)

56
app/ph.hoon
View File

@ -33,17 +33,22 @@
state
==
++ this .
++ test-lib ~(. ^test-lib our.hid)
++ install-tests
^+ this
=. raw-test-cores
~& jael=.^(noun %j /(scot %p our.hid)/code/(scot %da now.hid)/(scot %p our.hid))
=, test-lib
%- malt
^- (list (pair term test-core))
:~
:- %add
=+ num=5
|%
|_ [our=@p now=@da]
++ label %add
++ ships ~[~bud]
++ start
|= now=@da
^- (pair (list ph-event) _..start)
=. num +(num)
:_ ..start
@ -53,7 +58,7 @@
==
::
++ route
|= [who=ship ovo=unix-effect]
|= [now=@da who=ship ovo=unix-effect]
^- (quip ph-event _..start)
~& [%num num]
:_ ..start
@ -62,9 +67,11 @@
--
::
:- %hi
|%
|_ [our=@p now=@da]
++ label %hi
++ ships ~[~bud ~dev]
++ start
|= now=@da
^- (pair (list ph-event) _..start)
:_ ..start
%- zing
@ -74,24 +81,26 @@
==
::
++ route
|= [who=ship ovo=unix-effect]
|= [now=@da who=ship ovo=unix-effect]
^- (quip ph-event _..start)
:_ ..start
(expect-dojo-output ~bud who ovo "hi ~dev successful")
--
::
[%headstart-bud (galaxy:head-starts ~bud)]
[%headstart-bud (galaxy ~bud)]
::
:- %composed-child-boot
%+ compose-tests (planet:head-starts ~linnup-torsyx)
%+ compose-tests (planet ~linnup-torsyx)
^- test-core
|%
|_ [our=@p now=@da]
++ label %composed-child-boot
++ ships ~
++ start
|= now=@da
[(dojo ~linnup-torsyx "|hi ~bud") ..start]
::
++ route
|= [who=ship ovo=unix-effect]
|= [now=@da who=ship ovo=unix-effect]
^- (quip ph-event _..start)
:_ ..start
%- on-dojo-output
@ -100,11 +109,34 @@
|= ~
[%test-done &]~
--
::
:- %composed-child-boot-2
%+ compose-tests (planet ~haplun-todtus)
^- test-core
|_ [our=@p now=@da]
++ label %composed-child-boot-2
++ ships ~
++ start
|= now=@da
[(dojo ~haplun-todtus "|hi ~bud") ..start]
::
++ route
|= [now=@da who=ship ovo=unix-effect]
^- (quip ph-event _..start)
:_ ..start
%- on-dojo-output
:^ ~haplun-todtus who ovo
:- "hi ~bud successful"
|= ~
[%test-done &]~
--
::
:- %child-sync
|%
|_ [our=@p now=@da]
++ label %child-sync
++ ships ~[~bud ~marbud ~linnup-torsyx]
++ start
|= now=@da
^- (pair (list ph-event) _..start)
:_ ..start
%- zing
@ -112,7 +144,7 @@
==
::
++ route
|= [who=ship ovo=unix-effect]
|= [now=@da who=ship ovo=unix-effect]
^- (quip ph-event _..start)
:_ ..start
%- zing
@ -252,7 +284,7 @@
?+ arg ~|(%bad-noun-arg !!)
[%run-test lab=@tas]
=/ res=[events=(list ph-event) new-state=test-core]
start:(~(got by raw-test-cores) lab.arg)
(start:(~(got by raw-test-cores) lab.arg) now.hid)
=. test-cores (~(put by test-cores) lab.arg [ships .]:new-state.res)
=^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res)
=^ moves-2 this (run-events lab.arg events.res)
@ -274,7 +306,7 @@
?~ ovo.ova
[~ u.test-cor]
=^ events-1 cor.u.test-cor
(route:cor.u.test-cor who.ova i.ovo.ova)
(route:cor.u.test-cor now.hid who.ova i.ovo.ova)
=^ events-2 u.test-cor
$(ovo.ova t.ovo.ova)
[(weld events-1 events-2) u.test-cor]

121
lib/ph.hoon
View File

@ -22,9 +22,10 @@
++ test-core
$_ ^?
|%
++ label *term
++ ships *(list ship)
++ start *(quip ph-event _^?(..start))
++ route |~([ship unix-effect] *(quip ph-event _^?(..start)))
++ start |~(@da *(quip ph-event _^?(..start)))
++ route |~([@da [ship unix-effect]] *(quip ph-event _^?(..start)))
--
::
++ ph-event
@ -92,52 +93,73 @@
|= ~
[%test-done &]~
::
++ compose-tests
|= [a=test-core b=test-core]
^- test-core
=/ done-with-a |
|%
:: Union of ships in a and b
::
++ ships ~(tap in (~(uni in (silt ships.a)) (silt ships.b)))
::
:: Start with start of a
::
++ start
^- (quip ph-event _..start)
=^ events a start:a
[events ..start]
::
:: Keep going on a until it's done. If success, go to b.
::
:: In theory, we should be able to just swap out the whole core
:: for b, but in practice the types are hard, and we generally
:: try to avoid changing the structure of a core in the middle
:: like that.
::
++ route
|= [who=ship ovo=unix-effect]
^- (quip ph-event _..start)
?: done-with-a
=^ events b (route:b who ovo)
++ test-lib
|_ our=ship
++ compose-tests
|= [a=test-core b=test-core]
^- test-core
=/ done-with-a |
|%
::
:: Cache lookup label
::
++ label :((cury cat 3) label:a '--1-' label:b)
::
:: Union of ships in a and b
::
++ ships ~(tap in (~(uni in (silt ships.a)) (silt ships.b)))
::
:: Start with start of a
::
++ start
|= now=@da
^- (quip ph-event _..start)
=/ have-cache
.^ @f
%gx
(scot %p our)
%aqua
(scot %da now)
/fleet-snap/[label:a]/noun
==
~& [%have-cache label:a have-cache]
?: have-cache
=. done-with-a &
=/ restore-event [%restore-snap label:a]
=^ events-start b (start:b now)
[[restore-event events-start] ..start]
=^ events a (start:a now)
[events ..start]
=^ events a (route:a who ovo)
=+ ^- [done=(list ph-event) other-events=(list ph-event)]
%+ skid events
|= e=ph-event
=(%test-done -.e)
?~ done
[other-events ..start]
?> ?=(%test-done -.i.done)
?. p.i.done
[[%test-done |]~ ..start]
=. done-with-a &
=^ events-start b start:b
[(weld other-events events-start) ..start]
--
::
++ head-starts
|%
::
:: Keep going on a until it's done. If success, go to b.
::
:: In theory, we should be able to just swap out the whole core
:: for b, but in practice the types are hard, and we generally
:: try to avoid changing the structure of a core in the middle
:: like that.
::
++ route
|= [now=@da who=ship ovo=unix-effect]
^- (quip ph-event _..start)
?: done-with-a
=^ events b (route:b now who ovo)
[events ..start]
=^ events a (route:a now who ovo)
=+ ^- [done=(list ph-event) other-events=(list ph-event)]
%+ skid events
|= e=ph-event
=(%test-done -.e)
?~ done
[other-events ..start]
?> ?=(%test-done -.i.done)
?. p.i.done
[[%test-done |]~ ..start]
=. done-with-a &
=/ snap-event [%snap-ships label:a ships:a]
=^ events-start b (start:b now)
[(welp other-events [snap-event events-start]) ..start]
--
::
:: Don't use directly, or else you might not have a parent.
::
:: Consider ++galaxy, ++star, ++planet, and ++ship-with-ancestors.
@ -146,13 +168,15 @@
|= her=ship
^- test-core
|%
++ label (cat 3 'iinit-' (scot %p her))
++ ships ~[her]
++ start
|= now=@da
^- (quip ph-event _..start)
[(init her) ..start]
::
++ route
|= [who=ship ovo=unix-effect]
|= [now=@da who=ship ovo=unix-effect]
^- (quip ph-event _..start)
:_ ..start
%- zing
@ -201,4 +225,5 @@
%earl ~|(%moon-not-implemented !!)
%pawn ~|(%comet-not-implemented !!)
==
--
--

2
sur/aquarium.hoon
View File

@ -2,6 +2,8 @@
++ aqua-event
$% [%init-ship who=ship]
[%pause-events who=ship]
[%snap-ships lab=term hers=(list ship)]
[%restore-snap lab=term]
[%event who=ship ovo=unix-event]
==
::