Introduced %frog, but not using it or jetted yet.

This commit is contained in:
C. Guy Yarvin 2016-01-10 13:48:22 -08:00
parent effe5f08b1
commit 9e5cb0c7d6
2 changed files with 69 additions and 17 deletions

View File

@ -516,6 +516,7 @@
{$cube * _$} {$cube * _$}
{$face tusk _$} {$face tusk _$}
{$fork _$ _$} {$fork _$ _$}
{$frog (list _$)}
{$hold (list {_$ twig})} {$hold (list {_$ twig})}
== ==
wain :: "<|core|>" wain :: "<|core|>"
@ -524,6 +525,7 @@
?+ a a ?+ a a
{$?($cube $face) ^} a(q $(a q.a)) {$?($cube $face) ^} a(q $(a q.a))
{$?($cell $fork) ^} a(p $(a p.a), q $(a q.a)) {$?($cell $fork) ^} a(p $(a p.a), q $(a q.a))
{$frog *} a(p (turn p.a |=(b/span ^$(a b))))
{$core ^} `wain`/core {$core ^} `wain`/core
{$hold *} a(p (turn p.a |=({b/span c/twig} [^$(a b) c]))) {$hold *} a(p (turn p.a |=({b/span c/twig} [^$(a b) c])))
== ==

View File

