mirror of
https://github.com/urbit/shrub.git
synced 2025-01-02 09:32:29 +03:00
noun-autodiff: Added a mark that has diffing
This commit is contained in:
parent
5dcb298eec
commit
8b208451bd
219
pkg/base-dev/lib/noun-diff.hoon
Normal file
219
pkg/base-dev/lib/noun-diff.hoon
Normal file
@ -0,0 +1,219 @@
|
||||
=<
|
||||
|%
|
||||
++ diff
|
||||
|= [old=* new=*]
|
||||
^- patch
|
||||
=/ del (extract-del (oracle old new) old)
|
||||
=/ ins (extract-ins (oracle old new) new)
|
||||
=/ allowed-holes (~(int in (find-del-holes del)) (find-ins-holes ins))
|
||||
=. del (filter-del-holes allowed-holes del)
|
||||
=/ ins (filter-ins-holes allowed-holes ins)
|
||||
=/ closed-patch (closure (gcp [del ins]))
|
||||
?> =(& +.closed-patch)
|
||||
-.closed-patch
|
||||
++ apply
|
||||
|= [patch=_id noun=*]
|
||||
?- -.patch
|
||||
%diff
|
||||
=/ var-map (del del.patch noun)
|
||||
(ins ins.patch var-map)
|
||||
%cell
|
||||
?> ?=(^ noun)
|
||||
[$(patch lhs.patch, noun -.noun) $(patch rhs.patch, noun +.noun)]
|
||||
==
|
||||
++ id
|
||||
^- patch
|
||||
[%diff [%hole ~] [%hole ~]]
|
||||
+$ patch
|
||||
$% [%cell lhs=patch rhs=patch]
|
||||
[%diff ^diff]
|
||||
==
|
||||
--
|
||||
::
|
||||
|%
|
||||
+$ del-diff
|
||||
$% [%hole @]
|
||||
[%cell lhs=del-diff rhs=del-diff]
|
||||
[%ignore ~]
|
||||
==
|
||||
+$ ins-diff
|
||||
$% [%hole @ original=*]
|
||||
[%cell lhs=ins-diff rhs=ins-diff]
|
||||
[%atom @]
|
||||
==
|
||||
+$ final-ins-diff
|
||||
$% [%hole @]
|
||||
[%cell lhs=final-ins-diff rhs=final-ins-diff]
|
||||
[%atom @]
|
||||
==
|
||||
+$ diff [del=del-diff ins=final-ins-diff]
|
||||
+$ patch
|
||||
$% [%cell lhs=patch rhs=patch]
|
||||
[%diff diff]
|
||||
==
|
||||
++ insify-noun
|
||||
|= noun=*
|
||||
^- final-ins-diff
|
||||
?- noun
|
||||
^ [%cell $(noun -.noun) $(noun +.noun)]
|
||||
@ [%atom noun]
|
||||
==
|
||||
++ empty-set (silt `(list @)`~)
|
||||
++ find-del-holes
|
||||
|= diff=del-diff
|
||||
~+
|
||||
^- (set @)
|
||||
?- -.diff
|
||||
%hole (silt ~[+.diff])
|
||||
%cell
|
||||
(~(uni in $(diff lhs.diff)) $(diff rhs.diff))
|
||||
%ignore empty-set
|
||||
==
|
||||
++ find-final-ins-holes
|
||||
|= diff=final-ins-diff
|
||||
~+
|
||||
^- (set @)
|
||||
?- -.diff
|
||||
%hole (silt ~[+.diff])
|
||||
%cell
|
||||
(~(uni in $(diff lhs.diff)) $(diff rhs.diff))
|
||||
%atom empty-set
|
||||
==
|
||||
++ find-ins-holes
|
||||
|= diff=ins-diff
|
||||
~+
|
||||
^- (set @)
|
||||
?- -.diff
|
||||
%hole (silt ~[+<.diff])
|
||||
%cell
|
||||
(~(uni in $(diff lhs.diff)) $(diff rhs.diff))
|
||||
%atom empty-set
|
||||
==
|
||||
++ filter-del-holes
|
||||
|= [allowed-holes=(set @) diff=del-diff]
|
||||
^- del-diff
|
||||
?: ?=(%ignore -.diff) diff
|
||||
?- -.diff
|
||||
%hole
|
||||
?: (~(has in allowed-holes) +.diff) diff
|
||||
[%ignore ~]
|
||||
%cell [%cell $(diff +<.diff) $(diff +>.diff)]
|
||||
==
|
||||
++ filter-ins-holes
|
||||
|= [allowed-holes=(set @) diff=ins-diff]
|
||||
^- final-ins-diff
|
||||
?- -.diff
|
||||
%hole
|
||||
?: (~(has in allowed-holes) +<.diff) [%hole +<.diff]
|
||||
(insify-noun original:diff)
|
||||
%cell [%cell $(diff +<.diff) $(diff +>.diff)]
|
||||
%atom diff
|
||||
==
|
||||
++ gcp
|
||||
|= diff=diff
|
||||
^- patch
|
||||
?- -.ins.diff
|
||||
%atom
|
||||
[%diff diff]
|
||||
%cell
|
||||
?: ?=(%cell -.del.diff)
|
||||
[%cell $(diff [+<.del.diff +<.ins.diff]) $(diff [+>.del.diff +>.ins.diff])]
|
||||
[%diff diff]
|
||||
%hole
|
||||
[%diff diff]
|
||||
==
|
||||
++ closure
|
||||
|= =patch
|
||||
^- [^patch ?]
|
||||
?- -.patch
|
||||
%diff
|
||||
=/ del-holes (find-del-holes del:patch)
|
||||
=/ ins-holes (find-final-ins-holes ins:patch)
|
||||
=/ difference (~(dif in ins-holes) del-holes)
|
||||
[patch =(difference empty-set)]
|
||||
%cell
|
||||
=/ lhs $(patch lhs:patch)
|
||||
=/ rhs $(patch rhs:patch)
|
||||
?: ?&(+.lhs +.rhs) [[%cell -.lhs -.rhs] &]
|
||||
$(patch (pull-diff [%cell -.lhs -.rhs]))
|
||||
==
|
||||
++ pull-diff
|
||||
|= =patch
|
||||
^- [%diff del=del-diff ins=final-ins-diff]
|
||||
?- -.patch
|
||||
%diff patch
|
||||
%cell
|
||||
=/ pulled-lhs $(patch lhs:patch)
|
||||
=/ pulled-rhs $(patch rhs:patch)
|
||||
:+
|
||||
%diff
|
||||
[%cell del:pulled-lhs del:pulled-rhs]
|
||||
[%cell ins:pulled-lhs ins:pulled-rhs]
|
||||
==
|
||||
++ is-subtree
|
||||
|= [tree=* subtree=*]
|
||||
~+
|
||||
^- ?
|
||||
?: =(tree subtree) &
|
||||
?@ tree |
|
||||
?| (is-subtree -.tree subtree)
|
||||
(is-subtree +.tree subtree)
|
||||
==
|
||||
++ oracle
|
||||
|= [a=* b=*]
|
||||
|= subtree=*
|
||||
^- (unit @)
|
||||
?: ?& (is-subtree a subtree)
|
||||
(is-subtree b subtree)
|
||||
==
|
||||
`(mug subtree)
|
||||
~
|
||||
++ extract-del
|
||||
|= [oracle=$-(* (unit @)) subtree=*]
|
||||
~+
|
||||
^- del-diff
|
||||
=/ hash (oracle subtree)
|
||||
?^ hash [%hole +.hash]
|
||||
?@ subtree [%ignore ~]
|
||||
[%cell (extract-del oracle -.subtree) (extract-del oracle +.subtree)]
|
||||
++ extract-ins
|
||||
|= [oracle=$-(* (unit @)) subtree=*]
|
||||
~+
|
||||
^- ins-diff
|
||||
=/ hash (oracle subtree)
|
||||
?^ hash [%hole +.hash subtree]
|
||||
?@ subtree [%atom subtree]
|
||||
[%cell (extract-ins oracle -.subtree) (extract-ins oracle +.subtree)]
|
||||
++ ins
|
||||
|= [diff=final-ins-diff var-map=(map @ *)]
|
||||
^- *
|
||||
?- -.diff
|
||||
%atom +.diff
|
||||
%cell [$(diff +<.diff) $(diff +>.diff)]
|
||||
%hole (~(got by var-map) +.diff)
|
||||
==
|
||||
++ del
|
||||
|= [diff=del-diff noun=*]
|
||||
^- (map @ *)
|
||||
|^ (go diff noun ((map @ *) ~))
|
||||
++ go
|
||||
|= [diff=del-diff noun=* var-map=(map @ *)]
|
||||
^- (map @ *)
|
||||
?- -.diff
|
||||
%ignore
|
||||
var-map
|
||||
::
|
||||
%hole
|
||||
=/ subtree (~(get by var-map) +.diff)
|
||||
?~ subtree (~(put by var-map) +.diff noun)
|
||||
?> =(+.subtree noun)
|
||||
var-map
|
||||
::
|
||||
%cell
|
||||
?> ?=(^ noun)
|
||||
=/ lhs-var-map $(diff +<.diff, noun -.noun)
|
||||
=/ rhs-var-map $(diff +>.diff, noun +.noun, var-map lhs-var-map)
|
||||
rhs-var-map
|
||||
==
|
||||
--
|
||||
--
|
||||
32
pkg/base-dev/mar/noun-autodiff.hoon
Normal file
32
pkg/base-dev/mar/noun-autodiff.hoon
Normal file
@ -0,0 +1,32 @@
|
||||
::
|
||||
:::: /hoon/noun/mar
|
||||
::
|
||||
/? 310
|
||||
/+ noun-diff
|
||||
!:
|
||||
|_ non=*
|
||||
++ grab |%
|
||||
++ noun *
|
||||
--
|
||||
++ grow |%
|
||||
++ mime [/application/x-urb-jam (as-octs:mimes:html (jam non))]
|
||||
--
|
||||
++ grad
|
||||
|%
|
||||
++ form %noun
|
||||
++ diff
|
||||
|= new=*
|
||||
^- (list diff:noun-diff)
|
||||
~[(diff:noun-diff non new)]
|
||||
++ pact
|
||||
|= patches=(list patch:noun-diff)
|
||||
(roll patches |=([=patch:noun-diff n=_non] (apply:noun-diff patch n)))
|
||||
:: A poor mans' version of merging patches. Just apply them in sequence.
|
||||
++ join
|
||||
|= [old=(list patch:noun-diff) new=(list patch:noun-diff)]
|
||||
`(weld new old)
|
||||
++ mash
|
||||
|= [[ship desk old=(list patch:noun-diff)] [ship desk new=(list patch:noun-diff)]]
|
||||
(weld new old)
|
||||
--
|
||||
--
|
||||
20
tests/lib/noun-diff.hoon
Normal file
20
tests/lib/noun-diff.hoon
Normal file
@ -0,0 +1,20 @@
|
||||
/+ quiz, *test, noun-diff
|
||||
|%
|
||||
++ giv givers.quiz
|
||||
++ check ~(check quiz `@uv`1 200)
|
||||
++ test-diff
|
||||
=/ fate
|
||||
!>
|
||||
|= [old=* new=*]
|
||||
=/ patch (diff:noun-diff old new)
|
||||
=(new (apply:noun-diff patch old))
|
||||
(expect !>((check fate ~ ~)))
|
||||
++ test-id
|
||||
=/ fate
|
||||
!>
|
||||
|= non=*
|
||||
=(non (apply:noun-diff id.noun-diff non))
|
||||
(expect !>((check fate ~ ~)))
|
||||
--
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user