ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2025-01-04 13:19:48 +03:00
Code Issues Packages Projects Releases Wiki Activity

Adjust construct recursion logic.

Browse Source
This commit is contained in:
C. Guy Yarvin 2018-02-03 20:04:56 -08:00
parent cba2dfc8d0
commit 423f2bf00f
1 changed files with 50 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
sys/hoon.hoon
View File

@ -6917,19 +6917,20 @@
:: ::
fin fin
:: ::
++ probe ++ construct
:: probe for tuple :: local constructor
:: ::
|= $: :: tow: tuple width we need :: ~& [%construct axe mod]
:: any: default if probe fails ~+
:: ^- hoon
tow/@ud :: tow: width of ideal tuple
any/crib
==
:: yad: topographic map of correct tuple width
:: ::
=/ yad/tope =/ tow/@ud
|-(?:(=(1 tow) & [& $(tow (dec tow))])) ?+ mod 1
{^ *} 2
{$kelp *} 2
{$vine *} 2
==
:: joy: tuple test (~ fails, [~ ~] succeeds, [~ ~ ~] needs test) :: joy: tuple test (~ fails, [~ ~] succeeds, [~ ~ ~] needs test)
:: ::
=/ joy =/ joy
@ -6938,66 +6939,54 @@
?: =(| top) ~ ?: =(| top) ~
?: =(& top) [~ ~ ~] ?: =(& top) [~ ~ ~]
$(top +.top, tow (dec tow)) $(top +.top, tow (dec tow))
:: boc: construct against full tuple :: boc: construction given ideal subject
:: ::
=/ boc/hoon construct(top yad) =; boc
?: =([~ ~] joy) ?: =([~ ~] joy)
:: no test needed :: width is already ideal
::
boc
:: mac: matching crib
:: ::
boc =/ mac
:: mac: matching crib |- ^- crib
:: ?: =(2 tow)
=/ mac [%axil %cell]
|- ^- crib [[%axil %noun] $(tow (dec tow))]
?: =(2 tow) :: yum: matching hoon
[%axil %cell]
[[%axil %noun] $(tow (dec tow))]
:: yum: matching hoon
::
=/ yum
|- ^- hoon
?: =(2 tow)
[%base %cell]
[[%base %noun] $(tow (dec tow))]
:: luz: subject edited to inject default
::
=/ luz/hoon
:+ %cnts
[[%& 1] ~]
:_ ~
:: correct but slow
:: [fetch-wing ersatz:clear(mod any)]
[fetch-wing ersatz:clear(mod ?~(def mac u.def))]
?: =(~ joy)
:: unconditional build
:: ::
[%tsgr luz boc] =/ yum
:: conditional build |- ^- hoon
?: =(2 tow)
[%base %cell]
[[%base %noun] $(tow (dec tow))]
:: luz: subject edited to inject default
::
=/ luz/hoon
:+ %cnts
[[%& 1] ~]
:_ ~
:: correct but slow
:: [fetch-wing ersatz:clear(mod any)]
[fetch-wing ersatz:clear(mod ?~(def mac u.def))]
?: =(~ joy)
:: unconditional build
::
[%tsgr luz boc]
:: conditional build
::
[%tsgr [%wtcl [%wtts yum fetch-wing] [%$ 1] luz] boc]
:: idealize topography (should be a smarter merge)
:: ::
[%tsgr [%wtcl [%wtts yum fetch-wing] [%$ 1] luz] boc] =. top ?:(=(1 tow) top |-(?:(=(1 tow) & [& $(tow (dec tow))])))
::
++ construct
:: local constructor
::
:: ~& [%construct axe mod]
~+
^- hoon
?- mod ?- mod
:: ::
:: cell :: cell
:: ::
{^ *} {^ *}
:: apply help
::
%- decorate %- decorate
:: probe unless we know the sample is a cell :- construct:clear(mod -.mod, top -.top, axe (peg axe 2))
:: construct:clear(mod +.mod, top +.top, axe (peg axe 3))
?@ top
(probe 2 dummy)
:: if known cell, descend directly
::
:- construct:clear(mod -.mod, top p.top, axe (peg axe 2))
construct:clear(mod +.mod, top q.top, axe (peg axe 3))
:: ::
:: base :: base
:: ::
@ -7036,12 +7025,6 @@
:: switch, $% :: switch, $%
:: ::
{$kelp *} {$kelp *}
:: if atom or unknown, probe
::
?@ top
(probe 2 dummy)
:: if cell, enter switch directly
::
(switch i.p.mod t.p.mod) (switch i.p.mod t.p.mod)
:: ::
:: constant :: constant
@ -7080,8 +7063,6 @@
:: ::
{$vine *} {$vine *}
%- decorate %- decorate
?@ top
(probe 2 dummy)
:^ %wtpt :^ %wtpt
fetch-wing(axe (peg axe 2)) fetch-wing(axe (peg axe 2))
construct:clear(top [%| %&], mod q.mod) construct:clear(top [%| %&], mod q.mod)