ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-15 01:52:42 +03:00
Code Issues Packages Projects Releases Wiki Activity
8187c58ee5
urbit/pkg/arvo/sys/arvo.hoon
Joe Bryan 8187c58ee5 arvo: removes obsolete engines
2020-02-26 16:56:17 -08:00

1178 lines
35 KiB
Plaintext
Raw Blame History

:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: 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
++ 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
++ 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])
==
--
::
++ 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
::
++ 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
==
--
--
=< :: 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))
--
Reference in New Issue View Git Blame Copy Permalink