mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-11-15 13:17:41 +03:00
1274 lines
45 KiB
Plaintext
1274 lines
45 KiB
Plaintext
:: :: %gall, agent execution
|
|
!? 163
|
|
::::
|
|
|= pit+vase
|
|
=> =~
|
|
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: rest of arvo
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
++ volt ?($low $high) :: voltage
|
|
++ torc $@(?($iron $gold) {$lead p+ship}) :: security control
|
|
++ roon :: reverse ames msg
|
|
$% {$d p+mark q+*} :: diff (diff)
|
|
{$x $~} ::
|
|
== ::
|
|
++ rook :: forward ames msg
|
|
$% {$m p+mark q+*} :: message
|
|
{$s p+path} :: subscribe
|
|
{$u $~} :: cancel#unsubscribe
|
|
== ::
|
|
-- ::
|
|
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: local arvo
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
++ cote :: ++ap note
|
|
$% {$meta p+@tas q+vase} ::
|
|
{$send p+ship q+cush} ::
|
|
{$hiss p+mark q+cage}
|
|
== ::
|
|
++ cove (pair bone (mold cote cuft)) :: internal move
|
|
++ move {p+duct q+(mold note-arvo gift-arvo)} :: typed move
|
|
-- ::
|
|
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: %gall state
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
++ axle-n ?(axle axle-1) :: upgrade path
|
|
++ axle-1 {$1 pol+(map ship mast-1)} ::
|
|
++ mast-1 ::
|
|
(cork mast |=(mast +<(bum (~(run by bum) seat-1)))) ::
|
|
++ seat-1 ::
|
|
(cork seat |=(seat +<+)) ::
|
|
++ axle :: all state
|
|
$: $2 :: state version
|
|
pol+(map ship mast) :: apps by ship
|
|
== ::
|
|
++ gest :: subscriber data
|
|
$: sup+bitt :: incoming subscribers
|
|
neb+boat :: outgoing subscribers
|
|
qel+(map bone @ud) :: queue meter
|
|
== ::
|
|
++ mast :: ship state
|
|
$: sys+duct :: system duct
|
|
sap+(map ship scad) :: foreign contacts
|
|
bum+(map dude seat) :: running agents
|
|
wub+(map dude sofa) :: waiting queue
|
|
== ::
|
|
++ ffuc :: new cuff
|
|
$: p+(unit (set ship)) :: disclosing to
|
|
q+ship :: attributed to
|
|
== ::
|
|
++ prey (pair volt ffuc) :: privilege
|
|
++ scad :: foreign connection
|
|
$: p+@ud :: index
|
|
q+(map duct @ud) :: by duct
|
|
r+(map @ud duct) :: by index
|
|
== ::
|
|
++ scar :: opaque input
|
|
$: p+@ud :: bone sequence
|
|
q+(map duct bone) :: by duct
|
|
r+(map bone duct) :: by bone
|
|
== ::
|
|
++ seat :: agent state
|
|
$: vel+worm :: cache
|
|
mom+duct :: control duct
|
|
liv+? :: unstopped
|
|
toc+torc :: privilege
|
|
tyc+stic :: statistics
|
|
ged+gest :: subscribers
|
|
hav+vase :: running state
|
|
byk+beak :: update control
|
|
pyl+(map bone mark) :: req'd translations
|
|
zam+scar :: opaque ducts
|
|
== ::
|
|
++ sofa :: queue for blocked
|
|
$: kys+(qeu (trel duct prey club)) :: queued kisses
|
|
== ::
|
|
++ stic :: statistics
|
|
$: act+@ud :: change number
|
|
eny+@uvI :: entropy
|
|
lat+@da :: time
|
|
== ::
|
|
-- ::
|
|
:::::::::::::::::::::::::::::::::::::::::::::::::::::: vane header
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
. ==
|
|
=| all+axle :: all vane state
|
|
|= $: now+@da :: urban time
|
|
eny+@uvI :: entropy
|
|
ska+sled :: activate
|
|
== :: opaque core
|
|
~% %gall-top ..is ~
|
|
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: state machine
|
|
::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
++ mo
|
|
~% %gall-mo +> ~
|
|
|_ $: $: our+@p
|
|
hen+duct
|
|
moz+(list move)
|
|
==
|
|
mast
|
|
==
|
|
++ mo-abed :: initialize
|
|
|= {our+@p hen+duct}
|
|
^+ +>
|
|
%_ +>
|
|
our our
|
|
hen hen
|
|
+<+ (~(got by pol.all) our)
|
|
==
|
|
::
|
|
++ mo-abet :: resolve to
|
|
^+ [*(list move) +>+]
|
|
:_ +>+(pol.all (~(put by pol.all) our +<+))
|
|
%- flop
|
|
%+ turn moz
|
|
|= a+move
|
|
?. ?=($pass -.q.a) a
|
|
[p.a %pass [(scot %p our) p.q.a] q.q.a]
|
|
::
|
|
++ mo-conf :: configure
|
|
|= {dap+dude lum+culm}
|
|
(mo-boot dap ?:((~(has by bum) dap) %old %new) p.p.lum q.p.lum da#now)
|
|
::
|
|
++ mo-pass :: standard pass
|
|
|= {pax+path noh+note-arvo}
|
|
%_(+> moz :_(moz [hen %pass pax noh]))
|
|
::
|
|
++ mo-give
|
|
|= git+gift-gall
|
|
%_(+> moz :_(moz [hen %give git]))
|
|
::
|
|
++ mo-okay :: valid agent core
|
|
|= vax+vase
|
|
^- ?
|
|
=+ bol=(slew 12 vax)
|
|
?~ bol |
|
|
(~(nest ut p.u.bol) %| -:!>(*bowl))
|
|
::
|
|
++ mo-boom :: complete new boot
|
|
|= {dap+dude byk+beak dep+@uvH gux+gage}
|
|
^+ +>
|
|
?- -.gux
|
|
$tabl ~|(%made-tabl !!)
|
|
$|
|
|
=. +> (mo-bold byk dap dep)
|
|
=. +> (mo-give %onto %| p.gux)
|
|
+>
|
|
$&
|
|
?> ?=(@ p.p.gux)
|
|
?. (mo-okay q.p.gux)
|
|
(mo-give %onto %| [%leaf "{<dap>}: bogus core"]~)
|
|
=. +> (mo-bold byk dap dep)
|
|
=. +> (mo-born dap byk q.p.gux)
|
|
=+ old=+>.$
|
|
=+ wag=(ap-prop:(ap-abed:ap dap [%high [~ our]]) ~)
|
|
?^ -.wag
|
|
=. +>.$ old
|
|
(mo-give %onto %| u.-.wag)
|
|
=. +>.$ ap-abet:+.wag
|
|
(mo-give:(mo-claw dap) %onto %& dap %boot now)
|
|
==
|
|
::
|
|
++ mo-born :: new seat
|
|
|= {dap+dude byk+beak hav+vase}
|
|
=+ sat=*seat
|
|
%_ +>.$
|
|
bum
|
|
%+ ~(put by bum) dap
|
|
%_ sat
|
|
mom hen
|
|
byk byk
|
|
hav hav
|
|
p.zam 1
|
|
q.zam [[[~ ~] 0] ~ ~]
|
|
r.zam [[0 [~ ~]] ~ ~]
|
|
==
|
|
==
|
|
::
|
|
++ mo-boon :: complete old boot
|
|
|= {dap+dude byk+beak dep+@uvH gux+gage}
|
|
^+ +>
|
|
=+ sut=(~(get by bum) dap)
|
|
?~ sut
|
|
~& [%gall-old-boon dap]
|
|
+>.$
|
|
=. bum (~(put by bum) dap u.sut(byk byk))
|
|
=. +>.$ (mo-bold byk dap dep)
|
|
?- -.gux
|
|
$tabl ~|(%made-tabl !!)
|
|
$| (mo-give %onto %| p.gux)
|
|
$& ?> ?=(@ p.p.gux)
|
|
ap-abet:(ap-peep:(ap-abed:ap dap [%high [~ our]]) q.p.gux)
|
|
==
|
|
::
|
|
++ mo-bold :: wait for dep
|
|
|= {byk+beak dap+dude dep+@uvH}
|
|
^+ +>
|
|
%+ mo-pass [%sys %dep (scot %p p.byk) q.byk dap ~]
|
|
[%f %wasp our dep &]
|
|
::
|
|
++ mo-boot :: create ship
|
|
|= {dap+dude how+?($new $old) byk+beak}
|
|
^+ +>
|
|
:: ~& [%mo-boot dap how byk]
|
|
%+ mo-pass [%sys how dap (scot %p p.byk) q.byk (scot r.byk) ~]
|
|
^- note-arvo
|
|
[%f %exec our `[byk %core [byk [dap %ape ~]]]]
|
|
::
|
|
++ mo-away :: foreign request
|
|
|= {him+ship caz+cush} ::
|
|
^+ +>
|
|
:: ~& [%mo-away him caz]
|
|
?: ?=($pump -.q.caz)
|
|
::
|
|
:: you'd think this would send an ack for the diff
|
|
:: that caused this pump. it would, but we already
|
|
:: sent it when we got the diff in ++mo-cyst. then
|
|
:: we'd have to save the network duct and connect it
|
|
:: to this returning pump.
|
|
::
|
|
+>
|
|
=^ num +>.$ (mo-bale him)
|
|
=+ ^= roc ^- rook
|
|
?- -.q.caz
|
|
$peel !!
|
|
$poke [%m p.p.q.caz q.q.p.q.caz]
|
|
$pull [%u ~]
|
|
$puff !!
|
|
$punk !!
|
|
$peer [%s p.q.caz]
|
|
==
|
|
%+ mo-pass
|
|
[%sys %way -.q.caz ~]
|
|
`note-arvo`[%a %wont [our him] [%g %ge p.caz ~] [num roc]]
|
|
::
|
|
++ mo-baal :: error convert a
|
|
|= art+(unit ares)
|
|
^- ares
|
|
?~(art ~ ?~(u.art `[%blank ~] u.art))
|
|
::
|
|
++ mo-baba :: error convert b
|
|
|= ars+ares
|
|
^- (unit tang)
|
|
?~ ars ~
|
|
`[[%leaf (trip p.u.ars)] q.u.ars]
|
|
::
|
|
++ mo-awed :: foreign response
|
|
|= {him+ship why+?($peer $poke $pull) art+(unit ares)}
|
|
^+ +>
|
|
:: ~& [%mo-awed him why art]
|
|
=+ tug=(mo-baba (mo-baal art))
|
|
?- why
|
|
$peer (mo-give %unto %reap tug)
|
|
$poke (mo-give %unto %coup tug)
|
|
$pull +>.$
|
|
==
|
|
::
|
|
++ mo-bale :: assign outbone
|
|
|= him+ship
|
|
^- {@ud _+>}
|
|
=+ sad=(fall (~(get by sap) him) `scad`[1 ~ ~])
|
|
=+ nom=(~(get by q.sad) hen)
|
|
?^ nom [u.nom +>.$]
|
|
:- p.sad
|
|
%_ +>.$
|
|
sap
|
|
%+ ~(put by sap) him
|
|
%_ sad
|
|
p +(p.sad)
|
|
q (~(put by q.sad) hen p.sad)
|
|
r (~(put by r.sad) p.sad hen)
|
|
==
|
|
==
|
|
::
|
|
++ mo-ball :: outbone by index
|
|
|= {him+ship num+@ud}
|
|
^- duct
|
|
(~(got by r:(~(got by sap) him)) num)
|
|
::
|
|
++ mo-come :: handle locally
|
|
|= {her+ship caz+cush}
|
|
^+ +>
|
|
=+ pry=`prey`[%high [~ her]]
|
|
(mo-club p.caz pry q.caz)
|
|
::
|
|
++ mo-coup :: back from mo-away
|
|
|= {dap+dude him+ship cup+ares}
|
|
%^ mo-give %unto %coup
|
|
?~ cup ~
|
|
[~ `tang`[[%leaf (trip p.u.cup)] q.u.cup]]
|
|
::
|
|
++ mo-chew :: reverse build path
|
|
|= pax+path
|
|
^- beak
|
|
?> ?=({@ @ @ $~} pax)
|
|
[(slav %p i.pax) i.t.pax da#(slav %da i.t.t.pax)]
|
|
::
|
|
++ mo-cyst :: take in /sys
|
|
|= {pax+path sih+sign-arvo}
|
|
^+ +>
|
|
?+ -.pax !!
|
|
$dep :: update
|
|
?> ?=({$f $news *} sih)
|
|
?> ?=({@ @ @ $~} t.pax)
|
|
%^ mo-boot i.t.t.t.pax
|
|
?:((~(has by bum) i.t.t.t.pax) %old %new)
|
|
[(slav %p i.t.pax) i.t.t.pax [%da now]]
|
|
::
|
|
$new
|
|
?> ?=({$f $made *} sih)
|
|
?> ?=({@ @ @ @ $~} t.pax)
|
|
(mo-boom i.t.pax (mo-chew t.t.pax) +>.sih)
|
|
::
|
|
$old :: reload old
|
|
?> ?=({$f $made *} sih)
|
|
?> ?=({@ @ @ @ $~} t.pax)
|
|
(mo-boon i.t.pax (mo-chew t.t.pax) +>.sih)
|
|
::
|
|
$pel :: translated peer
|
|
?> ?=({@ $~} t.pax)
|
|
=+ mar=i.t.pax
|
|
?> ?=({$f $made *} sih)
|
|
?- -.q.+.sih
|
|
$tabl ~|(%made-tabl !!)
|
|
$& (mo-give %unto %diff p.q.+>.sih)
|
|
$| =. p.q.+>.sih (turn p.q.+>.sih |=(a+tank rose#[~ "! " ~]^[a]~))
|
|
~> %slog.`%*(. >[%wh %y]< +> [>%mo-cyst-fail< (flop p.q.+>.sih)])
|
|
(mo-give %unto %quit ~) :: XX better errors pls
|
|
==
|
|
::
|
|
$red :: diff ack
|
|
?> ?=({@ @ @ $~} t.pax)
|
|
?. ?=({$a $woot *} sih)
|
|
~& [%red-went pax]
|
|
+>.$
|
|
=+ :* him=(slav %p i.t.pax)
|
|
dap=i.t.t.pax
|
|
num=(slav %ud i.t.t.t.pax)
|
|
==
|
|
=> .(pax `path`[%req t.pax])
|
|
?~ q.+>.sih
|
|
(mo-pass [%sys pax] %g %deal [him our] dap %pump ~)
|
|
~& [%diff-bad-ack q.+>.sih] :: should not happen
|
|
=. +>.$ (mo-pass [%sys pax] %g %deal [him our] dap %pull ~)
|
|
(mo-pass [%sys pax] %a %wont [our him] [%g %gh dap ~] [num %x ~])
|
|
::
|
|
$rep :: reverse request
|
|
?> ?=({@ @ @ $~} t.pax)
|
|
?> ?=({$f $made *} sih)
|
|
=+ :* him=(slav %p i.t.pax)
|
|
dap=i.t.t.pax
|
|
num=(slav %ud i.t.t.t.pax)
|
|
==
|
|
?- -.q.+>.sih
|
|
$tabl ~|(%made-tabl !!)
|
|
$| (mo-give %mack `p.q.+>.sih) :: XX should crash
|
|
$& =. +>.$ (mo-give %mack ~) :: XX pump should ack
|
|
(mo-give(hen (mo-ball him num)) %unto %diff `cage`p.q.+>.sih)
|
|
==
|
|
::
|
|
$req :: inbound request
|
|
?> ?=({@ @ @ $~} t.pax)
|
|
=+ :* him=(slav %p i.t.pax)
|
|
dap=i.t.t.pax
|
|
num=(slav %ud i.t.t.t.pax)
|
|
==
|
|
?: ?=({$f $made *} sih)
|
|
?- -.q.+>.sih
|
|
$tabl ~|(%made-tabl !!)
|
|
$| (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
|
|
?> ?=({$g $unto *} sih)
|
|
=+ cuf=`cuft`+>.sih
|
|
?- -.cuf
|
|
$coup (mo-give %mack p.cuf)
|
|
$diff %+ mo-pass [%sys %red t.pax]
|
|
[%a %wont [our him] [%g %gh dap ~] [num %d p.p.cuf q.q.p.cuf]]
|
|
$doff !!
|
|
$quit %+ mo-pass [%sys pax]
|
|
[%a %wont [our him] [%g %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 $went *} sih) :: XX AWFUL
|
|
~& %way-went-bug
|
|
?> ?=({@ $~} t.pax)
|
|
%- mo-awed
|
|
:* p.+>.sih
|
|
(?($peer $poke $pull) i.t.pax)
|
|
~
|
|
==
|
|
?> ?=({$a $woot *} sih)
|
|
?> ?=({@ $~} t.pax)
|
|
%- mo-awed
|
|
:* p.+>.sih
|
|
(?($peer $poke $pull) i.t.pax)
|
|
+>+.sih
|
|
==
|
|
==
|
|
::
|
|
++ mo-cook :: take in /use
|
|
|= {pax+path hin+(hypo sign-arvo)}
|
|
^+ +>
|
|
?. ?=({@ @ $?($inn $out $cay) *} pax)
|
|
~& [%mo-cook-bad-pax pax]
|
|
!!
|
|
=+ dap=`@tas`i.pax
|
|
=+ pry=`prey`[%high [~ (slav %p i.t.pax)]]
|
|
=+ pap=(ap-abed:ap dap pry)
|
|
=+ vax=(slot 3 `vase`hin)
|
|
?- i.t.t.pax
|
|
$inn ap-abet:(ap-pour:pap t.t.t.pax (slot 3 `vase`hin))
|
|
$cay ?. ?=({$e $sigh *} q.hin)
|
|
~& [%mo-cook-weird q.hin]
|
|
~& [%mo-cook-weird-path pax]
|
|
+>.$
|
|
ap-abet:(ap-purr:pap +<.q.hin t.t.t.pax +>.q.hin)
|
|
::
|
|
$out ?: ?=({$f $made *} q.hin)
|
|
?- -.q.+>.q.hin
|
|
$tabl ~|(%made-tabl !!)
|
|
$& ap-abet:(ap-pout:pap t.t.t.pax %diff +.q.+>.q.hin)
|
|
$|
|
|
=+ why=p.q.+>.q.hin
|
|
=. why (turn why |=(a+tank rose#[~ "! " ~]^[a]~))
|
|
~> %slog.`rose#[" " "[" "]"]^[>%mo-cook-fail< (flop why)]
|
|
~& [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 ~]
|
|
!!
|
|
==
|
|
?. ?=({$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]
|
|
ap-abet:(ap-pout:pap t.t.t.pax +>.q.hin)
|
|
==
|
|
::
|
|
++ mo-claw :: clear queue
|
|
|= dap+dude
|
|
^+ +>
|
|
?. (~(has by bum) dap) +>
|
|
=+ suf=(~(get by wub) dap)
|
|
?~ suf +>.$
|
|
|- ^+ +>.^$
|
|
?: =(~ kys.u.suf)
|
|
+>.^$(wub (~(del by wub) dap))
|
|
=^ lep kys.u.suf [p q]:~(get to kys.u.suf)
|
|
$(moz :_(moz [p.lep %slip %g %deal [q.q.q.lep our] dap r.lep]))
|
|
:: $(+>.^$ (mo-clip(hen p.lep) dap q.lep r.lep))
|
|
::
|
|
++ mo-beak :: build beak
|
|
|= dap+dude
|
|
=- ?.(=(p our) - -(r [%da now])) :: soft dependencies
|
|
^- 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 +.cub]
|
|
?: ?=($punk -.cub)
|
|
%+ mo-pass
|
|
[%sys %val (scot %p q.q.pry) dap ~]
|
|
[%f %exec our ~ (mo-beak dap) %cast p.cub %$ q.cub]
|
|
ap-abet:(ap-club:(ap-abed:ap dap pry) cub)
|
|
::
|
|
++ mo-club :: local action
|
|
|= {dap+dude pry+prey cub+club}
|
|
^+ +>
|
|
?: |(!(~(has by bum) dap) (~(has by wub) dap))
|
|
:: ~& [%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]))))
|
|
(mo-clip dap pry cub)
|
|
::
|
|
++ mo-gawk :: ames forward
|
|
|= {him+@p dap+dude num+@ud rok+rook}
|
|
=. +> ?.(?=($u -.rok) +> (mo-give %mack ~))
|
|
%+ mo-pass
|
|
[%sys %req (scot %p him) dap (scot %ud num) ~]
|
|
^- note-arvo
|
|
?- -.rok
|
|
:: %m [%f %exec our ~ (mo-beak dap) %vale p.rok 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}
|
|
=. +> (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
|
|
~% %gall-ap +> ~
|
|
|_ $: $: dap+dude
|
|
pry+prey
|
|
ost+bone
|
|
zip+(list cove)
|
|
dub+(list (each suss tang))
|
|
==
|
|
seat
|
|
==
|
|
::
|
|
++ ap-abed :: initialize
|
|
|= {dap+dude pry+prey}
|
|
^+ +>
|
|
=: ^dap dap
|
|
^pry pry
|
|
+>+<+ `seat`(~(got by bum) dap)
|
|
==
|
|
=+ unt=(~(get by q.zam) hen)
|
|
=: act.tyc +(act.tyc)
|
|
eny.tyc (shax (mix (add dap act.tyc) eny))
|
|
lat.tyc now
|
|
==
|
|
?^ unt
|
|
+>.$(ost u.unt)
|
|
%= +>.$
|
|
ost p.zam
|
|
p.zam +(p.zam)
|
|
q.zam (~(put by q.zam) hen p.zam)
|
|
r.zam (~(put by r.zam) p.zam hen)
|
|
==
|
|
::
|
|
++ ap-abet :: resolve
|
|
^+ +>
|
|
=> ap-abut
|
|
%_ +>
|
|
bum (~(put by bum) dap +<+)
|
|
moz :(weld (turn zip ap-aver) (turn dub ap-avid) moz)
|
|
==
|
|
::
|
|
++ ap-abut :: track queue
|
|
^+ .
|
|
=+ [pyz=zip ful=*(set bone)]
|
|
|- ^+ +>
|
|
?^ pyz
|
|
?. ?=({$give $diff *} q.i.pyz)
|
|
$(pyz t.pyz)
|
|
=^ vad +> ap-fill(ost p.i.pyz)
|
|
$(pyz t.pyz, ful ?:(vad ful (~(put in ful) p.i.pyz)))
|
|
=+ ded=(~(tap in ful) ~)
|
|
|- ^+ +>.^$
|
|
?~ ded +>.^$
|
|
=> %*(. $(ded t.ded) ost i.ded)
|
|
=+ tib=(~(get by sup.ged) ost)
|
|
?~ tib ~&([%ap-abut-bad-bone dap ost] ..ap-kill)
|
|
ap-kill(q.q.pry p.u.tib)
|
|
::
|
|
++ ap-aver :: cove to move
|
|
|= cov+cove
|
|
^- move
|
|
:- (~(got by r.zam) p.cov)
|
|
?- -.q.cov
|
|
?($slip $sick) !!
|
|
$give
|
|
?< =(0 p.cov)
|
|
?. ?=($diff -.p.q.cov)
|
|
[%give %unto p.q.cov]
|
|
=+ cay=`cage`p.p.q.cov
|
|
=+ mar=(fall (~(get by pyl) p.cov) p.cay)
|
|
?: =(mar p.cay) [%give %unto p.q.cov]
|
|
:+ %pass
|
|
[%sys %pel dap ~]
|
|
[%f %exec our ~ (mo-beak dap) %cast mar %$ cay]
|
|
::
|
|
$pass
|
|
:+ %pass `path`[%use dap p.q.cov]
|
|
?- -.q.q.cov
|
|
$hiss `note-arvo`[%e %hiss p.q.q.cov q.q.q.cov]
|
|
$send `note-arvo`[%g %deal [our p.q.q.cov] q.q.q.cov]
|
|
$meta `note-arvo`[`@tas`p.q.q.cov %meta `vase`q.q.q.cov]
|
|
==
|
|
==
|
|
::
|
|
++ ap-avid :: onto results
|
|
|=(a+(each suss tang) [hen %give %onto a])
|
|
::
|
|
++ ap-call :: call into server
|
|
~/ %ap-call
|
|
|= {cog+term arg+vase}
|
|
^- {(unit tang) _+>}
|
|
=. +> ap-bowl
|
|
=^ arm +>.$ (ap-farm cog)
|
|
?: ?=($| -.arm) [`p.arm +>.$]
|
|
=^ zem +>.$ (ap-slam cog p.arm arg)
|
|
?: ?=($| -.zem) [`p.zem +>.$]
|
|
(ap-sake p.zem)
|
|
::
|
|
++ ap-club :: apply effect
|
|
|= cub+club
|
|
^+ +>
|
|
?- -.cub
|
|
$peel (ap-peel +.cub)
|
|
$poke (ap-poke +.cub)
|
|
$peer (ap-peer +.cub)
|
|
$puff !!
|
|
$punk !!
|
|
$pull ap-pull
|
|
$pump ap-fall
|
|
==
|
|
::
|
|
++ ap-diff :: pour a diff
|
|
|= {her+ship pax+path cag+cage}
|
|
=. q.cag (spec q.cag)
|
|
=+ cug=(ap-find [%diff p.cag +.pax])
|
|
?~ cug
|
|
%. [| her +.pax]
|
|
ap-pump:(ap-lame %diff (ap-suck "diff: no {<`path`[p.cag +.pax]>}"))
|
|
=+ ^= arg ^- vase
|
|
%- slop
|
|
?: =(0 p.u.cug)
|
|
[!>(`path`+.pax) !>(cag)]
|
|
[!>((slag (dec p.u.cug) `path`+.pax)) q.cag]
|
|
=^ cam +>.$ (ap-call q.u.cug arg)
|
|
?^ cam
|
|
(ap-pump:(ap-lame q.u.cug u.cam) | her pax)
|
|
(ap-pump & her pax)
|
|
::
|
|
++ ap-pump :: update subscription
|
|
|= {oak+? her+ship pax+path}
|
|
=+ way=[(scot %p her) %out pax]
|
|
?: oak
|
|
(ap-pass way %send her -.pax %pump ~)
|
|
(ap-pass:(ap-give %quit ~) way %send her -.pax %pull ~)
|
|
::
|
|
++ ap-fall :: drop from queue
|
|
^+ .
|
|
?. (~(has by sup.ged) ost) .
|
|
=+ soy=(~(get by qel.ged) ost)
|
|
?: |(?=($~ soy) =(0 u.soy))
|
|
:: ~& [%ap-fill-under [our dap] q.q.pry ost]
|
|
+
|
|
=. u.soy (dec u.soy)
|
|
:: ~& [%ap-fill-sub [[our dap] q.q.pry ost] u.soy]
|
|
?: =(0 u.soy)
|
|
+(qel.ged (~(del by qel.ged) ost))
|
|
+(qel.ged (~(put by qel.ged) ost u.soy))
|
|
::
|
|
++ ap-farm :: produce arm
|
|
~/ %ap-farm
|
|
|= cog+term
|
|
^- {(each vase tang) _+>}
|
|
=+ pyz=(mule |.((~(mint wa vel) p.hav [%cnzy cog])))
|
|
?: ?=($| -.pyz)
|
|
:_(+>.$ [%| +.pyz])
|
|
:_ +>.$(vel `worm`+>.pyz)
|
|
=+ ton=(mock [q.hav q.+<.pyz] ap-sled)
|
|
?- -.ton
|
|
$0 [%& p.+<.pyz p.ton]
|
|
$1 [%| (turn p.ton |=(a+* (smyt (path a))))]
|
|
$2 [%| p.ton]
|
|
==
|
|
::
|
|
++ ap-fill :: add to queue
|
|
^- {? _.}
|
|
=+ suy=(fall (~(get by qel.ged) ost) 0)
|
|
?: =(20 suy)
|
|
:: ~& [%ap-fill-full [our dap] q.q.pry ost]
|
|
[%| +]
|
|
:: ~? !=(20 suy) [%ap-fill-add [[our dap] q.q.pry ost] +(suy)]
|
|
[%& +(qel.ged (~(put by qel.ged) ost +(suy)))]
|
|
::
|
|
++ ap-find :: general arm
|
|
|= {cog+term pax+path}
|
|
=+ dep=0
|
|
|- ^- (unit (pair @ud term))
|
|
=+ ^= spu
|
|
?~ pax ~
|
|
$(pax t.pax, dep +(dep), cog (ap-hype cog i.pax))
|
|
?^ spu spu
|
|
?.((ap-fond cog) ~ `[dep cog])
|
|
::
|
|
++ ap-fond :: check for arm
|
|
|= cog+term
|
|
^- ?
|
|
(slob cog p.hav)
|
|
::
|
|
++ ap-give :: return result
|
|
|= cit+cuft
|
|
^+ +>
|
|
+>(zip :_(zip [ost %give cit]))
|
|
::
|
|
++ ap-bowl :: set up bowl
|
|
%_ .
|
|
+12.q.hav
|
|
^- bowl
|
|
:* :* our :: host
|
|
q.q.pry :: guest
|
|
dap :: agent
|
|
== ::
|
|
:* wex=~ :: outgoing
|
|
sup=sup.ged :: incoming
|
|
== ::
|
|
:* ost=ost :: cause
|
|
act=act.tyc :: tick
|
|
eny=eny.tyc :: nonce
|
|
now=lat.tyc :: time
|
|
byk=byk :: source
|
|
== == ::
|
|
==
|
|
::
|
|
++ ap-hype :: hyphenate
|
|
|=({a+term b+term} `term`(cat 3 a (cat 3 '-' b)))
|
|
::
|
|
++ ap-move :: process each move
|
|
~/ %ap-move
|
|
|= vax+vase
|
|
^- {(each cove tang) _+>}
|
|
?@ q.vax :_(+>.$ [%| (ap-suck "move: invalid move (atom)")])
|
|
?^ -.q.vax :_(+>.$ [%| (ap-suck "move: invalid move (bone)")])
|
|
?@ +.q.vax :_(+>.$ [%| (ap-suck "move: invalid move (card)")])
|
|
=+ hun=(~(get by r.zam) -.q.vax)
|
|
?. (~(has by r.zam) -.q.vax)
|
|
:_(+>.$ [%| (ap-suck "move: invalid card (bone {<-.q.vax>})")])
|
|
=^ pec vel (~(spot wa vel) 3 vax)
|
|
=^ cav vel (~(slot wa vel) 3 pec)
|
|
?+ +<.q.vax
|
|
(ap-move-pass -.q.vax +<.q.vax cav)
|
|
$diff (ap-move-diff -.q.vax cav)
|
|
$hiss (ap-move-hiss -.q.vax cav)
|
|
$peer (ap-move-peer -.q.vax cav)
|
|
$pull (ap-move-pull -.q.vax cav)
|
|
$poke (ap-move-poke -.q.vax cav)
|
|
$send (ap-move-send -.q.vax cav)
|
|
$quit (ap-move-quit -.q.vax cav)
|
|
==
|
|
::
|
|
++ ap-move-quit :: give quit move
|
|
|= {sto+bone vax+vase}
|
|
^- {(each cove tang) _+>}
|
|
:_ +>
|
|
?^ q.vax [%| (ap-suck "quit: improper give")]
|
|
[%& `cove`[sto %give `cuft`[%quit ~]]]
|
|
::
|
|
++ ap-move-diff :: give diff move
|
|
|= {sto+bone vax+vase}
|
|
^- {(each cove tang) _+>}
|
|
=^ pec vel (~(spec wa vel) vax)
|
|
?. &(?=(^ q.pec) ?=(@ -.q.pec) ((sane %tas) -.q.pec))
|
|
:_(+>.$ [%| (ap-suck "diff: improper give")])
|
|
=^ tel vel (~(slot wa vel) 3 pec)
|
|
:_(+>.$ [%& sto %give %diff `cage`[-.q.pec tel]])
|
|
::
|
|
++ ap-move-hiss :: pass %hiss
|
|
|= {sto+bone vax+vase}
|
|
^- {(each cove tang) _+>}
|
|
?. &(?=({p+* q+@ q+^} q.vax) ((sane %tas) q.q.vax))
|
|
:_(+>.$ [%| (ap-suck "hiss: bad hiss ask.[%hiss wire mark cage]")])
|
|
=^ gaw vel (~(slot wa vel) 7 vax)
|
|
?. &(?=({p+@ q+^} q.gaw) ((sane %tas) p.q.gaw))
|
|
:_(+>.$ [%| (ap-suck "hiss: malformed cage")])
|
|
=+ pux=((soft path) p.q.vax)
|
|
?. &(?=(^ pux) (levy u.pux (sane %ta)))
|
|
:_(+>.$ [%| (ap-suck "hiss: malformed path")])
|
|
=^ paw vel (~(stop wa vel) 3 gaw)
|
|
:_ +>.$
|
|
:^ %& sto %pass
|
|
:- [(scot %p q.q.pry) %cay u.pux]
|
|
[%hiss q.q.vax [p.q.gaw paw]]
|
|
::
|
|
++ ap-move-mess :: extract path, target
|
|
|= vax+vase
|
|
^- {(each (trel path ship term) tang) _+>}
|
|
:_ +>.$
|
|
?. ?& ?=({p+* {q+@ r+@} s+*} q.vax)
|
|
(gte 1 (met 7 q.q.vax))
|
|
==
|
|
[%| (ap-suck "mess: malformed target")]
|
|
=+ pux=((soft path) p.q.vax)
|
|
?. &(?=(^ pux) (levy u.pux (sane %ta)))
|
|
[%| (ap-suck "mess: malformed path")]
|
|
[%& [(scot %p q.q.vax) %out r.q.vax u.pux] q.q.vax r.q.vax]
|
|
::
|
|
++ ap-move-pass :: pass general move
|
|
|= {sto+bone wut+* vax+vase}
|
|
^- {(each cove tang) _+>}
|
|
?. &(?=(@ wut) ((sane %tas) wut))
|
|
:_(+>.$ [%| (ap-suck "pass: malformed card")])
|
|
=+ pux=((soft path) -.q.vax)
|
|
?. &(?=(^ pux) (levy u.pux (sane %ta)))
|
|
:_(+>.$ [%| (ap-suck "pass: malformed path")])
|
|
=+ huj=(ap-vain wut)
|
|
?~ huj :_(+>.$ [%| (ap-suck "move: unknown note {(trip wut)}")])
|
|
=^ tel vel (~(slot wa vel) 3 vax)
|
|
:_ +>.$
|
|
:^ %& sto %pass
|
|
:- [(scot %p q.q.pry) %inn u.pux]
|
|
[%meta u.huj (slop (ap-term %tas wut) tel)]
|
|
::
|
|
++ ap-move-poke :: pass %poke
|
|
|= {sto+bone vax+vase}
|
|
^- {(each cove tang) _+>}
|
|
=^ yep +>.$ (ap-move-mess vax)
|
|
?: ?=($| -.yep) :_(+>.$ yep)
|
|
=^ gaw vel (~(slot wa vel) 7 vax)
|
|
?. &(?=({p+@ q+*} q.gaw) ((sane %tas) p.q.gaw))
|
|
:_(+>.$ [%| (ap-suck "poke: malformed cage")])
|
|
=^ paw vel (~(stop wa vel) 3 gaw)
|
|
:_ +>.$
|
|
:^ %& sto %pass
|
|
:- p.p.yep
|
|
[%send q.p.yep r.p.yep %poke p.q.gaw paw]
|
|
::
|
|
++ ap-move-peer :: pass %peer
|
|
|= {sto+bone vax+vase}
|
|
^- {(each cove tang) _+>}
|
|
=^ yep +>.$ (ap-move-mess vax)
|
|
:_ +>.$
|
|
?: ?=($| -.yep) yep
|
|
=+ pux=((soft path) +>.q.vax)
|
|
?. &(?=(^ pux) (levy u.pux (sane %ta)))
|
|
[%| (ap-suck "peer: malformed path")]
|
|
:^ %& sto %pass
|
|
:- p.p.yep
|
|
[%send q.p.yep r.p.yep %peer u.pux]
|
|
::
|
|
++ ap-move-pull :: pass %pull
|
|
|= {sto+bone vax+vase}
|
|
^- {(each cove tang) _+>}
|
|
=^ yep +>.$ (ap-move-mess vax)
|
|
:_ +>.$
|
|
?: ?=($| -.yep) yep
|
|
?. =(~ +>.q.vax)
|
|
[%| (ap-suck "pull: malformed card")]
|
|
:^ %& sto %pass
|
|
:- p.p.yep
|
|
[%send q.p.yep r.p.yep %pull ~]
|
|
::
|
|
++ ap-move-send :: pass gall action
|
|
|= {sto+bone vax+vase}
|
|
^- {(each cove tang) _+>}
|
|
?. ?& ?=({p+* {q+@ r+@} {s+@ t+*}} q.vax)
|
|
(gte 1 (met 7 q.q.vax))
|
|
((sane %tas) r.q.vax)
|
|
==
|
|
:_(+>.$ [%| (ap-suck "send: improper ask.[%send wire gill club]")])
|
|
=+ pux=((soft path) p.q.vax)
|
|
?. &(?=(^ pux) (levy u.pux (sane %ta)))
|
|
:_(+>.$ [%| (ap-suck "send: malformed path")])
|
|
?: ?=($poke s.q.vax)
|
|
=^ gav vel (~(spot wa vel) 7 vax)
|
|
?> =(%poke -.q.gav)
|
|
?. ?& ?=({p+@ q+*} t.q.vax)
|
|
((sane %tas) p.t.q.vax)
|
|
==
|
|
:_(+>.$ [%| (ap-suck "send: malformed poke")])
|
|
=^ vig vel (~(spot wa vel) 3 gav)
|
|
=^ geb vel (~(slot wa vel) 3 vig)
|
|
:_ +>.$
|
|
:^ %& sto %pass
|
|
:- [(scot %p q.q.vax) %out r.q.vax u.pux]
|
|
^- cote
|
|
:: ~& [%ap-move-send `path`[(scot %p q.q.vax) %out r.q.vax u.pux]]
|
|
[%send q.q.vax r.q.vax %poke p.t.q.vax geb]
|
|
:_ +>.$
|
|
=+ cob=((soft club) [s t]:q.vax)
|
|
?~ cob
|
|
[%| (ap-suck "send: malformed club")]
|
|
:^ %& sto %pass
|
|
:- [(scot %p q.q.vax) %out r.q.vax u.pux]
|
|
:: ~& [%ap-move-send `path`[(scot %p q.q.vax) %out r.q.vax u.pux]]
|
|
[%send q.q.vax r.q.vax u.cob]
|
|
::
|
|
++ ap-pass :: request action
|
|
|= {pax+path coh+cote}
|
|
^+ +>
|
|
+>(zip :_(zip [ost %pass pax coh]))
|
|
::
|
|
++ ap-peep :: reinstall
|
|
|= vax+vase
|
|
^+ +>
|
|
(ap-prep(hav vax) `hav)
|
|
::
|
|
++ ap-peel
|
|
|= {mar+mark pax+path}
|
|
=. pyl (~(put by pyl) ost mar)
|
|
(ap-peer pax)
|
|
::
|
|
++ ap-peer :: apply %peer
|
|
|= pax+path
|
|
^+ +>
|
|
=. +> (ap-peon pax)
|
|
=+ cug=(ap-find %peer pax)
|
|
?~ cug +>.$
|
|
=+ old=zip
|
|
=. zip ~
|
|
=^ cam +>.$
|
|
%+ ap-call q.u.cug
|
|
!>(`path`(slag p.u.cug pax))
|
|
=. zip (weld zip `(list cove)`[[ost %give %reap cam] old])
|
|
?^(cam ap-pule +>.$)
|
|
::
|
|
++ ap-peon :: add subscriber
|
|
|= pax+path
|
|
%_ +>.$
|
|
sup.ged (~(put by sup.ged) ost [q.q.pry pax])
|
|
==
|
|
::
|
|
++ ap-poke :: apply %poke
|
|
|= cag+cage
|
|
^+ +>
|
|
=+ cug=(ap-find %poke p.cag ~)
|
|
?~ cug
|
|
(ap-give %coup `(ap-suck "no poke arm for {(trip p.cag)}"))
|
|
:: ~& [%ap-poke dap p.cag cug]
|
|
=^ tur +>.$
|
|
%+ ap-call q.u.cug
|
|
?. =(0 p.u.cug) q.cag
|
|
(slop (ap-term %tas p.cag) q.cag)
|
|
(ap-give %coup tur)
|
|
::
|
|
++ ap-lame :: pour error
|
|
|= {wut+@tas why+tang}
|
|
^+ +>
|
|
=+ cug=(ap-find /lame)
|
|
?~ cug
|
|
=. why [>%ap-lame dap wut< (turn why |=(a+tank rose#[~ "! " ~]^[a]~))]
|
|
~> %slog.`rose#[" " "[" "]"]^(flop why)
|
|
+>.$
|
|
=^ cam +>.$
|
|
%+ ap-call q.u.cug
|
|
!>([wut why])
|
|
?^ cam
|
|
=. why [>%ap-lame-lame< (turn u.cam |=(a+tank rose#[~ "! " ~]^[a]~))]
|
|
~> %slog.`rose#[" " "[" "]"]^(welp (flop why) leaf#"." (flop u.cam))
|
|
+>.$
|
|
+>.$
|
|
::
|
|
++ ap-pour :: generic take
|
|
|= {pax+path vax+vase}
|
|
^+ +>
|
|
?. &(?=({@ *} q.vax) ((sane %tas) -.q.vax))
|
|
(ap-lame %pour (ap-suck "pour: malformed card"))
|
|
=+ cug=(ap-find [-.q.vax pax])
|
|
?~ cug
|
|
?: =(-.q.vax %went)
|
|
+>.$
|
|
(ap-lame -.q.vax (ap-suck "pour: no {(trip -.q.vax)}: {<pax>}"))
|
|
=^ tel vel (~(slot wa vel) 3 vax)
|
|
=^ cam +>.$
|
|
%+ ap-call q.u.cug
|
|
%+ slop
|
|
!>(`path`(slag p.u.cug pax))
|
|
tel
|
|
?^ cam (ap-lame -.q.vax u.cam)
|
|
+>.$
|
|
::
|
|
++ ap-purr :: unwrap take
|
|
|= {wha+term pax+path cag+cage}
|
|
^+ +>
|
|
=. q.cag (spec q.cag)
|
|
=+ cug=(ap-find [wha p.cag pax])
|
|
?~ cug
|
|
(ap-lame wha (ap-suck "{(trip wha)}: no {<`path`[p.cag pax]>}"))
|
|
=+ ^= arg ^- vase
|
|
%- slop
|
|
?: =(0 p.u.cug)
|
|
[!>(`path`pax) !>(cag)]
|
|
[!>((slag (dec p.u.cug) `path`pax)) q.cag]
|
|
=^ cam +>.$ (ap-call q.u.cug arg)
|
|
?^ cam (ap-lame q.u.cug u.cam)
|
|
+>.$
|
|
::
|
|
++ ap-pout :: specific take
|
|
|= {pax+path cuf+cuft}
|
|
^+ +>
|
|
?- -.cuf
|
|
$coup (ap-take q.q.pry %coup +.pax `!>(p.cuf))
|
|
$diff (ap-diff q.q.pry pax p.cuf)
|
|
$doff !!
|
|
$quit (ap-take q.q.pry %quit +.pax ~)
|
|
$reap (ap-take q.q.pry %reap +.pax `!>(p.cuf))
|
|
==
|
|
::
|
|
++ ap-prep :: install
|
|
|= vux+(unit vase)
|
|
^+ +>
|
|
=^ gac +>.$ (ap-prop vux)
|
|
%= +>.$
|
|
dub
|
|
:_(dub ?~(gac [%& dap ?~(vux %boot %bump) now] [%| u.gac]))
|
|
==
|
|
::
|
|
++ ap-prop :: install
|
|
|= vux+(unit vase)
|
|
^- {(unit tang) _+>}
|
|
?. (ap-fond %prep)
|
|
?~ vux
|
|
`+>.$
|
|
=+ [new=p:(slot 13 hav) old=p:(slot 13 u.vux)]
|
|
?. (~(nest ut p:(slot 13 hav)) %| p:(slot 13 u.vux))
|
|
:_(+>.$ `(ap-suck "prep mismatch"))
|
|
`+>.$(+13.q.hav +13.q.u.vux)
|
|
=^ tur +>.$
|
|
%+ ap-call %prep
|
|
?~(vux !>(~) (slop !>(~) (slot 13 u.vux)))
|
|
?~(tur `+>.$ :_(+>.$ `u.tur))
|
|
::
|
|
++ ap-pule :: silent delete
|
|
=+ wim=(~(get by sup.ged) ost)
|
|
?~ wim +
|
|
%_ +
|
|
sup.ged (~(del by sup.ged) ost)
|
|
qel.ged (~(del by qel.ged) ost)
|
|
==
|
|
::
|
|
++ ap-pull :: load delete
|
|
=+ wim=(~(get by sup.ged) ost)
|
|
?~ wim + :: ~&(%ap-pull-none +)
|
|
=: sup.ged (~(del by sup.ged) ost)
|
|
qel.ged (~(del by qel.ged) ost)
|
|
==
|
|
=+ cug=(ap-find %pull q.u.wim)
|
|
?~ cug +>
|
|
=^ cam +>
|
|
%+ ap-call q.u.cug
|
|
!>((slag p.u.cug q.u.wim))
|
|
?^ cam (ap-lame q.u.cug u.cam)
|
|
+>+
|
|
::
|
|
++ ap-kill :: queue kill
|
|
:: ~& [%ap-kill dap ost]
|
|
(ap-give:ap-pull %quit ~)
|
|
::
|
|
++ ap-take :: non-diff gall take
|
|
|= {her+ship cog+term pax+path vux+(unit vase)}
|
|
^+ +>
|
|
=+ cug=(ap-find cog pax)
|
|
?~ cug
|
|
:: ~& [%ap-take-none cog pax]
|
|
+>.$
|
|
=^ cam +>.$
|
|
%+ ap-call q.u.cug
|
|
=+ den=!>((slag p.u.cug pax))
|
|
?~(vux den (slop den u.vux))
|
|
?^ cam (ap-lame q.u.cug u.cam)
|
|
+>.$
|
|
::
|
|
++ ap-safe :: process move list
|
|
|= vax+vase
|
|
^- {(each (list cove) tang) _+>}
|
|
?~ q.vax :_(+>.$ [%& ~])
|
|
?@ q.vax :_(+>.$ [%| (ap-suck "move: malformed list")])
|
|
=^ hed vel (~(slot wa vel) 2 vax)
|
|
=^ sud +>.$ (ap-move hed)
|
|
?: ?=($| -.sud) :_(+>.$ sud)
|
|
=^ tel vel (~(slot wa vel) 3 vax)
|
|
=^ res +>.$ $(vax tel)
|
|
:_ +>.$
|
|
?: ?=($| -.res) res
|
|
[%& p.sud p.res]
|
|
::
|
|
++ ap-sake :: handle result
|
|
|= vax+vase
|
|
^- {(unit tang) _+>}
|
|
?: ?=(@ q.vax)
|
|
[`(ap-suck "sake: invalid product (atom)") +>.$]
|
|
=^ hed vel (~(slot wa vel) 2 vax)
|
|
=^ muz +>.$ (ap-safe hed)
|
|
?: ?=($| -.muz) [`p.muz +>.$]
|
|
=^ tel vel (~(slot wa vel) 3 vax)
|
|
=^ sav +>.$ (ap-save tel)
|
|
?: ?=($| -.sav) [`p.sav +>.$]
|
|
:- ~
|
|
%_ +>.$
|
|
zip (weld (flop p.muz) zip)
|
|
hav p.sav
|
|
==
|
|
::
|
|
++ ap-save :: verify core
|
|
|= vax+vase
|
|
^- {(each vase tang) _+>}
|
|
=^ gud vel (~(nest wa vel) p.hav p.vax)
|
|
:_ +>.$
|
|
?. gud
|
|
[%| (ap-suck "invalid core")]
|
|
[%& vax]
|
|
::
|
|
++ ap-mong
|
|
~/ %ap-mong
|
|
|= {{gat+* sam+*} sky+$+(* (unit))}
|
|
^- toon
|
|
(mong [gat sam] sky)
|
|
::
|
|
++ ap-slam :: virtual slam
|
|
~/ %ap-slam
|
|
|= {cog+term gat+vase arg+vase}
|
|
^- {(each vase tang) _+>}
|
|
=+ wyz=(mule |.((~(play wa vel) [%cell p.gat p.arg] [%cncl `2 `3])))
|
|
?: ?=($| -.wyz)
|
|
%- =+ sam=(~(peek ut p.gat) %free 6)
|
|
(slog >%ap-slam-mismatch< ~(duck ut p.arg) ~(duck ut sam) ~)
|
|
:_(+>.$ [%| (ap-suck "call: {<cog>}: type mismatch")])
|
|
:_ +>.$(vel +>.wyz)
|
|
=+ ton=(ap-mong [q.gat q.arg] ap-sled)
|
|
?- -.ton
|
|
$0 [%& +<.wyz p.ton]
|
|
$1 [%| (turn p.ton |=(a+* (smyt (path a))))]
|
|
$2 [%| p.ton]
|
|
==
|
|
::
|
|
++ ap-sled (mole (slod ska)) :: namespace view
|
|
++ ap-suck :: standard tang
|
|
|= msg+tape
|
|
^- tang
|
|
[%leaf (weld "gall: {<dap>}: " msg)]~
|
|
::
|
|
++ ap-term :: atomic vase
|
|
|= {a+@tas b+@}
|
|
^- vase
|
|
[[%cube b %atom a] b]
|
|
::
|
|
++ ap-vain :: card to vane
|
|
|= sep+@tas
|
|
^- (unit @tas)
|
|
?+ sep ~& [%ap-vain sep]
|
|
~
|
|
$cash `%a
|
|
$conf `%g
|
|
$deal `%g
|
|
$exec `%f
|
|
$flog `%d
|
|
$drop `%c
|
|
$info `%c
|
|
$merg `%c
|
|
$mont `%c
|
|
$ogre `%c
|
|
$them `%e
|
|
$wait `%b
|
|
$want `%a
|
|
$wont `%a :: XX for begin; remove
|
|
$warp `%c
|
|
==
|
|
--
|
|
--
|
|
++ call :: request
|
|
~% %gall-call +> ~
|
|
|= {hen+duct hic+(hypo (hobo kiss-gall))}
|
|
^+ [p=*(list move) q=..^$]
|
|
=> .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard kiss-gall) p.q.hic)))
|
|
?- -.q.hic
|
|
$conf
|
|
?. (~(has by pol.all) p.p.q.hic)
|
|
~& [%gall-not-ours p.p.q.hic]
|
|
[~ ..^$]
|
|
mo-abet:(mo-conf:(mo-abed:mo p.p.q.hic hen) q.p.q.hic q.q.hic)
|
|
::
|
|
$deal
|
|
=< mo-abet
|
|
?. (~(has by pol.all) q.p.q.hic) :: either to us
|
|
?> (~(has by pol.all) p.p.q.hic) :: or from us
|
|
(mo-away:(mo-abed:mo p.p.q.hic hen) q.p.q.hic q.q.hic)
|
|
(mo-come:(mo-abed:mo q.p.q.hic hen) p.p.q.hic q.q.hic)
|
|
::
|
|
$init
|
|
:: ~& [%gall-init p.q.hic]
|
|
[~ ..^$(pol.all (~(put by pol.all) p.q.hic [hen ~ ~ ~]))]
|
|
::
|
|
$west
|
|
?. (~(has by pol.all) p.p.q.hic)
|
|
~& [%gall-not-ours p.q.hic]
|
|
[~ ..^$]
|
|
?> ?=({?($ge $gh) @ $~} q.q.hic)
|
|
=+ dap=i.t.q.q.hic
|
|
=+ our=p.p.q.hic
|
|
=+ him=q.p.q.hic
|
|
?: ?=($ge i.q.q.hic)
|
|
=+ mes=((hard {@ud rook}) r.q.hic)
|
|
=< mo-abet
|
|
(mo-gawk:(mo-abed:mo our hen) him dap mes)
|
|
=+ mes=((hard {@ud roon}) r.q.hic)
|
|
=< mo-abet
|
|
(mo-gawd:(mo-abed:mo our hen) him dap mes)
|
|
::
|
|
$wegh
|
|
:_ ..^$ :_ ~
|
|
:^ hen %give %mass
|
|
:- %gall
|
|
:- %|
|
|
%- |= a+(list (list mass)) ^- (list mass) :: XX single-home
|
|
=+ a2=a
|
|
?~ a !!
|
|
?~ i.a ~
|
|
:_ $(a (turn a2 tail))
|
|
:- p.i.i.a
|
|
?~ -.q.i.i.a
|
|
[%& (turn (turn a2 head) |=(b+mass ?~(-.q.b p.q.b !!)))]
|
|
[%| $(a (turn (turn a2 head) |=(b+mass ?~(-.q.b !! p.q.b))))]
|
|
%+ turn (~(tap by pol.all))
|
|
|= {@ mast}
|
|
:~ foreign#`sap
|
|
blocked#[%| (sort :_(aor (~(tap by (~(run by wub) |=(sofa `+<))))))]
|
|
active#[%| (sort :_(aor (~(tap by (~(run by bum) |=(seat `+<))))))]
|
|
==
|
|
==
|
|
::
|
|
++ doze :: sleep until
|
|
|= {now+@da hen+duct}
|
|
^- (unit @da)
|
|
~
|
|
::
|
|
++ load :: recreate vane
|
|
|= old+axle-n
|
|
^+ ..^$
|
|
?: ?=($2 -.old) ..^$(all old)
|
|
%= $
|
|
old => |=(seat-1 `seat`[*worm +<])
|
|
=> |=(mast-1 +<(bum (~(run by bum) +>)))
|
|
old(- %2, pol (~(run by pol.old) .))
|
|
==
|
|
::
|
|
++ scry
|
|
|= {fur+(unit (set monk)) ren+@tas who+ship syd+desk lot+coin tyl+path}
|
|
^- (unit (unit (pair mark *)))
|
|
[~ ~]
|
|
::
|
|
++ stay :: save w#o cache
|
|
`axle`all
|
|
::
|
|
++ take :: response
|
|
|= {tea+wire hen+duct hin+(hypo sign-arvo)}
|
|
^+ [p=*(list move) q=..^$]
|
|
~| [%gall-take tea]
|
|
?> ?=({@ ?($sys $use) *} tea)
|
|
=+ our=(need (slaw %p i.tea))
|
|
=+ mow=(mo-abed:mo our hen)
|
|
?: ?=($sys i.t.tea)
|
|
mo-abet:(mo-cyst:mow t.t.tea q.hin)
|
|
?> ?=($use i.t.tea)
|
|
mo-abet:(mo-cook:mow t.t.tea hin)
|
|
--
|