mirror of
https://github.com/urbit/shrub.git
synced 2025-01-01 17:16:47 +03:00
kiln: convert to fusion
This commit is contained in:
Philip Monk
parent
af1a26aa5d
commit
fd26b2184e
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:2c2de07be164de8a840cc724294a0b6770a9fb7b9cd28026ada3ea4a9a18cbd2
|
||||
size 13198099
|
||||
oid sha256:d86877601e9038c205c3ee2e2dfc646c5d3cfc6c7d144a5b5bc14e1241a9f116
|
||||
size 13136154
|
||||
|
||||
@ -338,8 +338,6 @@
|
||||
?+ +<.sign-arvo ~|([%kiln-bad-take-card +<.sign-arvo] !!)
|
||||
%done %+ done wire
|
||||
?>(?=(%done +<.sign-arvo) +>.sign-arvo)
|
||||
%made %+ take-made wire
|
||||
?>(?=(%made +<.sign-arvo) +>.sign-arvo)
|
||||
%mere %+ take-mere wire
|
||||
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
|
||||
==
|
||||
@ -349,18 +347,6 @@
|
||||
|= {way/wire are/(each (set path) (pair term tang))}
|
||||
abet:abet:(mere:(take way) are)
|
||||
::
|
||||
++ take-made
|
||||
|= [way=wire date=@da result=made-result:ford]
|
||||
:: hack for |overload
|
||||
::
|
||||
:: We might have gotten an ignorable response back for our cache priming
|
||||
:: ford call. If it matches our magic wire, ignore it.
|
||||
::
|
||||
?: =(/prime/cache way)
|
||||
~& %cache-primed
|
||||
abet
|
||||
abet:abet:(made:(take way) date result)
|
||||
::
|
||||
++ take-coup-fancy ::
|
||||
|= {way/wire saw/(unit tang)}
|
||||
abet:abet:(coup-fancy:(take way) saw)
|
||||
@ -603,10 +589,7 @@
|
||||
++ coup-fancy
|
||||
|= saw/(unit tang)
|
||||
?~ saw
|
||||
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
|
||||
%- blab :_ ~
|
||||
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
|
||||
[%pass /kiln/[syd] %arvo %c note]
|
||||
+>
|
||||
=+ :- "failed to set up conflict resolution scratch space"
|
||||
"I'm out of ideas"
|
||||
lose:(spam leaf+-< leaf+-> u.saw)
|
||||
@ -620,35 +603,60 @@
|
||||
=+ "merged with strategy {<gem>}"
|
||||
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
|
||||
:: ~? > =(~ p.are) [%mere-no-conflict syd]
|
||||
=+ "mashing conflicts"
|
||||
=> .(+>.$ (spam leaf+- ~))
|
||||
=> .(+>.$ (spam leaf+"mashing conflicts" ~))
|
||||
=+ tic=(cat 3 syd '-scratch')
|
||||
%- blab :_ ~
|
||||
=, ford
|
||||
:* %pass /kiln/[syd] %arvo %f
|
||||
:* %build live=%.n
|
||||
^- schematic
|
||||
:- %list
|
||||
^- (list schematic)
|
||||
:: ~& > kiln-mashing+[p.are syd=syd +<.abet]
|
||||
%+ turn ~(tap in p.are)
|
||||
|= pax/path
|
||||
^- [schematic schematic]
|
||||
:- [%$ %path -:!>(*path) pax]
|
||||
=/ base=schematic [%scry %c %x `rail`[[our tic] (flop pax)]]
|
||||
?> ?=([%da @] cas)
|
||||
=/ alis=schematic
|
||||
[%pin p.cas `schematic`[%scry %c %x [[our syd] (flop pax)]]]
|
||||
=/ bobs=schematic
|
||||
[%scry %c %x [[our syd] (flop pax)]]
|
||||
=/ dali=schematic [%diff [our syd] base alis]
|
||||
=/ dbob=schematic [%diff [our syd] base bobs]
|
||||
=/ for=mark
|
||||
=+ (slag (dec (lent pax)) pax)
|
||||
?~(- %$ i.-)
|
||||
^- schematic
|
||||
[%mash [our tic] for [[her sud] for dali] [[our syd] for dbob]]
|
||||
== ==
|
||||
=/ notations=(list [path (unit [mark vase])])
|
||||
%+ turn ~(tap in p.are)
|
||||
|= =path
|
||||
=/ =mark -:(flop path)
|
||||
=/ =dais .^(dais %cb /(scot %p our)/[syd]/(scot cas)/[mark])
|
||||
=/ base .^(vase %cr (weld /(scot %p our)/[tic]/(scot cas) path))
|
||||
=/ ali .^(vase %cr (weld /(scot %p her)/[sud]/(scot cas) path))
|
||||
=/ bob .^(vase %cr (weld /(scot %p our)/[syd]/(scot cas) path))
|
||||
=/ ali-dif (~(diff dais base) ali)
|
||||
=/ bob-dif (~(diff dais base) bob)
|
||||
=/ mash (~(mash dais base) [her sud ali-dif] [our syd bob-dif])
|
||||
:- path
|
||||
?~ mash
|
||||
~
|
||||
`[mark (~(pact dais base) u.mash)]
|
||||
=/ [annotated=(list [path *]) unnotated=(list [path *])]
|
||||
(skid notations |=([* v=*] ?=(^ v)))
|
||||
=/ tic=desk (cat 3 syd '-scratch')
|
||||
=/ tan=(list tank)
|
||||
%- zing
|
||||
^- (list (list tank))
|
||||
:~ %- tape-to-tanks
|
||||
"""
|
||||
done setting up scratch space in {<[tic]>}
|
||||
please resolve the following conflicts and run
|
||||
|merge {<syd>} our {<[tic]>}
|
||||
"""
|
||||
%^ tanks-if-any
|
||||
"annotated conflicts in:" (turn annotated head)
|
||||
""
|
||||
%^ tanks-if-any
|
||||
"unannotated conflicts in:" (turn unnotated head)
|
||||
"""
|
||||
some conflicts could not be annotated.
|
||||
for these, the scratch space contains
|
||||
the most recent common ancestor of the
|
||||
conflicting content.
|
||||
"""
|
||||
==
|
||||
=< win
|
||||
%- blab:(spam tan)
|
||||
:_ ~
|
||||
:* %pass /kiln/[syd] %arvo %c
|
||||
%info
|
||||
tic %&
|
||||
%+ murn notations
|
||||
|= [=path dif=(unit [=mark =vase])]
|
||||
^- (unit [^path miso])
|
||||
?~ dif
|
||||
~
|
||||
`[path %mut mark.u.dif vase.u.dif]
|
||||
==
|
||||
=+ "failed to merge with strategy meld"
|
||||
lose:(spam leaf+- >p.p.are< q.p.are)
|
||||
?: ?=(%& -.are)
|
||||
@ -688,7 +696,11 @@
|
||||
=> =+ :- "%mate merge failed with conflicts,"
|
||||
"setting up scratch space at %{(trip tic)}"
|
||||
[tic=tic (spam leaf+-< leaf+-> q.p.are)]
|
||||
(fancy-merge tic our syd %init)
|
||||
=. ..mere (fancy-merge tic our syd %init)
|
||||
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
|
||||
%- blab :_ ~
|
||||
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
|
||||
[%pass /kiln/[syd] %arvo %c note]
|
||||
==
|
||||
::
|
||||
++ tape-to-tanks
|
||||
@ -699,68 +711,5 @@
|
||||
|= {a/tape b/(list path) c/tape} ^- (list tank)
|
||||
?: =(~ b) ~
|
||||
(welp (tape-to-tanks "\0a{c}{a}") >b< ~)
|
||||
::
|
||||
++ made
|
||||
|= [date=@da result=made-result:ford]
|
||||
:: |= {dep/@uvH reg/gage:ford}
|
||||
^+ +>
|
||||
::
|
||||
?: ?=([%incomplete *] result)
|
||||
=+ "failed to mash"
|
||||
lose:(spam leaf+- tang.result)
|
||||
?: ?=([%complete %error *] result)
|
||||
=+ "failed to mash"
|
||||
lose:(spam leaf+- message.build-result.result)
|
||||
?> ?=([%complete %success %list *] result)
|
||||
=/ can=(list (pair path (unit miso)))
|
||||
%+ turn results.build-result.result
|
||||
|= res=build-result:ford
|
||||
^- (pair path (unit miso))
|
||||
?> ?=([%success ^ *] res)
|
||||
~! res
|
||||
=+ pax=(result-to-cage:ford head.res)
|
||||
=+ dif=(result-to-cage:ford tail.res)
|
||||
::
|
||||
?. ?=($path p.pax)
|
||||
~| "strange path mark: {<p.pax>}"
|
||||
!!
|
||||
[;;(path q.q.pax) ?:(?=($null p.dif) ~ `[%dif dif])]
|
||||
:: ~& > kiln-made+[(turn can head) syd=syd +<.abet]
|
||||
=+ notated=(skid can |=({path a/(unit miso)} ?=(^ a)))
|
||||
=+ annotated=(turn `(list (pair path *))`-.notated head)
|
||||
=+ unnotated=(turn `(list (pair path *))`+.notated head)
|
||||
=+ `desk`(cat 3 syd '-scratch')
|
||||
=/ tan=(list tank)
|
||||
%- zing
|
||||
^- (list (list tank))
|
||||
:~ %- tape-to-tanks
|
||||
"""
|
||||
done setting up scratch space in {<[-]>}
|
||||
please resolve the following conflicts and run
|
||||
|merge {<syd>} our {<[-]>}
|
||||
"""
|
||||
%^ tanks-if-any
|
||||
"annotated conflicts in:" annotated
|
||||
""
|
||||
%^ tanks-if-any
|
||||
"unannotated conflicts in:" unnotated
|
||||
"""
|
||||
some conflicts could not be annotated.
|
||||
for these, the scratch space contains
|
||||
the most recent common ancestor of the
|
||||
conflicting content.
|
||||
|
||||
"""
|
||||
==
|
||||
=< win
|
||||
%- blab:(spam tan)
|
||||
:_ ~
|
||||
:* %pass /kiln/[syd] %arvo %c
|
||||
:* %info
|
||||
(cat 3 syd '-scratch') %&
|
||||
%+ murn can
|
||||
|= {p/path q/(unit miso)}
|
||||
`(unit (pair path miso))`?~(q ~ `[p u.q])
|
||||
== ==
|
||||
--
|
||||
--
|
||||
|
||||
@ -1491,7 +1491,7 @@
|
||||
?~ cans
|
||||
[~ ford-cache.ford-args]
|
||||
=^ cage ford-cache.ford-args
|
||||
~> %slog.[0 leaf+"clay: validating {(spud path.i.cans)}"]
|
||||
:: ~> %slog.[0 leaf+"clay: validating {(spud path.i.cans)}"]
|
||||
%- wrap:fusion
|
||||
(get-value:(ford:fusion ford-args) path.i.cans)
|
||||
=/ =lobe
|
||||
@ -1694,6 +1694,8 @@
|
||||
~+
|
||||
?: =(0 let.dom)
|
||||
~
|
||||
?. =(%home syd)
|
||||
~
|
||||
%- malt
|
||||
%+ skim ~(tap by changes)
|
||||
|= [=path *]
|
||||
@ -2486,6 +2488,7 @@
|
||||
$c ~| %casts-should-be-compiled-on-your-own-ship !!
|
||||
$d ~| %totally-temporary-error-please-replace-me !!
|
||||
$p ~| %requesting-foreign-permissions-is-invalid !!
|
||||
$r ~| %no-cages-please-they-are-just-way-too-big !!
|
||||
$s ~| %please-dont-get-your-takos-over-a-network !!
|
||||
$t ~| %requesting-foreign-directory-is-vaporware !!
|
||||
$u ~| %prolly-poor-idea-to-get-rang-over-network !!
|
||||
@ -3242,13 +3245,8 @@
|
||||
|= [=yaki pax=path]
|
||||
^- @uvI
|
||||
=+ len=(lent pax)
|
||||
:: ~& read-z+[yon=yon qyt=~(wyt by q.yaki) pax=pax]
|
||||
=/ descendants/(list (pair path lobe))
|
||||
:: ~& %turning
|
||||
:: =- ~& %turned -
|
||||
%+ turn
|
||||
:: ~& %skimming
|
||||
:: =- ~& %skimmed -
|
||||
%+ skim ~(tap by (~(del by q.yaki) pax))
|
||||
|= {paf/path lob/lobe}
|
||||
=(pax (scag len paf))
|
||||
@ -3261,6 +3259,16 @@
|
||||
^- (list (pair path lobe))
|
||||
[[~ ?~(us *lobe u.us)] descendants]
|
||||
|=({{path lobe} @uvI} (shax (jam +<)))
|
||||
:: +read-r: %x wrapped in a vase
|
||||
::
|
||||
++ read-r
|
||||
|= [yon=aeon pax=path]
|
||||
^- (unit (unit cage))
|
||||
=/ x (read-x yon pax)
|
||||
?~ x ~
|
||||
?~ u.x [~ ~]
|
||||
?> ?=(%& -.u.u.x)
|
||||
``[p.p.u.u.x !>(q.p.u.u.x)]
|
||||
:: +read-s: produce yaki or blob for given tako or lobe
|
||||
::
|
||||
++ read-s
|
||||
@ -3496,6 +3504,7 @@
|
||||
%b (read-b yon path.mun)
|
||||
%c (read-c yon path.mun)
|
||||
%p :_(fod (read-p path.mun))
|
||||
%r :_(fod (bind (read-r yon path.mun) (lift |=(a=cage [%& a]))))
|
||||
%s :_(fod (bind (read-s yon path.mun) (lift |=(a=cage [%& a]))))
|
||||
%t :_(fod (bind (read-t yon path.mun) (lift |=(a=cage [%& a]))))
|
||||
%u :_(fod (read-u yon path.mun))
|
||||
|
||||
@ -582,7 +582,7 @@
|
||||
$% {$delta p/lobe q/{p/mark q/lobe} r/page} :: delta on q
|
||||
{$direct p/lobe q/page} :: immediate
|
||||
== ::
|
||||
++ care ?($a $b $c $d $p $s $t $u $v $w $x $y $z) :: clay submode
|
||||
++ care ?($a $b $c $d $p $r $s $t $u $v $w $x $y $z) :: clay submode
|
||||
++ case :: ship desk case spur
|
||||
$% {$da p/@da} :: date
|
||||
{$tas p/@tas} :: label
|
||||
|
||||
Loading…
Reference in New Issue
Block a user