%bunt schematic

This commit is contained in:
Ted Blackman 2018-05-18 13:59:00 -07:00
parent ef87e14f33
commit af21824b4f
2 changed files with 96 additions and 1 deletions

View File

@ -90,6 +90,7 @@
test-core-fssm
test-core-fsbr
test-core-fsbr-out-of-options
test-bunt
==
++ test-tear
~& %test-tear
@ -4387,6 +4388,65 @@
(expect-ford-empty ford ~nul)
==
::
++ test-bunt
~& %test-bunt
::
=/ ford *ford-gate
::
=/ hoon-src=@ta
'''
|_ cell=^
++ grab
|%
++ noun ^
--
--
'''
=/ scry-results=(map [term beam] cage)
%- my :~
:- [%cx [[~nul %home %da ~1234.5.6] /hoon/foo/mar]]
[%hoon !>(hoon-src)]
==
::
=^ results1 ford
%- test-ford-call-with-comparator :*
ford
now=~1234.5.6
scry=(scry-with-results scry-results)
::
^= call-args
:* duct=~[/path] type=~ %make ~nul
%pin ~1234.5.6
[%bunt [~nul %home] %foo]
==
::
^= 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 %bunt *] build-result.pin-result)
::
=/ =vase q.cage.build-result.pin-result
::
%+ weld
%- expect-eq !>
:- [0 0]
q.vase
::
%- expect-eq !>
:- &
(~(nest ut p.vase) | -:!>(*^))
==
::
;: weld
results1
(expect-ford-empty ford ~nul)
==
::
:: |utilities: helper arms
::
::+| utilities

View File

@ -2679,7 +2679,7 @@
%pin (make-pin date schematic)
%alts (make-alts choices)
%bake !!
%bunt !!
%bunt (make-bunt disc mark)
%call (make-call gate sample)
%cast !!
%core (make-core source-path)
@ -2767,6 +2767,41 @@
::
[build [%build-result %success %alts u.result] accessed-builds]
::
++ make-bunt
|= [=disc mark=term]
^- build-receipt
:: resolve path of the mark definition file
::
=/ path-build=^build [date.build [%path disc %mar mark]]
::
=^ path-result accessed-builds (depend-on path-build)
?~ path-result
[build [%blocks [path-build]~ ~] accessed-builds]
::
?. ?=([~ %success %path *] path-result)
(wrap-error path-result)
:: build the mark core from source
::
=/ core-build=^build [date.build [%core rail.u.path-result]]
::
=^ core-result accessed-builds (depend-on core-build)
?~ core-result
[build [%blocks [core-build]~ ~] accessed-builds]
::
?. ?=([~ %success %core *] core-result)
(wrap-error core-result)
:: extract the sample from the mark core
::
=/ mark-vase=vase vase.u.core-result
~| %mark-vase
=+ [sample-type=p sample-value=q]:(slot 6 mark-vase)
:: if sample is wrapped in a face, unwrap it
::
=? sample-type ?=(%face -.sample-type) q.sample-type
::
=/ =cage [mark sample-type sample-value]
[build [%build-result %success %bunt cage] accessed-builds]
::
++ make-call
|= [gate=schematic sample=schematic]
^- build-receipt