clay: move merge back into clay

This commit is contained in:
Philip Monk 2020-05-12 00:01:46 -07:00
parent e75ab631a4
commit aacd6f80d8
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
3 changed files with 477 additions and 27 deletions

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:71ae16ec67745d9c03cc24d4f85e3d4ad640b05b85a45457e413d1af37cf50da
size 13983138
oid sha256:684f47c147418d1424376be0088d59063bda843c7749196400bf96e8293d3e43
size 14063453

View File

@ -724,12 +724,13 @@
(dy-vase p.u.val)
%+ slap
(with-faces gat+gat rep+(with-faces soz) ~)
%- (slog >%try< (sell (slot 27 gat)) ~)
:+ %cncb ~[%gat]
^- (list [wing hoon])
%+ turn soz
|= [var=term vax=vase]
^- [wing hoon]
[~[var &+27 %gat] [%wing var %rep ~]]
[~[var &+27] [%wing var %rep ~]]
(slap gat ^~((ream '(.)')))
::
++ dy-made-dial :: dialog product
@ -847,7 +848,7 @@
?^ val=(dy-hoon-var hoon)
&+u.val
%- mule |.
:- %hoon
:- %noun
=/ vaz=(list [term vase])
(turn ~(tap by var) |=([lal=term cag=cage] [lal q.cag]))
=/ sut (slop !>([our=our now=now eny=eny]:hid) !>(..zuse))

View File

