neo: fix gifts and acks

This commit is contained in:
Liam Fitzgerald 2024-06-03 18:57:39 -04:00
parent 23402c7d04
commit 5f910bc84f
2 changed files with 60 additions and 18 deletions

View File

@ -76,7 +76,7 @@
=* state - =* state -
=< =<
%- mute %- mute
%+ libverb & %+ libverb |
%- agent:dbug %- agent:dbug
^- agent:gall ^- agent:gall
|_ =bowl:gall |_ =bowl:gall
@ -197,13 +197,13 @@
++ do-ack ++ do-ack
|= =ack:neo |= =ack:neo
^- (list card) ^- (list card)
?: =(p.p.ack sys-pith) ?: =(p.ack sys-pith)
%. *(list card) %. *(list card)
?~ q.ack ?~ q.ack
same same
?- -.u.q.ack ?- -.u.q.ack
%goof (mean leaf/"goof on sys" tang.u.q.ack) %goof (slog leaf/"goof on sys" tang.u.q.ack)
%gone (mean leaf/"no dependency {<term.u.q.ack>}" ~) %gone (slog leaf/"no dependency {<term.u.q.ack>}" ~)
== ==
=/ src=name:neo (de-pith:name:neo p.p.ack) =/ src=name:neo (de-pith:name:neo p.p.ack)
=/ =wire nack/(pout p.p.ack) =/ =wire nack/(pout p.p.ack)
@ -272,6 +272,7 @@
++ on-move ++ on-move
|= =move:neo |= =move:neo
^+ run ^+ run
%- (slog leaf/"{(en-tape:pith:neo p.move)} -> {(en-tape:pith:neo p.q.move)}: {<-.q.q.move>}" ~)
=/ src=name:neo (de-pith:name:neo p.move) =/ src=name:neo (de-pith:name:neo p.move)
=/ dst=name:neo (de-pith:name:neo p.q.move) =/ dst=name:neo (de-pith:name:neo p.q.move)
?> =(src.bowl ship.src) ?> =(src.bowl ship.src)
@ -280,13 +281,17 @@
(on-move:sys p.move q.move(p t.pith.dst)) (on-move:sys p.move q.move(p t.pith.dst))
++ on-ack ++ on-ack
|= =ack:neo |= =ack:neo
%. run =/ dst=name:neo (de-pith:name:neo p.p.ack)
?~ q.ack ?> =(src.bowl ship.dst)
same ?: =(sys-pith p.p.ack)
?- -.u.q.ack %. run
%gone (slog leaf/"Missing dep: {<term.u.q.ack>}" ~) ?~ q.ack
%goof (slog leaf/"nacked on flow {<p.ack>}" tang.u.q.ack) same
== ?- -.u.q.ack
%gone (slog leaf/"Missing dep: {<term.u.q.ack>}" ~)
%goof (slog leaf/"nacked on flow {<p.ack>}" tang.u.q.ack)
==
(on-move q.p.ack p.p.ack %poke ack/!>(q.ack))
:: ::
++ on-dirt-card ++ on-dirt-card
|= =card:dirt:neo |= =card:dirt:neo
@ -1515,6 +1520,8 @@
~| wer ~| wer
=; =vase =; =vase
(make-riff wer vase) (make-riff wer vase)
%- need
%- mole |.
=+ vaz=(vang & (pout wer)) =+ vaz=(vang & (pout wer))
%+ slap reef %+ slap reef
(scan (trip txt) (full (ifix [gay gay] tall:vaz))) (scan (trip txt) (full (ifix [gay gay] tall:vaz)))
@ -1576,8 +1583,9 @@
++ seize ++ seize
|= [par=pith:neo child=pith:neo car=?(%y %z)] |= [par=pith:neo child=pith:neo car=?(%y %z)]
^- ? ^- ?
=- ~&(seize/[par child -] -)
?: =(%y car) ?: =(%y car)
=(par (~(parent of:neo tide) child)) =(`par (~(parent of:neo tide) child))
!=(~ (dif:pith:neo par child)) !=(~ (dif:pith:neo par child))
:: ::
:: +abduct: check capture :: +abduct: check capture
@ -1585,21 +1593,26 @@
|= [par=pith:neo child=pith:neo] |= [par=pith:neo child=pith:neo]
^- ? ^- ?
?~ wav=(~(get of:neo tide) par) ?~ wav=(~(get of:neo tide) par)
::~& bailing-no-wave/[par child]
| |
?~ kids.dock.u.wav ?~ kids.dock.u.wav
::~& bailing-no-kids/[par child]
| |
(seize par child p.u.kids.dock.u.wav) (seize par child p.u.kids.dock.u.wav)
:: +adopt: produce all capturing parents :: +adopt: produce all capturing parents
:: ::
++ adopt ++ adopt
=| here=pith:neo
=| res=(set pith:neo) =| res=(set pith:neo)
=| here=pith:neo
|= =pith:neo |= =pith:neo
=. pith (tail pith)
::~& adopting/pith
|- ^+ res |- ^+ res
=? res (abduct here pith) =? res (abduct here pith)
(~(put in res) here) (~(put in res) [p/our.bowl here])
=/ nex (dif:pith:neo here pith) =/ nex (dif:pith:neo here pith)
?~ nex ?~ nex
::~& adopted/res
res res
$(here (snoc here i.nex)) $(here (snoc here i.nex))
:: ::
@ -1631,10 +1644,14 @@
=. run (add:stop move) =. run (add:stop move)
arvo arvo
|% |%
++ can-ack
^- ?
!?=([%poke %ack *] q.q.init-move)
++ abet ++ abet
^+ run ^+ run
?: =([~ ~] block) ?: =([~ ~] block)
=. run (emil `(list card)`(do-ack [p p.q]:init-move err.block)) =? run can-ack
(emil `(list card)`(do-ack [p p.q]:init-move err.block))
=. run (emil (turn up do-move)) =. run (emil (turn up do-move))
(dial smut) (dial smut)
:: %+ turn ~(tap by change) :: %+ turn ~(tap by change)
@ -1650,7 +1667,10 @@
?: ?=([%poke %rely *] q.q.move) ?: ?=([%poke %rely *] q.q.move)
~& >>> rely-nack/[src dst]:init ~& >>> rely-nack/[src dst]:init
run run
(emil (do-ack [p p.q]:init-move err.block)) ?: can-ack
(emil (do-ack [p p.q]:init-move err.block))
~& ack-nack/u.err.block
run
:: ::
++ arvo . ++ arvo .
++ emit |=(=move:neo arvo(down [move down])) ++ emit |=(=move:neo arvo(down [move down]))
@ -1669,18 +1689,22 @@
(ingest cards) (ingest cards)
:: ::
++ plunder ++ plunder
~& plundering/~
^+ arvo ^+ arvo
=/ by-parent=(jug pith:neo dust:neo) =/ by-parent=(jug pith:neo dust:neo)
%+ roll grit %+ roll grit
|= [=dust:neo by-parent=(jug pith:neo dust:neo)] |= [=dust:neo by-parent=(jug pith:neo dust:neo)]
%- ~(gas ju by-parent) %- ~(gas ju by-parent)
=/ adoptees (adopt pith.dust)
~& adoptees/adoptees
(turn ~(tap in (adopt pith.dust)) |=(=pith:neo [pith [(dif:pith:neo pith pith.dust) +.dust]])) (turn ~(tap in (adopt pith.dust)) |=(=pith:neo [pith [(dif:pith:neo pith pith.dust) +.dust]]))
:: XX: assert gifts empty :: XX: assert gifts empty
=. gifts =. gifts
%+ turn (sort ~(tap in ~(key by by-parent)) sort:pith:neo) %+ turn (sort ~(tap in ~(key by by-parent)) sort:pith:neo)
|= =pith:neo |= =pith:neo
^- [pith:neo gift:neo] ^- [pith:neo gift:neo]
[pith (gas-gift ~(tap in (~(get ju by-parent) pith)))] [(tail pith) (gas-gift ~(tap in (~(get ju by-parent) pith)))]
~& gifts/gifts
=. smut (welp smut grit) =. smut (welp smut grit)
=. grit ~ =. grit ~
give give
@ -1963,6 +1987,15 @@
:: ::
++ su-poke ++ su-poke
|= =pail:neo |= =pail:neo
^+ su-core
?. (~(has in poke.dock.wave) p.pail)
?: ?=(%ack p.pail)
%. su-core
=+ !<(ack=(unit quit:neo) q.pail)
?~ ack
same
(slog (print-quit:neo u.ack))
(mean leaf/"no support for {<p.pail>}" ~)
=/ [caz=(list card:neo) new=pail:neo] =/ [caz=(list card:neo) new=pail:neo]
(poke:su-form pail) (poke:su-form pail)
=. su-core (su-emil caz) =. su-core (su-emil caz)
@ -2186,6 +2219,7 @@
|= [src=pith:neo dst=pith:neo =note:neo] |= [src=pith:neo dst=pith:neo =note:neo]
?> ?=(%poke -.note) :: XX: all shanes should be virtualised and hand deliver acks ?> ?=(%poke -.note) :: XX: all shanes should be virtualised and hand deliver acks
?+ p.pail.note ~|(bad-eyre-call/p.pail.note !!) ?+ p.pail.note ~|(bad-eyre-call/p.pail.note !!)
%ack run
%eyre-req (on-eyre-req !<(req:eyre:neo q.pail.note)) %eyre-req (on-eyre-req !<(req:eyre:neo q.pail.note))
%eyre-sign (on-eyre-sign src !<(sign:eyre:neo q.pail.note)) %eyre-sign (on-eyre-sign src !<(sign:eyre:neo q.pail.note))
== ==

View File

@ -877,6 +877,13 @@
$% [%gone =term] :: injected a bad dependency $% [%gone =term] :: injected a bad dependency
[%goof =tang] :: crash [%goof =tang] :: crash
== ==
++ print-quit
|= q=quit
^- tang
?- -.q
%goof tang.q
%gone ~[leaf/"No dependency at {<term>}"]
==
+$ ack (pair flow (unit quit)) +$ ack (pair flow (unit quit))
:: ::
:: $flow: Call direction :: $flow: Call direction
@ -1416,7 +1423,8 @@
|- ^+ a |- ^+ a
?~ a b ?~ a b
?~ b a ?~ b a
?> =(i.a i.b) ?. =(i.a i.b)
a
$(a t.a, b t.b) $(a t.a, b t.b)
++ sub ++ sub
|= [from=$ del=$] |= [from=$ del=$]