refactor ++py for uni-directional diffs

This commit is contained in:
Anton Dyudin 2016-12-09 16:47:21 -08:00 committed by Fang
parent c9e5688065
commit 2ad320d66b

View File

@ -18,7 +18,7 @@
|= pit/vase |= pit/vase
=, pki:jael =, pki:jael
=, rights:jael =, rights:jael
=, able:jael =, able:jael
=, title =, title
=, crypto =, crypto
=, jael =, jael
@ -505,22 +505,51 @@
:: language compromises: the type system can't enforce :: language compromises: the type system can't enforce
:: that lef and ryt match, hence the asserts. :: that lef and ryt match, hence the asserts.
:: ::
=< |_ $: :: lef: old right
:: ryt: new right
::
lef/rite
ryt/rite
==
:: :: ++uni:ry
++ uni ~(sum +> lef ryt) :: add rights
:: :: ++dif:ry
++ dif :: r->l: {add remove}
^- (pair (unit rite) (unit rite))
[~(dif +> ryt lef) ~(dif +> lef ryt)]
:: :: ++sub:ry
++ sub :: l - r
^- (unit rite)
=/ vid dif
~| vid
?>(?=($~ q.vid) p.vid)
--
|_ $: :: lef: old right |_ $: :: lef: old right
:: ryt: new right :: ryt: new right
:: ::
lef/rite lef/rite
ryt/rite ryt/rite
== ==
:: :: ++sub-by:py
++ sub-by :: subtract elements
|* {new/(map) old/(map) sub/$-(^ *)} ^+ new
%- ~(rep by new)
|* {{key/* val/*} acc/_^+(new ~)}
=> .(+<- [key val]=+<-)
=/ var (~(get by old) key)
=. val ?~(var val (sub val u.var))
?~ val acc
(~(put by ,.acc) key val)
:: :: ++dif:ry :: :: ++dif:ry
++ dif :: r->l: {add remove} ++ dif :: in r and not l
^- (pair (unit rite) (unit rite)) ^- (unit rite)
|^ ?- -.lef |^ ?- -.lef
$apple ?>(?=($apple -.ryt) (table %apple p.lef p.ryt)) $apple ?>(?=($apple -.ryt) (table %apple p.lef p.ryt))
$block ?>(?=($block -.ryt) [~ ~]) $block ?>(?=($block -.ryt) ~)
$email ?>(?=($email -.ryt) (sable %email p.lef p.ryt)) $email ?>(?=($email -.ryt) (sable %email p.lef p.ryt))
$final ?>(?=($final -.ryt) (table %final p.lef p.ryt)) $final ?>(?=($final -.ryt) (table %final p.lef p.ryt))
$fungi ?>(?=($fungi -.ryt) (noble %fungi p.lef p.ryt)) $fungi ?>(?=($fungi -.ryt) (noble %fungi p.lef p.ryt))
$guest ?>(?=($guest -.ryt) [~ ~]) $guest ?>(?=($guest -.ryt) ~)
$hotel ?>(?=($hotel -.ryt) (bible %hotel p.lef p.ryt)) $hotel ?>(?=($hotel -.ryt) (bible %hotel p.lef p.ryt))
$jewel ?>(?=($jewel -.ryt) (table %jewel p.lef p.ryt)) $jewel ?>(?=($jewel -.ryt) (table %jewel p.lef p.ryt))
$login ?>(?=($login -.ryt) (sable %login p.lef p.ryt)) $login ?>(?=($login -.ryt) (sable %login p.lef p.ryt))
@ -528,97 +557,54 @@
$token ?>(?=($token -.ryt) (ruble %token p.lef p.ryt)) $token ?>(?=($token -.ryt) (ruble %token p.lef p.ryt))
$urban ?>(?=($urban -.ryt) (table %urban p.lef p.ryt)) $urban ?>(?=($urban -.ryt) (table %urban p.lef p.ryt))
== ==
:: :: ++cable:dif:ry
++ cable :: diff atom
|* {nut/@tas new/@ old/@}
^- (unit rite)
?: =(new old) ~
`[nut new]
:: :: ++bible:dif:ry :: :: ++bible:dif:ry
++ bible :: diff pile ++ bible :: diff pile
|* {nut/@tas new/(map dorm pile) old/(map dorm pile)} |* {nut/@tas old/(map dorm pile) new/(map dorm pile)}
=/ mor/_old ^- (unit rite)
%- ~(rep by old) =; mor/_new
|= {{cur/dorm fid/pile} acc/_^+(old ~)} ?~(mor ~ `[nut mor])
=. fid %^ sub-by new old
(~(sub py fid) (fall (~(get by new) cur) ~)) |=({a/pile b/pile} (~(sub py a) b))
?~ fid acc
(~(put by acc) cur fid)
::
=/ les/_new
%- ~(rep by new)
|= {{cur/dorm fid/pile} acc/_^+(new ~)}
=. fid
(~(sub py fid) (fall (~(get by old) cur) ~))
?~ fid acc
(~(put by acc) cur fid)
::
:- ?~(mor ~ `[nut mor])
?~(les ~ `[nut les])
:: :: ++noble:dif:ry :: :: ++noble:dif:ry
++ noble :: diff map of @ud ++ noble :: diff map of @ud
|* {nut/@tas new/(map * @ud) old/(map * @ud)} |* {nut/@tas old/(map * @ud) new/(map * @ud)}
^- (pair (unit rite) (unit rite)) ^- (unit rite)
=/ mor/_old =; mor/_new
%- ~(rep by old) ?~(mor ~ `[nut mor])
|* {{cur/* fid/@ud} acc/_^+(old ~)} %^ sub-by new old
=> .(+< `_[[cur fid]=-.new acc=old]`+<) |=({a/@u b/@u} (sub a (min a b)))
=. fid
(^sub fid (max fid (fall (~(get by new) cur) 0)))
?~ fid acc
(~(put by acc) cur fid)
::
=/ les/_new
%- ~(rep by new)
|* {{cur/* fid/@ud} acc/_^+(new ~)}
=> .(+< `_[[cur fid]=-.old acc=new]`+<)
=. fid
(^sub fid (max fid (fall (~(get by old) cur) 0)))
?~ fid acc
(~(put by acc) cur fid)
::
:- ?~(mor ~ `[nut mor])
?~(les ~ `[nut les])
:: :: ++ruble:dif:ry :: :: ++ruble:dif:ry
++ ruble :: diff map of maps ++ ruble :: diff map of maps
|* {nut/@tas new/(map * (map)) old/(map * (map))} |* {nut/@tas old/(map * (map)) new/(map * (map))}
=/ mor/_old ^- (unit rite)
%- ~(rep by old) =; mor/_new
|* {{cur/* fid/(map)} acc/_^+(old ~)} ?~(mor ~ `[nut mor])
=> .(+< `_[[cur fid]=n.-.new acc=old]`+<) %^ sub-by new old
=. fid =* valu (~(got by new))
(~(dif by ,.fid) (fall (~(get by new) cur) ~)) |= {a/_^+(valu ~) b/_^+(valu ~)} ^+ a
?~ fid acc (sub-by a b |*({a2/* b2/*} a2))
(~(put by acc) cur fid)
::
=/ les/_new
%- ~(rep by new)
|* {{cur/* fid/(map)} acc/_^+(new ~)}
=> .(+< `_[[cur fid]=n.-.old acc=new]`+<)
=. fid
(~(dif by ,.fid) (fall (~(get by old) cur) ~))
?~ fid acc
(~(put by acc) cur fid)
::
:- ?~(mor ~ `[nut mor])
?~(les ~ `[nut les])
:: :: ++sable:dif:ry :: :: ++sable:dif:ry
++ sable :: diff set ++ sable :: diff set
|* {nut/@tas new/(set) old/(set)} |* {nut/@tas old/(set) new/(set)}
=/ mor (~(dif in new) old) ^- (unit rite)
=/ les (~(dif in old) new) =; mor ?~(mor ~ `[nut mor])
:- ?~(mor ~ `[nut mor]) (~(dif in new) old)
?~(les ~ `[nut les])
:: :: ++table:dif:ry :: :: ++table:dif:ry
++ table :: diff map ++ table :: diff map
|* {nut/@tas new/(map) old/(map)} |* {nut/@tas old/(map) new/(map)}
::TODO (~(dep by old) new) ^- (unit rite)
=/ mor (~(dif by new) old) =; mor ?~(mor ~ `[nut mor])
=/ les (~(dif by old) new) ~! [old new]
:- ?~(mor ~ `[nut mor]) (sub-by new old |*({a/* b/*} a))
?~(les ~ `[nut les])
-- ::dif -- ::dif
:: :: ++sub:ry :: :: ++sum:ry
++ sub :: l - r ++ sum :: lef new, ryt old
^- (unit rite)
=/ vid dif
?>(?=($~ q.vid) p.vid)
:: :: ++add:ry
++ uni :: lef new, ryt old
^- rite ^- rite
|^ ?- -.lef |^ ?- -.lef
$apple ?>(?=($apple -.ryt) [%apple (table p.lef p.ryt)]) $apple ?>(?=($apple -.ryt) [%apple (table p.lef p.ryt)])
@ -1526,7 +1512,7 @@
:: ::
our/ship ::TODO "absolutely verboten" our/ship ::TODO "absolutely verboten"
now/@da now/@da
eny/@e eny/@e
gen/@pG gen/@pG
nym/arms nym/arms
== ==
@ -1543,7 +1529,7 @@
:: ::
:: initialize hierarchical property :: initialize hierarchical property
:: ::
=. +>.$ =. +>.$
=- abet:(deal:~(able ex our) our - ~) =- abet:(deal:~(able ex our) our - ~)
^- safe ^- safe
%- intern:up %- intern:up
@ -1574,7 +1560,7 @@
:: had: key handle :: had: key handle
:: ryt: initial right :: ryt: initial right
:: ::
=/ key (ypt:scr (mix our %jael-make) gen) =/ key (ypt:scr (mix our %jael-make) gen)
=* had (shaf %hand key) =* had (shaf %hand key)
=* ryt `rite`[%urban [had (add ~m1 now) key] ~ ~] =* ryt `rite`[%urban [had (add ~m1 now) key] ~ ~]
:: ::