@ -2763,7 +2763,6 @@
?^ ezy
:_(fod.dom.red `(bind u.ezy |=(a/cage [%& a])))
=+ nao=(case-to-aeon case.mun)
:: ~& [%aver-mun nao [%from syd lim case.mun]]
?~(nao [~ fod.dom.red] (read-at-aeon:ze for u.nao mun))
::
:: Queue a move.
@ -3520,6 +3519,469 @@
--
--
::
:: We always say we're merging from 'ali' to 'bob'. The basic steps,
:: not all of which are always needed, are:
::
:: -- fetch ali's desk, async in case it's remote
:: -- diff ali's desk against the mergebase
:: -- diff bob's desk against the mergebase
:: -- merge the diffs
:: -- commit
::
++ start-merge
|= [=ali=ship =ali=desk =case =germ]
^+ ..start-merge
=/ =wire /merge/[syd]/(scot %p ali-ship)/[ali-desk]/[germ]
(emit hen %pass wire %c %warp ali-ship ali-desk `[%sing %v case /])
::
++ merge
|= [=ali=ship =ali=desk =germ =riot]
^+ ..merge
|^
?~ riot
(done %| %ali-unavailable >[ali-ship ali-desk germ]< ~)
=/ ali-dome=dome:clay !<(dome:clay q.r.u.riot)
=/ ali-yaki=yaki (~(got by hut.ran) (~(got by hit.ali-dome) let.ali-dome))
=/ bob-yaki=(unit yaki)
?~ let.dom
~
(~(get by hut.ran) (~(got by hit.dom) let.dom))
=/ merge-result (merge-by-germ ali-yaki bob-yaki)
?: ?=(%| -.merge-result)
(done %| p.merge-result)
?~ p.merge-result
(done %& ~)
=. ..merge (done %& conflicts.u.p.merge-result)
(park | new.u.p.merge-result ~ lat.u.p.merge-result)
::
++ done
|= result=(each (set path) (pair term tang))
^+ ..merge
(emit hen %give %mere result)
::
+$ merge-result [conflicts=(set path) new=yoki lat=(map lobe blob)]
++ merge-by-germ
|= [=ali=yaki bob-yaki=(unit yaki)]
^- (each (unit merge-result) [term tang])
::
:: If this is an %init merge, we set the ali's commit to be
:: bob's.
::
?: ?=(%init germ)
&+`[conflicts=~ new=|+ali-yaki lat=~]
::
=/ bob-yaki (need bob-yaki)
|^
^- (each (unit merge-result) [term tang])
?- germ
::
:: If this is a %this merge, we check to see if ali's and bob's
:: commits are the same, in which case we're done. Otherwise, we
:: check to see if ali's commit is in the ancestry of bob's, in
:: which case we're done. Otherwise, we create a new commit with
:: bob's data plus ali and bob as parents.
::
%this
?: =(r.ali-yaki r.bob-yaki)
&+~
?: (~(has in (reachable-takos r.bob-yaki)) r.ali-yaki)
&+~
:* %& ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki q.bob-yaki)]
lat=~
==
::
:: If this is a %that merge, we check to see if ali's and bob's
:: commits are the same, in which case we're done. Otherwise, we
:: create a new commit with ali's data plus ali and bob as
:: parents.
::
%that
?: =(r.ali-yaki r.bob-yaki)
&+~
:* %& ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki q.ali-yaki)]
lat=~
==
::
:: If this is a %fine merge, we check to see if ali's and bob's
:: commits are the same, in which case we're done. Otherwise, we
:: check to see if ali's commit is in the ancestry of bob's, in
:: which case we're done. Otherwise, we check to see if bob's
:: commit is in the ancestry of ali's. If not, this is not a
:: fast-forward merge, so we error out. If it is, we add ali's
:: commit to bob's desk and checkout.
::
%fine
?: =(r.ali-yaki r.bob-yaki)
&+~
?: (~(has in (reachable-takos r.bob-yaki)) r.ali-yaki)
&+~
?. (~(has in (reachable-takos r.ali-yaki)) r.bob-yaki)
:~ %| %bad-fine-merge
leaf+"tried fast-forward but is not ancestor or descendant"
==
&+`[conflicts=~ new=|+ali-yaki lat=~]
::
?(%meet %mate %meld)
?: =(r.ali-yaki r.bob-yaki)
&+~
?: (~(has in (reachable-takos r.bob-yaki)) r.ali-yaki)
&+~
?: (~(has in (reachable-takos r.ali-yaki)) r.bob-yaki)
$(germ %fine)
=/ merge-points find-merge-points
?~ merge-points
:~ %| %merge-no-merge-base
leaf+"consider a %this or %that merge to get a mergebase"
==
=/ merge-point=yaki n.merge-points
?. ?=(%meet germ)
=/ ali-diffs=cane (diff-base ali-yaki bob-yaki merge-point)
=/ bob-diffs=cane (diff-base bob-yaki ali-yaki merge-point)
=/ bof=(map path (unit cage))
(merge-conflicts can.ali-diffs can.bob-diffs)
&+`(build ali-yaki bob-yaki merge-point ali-diffs bob-diffs bof)
=/ ali-diffs=cane (calc-diffs ali-yaki merge-point)
=/ bob-diffs=cane (calc-diffs bob-yaki merge-point)
=/ both-diffs=(map path *)
%- %~ int by
%- ~(uni by `(map path *)`new.ali-diffs)
%- ~(uni by `(map path *)`cal.ali-diffs)
%- ~(uni by `(map path *)`can.ali-diffs)
`(map path *)`old.ali-diffs
%- ~(uni by `(map path *)`new.bob-diffs)
%- ~(uni by `(map path *)`cal.bob-diffs)
%- ~(uni by `(map path *)`can.bob-diffs)
`(map path *)`old.bob-diffs
?. =(~ both-diffs)
:~ %| %meet-conflict
>~(key by both-diffs)<
leaf+"consider a %mate merge"
==
=/ not-deleted=(map path lobe)
%+ roll ~(tap by (~(uni by old.ali-diffs) old.bob-diffs))
=< .(not-deleted q.merge-point)
|= [[pax=path ~] not-deleted=(map path lobe)]
(~(del by not-deleted) pax)
=/ hat=(map path lobe)
%- ~(uni by not-deleted)
%- ~(uni by new.ali-diffs)
%- ~(uni by new.bob-diffs)
%- ~(uni by cal.ali-diffs)
cal.bob-diffs
:* %& ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki hat)]
lat=~
==
==
::
++ to-yuki
|= m=(map path lobe)
^- (map path (each page lobe))
(~(run by m) |=(=lobe |+lobe))
::
++ reachable-takos
|= tak=tako
^- (set tako)
|- ^- (set tako)
=/ =yaki (~(got by hut.ran) tak)
%+ roll p.yaki
=< .(takos (~(put in *(set tako)) tak))
|= [q=tako takos=(set tako)]
?: (~(has in takos) q) :: already done
takos :: hence skip
(~(uni in takos) ^$(tak q)) :: otherwise traverse
::
:: Find the most recent common ancestor(s).
::
:: Pretty sure this could be a lot more efficient.
::
++ find-merge-points
^- (set yaki)
%- reduce-merge-points
=+ r=(reachable-takos r.ali-yaki)
|- ^- (set yaki)
~! bob-yaki
?: (~(has in r) r.bob-yaki) (~(put in *(set yaki)) bob-yaki)
%+ roll p.bob-yaki
|= [t=tako s=(set yaki)]
?: (~(has in r) t)
(~(put in s) (~(got by hut.ran) t))
(~(uni in s) ^$(bob-yaki (~(got by hut.ran) t)))
::
:: Eliminate redundant merge-point candidates
::
++ reduce-merge-points
|= unk=(set yaki)
=| gud=(set yaki)
=/ zar=(map tako (set tako))
%+ roll ~(tap in unk)
|= [yak=yaki qar=(map tako (set tako))]
(~(put by qar) r.yak (reachable-takos r.yak))
|-
^- (set yaki)
?~ unk gud
=+ bun=(~(del in `(set yaki)`unk) n.unk)
?: %+ levy ~(tap by (~(uni in gud) bun))
|= yak=yaki
!(~(has in (~(got by zar) r.yak)) r.n.unk)
$(gud (~(put in gud) n.unk), unk bun)
$(unk bun)
::
:: The set of changes between the mergebase and one of the desks
:: being merged
::
:: -- `new` is the set of files in the new desk and not in the
:: mergebase.
:: -- `cal` is the set of changes in the new desk from the
:: mergebase except for any that are also in the other new desk.
:: -- `can` is the set of changes in the new desk from the
:: mergebase that are also in the other new desk (potential
:: conflicts).
:: -- `old` is the set of files in the mergebase and not in the
:: new desk.
::
+$ cane
$: new=(map path lobe)
cal=(map path lobe)
can=(map path cage)
old=(map path ~)
==
::
:: Calculate cane knowing there are no files changed by both
:: desks
::
++ calc-diffs
|= [hed=yaki bas=yaki]
^- cane
:* %- molt
%+ skip ~(tap by q.hed)
|= [pax=path lob=lobe]
(~(has by q.bas) pax)
::
%- molt
%+ skip ~(tap by q.hed)
|= [pax=path lob=lobe]
=+ (~(get by q.bas) pax)
|(=(~ -) =([~ lob] -))
::
~
::
%- malt ^- (list [path ~])
%+ murn ~(tap by q.bas)
|= [pax=path lob=lobe]
^- (unit (pair path ~))
?. =(~ (~(get by q.hed) pax))
~
`[pax ~]
==
::
:: Diff yak against bas where different from yuk
::
++ diff-base
|= [yak=yaki yuk=yaki bas=yaki]
^- cane
=/ new=(map path lobe)
%- malt
%+ skip ~(tap by q.yak)
|= [=path =lobe]
(~(has by q.bas) path)
::
=/ cal=(map path lobe)
%- malt ^- (list [path lobe])
%+ murn ~(tap by q.bas)
|= [pax=path lob=lobe]
^- (unit (pair path lobe))
=+ a=(~(get by q.yak) pax)
=+ b=(~(get by q.yuk) pax)
?. ?& ?=(^ a)
!=([~ lob] a)
=([~ lob] b)
==
~
`[pax +.a]
::
=/ can=(map path cage)
%- malt
%+ murn ~(tap by q.bas)
|= [=path =lobe]
^- (unit [^path cage])
=/ in-yak (~(get by q.yak) path)
?~ in-yak
~
?: =(lobe u.in-yak)
~
=/ in-yuk (~(get by q.yuk) path)
?~ in-yuk
~
?: =(lobe u.in-yuk)
~
?: =(u.in-yak u.in-yuk)
~
`[path (diff-lobes lobe u.in-yak)]
::
=/ old=(map path ~)
%- malt ^- (list [path ~])
%+ murn ~(tap by q.bas)
|= [pax=path lob=lobe]
?. =(~ (~(get by q.yak) pax))
~
(some pax ~)
::
[new cal can old]
::
:: These can/should save their caches
::
++ lobe-to-cage
|= =lobe
^- cage
=^ =page fod.dom
%- wrap:fusion
(lobe-to-page:(ford:fusion ank.dom ~ ~ lat.ran fod.dom) lobe)
=^ =cage fod.dom
%- wrap:fusion
(page-to-cage:(ford:fusion ank.dom ~ ~ lat.ran fod.dom) page)
cage
::
++ get-dais
|= =mark
^- dais
=^ =dais fod.dom
%- wrap:fusion
(get-mark:(ford:fusion ank.dom ~ ~ lat.ran fod.dom) mark)
dais
::
:: Diff two files on bob-desk
::
++ diff-lobes
|= [=a=lobe =b=lobe]
^- cage
=/ a-cage (lobe-to-cage a-lobe)
=/ b-cage (lobe-to-cage b-lobe)
?> =(p.a-cage p.b-cage)
=/ =dais (get-dais p.a-cage)
[form:dais (~(diff dais q.a-cage) q.b-cage)]
::
:: Merge diffs that are on the same file.
::
++ merge-conflicts
|= [ali-conflicts=(map path cage) bob-conflicts=(map path cage)]
^- (map path (unit cage))
%- ~(urn by (~(int by ali-conflicts) bob-conflicts))
|= [=path *]
^- (unit cage)
=/ cal=cage (~(got by ali-conflicts) path)
=/ cob=cage (~(got by bob-conflicts) path)
=/ =mark
=+ (slag (dec (lent path)) path)
?~(- %$ i.-)
=/ =dais (get-dais mark)
=/ res=(unit (unit vase)) (~(join dais bunt:dais) q.cal q.cob)
?~ res
~
?~ u.res
~
`[form:dais u.u.res]
::
:: Apply the patches in bof to get the new merged content.
::
:: Gather all the changes between ali's and bob's commits and the
:: mergebase. This is similar to the %meet of ++merge, except
:: where they touch the same file, we use the merged versions.
::
++ build
|= $: ali=yaki
bob=yaki
bas=yaki
dal=cane
dob=cane
bof=(map path (unit cage))
==
^- merge-result
=/ both-patched=(map path cage)
%- malt
%+ murn ~(tap by bof)
|= [=path cay=(unit cage)]
^- (unit [^path cage])
?~ cay
~
:+ ~ path
=+ (~(get by q.bas) path)
?~ -
~| %mate-strange-diff-no-base
!!
=/ =cage (lobe-to-cage u.-)
=/ =dais (get-dais p.cage)
?> =(p.u.cay form.dais)
:- p.cage
(~(pact dais q.cage) q.u.cay)
=/ con=(map path *) :: 2-change conflict
%- molt
%+ skim ~(tap by bof)
|=([pax=path cay=(unit cage)] ?=(~ cay))
=/ cab=(map path lobe) :: conflict base
%- ~(urn by con)
|= [pax=path *]
(~(got by q.bas) pax)
=. con :: change+del conflict
%- ~(uni by con)
%- malt ^- (list [path *])
%+ skim ~(tap by old.dal)
|= [pax=path ~]
?: (~(has by new.dob) pax)
~| %strange-add-and-del
!!
(~(has by can.dob) pax)
=. con :: change+del conflict
%- ~(uni by con)
%- malt ^- (list [path *])
%+ skim ~(tap by old.dob)
|= [pax=path ~]
?: (~(has by new.dal) pax)
~| %strange-del-and-add
!!
(~(has by can.dal) pax)
=. con :: add+add conflict
%- ~(uni by con)
%- malt ^- (list [path *])
%+ skip ~(tap by (~(int by new.dal) new.dob))
|= [pax=path *]
=((~(got by new.dal) pax) (~(got by new.dob) pax))
=/ old=(map path lobe) :: oldies but goodies
%+ roll ~(tap by (~(uni by old.dal) old.dob))
=< .(old q.bas)
|= [[pax=path ~] old=(map path lobe)]
(~(del by old) pax)
=/ [hot=(map path lobe) lat=(map lobe blob)] :: new content
%+ roll ~(tap by both-patched)
|= [[pax=path cay=cage] hat=(map path lobe) lat=(map lobe blob)]
=/ =blob [%direct (page-to-lobe [p q.q]:cay) [p q.q]:cay]
:- (~(put by hat) pax p.blob)
?: (~(has by lat) p.blob)
lat
(~(put by lat) p.blob blob)
=/ hat=(map path lobe) :: all the content
%- ~(uni by old)
%- ~(uni by new.dal)
%- ~(uni by new.dob)
%- ~(uni by cal.dal)
%- ~(uni by cal.dob)
%- ~(uni by hot)
cab
=/ del=(map path ?)
(~(run by (~(uni by old.dal) old.dob)) |=(~ %|))
=/ new &+[[r.bob r.ali ~] (~(run by hat) |=(=lobe |+lobe))]
:* (silt (turn ~(tap by con) head))
new
lat
==
--
--
::
:: Set permissions for a node.
::
++ perm
@ -4916,26 +5378,9 @@
%merg :: direct state up
?: =(%$ des.req)
~&(%merg-no-desk !!)
=. act.ruf
=/ =dojo (~(gut by dos.rom.ruf) des.req *dojo)
=/ writer=form:merge-clad
%- %- merge
:* our
now
[her dem]:req
[our des.req]
cas.req
mon.ruf
hez.ruf
==
:* how.req
dom.dojo
ran.ruf
==
`[hen req %merge (from-form:eval:merge-clad writer)]
=^ mos ruf
=/ den ((de our now ski hen ruf) our des.req)
abet:(take-merge:den clad-init-sign)
abet:(start-merge:den her.req dem.req cas.req how.req)
[mos ..^$]
::
%mont
@ -5118,11 +5563,15 @@
?^ dud
~|(%clay-take-dud (mean tang.u.dud))
::
?: ?=([%merge @ *] tea)
?: ?=([%merge @ @ @ @ ~] tea)
?> ?=(%writ +<.q.hin)
=* syd i.t.tea
=/ ali-ship (slav %p i.t.t.tea)
=* ali-desk i.t.t.t.tea
=/ germ (germ i.t.t.t.t.tea)
=^ mos ruf
=/ den ((de our now ski hen ruf) our syd)
abet:(take-merge:den q.hin)
=/ den ((de our now ski hen ruf) our i.t.tea)
abet:(merge:den ali-ship ali-desk germ p.q.hin)
[mos ..^$]
::
?: ?=([%mount @ *] tea)
@ -5245,7 +5694,7 @@
%crud
[[[hen %slip %d %flog +.q.hin] ~] ..^$]
::
%made ~|(%clay-raw-ford !!)
%made ~& %clay-raw-ford [~ ..^$]
%mere
?: ?=(%& -.p.+.q.hin)
~& 'initial merge succeeded'