shrub/pkg/arvo/sys/arvo.hoon

1377 lines
37 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: formal event"]
.(+> +:(poke now ovo))
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: volume 3, Arvo models and skeleton ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
=>
|%
+| %global
::
:: $arch: fundamental node
:: $beak: global context
:: $beam: global name
:: $bone: opaque duct handle
:: $case: global version
:: $cage: marked vase
:: +cask: marked data builder
:: $desk: local workspace
:: $dock: message target
:: $mark: symbolic content type
:: $ship: network identity
:: $sink: subscription
::
+$ arch [fil=(unit @uvI) dir=(map @ta ~)]
+$ beam [beak s=path]
+$ beak (trel ship desk case)
+$ bone @ud
+$ case
$% :: %da: date
:: %tas: label
:: %ud: sequence
::
[%da p=@da]
[%tas p=@tas]
[%ud p=@ud]
==
+$ cage (cask vase)
++ cask |$ [a] (pair mark a)
+$ desk @tas
+$ dock (pair @p term)
+$ mark @tas
+$ ship @p
+$ sink (trel bone ship path)
::
+| %meta
::
:: +hypo: type-associated builder
:: $meta: meta-vase
:: $maze: vase, or meta-vase
::
++ hypo
|$ [a]
(pair type a)
+$ meta (pair)
+$ maze (each vase meta)
::
+| %interface
::
:: $ball: dynamic kernel action
:: $curd: tagged, untyped event
:: $duct: causal history
:: +hobo: %soft task builder
:: $goof: crash label and trace XX fail/ruin/crud/flaw/lack/miss
:: $mass: memory usage
:: $monk: general identity
:: $move: cause and action
:: $ovum: card with cause
:: $scry-sample: vane +scry argument
:: $vane-sample: vane wrapper-gate aargument
:: $sley: namespace function
:: $slyd: super advanced
:: $slyt: old namespace
:: +wind: kernel action builder
:: $wire: event pretext
:: +wite: kernel action/error builder
::
+$ ball (wite [vane=term task=maze] maze)
+$ curd (cask)
+$ duct (list wire)
++ hobo
|$ [a]
$? $% [%soft p=*]
==
a
==
+$ goof [mote=term =tang]
+$ mass $~ $+|+~
(pair cord (each * (list mass)))
+$ monk (each ship (pair @tas @ta))
+$ move [=duct =ball]
+$ ovum (pair wire curd)
::
+$ 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]
::
+$ sley
$- [* (unit (set monk)) term beam]
(unit (unit cage))
+$ slyd
$~ =>(~ |~(* ~))
$- [* (unit (set monk)) term beam]
(unit (unit (cask meta)))
+$ slyt $-(^ (unit (unit)))
::
++ wind
|$ :: a: forward
:: b: reverse
::
[a b]
$% :: %pass: advance
:: %slip: lateral
:: %give: retreat
::
[%pass p=path q=a]
[%slip p=a]
[%give p=b]
==
+$ wire path
++ wite
|$ :: note: a routed $task
:: gift: a reverse action
::
:: NB: task: a forward action
:: sign: a sourced $gift
::
[note gift]
$% :: %hurl: action failed
:: %pass: advance
:: %slip: lateral
:: %give: retreat
::
[%hurl =goof wite=$;($>(?(%pass %give) $))]
[%pass =wire =note]
[%slip =note]
[%give =gift]
==
::
+| %implementation
::
:: $pane: kernel modules
:: $pone: kernel modules old
:: $vane: kernel module
:: $vile: reflexive constants
::
+$ pane (list (pair @tas vase))
+$ pone (list (pair @tas vise))
+$ vane [=vase =worm]
+$ vile
$: typ=type :: -:!>(*type)
duc=type :: -:!>(*duct)
wir=type :: -:!>(*wire)
dud=type :: -:!>(*(unit goof))
==
--
=>
~% %hex ..ut ~
|%
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: 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=?~(i.t.t.u.pux (some %$) (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 meta)))
(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 meta)))
(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
=> |%
:: $card: tagged, untyped event
:: $ovum: card with cause
::
:: XX replace top-level structures
::
+$ card (cask)
+$ ovum [=wire =card]
--
::
~% %part ..part ~
|%
::
+| %utilities
::
:: XX move into |wa?
::
:: +slur: slam a vase with a maze
::
++ slur
|= [sac=worm gat=vase sam=maze]
^- [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 maze
::
++ slid
|= [hed=vase tal=maze]
^- maze
?- -.tal
%& [%& (slop hed p.tal)]
%| [%| [%cell p.hed p.p.tal] [q.hed q.p.tal]]
==
::
+| %engines
::
:: |me: dynamic analysis
::
++ me
~/ %me
|_ :: sac: compiler cache
:: pyt: cached types
::
[sac=worm vil=vile]
:: +refine-moves: move list from vase
::
++ 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
::
++ refine-move
|= vax=vase
^- (pair move worm)
~> %mean.'bad-move'
=^ hip sac (~(nell wa sac) p.vax)
?. hip
~>(%mean.'not-cell' !!)
=/ duc
~> %mean.'bad-duct'
;;(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
::
++ refine-ball
|= vax=vase
^- (pair ball worm)
?+ q.vax
~> %mean.'bad-ball'
~_ (sell vax)
!!
::
[%give card]
:: yed: vase containing card
:: hil: card as maze
::
=^ yed sac (~(spot wa sac) 3 vax)
=^ hil sac (refine-card yed)
[[%give hil] sac]
::
[%pass wire=* vane=term card]
=/ =wire
~> %mean.'bad-wire'
;;(wire wire.q.vax)
=/ vane
~> %mean.'bad-vane-label'
?> ((sane %tas) vane.q.vax)
vane.q.vax
::
:: yed: vase containing card
:: hil: card as maze
::
=^ 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]
=/ vane
~> %mean.'bad-vane-label'
?> ((sane %tas) vane.q.vax)
vane.q.vax
::
:: yed: vase containing card
:: hil: card as maze
::
=^ xav sac (~(spot wa sac) 3 vax)
=^ yed sac (~(spot wa sac) 3 xav)
=^ hil sac (refine-card yed)
[[%slip vane hil] sac]
::
[%hurl goof=^ ball=*]
=/ =goof
=/ mote -.goof.q.vax
?> ?& ?=(@ mote)
((sane %tas) mote)
==
[mote ;;(tang +.goof.q.vax)]
::
=^ bal sac
=^ lab sac (~(spot wa sac) 7 vax)
$(vax lab)
::
?> ?=(?(%pass %give) -.p.bal)
[[%hurl goof p.bal] sac]
==
:: +refine-card: card from vase
::
++ refine-card
|= vax=vase
^- (pair maze worm)
~> %mean.'bad-card'
=^ hip sac (~(nell wa sac) p.vax)
?> hip
?. ?=(%meta -.q.vax)
::
:: for a non-meta card, the maze 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) typ.vil [%& typ])
::
:: support for meta-meta-cards has been removed
::
?> ?=(meta q.tiv)
[[%| q.tiv] sac]
--
::
:: |va: vane engine
::
++ va
~/ %va
|_ [our=ship vil=vile 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 meta)))
:: 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 meta)))
%+ 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 dud=(unit goof)]
=* duc [duc.vil hen]
=* err [dud.vil dud]
=/ sam=vane-sample [our now eny sky]
=^ rig sac
~> %mean.'spin: activation failed'
(~(slym wa sac) vax sam)
::
|%
:: +slix: en-hypo
::
++ slix
|= hil=maze
^- maze
?- -.hil
%& [%& (slop [typ.vil p.p.hil] p.hil)]
%| [%| [%cell typ.vil p.p.hil] p.hil]
==
:: +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=maze
^- (pair [vase vase] worm)
~> %mean.'call: failed'
=^ gat sac
(~(slap wa sac) rig [%limb %call])
::
:: sample is [duct (unit goof) (hypo (hobo task))]
::
=/ sam=maze
(slid duc (slid err (slix task)))
=^ pro sac (slur sac gat sam)
(peel pro)
:: +take:spin:plow:va: retreat statefully
::
++ take
|= [=wire from=term gift=maze]
^- (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 (unit goof) (hypo sign=[term gift])]
::
=/ sam=maze
=* tea [wir.vil wire]
(slid tea (slid duc (slid err (slix (slid src gift)))))
=^ pro sac (slur sac gat sam)
(peel pro)
--
--
--
::
:: |le: arvo event-loop engine
::
++ le
=> |%
:: $germ: worklist source and bar stack
:: $plan: worklist
:: $debt: in-progress state
::
+$ germ [vane=term bars=(list duct)]
+$ plan (pair germ (list move))
+$ debt
$~ [~ ~ *germ ~]
$: :: run: list of worklists
:: out: pending output
:: gem: worklist metadata
:: dud: propagate error
::
run=(list plan)
out=(list ovum)
gem=germ
dud=(unit goof)
==
--
::
~% %le part ~
=| debt
=* nub -
::
|_ $: our=ship
now=@da
eny=@uvJ
lac=?
vil=vile
van=(map term vane)
==
+* this .
++ plot run.nub
++ then |=(paz=(list plan) this(run (weld run paz)))
++ abed |=(nib=debt this(nub nib))
:: +abet: finalize loop
::
:: .ovo: optional effect to arvo itself
::
:: If ovo is ~, the loop is over; produce ova.
:: Else, produce u.ovo and the unfinished .nub internal state.
::
++ abet
|= ovo=(unit ovum)
^- $: %+ each (list ovum)
$: fec=ovum
nub=debt
==
van=(list (pair term vane))
==
:- ?~ ovo
&+(flop out)
|+[u.ovo nub]
::
%+ sort ~(tap by van)
|=([[a=@tas *] [b=@tas *]] (aor a b))
:: +emit: enqueue a worklist with source
::
++ emit
|= pan=plan
this(run [pan run])
:: +poke: prepare a worklist-of-one from outside
::
++ poke
|= [vane=term =ovum]
^+ this
~> %mean.'arvo: poke crashed'
~? !lac ["" %unix p.card.ovum wire.ovum now]
=/ =maze
=/ =type [%cell [%atom %tas `%soft] %noun]
[%& type [%soft card.ovum]]
=/ =move
~| [%bad-wire wire.ovum]
?> ?=([%$ *] wire.ovum)
[duct=~ %pass t.wire.ovum vane maze]
(emit [%$ ~] move ~)
:: +crud: prepare a worklist-of-one with error report from outside
::
++ crud
|= [vane=term =goof =ovum]
^+ this
~> %mean.'arvo: crud crashed'
~? !lac ["" %unix %crud p.card.ovum wire.ovum now]
=/ =maze
=/ =type [%cell [%atom %tas `%soft] %noun]
[%& type [%soft card.ovum]]
=/ =move
~| [%bad-wire wire.ovum]
?> ?=([%$ *] wire.ovum)
[duct=~ %hurl goof %pass t.wire.ovum vane maze]
(emit [%$ ~] move ~)
:: +spam: prepare a worklist for all targets
::
++ spam
|= =ovum
^+ this
~> %mean.'arvo: spam crashed'
:: fix up wire on %vega from previous kernel
::
=? wire.ovum =(ovum [/ %vega ~]) //arvo
=/ 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
^- abet
?~ run
(abet ~)
?: =(~ q.i.run) :: XX TMI
loop(run t.run)
=. dud ~
=. gem p.i.run
=^ mov=move q.i.run q.i.run
=> .(run `(list plan)`run) :: XX TMI
=^ ovo=(unit ovum) this (step mov)
?~ ovo
loop
(abet `u.ovo)
:: +step: advance the loop one step by routing a move
::
++ step
|= =move
^- [(unit ovum) _this]
::
~? &(!lac ?=(^ dud)) %goof
::
?- -.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 [(lent bars.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 [(lent bars.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 [(lent bars.gem) '|'] "")
:^ %give vane.gem
?: ?=(%unto +>-.gift)
[+>-.gift (symp +>+<.gift)]
(symp +>-.gift)
duct.move
::
`(take duct wire vane gift)
::
:: %hurl: action with error
::
%hurl
%= $
dud `goof.ball.move
ball.move wite.ball.move
==
==
:: +whey: measure memory usage
::
++ whey
^- (list mass)
=/ von
%+ turn
(sort ~(tap by van) |=([[a=@tas *] [b=@tas *]] (aor a b)))
|=([lal=@tas =vane] (cat 3 %vane- lal)^vane)
::
:~ :+ %reports %|
%+ turn von
=/ bem=beam [[our %home da+now] /whey]
|= [lal=@tas =vane]
=/ met (need (need (peek ** ~ (rsh 3 5 lal) bem)))
lal^|+;;((list mass) q.q.met)
::
:+ %caches %|
%+ turn von
|=([lal=@tas =vane] lal^&+worm.vane)
::
:+ %dregs %|
%+ turn von
|=([lal=@tas =vane] lal^&+vase.vane)
==
:: +peek: read from the entire namespace
::
++ peek
^- slyd
|= [typ=* fur=(unit (set monk)) ron=term bed=beam]
^- (unit (unit (cask meta)))
::
:: 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=maze]
^- [(unit ovum) _this]
=/ ovo=ovum [wire ;;(card q.p.gift)]
?: ?=(?(%lyra %veer %wack %verb %whey) -.card.ovo)
[`ovo this]
[~ this(out [ovo out])]
:: +call: advance to target
::
++ call
|= [=duct way=term task=maze]
^+ this
%+ push [way duct bars.gem]
~| bar-stack=`(list ^duct)`[duct bars.gem]
%. task
call:(spin:(plow way) duct eny dud)
:: +take: retreat along call-stack
::
++ take
|= [=duct =wire way=term gift=maze]
^+ this
%+ push [way duct bars.gem]
::
:: cons source onto .gift to make a $sign
::
~| wire=wire
~| bar-stack=`(list ^duct)`[duct bars.gem]
%. [wire [vane.gem gift]]
take:(spin:(plow way) duct eny dud)
:: +push: finalize an individual step
::
++ push
|= [gum=germ [zom=vase vax=vase] sac=worm]
^+ this
=^ moz sac
(~(refine-moves me sac vil) zom)
=. van (~(put by van) vane.gum [vax sac])
(emit `plan`[`germ`gum `(list move)`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 vil 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}
^+ +>
:: 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 ?-(-.res %& p.res, %| (mean leaf+"vint: {<lal>}" p.res))
%- mule |.
=+ gen=(rain pax txt)
~> %slog.[0 leaf+"vane: parsed {(scow p+(mug gen))}"]
=+ pro=(vent who lal vil bud [(slym (slap bud gen) bud) *worm])
~> %slog.[0 leaf+"vane: compiled {(scow 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')
wir=(pal '$:wire')
dud=(pal '=<($ (unit goof))') :: XX misparse
==
::
++ 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
==
::
++ is &
--
=< :: 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
=. soul (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"]
~< %slog.[0 leaf+"arvo: metamorphosed"]
=/ nyf
(turn vanes.^poke |=([label=@tas =vane] [label vase.vane]))
(load u.who now u.eny *pram 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
== ::
:: produce an interface that vere understands
::
=< arvo
:: soul: arvo implementation core
::
|%
++ soul .
:: arvo: structural interface core
::
++ arvo
|%
++ come |= [@ @ @ pram vise pone] :: 4
(come:soul +<)
::
++ load |= [@ @ @ pram vase pane] :: 10
(load:soul +<)
::
++ peek |= * :: 46
=/ rob (^peek ;;([@da path] +<))
?~ rob ~
?~ u.rob ~
[~ u.u.rob]
::
++ poke |= * :: 47
=> .(+< ;;([now=@da ovo=ovum] +<))
(poke:soul now ovo)
::
++ wish |=(* (^wish ;;(@ta +<))) :: 22
--
:: $pram: upgradeable state
:: +dram: upgrade $pram, compatible
::
+$ pram
$~ [%~2020.6.28 nub=*debt:le:part]
$% [%~2020.6.28 nub=debt:le:part]
(list ovum)
==
++ dram
|= ram=pram
^- pram
?: ?=([%~2020.6.28 *] ram)
ram
~| ram+ram
=| nub=debt:le:part
=/ =plan:le:part
:- [%$ ~]
%+ turn ;;((list ovum) ram)
|= ovo=ovum
^- move
[[p.ovo]~ %give %& %noun q.ovo]
[%~2020.6.28 nub(run [plan]~)]
:: $prim: old $pram
:: +drum: upgrade $prim to $pram, incompatible
::
+$ prim pram
++ drum |=(prim +<)
:: +come: load incompatible
::
++ come
|= [who=ship now=@da yen=@ rim=prim dub=vise nyf=pone]
^- [(list ovum) *]
~| %come
=/ fyn (turn nyf |=([a=@tas b=vise] [a (slim b)]))
=/ rum (drum rim)
(load who now yen rum (slim dub) fyn)
:: +load: load compatible, notifying vanes
::
++ load
|= [who=ship now=@da yen=@ ram=pram dub=vase nyf=pane]
^- [(list ovum) *]
~| %load
=: our who
eny yen
bud dub
vanes (turn nyf |=({a/@tas b/vise} [a [b *worm]]))
==
=. ram (dram ram)
?> ?=([%~2020.6.28 *] ram)
=/ run plot:(spam:(lead now ~) [//arvo %vega ~])
(leap now (then:(lead now `nub.ram) run))
:: +peek: external inspect
::
++ peek
|= {now/@da hap/path}
^- (unit (unit))
?~ hap [~ ~ hoon-version]
?: =(hap /whey)
``mass+(whey now)
((sloy peek:(lead now ~)) [[151 %noun] hap])
:: +poke: external apply
::
++ poke
|= [now=@da ovo=ovum]
=. eny (shaz (cat 3 eny now))
~| poke+-.q.ovo
|- ^- [(list ovum) *]
?+ -.q.ovo
:: Normal events are routed to a single vane
::
(leap now (poke:(lead now ~) (dint p.ovo) ovo))
:: Print warning and no-op.
::
%warn
:_ arvo
?. ?=(^ +.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)) ~)
~
:: Process these events just as if they had come from a vane
::
?(%lyra %veer %verb %wack %whey) (feck now ovo *debt:le:part)
:: These external events (currently only %trim) are global
:: notifications, spammed to every vane
::
%trim
=> .(ovo ;;((pair wire [%trim p=@ud]) ovo))
=^ zef vanes loop:(spam:(lead now ~) 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)
[p.zef arvo]
(feck now [fec nub]:p.zef)
:: Error notifications are unwrapped and routed as usual
::
%crud
?. ?=(^ q.q.ovo)
~|([%unknown-crud q.ovo] !!)
::
%+ leap now
?@ -.q.q.ovo
:: legacy %crud, directly routed
::
(poke:(lead now ~) (dint p.ovo) ovo)
:: modern %crud, unwrapped and routed w/ $goof
::
=/ =goof ;;(goof -.q.q.ovo)
=/ =curd ;;(curd +.q.q.ovo)
(crud:(lead now ~) (dint p.ovo) goof p.ovo curd)
==
:: +lead: initialize +le core
::
++ lead
|= [now=@da nub=(unit debt:le:part)]
^+ le:part
~| lead+.?(nub)
=; el
?~ nub el
(abed:el u.nub)
~(. le:part our now eny lac vil (~(gas by *(map term vane)) vanes))
:: +leap: run vane loop and handle effects
::
++ leap
|= [now=@da el=_le:part]
^- [(list ovum) *]
~| %leap
=^ zef vanes loop:el
?: ?=(%& -.zef)
[p.zef arvo]
(feck now [fec nub]:p.zef)
:: +whey: report memory usage
::
++ whey
|= now=@da
^- mass
:+ %arvo %|
:~ hoon+&+pit
zuse+&+bud
vane+|+whey:(lead now ~)
==
:: +feck: handle an effect from a vane
::
++ feck
|= [now=@da ovo=ovum nub=debt:le:part]
^- [(list ovum) *]
~| feck+-.q.ovo
?: ?=(%lyra -.q.ovo)
(vega now nub ;;([(unit @) @] +.q.ovo))
?+ -.q.ovo ~|(bad-fec+-.q.ovo !!)
:: produce memory usage report
::
%whey
=. out.nub [[p.ovo mass+(whey now)] out.nub]
(leap now (lead now `nub))
:: %verb: toggle event verbose event printfs
::
%verb
=. lac !lac
(leap now (lead now `nub))
:: %veer: install %zuse or vane
::
%veer
=. soul (veer our now q.ovo)
(leap now (lead now `nub))
:: %wack: add entropy
::
%wack
?> ?=(@ q.q.ovo)
=. eny (shaz (cat 3 eny q.q.ovo))
(leap now (lead now `nub))
==
:: +vega: reboot kernel
::
++ vega
|= $: :: now: current date
:: nub: vane continuation state
:: hun: hoon.hoon source, or ~ if unchanged
:: arv: arvo.hoon source
::
now=@da
nub=debt:le:part
hun=(unit @t)
van=@t
==
:: produce a new kernel and an effect list
::
^- [(list ovum) *]
:: go metacircular as hint to vere to run in new memory arena
::
=; res ?-(-.res %& p.res, %| (mean leaf+"vega: ruin" p.res))
%- mule |.
:: obtain hoon compiler data
::
:: Arvo is compiled against the hoon.hoon vase with its outer +ride
:: gate stripped off, leaving the main core.
::
:: hyp: hoon core type
:: hoc: hoon core
:: cop: compiler gate
:: lod: can we use the +load arm? (language-compatible upgrade)
::
=/ [hyp=* hoc=* cop=* lod=?]
:: if no new hoon.hoon source, use current compiler
::
?~ hun
[-:!>(+>:ride) +>:ride ride &]
:: compile new hoon.hoon source with the current compiler
::
=/ raw
~> %slog.[0 leaf+"vega: compiling hoon"]
(road |.((ride %noun u.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=* cop
?: =(nex hoon-version)
[raw cop]
~> %slog.[0 leaf+"vega: recompiling hoon {<nex>}k"]
~& [%hoon-compile-upgrade nex]
%- road |.
=/ hot (slum cop [%noun hun])
[hot .*(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 '+>'])
::
[hyp hoc cop =(nex hoon-version)]
:: compile arvo
::
=/ rav
~> %slog.[0 leaf+"vega: compiling kernel {(scow %p (mug hyp))}"]
%- road |.
(slum cop [hyp van])
:: activate arvo, and extract the arvo core from the outer gate
::
~> %slog.[0 leaf+"vega: extracting core"]
=/ voc .*(hoc [%7 +.rav %0 7])
:: entry gate: ++load for the normal case, ++come for upgrade
::
=/ gat
=/ arm ?:(lod 'load' 'come')
~> %slog.[0 leaf+"vega: +{(trip arm)}"]
:: 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
[%~2020.6.28 nub]
bud
(turn vanes |=([label=@tas =vane] [label vase.vane]))
==
:: call into the new kernel
::
~> %slog.[0 leaf+"vega: evolving"]
~< %slog.[0 leaf+"vega: evolution"]
=/ out (slum gat sam)
:: add types to the product
::
;;([(list ovum) *] out)
:: +veer: install %zuse or a vane
::
:: Identity is in the sample so the larval stage
:: can use this too.
::
++ veer
|= [who=ship now=@da fav=curd]
^+ soul
=> .(fav ;;([%veer lal=@tas pax=path txt=@t] fav))
=; res ?-(-.res %& p.res, %| (mean leaf+"veer: {<lal.fav>}" p.res))
%- mule |.
?: =(%$ lal.fav)
~> %slog.[0 leaf+"zuse: {(scow p+(mug txt.fav))}"]
=+ gen=(rain pax.fav txt.fav)
=+ vax=(slap pit gen)
soul(bud vax)
%_ soul
vanes
|- ^+ vanes
?~ vanes
~> %slog.[0 leaf+"vane: {<lal.fav>} {(scow p+(mug txt.fav))}"]
=/ vin (vint who lal.fav vil bud pax.fav txt.fav)
[[lal.fav vane.vin] vanes]
?. =(lal.fav label.i.vanes)
[i.vanes $(vanes t.vanes)]
~> %slog.[0 leaf+"vane: {<lal.fav>} {(scow p+(mug txt.fav))}"]
:_ t.vanes
:- label.i.vanes
~| [%failed-vane-activation lal.fav]
=< vane
%. [pax txt]:fav
ruck:(vent who lal.fav vil bud [vase.vane.i.vanes *worm])
==
:: +wish: external compute
::
++ wish
|= txt/@
q:(slap bud (ream txt))
--