From 7524157829c454fe1ca3e2a0ca79e172f2675ad5 Mon Sep 17 00:00:00 2001 From: "C. Guy Yarvin" Date: Thu, 4 Jun 2015 21:14:07 -0700 Subject: [PATCH] Various fixes and improvements. --- base/ape/dojo/core.hook | 6 ---- base/ape/talk/core.hook | 2 +- base/arvo/dill.hoon | 9 +---- base/arvo/eyre.hoon | 3 +- base/arvo/gall.hoon | 70 +++++++++++++++++++++++++++++------- base/arvo/zuse.hoon | 6 +++- base/cat/hood/link/gate.hook | 9 +++-- 7 files changed, 72 insertions(+), 33 deletions(-) diff --git a/base/ape/dojo/core.hook b/base/ape/dojo/core.hook index 0b47cab39..1d312b027 100644 --- a/base/ape/dojo/core.hook +++ b/base/ape/dojo/core.hook @@ -89,12 +89,6 @@ == :: ++ move (pair bone card) :: user-level move ++ hapt ,[p=ship q=path] :: - ++ cuft :: internal gift - $% [%coup p=(unit tang)] :: poke result - [%diff p=cage] :: subscription output - [%quit ~] :: close subscription - [%reap p=(unit tang)] :: peer result - == :: ++ hood :: assembly plan $: zus=@ud :: zuse kelvin sur=(list hoot) :: structures diff --git a/base/ape/talk/core.hook b/base/ape/talk/core.hook index cbe9e2f14..08dbfb846 100644 --- a/base/ape/talk/core.hook +++ b/base/ape/talk/core.hook @@ -1663,7 +1663,7 @@ ++ poke-talk-command :: accept command |= [cod=command] ^- [(list move) _+>] - ~& [%talk-poke-command src.hid cod] + :: ~& [%talk-poke-command src.hid cod] ra-abet:(~(ra-apply ra ost.hid ~) src.hid cod) :: ++ poke-sole-action :: accept console diff --git a/base/arvo/dill.hoon b/base/arvo/dill.hoon index c70b5a9d7..12a702115 100644 --- a/base/arvo/dill.hoon +++ b/base/arvo/dill.hoon @@ -43,13 +43,6 @@ ++ mess :: $% [%dill-belt p=(hypo dill-belt)] :: == :: -++ cuft :: internal gift - $% [%coup p=(unit tang)] :: poke result - [%quit ~] :: close subscription - [%reap p=(unit tang)] :: peer result - [%diff p=cage] :: subscription output - == :: -++ suss (trel term ,@tas ,@da) :: config report ++ move ,[p=duct q=(mold note gift)] :: local move ++ note-ames :: weird ames move $% [%make p=(unit ,@t) q=@ud r=@ s=?] :: @@ -79,7 +72,6 @@ [%d note-dill] :: [%g note-gall] :: == == :: -++ riff ,[p=desk q=(unit rave)] :: see %clay ++ sign-ames :: $% [%nice ~] :: [%init p=ship] :: @@ -305,6 +297,7 @@ +>.$ (dump:(crud %reap u.p.p.+>.sih) %logo ~) %diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih)) + %doff !! == :: [%c %note *] diff --git a/base/arvo/eyre.hoon b/base/arvo/eyre.hoon index 749ec77ec..9a148fd7b 100644 --- a/base/arvo/eyre.hoon +++ b/base/arvo/eyre.hoon @@ -684,6 +684,7 @@ ?(%coup %reap) (axom tee ?~(p.cuf [%nice ~] [%mean `[-.cuf u.p.cuf]])) :: + %doff !! %diff ?> ?=([%of @ ^] tee) ?. ?=(%json p.p.cuf) @@ -780,7 +781,7 @@ == == :: - ++ root-beak `beak`[our %demo da/now] :: XX + ++ root-beak `beak`[our %home da/now] :: XX ++ emule |= a=_|?(..emule) ^+ ..emule =+ mul=(mule a) diff --git a/base/arvo/gall.hoon b/base/arvo/gall.hoon index 15c4fe270..c27a3e425 100644 --- a/base/arvo/gall.hoon +++ b/base/arvo/gall.hoon @@ -218,6 +218,7 @@ ?- -.q.caz %poke [%m p.p.q.caz q.q.p.q.caz] %pull [%u ~] + %puff !! %peer [%s p.q.caz] == %+ mo-pass @@ -344,7 +345,7 @@ ?: ?=([%f %made *] sih) ?- -.q.+>.sih %tabl ~|(%made-tabl !!) - %| (mo-give %mack `p.q.+>.sih) :: XX should crash + %| (mo-give %mack `p.q.+>.sih) :: XX should crash %& (mo-pass [%sys pax] %g %deal [him our] i.t.t.pax %poke p.q.+>.sih) == ?: ?=([%a %woot *] sih) +>.$ :: quit ack, boring @@ -354,10 +355,21 @@ %coup (mo-give %mack p.cuf) %diff %+ mo-pass [%sys %red t.pax] [%a %wont [our him] [%q %gh dap ~] [num %d p.p.cuf q.q.p.cuf]] + %doff !! %quit %+ mo-pass [%sys pax] [%a %wont [our him] [%q %gh dap ~] [num %x ~]] %reap (mo-give %mack p.cuf) == + :: + %val :: inbound validate + ?> ?=([@ @ ~] t.pax) + =+ [him=(slav %p i.t.pax) dap=i.t.t.pax] + ?> ?=([%f %made *] sih) + ?- -.q.+>.sih + %tabl !! + %| (mo-give %unto %coup `p.q.+>.sih) :: XX invalid, crash + %& (mo-clip dap `prey`[%high ~ him] %poke p.q.sih) + == :: %way :: outbound request ?> ?=([%a %woot *] sih) @@ -387,10 +399,34 @@ +>.$ ap-abet:(ap-purr:pap +<.q.hin t.t.t.pax +>.q.hin) :: - %out ?. ?=([%g %unto *] q.hin) + %out ?: ?=([%f %made *] q.hin) + ?- -.q.+>.q.hin + %tabl !! + %| ~& [%mo-cook-fail +.q.+>.q.hin] + ~& [him=q.q.pry our=our pax=pax] + :: + :: here we should crash because the right thing + :: for the client to do is to upgrade so that it + :: understands the server's mark, thus allowing + :: the message to proceed. but ames is not quite + :: ready for promiscuous crashes, so instead we + :: send a pull outward and a quit downward. + :: or not... outgoing dap (XXX) is not in the path. + :: =. +>.$ ap-abet:(ap-pout:pap t.t.t.pax %quit ~) + :: %+ mo-pass + :: [%use pax] + :: [%g %deal [q.q.pry our] XXX %pull ~] + !! + %& ap-abet:(ap-pout:pap t.t.t.pax %diff +.q.+>.q.hin) + == + ?. ?=([%g %unto *] q.hin) ~& [%mo-cook-weird q.hin] ~& [%mo-cook-weird-path pax] +>.$ + ?: ?=(%doff +>-.q.hin) + %+ mo-pass + [%use pax] + [%f %exec our byk.pap ~ %vale p.+>+.q.hin our q.+>+.q.hin] ap-abet:(ap-pout:pap t.t.t.pax +>.q.hin) == :: @@ -405,13 +441,21 @@ ?: =(~ kys.u.suf) +>.^$(hen neh, wub (~(del by wub) dap)) =^ lep kys.u.suf [p q]:~(get to kys.u.suf) - $(+>.^$ ap-abet:(ap-club:(ap-abed:ap(hen p.lep) dap q.lep) r.lep)) + $(+>.^$ (mo-clip(hen p.lep) dap q.lep r.lep)) :: ++ mo-beak :: build beak |= dap=dude ^- beak byk:(~(got by bum) dap) :: + ++ mo-clip :: apply club + |= [dap=dude pry=prey cub=club] + ?: ?=(%puff -.cub) + %+ mo-pass + [%sys %val (scot %p q.q.pry) dap ~] + [%f %exec our (mo-beak dap) ~ %vale p.cub our q.cub] + ap-abet:(ap-club:(ap-abed:ap dap pry) cub) + :: ++ mo-club :: local action |= [dap=dude pry=prey cub=club] ^+ +> @@ -419,7 +463,7 @@ :: ~& [%mo-club-qeu dap cub] =+ syf=(fall (~(get by wub) dap) *sofa) +>.$(wub (~(put by wub) dap syf(kys (~(put to kys.syf) [hen pry cub])))) - ap-abet:(ap-club:(ap-abed:ap dap pry) cub) + (mo-clip dap pry cub) :: ++ mo-gawk :: ames forward |= [him=@p dap=dude num=@ud rok=rook] @@ -428,21 +472,19 @@ [%sys %req (scot %p him) dap (scot %ud num) ~] ^- note-arvo ?- -.rok - %m [%f %exec our (mo-beak dap) ~ %vale p.rok our q.rok] + :: %m [%f %exec our (mo-beak dap) ~ %vale p.rok our q.rok] + %m [%g %deal [him our] dap %puff p.rok q.rok] %s [%g %deal [him our] dap %peer p.rok] %u [%g %deal [him our] dap %pull ~] == :: ++ mo-gawd :: ames backward |= [him=@p dap=dude num=@ud ron=roon] - ?- -.ron - %d - %+ mo-pass - [%sys %rep (scot %p him) dap (scot %ud num) ~] - [%f %exec our (mo-beak dap) ~ %vale p.ron our q.ron] - :: - %x =. +> (mo-give %mack ~) :: XX should crash - (mo-give(hen (mo-ball him num)) %unto %quit ~) + =. +> (mo-give %mack ~) + =. hen (mo-ball him num) + ?- -.ron + %d (mo-give %unto %doff p.ron q.ron) + %x (mo-give %unto %quit ~) == :: ++ ap :: agent engine @@ -540,6 +582,7 @@ ?- -.cub %poke (ap-poke +.cub) %peer (ap-peer +.cub) + %puff !! %pull ap-pull %pump ap-fall == @@ -883,6 +926,7 @@ ?- -.cuf %coup (ap-punk q.q.pry %coup +.pax `!>(p.cuf)) %diff (ap-diff q.q.pry pax p.cuf) + %doff !! %quit (ap-punk q.q.pry %quit +.pax ~) %reap (ap-punk q.q.pry %reap +.pax `!>(p.cuf)) == diff --git a/base/arvo/zuse.hoon b/base/arvo/zuse.hoon index 835cf505a..d371e37e5 100644 --- a/base/arvo/zuse.hoon +++ b/base/arvo/zuse.hoon @@ -2542,14 +2542,18 @@ :::: %gall :: ++ club :: agent action - $% [%peer p=path] :: subscribe + $% :: [%peel p=mark q=path] :: translated peer + [%peer p=path] :: subscribe [%poke p=cage] :: apply + [%puff p=mark q=noun] :: unchecked poke [%pull ~] :: unsubscribe + :: [%punk p=mark q=cage] :: translated poke [%pump ~] :: pump yes/no == :: ++ cuft :: internal gift $% [%coup p=(unit tang)] :: poke result [%diff p=cage] :: subscription output + [%doff p=mark q=noun] :: untyped diff [%quit ~] :: close subscription [%reap p=(unit tang)] :: peer result == :: diff --git a/base/cat/hood/link/gate.hook b/base/cat/hood/link/gate.hook index cbfef2291..d488ab0f2 100644 --- a/base/cat/hood/link/gate.hook +++ b/base/cat/hood/link/gate.hook @@ -5,7 +5,10 @@ :: :::: !: -|= $: [now=@da eny=@uvI bec=beak] - [[who=ship dap=term ~] ~] +|= $: [now=@da eny=@uvI byk=beak] + [arg=$?([dap=term ~] [who=ship dap=term ~]) ~] == -[%hood-link who dap] +:- %hood-link +?~ +.arg + [p.byk dap.arg] +[who.arg dap.arg]