@ -341,6 +341,7 @@
{$cell p/span q/span} :: ordered pair {$cell p/span q/span} :: ordered pair
{$core p/span q/coil} :: object {$core p/span q/coil} :: object
{$face p/tusk q/span} :: namespace {$face p/tusk q/span} :: namespace
{$frog p/(list span)} :: new union
{$fork p/span q/span} :: union {$fork p/span q/span} :: union
{$hold p/(list {p/span q/twig})} :: lazy evaluation {$hold p/(list {p/span q/twig})} :: lazy evaluation
== :: == ::
@ -362,7 +363,6 @@
q/(set term) :: blocks q/(set term) :: blocks
r/(list (pair term twig)) :: bridges r/(list (pair term twig)) :: bridges
== :: == ::
++ twin {p/term q/wing r/axis s/span} :: alias info
++ typo span :: old span ++ typo span :: old span
++ udal :: atomic change (%b) ++ udal :: atomic change (%b)
$: p/@ud :: blockwidth $: p/@ud :: blockwidth
@ -2443,7 +2443,7 @@
?~ a +<+.b ?~ a +<+.b
$(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b))) $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
:: ::
+- tap :: list tiles a set +- tap :: convert to list
~/ %tap ~/ %tap
|= b/(list _?>(?=(^ a) n.a)) |= b/(list _?>(?=(^ a) n.a))
^+ b ^+ b
@ -6285,6 +6285,17 @@
hoz hoz
[%fork hoz bur] [%fork hoz bur]
:: ::
++ frog :: make %frog span
~/ %frog
|= yed/(list span)
=| lez/(set span)
|- ^- span
?~ yed
?~ lez %void
?: ?=({* $~ $~} lez) n.lez
[%frog (~(tap in `(set span)`lez))]
$(yed t.yed, lez ?:(=(%void i.yed) lez (~(put in lez) i.yed)))
::
++ cove :: extract [0 *] axis ++ cove :: extract [0 *] axis
|= nug/nock |= nug/nock
?- nug ?- nug
@ -7715,6 +7726,15 @@
[q.hin q.yon ~] [q.hin q.yon ~]
?> ?=(^ p.q.yon) ?> ?=(^ p.q.yon)
?:(=(q.hin i.p.q.yon) p.q.yon [q.hin p.q.yon]) ?:(=(q.hin i.p.q.yon) p.q.yon [q.hin p.q.yon])
::
{$frog *}
=- [p [%pick q]]
|- ^- {p/{p/(map span @) q/(map @ wine)} q/(list wine)}
?~ p.sut
[dex ~]
=+ mor=$(p.sut t.p.sut)
=+ dis=^$(dex p.mor, sut i.p.sut)
[p.dis q.dis q.mor]
:: ::
{$hold *} {$hold *}
=+ hey=(~(get by p.dex) sut) =+ hey=(~(get by p.dex) sut)
@ -7785,6 +7805,7 @@
{$core *} [p.r.q.sut $(sut p.sut)] {$core *} [p.r.q.sut $(sut p.sut)]
{$face *} $(sut repo) {$face *} $(sut repo)
{$fork *} $(sut p.sut) {$fork *} $(sut p.sut)
{$frog *} $(sut -.p.sut)
{$hold *} ?: (~(has in gil) sut) {$hold *} ?: (~(has in gil) sut)
~_ (dunk %span) ~_ (dunk %span)
~|(%burn-loop !!) ~|(%burn-loop !!)
@ -7846,6 +7867,7 @@
{$core *} ?:(?=(?({$atom *} {$cell *}) ref) sut sint) {$core *} ?:(?=(?({$atom *} {$cell *}) ref) sut sint)
{$face *} (face p.sut dext(sut q.sut)) {$face *} (face p.sut dext(sut q.sut))
{$fork *} (fork dext(sut p.sut) dext(sut q.sut)) {$fork *} (fork dext(sut p.sut) dext(sut q.sut))
{$frog *} (frog (turn p.sut |=(span dext(sut +<))))
{$hold *} ?< (~(has in bix) [sut ref]) {$hold *} ?< (~(has in bix) [sut ref])
dext(sut repo, bix (~(put in bix) [sut ref])) dext(sut repo, bix (~(put in bix) [sut ref]))
$noun dext(sut repo) $noun dext(sut repo)
@ -7858,6 +7880,9 @@
{$core *} sut {$core *} sut
{$face *} dext(ref repo(sut ref)) {$face *} dext(ref repo(sut ref))
{$fork *} dext(sut dext(ref p.ref), ref q.ref) {$fork *} dext(sut dext(ref p.ref), ref q.ref)
{$frog *} |- ^- span
?~ p.ref sut
$(p.ref t.p.ref, sut dext(ref i.p.ref))
{$hold *} dext(ref repo(sut ref)) {$hold *} dext(ref repo(sut ref))
== ==
-- --
@ -7993,6 +8018,18 @@
++ lose [%| %& p.heg] ++ lose [%| %& p.heg]
++ stop ?~(q.heg here lose) ++ stop ?~(q.heg here lose)
++ fake !! ++ fake !!
++ twin |= {hax/pony yor/pony}
~| %find-fork
?: ?=($| -.hax)
?>(=(hax yor) hax)
?< ?=($| -.yor)
?> =(p.p.hax p.p.yor)
:+ %& p.p.hax
?: &(?=($& -.q.p.hax) ?=($& -.q.p.yor))
[%& (fork p.q.p.hax p.q.p.yor)]
?> &(?=($| -.q.p.hax) ?=($| -.q.p.yor))
?> =(p.q.p.hax p.q.p.yor)
[%| p.q.p.hax (~(uni by q.q.p.hax) q.q.p.yor)]
++ $ ++ $
^- pony ^- pony
?- ref ?- ref
@ -8046,18 +8083,18 @@
?: lef ?: ryt [%| %& p.heg] ?: lef ?: ryt [%| %& p.heg]
$(ref q.ref) $(ref q.ref)
?: ryt $(ref p.ref) ?: ryt $(ref p.ref)
=+ [hax yor]=[$(ref p.ref) $(ref q.ref)] (twin $(ref p.ref) $(ref q.ref))
~| %find-fork ::
?: ?=($| -.hax) {$frog *}
?>(=(hax yor) hax) =+ ^= wiz |- ^- (list pony)
?< ?=($| -.yor) ?~ p.ref ~
?> =(p.p.hax p.p.yor) =+ mor=$(p.ref t.p.ref)
:+ %& p.p.hax ?: (~(has in gil) i.p.ref) mor
?: &(?=($& -.q.p.hax) ?=($& -.q.p.yor)) [^$(ref i.p.ref) mor]
[%& (fork p.q.p.hax p.q.p.yor)] ?~ wiz [%| %& p.heg]
?> &(?=($| -.q.p.hax) ?=($| -.q.p.yor)) |- ^- pony
?> =(p.q.p.hax p.q.p.yor) ?~ t.wiz i.wiz
[%| p.q.p.hax (~(uni by q.q.p.hax) q.q.p.yor)] (twin i.wiz $(wiz t.wiz))
:: ::
{$hold *} {$hold *}
?: (~(has in gil) ref) ?: (~(has in gil) ref)
@ -8115,6 +8152,8 @@
{$core *} [%0 0] {$core *} [%0 0]
{$face *} $(sut q.sut) {$face *} $(sut q.sut)
{$fork *} (flor $(sut p.sut) $(sut q.sut)) {$fork *} (flor $(sut p.sut) $(sut q.sut))
{$frog *} |- ^- nock
?~(p.sut [%1 1] (flor ^$(sut i.p.sut) $(p.sut t.p.sut)))
{$hold *} {$hold *}
?: (~(has in vot) sut) ?: (~(has in vot) sut)
[%0 0] [%0 0]
@ -8152,6 +8191,7 @@
{$core *} $(sut repo) {$core *} $(sut repo)
{$face *} (face p.sut $(sut q.sut)) {$face *} (face p.sut $(sut q.sut))
{$fork *} (fork $(sut p.sut) $(sut q.sut)) {$fork *} (fork $(sut p.sut) $(sut q.sut))
{$frog *} (frog (turn p.sut |=(span ^$(sut +<))))
{$hold *} {$hold *}
?: (~(has in bix) [sut ref]) ?: (~(has in bix) [sut ref])
~|(%fuse-loop !!) ~|(%fuse-loop !!)
@ -8339,6 +8379,7 @@
{$core *} $(sut p.sut) {$core *} $(sut p.sut)
{$face *} $(sut q.sut) {$face *} $(sut q.sut)
{$fork *} &($(sut p.sut) $(sut q.sut)) {$fork *} &($(sut p.sut) $(sut q.sut))
{$frog *} (lien p.sut |=(span ^$(sut +<)))
{$hold *} |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo)) {$hold *} |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo))
$noun | $noun |
$void & $void &
@ -8562,6 +8603,8 @@
{$face *} dext(sut q.sut) {$face *} dext(sut q.sut)
{$fork *} ?. ?=(?({$atom *} $noun {$cell *} {$core *}) ref) sint {$fork *} ?. ?=(?({$atom *} $noun {$cell *} {$core *}) ref) sint
|(dext(sut p.sut) dext(sut q.sut)) |(dext(sut p.sut) dext(sut q.sut))
{$frog *} ?. ?=(?({$atom *} $noun {$cell *} {$core *}) ref) sint
(lien p.sut |=(span dext(sut +<)))
{$hold *} ?: (~(has in seg) sut) | {$hold *} ?: (~(has in seg) sut) |
?: (~(has in gil) [sut ref]) & ?: (~(has in gil) [sut ref]) &
%= dext %= dext
@ -8581,6 +8624,7 @@
{$core *} dext(ref repo(sut ref)) {$core *} dext(ref repo(sut ref))
{$face *} dext(ref q.ref) {$face *} dext(ref q.ref)
{$fork *} &(sint(ref p.ref) sint(ref q.ref)) {$fork *} &(sint(ref p.ref) sint(ref q.ref))
{$frog *} (levy p.ref |=(span sint(ref +<)))
{$hold *} ?: (~(has in reg) ref) & {$hold *} ?: (~(has in reg) ref) &
?: (~(has in gil) [sut ref]) & ?: (~(has in gil) [sut ref]) &
%= dext %= dext
@ -8626,6 +8670,7 @@
== ==
:: ::
{$fork *} (fork $(sut p.sut) $(sut q.sut)) {$fork *} (fork $(sut p.sut) $(sut q.sut))
{$frog *} (frog (turn p.sut |=(span ^$(sut +<))))
{$hold *} {$hold *}
?: (~(has in gil) sut) ?: (~(has in gil) sut)
%void %void
@ -8739,6 +8784,7 @@
?+ sut ^$(vit t.vit) ?+ sut ^$(vit t.vit)
{$face *} (face p.sut ^$(vit t.vit, sut q.sut)) {$face *} (face p.sut ^$(vit t.vit, sut q.sut))
{$fork *} (fork $(sut p.sut) $(sut q.sut)) {$fork *} (fork $(sut p.sut) $(sut q.sut))
{$frog *} (frog (turn p.sut |=(span ^$(sut +<))))
{$hold *} $(sut repo) {$hold *} $(sut repo)
== ==
=+ vil=*(set span) =+ vil=*(set span)
@ -8761,6 +8807,10 @@
%void %void
=> .(vil (~(put in vil) sut)) => .(vil (~(put in vil) sut))
(fork $(sut p.sut) $(sut q.sut)) (fork $(sut p.sut) $(sut q.sut))
{$frog *} ?: (~(has in vil) sut)
%void
=> .(vil (~(put in vil) sut))
(frog (turn p.sut |=(span ^$(sut +<))))
{$hold *} $(sut repo) {$hold *} $(sut repo)
== ==
:: ::