2015-05-12 03:31:37 +03:00
|
|
|
:: :: ::
|
|
|
|
|
:::: /hook/core/kiln/lib :: ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
/? 310 :: version
|
|
|
|
|
/- *talk :: structures
|
|
|
|
|
/+ talk :: libraries
|
|
|
|
|
:: :: ::
|
|
|
|
|
:::: :: ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
|% :: ::
|
|
|
|
|
++ kiln-part :: kiln state
|
|
|
|
|
$: %kiln :: doubletag
|
|
|
|
|
%0 :: state version
|
|
|
|
|
rem=(map desk kiln-desk) ::
|
|
|
|
|
== ::
|
|
|
|
|
++ kiln-desk :: per-desk state
|
|
|
|
|
$: auto=? :: escalate on failure
|
|
|
|
|
gem=germ :: strategy
|
|
|
|
|
her=@p :: from ship
|
|
|
|
|
sud=@tas :: from desk
|
|
|
|
|
cas=case :: at case
|
|
|
|
|
== ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
:::: :: ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
++ hood-unix ::
|
|
|
|
|
$: syd=desk ::
|
|
|
|
|
syn=(unit bean) ::
|
|
|
|
|
== ::
|
|
|
|
|
++ hood-sync ::
|
|
|
|
|
$: syd=desk ::
|
|
|
|
|
her=ship ::
|
|
|
|
|
sud=desk ::
|
|
|
|
|
== ::
|
|
|
|
|
++ hood-merge ::
|
|
|
|
|
$: syd=desk ::
|
|
|
|
|
ali=ship ::
|
|
|
|
|
sud=desk ::
|
|
|
|
|
gim=?(%auto germ) ::
|
|
|
|
|
== ::
|
|
|
|
|
-- ::
|
|
|
|
|
:: :: ::
|
|
|
|
|
:::: :: ::
|
|
|
|
|
!: :: ::
|
2015-05-12 23:10:22 +03:00
|
|
|
|% :: kiln library
|
2015-05-12 03:31:37 +03:00
|
|
|
++ kiln-work :: work in kiln
|
|
|
|
|
|= [[hide from] kiln-part]
|
|
|
|
|
?> =(src our)
|
|
|
|
|
=> |% :: arvo structures
|
|
|
|
|
++ card ::
|
|
|
|
|
$% [%exec wire @p beak (unit silk)] ::
|
|
|
|
|
[%font wire @p @tas @p @tas] ::
|
|
|
|
|
[%info wire @p @tas nori] ::
|
|
|
|
|
[%lynx wire @p @tas (unit ,?)] ::
|
|
|
|
|
[%merg wire @p @tas @p @tas germ] ::
|
|
|
|
|
[%plug wire @p @tas @p @tas] ::
|
|
|
|
|
[%poke wire dock pear] ::
|
|
|
|
|
== ::
|
|
|
|
|
++ pear :: poke fruit
|
|
|
|
|
$% [%talk-command command:talk] ::
|
|
|
|
|
[%hood-merge hood-merge] ::
|
|
|
|
|
== ::
|
|
|
|
|
++ suss ,[term @tas @da] :: config report
|
|
|
|
|
++ milk (trel ship desk silk) ::
|
|
|
|
|
++ silk ::
|
|
|
|
|
$& [p=silk q=silk] :: cons
|
|
|
|
|
$% [%diff p=silk q=silk] :: diff
|
|
|
|
|
[%done p=(set beam) q=gage] :: literal
|
|
|
|
|
[%file p=beam] :: from clay
|
|
|
|
|
[%mash p=mark q=milk r=milk] :: merge
|
|
|
|
|
[%tabl p=(list (pair silk silk))] :: list
|
|
|
|
|
== ::
|
|
|
|
|
++ tage :: %tabl gage
|
|
|
|
|
,[[%tabl p=(list (pair marc marc))] q=vase] ::
|
|
|
|
|
++ move (pair bone card) :: user-level move
|
|
|
|
|
--
|
|
|
|
|
|_ moz=(list move)
|
|
|
|
|
++ abet :: resolve
|
|
|
|
|
[(flop moz) `kiln-part`+>+>->]
|
|
|
|
|
::
|
|
|
|
|
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
|
|
|
|
|
++ emil :: return cards
|
|
|
|
|
|= (list card)
|
|
|
|
|
^+ +>
|
|
|
|
|
?~(+< +> $(+< t.+<, +> (emit i.+<)))
|
|
|
|
|
::
|
|
|
|
|
++ poke-unix ::
|
|
|
|
|
|= hood-unix
|
|
|
|
|
abet:(emit %lynx /kiln our syd syn)
|
|
|
|
|
::
|
|
|
|
|
++ poke-sync ::
|
|
|
|
|
|= hood-sync
|
|
|
|
|
abet:(emit %font /kiln our syd her sud)
|
|
|
|
|
::
|
|
|
|
|
++ poke-merge ::
|
|
|
|
|
|= hood-merge
|
|
|
|
|
abet:abet:(merge:(work syd) ali sud gim)
|
|
|
|
|
::
|
|
|
|
|
++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler
|
|
|
|
|
++ take-mere ::
|
|
|
|
|
|= [way=wire are=(each (set path) (pair term tang))]
|
|
|
|
|
abet:abet:(mere:(take way) are)
|
|
|
|
|
::
|
|
|
|
|
++ take-made ::
|
|
|
|
|
|= [way=wire dep=@uvH reg=(each gage tang)]
|
|
|
|
|
abet:abet:(made:(take way) dep reg)
|
|
|
|
|
::
|
|
|
|
|
++ take-coup-fancy ::
|
|
|
|
|
|= [way=wire saw=(unit tang)]
|
|
|
|
|
abet:abet:(coup-fancy:(take way) saw)
|
|
|
|
|
::
|
|
|
|
|
++ work :: state machine
|
|
|
|
|
|= syd=desk
|
|
|
|
|
=+ ^- kiln-desk
|
|
|
|
|
%+ fall (~(get by rem) syd)
|
|
|
|
|
=+ *kiln-desk
|
|
|
|
|
%_(- cas [%da lat])
|
|
|
|
|
|%
|
|
|
|
|
++ abet :: resolve
|
|
|
|
|
..work(rem (~(put by rem) syd auto gem her sud cas))
|
|
|
|
|
::
|
|
|
|
|
++ blab :: emit, XX remove
|
|
|
|
|
|= new=(list move)
|
|
|
|
|
^+ +>
|
|
|
|
|
+>.$(moz (welp new moz))
|
|
|
|
|
::
|
|
|
|
|
++ win . :: successful poke
|
|
|
|
|
++ lose
|
|
|
|
|
^+ .
|
|
|
|
|
~| %kiln-work-failed
|
|
|
|
|
!!
|
|
|
|
|
::
|
|
|
|
|
++ gage-to-tage ::
|
|
|
|
|
|= res=gage
|
|
|
|
|
^- tage
|
|
|
|
|
?@ p.res
|
|
|
|
|
~|(%bad-marc !!)
|
|
|
|
|
res
|
|
|
|
|
::
|
|
|
|
|
++ tage-to-cages ::
|
|
|
|
|
|= tab=tage
|
|
|
|
|
^- (list (pair cage cage))
|
|
|
|
|
?~ p.tab
|
|
|
|
|
~
|
|
|
|
|
:_ $(p.tab t.p.tab, q.tab (slot 3 q.tab))
|
|
|
|
|
~| %strange-gage
|
|
|
|
|
:- [?^(p.i.p.tab !! p.i.p.tab) (slot 4 q.tab)]
|
|
|
|
|
[?^(q.i.p.tab !! q.i.p.tab) (slot 5 q.tab)]
|
|
|
|
|
::
|
|
|
|
|
++ perform ::
|
|
|
|
|
^+ .
|
|
|
|
|
(blab [ost %merg /kiln/[syd] our syd her sud gem] ~)
|
|
|
|
|
::
|
2015-05-14 00:18:43 +03:00
|
|
|
++ fancy-merge :: send to self
|
2015-05-12 03:31:37 +03:00
|
|
|
|= [syd=desk her=@p sud=desk gem=?(%auto germ)]
|
|
|
|
|
^+ +>
|
|
|
|
|
%- blab :_ ~
|
2015-05-14 00:18:43 +03:00
|
|
|
[ost %poke /kiln/fancy/[^syd] [our %hood] %hood-merge [syd her sud gem]]
|
2015-05-12 03:31:37 +03:00
|
|
|
::
|
|
|
|
|
++ spam
|
|
|
|
|
|= mes=(list tank)
|
|
|
|
|
%- blab :_ ~
|
|
|
|
|
:* ost %poke /kiln/spam/[syd]
|
|
|
|
|
[our %talk] %talk-command
|
|
|
|
|
^- command:talk
|
|
|
|
|
:- %publish
|
|
|
|
|
%- flop
|
|
|
|
|
=< acc
|
|
|
|
|
%+ roll mes
|
|
|
|
|
=< .(eny eny)
|
|
|
|
|
|= [tan=tank acc=(list thought:talk) eny=@uvI]
|
|
|
|
|
^- [acc=(list thought:talk) eny=@uvI]
|
|
|
|
|
=+ (sham eny mes)
|
|
|
|
|
:_ -
|
|
|
|
|
:_ acc
|
|
|
|
|
^- thought:talk
|
|
|
|
|
:+ -
|
|
|
|
|
[[[%& our (main our)] [*envelope:talk %pending]] ~ ~]
|
|
|
|
|
[lat *bouquet:talk [%app (crip ~(ram re tan))]]
|
|
|
|
|
==
|
|
|
|
|
::
|
|
|
|
|
++ merge
|
|
|
|
|
|= [her=@p sud=@tas gim=?(%auto germ)]
|
|
|
|
|
^+ +>
|
|
|
|
|
=. cas [%da lat]
|
|
|
|
|
?. ?=(%auto gim)
|
|
|
|
|
perform(auto |, gem gim, her her, sud sud)
|
|
|
|
|
?: =(0 .^(%cw /(scot %p our)/[syd]/(scot %da lat)))
|
|
|
|
|
=> $(gim %init)
|
|
|
|
|
.(auto &)
|
|
|
|
|
=> $(gim %fine)
|
|
|
|
|
.(auto &)
|
|
|
|
|
::
|
|
|
|
|
++ coup-fancy
|
|
|
|
|
|= saw=(unit tang)
|
|
|
|
|
?~ saw
|
|
|
|
|
=> (spam leaf/"%melding %{(trip sud)} into scratch space" ~)
|
|
|
|
|
%- blab :_ ~
|
|
|
|
|
[ost %merg /kiln/[syd] our (cat 3 syd '-scratch') her sud gem]
|
|
|
|
|
=+ :- "failed to set up conflict resolution scratch space"
|
|
|
|
|
"I'm out of ideas"
|
|
|
|
|
lose:(spam leaf/-< leaf/-> ~)
|
|
|
|
|
::
|
|
|
|
|
++ mere
|
|
|
|
|
|= are=(each (set path) (pair term tang))
|
|
|
|
|
^+ +>
|
|
|
|
|
?: =(%meld gem)
|
|
|
|
|
?: ?=(%& -.are)
|
|
|
|
|
?. auto
|
|
|
|
|
=+ "successfully merged with strategy {<gem>}"
|
|
|
|
|
win:(spam leaf/- ?~(p.are ~ [>`(set path)`p.are< ~]))
|
|
|
|
|
=+ "mashing conflicts"
|
|
|
|
|
=> .(+>.$ (spam leaf/- ~))
|
|
|
|
|
=+ tic=(cat 3 syd '-scratch')
|
|
|
|
|
%- blab :_ ~
|
|
|
|
|
:* ost %exec /kiln/[syd]
|
|
|
|
|
our [our tic %da lat] ~ %tabl
|
|
|
|
|
^- (list (pair silk silk))
|
|
|
|
|
%+ turn (~(tap in p.are))
|
|
|
|
|
|= pax=path
|
|
|
|
|
^- (pair silk silk)
|
|
|
|
|
:- [%done ~ %path -:!>(*path) pax]
|
|
|
|
|
=+ base=[%file [our tic %da lat] (flop pax)]
|
|
|
|
|
=+ alis=[%file [her sud cas] (flop pax)]
|
|
|
|
|
=+ bobs=[%file [our syd %da lat] (flop pax)]
|
|
|
|
|
=+ dali=[%diff base alis]
|
|
|
|
|
=+ dbob=[%diff base bobs]
|
|
|
|
|
=+ ^- for=mark
|
|
|
|
|
=+ (slag (dec (lent pax)) pax)
|
|
|
|
|
?~(- %$ i.-)
|
|
|
|
|
[%mash for [her sud dali] [our syd dbob]]
|
|
|
|
|
==
|
|
|
|
|
=+ "failed to merge with strategy {<p.p.are>}"
|
|
|
|
|
lose:(spam leaf/- q.p.are)
|
|
|
|
|
?: ?=(%& -.are)
|
|
|
|
|
=+ "successfully merged with strategy {<gem>}"
|
|
|
|
|
win:(spam leaf/- ?~(p.are ~ [>`(set path)`p.are< ~]))
|
|
|
|
|
?. auto
|
|
|
|
|
=+ "failed to merge with strategy {<p.p.are>}"
|
|
|
|
|
lose:(spam leaf/- q.p.are)
|
|
|
|
|
?+ gem
|
|
|
|
|
(spam leaf/"strange auto" >gem< ~)
|
|
|
|
|
::
|
|
|
|
|
%init
|
|
|
|
|
=+ :- "auto merge failed on strategy %init"
|
|
|
|
|
"I'm out of ideas"
|
|
|
|
|
lose:(spam leaf/-< leaf/-> [>p.p.are< q.p.are])
|
|
|
|
|
::
|
|
|
|
|
%fine
|
|
|
|
|
?. ?=(%bad-fine-merge p.p.are)
|
|
|
|
|
=+ "auto merge failed on strategy %fine"
|
|
|
|
|
lose:(spam leaf/- >p.p.are< q.p.are)
|
|
|
|
|
=> (spam leaf/"%fine merge failed, trying %meet" ~)
|
|
|
|
|
perform(gem %meet)
|
|
|
|
|
::
|
|
|
|
|
%meet
|
|
|
|
|
?. ?=(%meet-conflict p.p.are)
|
|
|
|
|
=+ "auto merge failed on strategy %meet"
|
|
|
|
|
lose:(spam leaf/- >p.p.are< q.p.are)
|
|
|
|
|
=> (spam leaf/"%meet merge failed, trying %mate" ~)
|
|
|
|
|
perform(gem %mate)
|
|
|
|
|
::
|
|
|
|
|
%mate
|
|
|
|
|
?. ?=(%mate-conflict p.p.are)
|
|
|
|
|
=+ "auto merge failed on strategy %mate"
|
|
|
|
|
lose:(spam leaf/- >p.p.are< q.p.are)
|
|
|
|
|
=> .(gem %meld)
|
|
|
|
|
=+ tic=(cat 3 syd '-scratch')
|
|
|
|
|
=> =+ :- "%mate merge failed with conflicts,"
|
|
|
|
|
"setting up scratch space at %{(trip tic)}"
|
|
|
|
|
[tic=tic (spam leaf/-< leaf/-> ~)]
|
|
|
|
|
(fancy-merge tic our syd %auto)
|
|
|
|
|
==
|
|
|
|
|
::
|
|
|
|
|
++ made
|
|
|
|
|
|= [dep=@uvH reg=(each gage tang)]
|
|
|
|
|
^+ +>
|
|
|
|
|
?: ?=(%| -.reg)
|
|
|
|
|
=+ "failed to mash"
|
|
|
|
|
lose:(spam leaf/- p.reg)
|
|
|
|
|
=+ ^- can=(list (pair path (unit miso)))
|
|
|
|
|
%+ turn (tage-to-cages (gage-to-tage p.reg))
|
|
|
|
|
|= [pax=cage dif=cage]
|
|
|
|
|
^- (pair path (unit miso))
|
|
|
|
|
?. ?=(%path p.pax)
|
|
|
|
|
~| "strange path mark: {<p.pax>}"
|
|
|
|
|
!!
|
|
|
|
|
[((hard path) q.q.pax) ?:(?=(%null p.dif) ~ `[%dif dif])]
|
|
|
|
|
=+ notated=(skid can |=([path a=(unit miso)] ?=(^ a)))
|
|
|
|
|
=+ annotated=(turn `(list (pair path ,*))`-.notated head)
|
|
|
|
|
=+ unnotated=(turn `(list (pair path ,*))`+.notated head)
|
|
|
|
|
=+ (trip (cat 3 syd '-scratch'))
|
|
|
|
|
=+ ^- tan=(list tank)
|
|
|
|
|
%- zing
|
|
|
|
|
^- (list (list tank))
|
|
|
|
|
:~ :~ leaf/""
|
|
|
|
|
leaf/"done setting up scratch space in %{-}"
|
|
|
|
|
leaf/"please resolve the following conflicts and run"
|
2015-05-12 23:10:22 +03:00
|
|
|
leaf/":+merge %{(trip syd)} {<our>} %{-}"
|
2015-05-12 03:31:37 +03:00
|
|
|
==
|
|
|
|
|
?~ annotated
|
|
|
|
|
~
|
|
|
|
|
:~ leaf/""
|
|
|
|
|
leaf/"annotated conflicts in:"
|
|
|
|
|
>`(list path)`annotated<
|
|
|
|
|
==
|
|
|
|
|
?~ unnotated
|
|
|
|
|
~
|
|
|
|
|
:~ leaf/""
|
|
|
|
|
leaf/"some conflicts could not be annotated."
|
|
|
|
|
leaf/"for these, the scratch space contains"
|
|
|
|
|
leaf/"the most recent common ancestor of the"
|
|
|
|
|
leaf/"conflicting content."
|
|
|
|
|
leaf/""
|
|
|
|
|
leaf/"unannotated conflicts in:"
|
|
|
|
|
>`(list path)`unnotated<
|
|
|
|
|
==
|
|
|
|
|
==
|
|
|
|
|
=< win
|
|
|
|
|
%- blab:(spam tan)
|
|
|
|
|
:_ ~
|
|
|
|
|
:* ost %info /kiln/[syd]/dash
|
|
|
|
|
our (cat 3 syd '-scratch')
|
|
|
|
|
%& *cart
|
|
|
|
|
%+ murn can
|
|
|
|
|
|= [p=path q=(unit miso)]
|
|
|
|
|
`(unit (pair path miso))`?~(q ~ `[p u.q])
|
|
|
|
|
==
|
|
|
|
|
--
|
|
|
|
|
--
|
|
|
|
|
--
|
