:::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: :::::: :::::: Postface :::::: :::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: ~> %slog.[0 leaf+"%arvo-assembly"] =- ~> %slog.[0 leaf+"%arvo-assembled"] - =< :: :: Arvo formal interface :: :: this lifecycle wrapper makes the arvo door (multi-armed core) :: look like a gate (function or single-armed core), to fit :: urbit's formal lifecycle function. a practical interpreter :: can ignore it. :: |= [now=@da ovo=*] ^- * ~> %slog.[0 leaf+"arvo-event"] .(+> +:(poke now ovo)) :::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: :::::: :::::: volume 3, Arvo models and skeleton :::::: :::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: => |% ++ arch {fil/(unit @uvI) dir/(map @ta $~)} :: fundamental node ++ arvo (wind {p/term q/mill} mill) :: arvo card ++ beam {{p/ship q/desk r/case} s/path} :: global name ++ beak {p/ship q/desk r/case} :: garnish with beak ++ bone @ud :: opaque duct ++ case :: version $% {$da p/@da} :: date {$tas p/@tas} :: label {$ud p/@ud} :: sequence == :: ++ desk @tas :: ship desk case spur ++ dock (pair @p term) :: message target ++ cage (cask vase) :: global metadata ++ cask |*(a/mold (pair mark a)) :: global data ++ curd {p/@tas q/*} :: typeless card ++ duct (list wire) :: causal history ++ hypo |*(a/mold (pair type a)) :: type associated ++ hobo |* a/mold :: kiss wrapper $? $% {$soft p/*} :: == :: a :: == :: ++ mark @tas :: content type ++ mash |=(* (mass +<)) :: producing mass ++ mass $~ [%$ [%& ~]] :: memory usage (pair cord (each noun (list mash))) :: ++ mill (each vase milt) :: vase+metavase ++ milt {p/* q/*} :: metavase ++ monk (each ship {p/@tas q/@ta}) :: general identity ++ muse {p/@tas q/duct r/arvo s/@ud} :: sourced move ++ move {p/duct q/arvo} :: arvo move ++ ovum {p/wire q/curd} :: typeless ovum ++ pane (list {p/@tas q/vase}) :: kernel modules ++ pone (list {p/@tas q/vise}) :: kernel modules old +$ scry-sample [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path] +$ vane-sample [our=ship now=@da eny=@uvJ ski=slyd] ++ ship @p :: network identity ++ sink (trel bone ship path) :: subscription ++ sley $- {* (unit (set monk)) term beam} :: namespace function (unit (unit cage)) :: ++ slyd $~ =>(~ |~(* ~)) :: super advanced $- {* (unit (set monk)) term beam} :: (unit (unit (cask milt))) :: ++ slyt $-({* *} (unit (unit))) :: old namespace +$ vane [=vase =worm] ++ vile :: reflexive constants $: typ/type :: -:!>(*type) duc/type :: -:!>(*duct) pah/type :: -:!>(*path) mev/type :: -:!>([%meta *vase]) == :: ++ wind :: new kernel action |* {a/mold b/mold} :: forward+reverse $% {$pass p/path q/a} :: advance {$slip p/a} :: lateral {$give p/b} :: retreat == :: ++ wire path :: event pretext -- => ~% %hex +> ~ |% :::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: section 3bE, Arvo core :: :: ++ sloy :: +sloy: adapter from old style scrys to new style scrys :: :: This does path parsing which shows up hot, but removing the last +slay :: here requires deeper interface changes. :: !: ~/ %sloy |= sod/slyd ^- slyt |= {ref/* raw/*} =+ pux=((soft path) raw) ?~ pux ~ ?. ?=({@ @ @ @ *} u.pux) ~ =+ :* hyr=(slaw %tas i.u.pux) fal=(slaw %p i.t.u.pux) dyc=(slaw %tas i.t.t.u.pux) ved=(slay i.t.t.t.u.pux) tyl=t.t.t.t.u.pux == ?~ hyr ~ ?~ fal ~ ?~ dyc ~ ?. ?=(^ ved) ~ =/ ron=@tas u.hyr =/ bed=beam [[u.fal u.dyc (case p.u.ved)] (flop tyl)] =/ bop=(unit (unit (cask milt))) (sod ref ~ ron bed) ?~ bop ~ ?~ u.bop [~ ~] :: XX figure out wth to do about hoon-version :: ?. ?& ?=([?(%151 %141) *] ref) -:(~(nets wa *worm) +.ref -.q.u.u.bop) == ~>(%slog.[0 leaf+"arvo: scry-lost"] ~) [~ ~ +.q.u.u.bop] :: +sloy-light: minimal parsing version of sloy :: :: There are several places inside vanes where we manually call the scry :: function raw, instead of passing it into +mink. In those cases, we're :: paying the price to render the arguments as text, and then are :: immediately parsing the passed in data. We can avoid that. :: :: TODO: The entire scrying system needs to be cleaned up in a more :: permanent way. This hack fixes up some print/parse costs, but doesn't :: recover the print/parse costs of the scry itself, which we could prevent :: if we didn't send (list @ta), but instead sent (list dime). :: ++ sloy-light ~/ %sloy-light |= sod/slyd |= [ref=* ron=@tas fal=@p dyc=@tas ved=case tyl=path] :: we do not flop tyl because tyl wouldn't have been flopped by +en-beam :: =/ bed=beam [[fal dyc ved] tyl] =/ bop=(unit (unit (cask milt))) (sod ref ~ ron bed) ?~ bop ~ ?~ u.bop [~ ~] :: XX figure out wth to do about hoon-version :: ?. ?& ?=([?(%151 %141) *] ref) -:(~(nets wa *worm) +.ref -.q.u.u.bop) == ~>(%slog.[0 leaf+"arvo: scry-dark"] ~) [~ ~ +.q.u.u.bop] :: |part: arvo structures and engines :: ++ part => |% :: $wind: kernel action :: :: note: a routed $task :: gift: a reverse action :: :: NB: :: task: a forward action :: sign: a sourced $gift :: ++ wind |$ [note gift] :: forward+reverse $% [%pass =wire =note] :: advance [%slip =note] :: lateral [%give =gift] :: retreat == :: +$ ball (wind [vane=term task=mill] mill) +$ card (cask) :: +$ germ [vane=term depth=@ud] +$ maze (pair) :: metavase +$ mill (each vase maze) :: vase or metavase +$ ovum [=wire =card] +$ plan (pair germ (list move)) :: +$ move [=duct =ball] +$ vane [=vase =worm] -- :: ~% %part +> ~ |% :: +| %utilities :: XX replace +slam:wa ? :: ++ slur |= [sac=worm gat=vase sam=mill] ^- [vase worm] =^ cur sac (~(slot wa sac) 6 gat) =^ hig sac ?- -.sam %& (~(nest wa sac) p.cur p.p.sam) %| (~(nets wa sac) p.cur p.p.sam) == ?> hig (~(slym wa sac) gat q.p.sam) :: +slid: cons a vase onto a mill XX where :: ++ slid |= [hed=vase tal=mill] ^- mill ?- -.tal %& [%& (slop hed p.tal)] %| [%| [%cell p.hed p.p.tal] [q.hed q.p.tal]] == :: +slix: en-hypo XX remove :: ++ slix |= hil=mill ^- mill =/ typ -:!>(*type) ?- -.hil %& [%& (slop [typ p.p.hil] p.hil)] %| [%| [%cell typ p.p.hil] p.hil] == :: +| %engines :: :: |me: dynamic analysis :: ++ me ~/ %me |_ :: sac: compiler cache :: pyt: type of type :: [sac=worm pyt=type] :: +refine-moves: move list from vase (was +said) :: ++ refine-moves |= vax=vase ^- (pair (list move) worm) ?: =(~ q.vax) [~ sac] =^ hed sac (~(slot wa sac) 2 vax) =^ tal sac (~(slot wa sac) 3 vax) =^ mov sac (refine-move hed) =^ moz sac $(vax tal) [[mov moz] sac] :: +refine-move: move from vase (was in +sump) :: ++ refine-move |= vax=vase ^- (pair move worm) ~> %mean.'bad-move' =^ hip sac (~(nell wa sac) p.vax) ?. hip ~>(%mean.'not a cell' !!) =/ duc ~> %mean.'bad-duct' :: XX used to be a nest-check and clam, seemed excessive :: ;;(duct -.q.vax) :: :: yat: specialized ball vase :: =^ yat sac (~(spot wa sac) 3 vax) =^ del sac (refine-ball yat) [[duc del] sac] :: +refine-ball: ball from vase (was in +sump) :: ++ refine-ball |= vax=vase ^- (pair ball worm) ?+ q.vax ~> %mean.'bad-ball' ~_ (sell vax) !! :: [%give card] :: yed: vase containing card :: hil: card as mill :: =^ yed sac (~(spot wa sac) 3 vax) =^ hil sac (refine-card yed) [[%give hil] sac] :: [%pass wire=* vane=term card] =/ =wire ~> %mean.'bad-wire' :: XX used to be a nest-check and clam, seemed excessive :: ;;(wire wire.q.vax) =/ vane ~> %mean.'bad-vane-label' ?> ((sane %tas) vane.q.vax) vane.q.vax :: :: yed: vase containing card :: hil: card as mill :: =^ xav sac (~(spot wa sac) 7 vax) =^ yed sac (~(spot wa sac) 3 xav) =^ hil sac (refine-card yed) [[%pass wire vane hil] sac] :: [%slip vane=term card] :: XX remove :: =/ vane ~> %mean.'bad-vane-label' ?> ((sane %tas) vane.q.vax) vane.q.vax :: :: yed: vase containing card :: hil: card as mill :: =^ xav sac (~(spot wa sac) 3 vax) =^ yed sac (~(spot wa sac) 3 xav) =^ hil sac (refine-card yed) [[%slip vane hil] sac] == :: +refine-card: card from vase (was +song) :: ++ refine-card |= vax=vase ^- (pair mill worm) ~> %mean.'bad-card' =^ hip sac (~(nell wa sac) p.vax) ?> hip ?. ?=(%meta -.q.vax) :: :: for an non-meta card, the mill is the vase :: [[%& vax] sac] ~> %mean.'bad-meta' :: :: tiv: vase of vase of card :: typ: vase of span :: =^ tiv sac (~(slot wa sac) 3 vax) =^ hip sac (~(nell wa sac) p.tiv) ?> hip =^ typ sac (~(slot wa sac) 2 tiv) =. sac (~(neat wa sac) pyt [%& typ]) :: :: support for meta-meta-cards has been removed :: ?> ?=(milt q.tiv) [[%| q.tiv] sac] :: :: =/ mut :: ?>(?=(milt q.tiv) q.tiv) :: |- ^- (pair [%| milt] worm) :: ?. ?=([%meta *] mut) :: [[%| mut] sac] :: =^ dip sac (~(nets wa sac) -:!>([%meta *vase]) p.mut) :: ?> dip :: $(q.tiv +.q.mut) -- :: :: |va: vane engine :: ++ va ~/ %va |_ [our=ship vax=vase sac=worm] :: :: |plow:va: operate in time and space :: ++ plow |= [now=@da sky=slyd] |% :: +peek:plow:va: read from a local namespace :: ++ peek |= [fur=(unit (set monk)) ren=@t bed=beam] ^- (unit (unit (cask maze))) :: namespace reads receive no entropy :: =/ sam=vane-sample [our now *@uvJ sky] =^ rig sac ~> %mean.'peek: activation failed' (~(slym wa sac) vax sam) =^ gat sac ~> %mean.'peek: call failed' (~(slap wa sac) rig [%limb %scry]) :: ;; (unit (unit (cask maze))) %+ slum q.gat ^- scry-sample :* fur ren [%& p.bed] q.bed `coin`[%$ r.bed] (flop s.bed) == :: :: |spin:plow:va: move statefully :: ++ spin |= [hen=duct eny=@uvJ] =/ duc !>(hen) =/ sam=vane-sample [our now eny sky] =^ rig sac ~> %mean.'spin: activation failed' (~(slym wa sac) vax sam) :: |% :: +peel:spin:plow:va: extract products, finalize vane :: ++ peel |= pro=vase ^- (pair [vase vase] worm) =^ moz sac (~(slot wa sac) 2 pro) =^ vem sac (~(slot wa sac) 3 pro) :: replace vane sample with default to plug leak :: =. +<.q.vem *vane-sample [[moz vem] sac] :: +call:spin:plow:va: advance statefully :: ++ call |= task=mill ^- (pair [vase vase] worm) ~> %mean.'call: failed' =^ gat sac (~(slap wa sac) rig [%limb %call]) :: :: sample is [duct (hypo (hobo task))] :: =/ sam=mill (slid duc (slix task)) =^ pro sac (slur sac gat sam) (peel pro) :: +take:spin:plow:va: retreat statefully :: ++ take |= [=wire from=term gift=mill] ^- (pair [vase vase] worm) ~> %mean.'take: failed' =^ gat sac (~(slap wa sac) rig [%limb %take]) =/ src=vase [[%atom %tas `from] from] :: :: sample is [wire duct (hypo sign=[term gift])] :: =/ sam=mill (slid !>(wire) (slid duc (slix (slid src gift)))) =^ pro sac (slur sac gat sam) (peel pro) -- -- -- :: :: |le: arvo event-loop engine :: ++ le ~% %le +>+ ~ =| $: :: run: list of worklists :: out: pending output :: gem: worklist metadata :: run=(list plan) out=(list ovum) gem=germ == :: |_ $: our=ship now=@da eny=@uvJ lac=? van=(map term vane) == +* this . :: +abet: finalize loop :: ++ abet ^- (pair (list ovum) (list (pair term vane))) :- (flop out) %+ sort ~(tap by van) |=([[a=@tas *] [b=@tas *]] (aor a b)) :: +emit: enqueue a worklist with source :: ++ emit |= [src=term moz=(list move)] =/ =plan [[src +(depth.gem)] moz] this(run [plan run]) :: +poke: prepare a worklist-of-one from outside :: ++ poke |= [vane=term =ovum] ^+ this ~? !lac ["" %unix p.card.ovum wire.ovum now] =/ =mill =/ =type [%cell [%atom %tas `%soft] %noun] [%& type [%soft card.ovum]] =/ =move ~| [%poke %bad-wire wire.ovum] ?> ?=([%$ *] wire.ovum) [duct=~ %pass t.wire.ovum vane mill] (emit %$ move ~) :: +spam: prepare a worklist for all targets :: ++ spam |= =ovum ^+ this =/ ord=(list (pair term *)) %+ sort ~(tap by van) |=([[a=@ *] [b=@ *]] (aor b a)) |- ^+ this ?~ ord this =. this (poke p.i.ord ovum) $(ord t.ord) :: +loop: until done :: ++ loop ^+ this ?~ run this ?: =(~ q.i.run) :: XX TMI loop(run t.run) =. gem p.i.run =^ mov q.i.run q.i.run loop:(step mov) :: +step: advance the loop one step by routing a move :: ++ step |= =move ^+ this ?- -.ball.move :: :: %pass: forward move :: %pass =* wire wire.ball.move =* duct duct.move =* vane vane.note.ball.move =* task task.note.ball.move :: ~? &(!lac !=(%$ vane.gem)) :- (runt [(dec depth.gem) '|'] "") :^ %pass [vane.gem vane] ?: ?=(?(%deal %deal-gall) +>-.task) :- :- +>-.task ;;([[ship ship] term term] [+>+< +>+>- +>+>+<]:task) wire [(symp +>-.task) wire] duct :: :: cons source onto wire, and wire onto duct :: (call [[vane.gem wire] duct] vane task) :: :: %slip: lateral move :: %slip =* duct duct.move =* vane vane.note.ball.move =* task task.note.ball.move :: ~? !lac :- (runt [(dec depth.gem) '|'] "") [%slip vane.gem (symp +>-.task) duct] :: (call duct vane task) :: :: %give: return move :: %give ?. ?=(^ duct.move) ~>(%mean.'give-no-duct' !!) :: =/ wire i.duct.move =/ duct t.duct.move =* gift gift.ball.move :: ?~ duct :: :: the caller was Outside :: ~| [%xeno wire (symp -.q.p.gift)] ?> ?=([%$ *] wire) (xeno wire gift) :: :: the caller was a vane :: =^ vane=term wire ~| [%give duct.move (symp -.q.p.gift)] ?>(?=(^ wire) wire) :: ~? &(!lac |(!=(%blit +>-.gift) !=(%d vane.gem))) :- (runt [(dec depth.gem) '|'] "") :^ %give vane.gem ?: ?=(%unto +>-.gift) [+>-.gift (symp +>+<.gift)] (symp +>-.gift) duct :: (take duct wire vane gift) == :: +peek: read from the entire namespace :: ++ peek ^- slyd |= [typ=* fur=(unit (set monk)) ron=term bed=beam] ^- (unit (unit (cask maze))) :: :: XX identity is defaulted to ship from beam :: => .(fur ?^(fur fur `[[%& p.bed] ~ ~])) :: :: XX vane and care are concatenated :: =/ lal (end 3 1 ron) =/ ren ;;(@t (rsh 3 1 ron)) ?. (~(has by van) lal) ~ (peek:(plow lal) fur ren bed) :: +xeno: stash pending output :: ++ xeno |= [=wire gift=mill] ^+ this this(out [[wire ;;(card q.p.gift)] out]) :: +call: advance to target :: ++ call |= [=duct way=term task=mill] ^+ this %+ push way (call:(spin:(plow way) duct eny) task) :: +take: retreat along call-stack :: ++ take |= [=duct =wire way=term gift=mill] ^+ this %+ push way :: :: cons source onto .gift to make a $sign :: (take:(spin:(plow way) duct eny) wire [vane.gem gift]) :: +push: finalize an individual step :: ++ push |= [way=term [zom=vase vax=vase] sac=worm] ^+ this =^ moz sac (~(refine-moves me sac -:!>(*type)) zom) =. van (~(put by van) way [vax sac]) (emit way moz) :: +plow: operate on a vane, in time and space :: ++ plow |= way=term ~| [%plow-failed way] =/ =vane ~| [%missing-vane way] (~(got by van) way) (~(plow va [our vane]) now peek) -- -- :: ++ symp :: symbol or empty |= a=* ^- @tas ?.(&(?=(@ a) ((sane %tas) a)) %$ a) :: ++ vent :: vane core |= [who=ship lal=@tas vil=vile bud=vase =vane] ~% %vent +>+ ~ |% ++ ruck :: update vase |= {pax/path txt/@ta} ^+ +> =- ?:(?=(%| -.res) ((slog p.res) +>.$) p.res) ^= res %- mule |. :: XX should use real entropy and the real date :: =/ arg=vane-sample [who ~2000.1.1 *@uvJ =>(~ |~(* ~))] =+ rig=(slym vase.vane arg) =+ gen=(rain pax txt) =+ rev=(slym (slap bud gen) bud) =+ syg=(slym rev arg) :: update the vane itself :: :: We don't cache the n+slap/+slam types because they're only used once :: right here; they'll never be used again. :: =. vase.vane ~| %load-lost (slam (slap syg [%limb %load]) (slap rig [%limb %stay])) :: prime the new compiler cache :: prime :: reset and prime the worm cache for scrys :: :: If the +slap/+slym in scry isn't cached, we spend the majority of :: the time in a scry in the compiler. The +scry gate cannot have side :: effects so we can't modify the cache at access time. So we seed the :: cache with all the things +scry will need when we install the vane :: ++ prime ^+ ..prime :: %_ ..prime worm.vane :: reset cache and add in vane activation entry :: =^ rig worm.vane (~(slym wa *worm) vase.vane *vane-sample) :: cache the access of the %scry arm :: +:(~(slap wa worm.vane) rig [%limb %scry]) == :: ++ wink :: deploy |= {now/@da eny/@ ski/slyd} =^ rig worm.vane ~| [%failed-vane-activation-for lal] (~(slym wa worm.vane) vase.vane `vane-sample`[who +<]) :: activate vane ~% %wink +>+> ~ |% ++ slid |= {hed/mill tal/mill} ^- mill ?: &(?=(%& -.hed) ?=(%& -.tal)) [%& (slop p.hed p.tal)] [%| [%cell p.p.hed p.p.tal] [q.p.hed q.p.tal]] :: ++ slix |= hil/mill ^- mill ?- -.hil %& [%& (slop [typ.vil p.p.hil] p.hil)] %| [%| [%cell typ.vil p.p.hil] p.hil] == :: ++ slur :: call gate on |= {gat/vase hil/mill} ^- (unit (pair vase worm)) =^ sam worm.vane ~| [%failed-slot-in lal] (~(slot wa worm.vane) 6 gat) =^ hig worm.vane ~| [%failed-nest-in lal] ?- -.hil %& (~(nest wa worm.vane) p.sam p.p.hil) %| (~(nets wa worm.vane) p.sam p.p.hil) == ?. hig ~ ~| [%failed-slym-in lal] `(~(slym wa worm.vane) gat +>.hil) :: ++ slur-a ~/(%slur-a |=({gat/vase hil/mill} =+(%a (slur gat hil)))) ++ slur-b ~/(%slur-b |=({gat/vase hil/mill} =+(%b (slur gat hil)))) ++ slur-c ~/(%slur-c |=({gat/vase hil/mill} =+(%c (slur gat hil)))) ++ slur-d ~/(%slur-d |=({gat/vase hil/mill} =+(%d (slur gat hil)))) ++ slur-e ~/(%slur-e |=({gat/vase hil/mill} =+(%e (slur gat hil)))) ++ slur-f ~/(%slur-f |=({gat/vase hil/mill} =+(%f (slur gat hil)))) ++ slur-g ~/(%slur-g |=({gat/vase hil/mill} =+(%g (slur gat hil)))) ++ slur-i ~/(%slur-i |=({gat/vase hil/mill} =+(%i (slur gat hil)))) ++ slur-j ~/(%slur-j |=({gat/vase hil/mill} =+(%j (slur gat hil)))) ++ slur-z ~/(%slur-z |=({gat/vase hil/mill} =+(%z (slur gat hil)))) :: ++ slur-pro :: profiling slur ~/ %slur-pro |= {lal/@tas gat/vase hil/mill} ?+ lal (slur-z gat hil) $a (slur-a gat hil) $b (slur-b gat hil) $c (slur-c gat hil) $d (slur-d gat hil) $e (slur-e gat hil) $f (slur-f gat hil) $g (slur-g gat hil) $i (slur-i gat hil) $j (slur-j gat hil) == :: ++ song :: reduce metacard ~/ %song :: |= mex/vase :: mex: vase of card ^- (unit (pair mill worm)) :: =^ hip worm.vane (~(nell wa worm.vane) p.mex) :: ?. hip ~ :: a card is a cell ?. ?=($meta -.q.mex) `[[%& mex] worm.vane] :: ordinary card =^ tiv worm.vane (~(slot wa worm.vane) 3 mex) :: =^ hip worm.vane (~(nell wa worm.vane) p.tiv) :: ?. hip ~ :: a vase is a cell =^ vax worm.vane (~(slot wa worm.vane) 2 tiv) :: =^ hip worm.vane (~(nest wa worm.vane) typ.vil p.vax) :: ?. hip ~ :: vase head is type %+ biff :: =+ mut=(milt q.tiv) :: card type, value |- ^- (unit (pair milt worm)) :: ?. ?=({$meta p/* q/milt} q.mut) `[mut worm.vane] :: ordinary metacard =^ hip worm.vane (~(nets wa worm.vane) mev.vil p.mut):: ?. hip ~ :: meta-metacard $(mut +.q.mut) :: descend into meta |=(a/(pair milt worm) `[[%| p.a] q.a]) :: milt to mill :: ++ sump :: vase to move ~/ %sump |= wec/vase ^- (unit (pair move worm)) %+ biff ((soft duct) -.q.wec) |= a/duct %+ bind =- ?- -.har %| ~& [%dead-card p.har] ~ :: XX properly log? %& (some p.har) == ^= har ^- (each (pair arvo worm) term) =^ caq worm.vane (~(spot wa worm.vane) 3 wec) ?+ q.caq [%| (cat 3 %funk (symp q.caq))] :: {$pass p/* q/@tas r/{p/@tas q/*}} %- (bond |.([%| p.r.q.caq])) %+ biff ((soft @) q.q.caq) |= lal/@tas ?. ((sane %tas) lal) ~ %+ biff ((soft path) p.q.caq) |= pax/path =^ xav worm.vane (~(spot wa worm.vane) 7 caq) =^ yav worm.vane (~(spot wa worm.vane) 3 xav) %+ bind (song yav) |= {hil/mill vel/worm} [%& [%pass pax lal hil] vel] :: {$give p/{p/@tas q/*}} %- (bond |.([%| p.p.q.caq])) =^ yav worm.vane (~(spot wa worm.vane) 3 caq) %+ bind (song yav) |= {hil/mill vel/worm} [%& [%give hil] vel] :: {$slip p/@tas q/{p/@tas q/*}} %- (bond |.([%| p.q.q.caq])) %+ biff ((soft @) p.q.caq) |= lal/@tas ?. ((sane %tas) lal) ~ =^ xav worm.vane (~(spot wa worm.vane) 3 caq) =^ yav worm.vane (~(spot wa worm.vane) 3 xav) %+ bind (song yav) |= {hil/mill vel/worm} [%& [%slip lal hil] vel] == |=(b/(pair arvo worm) [`move`[a p.b] q.b]) :: ++ said :: vase to (list move) |= vud/vase |- ^- (pair (list move) worm) ?: =(~ q.vud) [~ worm.vane] =^ hed worm.vane (~(slot wa worm.vane) 2 vud) =^ tal worm.vane (~(slot wa worm.vane) 3 vud) =^ mov worm.vane (need (sump hed)) =^ moz worm.vane $(vud tal) [[mov moz] worm.vane] :: ++ scry :: read namespace ~/ %scry |= $: fur/(unit (set monk)) ren/@t bed/beam == ^- (unit (unit (cask milt))) :: ~& [%arvo-scry ren bed] =/ old=scry-sample :* fur ren [%& p.bed] q.bed `coin`[%$ r.bed] (flop s.bed) == ^- (unit (unit (cask milt))) =+ fun=-:(~(slap wa worm.vane) rig [%limb %scry]) :: %- (unit (unit (cask milt))) (slum q.fun old) :: ++ soar :: scrub vane |= sev/vase ^- vase ?: &(=(-.q.vase.vane -.q.sev) =(+>.q.vase.vane +>.q.sev)) vase.vane :: unchanged, use old =| sam=vane-sample sev(+<.q sam(ski =>(~ |~(* ~)))) :: clear to stop leak :: ++ swim ~/ %swim |= $: org/@tas pux/(unit wire) hen/duct hil/mill == ^- [(list move) _vane] ~| [%failed-swim lal org pux] :: ~& [%swim-wyt `@ud`~(wyt in worm.vane)] =+ ^= pru ?~ pux ~| [%swim-call-vane lal (symp ?@(+.p.hil +.p.hil +<.p.hil))] =^ vax worm.vane (~(slap wa worm.vane) rig [%limb %call]) %^ slur-pro lal vax (slid [%& duc.vil hen] (slix hil)) ~| [%swim-take-vane lal (symp ?@(+.p.hil +.p.hil +<.p.hil))] =^ vax worm.vane (~(slap wa worm.vane) rig [%limb %take]) %^ slur-pro lal vax ;: slid [%& pah.vil u.pux] [%& duc.vil hen] (slix (slid [%& [%atom %tas `org] org] hil)) == ?~ pru ~& [%swim-lost lal (symp +>-.hil)] [~ [vase.vane worm.vane]] =^ pro worm.vane (need pru) =^ moz worm.vane (~(slot wa worm.vane) 2 pro) =^ vem worm.vane (~(slot wa worm.vane) 3 pro) :: =^ sad worm.vane (said moz) =^ sad worm.vane (~(refine-moves me:part worm.vane typ.vil) moz) [sad [(soar vem) worm.vane]] -- -- :: ++ vint :: create vane |= $: who=ship lal=@tas vil=vile bud=vase pax=path txt=@ta == =- ?:(?=(%| -.res) ((slog p.res) ~) (some p.res)) ^= res %- mule |. ~| [%failed-vint lal] =+ gen=(rain pax txt) ~& [%vane-parsed `@p`(mug gen)] =+ pro=(vent who lal vil bud [(slym (slap bud gen) bud) *worm]) ~& [%vane-compiled `@p`(mug pro)] prime:pro :: ++ viol :: vane tools |= but/type ^- vile =+ pal=|=(a/@t ^-(type (~(play ut but) (vice a)))) :* typ=(pal '$:type') duc=(pal '$:duct') pah=(pal '$:path') mev=(pal '$:{$meta $vase}') == :: ++ is :: operate in time |= [who=ship vil=vile eny=@ bud=vase vanes=(list [label=@tas =vane])] |_ now/@da ++ beck ^- slyd |= {typ/* fur/(unit (set monk)) ron/term bed/beam} ^- (unit (unit (cask milt))) => .(fur ?^(fur fur `[[%& p.bed] ~ ~])) :: XX heinous =+ lal=(end 3 1 ron) =+ ren=(@t (rsh 3 1 ron)) |- ^- (unit (unit (cask milt))) ?~ vanes ~ ?. =(lal label.i.vanes) $(vanes t.vanes) ~| [%failed-scry ron bed] %- scry:(wink:(vent who lal vil bud vane.i.vanes) now eny ..^$) [fur ren bed] :: ++ dink :: vase by char |= din/@tas ^- vase ?~(vanes !! ?:(=(din label.i.vanes) vase.vane.i.vanes $(vanes t.vanes))) :: ++ dint :: input routing |= hap/path ^- @tas ?+ hap ~|([%bad-dint hap] !!) {@ $ames *} %a {@ $boat *} %c {@ $newt *} %a {@ $sync *} %c {@ $term *} %d {@ $http-client *} %i {@ $http-server *} %e {@ $behn *} %b == :: ++ hurl :: start loop |= {lac/? ovo/ovum} ~? !lac ["" %unix -.q.ovo p.ovo now] :: ^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))} ^- {p/(list ovum) q=(list [label=@tas =vane])} ?> ?=(^ p.ovo) %+ kick lac :~ :* i.p.ovo ~ :^ %pass t.p.ovo (dint p.ovo) :+ %& [%cell [%atom %tas `%soft] %noun] [%soft q.ovo] 0 == == :: ++ race :: take |= {org/@tas lal/@tas pux/(unit wire) hen/duct hil/mill =vane} ^- [p=(list move) q=_vane] =+ ven=(vent who lal vil bud vane) ~| [%failed-take lal] =+ win=(wink:ven now eny beck) (swim:win org pux hen hil) :: ++ fire :: execute |= {org/term deh/@ud lal/term pux/(unit wire) hen/duct hil/mill} ^- {{p/(list ovum) q/(list muse)} _vanes} ?: &(?=(^ pux) ?=($~ hen)) [[[[lal u.pux] (curd +>.hil)]~ ~] vanes] =+ naf=vanes |- ^- {{p/(list ovum) q/(list muse)} _vanes} ?~ naf [[~ ~] ~] ?. =(lal label.i.naf) ~| [%lal lal label.i.naf] =+ tuh=$(naf t.naf) [-.tuh [+<.tuh [i.naf +>.tuh]]] :: =+ fiq=(race org lal pux hen hil vane.i.naf) :- [~ (turn p.fiq |=(a/move [lal p.a q.a +(deh)]))] [[label.i.naf q.fiq] t.naf] :: ++ jack :: dispatch card |= {lac/? gum/muse} ^- {{p/(list ovum) q/(list muse)} _vanes} ~| %failed-jack :: =. lac |(lac ?=(?(%g %f) p.gum)) :: =. lac &(lac !?=($b p.gum)) %^ fire p.gum s.gum ?- -.r.gum $pass ~? &(!lac !=(%$ p.gum)) :- (runt [s.gum '|'] "") :^ %pass [p.gum p.q.r.gum] ?: ?=(?(%deal %deal-gall) +>-.q.q.r.gum) :- :- +>-.q.q.r.gum (,[[ship ship] term term] [+>+< +>+>- +>+>+<]:q.q.r.gum) p.r.gum [(symp +>-.q.q.r.gum) p.r.gum] q.gum [p.q.r.gum ~ [[p.gum p.r.gum] q.gum] q.q.r.gum] :: $give ?. &(?=(^ q.gum) ?=(^ i.q.gum)) ~| [%jack-bad-duct q.gum] ~| [%jack-bad-card p.gum (symp +>-.p.r.gum)] !! ~? &(!lac |(!=(%blit +>-.p.r.gum) !=(%d p.gum))) :- (runt [s.gum '|'] "") :^ %give p.gum ?: ?=(%unto +>-.p.r.gum) [+>-.p.r.gum (term +>+<.p.r.gum)] (symp +>-.p.r.gum) `duct`q.gum [i.i.q.gum [~ t.i.q.gum] t.q.gum p.r.gum] :: $slip ~? !lac :- (runt [s.gum '|'] "") [%slip p.gum (symp +>-.q.p.r.gum) q.gum] [p.p.r.gum ~ q.gum q.p.r.gum] == :: ++ kick :: new main loop |= {lac/? mor/(list muse)} =| ova/(list ovum) |- ^- {p/(list ovum) q=(list [label=@tas =vane])} ?~ mor [ova vanes] =^ nyx vanes (jack lac i.mor) :: we emit ova to unix in fifo order, but emit internal moves depth-first :: $(ova (weld ova p.nyx), mor (weld q.nyx t.mor)) :: +spam: kick every vane with :ovum :: ++ spam |= [lac=? ovo=ovum] ^- [(list ovum) (list [label=@tas =vane])] =/ card :+ %& [%cell [%atom %tas `%soft] %noun] [%soft q.ovo] %+ kick lac %+ turn vanes |=([label=@tas *] [label ~ [%pass p.ovo label card] 0]) -- -- =< :: Arvo larval stage :: :: The true Arvo kernel knows who it is. It should not *maybe* :: have an identity, nor should it contain multitudes. This outer :: kernel exists to accumulate identity, entropy, and the :: standard library. Upon having done so, it upgrades itself into :: the true Arvo kernel. Subsequent upgrades will fall through :: the larval stage directly into the actual kernel. :: :: For convenience, this larval stage also supports hoon compilation :: with +wish and vane installation with the %veer event. :: =/ pit=vase !>(..is) =| $: :: who: our identity once we know it :: eny: entropy once we learn it :: bod: %zuse once we receive it :: who=(unit ship) eny=(unit @) bod=(unit vase) == :: larval Arvo structural interface :: |% ++ come ^come :: 4 ++ load ^load :: 10 ++ peek |=(* ~) :: 46 :: ++ poke |= * :: 47 ^- [(list ovum) *] => .(+< ;;([now=@da ovo=ovum] +<)) ^- [(list ovum) *] =. +>.$ ?+ -.q.ovo :: ignore unrecognized :: ~& [%larval-ignore p.ovo -.q.ovo] +>.$ :: install %zuse or vane :: %veer ^+ +>.$ :: use the maximum comet if we don't know who we are yet :: =/ our ?^ who u.who =/ fip=ship (dec (bex 128)) ~>(%slog.[0 leaf+"arvo: larval identity {(scow %p fip)}"] fip) =. ..veer (veer our now q.ovo) +>.$(bod ?^(bod bod `bud.^poke)) :: add entropy :: %wack ^+ +>.$ ?> ?=(@ q.q.ovo) +>.$(eny `q.q.ovo) :: become who you were born to be :: %whom ^+ +>.$ ?> ?=(@ q.q.ovo) +>.$(who `q.q.ovo) == :: upgrade once we've accumulated identity, entropy, and %zuse :: ?. &(?=(^ who) ?=(^ eny) ?=(^ bod)) [~ +>.$] ~> %slog.[0 leaf+"arvo: metamorphosis"] =/ nyf (turn vanes.^poke |=([label=@tas =vane] [label vase.vane])) (load u.who now u.eny ova=~ u.bod nyf) :: ++ wish |= txt=* :: 22 ?> ?=(@ txt) q:(slap ?~(bod pit u.bod) (ream txt)) -- :: :: persistent arvo state :: =/ pit=vase !>(..is) :: =/ vil=vile (viol p.pit) :: cached reflexives =| $: lac=_& :: laconic bit eny=@ :: entropy our=ship :: identity bud=vase :: %zuse vanes=(list [label=@tas =vane]) :: modules == :: =< :: Arvo structural interface :: |% ++ come |= [@ @ @ (list ovum) vise pone] :: 4 ^- [(list ovum) _+>] ~& %hoon-come =^ rey +>+ (^come +<) [rey +>.$] :: ++ load |= [@ @ @ (list ovum) vase pane] :: 10 ^- [(list ovum) _+>] ~& %hoon-load =^ rey +>+ (^load +<) [rey +>.$] :: ++ peek |= * :: 46 =/ rob (^peek ;;([@da path] +<)) ?~ rob ~ ?~ u.rob ~ [~ u.u.rob] :: ++ poke |= * :: 47 => .(+< ;;([now=@da ovo=ovum] +<)) =^ ova +>+.$ (^poke now ovo) =| out=(list ovum) |- ^- [(list ovum) *] ?~ ova [(flop out) +>.^$] :: upgrade the kernel :: ?: ?=(%lyra -.q.i.ova) %+ fall (vega now t.ova ;;([@ @] +.q.i.ova)) [~ +>.^$] :: iterate over effects, handling those on arvo proper :: and passing the rest through as output :: =^ vov +>+.^$ (feck now i.ova) =? out ?=(^ vov) [+.vov out] $(ova t.ova) :: ++ wish |=(* (^wish ;;(@ta +<))) :: 22 -- :: Arvo implementation core :: |% ++ come :: load incompatible |= [who=ship now=@da yen=@ ova=(list ovum) dub=vise nyf=pone] ^+ [ova +>] =/ fyn (turn nyf |=([a=@tas b=vise] [a (slim b)])) (load who now yen ova (slim dub) fyn) :: ++ load :: load compatible |= [who=ship now=@da yen=@ ova=(list ovum) dub=vase nyf=pane] ^+ [ova +>] =: our who eny yen bud dub vanes (turn nyf |=({a/@tas b/vise} [a [b *worm]])) == =| out=(list ovum) |- ^- [(list ovum) _+>.^$] ?~ ova [(flop out) +>.^$] :: iterate over effects, handling those on arvo proper :: and passing the rest through as output :: :: In practice, the pending effects after an upgrade :: are the %veer moves to install %zuse and the vanes, :: plus a %vega notification that the upgrade is complete. :: :: N.B. this implementation assumes that %vega will be :: at the end of :ova. :: ?: ?=(%vega -.q.i.ova) =^ zef=(list ovum) vanes :: (~(spam (is our vil eny bud vanes) now) lac i.ova) =< abet:loop %. i.ova %~ spam le:part [our now eny lac (~(gas by *(map term vane)) vanes)] :: $(out [i.ova out], ova (weld t.ova zef)) :: =^ vov +>.^$ (feck now i.ova) =? out ?=(^ vov) [+.vov out] $(ova t.ova) :: ++ peek :: external inspect |= {now/@da hap/path} ^- (unit (unit)) ?~ hap [~ ~ hoon-version] :: ((sloy ~(beck (is our vil eny bud vanes) now)) [151 %noun] hap) %. [[151 %noun] hap] %- sloy %~ peek le:part [our now eny lac (~(gas by *(map term vane)) vanes)] :: ++ poke :: external apply |= [now=@da ovo=ovum] =. eny (shaz (cat 3 eny now)) ^- [(list ovum) _+>.$] :: :: These external events are actually effects on arvo proper. :: They can also be produced as the effects of other events. :: In either case, they fall through here to be handled :: after the fact in +feck. :: ?: ?=(?(%veer %verb %wack %warn) -.q.ovo) [[ovo ~] +>.$] :: :: These external events (currently only %trim) are global :: notifications, spammed to every vane :: ?: ?=(%trim -.q.ovo) => .(ovo ;;((pair wire [%trim p=@ud]) ovo)) =^ zef vanes :: (~(spam (is our vil eny bud vanes) now) lac ovo) ^- (pair (list ovum) (list (pair term vane))) =< abet:loop %. ovo %~ spam le:part [our now eny lac (~(gas by *(map term vane)) vanes)] :: clear compiler caches if high-priority :: =? vanes =(0 p.q.ovo) ~> %slog.[0 leaf+"arvo: trim: clearing caches"] (turn vanes |=([a=@tas =vane] [a vase.vane *worm])) [zef +>.$] :: :: Normal events are routed to a single vane :: =^ zef vanes :: (~(hurl (is our vil eny bud vanes) now) lac ovo) =< abet:loop %. [(dint:$:is p.ovo) ovo] %~ poke le:part [our now eny lac (~(gas by *(map term vane)) vanes)] :: [zef +>.$] :: +feck: handle an arvo effect :: ++ feck |= [now=@da ovo=ovum] ^- [(unit ovum) _+>.$] ?+ -.q.ovo :: pass through unrecognized effect :: [[~ ovo] +>.$] :: toggle event verbose event printfs :: %verb [~ +>.$(lac !lac)] :: install %zuse or vane :: %veer [~ (veer our now q.ovo)] :: add data to memory profile :: %mass =. q.q.ovo :- %userspace :- %| :~ hoon+&+pit zuse+&+bud :+ %caches %| %+ turn %+ sort vanes |=([a=[lab=@tas *] b=[lab=@tas *]] (aor lab.a lab.b)) |=([label=@tas =vane] [(cat 3 %vane- label) %& worm.vane]) q.q.ovo :+ %vases %| %+ turn %+ sort vanes |=([a=[lab=@tas *] b=[lab=@tas *]] (aor lab.a lab.b)) |=([label=@tas =vane] [(cat 3 %vane- label) %& vase.vane]) dot+&+. == [[~ ovo] +>.$] :: add entropy :: %wack ?> ?=(@ q.q.ovo) =. eny (shaz (cat 3 eny q.q.ovo)) [~ +>.$] :: learn of event-replacement failure :: %warn :_ +>.$ ?. ?=(^ +.q.ovo) ~ =/ msg=tape :(weld "(for %" (trip (symp +<.q.ovo)) ") failed") ~> %slog.[0 leaf+(weld "arvo: replacement event " msg)] ?: lac ~ =/ rep %- mule |. ((slog (tang +>.q.ovo)) ~) ?.(?=(%& -.rep) ~ p.rep) == :: ++ vega :: reboot kernel |= $: :: now: current date :: ova: actions to process after reboot :: hun: hoon.hoon source :: arv: arvo.hoon source :: now=@da ova=(list ovum) hun=@t van=@t == ^- (unit (pair (list ovum) *)) :: virtualize; dump error if we fail :: =- ?:(?=(%| -.res) ((slog p.res) ~) `p.res) ^= res %- mule |. :: produce a new kernel and an effect list :: ^- (pair (list ovum) *) :: compile the hoon.hoon source with the current compiler :: =/ raw ~& [%hoon-compile `@p`(mug hun)] (ride %noun hun) :: activate the new compiler gate, producing +ride :: =/ cop .*(0 +.raw) :: find the hoon version number of the new kernel :: =/ nex (@ .*(cop q:(~(mint ut p.raw) %noun [%limb %hoon-version]))) ?> |(=(nex hoon-version) =(+(nex) hoon-version)) :: if we're upgrading language versions, recompile the compiler :: :: hot: raw compiler formula :: => ?: =(nex hoon-version) [hot=`*`raw .] ~& [%hoon-compile-upgrade nex] =/ hot (slum cop [%noun hun]) .(cop .*(0 +.hot)) :: extract the hoon core from the outer gate (+ride) :: =/ hoc .*(cop [%0 7]) :: compute the type of the hoon.hoon core :: =/ hyp -:(slum cop [-.hot '+>']) :: compile arvo :: =/ rav ~& [%arvo-compile `@p`(mug hyp) `@p`(mug van)] (slum cop [hyp van]) :: activate arvo, and extract the arvo core from the outer gate :: =/ voc .*(hoc [%7 +.rav %0 7]) :: entry gate: ++load for the normal case, ++come for upgrade :: =/ gat =/ arm ?:(=(nex hoon-version) 'load' 'come') :: compute the type of the arvo.hoon core :: =/ vip -:(slum cop [-.rav '+>']) :: compute the formula for the upgrade gate :: =/ fol +:(slum cop [vip arm]) :: produce the upgrade gate :: .*(voc fol) :: upgrade gate sample :: =/ sam :* our now eny :: tack a notification onto the pending effects :: (weld ova [`ovum`[/ %vega ~] ~]) bud (turn vanes |=([label=@tas =vane] [label vase.vane])) == :: call into the new kernel :: =/ out (slum gat sam) :: add types to the product :: [((list ovum) -.out) +.out] :: +veer: install %zuse or a vane :: :: Identity is in the sample so the larval stage :: can use this as well. :: ++ veer |= [who=ship now=@da fav=curd] => .(fav ;;({$veer lal/@ta pax/path txt/@t} fav)) =- ?:(?=(%| -.res) ((slog p.res) +>.$) p.res) ^= res %- mule |. ?: =(%$ lal.fav) ~& [%tang pax.fav `@p`(mug txt.fav)] =+ gen=(rain pax.fav txt.fav) =+ vax=(slap pit gen) +>.^$(bud vax) %_ +>.^$ vanes |- ^+ vanes ?~ vanes ~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)] =+ vin=(vint who lal.fav vil bud pax.fav txt.fav) ?~ vin vanes [[lal.fav vane:u.vin] vanes] ?. =(lal.fav label.i.vanes) [i.vanes $(vanes t.vanes)] ~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)] :_ t.vanes :- label.i.vanes ~| [%failed-vane-activation now lal.fav] vane:(ruck:(vent who lal.fav vil bud [vase.vane.i.vanes *worm]) pax.fav txt.fav) == :: ++ wish :: external compute |= txt/@ q:(slap bud (ream txt)) --