mirror of
https://github.com/urbit/shrub.git
synced 2024-12-01 22:55:03 +03:00
1377 lines
37 KiB
Plaintext
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=(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
|
|
$~ [%345 nub=*debt:le:part]
|
|
$% [%345 nub=debt:le:part]
|
|
(list ovum)
|
|
==
|
|
++ dram
|
|
|= ram=pram
|
|
^- pram
|
|
?: ?=([%345 *] ram)
|
|
ram
|
|
~| ram+ram
|
|
=| nub=debt:le:part
|
|
=/ =plan:le:part
|
|
:- [%$ ~]
|
|
%+ turn ;;((list ovum) ram)
|
|
|= ovo=ovum
|
|
^- move
|
|
[[p.ovo]~ %give %& %noun q.ovo]
|
|
[%345 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)
|
|
?> ?=([%345 *] 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
|
|
345+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))
|
|
--
|