ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-15 01:52:42 +03:00
Code Issues Packages Projects Releases Wiki Activity

New model bull.

Browse Source
This commit is contained in:
C. Guy Yarvin 2013-12-31 11:30:37 -08:00
parent eafadbd9b5
commit 9f2f953637
1 changed files with 102 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

151
arvo/hoon.hoon
View File

@ -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,31 +5433,22 @@
~| %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.hax) ?=(^ q.yor) =(p.hax p.yor) =(p.u.q.hax p.u.q.yor))
:- p.hax
?- -.q.u.q.hax
&
?- -.q.u.q.yor
& [~ p.u.q.hax %& (fork p.q.u.q.hax p.q.u.q.yor)]
| !!
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)
==
::
|
?- -.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)]
:* ~
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)
==
==
::
@ -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