mirror of
https://github.com/urbit/shrub.git
synced 2024-12-14 20:02:51 +03:00
985 lines
34 KiB
Plaintext
985 lines
34 KiB
Plaintext
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
|
:::::: :::::: 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 $- {* (unit (set monk)) term beam} :: super advanced
|
|
(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]
|
|
::
|
|
++ 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-j ~/(%slur-j |=({gat/vase hil/mill} =+(%j (slur gat hil))))
|
|
++ slur-z ~/(%slur-z |=({gat/vase hil/mill} =+(%z (slur gat hil))))
|
|
++ slur-r
|
|
~/ %slur-r
|
|
|=({gat/vase hil/mill} =+(%r (slur gat hil)))
|
|
++ slur-l
|
|
~/ %slur-l
|
|
|=({gat/vase hil/mill} =+(%l (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)
|
|
$j (slur-j gat hil)
|
|
::
|
|
%l (slur-l gat hil)
|
|
%r (slur-r 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
|
|
=^ yav worm.vane (~(spot wa worm.vane) 15 caq)
|
|
%+ 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) ~
|
|
=^ yav worm.vane (~(spot wa worm.vane) 7 caq)
|
|
%+ 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 [(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 !=(%belt -.q.ovo)) ["" %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]
|
|
[(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 (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 |=(* (^peek ;;([@da path] +<))) :: 46
|
|
::
|
|
++ poke |= * :: 47
|
|
^- [(list ovum) *]
|
|
=> .(+< ;;([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 vanes
|
|
(~(spam (is our vil eny bud vanes) now) lac i.ova)
|
|
$(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)
|
|
?~ hap [~ hoon-version]
|
|
=+ rob=((sloy ~(beck (is our vil eny bud vanes) now)) [151 %noun] hap)
|
|
?~ rob ~
|
|
?~ u.rob ~
|
|
[~ u.u.rob]
|
|
::
|
|
++ 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)
|
|
:: 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)
|
|
[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))
|
|
--
|