send merge messages to talk

This commit is contained in:
Philip C Monk 2015-04-24 16:03:23 -04:00
parent ca788cac3c
commit df357653e9
5 changed files with 32 additions and 315 deletions

View File

@ -2,7 +2,7 @@
:::: /hook/core/helm/app :: ::
:: :: ::
/? 314 :: zuse version
/- *sole :: structures
/- *sole, *talk :: structures
/+ sole :: libraries
:: :: ::
:::: :: ::
@ -228,8 +228,24 @@
::
++ spam
|= mes=(list tank)
=+ (turn mes |=(tank ~&(~(ram re +<) .)))
+>.$
%- blab :_ ~
:* ost %pass /merge/[syd]/spam %g %mess
[our.hid /talk] our.hid %talk-command -:!>(*command)
%publish
%- flop
=< acc
%+ roll mes
=< .(eny eny.hid)
|= [tan=tank acc=(list thought) eny=@uvI]
^- [acc=(list thought) eny=@uvI]
=+ (sham eny mes)
:_ -
:_ acc
^- thought
:+ -
`(map partner (pair envelope delivery))`[[`partner`[%& our.hid %porch] [*envelope %pending]] ~ ~]
`statement`[lat.hid *bouquet [%app (crip ~(ram re tan))]]
==
++ start
|= [her=@p sud=@tas gim=?(%auto germ)]
^+ +>
@ -309,8 +325,8 @@
^- (list (list tank))
:~ :~ leaf/""
leaf/"done setting up scratch space in %{-}"
leaf/"please resolve the following conflicts nd run"
leaf/":helm+merge %{(trip syd)} %{<our.hid>} %{-}"
leaf/"please resolve the following conflicts and run"
leaf/":helm+merge %{(trip syd)} {<our.hid>} %{-}"
==
?~ annotated
~
@ -452,6 +468,8 @@
|= [ost=bone pax=path sih=sign]
?+ pax ~| %helm-strange-path !!
[%merge @tas @ ~]
?: ?=(%spam i.t.t.pax)
[~ +>.$]
he-abet:merge-abet:(work:(he-wish-merge:(hoke ost our.hid) i.t.pax) sih)
==
--

View File

