New model bull.

This commit is contained in:
C. Guy Yarvin 2013-12-31 11:30:37 -08:00
parent eafadbd9b5
commit 9f2f953637

View File

@ -98,6 +98,13 @@
[%| p=axis q=(list ,[p=type q=foot])] :: [%| 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 :: ++ prop $: p=axis ::
$= q :: $= q ::
[p=?(~ axis) q=(list ,[p=type q=foot])] :: [p=?(~ axis) q=(list ,[p=type q=foot])] ::
@ -247,7 +254,6 @@
[%wtbr p=tusk] :: [%wtbr p=tusk] ::
[%wthp p=twig q=tine] :: [%wthp p=twig q=tine] ::
[%wtcl p=twig q=twig r=twig] :: [%wtcl p=twig q=twig r=twig] ::
[%wtcn p=twig q=twig] ::
[%wtdt p=twig q=twig r=twig] :: [%wtdt p=twig q=twig r=twig] ::
[%wtkt p=twig q=twig r=twig] :: [%wtkt p=twig q=twig r=twig] ::
[%wtgl p=twig q=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)))) | (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
~/ %foil ~/ %foil
|= pok=port |= pok=port
@ -4711,7 +4726,6 @@
[%wtgl *] [%wtcl p.gen [%zpzp ~] q.gen] [%wtgl *] [%wtcl p.gen [%zpzp ~] q.gen]
[%wtgr *] [%wtcl p.gen q.gen [%zpzp ~]] [%wtgr *] [%wtcl p.gen q.gen [%zpzp ~]]
[%wtkt *] [%wtcl [%wtts [%axil %atom %$] p.gen] r.gen q.gen] [%wtkt *] [%wtcl [%wtts [%axil %atom %$] p.gen] r.gen q.gen]
[%wtts *] [%wtcn ~(bunt al p.gen) q.gen]
[%wthp *] [%wthp *]
|- |-
?@ q.gen ?@ q.gen
@ -4768,7 +4782,6 @@
%duck duck %duck duck
%dune dune %dune dune
%dunk dunk %dunk dunk
%find find
%fink fink %fink fink
%fire fire %fire fire
%firm firm %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
~/ %cull ~/ %cull
|= [pol=? axe=axis ref=type] |= [pol=? axe=axis ref=type]
@ -5319,18 +5380,17 @@
[['.' ~] ['-' ~] ~ ~] [['.' ~] ['-' ~] ~ ~]
[[%leaf (mesc (trip paz))] duck ~] [[%leaf (mesc (trip paz))] duck ~]
:: ::
++ find ++ fino
~/ %find
|= [dep=@ud way=?(%read %rite %both) cog=term] |= [dep=@ud way=?(%read %rite %both) cog=term]
=+ gil=*(set type) =+ gil=*(set type)
|- ^- [p=@ud q=(unit port)] |- ^- [p=@ud q=(unit post)]
?+ sut [dep ~] ?+ sut [dep ~]
[%bull *] [%bull *]
?. =(cog p.p.sut) ?. =(cog p.p.sut)
[dep ~] [dep ~]
?. ?=(0 dep) ?. ?=(0 dep)
[(dec dep) ~] [(dec dep) ~]
[0 ~ q.p.sut %& r.p.sut] [0 ~ 1 %2 p.sut q.sut]
:: ::
[%cell *] [%cell *]
=+ taf=$(sut p.sut) =+ taf=$(sut p.sut)
@ -5345,7 +5405,7 @@
=+ zem=(look cog q.r.q.sut) =+ zem=(look cog q.r.q.sut)
=> ^+(. ?:(|(=(~ zem) =(0 dep)) . .(dep (dec dep), zem ~))) => ^+(. ?:(|(=(~ zem) =(0 dep)) . .(dep (dec dep), zem ~)))
?^ 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) =+ taf=$(sut p.sut)
?~ q.taf ?~ q.taf
taf taf
@ -5360,7 +5420,7 @@
?: =(cog p.sut) ?: =(cog p.sut)
?. ?=(0 dep) ?. ?=(0 dep)
[(dec dep) ~] [(dec dep) ~]
[0 ~ 1 %& q.sut] [0 ~ 1 %0 q.sut]
[dep ~] [dep ~]
:: ::
[%fork *] [%fork *]
@ -5373,32 +5433,23 @@
~| %find-fork ~| %find-fork
?: =(hax yor) ?: =(hax yor)
hax hax
?~ q.hax ?> &(?=(^ q.hax) ?=(^ q.yor) =(p.hax p.yor) =(p.u.q.hax p.u.q.yor))
?~ q.yor :- p.hax
?>(=(hax yor) hax) ?- -.q.u.q.hax
?> =(0 p.hax) 0 ?> ?=(0 -.q.u.q.yor)
:: ?>((nest(sut %void) | (peek(sut p.sut) way p.u.q.yor)) 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))
?~ q.yor [~ p.u.q.hax %1 p.q.u.q.hax (weld q.q.u.q.hax q.q.u.q.yor)]
?> =(0 p.yor) 2 ?> ?& ?=(2 -.q.u.q.yor)
:: ?>((nest(sut %void) | (peek(sut q.sut) way p.u.q.hax)) hax) =(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 p.u.q.yor) ==
:- 0 :* ~
?- -.q.u.q.hax p.u.q.hax
& %2
?- -.q.u.q.yor [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)]
& [~ p.u.q.hax %& (fork p.q.u.q.hax p.q.u.q.yor)] (fork q.q.u.q.hax q.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)]
==
== ==
:: ::
[%hold *] [%hold *]
@ -5413,7 +5464,18 @@
^- port ^- port
:: ~! (dunk 'type') :: ~! (dunk 'type')
~! (show [%c 'find-limb'] ?:(=(%$ cog) '$' [%a cog])) ~! (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 ?~ q.hoq
~|(%find-none !!) ~|(%find-none !!)
u.q.hoq u.q.hoq
@ -5603,14 +5665,12 @@
++ chip ++ chip
~/ %chip ~/ %chip
|= [way=? gen=twig] ^- type |= [way=? gen=twig] ^- type
?: ?=([%wtcn *] gen)
(cull way p:(seek %read ~(rake ap q.gen)) (play p.gen))
?: ?=([%wtts *] 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)) ?: ?&(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)) ?: ?&(!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=~(open ap gen)
?:(=(neg gen) sut $(gen neg)) ?:(=(neg gen) sut $(gen neg))
:: ::
@ -5736,9 +5796,6 @@
=+ hiq=$(sut fex, gen q.gen) =+ hiq=$(sut fex, gen q.gen)
=+ ran=$(sut wux, gen r.gen) =+ ran=$(sut wux, gen r.gen)
[(fork p.hiq p.ran) (cond duy q.hiq q.ran)] [(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 *] [%wtts *]
:- (nice bean) :- (nice bean)
@ -5897,15 +5954,6 @@
~|(%mull-bonk-c !!) ~|(%mull-bonk-c !!)
$(sut p.wux, dox q.wux, gen r.gen) $(sut p.wux, dox q.wux, gen r.gen)
[(nice (fork p.hiq p.ran)) (fork q.hiq q.ran)] [(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 *] [%wtts *]
=+ nob=~(bunt al p.gen) =+ nob=~(bunt al p.gen)
@ -6222,7 +6270,6 @@
%+ fork %+ fork
?:(=(%void fex) %void $(sut fex, gen q.gen)) ?:(=(%void fex) %void $(sut fex, gen q.gen))
?:(=(%void wux) %void $(sut wux, gen r.gen)) ?:(=(%void wux) %void $(sut wux, gen r.gen))
[%wtcn *] bean
[%wtts *] bean [%wtts *] bean
[%zpcb *] ~!((show %o p.gen) $(gen q.gen)) [%zpcb *] ~!((show %o p.gen) $(gen q.gen))
[%zpcm *] (play p.gen) [%zpcm *] (play p.gen)
@ -6313,7 +6360,7 @@
|= [peh=wing mur=type] |= [peh=wing mur=type]
=+ axe=1 =+ axe=1
|- ^- [p=axis q=type] |- ^- [p=axis q=type]
?@ peh ?~ peh
[axe mur] [axe mur]
=> .(i.peh ?^(i.peh i.peh [%| p=0 q=i.peh])) => .(i.peh ?^(i.peh i.peh [%| p=0 q=i.peh]))
?- i.peh ?- i.peh