From 8b208451bdb6554bcccbf3222179641c016fc84a Mon Sep 17 00:00:00 2001 From: iko Date: Wed, 21 Jun 2023 14:51:00 +0300 Subject: [PATCH] noun-autodiff: Added a mark that has diffing --- pkg/base-dev/lib/noun-diff.hoon | 219 ++++++++++++++++++++++++++++ pkg/base-dev/mar/noun-autodiff.hoon | 32 ++++ tests/lib/noun-diff.hoon | 20 +++ 3 files changed, 271 insertions(+) create mode 100644 pkg/base-dev/lib/noun-diff.hoon create mode 100644 pkg/base-dev/mar/noun-autodiff.hoon create mode 100644 tests/lib/noun-diff.hoon diff --git a/pkg/base-dev/lib/noun-diff.hoon b/pkg/base-dev/lib/noun-diff.hoon new file mode 100644 index 0000000000..722f53697e --- /dev/null +++ b/pkg/base-dev/lib/noun-diff.hoon @@ -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 + == + -- +-- diff --git a/pkg/base-dev/mar/noun-autodiff.hoon b/pkg/base-dev/mar/noun-autodiff.hoon new file mode 100644 index 0000000000..ea102a4589 --- /dev/null +++ b/pkg/base-dev/mar/noun-autodiff.hoon @@ -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) + -- +-- diff --git a/tests/lib/noun-diff.hoon b/tests/lib/noun-diff.hoon new file mode 100644 index 0000000000..0bce649613 --- /dev/null +++ b/tests/lib/noun-diff.hoon @@ -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 ~ ~))) +-- + +