@ -1,305 +0,0 @@
:: Desk sync
::
:::: /hook/core/sync/app
::
|%
++ bead ,[p=(set beam) q=gage]
++ merge-state
$: auto=?
gem=germ
her=@p
sud=@tas
cas=case
==
++ gift
$% [%mean p=ares]
[%nice ~]
[%rush %tang (list tank)]
==
++ milk (trel ship desk silk)
++ move ,[p=bone q=(mold note gift)]
++ note
$% $: %c
$% [%info p=@p q=@tas r=nori]
[%merg p=@p q=@tas r=@p s=@tas t=germ]
== ==
$: %f
$% [%exec p=@p q=beak r=(unit silk)]
== ==
$: %g
$% [%mess p=[ship path] q=ship r=cage]
== == ==
++ sign
$% $: %c
$% [%mere are=(each (set path) (pair term (list tank)))]
== ==
$: %f
$% [%made p=(each bead (list tank))]
== ==
$: %g
$% [%mean p=ares]
[%nice ~]
== == ==
++ silk
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%bunt p=mark] :: example of mark
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%diff p=silk q=silk] :: diff
[%done p=(set beam) q=gage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit gage)] :: unit literal
[%file p=beam] :: from clay
[%join p=mark q=silk r=silk] :: merge
[%mash p=mark q=milk r=milk] :: merge
[%mute p=silk q=(list (pair wing silk))] :: mutant
[%pact p=silk q=silk] :: patch
[%reef ~] :: kernel reef
[%ride p=twig q=silk] :: silk thru twig
[%tabl p=(list (pair silk silk))] :: list
[%vale p=mark q=ship r=*] :: validate [our his]
[%volt p=(set beam) q=(cask ,*)] :: unsafe add type
==
++ tage ,[[%tabl p=(list (pair marc marc))] q=vase] :: %tabl gage
--
!:
::::
::
|_ [hid=hide merges=(map desk merge-state)]
++ me
|= [ost=bone syd=desk]
=+ ^- merge-state
%+ fall (~(get by merges) syd)
=+ *merge-state
%_(- cas [%da lat.hid])
=| mow=(list move)
|%
++ abet
[(flop mow) ..me(merges (~(put by merges) syd auto gem her sud cas))]
::
++ blab
|= new=(list move)
^+ +>
+>.$(mow (welp new mow))
::
++ win (blab [ost %give %nice ~] ~)
++ lose (blab [ost %give %mean ~] ~)
::
++ bead-to-tage
|= res=bead
^- tage
?@ p.q.res
~|(%bad-marc !!)
q.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)]
::
++ merge
^+ .
(blab [ost %pass /[syd]/merge %c %merg our.hid syd her sud gem] ~)
::
++ fancy-merge :: recurse
|= [syd=desk her=@p sud=desk gem=$|(%auto germ)]
^+ +>
%- blab :_ ~
:* ost %pass /[^syd]/fancy %g %mess [our.hid imp.hid] our.hid
%merge-args !>([syd her sud gem ~])
==
::
++ spam (corl blab ^spam)
++ start
|= [her=@p sud=@tas gim=$|(%auto germ)]
^+ +>
?. ?=(%auto gim)
merge(auto |, gem gim, her her, sud sud)
?: =(0 .^(%cw /(scot %p our.hid)/[syd]/(scot %da lat.hid)))
=> $(gim %init)
.(auto &)
=> $(gim %fine)
.(auto &)
::
:: =+ (trip (cat 3 syd '-scratch'))
:: =+ ^- (list tape)
:: :~ "done setting up scratch space in %{-}"
:: "please resolve conflicts in the following files and run"
:: ":merge %{(trip syd)} our %{-}"
:: ""
:: "conflicts in:"
:: ==
:: win:(spam (welp (turn - (cury same %leaf)) [>p.are.sih< ~]))
++ work
|= sih=sign
^+ +>
~| [%working auto=auto gem=gem syd=syd her=her sud=sud]
?: ?=(%meld gem)
?- -.sih
%g
?: ?=(%nice +<.sih)
=> (spam leaf/"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
:* ost %pass /[syd]/scratch %c %merg our.hid
(cat 3 syd '-scratch') her sud gem
==
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
lose:(spam leaf/-< leaf/-> ~)
::
%c
?: ?=(%& -.are.sih)
?. auto
=+ "successfully merged with strategy {<gem>}"
win:(spam leaf/- ?~(p.are.sih ~ [>`(set path)`p.are.sih< ~]))
=+ "mashing conflicts"
=> .(+>.$ (spam leaf/- ~))
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
:* ost %pass /[syd]/mash
%f %exec our.hid [our.hid tic %da lat.hid] ~ %tabl
^- (list (pair silk silk))
%+ turn (~(tap in p.are.sih))
|= pax=path
^- (pair silk silk)
:- [%done ~ %path -:!>(*path) pax]
=+ base=[%file [our.hid tic %da lat.hid] (flop pax)]
=+ alis=[%file [her sud cas] (flop pax)]
=+ bobs=[%file [our.hid syd %da lat.hid] (flop pax)]
=+ dali=[%diff base alis]
=+ dbob=[%diff base bobs]
=+ ^- for=mark
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
[%mash for [her sud dali] [our.hid syd dbob]]
==
=+ "failed to merge with strategy {<p.p.are.sih>}"
lose:(spam leaf/- q.p.are.sih)
::
%f
?: ?=(%| -.p.sih)
=+ "failed to mash"
lose:(spam leaf/- p.p.sih)
=+ ^- can=(list (pair path (unit miso)))
%+ turn (tage-to-cages (bead-to-tage p.p.sih))
|= [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=`(list path)`(turn `(list (pair path ,*))`-.notated head)
=+ unnotated=`(list path)`(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 conflicts in the following files and run"
leaf/":merge %{(trip syd)} our %{-}"
==
?~ 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 %pass /[syd]/dash %c %info
our.hid (cat 3 syd '-scratch')
%& *cart
%+ murn can
|= [p=path q=(unit miso)]
`(unit (pair path miso))`?~(q ~ `[p u.q])
==
==
?> ?=(%c -.sih)
?: ?=(%& -.are.sih)
=+ "successfully merged with strategy {<gem>}"
win:(spam leaf/- ?~(p.are.sih ~ [>`(set path)`p.are.sih< ~]))
?. auto
=+ "failed to merge with strategy {<p.p.are.sih>}"
lose:(spam leaf/- q.p.are.sih)
?+ 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.sih< q.p.are.sih])
::
%fine
?. ?=(%bad-fine-merge p.p.are.sih)
=+ "auto merge failed on strategy %fine"
lose:(spam leaf/- >p.p.are.sih< q.p.are.sih)
=> (spam leaf/"%fine merge failed, trying %meet" ~)
merge(gem %meet)
::
%meet
?. ?=(%meet-conflict p.p.are.sih)
=+ "auto merge failed on strategy %meet"
lose:(spam leaf/- >p.p.are.sih< q.p.are.sih)
=> (spam leaf/"%meet merge failed, trying %mate" ~)
merge(gem %mate)
::
%mate
?. ?=(%mate-conflict p.p.are.sih)
=+ "auto merge failed on strategy %mate"
lose:(spam leaf/- >p.p.are.sih< q.p.are.sih)
=> .(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.hid syd %auto)
==
--
++ peer ,_`.
++ poke--args
|= [ost=bone you=ship syd=@tas her=@p sud=@tas gim=$?(%auto germ)]
^- [(list move) _+>.$]
?~ gim
$(gim [%auto ~])
abet:(start:(me ost syd) her sud -.gim)
::
++ pour
|= [ost=bone pax=path sih=*]
^- [(list move) _+>.$]
~| [%pour-pax pax]
=+ ((soft sign) sih)
?~ -
[(spam leaf/"not working so well" >sih< ~) +>.$]
~| [%pour-sih -.sih +<.sih]
abet:(work:(me ost -.pax) u)
::
++ spam
|= mes=(list tank)
^- (list move)
%+ turn (~(tap in (~(get ju pus.hid) /out)))
|= ost=bone
[ost %give %rush %tang mes]
--

View File

@ -105,7 +105,7 @@
:: ::
++ work :: interface action
$% [%number p=? q=@ud] :: activate by number
[%join p=(set partner)] ::
[%join p=(set partner)] ::
[%say p=speech] ::
[%invite p=span q=(list partner)] ::
[%banish p=span q=(list partner)] ::
@ -1751,6 +1751,9 @@
?: oug
(weld "@ " txt)
(weld " " txt)
::
%app
[' ' (trip p.sep)]
==
--
::

View File

@ -1593,15 +1593,15 @@
::
%fine
?: =(r.ali.dat r.bob.dat)
~& [%fine-trivial ali=<ali> bob=<bob> r.ali.dat r.bob.dat]
:: ~& [%fine-trivial ali=<ali> bob=<bob> r.ali.dat r.bob.dat]
(done:he ~)
?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat)
~& [%fine-mostly-trivial ali=<ali> bob=<bob>]
:: ~& [%fine-mostly-trivial ali=<ali> bob=<bob>]
(done:he ~)
?. (~(has in (reachable-takos r.ali.dat)) r.bob.dat)
~& [%fine-not-so-trivial ali=<ali> bob=<bob>]
:: ~& [%fine-not-so-trivial ali=<ali> bob=<bob>]
(error:he %bad-fine-merge ~)
~& [%fine-lets-go ali=<ali> bob=<bob>]
:: ~& [%fine-lets-go ali=<ali> bob=<bob>]
=. new.dat ali.dat
=. erg.dat
%- mo ^- (list ,[path ?])

View File

@ -63,6 +63,7 @@
[%ire p=serial q=speech] :: in-reply-to
[%lin p=? q=@t] :: no=@, text line
[%mor p=(list speech)] :: multiplex
[%app p=@t] :: app message
== ::
++ serial ,@uvH :: unique identity
++ partner (each station passport) :: interlocutor