shrub/arvo/clay.hoon
2015-03-06 16:07:34 -05:00

2260 lines
75 KiB
Plaintext

!:
:: clay (4c), revision control
::
|= pit=vase
=> |%
++ bead ,[p=(set beam) q=gage] :: ford result
++ cane :: change set
$: new=(map path lobe) :: new files
can=(map path cage) :: diffs
old=(map path ,~) :: deleted files
== ::
++ cult (map duct rove) :: subscriptions
++ dojo :: domestic desk state
$: qyx=cult :: subscribers
dom=dome :: desk data
dok=(unit dork) :: outstanding diffs
mer=(map (pair ship desk) mery) :: outstanding merges
== ::
++ gift :: out result <-$
$% [%ergo p=@p q=@tas r=@ud s=(list ,[path (unit mime)])]
:: version update
[%mere p=(each (set path) (pair term (list tank)))]
:: merge result
[%note p=@tD q=tank] :: debug message
[%writ p=riot] :: response
== ::
++ khan ::
$: fil=(unit (unit cage)) ::
dir=(map ,@ta khan) ::
== ::
++ kiss :: in request ->$
$% [%font p=@p q=@tas r=@p s=@tas] :: set upstream
[%info p=@p q=@tas r=nori] :: internal edit
[%init p=@p] :: report install
[%into p=@p q=@tas r=khan] :: external edit
[%merg p=@p q=@tas r=@p s=@tas t=germ] :: merge desks
[%plug p=@p q=@tas r=@p s=@tas] :: unset upstream
[%wart p=sock q=@tas r=path s=*] :: network request
[%warp p=sock q=riff] :: file request
== ::
++ mery ::
$: gem=germ :: strategy
cas=case :: ali's case
ali=yaki :: ali's commit
bob=yaki :: bob's commit
bas=yaki :: mergebase
dal=cane :: diff(bas,ali)
dob=cane :: diff(bas,bob)
new=yaki :: merge(dal,dob)
ank=ankh :: new state
erg=(map path ,?) :: ergoable changes
gon=(each (set path) (pair term (list tank))) :: return value
== ::
++ moot ,[p=case q=case r=path s=(map path lobe)] :: stored change range
++ move ,[p=duct q=(mold note gift)] :: local move
++ nako $: gar=(map aeon tako) :: new ids
let=aeon :: next id
lar=(set yaki) :: new commits
bar=(set plop) :: new content
== ::
++ note :: out request $->
$% $: %a :: to %ames
$% [%want p=sock q=path r=*] ::
== == ::
$: %c :: to %clay
$% [%font p=@p q=@tas r=@p s=@tas] ::
[%info p=@p q=@tas r=nori] :: internal edit
[%merg p=@p q=@tas r=@p s=@tas t=germ] :: merge desks
[%warp p=sock q=riff] ::
== == ::
$: %d ::
$% [%flog p=[%crud p=@tas q=(list tank)]] :: to %dill
== == ::
$: %f ::
$% [%exec p=@p q=(unit silk)] ::
== == ::
$: %t ::
$% [%wait p=@da] ::
[%rest p=@da] ::
== == == ::
++ sign :: in result $<-
$? $: %a :: by %ames
$% [%waft p=sock q=*] ::
[%went p=ship q=cape] ::
== == ::
$: %c :: by %clay
$% [%mere p=(each (set path) (pair term (list tank)))]
[%writ p=riot] ::
== == ::
$: %f ::
$% [%made p=(each bead (list tank))] ::
== == ::
$: %t ::
$% [%wake ~] :: timer activate
== == ::
$: @tas :: by any
$% [%crud p=@tas q=(list tank)] ::
== == == ::
++ silk :: construction layer
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%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
[%join p=mark q=silk r=silk] :: 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]
== ::
++ raft :: filesystem
$: fat=(map ship room) :: domestic
hoy=(map ship rung) :: foreign
ran=rang :: hashes
sor=(map ,[p=@p q=@tas r=@p s=@tas] duct) :: upstreams
== ::
++ rave :: general request
$% [& p=mood] :: single request
[| p=moat] :: change range
== ::
++ rede :: universal project
$: lim=@da :: complete to
qyx=cult :: subscribers
ref=(unit rind) :: outgoing requests
dom=dome :: revision state
dok=(unit dork) :: outstanding diffs
mer=(map (pair ship desk) mery) :: outstanding merges
== ::
++ riff ,[p=desk q=(unit rave)] :: request/desist
++ rind :: request manager
$: nix=@ud :: request index
bom=(map ,@ud ,[p=duct q=rave]) :: outstanding
fod=(map duct ,@ud) :: current requests
haw=(map mood (unit cage)) :: simple cache
nak=(unit nako) :: pending validation
== ::
++ room :: fs per ship
$: hun=duct :: terminal duct
hez=(unit duct) :: sync duct
dos=(map desk dojo) :: native desk
== ::
++ rove (each mood moot) :: stored request
++ rung $: rus=(map desk rede) :: neighbor desks
== ::
++ dork :: diff work
$: sot=(list ,[p=path q=misu]) ::
lon=(list path) ::
mim=(map path mime) ::
== ::
-- =>
::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4cA, filesystem logic ::
::
::
::
|%
++ de :: per desk
|= [now=@da hen=duct hun=duct hez=(unit duct)]
|= [[who=@p for=@p] syd=@ta rede ran=rang]
=* red +<+>-
=| yel=(list ,[p=duct q=gift])
=| byn=(list ,[p=duct q=riot])
=| reg=(list ,[p=duct q=gift])
=| say=(list ,[p=duct q=path r=ship s=[p=@ud q=riff]])
=| tag=(list ,[p=duct q=path r=note])
|%
++ abet
^- [(list move) rede]
:_ red
;: weld
%+ turn (flop yel)
|=([a=duct b=gift] [hun %give b])
::
%+ turn (flop byn)
|=([a=duct b=riot] [a %give [%writ b]])
::
%+ turn (flop reg)
|=([a=duct b=gift] [a %give b])
::
%+ turn (flop say)
|= [a=duct b=path c=ship d=[p=@ud q=riff]]
:- a
[%pass b %a %want [who c] [%q %re p.q.d (scot %ud p.d) ~] q.d]
::
%+ turn (flop tag)
|=([a=duct b=path c=note] [a %pass b c])
==
::
++ aver :: read
|= mun=mood
^- (unit (unit cage))
?: &(=(p.mun %u) !=(p.q.mun now)) :: prevent bad things
~& [%clay-fail p.q.mun %now now]
!!
=+ ezy=?~(ref ~ (~(get by haw.u.ref) mun))
?^ ezy ezy
=+ nao=(case-to-aeon:ze q.mun)
:: ~& [%aver-mun nao [%from syd lim q.mun]]
?~(nao ~ [~ (read-at-aeon:ze u.nao mun)])
::
++ balk :: read and send
|= [hen=duct yon=@ud mun=mood]
^+ +>
=+ vid=(read-at-aeon:ze yon mun)
?~ vid (blub hen) (blab hen mun u.vid)
::
++ bait
|= [hen=duct tym=@da]
%_(+> tag :_(tag [hen /tyme %t %wait tym]))
::
++ best
|= [hen=duct tym=@da]
%_(+> tag :_(tag [hen /tyme %t %rest tym]))
::
++ blab :: ship result
|= [hen=duct mun=mood dat=cage]
^+ +>
+>(byn [[hen ~ [p.mun q.mun syd] r.mun dat] byn])
::
++ bleb :: ship sequence
|= [hen=duct ins=@ud hip=nako]
^+ +>
(blab hen [%w [%ud ins] ~] %nako !>(hip))
::
++ blub :: ship stop
|= hen=duct
%_(+> byn [[hen ~] byn])
::
++ duce :: produce request
|= rov=rove
^+ +>
=. qyx (~(put by qyx) hen rov)
?~ ref
(mabe rov (cury bait hen))
|- ^+ +>+.$ :: XX why?
=+ rav=(reve rov)
=+ ^= vaw ^- rave
?. ?=([%& %v *] rav) rav
[%| [%ud let.dom] `case`q.p.rav r.p.rav]
=+ inx=nix.u.ref
%= +>+.$
say [[hen [(scot %ud inx) ~] for [inx syd ~ vaw]] say]
nix.u.ref +(nix.u.ref)
bom.u.ref (~(put by bom.u.ref) inx [hen vaw])
fod.u.ref (~(put by fod.u.ref) hen inx)
==
::
++ ease :: release request
^+ .
?~ ref
=+ rov=(~(got by qyx) hen)
=. qyx (~(del by qyx) hen)
(mabe rov (cury best hen))
=. qyx (~(del by qyx) hen)
|- ^+ +.$
=+ nux=(~(get by fod.u.ref) hen)
?~ nux +.$
%= +.$
say [[hen [(scot %ud u.nux) ~] for [u.nux syd ~]] say]
fod.u.ref (~(del by fod.u.ref) hen)
bom.u.ref (~(del by bom.u.ref) u.nux)
==
::
++ eave :: subscribe
|= rav=rave
^+ +>
?- -.rav
&
?: &(=(p.p.rav %u) !=(p.q.p.rav now))
~& [%clay-fail p.q.p.rav %now now]
!!
=+ ver=(aver p.rav)
?~ ver
(duce rav)
?~ u.ver
(blub hen)
(blab hen p.rav u.u.ver)
::
|
=+ nab=(case-to-aeon:ze p.p.rav)
?~ nab
?> =(~ (case-to-aeon:ze q.p.rav))
(duce (rive rav))
=+ huy=(case-to-aeon:ze q.p.rav)
?: &(?=(^ huy) |((lth u.huy u.nab) &(=(0 u.huy) =(0 u.nab))))
(blub hen)
=+ top=?~(huy let.dom u.huy)
=+ sar=(lobes-at-path:ze u.nab r.p.rav)
=+ ear=(lobes-at-path:ze top r.p.rav)
=. +>.$
?: =(sar ear) +>.$
=+ fud=(make-nako:ze u.nab top)
(bleb hen u.nab fud)
?^ huy
(blub hen)
=+ ^= ptr ^- case
[%ud +(let.dom)]
(duce `rove`[%| ptr q.p.rav r.p.rav ear])
==
::
++ echa :: announce raw
|= [wen=@da mer=mizu]
^+ +>
%= +>
reg ~& %merge-announce reg
:: ?~(hez reg :_(reg [u.hez [%ergo who syd let.dom]]))
:: yel [[hen %note '=' %leaf ~] yel] :: XX do better
==
::
++ echo :: announce changes
|= [wen=@da mim=(map path mime) lem=nori]
^+ +>
%_ +>.$
yel
=+ pre=`path`~[(scot %p for) syd (scot %ud let.dom)]
?- -.lem
| :_ yel
[hen %note '=' %leaf :(weld (trip p.lem) " " (spud pre))]
& |- ^+ yel
?~ q.p.lem yel
:_ $(q.p.lem t.q.p.lem)
:- hen
:+ %note
?-(-.q.i.q.p.lem %del '-', %ins '+', %mut ':', %dif ';')
[%leaf (spud (weld pre p.i.q.p.lem))]
==
==
::
++ edit :: apply changes
|= [wen=@da lem=nori]
^+ +>
?: ?=(%| -.lem)
=^ hat +>.$
(edit:ze wen lem)
?~ hat
+>.$
(echo:(checkout-ankh u.hat) wen ~ lem)
?. =(~ dok)
~& %already-applying-changes +>
=+ ^= sop
|= [a=path b=miso]
^- ?
?| ?=(%del -.b)
?& ?=(%ins -.b)
?=(%mime p.p.b)
=+ (slag (dec (lent a)) a)
?| =([%hook ~] -)
=([%hoon ~] -)
== == ==
=+ ^- lon=(list path)
(murn q.p.lem |=([a=path b=miso] ?:((sop a b) ~ (some a))))
=+ ^- sot=(list ,[p=path q=misu])
%+ murn q.p.lem
|=([a=path b=miso] ?.((sop a b) ~ (some [a ?<(?=(%mut -.b) b)])))
=+ ^- mim=(map path mime)
%- mo
^- (list ,[path mime])
%+ murn q.p.lem
|= [a=path b=miso]
?- -.b
%del ~
%ins ?.(?=(%mime p.p.b) ~ (some a ((hard mime) q.q.p.b)))
%dif ~
%mut ?.(?=(%mime p.q.b) ~ (some a ((hard mime) q.q.q.b)))
==
=. dok `[sot lon mim]
?~ lon
(apply-edit wen)
=+ ^- los=(list ,[duct path note])
%+ murn q.p.lem
|=([a=path b=miso] ?:((sop a b) ~ (some (silkify wen a b))))
%_(+>.$ tag (welp los tag))
::
++ silkify
|= [wen=@da pax=path mis=miso]
^- [duct path note]
:- hen
?+ -.mis !!
%mut
:- [%diffing (scot %p who) syd (scot %da wen) pax]
:^ %f %exec who :- ~
^- silk
=+ =+ (slag (dec (lent pax)) pax)
=+ ?~(- %$ i.-)
[%cast - [%done ~ q.mis]]
[%diff [%done ~ p.mis] -]
::
%ins
:- [%casting (scot %p who) syd (scot %da wen) pax]
:^ %f %exec who :- ~
^- silk
=+ (slag (dec (lent pax)) pax)
=+ ?~(- %$ i.-)
[%cast - [%done ~ p.mis]]
==
::
++ patch
|= [pax=path bar=lobe]
^- [duct path note]
:+ hen
[%patching (scot %p who) syd pax]
[%f %exec who ~ (lobe-to-silk:ze bar)]
::
++ apply-edit
|= wen=@da
^+ +>
=+ ^= hat
(edit:ze wen %& *cart ?~(dok ~|(%no-changes !!) sot.u.dok))
?~ dok ~& %no-changes !!
?^ lon.u.dok ~& %not-done-diffing !!
?~ -.hat
([echo(dok ~)]:.(+>.$ +.hat) wen mim.u.dok %& *cart sot.u.dok)
(checkout-ankh(lat.ran lat.ran.+.hat) u.-.hat)
::
++ take-cast
|= [wen=@da pax=path res=(each bead (list tank))]
^+ +>
?~ dok
~& %clay-unexpected-made +>.$
?. (lien lon.u.dok |=(path =(+< pax)))
~& %clay-strange-made +>.$
?: ?=(%| -.res)
%_ +>.$
dok ~
:: XX should be here
:: tag
:: %- welp :_ tag
:: ^- (list ,[duct path note])
:: %+ murn lon.u.dok
:: |= a=path
:: ^- (unit ,[duct path note])
:: ?: =(pax a) ~
:: `[hen [%diffing (scot %p who) syd (scot %da wen) a] %f %exec who ~]
::
yel
[[hen %note '!' %rose [" " "" ""] leaf/"clay diff failed" p.res] yel]
==
?. ?=(@ p.q.p.res) ~| %bad-marc !!
=: lon.u.dok (skip lon.u.dok |=(path =(+< pax)))
sot.u.dok [[pax %ins q.p.res] sot.u.dok]
==
?~ lon.u.dok
(apply-edit wen)
+>.$
::
++ take-diff
|= [wen=@da pax=path res=(each bead (list tank))]
^+ +>
?~ dok
~& %clay-unexpected-made +>.$
?. (lien lon.u.dok |=(path =(+< pax)))
~& %clay-strange-made +>.$
?: ?=(%| -.res)
%_ +>.$
dok ~
:: tag
:: %- welp :_ tag
:: ^- (list ,[duct path note])
:: %+ murn lon.u.dok
:: |= a=path
:: ^- (unit ,[duct path note])
:: ?: =(pax a) ~
:: `[hen [%diffing (scot %p who) syd (scot %da wen) a] %f %exec who ~]
::
yel
:_ yel
[hen %note '!' %rose [" " "" ""] leaf/"clay diff failed" >pax< p.res]
==
?. ?=(@ p.q.p.res) ~| %bad-marc !!
=: lon.u.dok (skip lon.u.dok |=(path =(+< pax)))
sot.u.dok ?: =(%null p.q.p.res)
sot.u.dok
[[pax %dif q.p.res] sot.u.dok]
==
?~ lon.u.dok
(apply-edit wen)
+>.$
::
++ take-patch
|= res=(each bead (list tank))
^+ +>
?: ?=(%| -.res)
%_ +>.$
dok ~
yel
[[hen %note '!' %rose [" " "" ""] leaf/"clay patch failed" p.res] yel]
==
=^ hat +>.$
(edit:ze now %& *cart ?~(dok ~|(%no-changes !!) sot.u.dok))
=. +>.$ wake
?~ dok ~& %no-dok +>.$
?^ lon.u.dok ~& %not-done-diffing !!
=>
%= .
+>.$
?< ?=(~ hat)
%^ echo :: :(checkout-ankh u.hat)
now
mim.u.dok
[%& *cart sot.u.dok]
==
?~ dok ~& %no-dok +>.$
?^ lon.u.dok ~& %not-done-diffing !!
=+ cay=q.p.res
?@ p.cay ~| %patch-bad-marc !!
=+ ^= can
|- ^- (list ,[path cage])
?~ p.p.cay
~
:_ %_($ cay [[%tabl t.p.p.cay] (slot 3 q.cay)])
?. ?=(%path p.i.p.p.cay)
~| %patch-strange-marc-a
!!
?. ?=(@ q.i.p.p.cay)
~| %patch-strange-marc-b
!!
=+ coy=(slot 2 q.cay)
?@ q.coy
~| %patch-strange-coy
!!
:- ((hard path) -.q.coy)
[q.i.p.p.cay (slot 3 coy)]
=. ank.dom (checkout-ankh:ze (mo can))
?~ hez +>.$(dok ~)
=+ ^= ceq
|= a=miso
?| ?=(%del -.a)
&(?=(%ins -.a) ?=(%mime -.+.a))
&(?=(%mut -.a) ?=(%mime -.+>.a))
==
%_ +>.$
dok ~
tag :: ?~(hez reg :_(reg [u.hez [%ergo who syd let.dom]]))
:_ tag
:^ hen
[%ergoing (scot %p who) syd ~]
%f
:^ %exec who ~ :- %tabl
^- (list (pair silk silk))
%+ turn sot.u.dok
|= [a=path b=misu]
^- (pair silk silk)
:- [%done ~ %path !>(a)]
?: ?=(%del -.b)
[%done ~ %null !>(~)]
:^ %cast %mime %done
=+ (~(get by mim.u.dok) a)
`?^(- [%mime !>(u.-)] (need (read:ze %x [%ud let.dom] a)))
==
::
++ take-ergo
|= res=(each bead (list tank))
^+ +>
?: ?=(%| -.res)
%_ +>.$
yel
[[hen %note '!' %rose [" " "" ""] leaf/"clay ergo failed" p.res] yel]
==
?~ hez ~& %no-sync-duct !!
=+ cay=q.p.res
?@ p.cay ~| %patch-bad-marc !!
%= +>.$
reg
:_ reg
:* u.hez %ergo who syd let.dom
|- ^- (list ,[path (unit mime)])
?~ p.p.cay
~
:_ %_($ cay [[%tabl t.p.p.cay] (slot 3 q.cay)])
?. ?=(%path p.i.p.p.cay)
~| %ergo-strange-marc-a
!!
?. ?=(@ q.i.p.p.cay)
~| %ergo-strange-marc-b
!!
=+ coy=(slot 2 q.cay)
?@ q.coy
~| %ergo-strange-coy
!!
:- ((hard path) -.q.coy)
?. ?=(%mime q.i.p.p.cay)
~
`((hard mime) q:(slot 3 coy))
==
==
::
++ checkout-ankh
|= hat=(map path lobe)
^+ +>
%_ +>.$
tag
:_ tag
:^ hen
[%patching (scot %p who) syd ~]
%f
:^ %exec who ~ :- %tabl
^- (list (pair silk silk))
%+ turn (~(tap by hat))
|= [a=path b=lobe]
^- (pair silk silk)
:- [%done ~ %path !>(a)]
|- ^- silk
=+ bob=(~(got by lat.ran) b)
?- -.bob
%direct [%done ~ q.bob]
%indirect [%done ~ q.bob]
%delta [%pact $(b q.bob) [%done ~ r.bob]]
==
==
::
++ apply-foreign-update :: apply subscription
|= $: gar=(map aeon tako) :: new ids
let=aeon :: next id
lar=(set yaki) :: new commits
bar=(set blob) :: new content
==
^+ +>
%= +>
hit.dom ~& [%gar gar]
(~(uni by hit.dom) gar)
let.dom let
hut.ran ~& [%lar lar]
=- ~& [%newhut (~(run by -) ,~)] -
%- ~(uni by hut.ran)
%- mo ^- (list (pair tako yaki))
%+ turn (~(tap in lar))
|= yak=yaki
[r.yak yak]
lat.ran %- ~(uni by lat.ran)
%- mo ^- (list (pair lobe blob))
%+ turn (~(tap in bar))
|= bob=blob
[p.bob bob]
==
::
++ exec :: change and update
|= [wen=@da lem=nori]
^+ +>
wake:(edit wen lem)
::
++ exem :: execute merge
|= [wen=@da her=@p sud=@tas gem=germ] :: aka direct change
!!
:: ?. (gte p.mer let.dom) !! :: no
:: =. +>.$ %= +>.$
:: hut.ran (~(uni by hut.r.mer) hut.ran)
:: lat.ran (~(uni by lat.r.mer) lat.ran)
:: let.dom p.mer
:: hit.dom (~(uni by q.mer) hit.dom)
:: ==
:: =+ ^= hed :: head commit
:: =< q
:: %- ~(got by hut.ran)
:: %- ~(got by hit.dom)
:: let.dom
:: (echa:wake:(checkout-ankh hed))
::
++ take-foreign-update :: external change
|= [inx=@ud rut=(unit rand)]
^+ +>
?> ?=(^ ref)
|- ^+ +>+.$
=+ ruv=(~(get by bom.u.ref) inx)
?~ ruv +>+.$
=> ?. |(?=(~ rut) ?=(& -.q.u.ruv)) .
%_ .
bom.u.ref (~(del by bom.u.ref) inx)
fod.u.ref (~(del by fod.u.ref) p.u.ruv)
==
?~ rut
=+ rav=`rave`q.u.ruv
%= +>+.$
lim
?.(&(?=(| -.rav) ?=(%da -.q.p.rav)) lim `@da`p.q.p.rav)
::
haw.u.ref
?. ?=(& -.rav) haw.u.ref
(~(put by haw.u.ref) p.rav ~)
==
?- p.p.u.rut
%u
~| %im-thinkin-its-prolly-a-bad-idea-to-request-rang-over-the-network
!!
::
%v
~| %weird-we-shouldnt-get-a-dome-request-over-the-network
!!
::
%x
=< ?> ?=(^ ref) .
(rand-to-rant u.rut)
::
%w
=. haw.u.ref
%+ ~(put by haw.u.ref)
[p.p.u.rut q.p.u.rut q.u.rut]
:+ ~
p.r.u.rut
?+ p.r.u.rut ~| %strange-w-over-nextwork !!
%aeon !>(((hard aeon) q.r.u.rut))
%nako !>(((hard nako) q.r.u.rut))
==
?. ?=(%nako p.r.u.rut) +>+.$
|- ^+ +>+.^$
=+ nez=[%w [%ud let.dom] ~]
=+ nex=(~(get by haw.u.ref) nez)
?~ nex +>+.^$
?~ u.nex +>+.^$ :: should never happen
=. nak.u.ref `((hard nako) q.q.u.u.nex)
=. +>+.^$
=+ roo=(validate-plops for bar:(need nak.u.ref))
?>(?=(^ ref.roo) roo)
%= $
haw.u.ref (~(del by haw.u.ref) nez)
==
::
%y
%_ +>+.$
haw.u.ref
%+ ~(put by haw.u.ref)
[p.p.u.rut q.p.u.rut q.u.rut]
`[p.r.u.rut !>(((hard arch) q.r.u.rut))]
==
::
%z
~| %its-prolly-reasonable-to-request-ankh-over-the-network-sorry
!!
==
::
++ rand-to-rant
|= rut=rand
^+ +>
~| %x-over-network-not-implemented !!
:: =- %_(+>.$ tag [- tag])
:: :* hen
:: [%foreign-plops (scot %p who) (scot %p for) syd ~]
:: %f %exec who ~ %tabl
:: ^- (list (pair silk silk))
:: %+ turn (~(tap in pop))
:: |= a=plop
:: ?- -.a
:: %delta
:: :- [%done ~ %blob !>([%delta p.a q.a *cage])]
:: [%vale p.r.a him q.r.a]
:: ::
:: %direct
:: :- [%done ~ %blob !>([%direct p.a *cage])]
:: [%vale p.q.a him q.q.a]
:: ::
:: %indirect ~| %foreign-indirect-not-implemented !!
:: ==
:: ==
::
++ validate-plops
|= [him=ship pop=(set plop)]
^+ +>
=- %_(+>.$ tag [- tag])
:* hen
[%foreign-plops (scot %p who) (scot %p for) syd ~]
%f %exec who ~ %tabl
^- (list (pair silk silk))
%+ turn (~(tap in pop))
|= a=plop
?- -.a
%delta
:- [%done ~ %blob !>([%delta p.a q.a *cage])]
[%vale p.r.a him q.r.a]
::
%direct
:- [%done ~ %blob !>([%direct p.a *cage])]
[%vale p.q.a him q.q.a]
::
%indirect ~| %foreign-indirect-not-implemented !!
==
==
::
++ take-foreign-plops
|= res=(each bead (list tank))
^+ +>
?> ?=(^ ref)
?> ?=(^ nak.u.ref)
?: ?=(%| -.res)
~| "validate foreign plops failed"
~& [%plop-fail (turn p.res |=(tank ~(ram re +<)))]
!!
=+ cay=q.p.res
?@ p.cay ~| %plop-bad-marc !!
=+ |- ^- lat=(list blob)
?~ p.p.cay
~
:_ %_($ cay [[%tabl t.p.p.cay] (slot 3 q.cay)])
?. ?=(%blob p.i.p.p.cay)
~| %plop-strange-marc-a
!!
?. ?=(@ q.i.p.p.cay)
~| %plop-strange-marc-b
!!
=+ coy=(slot 2 q.cay)
?@ q.coy
~| %plop-strange-coy
!!
=+ bob=((hard blob) -.q.coy)
?- -.bob
%delta [-.bob p.bob q.bob q.i.p.p.cay (slot 3 coy)]
%direct [-.bob p.bob q.i.p.p.cay (slot 3 coy)]
%indirect ~| %plop-indirect-not-implemented !!
==
%^ apply-foreign-update
gar.u.nak.u.ref
let.u.nak.u.ref
[lar.u.nak.u.ref (sa lat)]
::
++ mabe :: maybe fire function
|* [rov=rove fun=$+(@da _+>.^$)]
^+ +>.$
%- fall :_ +>.$
%- bind :_ fun
^- (unit ,@da)
?- -.rov
%&
?. ?=(%da -.q.p.rov) ~
`p.q.p.rov
%|
=* mot p.rov
%+ hunt
?. ?=(%da -.p.mot) ~
?.((lth now p.p.mot) ~ [~ p.p.mot])
?. ?=(%da -.q.mot) ~
?.((lth now p.q.mot) [~ now] [~ p.q.mot])
==
::
++ reve
|= rov=rove
^- rave
?: ?=(%& -.rov) rov
[%| p.p.rov q.p.rov r.p.rov]
::
++ rive
|= rav=[%| p=moat]
^- rove
[%| p.p.rav q.p.rav r.p.rav ~]
::
++ wake :: update subscribers
^+ .
=+ xiq=(~(tap by qyx) ~)
=| xaq=(list ,[p=duct q=rove])
|- ^+ ..wake
?~ xiq
..wake(qyx (~(gas by *cult) xaq))
?- -.q.i.xiq
&
=+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.q.i.xiq))
?^ cas
%= $
xiq t.xiq
..wake ?~ u.cas (blub p.i.xiq)
(blab p.i.xiq p.q.i.xiq u.u.cas)
==
~& [%sydhit syd hit.dom let.dom]
=+ nao=(case-to-aeon:ze q.p.q.i.xiq)
?~ nao $(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (balk p.i.xiq u.nao p.q.i.xiq))
::
|
=+ mot=`moot`p.q.i.xiq
=+ nab=(case-to-aeon:ze p.mot)
?~ nab
$(xiq t.xiq, xaq [i.xiq xaq])
=+ huy=(case-to-aeon:ze q.mot)
?~ huy
=+ ptr=[%ud +(let.dom)]
%= $
xiq t.xiq
xaq [[p.i.xiq [%| ptr q.mot r.mot s.mot]] xaq]
..wake =+ ^= ear
(lobes-at-path:ze let.dom r.p.q.i.xiq)
?: =(s.p.q.i.xiq ear) ..wake
=+ fud=(make-nako:ze u.nab let.dom)
(bleb p.i.xiq let.dom fud)
==
%= $
xiq t.xiq
..wake =- (blub:- p.i.xiq)
=+ ^= ear
(lobes-at-path:ze u.huy r.p.q.i.xiq)
?: =(s.p.q.i.xiq ear) (blub p.i.xiq)
=+ fud=(make-nako:ze u.nab u.huy)
(bleb p.i.xiq +(u.nab) fud)
==
==
++ ze
|%
++ aeon-to-tako ~(got by hit.dom)
++ aeon-to-yaki (cork aeon-to-tako tako-to-yaki)
++ lobe-to-blob ~(got by lat.ran)
++ tako-to-yaki ~(got by hut.ran)
++ lobe-to-silk
|= a=lobe
|- ^- silk
=+ bob=(~(got by lat.ran) a)
?- -.bob
%direct [%done ~ q.bob]
%indirect [%done ~ q.bob]
%delta [%pact $(a q.bob) [%done ~ r.bob]]
==
::
++ blob-to-plop
|= a=blob
^- plop
=> a
?- -
%delta [- p q [p q.q]:r]
%direct [- p [p q.q]:q]
%indirect [- p [p q.q]:q [p q.q]:r s]
==
::
++ make-direct :: make blob
|= p=cage
^- blob
[%direct (mug p) p]
::
++ make-delta :: make blob delta
|= [p=lobe q=cage]
^- blob
=+ t=[%delta 0 p q]
=+ ^= has
%^ cat 7 (sham [%blob q.q.q])
(sham [%lobe p])
[%delta has p q]
::
++ make-yaki :: make yaki
|= [p=(list tako) q=(map path lobe) t=@da]
^- yaki
=+ ^= has
%^ cat 7 (sham [%yaki (roll p add) q t])
(sham [%tako (roll p add) q t])
[p q has t]
::
++ apply-changes :: apply-changes:ze
|= lar=(list ,[p=path q=misu]) :: store changes
^- (map path blob)
=+ ^= hat :: current state
?: =(let.dom 0) :: initial commit
~ :: has nothing
=< q
%- aeon-to-yaki
let.dom
=- =+ sar=(sa (turn lar |=([p=path *] p))) :: changed paths
%+ roll (~(tap by hat) ~) :: find unchanged
=< .(bat bar)
|= [[pat=path gar=lobe] bat=(map path blob)]
?: (~(has in sar) pat) :: has update
bat
%+ ~(put by bat) pat
~|((crip <pat gar (lent (~(tap by lat.ran)))>) (lobe-to-blob gar)) :: use original
^= bar ^- (map path blob)
%+ roll lar
|= [[pat=path mys=misu] bar=(map path blob)]
^+ bar
?- -.mys
%ins :: insert if not exist
?: (~(has by bar) pat) !! ::
?: (~(has by hat) pat) !! ::
%+ ~(put by bar) pat
%- make-direct
?: &(?=(%mime -.p.mys) =([%hook ~] (slag (dec (lent pat)) pat)))
`cage`[%hook [%atom %t] +.+.q.q.p.mys]
?: &(?=(%mime -.p.mys) =([%hoon ~] (slag (dec (lent pat)) pat)))
`cage`[%hoon [%atom %t] +.+.q.q.p.mys]
p.mys
%del :: delete if exists
?. |((~(has by hat) pat) (~(has by bar) pat)) !!
(~(del by bar) pat)
%dif :: mutate, must exist
=+ ber=(~(get by bar) pat) :: XX typed
?~ ber
=+ har=(~(get by hat) pat)
?~ har !!
%+ ~(put by bar) pat
(make-delta u.har p.mys)
%+ ~(put by bar) pat
(make-delta p.u.ber p.mys)
==
::
++ as-arch
^- arch
:+ p.ank.dom
?~(q.ank.dom ~ [~ p.u.q.ank.dom])
|- ^- (map ,@ta ,~)
?~ r.ank.dom ~
[[p.n.r.ank.dom ~] $(r.ank.dom l.r.ank.dom) $(r.ank.dom r.r.ank.dom)]
::
++ case-to-aeon :: case-to-aeon:ze
|= lok=case :: act count through
^- (unit aeon)
?- -.lok
%da
?: (gth p.lok lim) ~
|- ^- (unit aeon)
?: =(0 let.dom) [~ 0] :: avoid underflow
?: %+ gte p.lok
=< t
~| [%letdom let=let.dom hit=hit.dom hut=(~(run by hut.ran) ,~)]
~| [%getdom (~(get by hit.dom) let.dom)]
~| [%gotdom (~(get by hut.ran) (~(got by hit.dom) let.dom))]
%- aeon-to-yaki
let.dom
[~ let.dom]
$(let.dom (dec let.dom))
::
%tas (~(get by lab.dom) p.lok)
%ud ?:((gth p.lok let.dom) ~ [~ p.lok])
==
::
++ checkout-ankh
|= hat=(map path cage)
^- ankh
%- cosh
%+ roll (~(tap by hat) ~)
|= [[pat=path zar=cage] ank=ankh]
^- ankh
%- cosh
?~ pat
ank(q [~ (sham q.q.zar) zar])
=+ nak=(~(get by r.ank) i.pat)
%= ank
r %+ ~(put by r.ank) i.pat
$(pat t.pat, ank (fall nak *ankh))
==
::
++ cosh
|= ank=ankh
%_ ank
p
^- cash
%+ mix ?~(q.ank 0 p.u.q.ank)
=+ axe=1
|- ^- cash
?~ r.ank *@
;: mix
(shaf %dash (mix axe (shaf %dush (mix p.n.r.ank p.q.n.r.ank))))
$(r.ank l.r.ank, axe (peg axe 2))
$(r.ank r.r.ank, axe (peg axe 3))
==
==
::
++ edit :: edit:ze
|= [wen=@da lem=nuri] :: edit
^- [(unit (map path lobe)) _..ze]
?- -.lem
& =^ yak lat.ran :: merge objects
%+ forge-yaki wen
?: =(let.dom 0) :: initial import
[~ p.lem]
[(some r:(aeon-to-yaki let.dom)) p.lem]
?. ?| =(0 let.dom)
!=((lent p.yak) 1)
!(equiv q.yak q:(aeon-to-yaki let.dom))
==
`..ze :: silently ignore
=: let.dom +(let.dom)
hit.dom (~(put by hit.dom) +(let.dom) r.yak)
hut.ran (~(put by hut.ran) r.yak yak)
==
[`q.yak ..ze]
:: +>.$(ank (checkout-ankh q.yak))
| ?< (~(has by lab.dom) p.lem)
[~ ..ze(lab.dom (~(put by lab.dom) p.lem let.dom))]
==
::
++ equiv :: test paths
|= [p=(map path lobe) q=(map path lobe)]
^- ?
=- ?. qat %.n
%+ levy (~(tap by q) ~)
|= [pat=path lob=lobe]
(~(has by p) pat)
^= qat
%+ levy (~(tap by p) ~)
|= [pat=path lob=lobe]
=+ zat=(~(get by q) pat)
?~ zat %.n
=(u.zat lob)
:: =((lobe-to-cage u.zat) (lobe-to-cage lob))
::
++ forge-nori :: forge-nori:ze
|= yak=yaki :: forge nori
^- nori
!!
:: ?~ p.yak !! :: no parent, no diff
:: :+ %& *cart :: diff w/ 1st parent
:: (~(tap by (diff-yakis (tako-to-yaki i.p.yak) yak)) ~)
::
++ forge-yaki :: forge-yaki:ze
|= [wen=@da par=(unit tako) lem=suba] :: forge yaki
=+ ^= per
?~ par ~
~[u.par]
=+ gar=(update-lat (apply-changes q.lem) lat.ran)
:- %^ make-yaki per +.gar wen :: from existing diff
-.gar :: fix lat
::
++ lobes-at-path :: lobes-at-path:ze
|= [yon=aeon pax=path] :: data at path
^- (map path lobe)
?: =(0 yon) ~
%- mo
%+ skim
%. ~
%~ tap by
=< q
%- aeon-to-yaki
yon
|= [p=path q=lobe]
?| ?=(~ pax)
?& !?=(~ p)
=(-.pax -.p)
$(p +.p, pax +.pax)
== ==
::
++ make-nako
|= [a=aeon b=aeon]
^- nako
:+ hit.dom
let.dom
(data-twixt-takos (~(get by hit.dom) a) (aeon-to-tako b))
::
++ query :: query:ze
|= ren=?(%u %v %x %y %z) :: endpoint query
^- (unit cage)
?- ren
%u [~ %rang !>(ran)]
%v [~ %dome !>(dom)]
%x ?~(q.ank.dom ~ [~ q.u.q.ank.dom])
%y [~ %arch !>(as-arch)]
%z [~ %ankh !>(ank.dom)]
==
::
++ data-twixt-takos
|= [a=(unit tako) b=tako]
^- [(set yaki) (set plop)]
=+ yal=(turn (~(tap in (reachable-takos b))) tako-to-yaki)
:- (sa yal)
%- sa ^- (list plop)
%- zing ^- (list (list plop))
%+ turn yal
|= yak=yaki
%+ turn (~(tap by q.yak))
|= [pax=path lob=lobe]
(blob-to-plop (lobe-to-blob lob))
::
++ reachable-takos :: reachable
|= p=tako :: XX slow
^- (set tako)
=+ y=(tako-to-yaki p)
=+ t=(~(put in *(set tako)) p)
%+ roll p.y
=< .(s t)
|= [q=tako s=(set tako)]
?: (~(has in s) q) :: already done
s :: hence skip
(~(uni in s) ^$(p q)) :: otherwise traverse
::
++ read :: read:ze
|= mun=mood :: read at point
^- (unit cage)
?: ?=(%v p.mun)
[~ %dome !>(dom)]
?: &(?=(%w p.mun) !?=(%ud -.q.mun))
?^(r.mun ~ [~ %aeon !>(let.dom)])
?: ?=(%w p.mun)
=+ ^= yak
%- aeon-to-yaki
let.dom
?^(r.mun ~ [~ %w !>([t.yak (forge-nori yak)])])
(query(ank.dom ank:(descend-path:(zu ank.dom) r.mun)) p.mun)
::
++ read-at-aeon :: read-at-aeon:ze
|= [yon=aeon mun=mood] :: seek and read
^- (unit cage)
?: &(?=(%w p.mun) !?=(%ud -.q.mun)) :: NB only for speed
?^(r.mun ~ [~ %aeon !>(yon)])
%+ biff
(rewind yon)
|= a=_+>.$
(read:a mun)
::
++ rewind :: rewind:ze
|= yon=aeon :: rewind to aeon
^- (unit ,_+>)
?: =(let.dom yon) `+>
?: (gth yon let.dom) !! :: don't have version
=+ hat=q:(aeon-to-yaki yon)
?: (~(any by hat) |=(a=lobe ?=(%delta [-:(lobe-to-blob a)])))
~
=+ ^- (map path cage)
%- ~(run by hat)
|= a=lobe
=+ (lobe-to-blob a)
?-(-.- %direct q.-, %indirect q.-, %delta !!)
`+>.$(ank.dom (checkout-ankh -), let.dom yon)
::
++ update-lat :: update-lat:ze
|= [lag=(map path blob) sta=(map lobe blob)] :: fix lat
^- [(map lobe blob) (map path lobe)]
%+ roll (~(tap by lag) ~)
=< .(lut sta)
|= [[pat=path bar=blob] [lut=(map lobe blob) gar=(map path lobe)]]
?~ (~(has by lut) p.bar)
[lut (~(put by gar) pat p.bar)]
:- (~(put by lut) p.bar bar)
(~(put by gar) pat p.bar)
::
++ zu :: filesystem
|= ank=ankh :: filesystem state
=| ram=path :: reverse path into
|%
++ descend :: descend
|= lol=@ta
^+ +>
=+ you=(~(get by r.ank) lol)
+>.$(ram [lol ram], ank ?~(you [*cash ~ ~] u.you))
::
++ descend-path :: descend recursively
|= way=path
^+ +>
?~(way +> $(way t.way, +> (descend i.way)))
--
::
++ me :: merge ali into bob
|= ali=(pair ship desk) :: from
=+ bob=`(pair ship desk)`[who syd] :: to
=+ dat=(fall (~(get by mer) ali) *mery) :: merge data
=| don=? :: keep going
|%
++ abet
^+ ..me
?~ don
..me(mer (~(put by mer) ali dat))
..me(mer (~(del by mer) ali), reg :_(reg [hen %mere gon.dat]))
::
++ route
|= [sat=term res=(each riot (each bead (list tank)))]
^+ +>.$
?+ sat ~|((crip <[%bad-stage sat]>) !!)
%ali %- fetched-ali ?> ?=(%& -.res) p.res
%diff-ali %- diffed-ali ?> ?=(%| -.res) p.res
%diff-bob %- diffed-bob ?> ?=(%| -.res) p.res
%merge %- merged ?> ?=(%| -.res) p.res
%checkout %- checked-out ?> ?=(%| -.res) p.res
%ergo %- ergoed ?> ?=(%| -.res) p.res
==
::
++ start
|= gem=germ
^+ +>
?: (~(has by mer) ali)
(error:he %already-merging ~)
?: &(=(0 let.dom) !?=(%init gem))
(error:he %no-bob-desk ~)
=. gem.dat gem
=. cas.dat [%da now]
?: ?=(%init gem.dat)
fetch-ali
=+ (~(get by hit.dom) let.dom)
?~ -
(error:he %no-bob--version ~)
=+ (~(get by hut.ran) u.-)
?~ -
(error:he %no-bob-commit ~)
fetch-ali(bob.dat u.-)
::
++ fetch-ali
^+ .
=- %_(+ tag [- tag])
:* hen [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %ali ~]
%c %warp [p.bob p.ali] q.ali
`[%& %v cas.dat /]
==
::
++ fetched-ali
|= rot=riot
^+ +>
?~ rot
(error:he %bad-fetch-ali ~)
=+ ^= dum
%- (hard ,[ank=* let=@ud hit=(map ,@ud tako) lab=(map ,@tas ,@ud)])
q.q.r.u.rot
?: =(0 let.dum)
(error:he %no-ali-desk ~)
=+ (~(get by hit.dum) let.dum)
?~ -
(error:he %no-ali-version ~)
=+ (~(get by hut.ran) u.-)
?~ -
(error:he %no-ali-commit ~)
=. ali.dat u.-
|-
?- gem.dat
%init
?. =(let.dom 0)
(error:he %bad-init-merge ~)
=. new.dat ali.dat
=. hut.ran (~(put by hut.ran) r.new.dat new.dat)
=. erg.dat (~(run by q.ali.dat) |=(lobe %&))
checkout
::
%fine
?: =(r.ali.dat r.bob.dat)
(done:he ~)
?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat)
(done:he ~)
?. (~(has in (reachable-takos r.ali.dat)) r.bob.dat)
(error:he %bad-fine-merge ~)
=. new.dat ali.dat
=. erg.dat
%- ~(uni by `(map path ,?)`(~(run by q.bob.dat) |=(lobe %|)))
`(map path ,?)`(~(run by q.ali.dat) |=(lobe %&))
checkout
::
%this
?: =(r.ali.dat r.bob.dat)
(done:he ~)
?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat)
(done:he ~)
=. new.dat (make-yaki [r.ali.dat r.bob.dat ~] q.bob.dat now)
=. hut.ran (~(put by hut.ran) r.new.dat new.dat)
=. erg.dat ~
checkout
::
%that
?: =(r.ali.dat r.bob.dat)
(done:he ~)
?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat)
(done:he ~)
=. new.dat (make-yaki [r.ali.dat r.bob.dat ~] q.ali.dat now)
=. hut.ran (~(put by hut.ran) r.new.dat new.dat)
=. erg.dat
%- ~(uni by `(map path ,?)`(~(run by q.bob.dat) |=(lobe %|)))
`(map path ,?)`(~(run by q.ali.dat) |=(lobe %&))
checkout
::
?(%meet %mate %meld)
?: =(r.ali.dat r.bob.dat)
(done:he ~)
?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat)
(done:he ~)
?: (~(has in (reachable-takos r.ali.dat)) r.bob.dat)
$(gem.dat %fine)
=+ r=(find-merge-points:he ali.dat bob.dat)
?~ r
(error:he %merge-no-merge-base ~)
?. ?=([* ~ ~] r)
=+ (lent (~(tap in `(set yaki)`r)))
(error:he %merge-criss-cross >[-]< ~)
=. bas.dat n.r
diff-ali
==
::
++ diff-bas
|= [nam=term yak=yaki]
^+ +>
=- %_(+>.$ tag [- tag])
:* hen
=+ (cat 3 %diff- nam)
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali - ~]
%f %exec p.bob ~ %tabl
^- (list (pair silk silk))
%+ murn (~(tap by q.bas.dat))
|= [pax=path lob=lobe]
^- (unit (pair silk silk))
=+ (~(get by q.yak) pax)
?~ -
~
?: =(lob u.-)
~
:- ~
:- [%done ~ %path !>(pax)]
[%diff (lobe-to-silk lob) (lobe-to-silk u.-)]
==
::
++ diff-ali
^+ .
(diff-bas %ali ali.dat)
::
++ diffed-ali
|= res=(each bead (list tank))
^+ +>
?: ?=(%| -.res)
(error:he %diff-ali-bad-made leaf/"merge diff ali failed" p.res)
=+ cay=q.p.res
?@ p.cay
(error:he %diff-ali-bad-marc >p.cay< ~)
=| can=(map path cage)
=>
|- ^+ +
?~ p.p.cay
+.$(can ~)
=+ tal=%_($ cay [[%tabl t.p.p.cay] (slot 3 q.cay)])
?: ?=(%| -.gon.dat.tal)
tal
?. ?=(%path p.i.p.p.cay)
+.$(+>.$ (error:he %diff-ali-strange-marc-a >p.i.p.p.cay< ~))
?. ?=(@ q.i.p.p.cay)
+.$(+>.$ (error:he %diff-ali-strange-marc-b >q.i.p.p.cay< ~))
=+ coy=(slot 2 q.cay)
?@ q.coy
+.$(+>.$ (error:he %diff-ali-strange-coy ~))
%_ +.$
can
%+ ~(put by can:tal)
((hard path) -.q.coy)
[q.i.p.p.cay (slot 3 coy)]
==
?: ?=(%| -.gon.dat)
+>.$
=. new.dal.dat
%- mo
%+ skip (~(tap by q.ali.dat))
|= [pax=path lob=lobe]
(~(has by q.bas.dat) pax)
=. can.dal.dat can
=. old.dal.dat
%- mo ^- (list ,[path ~])
%+ murn (~(tap by q.bas.dat))
|= [pax=path lob=lobe]
?. =(~ (~(get by q.ali.dat) pax))
~
(some pax ~)
diff-bob
::
++ diff-bob
^+ .
(diff-bas %bob bob.dat)
::
++ diffed-bob
|= res=(each bead (list tank))
^+ +>
?: ?=(%| -.res)
(error:he %diff-bob-bad-made leaf/"merge diff bob failed" p.res)
=+ cay=q.p.res
?@ p.cay
(error:he %diff-bob-bad-marc >p.cay< ~)
=| can=(map path cage)
=>
|- ^+ +
?~ p.p.cay
+.$(can ~)
=+ tal=%_($ cay [[%tabl t.p.p.cay] (slot 3 q.cay)])
?: ?=(%| -.gon.dat.tal)
tal
?. ?=(%path p.i.p.p.cay)
+.$(+>.$ (error:he %diff-bob-strange-marc-a >p.i.p.p.cay< ~))
?. ?=(@ q.i.p.p.cay)
+.$(+>.$ (error:he %diff-bob-strange-marc-b >q.i.p.p.cay< ~))
=+ coy=(slot 2 q.cay)
?@ q.coy
+.$(+>.$ (error:he %diff-bob-strange-coy ~))
%_ +.$
can
%+ ~(put by can:tal)
((hard path) -.q.coy)
[q.i.p.p.cay (slot 3 coy)]
==
?: ?=(%| -.gon.dat)
+>.$
=. new.dob.dat
%- mo
%+ skip (~(tap by q.bob.dat))
|= [pax=path lob=lobe]
(~(has by q.bas.dat) pax)
=. can.dob.dat can
=. old.dob.dat
%- mo ^- (list ,[path ~])
%+ murn (~(tap by q.bas.dat))
|= [pax=path lob=lobe]
?. =(~ (~(get by q.bob.dat) pax))
~
(some pax ~)
merge
::
++ merge
^+ .
|- ^+ +.$
?+ gem.dat ~| %merge-weird-gem !!
%meet
=+ ^= bof
%- %~ int by
%- ~(uni by `(map path ,*)`new.dal.dat)
%- ~(uni by `(map path ,*)`can.dal.dat)
`(map path ,*)`old.dal.dat
%- ~(uni by `(map path ,*)`new.dob.dat)
%- ~(uni by `(map path ,*)`can.dob.dat)
`(map path ,*)`old.dob.dat
?^ bof
(error:he %meet-conflict >(~(run by `(map path ,*)`bof) ,_~)< ~)
=+ ^- old=(map path lobe)
%+ roll (~(tap by (~(uni by old.dal.dat) old.dob.dat)))
=< .(old q.bas.dat)
|= [[pax=path ~] old=(map path lobe)]
(~(del by old) pax)
=^ hat lat.ran
^- [(map path lobe) (map lobe blob)]
%+ roll (~(tap by (~(uni by can.dal.dat) can.dob.dat)))
=< .(lat lat.ran)
|= [[pax=path cay=cage] hat=(map path lobe) lat=(map lobe blob)]
=+ ^= bol
=+ (~(get by q.bas.dat) pax)
?~ -
~| %meet-strange-diff-no-base
!!
(make-delta u.- cay)
[(~(put by hat) pax p.bol) (~(put by lat) p.bol bol)]
=. hat
%- ~(uni by old)
%- ~(uni by new.dal.dat)
%- ~(uni by new.dob.dat)
hat
=+ ^- del=(map path ,?)
(~(run by (~(uni by old.dal.dat) old.dob.dat)) |=(~ %|))
=. new.dat
(make-yaki [r.ali.dat r.bob.dat ~] hat now)
=. hut.ran (~(put by hut.ran) r.new.dat new.dat)
=. erg.dat %- ~(uni by del)
`(map path ,?)`(~(run by hat) |=(lobe %&))
checkout
::
?(%mate %meld)
=+ ^= bof
%- %~ int by
%- ~(uni by `(map path ,*)`new.dal.dat)
%- ~(uni by `(map path ,*)`can.dal.dat)
`(map path ,*)`old.dal.dat
%- ~(uni by `(map path ,*)`new.dob.dat)
%- ~(uni by `(map path ,*)`can.dob.dat)
`(map path ,*)`old.dob.dat
?~ bof
$(gem.dat %meet)
=- %_(+.$ tag [- tag])
:* hen
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %merge ~]
%f %exec p.bob ~ %tabl
^- (list (pair silk silk))
%+ turn (~(tap by (~(int by can.dal.dat) can.dob.dat)))
|= [pax=path *]
^- (pair silk silk)
=+ cal=(~(got by can.dal.dat) pax)
=+ cob=(~(got by can.dob.dat) pax)
=+ ^= for
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
:- [%done ~ %path !>(pax)]
[%join for [%done ~ cal] [%done ~ cob]]
==
==
::
++ merged
|= res=(each bead (list tank))
^+ +>
?: ?=(%| -.res)
(error:he %merge-bad-made leaf/"merging failed" p.res)
=+ cay=q.p.res
?@ p.cay
(error:he %merge-bad-marc >p.cay< ~)
=| bof=(map path (unit cage))
=>
|- ^+ +
?~ p.p.cay
+.$(bof ~)
=+ tal=%_($ cay [[%tabl t.p.p.cay] (slot 3 q.cay)])
?: ?=(%| -.gon.dat.tal)
tal
?. ?=(%path p.i.p.p.cay)
+.$(+>.$ (error:he %merge-strange-marc-a >p.i.p.p.cay< ~))
?. ?=(@ q.i.p.p.cay)
+.$(+>.$ (error:he %merge-strange-marc-b >q.i.p.p.cay< ~))
=+ coy=(slot 2 q.cay)
?@ q.coy
+.$(+>.$ (error:he %merge-strange-coy ~))
%_ +.$
bof
%+ ~(put by bof:tal)
((hard path) -.q.coy)
?: ?=(%null q.i.p.p.cay)
~
`[q.i.p.p.cay (slot 3 coy)]
==
?: ?=(%| -.gon.dat)
+>.$
=+ ^- con=(map path ,*) :: 2-change conflict
%- mo
%+ skim (~(tap by bof))
|=([pax=path cay=(unit cage)] ?=(~ cay))
=+ ^- cas=(map path lobe) :: conflict base
%- ~(urn by con)
|= [pax=path *]
(~(got by q.bas.dat) pax)
=. con :: add/del conflict
%- ~(uni by con)
%- mo ^- (list ,[path *])
%+ skim (~(tap by old.dal.dat))
|= [pax=path ~]
?: (~(has by new.dob.dat) pax)
~| %strange-add-and-del
!!
(~(has by can.dob.dat) pax)
=. con :: add/del conflict
%- ~(uni by con)
%- mo ^- (list ,[path *])
%+ skim (~(tap by old.dob.dat))
|= [pax=path ~]
?: (~(has by new.dal.dat) pax)
~| %strange-del-and-add
!!
(~(has by can.dal.dat) pax)
=. con :: add/add conflict
%- ~(uni by con)
%- mo ^- (list ,[path *])
%+ skip (~(tap by (~(int by new.dal.dat) new.dob.dat)))
|= [pax=path *]
=((~(got by new.dal.dat) pax) (~(got by new.dob.dat) pax))
?: &(?=(%mate gem.dat) ?=(^ con))
=+ (turn (~(tap by `(map path ,*)`con)) |=([path *] >[+<-]<))
(error:he %mate-conflict -)
=+ ^- old=(map path lobe) :: oldies but goodies
%+ roll (~(tap by (~(uni by old.dal.dat) old.dob.dat)))
=< .(old q.bas.dat)
|= [[pax=path ~] old=(map path lobe)]
(~(del by old) pax)
=+ ^- can=(map path cage) :: content changes
%- ~(uni by can.dal.dat)
%- ~(uni by can.dob.dat)
%- mo
^- (list (pair path cage))
%+ murn (~(tap by bof))
|= [pax=path cay=(unit cage)]
^- (unit (pair path cage))
?~ cay
~
`[pax u.cay]
=^ hat lat.ran :: new content
^- [(map path lobe) (map lobe blob)]
%+ roll (~(tap by can))
=< .(lat lat.ran)
|= [[pax=path cay=cage] hat=(map path lobe) lat=(map lobe blob)]
=+ ^= bol
=+ (~(get by q.bas.dat) pax)
?~ -
~| %mate-strange-diff-no-base
!!
(make-delta u.- cay)
[(~(put by hat) pax p.bol) (~(put by lat) p.bol bol)]
=. hat :: all the content
%- ~(uni by old)
%- ~(uni by new.dal.dat)
%- ~(uni by new.dob.dat)
%- ~(uni by hat)
cas
=+ ^- del=(map path ,?)
(~(run by (~(uni by old.dal.dat) old.dob.dat)) |=(~ %|))
=. gon.dat [%& (sa (turn (~(tap by con)) |=([path *] +<-)))]
=. new.dat
(make-yaki [r.ali.dat r.bob.dat ~] hat now)
=. hut.ran (~(put by hut.ran) r.new.dat new.dat)
=. erg.dat %- ~(uni by del)
`(map path ,?)`(~(run by hat) |=(lobe %&))
checkout
::
++ checkout
^+ .
=- %_(+ tag [- tag])
:* hen
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %checkout ~]
%f %exec p.bob ~ %tabl
^- (list (pair silk silk))
%+ turn (~(tap by q.new.dat))
|= [a=path b=lobe]
^- (pair silk silk)
[[%done ~ %path !>(a)] (lobe-to-silk b)]
==
::
++ checked-out
|= res=(each bead (list tank))
^+ +>
?: ?=(%| -.res)
(error:he %checkout-bad-made leaf/"merge checkout failed" p.res)
=+ cay=q.p.res
?@ p.cay
(error:he %patch-bad-marc >p.cay< ~)
=| can=(list ,[path cage])
=>
|- ^+ +
?~ p.p.cay
+.$(can ~)
=+ tal=%_($ cay [[%tabl t.p.p.cay] (slot 3 q.cay)])
?: ?=(%| -.gon.dat.tal)
tal
?. ?=(%path p.i.p.p.cay)
+.$(+>.$ (error:he %patch-strange-marc-a >p.i.p.p.cay< ~))
?. ?=(@ q.i.p.p.cay)
+.$(+>.$ (error:he %patch-strange-marc-b >q.i.p.p.cay< ~))
=+ coy=(slot 2 q.cay)
?@ q.coy
+.$(+>.$ (error:he %patch-strange-coy ~))
%_ +.$
can
:_ can:tal
:- ((hard path) -.q.coy)
[q.i.p.p.cay (slot 3 coy)]
==
?: ?=(%| -.gon.dat)
+>.$
=. let.dom +(let.dom)
=. hit.dom (~(put by hit.dom) let.dom r.new.dat)
=. ank.dat (checkout-ankh:ze (mo can))
=. ank.dom ank.dat
?~ hez
(done:he ~)
ergo
::
++ ergo
^+ .
=- %_(+ tag [- tag])
=+ zez=ze(ank.dom ank.dat)
:* hen
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %ergo ~]
%f %exec p.bob ~ %tabl
^- (list (pair silk silk))
%+ turn (~(tap by erg.dat))
|= [a=path b=?]
^- (pair silk silk)
:- [%done ~ %path !>(a)]
?. b
[%done ~ %null !>(~)]
:^ %cast %mime %done
`(need (read:zez %x [%ud let.dom] a))
==
::
++ ergoed
|= res=(each bead (list tank))
^+ +>
?: ?=(%| -.res)
(error:he %ergo-bad-made leaf/"merge ergo failed" p.res)
=+ cay=q.p.res
?@ p.cay ~| %patch-bad-marc !!
=| can=(list ,[path (unit mime)])
=>
|- ^+ +
?~ p.p.cay
+.$(can ~)
=+ tal=%_($ cay [[%tabl t.p.p.cay] (slot 3 q.cay)])
?: ?=(%| -.gon.dat.tal)
tal
?. ?=(%path p.i.p.p.cay)
+.$(+>.$ (error:he %patch-strange-marc-a >p.i.p.p.cay< ~))
?. ?=(@ q.i.p.p.cay)
+.$(+>.$ (error:he %patch-strange-marc-b >p.i.p.p.cay< ~))
=+ coy=(slot 2 q.cay)
?@ q.coy
+.$(+>.$ (error:he %patch-strange-coy ~))
%_ +.$
can
:_ can:tal
:- ((hard path) -.q.coy)
?. ?=(%mime q.i.p.p.cay)
~
`((hard mime) q:(slot 3 coy))
==
?~ hez
(error:he %ergo-no-hez ~)
?: ?=(%| -.gon.dat)
+>.$
%= +>.$
don %|
reg [[u.hez %ergo who syd let.dom can] reg]
==
::
++ he
|%
++ done
|= con=(set path)
^+ ..he
..he(don |, gon.dat [%& con])
++ error
|= [err=term tan=(list tank)]
^+ ..he
..he(don |, gon.dat [%| err >ali< >bob< tan])
::
++ find-merge-points
|= [p=yaki q=yaki] :: maybe need jet
^- (set yaki)
%- reduce-merge-points
=+ r=(reachable-takos r.p)
|- ^- (set yaki)
?: (~(has in r) r.q) (~(put in *(set yaki)) q)
%+ roll p.q
|= [t=tako s=(set yaki)]
?: (~(has in r) t)
(~(put in s) (tako-to-yaki t)) :: found
(~(uni in s) ^$(q (tako-to-yaki t))) :: traverse
::
++ reduce-merge-points
|= unk=(set yaki) :: maybe need jet
=| 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)
:: I'm pretty sure this is just wrong, but given
:: the relative intelligence levels of me and Jared,
:: I'm going to keep it here for a little bit
:: ?: %+ roll (~(tap by (~(uni in gud) bun)) ~)
:: |= [tak=yaki god=?] :: only good + unknown
:: ^- ?
:: ?. god god
:: (~(has in (~(got by zar) r.tak)) n.unk)
:: Also, I'd be curious how often this actually
:: elminates merge points
$(gud (~(put in gud) n.unk), unk bun)
$(unk bun)
--
--
--
--
::
++ do
|= [now=@da hen=duct [who=ship him=ship] syd=@tas ruf=raft]
=+ ^= rug ^- rung
=+ rug=(~(get by hoy.ruf) him)
?^(rug u.rug *rung)
=+ ^= red ^- rede
=+ yit=(~(get by rus.rug) syd)
?^(yit u.yit `rede`[~2000.1.1 ~ [~ *rind] *dome ~ ~])
((de now hen ~ ~) [who him] syd red ran.ruf)
::
++ posh
|= [him=ship syd=desk red=rede ruf=raft]
^- raft
=+ ^= rug ^- rung
=+ rug=(~(get by hoy.ruf) him)
?^(rug u.rug *rung)
ruf(hoy (~(put by hoy.ruf) him rug(rus (~(put by rus.rug) syd red))))
::
++ un :: domestic ship
|= [who=@p now=@da hen=duct ruf=raft]
=+ ^= yar ^- room
=+ yar=(~(get by fat.ruf) who)
?~(yar *room u.yar)
|%
++ abet ruf(fat (~(put by fat.ruf) who yar))
++ pish
|= [syd=@ta red=rede run=rang]
%_ +>
ran.ruf run
dos.yar
(~(put by dos.yar) syd [qyx.red dom.red dok.red mer.red])
==
::
++ wake
=+ saz=(turn (~(tap by dos.yar) ~) |=([a=@tas b=*] a))
=| moz=(list move)
=< [moz ..wake]
|- ^+ +
?~ saz +
=+ sog=abet:wake:(di i.saz)
$(saz t.saz, moz (weld moz -.sog), ..wake (pish i.saz +.sog ran.ruf))
::
++ di
|= syd=@ta
=+ ^= saq ^- dojo
=+ saq=(~(get by dos.yar) syd)
?~(saq *dojo u.saq)
%^ (de now hen hun.yar hez.yar)
[who who]
syd
[[now qyx.saq ~ dom.saq dok.saq mer.saq] ran.ruf]
--
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4cA, filesystem vane ::
:: ::
=| :: instrument state
$: %0 :: vane version
ruf=raft :: revision tree
== ::
|= [now=@da eny=@ ski=sled] :: activate
^? :: opaque core
|% ::
++ call :: handle request
|= $: hen=duct
hic=(hypo (hobo kiss))
==
=> %= . :: XX temporary
q.hic
^- kiss
?: ?=(%soft -.q.hic)
=+
~|([%bad-soft (,@t -.p.q.hic)] ((soft kiss) p.q.hic))
?~ -
~& [%bad-softing (,@t -.p.q.hic)] !!
u.-
?: (~(nest ut -:!>(*kiss)) | p.hic) q.hic
~& [%clay-call-flub (,@tas `*`-.q.hic)]
((hard kiss) q.hic)
==
^- [p=(list move) q=_..^$]
?- -.q.hic
%font
?: (~(has by sor.ruf) +.q.hic) `..^$
:_ ..^$(sor.ruf (~(put by sor.ruf) +.q.hic hen))
:: XX pass %merg and handle response
:~ ^- move
:* hen %pass
/auto/(scot %p p.q.hic)/[q.q.hic]/(scot %p r.q.hic)/[s.q.hic]/y
%c %merg [p q r s %init]:q.hic
==
==
::
%init
:_ ..^$(fat.ruf (~(put by fat.ruf) p.q.hic [hen ~ ~]))
=+ bos=(sein p.q.hic)
~& [%bos bos p.q.hic]
?: =(bos p.q.hic) ~
^- (list move)
%+ turn (limo ~[%main %arvo %try])
|= syd=@tas
[hen %pass / %c %font p.q.hic syd bos syd]
::
%info
?: =(%$ q.q.hic)
[~ ..^$]
=^ mos ruf
=+ une=(un p.q.hic now hen ruf)
=+ ^= zat
(exec:(di:wake:une q.q.hic) now r.q.hic)
=+ zot=abet.zat
:- -.zot
=. une (pish:une q.q.hic +.zot ran.zat)
abet:une
[mos ..^$]
::
%into
=+ yar=(~(got by fat.ruf) p.q.hic)
:_ ..^$(fat.ruf (~(put by fat.ruf) p.q.hic yar(hez [~ hen])))
^- (list move)
?: =(%$ q.q.hic)
~
=+ dos=(~(get by dos.yar) q.q.hic)
?: &(?=(^ dos) !=(0 +>-.+<.+.dos)) :: ank.s.u.dos
?: =(ank.dom.u.dos q.q.hic)
~
:_ ~
:* hen %slip %c %info p.q.hic q.q.hic %&
(khan-to-soba `ank.dom.u.dos `r.q.hic)
==
=+ cos=(khan-to-soba ~ `r.q.hic)
=+ ^- [one=(list ,[path miso]) two=(list ,[path miso])]
%+ skid q.cos
|= [a=path b=miso]
?& ?=(%ins -.b)
?=(%mime p.p.b)
=+ (slag (dec (lent a)) a)
?| =([%hook ~] -)
=([%hoon ~] -)
== ==
:~ [hen %slip %c %info p.q.hic q.q.hic %& p.cos one]
[hen %slip %c %info p.q.hic q.q.hic %& p.cos two]
==
::
%merg :: direct state up
?: =(%$ q.q.hic)
[~ ..^$]
=^ mos ruf
=+ une=(un p.q.hic now hen ruf)
=+ ^= zat
abet:(start:(me:ze:(di:wake:une q.q.hic) r.q.hic s.q.hic) t.q.hic)
=+ zot=abet.zat
:- -.zot
=. une (pish:une q.q.hic +.zot ran.zat)
abet:une
[mos ..^$]
::
%plug
?. (~(has by sor.ruf) +.q.hic) `..^$
:_ ..^$(sor.ruf (~(del by sor.ruf) +.q.hic))
=+ hyn=(~(got by sor.ruf) +.q.hic)
:~ :* hyn %pass
/auto/(scot %p p.q.hic)/[q.q.hic]/(scot %p r.q.hic)/[s.q.hic]/y
%c %warp [p.q.hic r.q.hic] s.q.hic ~
==
:* hyn %pass
/auto/(scot %p p.q.hic)/[q.q.hic]/(scot %p r.q.hic)/[s.q.hic]/v
%c %warp [p.q.hic r.q.hic] s.q.hic ~
==
==
::
%warp
=^ mos ruf
?: =(p.p.q.hic q.p.q.hic)
=+ une=(un p.p.q.hic now hen ruf)
=+ wex=(di:une p.q.q.hic)
=+ ^= wao
?~ q.q.q.hic
ease:wex
(eave:wex u.q.q.q.hic)
=+ ^= woo
abet:wao
[-.woo abet:(pish:une p.q.q.hic +.woo ran.wao)]
=+ wex=(do now hen p.q.hic p.q.q.hic ruf)
=+ ^= woo
?~ q.q.q.hic
abet:ease:wex
abet:(eave:wex u.q.q.q.hic)
[-.woo (posh q.p.q.hic p.q.q.hic +.woo ruf)]
[mos ..^$]
::
%wart
?> ?=(%re q.q.hic)
=+ ryf=((hard riff) s.q.hic)
:_ ..^$
:~ :- hen
:^ %pass [(scot %p p.p.q.hic) (scot %p q.p.q.hic) r.q.hic]
%c
[%warp [p.p.q.hic p.p.q.hic] ryf]
==
==
::
++ doze
|= [now=@da hen=duct]
^- (unit ,@da)
~
::
++ load
|= old=[%0 ruf=raft]
^+ ..^$
..^$(ruf ruf.old)
::
++ scry :: inspect
|= [fur=(unit (set monk)) ren=@tas his=ship syd=desk lot=coin tyl=path]
^- (unit (unit cage))
=+ got=(~(has by fat.ruf) his)
=+ luk=?.(?=(%$ -.lot) ~ ((soft case) p.lot))
?~ luk [~ ~]
?: =(%$ ren)
[~ ~]
=+ run=((soft care) ren)
?~ run [~ ~]
%. [u.run u.luk tyl]
=< aver
?: got
(di:(un his now ~ ruf) syd)
(do now ~ [his his] syd ruf)
::
++ stay [%0 ruf]
++ take :: accept response
|= [tea=wire hen=duct hin=(hypo sign)]
^- [p=(list move) q=_..^$]
?: ?=([%merge @ @ @ @ @ ~] tea)
?> ?=(?(%writ %made) +<.q.hin)
=+ our=(slav %p i.t.tea)
=* syd i.t.t.tea
=+ her=(slav %p i.t.t.t.tea)
=* sud i.t.t.t.t.tea
=* sat i.t.t.t.t.t.tea
=+ une=(un our now hen ruf)
=+ wex=(di:une syd)
=+ dat=?-(+<.q.hin %writ [%& p.q.hin], %made [%| p.q.hin])
=+ wao=abet:(route:(me:ze:wex her sud) sat dat)
=+ woo=abet:wao
[-.woo ..^$(ruf abet:(pish:une syd +.woo ran.wao))]
?- -.+.q.hin
%crud
[[[hen %slip %d %flog +.q.hin] ~] ..^$]
::
%made
?~ tea !!
?+ -.tea !!
%casting
?> ?=([@ @ @ *] t.tea)
=+ who=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ une=(un who now hen ruf)
=+ ^= zat
(take-cast:(di:wake:une syd) wen t.t.t.t.tea p.q.hin)
=+ zot=abet.zat
[-.zot abet:(pish:une syd +.zot ran.zat)]
[mos ..^$]
::
%diffing
?> ?=([@ @ @ *] t.tea)
=+ who=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ une=(un who now hen ruf)
=+ ^= zat
(take-diff:(di:wake:une syd) wen t.t.t.t.tea p.q.hin)
=+ zot=abet.zat
[-.zot abet:(pish:une syd +.zot ran.zat)]
[mos ..^$]
::
%patching
?> ?=([@ @ ~] t.tea)
=+ who=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=^ mos ruf
?: (~(has by fat.ruf) who)
=+ une=(un who now hen ruf)
=+ zat=(take-patch:(di:wake:une syd) p.q.hin)
=+ zot=abet.zat
[-.zot abet:(pish:une syd +.zot ran.zat)]
=+ zax=(do now hen [who who] syd ruf)
=+ zat=(take-patch:zax p.q.hin)
=+ zot=abet.zat
[-.zot (posh who syd +.zot ruf)]
[mos ..^$]
::
%ergoing
?> ?=([@ @ ~] t.tea)
=+ who=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=^ mos ruf
=+ une=(un who now hen ruf)
=+ ^= zat
(take-ergo:(di:wake:une syd) p.q.hin)
=+ zot=abet.zat
[-.zot abet:(pish:une syd +.zot ran.zat)]
[mos ..^$]
::
%foreign-plops
?> ?=([@ @ @ ~] t.tea)
=+ our=(slav %p i.t.tea)
=+ her=(slav %p i.t.t.tea)
=* syd i.t.t.t.tea
=+ zax=(do now hen [our her] syd ruf)
=+ zat=(take-foreign-plops:zax p.q.hin)
=^ mos ruf
=+ zot=abet.zat
[-.zot (posh her syd +.zot ruf)]
[mos ..^$(ran.ruf ran.zat)]
==
::
%mere
~& ?: ?=(%& -.p.+.q.hin)
['merge succeeded' p.p.+.q.hin]
['merge failed' p.p.p.+.q.hin]
[~ ..^$]
::
%waft
?> ?=([@ @ ~] tea)
=+ syd=(slav %tas i.tea)
=+ inx=(slav %ud i.t.tea)
=+ ^= zat
=< wake
%- take-foreign-update:(do now hen p.+.q.hin syd ruf)
:: ~& [%rand q.+.q.hin ((soft (unit rand)) q.+.q.hin)]
[inx ((hard (unit rand)) q.+.q.hin)]
=^ mos ruf
=+ zot=abet.zat
[-.zot (posh q.p.+.q.hin syd +.zot ruf)]
~& %wafting
[mos ..^$(ran.ruf ran.zat)] :: merge in new obj
::
%wake
=+ dal=(turn (~(tap by fat.ruf) ~) |=([a=@p b=room] a))
=| mos=(list move)
|- ^- [p=(list move) q=_..^^$]
?~ dal [mos ..^^$]
=+ une=(un i.dal now hen ruf)
=^ som une wake:une
$(dal t.dal, ruf abet:une, mos (weld som mos))
::
%writ
?> ?=([@ @ *] tea)
~| i=i.tea
~| it=i.t.tea
=+ our=(slav %p i.tea)
=+ him=(slav %p i.t.tea)
:_ ..^$
:~ :* hen %pass ~ %a
%want [our him] [%r %re %c t.t.tea]
(bind p.+.q.hin rant-to-rand)
==
==
::
%went
?: =(%good q.+.q.hin) [~ ..^$]
~& [%clay-lost p.+.q.hin tea]
[~ ..^$]
==
::
++ rant-to-rand
|= rant
^- rand
[p q [p q.q]:r]
::
++ khan-to-soba
|= [ank=(unit ankh) kan=(unit khan)]
^- soba
:- *cart
=| pax=path
|- ^- (list ,[p=path q=miso])
?~ ank
?~ kan
~
=+ =+ (~(tap by dir.u.kan))
|-(?~(+< ~ (weld ^$(pax [p.i pax], kan `q.i) $(+< t))))
?~ fil.u.kan
-
?~ u.fil.u.kan
-
[[(flop pax) %ins u.u.fil.u.kan] -]
?~ kan
=+ =+ (~(tap by r.u.ank))
|-(?~(+< ~ (weld ^$(pax [p.i pax], ank `q.i) $(+< t))))
?~ q.u.ank
-
[[(flop pax) %del q.u.q.u.ank] -]
=+ %+ weld
=+ (~(tap by r.u.ank))
|- ^- (list ,[p=path q=miso])
?~ +< ~
%- weld :_ $(+< t)
^$(pax [p.i pax], ank `q.i, kan (~(get by dir.u.kan) p.i))
=+ (~(tap by dir.u.kan))
|- ^- (list ,[p=path q=miso])
?~ +< ~
?: (~(has by r.u.ank) p.i) $(+< t)
%- weld :_ $(+< t)
^$(pax [p.i pax], kan `q.i, ank ~)
?~ q.u.ank
?~ fil.u.kan
-
?~ u.fil.u.kan
-
[[(flop pax) %ins u.u.fil.u.kan] -]
?~ fil.u.kan
-
?~ u.fil.u.kan
[[(flop pax) %del q.u.q.u.ank] -]
[[(flop pax) %mut q.u.q.u.ank u.u.fil.u.kan] -]
--