Merge remote-tracking branch 'origin/philip/ford-fusion' into ford-fusion

This commit is contained in:
Ted Blackman 2020-04-29 17:46:33 -04:00
commit 73352faa23
2 changed files with 72 additions and 38 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:a121bee8b108c9faad1e6110d6a5e254f1543345892c9503dc6361dd5ff86e31
size 13132967
oid sha256:bfdea141b5c28a037952fa06fbe350090b58eb4bd3c8fd7124d75a49ccd50d07
size 13151591

View File

@ -3547,10 +3547,11 @@
::
:: ?: &(!updated !=(~ (need-sys-update changes)))
:: (sys-update args yuki changes)
::
=. ..park (emil (print deletes ~(key by changes)))
=^ change-cages ford-cache.args
(checkout-changes args changes)
:: =/ cont (sane-changes changes change-cages)
:: =/ sane-cont (sane-changes changes change-cages)
=/ new-blobs=(map lobe blob)
%- malt
%+ turn ~(tap by change-cages)
@ -3573,7 +3574,7 @@
::
=^ ankh ford-cache.args
(checkout-ankh args deletes change-cages ank.dom)
:: =/ null (sane-ankh cont ankh)
:: =/ null (sane-ankh sane-cont ankh)
=. ankh.args ankh
=. ank.dom ankh
=^ mim ford-cache.args
@ -3646,7 +3647,10 @@
=/ =lobe
?- -.change.i.cans
%| p.change.i.cans
%& (page-to-lobe:util p.change.i.cans)
:: Don't use p.change.i.cans because that's before casting to
:: the correct mark.
::
%& (page-to-lobe:util [p q.q]:cage)
==
=^ so-far ford-cache.ford-args $(cans t.cans)
[(~(put by so-far) path.i.cans lobe cage) ford-cache.ford-args]
@ -3698,7 +3702,7 @@
path.i.cans t.path.i.cans
ankh (~(gut by dir.ankh) i.path.i.cans *^ankh)
==
:- child-ankh(dir (~(put by dir.ankh) i.path.i.cans child-ankh))
:- ankh(dir (~(put by dir.ankh) i.path.i.cans child-ankh))
ford-cache.ford-args
[ankh(fil `[lobe.i.cans cage.i.cans]) ford-cache.ford-args]
=. ankh new-ankh
@ -3765,6 +3769,8 @@
|^
?~ hun
~
?: =(0 let.dom)
~
%+ weld
%+ turn ~(tap in deletes)
|= =path
@ -3775,7 +3781,7 @@
::
++ path-to-tank
|= =path
=/ pre=^path ~[(scot %p our) syd (scot %ud let.dom)]
=/ pre=^path ~[(scot %p our) syd (scot %ud +(let.dom))]
:+ %rose ["/" "/" ~]
%+ turn (weld pre path)
|= a=cord
@ -3791,17 +3797,36 @@
|= $: changes=(map path (each page lobe))
change-cages=(map path [lobe cage])
==
^- [(map path [lobe cage]) args:ford:fusion]
=/ =yaki (~(got by hut.ran) (~(got by hit.dom) let.dom))
^- (unit [(map path [lobe cage]) args:ford:fusion])
=/ tak=(unit tako) (~(get by hit.dom) let.dom)
?~ tak
~
=/ =yaki (~(got by hut.ran) u.tak)
:: Assert all blobs hash to their lobe
::
=/ foo
%- ~(urn by lat.ran)
|= [=lobe =blob]
?: ?=(%delta -.blob)
~
=/ actual-lobe=^lobe `@uv`(page-to-lobe q.blob)
~| [lobe p.blob actual-lobe]
?> &(=(lobe p.blob) =(lobe actual-lobe))
~
:: Assert all new lobes are reachable
::
=/ files=(list [=path =lobe]) ~(tap by q.yaki)
|- ^+ *sane-changes
?^ files
?. (~(has by lat.ran) lobe.i.files)
~| missing-lobe=[path lobe]
!!
$(files t.files)
:: XX Needs to run after dome is updated
::
:: =/ files=(list [=path =lobe]) ~(tap by q.yaki)
:: |- ^+ *sane-changes
:: ?^ files
:: ?. (~(has by lat.ran) lobe.i.files)
:: ~| missing-lobe=[path lobe]
:: !!
:: $(files t.files)
:: Assert we calculated the same change-cages w/o cache
::
:: XX remove deletes
::
=/ all-changes=(map path (each page lobe))
=/ original=(map path (each page lobe))
@ -3814,22 +3839,44 @@
=/ ccs=(list [=path =lobe =cage]) ~(tap by change-cages)
|- ^+ *sane-changes
?^ ccs
?. =(`cage.i.ccs (~(get by all-change-cages) path.i.ccs))
~| not-same-cages+path
?. =(`[lobe cage]:i.ccs (~(get by all-change-cages) path.i.ccs))
~| not-same-cages+path.i.ccs
!!
$(ccs t.ccs)
[all-change-cages args]
`[all-change-cages args]
::
++ sane-ankh
|= $: [change-cages=(map path [lobe cage]) =ford=args:ford:fusion]
|= $: $= cont
(unit [all-changes=(map path [lobe cage]) =ford=args:ford:fusion])
=test=ankh
==
?~ cont
~
=+ u.cont
=^ ankh ford-cache.ford-args
(checkout-ankh ford-args ~ change-cages *ankh)
?. =(ankh test-ankh)
~| %not-same-ankh
(checkout-ankh ford-args ~ all-changes *ankh)
=| =path
|- ^- ~
=* loop $
=/ fil (bind fil.ankh |=([=lobe =cage] [lobe p.cage q.q.cage]))
=/ test (bind fil.ankh |=([=lobe =cage] [lobe p.cage q.q.cage]))
?. =(fil test)
~| [%not-same-file path ?=(~ fil.ankh) ?=(~ fil.test-ankh)]
~| ?~(fil.ankh ~ [[p p.q]:u.fil.ankh `@uv`(page-to-lobe [p q.q]:q.u.fil.ankh)])
~| ?~(fil.test-ankh ~ [[p p.q]:u.fil.test-ankh `@uv`(page-to-lobe [p q.q]:q.u.fil.test-ankh)])
!!
~
?. =(~(key by dir.ankh) ~(key by dir.test-ankh))
~| [%not-same-children path ~(key by dir.ankh) ~(key by dir.test-ankh)]
!!
=< ~
%+ turn ~(tap by dir.ankh)
|= [=@ta =child=^ankh]
~| sane-ankh=[path ta]
%= loop
path (snoc path ta)
ankh child-ankh
test-ankh (~(got by dir.test-ankh) ta)
==
::
:: Find /sys changes
::
@ -5333,21 +5380,8 @@
=/ dos (~(get by dos.rom.ruf) q.bem)
?~ dos
!! :: fire next in queue
?: =(0 let.dom.u.dos)
=+ cos=(mode-to-soba ~ s.bem all.req fis.req)
=/ [one=soba two=soba]
%+ skid cos
|= [a=path b=miso]
?& ?=(%ins -.b)
?=(%mime p.p.b)
?=([%hoon ~] (slag (dec (lent a)) a))
==
:_ ..^$
:~ [hen %pass /one %c %info q.bem %& one]
[hen %pass /two %c %info q.bem %& two]
==
=^ mos ruf
=/ den ((de our now ski hen ruf) our des.req)
=/ den ((de our now ski hen ruf) our q.bem)
abet:(into:den (flop s.bem) all.req fis.req)
[mos ..^$]
::