diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 1e999aaa1..64b0ac3f8 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -98,6 +98,13 @@ [%| p=axis q=(list ,[p=type q=foot])] :: == :: == :: +++ post $: p=axis :: + $= q :: + $% [0 p=type] :: + [1 p=axis q=(list ,[p=type q=foot])] :: + [2 p=twin q=type] :: + == :: + == :: ++ prop $: p=axis :: $= q :: [p=?(~ axis) q=(list ,[p=type q=foot])] :: @@ -247,7 +254,6 @@ [%wtbr p=tusk] :: [%wthp p=twig q=tine] :: [%wtcl p=twig q=twig r=twig] :: - [%wtcn p=twig q=twig] :: [%wtdt p=twig q=twig r=twig] :: [%wtkt p=twig q=twig r=twig] :: [%wtgl p=twig q=twig] :: @@ -3728,6 +3734,15 @@ | (roll q.q.pok =+([p=[p=*type q=*foot] q=`type`%void] |.((fork p.p q)))) == :: +++ flee + |= poy=post + ^- port + ?- -.q.poy + 0 [p.poy %& p.q.poy] + 1 [p.poy %| p.q.poy q.q.poy] + 2 [(peg p.poy q.p.q.poy) %& r.p.q.poy] + == +:: ++ foil ~/ %foil |= pok=port @@ -4711,7 +4726,6 @@ [%wtgl *] [%wtcl p.gen [%zpzp ~] q.gen] [%wtgr *] [%wtcl p.gen q.gen [%zpzp ~]] [%wtkt *] [%wtcl [%wtts [%axil %atom %$] p.gen] r.gen q.gen] - [%wtts *] [%wtcn ~(bunt al p.gen) q.gen] [%wthp *] |- ?@ q.gen @@ -4768,7 +4782,6 @@ %duck duck %dune dune %dunk dunk - %find find %fink fink %fire fire %firm firm @@ -4902,6 +4915,54 @@ == -- :: + ++ cool + |= [pol=? hyp=wing ref=type] + ^- type + =+ peh=`wing`(flop hyp) + |- ^- type + ?~ peh + ?:(pol (fuse ref) (crop ref)) + => .(i.peh ?^(i.peh i.peh [%| p=0 q=i.peh])) + =+ ^= poz ^- post + ?- -.i.peh + & [p.i.peh %& (peek %both p.i.peh)] + | (finq p.i.peh %both q.i.peh) + == + |- ^- type + ?: =(1 p.poz) + ?- -.q.poz + 0 ?- -.i.peh + & ^$(peh t.peh) + | (face q.i.peh ^$(peh t.peh, sut p.q.poz)) + == + 1 ^$(peh t.peh) + 2 (bull [p.p.q.poz q.p.q.poz ^$(peh t.peh, sut r.p.q.poz)] q.q.poz) + == + =+ [now=(cap p.poz) lat=(mas p.poz)] + =+ vil=*(set type) + |- ^- type + ?- sut + [%atom *] %void + [%bull *] (reco |=(p=type ^$(sut p))) + [%cell *] + ?: =(2 now) + (cell ^$(p.poz lat, sut p.sut) q.sut) + (cell p.sut ^$(p.poz lat, sut q.sut)) + :: + [%core *] ?.(=(3 now) sut (core ^$(p.poz lat, sut p.sut) q.sut)) + [%cube *] (reco |=(p=type ^$(sut p))) + [%face *] (reco |=(p=type (face p.sut ^$(sut p)))) + [%fork *] + ?: (~(has in vil) sut) + %void + => .(vil (~(put in vil) sut)) + (fork $(sut p.sut) $(sut q.sut)) + :: + [%hold *] (reco |=(p=type ^$(sut p))) + %noun (reco |=(p=type ^$(sut p))) + %void %void + == + :: ++ cull ~/ %cull |= [pol=? axe=axis ref=type] @@ -5319,18 +5380,17 @@ [['.' ~] ['-' ~] ~ ~] [[%leaf (mesc (trip paz))] duck ~] :: - ++ find - ~/ %find + ++ fino |= [dep=@ud way=?(%read %rite %both) cog=term] =+ gil=*(set type) - |- ^- [p=@ud q=(unit port)] + |- ^- [p=@ud q=(unit post)] ?+ sut [dep ~] [%bull *] ?. =(cog p.p.sut) [dep ~] ?. ?=(0 dep) [(dec dep) ~] - [0 ~ q.p.sut %& r.p.sut] + [0 ~ 1 %2 p.sut q.sut] :: [%cell *] =+ taf=$(sut p.sut) @@ -5345,7 +5405,7 @@ =+ zem=(look cog q.r.q.sut) => ^+(. ?:(|(=(~ zem) =(0 dep)) . .(dep (dec dep), zem ~))) ?^ zem - [dep ~ 1 [%| (peg 2 p.u.zem) [[sut(p.q %gold) q.u.zem] ~]]] + [dep ~ 1 [%1 (peg 2 p.u.zem) [[sut(p.q %gold) q.u.zem] ~]]] =+ taf=$(sut p.sut) ?~ q.taf taf @@ -5360,7 +5420,7 @@ ?: =(cog p.sut) ?. ?=(0 dep) [(dec dep) ~] - [0 ~ 1 %& q.sut] + [0 ~ 1 %0 q.sut] [dep ~] :: [%fork *] @@ -5373,32 +5433,23 @@ ~| %find-fork ?: =(hax yor) hax - ?~ q.hax - ?~ q.yor - ?>(=(hax yor) hax) - ?> =(0 p.hax) - :: ?>((nest(sut %void) | (peek(sut p.sut) way p.u.q.yor)) yor) - !! - ?~ q.yor - ?> =(0 p.yor) - :: ?>((nest(sut %void) | (peek(sut q.sut) way p.u.q.hax)) hax) - !! - ?> =(p.u.q.hax p.u.q.yor) - :- 0 - ?- -.q.u.q.hax - & - ?- -.q.u.q.yor - & [~ p.u.q.hax %& (fork p.q.u.q.hax p.q.u.q.yor)] - | !! - == - :: - | - ?- -.q.u.q.yor - & !! - | - ?> =(p.q.u.q.yor p.q.u.q.hax) - [~ p.u.q.hax %| p.q.u.q.hax (weld q.q.u.q.hax q.q.u.q.yor)] - == + ?> &(?=(^ q.hax) ?=(^ q.yor) =(p.hax p.yor) =(p.u.q.hax p.u.q.yor)) + :- p.hax + ?- -.q.u.q.hax + 0 ?> ?=(0 -.q.u.q.yor) + [~ p.u.q.hax %0 (fork p.q.u.q.hax p.q.u.q.yor)] + 1 ?> &(?=(1 -.q.u.q.yor) =(p.q.u.q.yor p.q.u.q.hax)) + [~ p.u.q.hax %1 p.q.u.q.hax (weld q.q.u.q.hax q.q.u.q.yor)] + 2 ?> ?& ?=(2 -.q.u.q.yor) + =(p.p.q.u.q.hax p.p.q.u.q.yor) + =(q.p.q.u.q.hax q.p.q.u.q.yor) + == + :* ~ + p.u.q.hax + %2 + [p.p.q.u.q.hax q.p.q.u.q.hax (fork r.p.q.u.q.hax r.p.q.u.q.yor)] + (fork q.q.u.q.hax q.q.u.q.yor) + == == :: [%hold *] @@ -5413,7 +5464,18 @@ ^- port :: ~! (dunk 'type') ~! (show [%c 'find-limb'] ?:(=(%$ cog) '$' [%a cog])) - =+ hoq=(find dep way cog) + =+ hoq=(fino dep way cog) + ?~ q.hoq + ~|(%find-none !!) + (flee u.q.hoq) + :: + ++ finq + ~/ %fink + |= [dep=@ud way=?(%read %rite %both) cog=term] + ^- post + :: ~! (dunk 'type') + ~! (show [%c 'find-limb'] ?:(=(%$ cog) '$' [%a cog])) + =+ hoq=(fino dep way cog) ?~ q.hoq ~|(%find-none !!) u.q.hoq @@ -5603,14 +5665,12 @@ ++ chip ~/ %chip |= [way=? gen=twig] ^- type - ?: ?=([%wtcn *] gen) - (cull way p:(seek %read ~(rake ap q.gen)) (play p.gen)) ?: ?=([%wtts *] gen) - (cull way p:(seek %read ~(rake ap q.gen)) (play ~(bunt al p.gen))) + (cool way ~(rake ap q.gen) (play ~(bunt al p.gen))) ?: ?&(way ?=([%wtpm *] gen)) - |-(?@(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) + |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) ?: ?&(!way ?=([%wtbr *] gen)) - |-(?@(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) + |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) =+ neg=~(open ap gen) ?:(=(neg gen) sut $(gen neg)) :: @@ -5736,9 +5796,6 @@ =+ hiq=$(sut fex, gen q.gen) =+ ran=$(sut wux, gen r.gen) [(fork p.hiq p.ran) (cond duy q.hiq q.ran)] - :: - [%wtcn *] - [(nice bean) (fish(sut (play p.gen)) (cove q:$(gen q.gen, gol %noun)))] :: [%wtts *] :- (nice bean) @@ -5897,15 +5954,6 @@ ~|(%mull-bonk-c !!) $(sut p.wux, dox q.wux, gen r.gen) [(nice (fork p.hiq p.ran)) (fork q.hiq q.ran)] - :: - [%wtcn *] - =+ waz=[p=(play p.gen) q=(play(sut dox) p.gen)] - =+ ^= syx :- p=(cove q:(mint %noun q.gen)) - q=(cove q:(mint(sut dox) %noun q.gen)) - =+ pov=[p=(fish(sut p.waz) p.syx) q=(fish(sut q.waz) q.syx)] - ?. &(=(p.syx q.syx) =(p.pov q.pov)) - ~|(%mull-bonk-a !!) - (both bean) :: [%wtts *] =+ nob=~(bunt al p.gen) @@ -6222,7 +6270,6 @@ %+ fork ?:(=(%void fex) %void $(sut fex, gen q.gen)) ?:(=(%void wux) %void $(sut wux, gen r.gen)) - [%wtcn *] bean [%wtts *] bean [%zpcb *] ~!((show %o p.gen) $(gen q.gen)) [%zpcm *] (play p.gen) @@ -6313,7 +6360,7 @@ |= [peh=wing mur=type] =+ axe=1 |- ^- [p=axis q=type] - ?@ peh + ?~ peh [axe mur] => .(i.peh ?^(i.peh i.peh [%| p=0 q=i.peh])) ?- i.peh