shrub/arvo/gall.hoon

1274 lines
45 KiB
Plaintext
Raw Normal View History

2015-12-14 10:58:14 +03:00
:: :: %gall, agent execution
2015-05-10 01:55:05 +03:00
!? 163
::::
2015-12-20 23:50:45 +03:00
|= pit/vase
2015-05-10 01:55:05 +03:00
=> =~
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: rest of arvo
::::::::::::::::::::::::::::::::::::::::::::::::::::::
2015-12-07 20:23:58 +03:00
++ volt ?($low $high) :: voltage
2015-12-20 23:50:45 +03:00
++ torc $@(?($iron $gold) {$lead p/ship}) :: security control
2015-05-10 01:55:05 +03:00
++ roon :: reverse ames msg
2015-12-20 23:50:45 +03:00
$% {$d p/mark q/*} :: diff (diff)
2015-12-07 20:23:58 +03:00
{$x $~} ::
2015-05-10 01:55:05 +03:00
== ::
++ rook :: forward ames msg
2015-12-20 23:50:45 +03:00
$% {$m p/mark q/*} :: message
{$s p/path} :: subscribe
2015-12-21 00:16:39 +03:00
{$u $~} :: cancel+unsubscribe
2015-05-10 01:55:05 +03:00
== ::
-- ::
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: local arvo
::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ cote :: ++ap note
2015-12-20 23:50:45 +03:00
$% {$meta p/@tas q/vase} ::
{$send p/ship q/cush} ::
{$hiss p/mark q/cage}
2015-05-10 01:55:05 +03:00
== ::
++ cove (pair bone (mold cote cuft)) :: internal move
2015-12-26 13:07:50 +03:00
++ move {p/duct q/(mold note-arvo gift-arvo)} :: typed move
2015-05-10 01:55:05 +03:00
-- ::
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: %gall state
::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ axle-n ?(axle axle-1) :: upgrade path
2015-12-20 23:50:45 +03:00
++ axle-1 {$1 pol/(map ship mast-1)} ::
++ mast-1 ::
(cork mast |=(mast +<(bum (~(run by bum) seat-1)))) ::
++ seat-1 ::
(cork seat |=(seat +<+)) ::
2015-05-10 01:55:05 +03:00
++ axle :: all state
2015-12-14 10:58:14 +03:00
$: $2 :: state version
2015-12-20 23:50:45 +03:00
pol/(map ship mast) :: apps by ship
2015-05-10 01:55:05 +03:00
== ::
++ gest :: subscriber data
2015-12-20 23:50:45 +03:00
$: sup/bitt :: incoming subscribers
neb/boat :: outgoing subscribers
qel/(map bone @ud) :: queue meter
2015-05-10 01:55:05 +03:00
== ::
++ mast :: ship state
2015-12-20 23:50:45 +03:00
$: sys/duct :: system duct
sap/(map ship scad) :: foreign contacts
bum/(map dude seat) :: running agents
wub/(map dude sofa) :: waiting queue
2015-05-10 01:55:05 +03:00
== ::
++ ffuc :: new cuff
2015-12-20 23:50:45 +03:00
$: p/(unit (set ship)) :: disclosing to
q/ship :: attributed to
2015-05-10 01:55:05 +03:00
== ::
++ prey (pair volt ffuc) :: privilege
++ scad :: foreign connection
2015-12-20 23:50:45 +03:00
$: p/@ud :: index
q/(map duct @ud) :: by duct
r/(map @ud duct) :: by index
2015-05-10 01:55:05 +03:00
== ::
++ scar :: opaque input
2015-12-20 23:50:45 +03:00
$: p/@ud :: bone sequence
q/(map duct bone) :: by duct
r/(map bone duct) :: by bone
2015-05-10 01:55:05 +03:00
== ::
++ seat :: agent state
2015-12-20 23:50:45 +03:00
$: 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
2015-05-10 01:55:05 +03:00
== ::
++ sofa :: queue for blocked
2015-12-20 23:50:45 +03:00
$: kys/(qeu (trel duct prey club)) :: queued kisses
2015-05-10 01:55:05 +03:00
== ::
++ stic :: statistics
2015-12-20 23:50:45 +03:00
$: act/@ud :: change number
eny/@uvI :: entropy
lat/@da :: time
2015-05-10 01:55:05 +03:00
== ::
-- ::
:::::::::::::::::::::::::::::::::::::::::::::::::::::: vane header
::::::::::::::::::::::::::::::::::::::::::::::::::::::
. ==
2015-12-20 23:50:45 +03:00
=| all/axle :: all vane state
|= $: now/@da :: urban time
eny/@uvI :: entropy
ska/sled :: activate
2015-05-10 01:55:05 +03:00
== :: opaque core
~% %gall-top ..is ~
2015-05-10 01:55:05 +03:00
|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: state machine
::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ mo
~% %gall-mo +> ~
2015-12-20 23:50:45 +03:00
|_ $: $: our/@p
hen/duct
moz/(list move)
2015-05-10 01:55:05 +03:00
==
mast
==
++ mo-abed :: initialize
2015-12-20 23:50:45 +03:00
|= {our/@p hen/duct}
2015-05-10 01:55:05 +03:00
^+ +>
%_ +>
our our
hen hen
+<+ (~(got by pol.all) our)
==
::
++ mo-abet :: resolve to
2015-12-07 20:23:58 +03:00
^+ [*(list move) +>+]
2015-05-10 01:55:05 +03:00
:_ +>+(pol.all (~(put by pol.all) our +<+))
%- flop
%+ turn moz
2015-12-20 23:50:45 +03:00
|= a/move
2015-12-07 20:23:58 +03:00
?. ?=($pass -.q.a) a
2015-05-10 01:55:05 +03:00
[p.a %pass [(scot %p our) p.q.a] q.q.a]
::
++ mo-conf :: configure
2015-12-20 23:50:45 +03:00
|= {dap/dude lum/culm}
2015-12-21 00:16:39 +03:00
(mo-boot dap ?:((~(has by bum) dap) %old %new) p.p.lum q.p.lum da+now)
2015-05-10 01:55:05 +03:00
::
++ mo-pass :: standard pass
2015-12-20 23:50:45 +03:00
|= {pax/path noh/note-arvo}
2015-05-10 01:55:05 +03:00
%_(+> moz :_(moz [hen %pass pax noh]))
::
++ mo-give
2015-12-20 23:50:45 +03:00
|= git/gift-gall
2015-05-10 01:55:05 +03:00
%_(+> moz :_(moz [hen %give git]))
::
++ mo-okay :: valid agent core
2015-12-20 23:50:45 +03:00
|= vax/vase
2015-05-10 01:55:05 +03:00
^- ?
2015-05-30 02:47:38 +03:00
=+ bol=(slew 12 vax)
?~ bol |
(~(nest ut p.u.bol) %| -:!>(*bowl))
2015-05-10 01:55:05 +03:00
::
++ mo-boom :: complete new boot
2015-12-20 23:50:45 +03:00
|= {dap/dude byk/beak dep/@uvH gux/gage}
2015-05-10 01:55:05 +03:00
^+ +>
?- -.gux
2015-12-07 20:23:58 +03:00
$tabl ~|(%made-tabl !!)
$|
2015-06-04 23:47:49 +03:00
=. +> (mo-bold byk dap dep)
2015-05-18 06:51:17 +03:00
=. +> (mo-give %onto %| p.gux)
+>
$&
2015-05-10 01:55:05 +03:00
?> ?=(@ p.p.gux)
?. (mo-okay q.p.gux)
(mo-give %onto %| [%leaf "{<dap>}: bogus core"]~)
2015-06-04 23:47:49 +03:00
=. +> (mo-bold byk dap dep)
=. +> (mo-born dap byk q.p.gux)
2015-05-10 01:55:05 +03:00
=+ 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
2015-12-20 23:50:45 +03:00
|= {dap/dude byk/beak hav/vase}
2015-05-10 01:55:05 +03:00
=+ sat=*seat
%_ +>.$
bum
%+ ~(put by bum) dap
%_ sat
mom hen
2015-06-04 23:47:49 +03:00
byk byk
2015-05-10 01:55:05 +03:00
hav hav
p.zam 1
q.zam [[[~ ~] 0] ~ ~]
r.zam [[0 [~ ~]] ~ ~]
==
==
::
++ mo-boon :: complete old boot
2015-12-20 23:50:45 +03:00
|= {dap/dude byk/beak dep/@uvH gux/gage}
2015-05-10 01:55:05 +03:00
^+ +>
=+ sut=(~(get by bum) dap)
?~ sut
2015-05-10 01:55:05 +03:00
~& [%gall-old-boon dap]
+>.$
=. bum (~(put by bum) dap u.sut(byk byk))
=. +>.$ (mo-bold byk dap dep)
2015-05-10 01:55:05 +03:00
?- -.gux
2015-12-07 20:23:58 +03:00
$tabl ~|(%made-tabl !!)
$| (mo-give %onto %| p.gux)
$& ?> ?=(@ p.p.gux)
2015-12-07 20:23:58 +03:00
ap-abet:(ap-peep:(ap-abed:ap dap [%high [~ our]]) q.p.gux)
2015-05-10 01:55:05 +03:00
==
::
++ mo-bold :: wait for dep
2015-12-20 23:50:45 +03:00
|= {byk/beak dap/dude dep/@uvH}
2015-05-10 01:55:05 +03:00
^+ +>
2015-06-04 23:47:49 +03:00
%+ mo-pass [%sys %dep (scot %p p.byk) q.byk dap ~]
2015-12-01 02:52:18 +03:00
[%f %wasp our dep &]
2015-05-10 01:55:05 +03:00
::
++ mo-boot :: create ship
2015-12-20 23:50:45 +03:00
|= {dap/dude how/?($new $old) byk/beak}
2015-05-10 01:55:05 +03:00
^+ +>
2015-06-04 23:47:49 +03:00
:: ~& [%mo-boot dap how byk]
%+ mo-pass [%sys how dap (scot %p p.byk) q.byk (scot r.byk) ~]
2015-05-12 23:10:22 +03:00
^- note-arvo
2015-07-10 21:49:03 +03:00
[%f %exec our `[byk %core [byk [dap %ape ~]]]]
2015-05-10 01:55:05 +03:00
::
++ mo-away :: foreign request
2015-12-20 23:50:45 +03:00
|= {him/ship caz/cush} ::
2015-05-10 01:55:05 +03:00
^+ +>
:: ~& [%mo-away him caz]
2015-12-07 20:23:58 +03:00
?: ?=($pump -.q.caz)
2015-05-10 01:55:05 +03:00
::
:: 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
2015-12-07 20:23:58 +03:00
$peel !!
$poke [%m p.p.q.caz q.q.p.q.caz]
$pull [%u ~]
$puff !!
$punk !!
$peer [%s p.q.caz]
2015-05-10 01:55:05 +03:00
==
%+ mo-pass
[%sys %way -.q.caz ~]
2015-06-23 00:02:27 +03:00
`note-arvo`[%a %wont [our him] [%g %ge p.caz ~] [num roc]]
2015-05-10 01:55:05 +03:00
::
++ mo-baal :: error convert a
2015-12-20 23:50:45 +03:00
|= art/(unit ares)
2015-05-10 01:55:05 +03:00
^- ares
?~(art ~ ?~(u.art `[%blank ~] u.art))
::
++ mo-baba :: error convert b
2015-12-20 23:50:45 +03:00
|= ars/ares
2015-05-10 01:55:05 +03:00
^- (unit tang)
?~ ars ~
`[[%leaf (trip p.u.ars)] q.u.ars]
::
++ mo-awed :: foreign response
2015-12-20 23:50:45 +03:00
|= {him/ship why/?($peer $poke $pull) art/(unit ares)}
2015-05-10 01:55:05 +03:00
^+ +>
:: ~& [%mo-awed him why art]
=+ tug=(mo-baba (mo-baal art))
?- why
2015-12-07 20:23:58 +03:00
$peer (mo-give %unto %reap tug)
$poke (mo-give %unto %coup tug)
$pull +>.$
2015-05-10 01:55:05 +03:00
==
::
++ mo-bale :: assign outbone
2015-12-20 23:50:45 +03:00
|= him/ship
2015-12-15 01:21:10 +03:00
^- {@ud _+>}
2015-05-10 01:55:05 +03:00
=+ 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
2015-12-20 23:50:45 +03:00
|= {him/ship num/@ud}
2015-05-10 01:55:05 +03:00
^- duct
(~(got by r:(~(got by sap) him)) num)
::
++ mo-come :: handle locally
2015-12-20 23:50:45 +03:00
|= {her/ship caz/cush}
2015-05-10 01:55:05 +03:00
^+ +>
=+ pry=`prey`[%high [~ her]]
(mo-club p.caz pry q.caz)
::
++ mo-coup :: back from mo-away
2015-12-20 23:50:45 +03:00
|= {dap/dude him/ship cup/ares}
2015-05-10 01:55:05 +03:00
%^ mo-give %unto %coup
?~ cup ~
[~ `tang`[[%leaf (trip p.u.cup)] q.u.cup]]
::
2015-06-04 23:47:49 +03:00
++ mo-chew :: reverse build path
2015-12-20 23:50:45 +03:00
|= pax/path
2015-06-04 23:47:49 +03:00
^- beak
?> ?=({@ @ @ $~} pax)
2015-12-21 00:16:39 +03:00
[(slav %p i.pax) i.t.pax da+(slav %da i.t.t.pax)]
2015-06-04 23:47:49 +03:00
::
2015-05-10 01:55:05 +03:00
++ mo-cyst :: take in /sys
2015-12-20 23:50:45 +03:00
|= {pax/path sih/sign-arvo}
2015-05-10 01:55:05 +03:00
^+ +>
?+ -.pax !!
2015-12-07 20:23:58 +03:00
$dep :: update
?> ?=({$f $news *} sih)
?> ?=({@ @ @ $~} t.pax)
2015-05-23 20:03:02 +03:00
%^ mo-boot i.t.t.t.pax
?:((~(has by bum) i.t.t.t.pax) %old %new)
2015-06-04 23:47:49 +03:00
[(slav %p i.t.pax) i.t.t.pax [%da now]]
2015-05-10 01:55:05 +03:00
::
2015-12-07 20:23:58 +03:00
$new
?> ?=({$f $made *} sih)
?> ?=({@ @ @ @ $~} t.pax)
2015-06-04 23:47:49 +03:00
(mo-boom i.t.pax (mo-chew t.t.pax) +>.sih)
2015-05-10 01:55:05 +03:00
::
2015-12-07 20:23:58 +03:00
$old :: reload old
?> ?=({$f $made *} sih)
?> ?=({@ @ @ @ $~} t.pax)
2015-06-04 23:47:49 +03:00
(mo-boon i.t.pax (mo-chew t.t.pax) +>.sih)
2015-06-06 01:07:40 +03:00
::
2015-12-07 20:23:58 +03:00
$pel :: translated peer
?> ?=({@ $~} t.pax)
2015-06-25 02:57:17 +03:00
=+ mar=i.t.pax
2015-12-07 20:23:58 +03:00
?> ?=({$f $made *} sih)
2015-06-25 02:57:17 +03:00
?- -.q.+.sih
2015-12-07 20:23:58 +03:00
$tabl ~|(%made-tabl !!)
$& (mo-give %unto %diff p.q.+>.sih)
2015-12-21 00:16:39 +03:00
$| =. p.q.+>.sih (turn p.q.+>.sih |=(a/tank rose+[~ "! " ~]^[a]~))
2015-12-07 20:23:58 +03:00
~> %slog.`%*(. >[%wh %y]< +> [>%mo-cyst-fail< (flop p.q.+>.sih)])
(mo-give %unto %quit ~) :: XX better errors pls
2015-06-25 02:57:17 +03:00
==
2015-05-10 01:55:05 +03:00
::
2015-12-07 20:23:58 +03:00
$red :: diff ack
?> ?=({@ @ @ $~} t.pax)
?. ?=({$a $woot *} sih)
2015-09-01 20:38:21 +03:00
~& [%red-went pax]
+>.$
2015-05-10 01:55:05 +03:00
=+ :* 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 ~)
2015-06-23 00:02:27 +03:00
(mo-pass [%sys pax] %a %wont [our him] [%g %gh dap ~] [num %x ~])
2015-05-10 01:55:05 +03:00
::
2015-12-07 20:23:58 +03:00
$rep :: reverse request
?> ?=({@ @ @ $~} t.pax)
?> ?=({$f $made *} sih)
2015-05-10 01:55:05 +03:00
=+ :* him=(slav %p i.t.pax)
dap=i.t.t.pax
num=(slav %ud i.t.t.t.pax)
==
?- -.q.+>.sih
2015-12-07 20:23:58 +03:00
$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)
2015-05-10 01:55:05 +03:00
==
::
2015-12-07 20:23:58 +03:00
$req :: inbound request
?> ?=({@ @ @ $~} t.pax)
2015-05-10 01:55:05 +03:00
=+ :* him=(slav %p i.t.pax)
dap=i.t.t.pax
num=(slav %ud i.t.t.t.pax)
==
2015-12-07 20:23:58 +03:00
?: ?=({$f $made *} sih)
2015-05-10 01:55:05 +03:00
?- -.q.+>.sih
2015-12-07 20:23:58 +03:00
$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)
2015-05-10 01:55:05 +03:00
==
2015-12-07 20:23:58 +03:00
?: ?=({$a $woot *} sih) +>.$ :: quit ack, boring
?> ?=({$g $unto *} sih)
2015-05-10 01:55:05 +03:00
=+ cuf=`cuft`+>.sih
?- -.cuf
2015-12-07 20:23:58 +03:00
$coup (mo-give %mack p.cuf)
$diff %+ mo-pass [%sys %red t.pax]
2015-06-23 00:02:27 +03:00
[%a %wont [our him] [%g %gh dap ~] [num %d p.p.cuf q.q.p.cuf]]
2015-12-07 20:23:58 +03:00
$doff !!
$quit %+ mo-pass [%sys pax]
2015-06-23 00:02:27 +03:00
[%a %wont [our him] [%g %gh dap ~] [num %x ~]]
2015-12-07 20:23:58 +03:00
$reap (mo-give %mack p.cuf)
2015-05-10 01:55:05 +03:00
==
2015-06-05 07:14:07 +03:00
::
2015-12-07 20:23:58 +03:00
$val :: inbound validate
?> ?=({@ @ $~} t.pax)
2015-06-05 07:14:07 +03:00
=+ [him=(slav %p i.t.pax) dap=i.t.t.pax]
?> ?=({$f $made *} sih)
2015-06-05 07:14:07 +03:00
?- -.q.+>.sih
2015-12-07 20:23:58 +03:00
$tabl !!
$| (mo-give %unto %coup `p.q.+>.sih) :: XX invalid, crash
$& (mo-clip dap `prey`[%high ~ him] %poke p.q.sih)
2015-06-05 07:14:07 +03:00
==
2015-05-10 01:55:05 +03:00
::
$way :: outbound request
?: ?=({$a $went *} sih) :: XX AWFUL
2015-06-07 08:49:53 +03:00
~& %way-went-bug
?> ?=({@ $~} t.pax)
2015-06-07 08:49:53 +03:00
%- mo-awed
:* p.+>.sih
(?($peer $poke $pull) i.t.pax)
2015-06-07 08:49:53 +03:00
~
==
?> ?=({$a $woot *} sih)
?> ?=({@ $~} t.pax)
2015-05-10 01:55:05 +03:00
%- mo-awed
:* p.+>.sih
(?($peer $poke $pull) i.t.pax)
2015-05-10 01:55:05 +03:00
+>+.sih
==
==
::
++ mo-cook :: take in /use
2015-12-20 23:50:45 +03:00
|= {pax/path hin/(hypo sign-arvo)}
2015-05-10 01:55:05 +03:00
^+ +>
2015-12-14 10:58:14 +03:00
?. ?=({@ @ $?($inn $out $cay) *} pax)
2015-05-10 01:55:05 +03:00
~& [%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)
2015-05-28 01:34:01 +03:00
~& [%mo-cook-weird q.hin]
~& [%mo-cook-weird-path pax]
+>.$
2015-05-28 05:46:58 +03:00
ap-abet:(ap-purr:pap +<.q.hin t.t.t.pax +>.q.hin)
2015-05-28 01:34:01 +03:00
::
$out ?: ?=({$f $made *} q.hin)
2015-06-05 07:14:07 +03:00
?- -.q.+>.q.hin
$tabl ~|(%made-tabl !!)
$& ap-abet:(ap-pout:pap t.t.t.pax %diff +.q.+>.q.hin)
$|
=+ why=p.q.+>.q.hin
2015-12-21 00:16:39 +03:00
=. why (turn why |=(a/tank rose+[~ "! " ~]^[a]~))
~> %slog.`rose+[" " "[" "]"]^[>%mo-cook-fail< (flop why)]
2015-06-05 07:14:07 +03:00
~& [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)
2015-05-10 01:55:05 +03:00
~& [%mo-cook-weird q.hin]
~& [%mo-cook-weird-path pax]
+>.$
2015-12-07 20:23:58 +03:00
?: ?=($doff +>-.q.hin)
2015-06-05 07:14:07 +03:00
%+ mo-pass
[%use pax]
2015-07-10 21:49:03 +03:00
[%f %exec our ~ byk.pap %vale +.p.q.hin]
2015-05-10 01:55:05 +03:00
ap-abet:(ap-pout:pap t.t.t.pax +>.q.hin)
==
::
++ mo-claw :: clear queue
2015-12-20 23:50:45 +03:00
|= dap/dude
2015-05-10 01:55:05 +03:00
^+ +>
?. (~(has by bum) dap) +>
=+ suf=(~(get by wub) dap)
?~ suf +>.$
|- ^+ +>.^$
?: =(~ kys.u.suf)
+>.^$(wub (~(del by wub) dap))
2015-05-10 01:55:05 +03:00
=^ 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))
2015-05-10 01:55:05 +03:00
::
++ mo-beak :: build beak
2015-12-20 23:50:45 +03:00
|= dap/dude
=- ?.(=(p our) - -(r [%da now])) :: soft dependencies
2015-05-10 01:55:05 +03:00
^- beak
2015-06-04 23:47:49 +03:00
byk:(~(got by bum) dap)
2015-05-10 01:55:05 +03:00
::
2015-06-05 07:14:07 +03:00
++ mo-clip :: apply club
2015-12-20 23:50:45 +03:00
|= {dap/dude pry/prey cub/club}
2015-12-07 20:23:58 +03:00
?: ?=($puff -.cub)
2015-06-05 07:14:07 +03:00
%+ mo-pass
[%sys %val (scot %p q.q.pry) dap ~]
2015-07-10 21:49:03 +03:00
[%f %exec our ~ (mo-beak dap) %vale +.cub]
2015-12-07 20:23:58 +03:00
?: ?=($punk -.cub)
2015-06-06 01:07:40 +03:00
%+ mo-pass
[%sys %val (scot %p q.q.pry) dap ~]
2015-07-10 21:49:03 +03:00
[%f %exec our ~ (mo-beak dap) %cast p.cub %$ q.cub]
2015-06-05 07:14:07 +03:00
ap-abet:(ap-club:(ap-abed:ap dap pry) cub)
::
2015-05-10 01:55:05 +03:00
++ mo-club :: local action
2015-12-20 23:50:45 +03:00
|= {dap/dude pry/prey cub/club}
2015-05-10 01:55:05 +03:00
^+ +>
?: |(!(~(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]))))
2015-06-05 07:14:07 +03:00
(mo-clip dap pry cub)
2015-05-10 01:55:05 +03:00
::
++ mo-gawk :: ames forward
2015-12-20 23:50:45 +03:00
|= {him/@p dap/dude num/@ud rok/rook}
2015-12-07 20:23:58 +03:00
=. +> ?.(?=($u -.rok) +> (mo-give %mack ~))
2015-05-10 01:55:05 +03:00
%+ mo-pass
[%sys %req (scot %p him) dap (scot %ud num) ~]
2015-05-12 23:10:22 +03:00
^- note-arvo
2015-05-10 01:55:05 +03:00
?- -.rok
2015-07-10 21:49:03 +03:00
:: %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 ~]
2015-05-10 01:55:05 +03:00
==
::
++ mo-gawd :: ames backward
2015-12-20 23:50:45 +03:00
|= {him/@p dap/dude num/@ud ron/roon}
2015-06-05 07:14:07 +03:00
=. +> (mo-give %mack ~)
=. hen (mo-ball him num)
?- -.ron
$d (mo-give %unto %doff p.ron q.ron)
$x (mo-give %unto %quit ~)
2015-05-10 01:55:05 +03:00
==
::
++ ap :: agent engine
~% %gall-ap +> ~
2015-12-20 23:50:45 +03:00
|_ $: $: dap/dude
pry/prey
ost/bone
zip/(list cove)
dub/(list (each suss tang))
2015-05-10 01:55:05 +03:00
==
seat
==
::
++ ap-abed :: initialize
2015-12-20 23:50:45 +03:00
|= {dap/dude pry/prey}
2015-05-10 01:55:05 +03:00
^+ +>
=: ^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)
2015-05-10 01:55:05 +03:00
::
++ ap-aver :: cove to move
2015-12-20 23:50:45 +03:00
|= cov/cove
2015-05-10 01:55:05 +03:00
^- move
:- (~(got by r.zam) p.cov)
?- -.q.cov
?($slip $sick) !!
$give
2015-06-25 02:57:17 +03:00
?< =(0 p.cov)
2015-12-07 20:23:58 +03:00
?. ?=($diff -.p.q.cov)
2015-06-25 02:57:17 +03:00
[%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 ~]
2015-07-10 21:49:03 +03:00
[%f %exec our ~ (mo-beak dap) %cast mar %$ cay]
2015-06-25 02:57:17 +03:00
::
$pass
2015-05-10 01:55:05 +03:00
:+ %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]
2015-05-10 01:55:05 +03:00
==
==
::
++ ap-avid :: onto results
2015-12-20 23:50:45 +03:00
|=(a/(each suss tang) [hen %give %onto a])
2015-05-10 01:55:05 +03:00
::
++ ap-call :: call into server
~/ %ap-call
2015-12-20 23:50:45 +03:00
|= {cog/term arg/vase}
2015-12-15 01:21:10 +03:00
^- {(unit tang) _+>}
2015-06-25 02:57:17 +03:00
=. +> ap-bowl
=^ arm +>.$ (ap-farm cog)
2015-12-07 20:23:58 +03:00
?: ?=($| -.arm) [`p.arm +>.$]
=^ zem +>.$ (ap-slam cog p.arm arg)
2015-12-07 20:23:58 +03:00
?: ?=($| -.zem) [`p.zem +>.$]
2015-05-10 01:55:05 +03:00
(ap-sake p.zem)
::
++ ap-club :: apply effect
2015-12-20 23:50:45 +03:00
|= cub/club
2015-05-10 01:55:05 +03:00
^+ +>
?- -.cub
$peel (ap-peel +.cub)
$poke (ap-poke +.cub)
$peer (ap-peer +.cub)
$puff !!
$punk !!
$pull ap-pull
$pump ap-fall
2015-05-10 01:55:05 +03:00
==
::
++ ap-diff :: pour a diff
2015-12-20 23:50:45 +03:00
|= {her/ship pax/path cag/cage}
2015-05-10 01:55:05 +03:00
=. q.cag (spec q.cag)
2015-05-17 22:39:03 +03:00
=+ cug=(ap-find [%diff p.cag +.pax])
2015-05-10 01:55:05 +03:00
?~ cug
2015-05-17 22:39:03 +03:00
%. [| her +.pax]
2015-05-28 05:00:53 +03:00
ap-pump:(ap-lame %diff (ap-suck "diff: no {<`path`[p.cag +.pax]>}"))
2015-05-10 01:55:05 +03:00
=+ ^= arg ^- vase
%- slop
?: =(0 p.u.cug)
2015-05-28 09:51:32 +03:00
[!>(`path`+.pax) !>(cag)]
[!>((slag (dec p.u.cug) `path`+.pax)) q.cag]
2015-05-10 01:55:05 +03:00
=^ cam +>.$ (ap-call q.u.cug arg)
?^ cam
(ap-pump:(ap-lame q.u.cug u.cam) | her pax)
(ap-pump & her pax)
::
2015-05-17 22:39:03 +03:00
++ ap-pump :: update subscription
2015-12-20 23:50:45 +03:00
|= {oak/? her/ship pax/path}
2015-05-10 01:55:05 +03:00
=+ 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
^+ .
2015-05-14 02:31:13 +03:00
?. (~(has by sup.ged) ost) .
2015-05-10 01:55:05 +03:00
=+ soy=(~(get by qel.ged) ost)
?: |(?=($~ soy) =(0 u.soy))
2015-11-17 06:29:27 +03:00
:: ~& [%ap-fill-under [our dap] q.q.pry ost]
2015-05-10 01:55:05 +03:00
+
=. 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
2015-12-20 23:50:45 +03:00
|= cog/term
2015-12-15 01:21:10 +03:00
^- {(each vase tang) _+>}
2015-12-21 08:05:19 +03:00
=+ pyz=(mule |.((~(mint wa vel) p.hav [%limb cog])))
2015-12-07 20:23:58 +03:00
?: ?=($| -.pyz)
:_(+>.$ [%| +.pyz])
:_ +>.$(vel `worm`+>.pyz)
=+ ton=(mock [q.hav q.+<.pyz] ap-sled)
2015-05-10 01:55:05 +03:00
?- -.ton
$0 [%& p.+<.pyz p.ton]
2015-12-20 23:50:45 +03:00
$1 [%| (turn p.ton |=(a/* (smyt (path a))))]
$2 [%| p.ton]
2015-05-10 01:55:05 +03:00
==
::
++ ap-fill :: add to queue
2015-12-15 01:21:10 +03:00
^- {? _.}
2015-05-10 01:55:05 +03:00
=+ suy=(fall (~(get by qel.ged) ost) 0)
2015-05-15 02:27:45 +03:00
?: =(20 suy)
2015-11-03 01:16:29 +03:00
:: ~& [%ap-fill-full [our dap] q.q.pry ost]
2015-05-10 01:55:05 +03:00
[%| +]
2015-05-15 02:27:45 +03:00
:: ~? !=(20 suy) [%ap-fill-add [[our dap] q.q.pry ost] +(suy)]
2015-05-10 01:55:05 +03:00
[%& +(qel.ged (~(put by qel.ged) ost +(suy)))]
::
++ ap-find :: general arm
2015-12-20 23:50:45 +03:00
|= {cog/term pax/path}
2015-05-10 01:55:05 +03:00
=+ dep=0
|- ^- (unit (pair @ud term))
2015-05-10 01:55:05 +03:00
=+ ^= 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
2015-12-20 23:50:45 +03:00
|= cog/term
2015-05-10 01:55:05 +03:00
^- ?
(slob cog p.hav)
::
++ ap-give :: return result
2015-12-20 23:50:45 +03:00
|= cit/cuft
2015-05-10 01:55:05 +03:00
^+ +>
+>(zip :_(zip [ost %give cit]))
::
2015-05-28 05:00:53 +03:00
++ 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
2015-06-04 23:47:49 +03:00
byk=byk :: source
2015-05-28 05:00:53 +03:00
== == ::
==
::
2015-05-10 01:55:05 +03:00
++ ap-hype :: hyphenate
2015-12-20 23:50:45 +03:00
|=({a/term b/term} `term`(cat 3 a (cat 3 '-' b)))
2015-05-10 01:55:05 +03:00
::
++ ap-move :: process each move
~/ %ap-move
2015-12-20 23:50:45 +03:00
|= vax/vase
2015-12-15 01:21:10 +03:00
^- {(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)")])
2015-05-10 01:55:05 +03:00
=+ 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)
2015-05-10 01:55:05 +03:00
?+ +<.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)
2015-05-10 01:55:05 +03:00
==
::
++ ap-move-quit :: give quit move
2015-12-20 23:50:45 +03:00
|= {sto/bone vax/vase}
2015-12-15 01:21:10 +03:00
^- {(each cove tang) _+>}
:_ +>
2015-08-20 22:30:56 +03:00
?^ q.vax [%| (ap-suck "quit: improper give")]
[%& `cove`[sto %give `cuft`[%quit ~]]]
2015-05-10 01:55:05 +03:00
::
++ ap-move-diff :: give diff move
2015-12-20 23:50:45 +03:00
|= {sto/bone vax/vase}
2015-12-15 01:21:10 +03:00
^- {(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]])
2015-05-10 01:55:05 +03:00
::
2015-05-28 01:34:01 +03:00
++ ap-move-hiss :: pass %hiss
2015-12-20 23:50:45 +03:00
|= {sto/bone vax/vase}
2015-12-15 01:21:10 +03:00
^- {(each cove tang) _+>}
2015-12-20 23:50:45 +03:00
?. &(?=({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)
2015-12-20 23:50:45 +03:00
?. &(?=({p/@ q/^} q.gaw) ((sane %tas) p.q.gaw))
:_(+>.$ [%| (ap-suck "hiss: malformed cage")])
2015-05-28 01:34:01 +03:00
=+ pux=((soft path) p.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
:_(+>.$ [%| (ap-suck "hiss: malformed path")])
=^ paw vel (~(stop wa vel) 3 gaw)
:_ +>.$
2015-05-28 01:34:01 +03:00
:^ %& sto %pass
2015-05-28 05:46:58 +03:00
:- [(scot %p q.q.pry) %cay u.pux]
[%hiss q.q.vax [p.q.gaw paw]]
2015-05-28 01:34:01 +03:00
::
2015-05-10 01:55:05 +03:00
++ ap-move-mess :: extract path, target
2015-12-20 23:50:45 +03:00
|= vax/vase
2015-12-15 01:21:10 +03:00
^- {(each (trel path ship term) tang) _+>}
:_ +>.$
2015-12-20 23:50:45 +03:00
?. ?& ?=({p/* {q/@ r/@} s/*} q.vax)
2015-05-10 01:55:05 +03:00
(gte 1 (met 7 q.q.vax))
==
2015-08-20 22:30:56 +03:00
[%| (ap-suck "mess: malformed target")]
2015-05-10 01:55:05 +03:00
=+ pux=((soft path) p.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
2015-08-20 22:30:56 +03:00
[%| (ap-suck "mess: malformed path")]
2015-05-10 01:55:05 +03:00
[%& [(scot %p q.q.vax) %out r.q.vax u.pux] q.q.vax r.q.vax]
::
++ ap-move-pass :: pass general move
2015-12-20 23:50:45 +03:00
|= {sto/bone wut/* vax/vase}
2015-12-15 01:21:10 +03:00
^- {(each cove tang) _+>}
2015-05-10 01:55:05 +03:00
?. &(?=(@ wut) ((sane %tas) wut))
:_(+>.$ [%| (ap-suck "pass: malformed card")])
2015-05-10 01:55:05 +03:00
=+ pux=((soft path) -.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
:_(+>.$ [%| (ap-suck "pass: malformed path")])
2015-05-10 01:55:05 +03:00
=+ huj=(ap-vain wut)
?~ huj :_(+>.$ [%| (ap-suck "move: unknown note {(trip wut)}")])
=^ tel vel (~(slot wa vel) 3 vax)
:_ +>.$
2015-05-10 01:55:05 +03:00
:^ %& sto %pass
:- [(scot %p q.q.pry) %inn u.pux]
[%meta u.huj (slop (ap-term %tas wut) tel)]
2015-05-10 01:55:05 +03:00
::
++ ap-move-poke :: pass %poke
2015-12-20 23:50:45 +03:00
|= {sto/bone vax/vase}
2015-12-15 01:21:10 +03:00
^- {(each cove tang) _+>}
=^ yep +>.$ (ap-move-mess vax)
2015-12-07 20:23:58 +03:00
?: ?=($| -.yep) :_(+>.$ yep)
=^ gaw vel (~(slot wa vel) 7 vax)
2015-12-20 23:50:45 +03:00
?. &(?=({p/@ q/*} q.gaw) ((sane %tas) p.q.gaw))
:_(+>.$ [%| (ap-suck "poke: malformed cage")])
=^ paw vel (~(stop wa vel) 3 gaw)
:_ +>.$
2015-05-10 01:55:05 +03:00
:^ %& sto %pass
:- p.p.yep
[%send q.p.yep r.p.yep %poke p.q.gaw paw]
2015-05-10 01:55:05 +03:00
::
++ ap-move-peer :: pass %peer
2015-12-20 23:50:45 +03:00
|= {sto/bone vax/vase}
2015-12-15 01:21:10 +03:00
^- {(each cove tang) _+>}
=^ yep +>.$ (ap-move-mess vax)
:_ +>.$
2015-12-07 20:23:58 +03:00
?: ?=($| -.yep) yep
2015-05-10 01:55:05 +03:00
=+ 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
2015-12-20 23:50:45 +03:00
|= {sto/bone vax/vase}
2015-12-15 01:21:10 +03:00
^- {(each cove tang) _+>}
=^ yep +>.$ (ap-move-mess vax)
:_ +>.$
2015-12-07 20:23:58 +03:00
?: ?=($| -.yep) yep
2015-05-10 01:55:05 +03:00
?. =(~ +>.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
2015-12-20 23:50:45 +03:00
|= {sto/bone vax/vase}
2015-12-15 01:21:10 +03:00
^- {(each cove tang) _+>}
2015-12-20 23:50:45 +03:00
?. ?& ?=({p/* {q/@ r/@} {s/@ t/*}} q.vax)
2015-05-10 01:55:05 +03:00
(gte 1 (met 7 q.q.vax))
((sane %tas) r.q.vax)
==
:_(+>.$ [%| (ap-suck "send: improper ask.[%send wire gill club]")])
2015-05-10 01:55:05 +03:00
=+ pux=((soft path) p.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
:_(+>.$ [%| (ap-suck "send: malformed path")])
2015-12-07 20:23:58 +03:00
?: ?=($poke s.q.vax)
=^ gav vel (~(spot wa vel) 7 vax)
2015-05-10 01:55:05 +03:00
?> =(%poke -.q.gav)
2015-12-20 23:50:45 +03:00
?. ?& ?=({p/@ q/*} t.q.vax)
2015-05-10 01:55:05 +03:00
((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)
:_ +>.$
2015-05-10 01:55:05 +03:00
:^ %& 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]
:_ +>.$
2015-05-10 01:55:05 +03:00
=+ cob=((soft club) [s t]:q.vax)
?~ cob
2015-08-20 22:30:56 +03:00
[%| (ap-suck "send: malformed club")]
2015-05-10 01:55:05 +03:00
:^ %& 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
2015-12-20 23:50:45 +03:00
|= {pax/path coh/cote}
2015-05-10 01:55:05 +03:00
^+ +>
+>(zip :_(zip [ost %pass pax coh]))
::
++ ap-peep :: reinstall
2015-12-20 23:50:45 +03:00
|= vax/vase
2015-05-10 01:55:05 +03:00
^+ +>
(ap-prep(hav vax) `hav)
::
2015-06-25 02:57:17 +03:00
++ ap-peel
2015-12-20 23:50:45 +03:00
|= {mar/mark pax/path}
2015-06-25 02:57:17 +03:00
=. pyl (~(put by pyl) ost mar)
(ap-peer pax)
::
2015-05-10 01:55:05 +03:00
++ ap-peer :: apply %peer
2015-12-20 23:50:45 +03:00
|= pax/path
2015-05-10 01:55:05 +03:00
^+ +>
=. +> (ap-peon pax)
2015-05-10 01:55:05 +03:00
=+ cug=(ap-find %peer pax)
?~ cug +>.$
=+ old=zip
=. zip ~
2015-05-10 01:55:05 +03:00
=^ cam +>.$
%+ ap-call q.u.cug
2015-05-28 09:51:32 +03:00
!>(`path`(slag p.u.cug pax))
=. zip (weld zip `(list cove)`[[ost %give %reap cam] old])
?^(cam ap-pule +>.$)
2015-05-10 01:55:05 +03:00
::
++ ap-peon :: add subscriber
2015-12-20 23:50:45 +03:00
|= pax/path
2015-05-10 01:55:05 +03:00
%_ +>.$
sup.ged (~(put by sup.ged) ost [q.q.pry pax])
==
::
++ ap-poke :: apply %poke
2015-12-20 23:50:45 +03:00
|= cag/cage
2015-05-10 01:55:05 +03:00
^+ +>
=+ cug=(ap-find %poke p.cag ~)
?~ cug
2015-05-14 02:31:13 +03:00
(ap-give %coup `(ap-suck "no poke arm for {(trip p.cag)}"))
2015-05-10 01:55:05 +03:00
:: ~& [%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
2015-12-20 23:50:45 +03:00
|= {wut/@tas why/tang}
2015-05-10 01:55:05 +03:00
^+ +>
=+ cug=(ap-find /lame)
?~ cug
2015-12-21 00:16:39 +03:00
=. why [>%ap-lame dap wut< (turn why |=(a/tank rose+[~ "! " ~]^[a]~))]
~> %slog.`rose+[" " "[" "]"]^(flop why)
2015-05-10 01:55:05 +03:00
+>.$
=^ cam +>.$
%+ ap-call q.u.cug
2015-05-28 09:51:32 +03:00
!>([wut why])
2015-05-10 01:55:05 +03:00
?^ cam
2015-12-21 00:16:39 +03:00
=. why [>%ap-lame-lame< (turn u.cam |=(a/tank rose+[~ "! " ~]^[a]~))]
~> %slog.`rose+[" " "[" "]"]^(welp (flop why) leaf+"." (flop u.cam))
2015-06-24 01:59:48 +03:00
+>.$
2015-05-10 01:55:05 +03:00
+>.$
::
++ ap-pour :: generic take
2015-12-20 23:50:45 +03:00
|= {pax/path vax/vase}
2015-05-10 01:55:05 +03:00
^+ +>
?. &(?=({@ *} q.vax) ((sane %tas) -.q.vax))
2015-05-10 01:55:05 +03:00
(ap-lame %pour (ap-suck "pour: malformed card"))
=+ cug=(ap-find [-.q.vax pax])
?~ cug
2015-11-24 01:38:01 +03:00
?: =(-.q.vax %went)
+>.$
2015-05-10 01:55:05 +03:00
(ap-lame -.q.vax (ap-suck "pour: no {(trip -.q.vax)}: {<pax>}"))
=^ tel vel (~(slot wa vel) 3 vax)
2015-05-10 01:55:05 +03:00
=^ cam +>.$
%+ ap-call q.u.cug
%+ slop
2015-05-28 09:51:32 +03:00
!>(`path`(slag p.u.cug pax))
tel
2015-05-10 01:55:05 +03:00
?^ cam (ap-lame -.q.vax u.cam)
+>.$
::
2015-05-28 05:46:58 +03:00
++ ap-purr :: unwrap take
2015-12-20 23:50:45 +03:00
|= {wha/term pax/path cag/cage}
2015-05-28 01:34:01 +03:00
^+ +>
=. q.cag (spec q.cag)
2015-05-28 05:46:58 +03:00
=+ cug=(ap-find [wha p.cag pax])
2015-05-28 01:34:01 +03:00
?~ cug
2015-05-28 05:46:58 +03:00
(ap-lame wha (ap-suck "{(trip wha)}: no {<`path`[p.cag pax]>}"))
2015-05-28 01:34:01 +03:00
=+ ^= arg ^- vase
%- slop
?: =(0 p.u.cug)
2015-05-29 22:27:09 +03:00
[!>(`path`pax) !>(cag)]
[!>((slag (dec p.u.cug) `path`pax)) q.cag]
2015-05-28 01:34:01 +03:00
=^ cam +>.$ (ap-call q.u.cug arg)
?^ cam (ap-lame q.u.cug u.cam)
+>.$
::
2015-05-10 01:55:05 +03:00
++ ap-pout :: specific take
2015-12-20 23:50:45 +03:00
|= {pax/path cuf/cuft}
2015-05-10 01:55:05 +03:00
^+ +>
?- -.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))
2015-05-10 01:55:05 +03:00
==
::
++ ap-prep :: install
2015-12-20 23:50:45 +03:00
|= vux/(unit vase)
2015-05-10 01:55:05 +03:00
^+ +>
=^ gac +>.$ (ap-prop vux)
%= +>.$
dub
:_(dub ?~(gac [%& dap ?~(vux %boot %bump) now] [%| u.gac]))
==
::
++ ap-prop :: install
2015-12-20 23:50:45 +03:00
|= vux/(unit vase)
2015-12-15 01:21:10 +03:00
^- {(unit tang) _+>}
2015-05-10 01:55:05 +03:00
?. (ap-fond %prep)
?~ vux
`+>.$
=+ [new=p:(slot 13 hav) old=p:(slot 13 u.vux)]
2015-05-10 01:55:05 +03:00
?. (~(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
2015-05-10 01:55:05 +03:00
=+ wim=(~(get by sup.ged) ost)
2015-11-17 06:29:27 +03:00
?~ wim + :: ~&(%ap-pull-none +)
2015-05-10 01:55:05 +03:00
=: 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
2015-05-28 09:51:32 +03:00
!>((slag p.u.cug q.u.wim))
2015-05-10 01:55:05 +03:00
?^ cam (ap-lame q.u.cug u.cam)
+>+
::
++ ap-kill :: queue kill
2015-11-17 06:29:27 +03:00
:: ~& [%ap-kill dap ost]
2015-05-10 01:55:05 +03:00
(ap-give:ap-pull %quit ~)
::
2015-06-06 01:07:40 +03:00
++ ap-take :: non-diff gall take
2015-12-20 23:50:45 +03:00
|= {her/ship cog/term pax/path vux/(unit vase)}
2015-05-10 01:55:05 +03:00
^+ +>
=+ cug=(ap-find cog pax)
?~ cug
2015-11-17 06:29:27 +03:00
:: ~& [%ap-take-none cog pax]
2015-05-10 01:55:05 +03:00
+>.$
=^ cam +>.$
%+ ap-call q.u.cug
2015-05-28 09:51:32 +03:00
=+ den=!>((slag p.u.cug pax))
2015-05-10 01:55:05 +03:00
?~(vux den (slop den u.vux))
?^ cam (ap-lame q.u.cug u.cam)
+>.$
::
++ ap-safe :: process move list
2015-12-20 23:50:45 +03:00
|= vax/vase
2015-12-15 01:21:10 +03:00
^- {(each (list cove) tang) _+>}
?~ q.vax :_(+>.$ [%& ~])
?@ q.vax :_(+>.$ [%| (ap-suck "move: malformed list")])
=^ hed vel (~(slot wa vel) 2 vax)
=^ sud +>.$ (ap-move hed)
2015-12-07 20:23:58 +03:00
?: ?=($| -.sud) :_(+>.$ sud)
=^ tel vel (~(slot wa vel) 3 vax)
=^ res +>.$ $(vax tel)
:_ +>.$
2015-12-07 20:23:58 +03:00
?: ?=($| -.res) res
2015-05-10 01:55:05 +03:00
[%& p.sud p.res]
::
++ ap-sake :: handle result
2015-12-20 23:50:45 +03:00
|= vax/vase
2015-12-15 01:21:10 +03:00
^- {(unit tang) _+>}
2015-05-10 01:55:05 +03:00
?: ?=(@ q.vax)
[`(ap-suck "sake: invalid product (atom)") +>.$]
=^ hed vel (~(slot wa vel) 2 vax)
=^ muz +>.$ (ap-safe hed)
2015-12-07 20:23:58 +03:00
?: ?=($| -.muz) [`p.muz +>.$]
=^ tel vel (~(slot wa vel) 3 vax)
=^ sav +>.$ (ap-save tel)
2015-12-07 20:23:58 +03:00
?: ?=($| -.sav) [`p.sav +>.$]
2015-05-10 01:55:05 +03:00
:- ~
%_ +>.$
zip (weld (flop p.muz) zip)
hav p.sav
==
::
++ ap-save :: verify core
2015-12-20 23:50:45 +03:00
|= vax/vase
2015-12-15 01:21:10 +03:00
^- {(each vase tang) _+>}
=^ gud vel (~(nest wa vel) p.hav p.vax)
:_ +>.$
?. gud
2015-05-10 01:55:05 +03:00
[%| (ap-suck "invalid core")]
[%& vax]
::
++ ap-mong
~/ %ap-mong
2015-12-20 23:50:45 +03:00
|= {{gat/* sam/*} sky/$+(* (unit))}
^- toon
(mong [gat sam] sky)
::
2015-05-10 01:55:05 +03:00
++ ap-slam :: virtual slam
~/ %ap-slam
2015-12-20 23:50:45 +03:00
|= {cog/term gat/vase arg/vase}
2015-12-15 01:21:10 +03:00
^- {(each vase tang) _+>}
=+ wyz=(mule |.((~(play wa vel) [%cell p.gat p.arg] [%cncl `2 `3])))
2015-12-07 20:23:58 +03:00
?: ?=($| -.wyz)
2015-05-30 02:47:38 +03:00
%- =+ sam=(~(peek ut p.gat) %free 6)
2015-07-28 01:39:36 +03:00
(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)
2015-05-10 01:55:05 +03:00
?- -.ton
$0 [%& +<.wyz p.ton]
2015-12-20 23:50:45 +03:00
$1 [%| (turn p.ton |=(a/* (smyt (path a))))]
$2 [%| p.ton]
2015-05-10 01:55:05 +03:00
==
::
++ ap-sled (mole (slod ska)) :: namespace view
++ ap-suck :: standard tang
2015-12-20 23:50:45 +03:00
|= msg/tape
2015-05-10 01:55:05 +03:00
^- tang
[%leaf (weld "gall: {<dap>}: " msg)]~
::
++ ap-term :: atomic vase
2015-12-20 23:50:45 +03:00
|= {a/@tas b/@}
2015-05-10 01:55:05 +03:00
^- vase
[[%cube b %atom a] b]
::
++ ap-vain :: card to vane
2015-12-20 23:50:45 +03:00
|= sep/@tas
^- (unit @tas)
2015-05-10 01:55:05 +03:00
?+ 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
2015-05-10 01:55:05 +03:00
==
--
--
++ call :: request
~% %gall-call +> ~
2015-12-20 23:50:45 +03:00
|= {hen/duct hic/(hypo (hobo kiss-gall))}
^+ [p=*(list move) q=..^$]
2015-12-07 20:23:58 +03:00
=> .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard kiss-gall) p.q.hic)))
2015-05-10 01:55:05 +03:00
?- -.q.hic
$conf
2015-05-10 01:55:05 +03:00
?. (~(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
2015-05-10 01:55:05 +03:00
=< 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
2015-06-06 01:07:40 +03:00
:: ~& [%gall-init p.q.hic]
2015-05-10 01:55:05 +03:00
[~ ..^$(pol.all (~(put by pol.all) p.q.hic [hen ~ ~ ~]))]
::
$west
2015-05-10 01:55:05 +03:00
?. (~(has by pol.all) p.p.q.hic)
~& [%gall-not-ours p.q.hic]
[~ ..^$]
?> ?=({?($ge $gh) @ $~} q.q.hic)
2015-06-23 00:02:27 +03:00
=+ dap=i.t.q.q.hic
2015-05-10 01:55:05 +03:00
=+ our=p.p.q.hic
=+ him=q.p.q.hic
2015-12-07 20:23:58 +03:00
?: ?=($ge i.q.q.hic)
=+ mes=((hard {@ud rook}) r.q.hic)
2015-06-23 00:02:27 +03:00
=< mo-abet
(mo-gawk:(mo-abed:mo our hen) him dap mes)
=+ mes=((hard {@ud roon}) r.q.hic)
2015-05-10 01:55:05 +03:00
=< mo-abet
(mo-gawd:(mo-abed:mo our hen) him dap mes)
2015-05-19 04:16:32 +03:00
::
$wegh
2015-05-19 04:16:32 +03:00
:_ ..^$ :_ ~
:^ hen %give %mass
:- %gall
:- %|
2015-12-20 23:50:45 +03:00
%- |= 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
2015-12-20 23:50:45 +03:00
[%& (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}
2015-12-21 00:16:39 +03:00
:~ foreign+`sap
blocked+[%| (sort :_(aor (~(tap by (~(run by wub) |=(sofa `+<))))))]
active+[%| (sort :_(aor (~(tap by (~(run by bum) |=(seat `+<))))))]
2015-05-19 04:16:32 +03:00
==
2015-05-10 01:55:05 +03:00
==
::
++ doze :: sleep until
2015-12-20 23:50:45 +03:00
|= {now/@da hen/duct}
^- (unit @da)
2015-05-10 01:55:05 +03:00
~
::
++ load :: recreate vane
2015-12-20 23:50:45 +03:00
|= old/axle-n
2015-05-10 01:55:05 +03:00
^+ ..^$
2015-12-07 20:23:58 +03:00
?: ?=($2 -.old) ..^$(all old)
2015-06-25 02:57:17 +03:00
%= $
old => |=(seat-1 `seat`[*worm +<])
=> |=(mast-1 +<(bum (~(run by bum) +>)))
old(- %2, pol (~(run by pol.old) .))
2015-06-25 02:57:17 +03:00
==
2015-05-10 01:55:05 +03:00
::
++ scry
2015-12-20 23:50:45 +03:00
|= {fur/(unit (set monk)) ren/@tas who/ship syd/desk lot/coin tyl/path}
^- (unit (unit (pair mark *)))
2015-05-10 01:55:05 +03:00
[~ ~]
::
2015-12-21 00:16:39 +03:00
++ stay :: save w+o cache
2015-05-10 01:55:05 +03:00
`axle`all
::
++ take :: response
2015-12-20 23:50:45 +03:00
|= {tea/wire hen/duct hin/(hypo sign-arvo)}
^+ [p=*(list move) q=..^$]
2015-05-10 01:55:05 +03:00
~| [%gall-take tea]
?> ?=({@ ?($sys $use) *} tea)
2015-05-10 01:55:05 +03:00
=+ our=(need (slaw %p i.tea))
=+ mow=(mo-abed:mo our hen)
2015-12-07 20:23:58 +03:00
?: ?=($sys i.t.tea)
2015-05-10 01:55:05 +03:00
mo-abet:(mo-cyst:mow t.t.tea q.hin)
2015-12-07 20:23:58 +03:00
?> ?=($use i.t.tea)
2015-05-10 01:55:05 +03:00
mo-abet:(mo-cook:mow t.t.tea hin)
--