mirror of
https://github.com/urbit/shrub.git
synced 2024-12-24 03:14:30 +03:00
Merge branch 'philip/core-gol' (#1928)
* philip/core-gol: hoon: extend gol check through cores Signed-off-by: Jared Tobin <jared@tlon.io>
This commit is contained in:
Jared Tobin
commit
a480e3aafd
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:ccb3dc7661a01ab606806bc2d2bf8dfca349ad37ac49432937336431f20b5880
|
||||
size 8935337
|
||||
oid sha256:9e6a332c3f22b3448284437ab597a2f0a76649a2c380a558f16eb788769e25c0
|
||||
size 8958901
|
||||
|
||||
@ -10013,13 +10013,13 @@
|
||||
++ hemp
|
||||
:: generate formula from foot
|
||||
::
|
||||
|= [hud/poly gen/hoon]
|
||||
|= [hud/poly gol/type gen/hoon]
|
||||
^- nock
|
||||
~+
|
||||
=+ %hemp-141
|
||||
?- hud
|
||||
$dry q:(mint %noun gen)
|
||||
$wet q:(mint(vet |) %noun gen)
|
||||
$dry q:(mint gol gen)
|
||||
$wet q:(mint(vet |) gol gen)
|
||||
==
|
||||
::
|
||||
++ laze
|
||||
@ -10043,7 +10043,7 @@
|
||||
^- (unit noun)
|
||||
%+ bind (~(get by tal) axe)
|
||||
|= gen/hoon
|
||||
%. [hud gen]
|
||||
%. [hud %noun gen]
|
||||
hemp(sut (core sut [nym hud %gold] sut [[%lazy 1 ..^$] ~] dom))
|
||||
::
|
||||
%- ~(gas by *(map @ud hoon))
|
||||
@ -10167,8 +10167,11 @@
|
||||
++ mine
|
||||
:: mint all chapters and feet in a core
|
||||
::
|
||||
|= [mel/vair nym/(unit term) hud/poly dom/(map term tome)]
|
||||
|= [gol/type mel/vair nym/(unit term) hud/poly dom/(map term tome)]
|
||||
^- (pair type nock)
|
||||
|^
|
||||
=/ log (chapters-check (core-check gol))
|
||||
=/ dog (get-tomes log)
|
||||
=- :_ [%1 dez]
|
||||
(core sut [nym hud mel] sut [[%full ~] dez] dom)
|
||||
^= dez
|
||||
@ -10178,10 +10181,12 @@
|
||||
~
|
||||
=/ dov/?(~ ^)
|
||||
=/ dab/(map term hoon) q.q.n.dom
|
||||
=/ dag (arms-check dab (get-arms dog p.n.dom))
|
||||
|- ^- ?(~ ^)
|
||||
?: ?=(~ dab)
|
||||
~
|
||||
=+ vad=(hemp hud q.n.dab)
|
||||
=/ gog (get-arm-type log dag p.n.dab)
|
||||
=+ vad=(hemp hud gog q.n.dab)
|
||||
?- dab
|
||||
{* ~ ~} vad
|
||||
{* ~ *} [vad $(dab r.dab)]
|
||||
@ -10194,6 +10199,119 @@
|
||||
{* * ~} [dov $(dom l.dom)]
|
||||
{* * *} [dov $(dom l.dom) $(dom r.dom)]
|
||||
==
|
||||
::
|
||||
:: all the below arms are used for gol checking and should have no
|
||||
:: effect other than giving more specific errors
|
||||
::
|
||||
:: all the possible types we could be expecting.
|
||||
::
|
||||
+$ gol-type
|
||||
$~ %noun
|
||||
$@ %noun
|
||||
$% [%cell p=type q=type]
|
||||
[%core p=type q=coil]
|
||||
[%fork p=(set gol-type)]
|
||||
==
|
||||
:: check that we're looking for a core
|
||||
::
|
||||
++ core-check
|
||||
|= log=type
|
||||
|- ^- gol-type
|
||||
?+ log $(log repo(sut log))
|
||||
%noun (nice log &)
|
||||
%void (nice %noun |)
|
||||
[%atom *] (nice %noun |)
|
||||
[%cell *] (nice log (nest(sut p.log) & %noun))
|
||||
[%core *] (nice log(r.p.q %gold) &)
|
||||
[%fork *]
|
||||
=/ tys ~(tap in p.log)
|
||||
:- %fork
|
||||
|- ^- (set gol-type)
|
||||
?~ tys
|
||||
~
|
||||
=/ a ^$(log i.tys)
|
||||
=/ b $(tys t.tys)
|
||||
(~(put in b) a)
|
||||
==
|
||||
:: check we have the expected number of chapters
|
||||
::
|
||||
++ chapters-check
|
||||
|= log=gol-type
|
||||
|- ^- gol-type
|
||||
?- log
|
||||
%noun (nice log &)
|
||||
[%cell *] (nice log &)
|
||||
[%core *] ~_ leaf+"core-number-of-chapters"
|
||||
(nice log =(~(wyt by dom) ~(wyt by q.r.q.log)))
|
||||
[%fork *]
|
||||
=/ tys ~(tap in p.log)
|
||||
|- ^- gol-type
|
||||
?~ tys
|
||||
log
|
||||
=/ a ^$(log i.tys)
|
||||
=/ b $(tys t.tys)
|
||||
log
|
||||
==
|
||||
:: get map of tomes if exists
|
||||
::
|
||||
++ get-tomes
|
||||
|= log=gol-type
|
||||
^- (unit (map term tome))
|
||||
?- log
|
||||
%noun ~
|
||||
[%cell *] ~
|
||||
[%fork *] ~ :: maybe could be more aggressive
|
||||
[%core *] `q.r.q.log
|
||||
==
|
||||
:: get arms in tome
|
||||
::
|
||||
++ get-arms
|
||||
|= [dog=(unit (map term tome)) nam=term]
|
||||
^- (unit (map term hoon))
|
||||
%+ bind dog
|
||||
|= a/(map term tome)
|
||||
~_ leaf+"unexpcted-chapter.{(trip nam)}"
|
||||
q:(~(got by a) nam)
|
||||
:: check we have the expected number of arms
|
||||
::
|
||||
++ arms-check
|
||||
|= [dab=(map term hoon) dag=(unit (map term hoon))]
|
||||
?~ dag
|
||||
dag
|
||||
=/ a
|
||||
=/ exp ~(wyt by u.dag)
|
||||
=/ hav ~(wyt by dab)
|
||||
~_ =/ expt (scow %ud exp)
|
||||
=/ havt (scow %ud hav)
|
||||
leaf+"core-number-of-arms.exp={expt}.hav={havt}"
|
||||
~_ =/ missing ~(tap in (~(dif in ~(key by u.dag)) ~(key by dab)))
|
||||
leaf+"missing.{<missing>}"
|
||||
~_ =/ extra ~(tap in (~(dif in ~(key by dab)) ~(key by u.dag)))
|
||||
leaf+"extra.{<extra>}"
|
||||
~_ =/ have ~(tap in ~(key by dab))
|
||||
leaf+"have.{<have>}"
|
||||
(nice dag =(exp hav))
|
||||
a
|
||||
:: get expected type of this arm
|
||||
::
|
||||
++ get-arm-type
|
||||
|= [log=gol-type dag=(unit (map term hoon)) nam=term]
|
||||
^- type
|
||||
%- fall :_ %noun
|
||||
%+ bind dag
|
||||
|= a=(map term hoon)
|
||||
=/ gen=hoon
|
||||
~_ leaf+"unexpected-arm.{(trip nam)}"
|
||||
(~(got by a) nam)
|
||||
(play(sut log) gen)
|
||||
::
|
||||
++ nice
|
||||
|* [typ=* gud=?]
|
||||
?: gud
|
||||
typ
|
||||
~_ leaf+"core-nice"
|
||||
!!
|
||||
--
|
||||
::
|
||||
++ mint
|
||||
~/ %mint
|
||||
@ -10342,7 +10460,7 @@
|
||||
|= {mel/vair nym/(unit term) hud/poly ruf/hoon dom/(map term tome)}
|
||||
^- {p/type q/nock}
|
||||
=+ dan=^$(gen ruf, gol %noun)
|
||||
=+ pul=(mine mel nym hud dom)
|
||||
=+ pul=(mine gol mel nym hud dom)
|
||||
[(nice p.pul) (cons q.pul q.dan)]
|
||||
--
|
||||
::
|
||||
|
||||
Loading…
Reference in New Issue
Block a user