mirror of
https://github.com/urbit/shrub.git
synced 2024-12-14 11:08:45 +03:00
%join schematic
This commit is contained in:
Ted Blackman
parent
514abe2f2d
commit
bbc38adddc
@ -111,6 +111,7 @@
|
||||
test-diff-form
|
||||
test-pact
|
||||
test-pact-mark
|
||||
test-join
|
||||
==
|
||||
++ test-tear
|
||||
:- `tank`leaf+"test-tear"
|
||||
@ -6045,6 +6046,79 @@
|
||||
results1
|
||||
(expect-ford-empty ford ~nul)
|
||||
==
|
||||
::
|
||||
++ test-join
|
||||
:- `tank`leaf+"test-join"
|
||||
::
|
||||
=/ 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
|
||||
.^(@t %cx (en-beam:format [bek /hoon/txt/mar]))
|
||||
::
|
||||
:- [%cx [[~nul %home %da ~1234.5.6] /hoon/txt-diff/mar]]
|
||||
:^ ~ %hoon hoon-src-type
|
||||
.^(@t %cx (en-beam:format [bek /hoon/txt-diff/mar]))
|
||||
::
|
||||
:- [%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
|
||||
:^ %join [~nul %home] %txt
|
||||
:: replace %a with %c on the first line
|
||||
::
|
||||
:- [%$ %txt-diff !>(~[[%| ~[%a] ~[%c]] [%& 1]])]
|
||||
:: replace %b with %d on the second line
|
||||
::
|
||||
[%$ %txt-diff !>(~[[%& 1] [%| ~[%b] ~[%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
|
||||
?> ?=([%success %join *] build-result.pin-result)
|
||||
::
|
||||
=/ =cage cage.build-result.pin-result
|
||||
::
|
||||
%+ weld
|
||||
%- expect-eq !>
|
||||
:- %txt-diff
|
||||
p.cage
|
||||
::
|
||||
%+ weld
|
||||
%- expect-eq !>
|
||||
:- ~[[%| ~[%a] ~[%c]] [%| ~[%b] ~[%d]]]
|
||||
q.q.cage
|
||||
::
|
||||
%- expect-eq !>
|
||||
:- &
|
||||
(~(nest ut p.q.cage) | -:!>(*(urge:clay cord)))
|
||||
==
|
||||
::
|
||||
;: weld
|
||||
results1
|
||||
(expect-ford-empty ford ~nul)
|
||||
==
|
||||
|
||||
|
||||
:: |utilities: helper arms
|
||||
::
|
||||
::+| utilities
|
||||
|
||||
@ -2683,7 +2683,7 @@
|
||||
%diff (make-diff disc start end)
|
||||
%dude (make-dude error attempt)
|
||||
%hood (make-hood source-path)
|
||||
%join !!
|
||||
%join (make-join disc mark first second)
|
||||
%mash !!
|
||||
%mute (make-mute subject mutations)
|
||||
%pact (make-pact disc start diff)
|
||||
@ -3397,6 +3397,133 @@
|
||||
::
|
||||
[build [%build-result %success %hood p.u.q.parsed] accessed-builds]
|
||||
::
|
||||
++ make-join
|
||||
|= [disc=^disc mark=term first=schematic second=schematic]
|
||||
^- build-receipt
|
||||
::
|
||||
=/ initial-build=^build
|
||||
[date.build [first second] [%path disc %mar mark]]
|
||||
::
|
||||
=^ initial-result accessed-builds (depend-on initial-build)
|
||||
?~ initial-result
|
||||
[build [%blocks [initial-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success [%success ^ ^] %success %path *] initial-result)
|
||||
(wrap-error initial-result)
|
||||
::
|
||||
=/ first-cage=cage (result-to-cage head.head.u.initial-result)
|
||||
=/ second-cage=cage (result-to-cage tail.head.u.initial-result)
|
||||
=/ mark-path=rail rail.tail.u.initial-result
|
||||
:: TODO: duplicate logic with +make-pact and others
|
||||
::
|
||||
=/ mark-build=^build [date.build [%core mark-path]]
|
||||
::
|
||||
=^ mark-result accessed-builds (depend-on mark-build)
|
||||
?~ mark-result
|
||||
[build [%blocks [mark-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %core *] mark-result)
|
||||
(wrap-error mark-result)
|
||||
::
|
||||
=/ mark-vase=vase vase.u.mark-result
|
||||
::
|
||||
?. (slab %grad p.mark-vase)
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %join failed: %{<mark>} mark has no +grad arm"
|
||||
::
|
||||
=/ grad-build=^build
|
||||
[date.build [%ride [%limb %grad] [%$ %noun mark-vase]]]
|
||||
::
|
||||
=^ grad-result accessed-builds (depend-on grad-build)
|
||||
?~ grad-result
|
||||
[build [%blocks [grad-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %ride *] grad-result)
|
||||
(wrap-error grad-result)
|
||||
::
|
||||
=/ grad-vase=vase vase.u.grad-result
|
||||
:: if +grad produced a mark, delegate %join behavior to that mark
|
||||
::
|
||||
?@ q.grad-vase
|
||||
:: if +grad produced a term, make sure it's a valid mark
|
||||
::
|
||||
=/ grad-mark=(unit term) ((sand %tas) q.grad-vase)
|
||||
?~ grad-mark
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %pact failed: %{<mark>} mark invalid +grad"
|
||||
::
|
||||
=/ join-build=^build
|
||||
[date.build [%join disc mark [%$ first-cage] [%$ second-cage]]]
|
||||
::
|
||||
=^ join-result accessed-builds (depend-on join-build)
|
||||
?~ join-result
|
||||
[build [%blocks [join-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %join *] join-result)
|
||||
(wrap-error join-result)
|
||||
::
|
||||
[build [%build-result u.join-result] accessed-builds]
|
||||
:: make sure the +grad core has a +form arm
|
||||
::
|
||||
?. (slab %form p.grad-vase)
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %join failed: no +form:grad in %{<mark>} mark"
|
||||
:: make sure the +grad core has a +join arm
|
||||
::
|
||||
?. (slab %join p.grad-vase)
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %join failed: no +join:grad in %{<mark>} mark"
|
||||
:: fire the +form:grad arm, which should produce a mark
|
||||
::
|
||||
=/ form-build=^build
|
||||
[date.build [%ride [%limb %form] [%$ %noun grad-vase]]]
|
||||
::
|
||||
=^ form-result accessed-builds (depend-on form-build)
|
||||
?~ form-result
|
||||
[build [%blocks [form-build]~ ~] accessed-builds]
|
||||
::
|
||||
?. ?=([~ %success %ride *] form-result)
|
||||
(wrap-error form-result)
|
||||
::
|
||||
=/ form-mark=(unit term) ((soft @tas) q.vase.u.form-result)
|
||||
?~ form-mark
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %join failed: %{<mark>} mark invalid +form:grad"
|
||||
:: the mark produced by +form:grad should match both diffs
|
||||
::
|
||||
?. &(=(u.form-mark p.first-cage) =(u.form-mark p.second-cage))
|
||||
%- return-error :_ ~ :- %leaf
|
||||
"ford: %join failed: mark mismatch"
|
||||
:: if the diffs are identical, just produce the first
|
||||
::
|
||||
?: =(q.q.first-cage q.q.second-cage)
|
||||
[build [%build-result %success %join first-cage] accessed-builds]
|
||||
:: call the +join:grad gate on the two diffs
|
||||
::
|
||||
=/ diff-build=^build
|
||||
:- date.build
|
||||
:+ %call
|
||||
:+ %ride
|
||||
[%limb %join]
|
||||
[%$ %noun grad-vase]
|
||||
[%$ %noun (slop q.first-cage q.second-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)
|
||||
:: the result was a unit; if `~`, use %null mark; otherwise grab tail
|
||||
::
|
||||
=/ =build-result
|
||||
:+ %success %join
|
||||
?@ q.vase.u.diff-result
|
||||
[%null vase.u.diff-result]
|
||||
[u.form-mark (slot 3 vase.u.diff-result)]
|
||||
::
|
||||
[build [%build-result build-result] accessed-builds]
|
||||
::
|
||||
++ make-mute
|
||||
|= [subject=schematic mutations=(list [=wing =schematic])]
|
||||
^- build-receipt
|
||||
|
||||
Loading…
Reference in New Issue
Block a user