mirror of
https://github.com/urbit/shrub.git
synced 2024-12-14 20:02:51 +03:00
%diff schematic
This commit is contained in:
Ted Blackman
parent
c609f4d210
commit
afb1532241
@ -107,6 +107,8 @@
|
||||
test-mute
|
||||
test-bake-renderer
|
||||
test-bake-mark
|
||||
test-diff
|
||||
test-diff-form
|
||||
==
|
||||
++ test-tear
|
||||
:- `tank`leaf+"test-tear"
|
||||
@ -5583,16 +5585,6 @@
|
||||
::
|
||||
=/ hoon-src-type=type [%atom %$ ~]
|
||||
::
|
||||
=/ bar-mark-src=@ta
|
||||
'''
|
||||
|_ sample=[@ @]
|
||||
++ grab
|
||||
|%
|
||||
+= noun [@ @]
|
||||
--
|
||||
--
|
||||
'''
|
||||
::
|
||||
=/ scry-results=(map [term beam] (unit cage))
|
||||
%- my :~
|
||||
:- [%cx [[~nul %home %da ~1234.5.6] /hoon/foo/mar]]
|
||||
@ -5675,6 +5667,172 @@
|
||||
(expect-ford-empty ford ~nul)
|
||||
==
|
||||
::
|
||||
++ test-diff
|
||||
:- `tank`leaf+"test-diff"
|
||||
::
|
||||
=/ ford *ford-gate
|
||||
::
|
||||
=/ hoon-src-type=type [%atom %$ ~]
|
||||
::
|
||||
=/ scry-results=(map [term beam] (unit cage))
|
||||
%- my :~
|
||||
:- [%cx [[~nul %home %da ~1234.5.6] /hoon/foo/mar]]
|
||||
:^ ~ %hoon hoon-src-type
|
||||
'''
|
||||
|_ cell=^
|
||||
++ grab
|
||||
|%
|
||||
++ noun ^
|
||||
--
|
||||
++ grad
|
||||
|%
|
||||
++ diff |=(^ +<)
|
||||
++ form %foo
|
||||
--
|
||||
--
|
||||
'''
|
||||
==
|
||||
::
|
||||
=^ results1 ford
|
||||
%- test-ford-call-with-comparator :*
|
||||
ford
|
||||
now=~1234.5.6
|
||||
scry=(scry-with-results-and-failures scry-results)
|
||||
::
|
||||
::
|
||||
^= call-args
|
||||
:* duct=~[/path] type=~ %make ~nul
|
||||
%pin ~1234.5.6
|
||||
:^ %diff [~nul %home]
|
||||
[%$ %foo !>([12 13])]
|
||||
[%$ %foo !>([17 18])]
|
||||
==
|
||||
::
|
||||
^= comparator
|
||||
|= moves=(list move:ford-gate)
|
||||
::
|
||||
?> =(1 (lent moves))
|
||||
?> ?=(^ moves)
|
||||
?> ?=([* %give %made @da %complete %success %pin *] i.moves)
|
||||
=/ result result.p.card.i.moves
|
||||
=/ pin-result build-result.result
|
||||
~& build-result.pin-result
|
||||
?> ?=([%success %diff *] build-result.pin-result)
|
||||
::
|
||||
=/ =cage cage.build-result.pin-result
|
||||
::
|
||||
%+ weld
|
||||
%- expect-eq !>
|
||||
:- %foo
|
||||
p.cage
|
||||
::
|
||||
%+ weld
|
||||
%- expect-eq !>
|
||||
:- [17 18]
|
||||
q.q.cage
|
||||
::
|
||||
%- expect-eq !>
|
||||
:- &
|
||||
(~(nest ut p.q.cage) | -:!>([17 18]))
|
||||
==
|
||||
::
|
||||
;: weld
|
||||
results1
|
||||
(expect-ford-empty ford ~nul)
|
||||
==
|
||||
::
|
||||
++ test-diff-form
|
||||
:- `tank`leaf+"test-diff-form"
|
||||
::
|
||||
=/ ford *ford-gate
|
||||
::
|
||||
=/ hoon-src-type=type [%atom %$ ~]
|
||||
::
|
||||
=/ scry-results=(map [term beam] (unit cage))
|
||||
%- my :~
|
||||
:- [%cx [[~nul %home %da ~1234.5.6] /hoon/txt/mar]]
|
||||
:^ ~ %hoon hoon-src-type
|
||||
'''
|
||||
|_ txt=wain
|
||||
++ grab
|
||||
|%
|
||||
++ noun wain
|
||||
--
|
||||
++ grad
|
||||
|%
|
||||
++ form %txt-diff
|
||||
++ diff
|
||||
|= other-txt=wain
|
||||
^- (urge:clay cord)
|
||||
=, differ
|
||||
(lusk txt other-txt (loss txt other-txt))
|
||||
--
|
||||
--
|
||||
'''
|
||||
::
|
||||
:- [%cx [[~nul %home %da ~1234.5.6] /hoon/txt-diff/mar]]
|
||||
:^ ~ %hoon hoon-src-type
|
||||
'''
|
||||
|_ txt-diff=(urge:clay cord)
|
||||
++ grab
|
||||
|%
|
||||
++ noun (urge:clay cord)
|
||||
--
|
||||
--
|
||||
'''
|
||||
::
|
||||
:- [%cx [[~nul %home %da ~1234.5.6] /hoon/diff/txt/mar]]
|
||||
~
|
||||
==
|
||||
::
|
||||
=^ results1 ford
|
||||
%- test-ford-call-with-comparator :*
|
||||
ford
|
||||
now=~1234.5.6
|
||||
scry=(scry-with-results-and-failures scry-results)
|
||||
::
|
||||
::
|
||||
^= call-args
|
||||
:* duct=~[/path] type=~ %make ~nul
|
||||
%pin ~1234.5.6
|
||||
:^ %diff [~nul %home]
|
||||
[%$ %txt !>(~[%a %b])]
|
||||
[%$ %txt !>(~[%a %d])]
|
||||
==
|
||||
::
|
||||
^= comparator
|
||||
|= moves=(list move:ford-gate)
|
||||
::
|
||||
?> =(1 (lent moves))
|
||||
?> ?=(^ moves)
|
||||
?> ?=([* %give %made @da %complete %success %pin *] i.moves)
|
||||
=/ result result.p.card.i.moves
|
||||
=/ pin-result build-result.result
|
||||
~& build-result.pin-result
|
||||
?> ?=([%success %diff *] build-result.pin-result)
|
||||
::
|
||||
=/ =cage cage.build-result.pin-result
|
||||
::
|
||||
%+ weld
|
||||
%- expect-eq !>
|
||||
:- %txt-diff
|
||||
p.cage
|
||||
::
|
||||
%+ weld
|
||||
%- expect-eq !>
|
||||
:- ~[[%& 1] [%| ~[%b] ~[%d]]]
|
||||
q.q.cage
|
||||
::
|
||||
%- expect-eq !>
|
||||
:- &
|
||||
(~(nest ut p.q.cage) | -:!>(~[[%& 1] [%| ~[%b] ~[%d]]]))
|
||||
==
|
||||
::
|
||||
;: weld
|
||||
results1
|
||||
(expect-ford-empty ford ~nul)
|
||||
==
|
||||
::
|
||||
::
|
||||
:: |utilities: helper arms
|
||||
::
|
||||
|
||||
@ -2683,7 +2683,7 @@
|
||||
%call (make-call gate sample)
|
||||
%cast (make-cast disc mark input)
|
||||
%core (make-core source-path)
|
||||
%diff !!
|
||||
%diff (make-diff disc start end)
|
||||
%dude (make-dude error attempt)
|
||||
%hood (make-hood source-path)
|
||||
%join !!
|
||||
@ -3210,6 +3210,155 @@
|
||||
?> ?=([%success %plan *] u.plan-result)
|
||||
[build [%build-result %success %core vase.u.plan-result] accessed-builds]
|
||||
::
|
||||
++ make-diff
|
||||
|= [=disc start=schematic end=schematic]
|
||||
^- build-receipt
|
||||
:: run both input schematics as an autocons build
|
||||
::
|
||||
=/ sub-build=^build [date.build [start end]]
|
||||
::
|
||||
=^ sub-result accessed-builds (depend-on sub-build)
|
||||
?~ sub-result
|
||||
[build [%blocks [sub-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success ^ ^] sub-result)
|
||||
(wrap-error sub-result)
|
||||
?. ?=([%success *] head.u.sub-result)
|
||||
(wrap-error `head.u.sub-result)
|
||||
?. ?=([%success *] tail.u.sub-result)
|
||||
(wrap-error `tail.u.sub-result)
|
||||
::
|
||||
=/ start-cage=cage (result-to-cage head.u.sub-result)
|
||||
=/ end-cage=cage (result-to-cage tail.u.sub-result)
|
||||
:: if the marks aren't the same, we can't diff them
|
||||
::
|
||||
?. =(p.start-cage p.end-cage)
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %diff failed: mark mismatch: %{<p.start-cage>} / %{<p.end-cage>}"
|
||||
:: if the values are the same, the diff is null
|
||||
::
|
||||
?: =(q.q.start-cage q.q.end-cage)
|
||||
=/ =build-result
|
||||
[%success %diff [%null [%atom %n ~] ~]]
|
||||
::
|
||||
[build [%build-result build-result] accessed-builds]
|
||||
::
|
||||
=/ mark-path-build=^build [date.build [%path disc %mar p.start-cage]]
|
||||
::
|
||||
=^ mark-path-result accessed-builds (depend-on mark-path-build)
|
||||
?~ mark-path-result
|
||||
[build [%blocks [mark-path-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %path *] mark-path-result)
|
||||
(wrap-error mark-path-result)
|
||||
::
|
||||
=/ mark-build=^build [date.build [%core rail.u.mark-path-result]]
|
||||
::
|
||||
=^ mark-result accessed-builds (depend-on mark-build)
|
||||
?~ mark-result
|
||||
[build [%blocks [mark-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %core *] mark-result)
|
||||
(wrap-error mark-result)
|
||||
::
|
||||
?. (slab %grad p.vase.u.mark-result)
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %diff failed: %{<p.start-cage>} mark has no +grad arm"
|
||||
::
|
||||
=/ grad-build=^build
|
||||
[date.build [%ride [%limb %grad] [%$ %noun vase.u.mark-result]]]
|
||||
::
|
||||
=^ grad-result accessed-builds (depend-on grad-build)
|
||||
?~ grad-result
|
||||
[build [%blocks [grad-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %ride *] grad-result)
|
||||
(wrap-error grad-result)
|
||||
:: if +grad produced a @tas, convert to that mark and diff those
|
||||
::
|
||||
?@ q.vase.u.grad-result
|
||||
=/ mark=(unit @tas) ((sand %tas) q.vase.u.grad-result)
|
||||
?~ mark
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %diff failed: %{<p.start-cage>} mark has invalid +grad arm"
|
||||
::
|
||||
=/ diff-build=^build
|
||||
:- date.build
|
||||
:^ %diff
|
||||
disc
|
||||
[%cast disc u.mark [%$ start-cage]]
|
||||
[%cast disc u.mark [%$ end-cage]]
|
||||
::
|
||||
=^ diff-result accessed-builds (depend-on diff-build)
|
||||
?~ diff-result
|
||||
[build [%blocks [diff-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %diff *] diff-result)
|
||||
(wrap-error diff-result)
|
||||
::
|
||||
=/ =build-result
|
||||
[%success %diff cage.u.diff-result]
|
||||
::
|
||||
[build [%build-result build-result] accessed-builds]
|
||||
:: +grad produced a cell, which should be a core with a +form arm
|
||||
::
|
||||
?. (slab %form p.vase.u.grad-result)
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %diff failed: %{<p.start-cage>} mark has no +form:grab arm"
|
||||
~& sloe+(sloe p.vase.u.grad-result)
|
||||
:: the +grab core should also contain a +diff arm
|
||||
::
|
||||
?. (slab %diff p.vase.u.grad-result)
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %diff failed: %{<p.start-cage>} mark has no +diff:grab arm"
|
||||
::
|
||||
=/ diff-build=^build
|
||||
:- date.build
|
||||
:+ %call
|
||||
::
|
||||
^= gate
|
||||
:+ %ride
|
||||
::
|
||||
formula=`hoon`[%tsgl [%wing ~[%diff]] [%wing ~[%grad]]]
|
||||
::
|
||||
^= subject
|
||||
:+ %mute
|
||||
::
|
||||
subject=`schematic`[%$ %noun vase.u.mark-result]
|
||||
::
|
||||
^= mutations
|
||||
^- (list [wing schematic])
|
||||
[[%& 6]~ [%$ start-cage]]~
|
||||
::
|
||||
sample=`schematic`[%$ end-cage]
|
||||
::
|
||||
=^ diff-result accessed-builds (depend-on diff-build)
|
||||
?~ diff-result
|
||||
[build [%blocks [diff-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %call *] diff-result)
|
||||
(wrap-error diff-result)
|
||||
::
|
||||
=/ form-build=^build
|
||||
[date.build [%ride [%limb %form] [%$ %noun vase.u.grad-result]]]
|
||||
::
|
||||
=^ form-result accessed-builds (depend-on form-build)
|
||||
?~ form-result
|
||||
[build [%blocks [form-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %ride *] form-result)
|
||||
(wrap-error form-result)
|
||||
::
|
||||
=/ mark=(unit @tas) ((soft @tas) q.vase.u.form-result)
|
||||
?~ mark
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %diff failed: invalid +form result: {(text vase.u.form-result)}"
|
||||
::
|
||||
=/ =build-result
|
||||
[%success %diff [u.mark vase.u.diff-result]]
|
||||
::
|
||||
[build [%build-result build-result] accessed-builds]
|
||||
::
|
||||
++ make-dude
|
||||
|= [error=(trap tank) attempt=schematic]
|
||||
^- build-receipt
|
||||
|
||||
Loading…
Reference in New Issue
Block a user