ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-09-20 15:08:34 +03:00
Code Issues Packages Projects Releases Wiki Activity

New metal boot system.

Browse Source
This commit is contained in:
C. Guy Yarvin 2016-11-23 20:25:07 -08:00
parent 457b639203
commit 092dc318de
13 changed files with 29063 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
arvo/hoon.hoon
View File

@ -9511,7 +9511,7 @@
++ ride :: end-to-end compiler
|= {typ/span txt/@}
^- (pair span nock)
(~(mint ut typ) %noun (ream txt))
::
:::: 5e: caching compiler
::
@ -10426,3 +10426,4 @@
|= txt/@
q:(slap mast (ream txt))
--

167
gen/metal.hoon
View File

@ -6,8 +6,8 @@
::::
!:
:- %say
|= $: {now/@da *}
*
|= $: {now/@da eny/@uvJ bec/beak}
{{who/@p $~} $~}
==
:- %noun
=+ ^= event-zero
@ -25,19 +25,22 @@
:: formula peels off the first n (currently 3) events
:: to set up the lifecycle loop.
::
~> %slog.[0 leaf+"0-a"]
=+ [state-gate main-sequence]=.*(full-sequence boot-formula)
~> %slog.[0 leaf+"0-b"]
::
:: in this lifecycle loop, we replace the state function
:: with its product, called on the next event, until
:: we run out of events.
::
:: we have to use raw nock to "call" the function,
:: since these are untyped nouns.
::
:: in real life we don't actually run the lifecycle loop,
:: since
:: since real life is updated incrementally and also cares
:: about things like output. we couple to the internal
:: structure of the state machine and work directly with
:: the underlying arvo engine.
::
|- ?@ main-sequence
|- ~> %slog.[0 leaf+"0-c"]
?@ main-sequence
state-gate
%= $
main-sequence +.main-sequence
@ -48,17 +51,17 @@
:: event 1 is the boot formula, which verifies the compiler
:: and starts the main lifecycle.
::
=> :* :: event 2: a trap (hoon |.), producing the hoon compiler
=> :* :: event 2: a formula producing the hoon compiler
::
compiler-trap=**
compiler-formula=**
::
:: event 3: hoon compiler source, compiling to event 2
::
compiler-source=*@
compiler-source=*@t
::
:: event 4: arvo kernel source
::
kernel-source=*@
kernel-source=*@t
::
:: events 5..n: main sequence with normal semantics
::
@ -66,92 +69,102 @@
==
!= :_ main-sequence
::
:: activate the compiler gate. the reason we use a trap
:: here is to actually compose the gate live, activating
:: any jets as we build the cores. the compiler trap is
:: the only true binary used in the boot sequence.
:: activate the compiler gate. the product of this formula
:: is smaller than the formula. so you might think we should
:: save the gate itself rather than the formula producing it.
:: but we have to run the formula at runtime, to register jets.
::
:: as always, we have to use raw nock as we have no type.
:: the gate is in fact ++ride.
::
=+ ^= compiler-gate
.*(compiler-trap -:compiler-trap)
~> %slog.[0 leaf+"1-a"]
=+ ^= compiler-gate
.*(compiler-formula 0)
::
:: compile the compiler source, producing (pair span nock).
:: the compiler ignores its input so we use a trivial span.
::
~> %slog.[0 leaf+"1-b"]
=+ ^= compiler-tool
.*(compiler-gate(+< [%noun compiler-source]) -.compiler-gate)
::
:: run the nock to produce a new copy of the compiler trap;
:: check that it equals the old one.
:: check that the new compiler formula equals the old formula.
::
?> =(compiler-trap -:.*(0 +:compiler-tool))
~> %slog.[0 leaf+"1-c"]
?> =(compiler-formula -:.*(0 +:compiler-tool))
::
:: get the span (type) of the context of the compiler gate,
:: which is the compiler core. this is at tree address 15
:: from the span produced by compiling the compiler source,
:: which is the span of the compiler trap.
:: get the span (type) of the kernel, which is the context
:: of the compiler gate. we just compiled the compiler,
:: so we know the span (type) of the compiler gate. its
:: context is at tree address `+>` (ie, `+7` or Lisp `cddr`).
:: we use the compiler again to infer this trivial program.
::
~> %slog.[0 leaf+"1-d"]
=+ ^= compiler-span
.*(compiler-gate(+< [-.compiler-gate '+15']) -.compiler-gate)
-:.*(compiler-gate(+< [-.compiler-tool '+>']) -.compiler-gate)
::
:: compile the arvo source against the compiler core.
::
~> %slog.[0 leaf+"1-e"]
=+ ^= kernel-tool
.*(compiler-gate(+< [compiler-span kernel-source]) -.compiler-gate)
::
:: pass the compiler core to the arvo kernel, and we done
:: arvo kernel, and we done
::
~> %slog.[0 leaf+"1-f"]
.*(+>:compiler-gate +:kernel-tool)
42
::=+ ^=
::::
:::: load files. ship and desk are in generator beak. case is now.
:::: source files:
::::
:::: sys/hoon compiler
:::: sys/arvo kernel
:::: sys/zuse standard library
:::: sys/vane/ames network vane
:::: sys/vane/behn timer vane
:::: sys/vane/clay revision-control vane
:::: sys/vane/dill console vane
:::: sys/vane/eyre web/internet vane
:::: sys/vane/ford build vane
:::: sys/vane/gall app vane
:::: sys/vane/jael security vane
::::
::=+ top=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/arvo
::=+ ^= com
::=+ pax=`path`(weld top `path`[%hoon ~])
::~& %plastic-start
::=+ gen=(reck (weld
::~& %plastic-parsed
::=+ ken=q:(~(mint ut %noun) %noun gen)
::~& %plastic-compiled
:::- ken
::=+ all=.*(0 ken)
::=+ ^= vent
:: |= {abr/term den/path}
:: =+ pax=(weld top den)
:: =+ txt=.^(@ %cx (weld pax `path`[%hoon ~]))
:: `ovum`[[%vane den] [%veer abr pax txt]]
::=+ ^= evo
:: ^- (list ovum)
:: :~ (vent %$ /zuse)
:: [[%name (scot %p who) ~] [%veal who]]
:: (vent %c /vane/clay)
:: (vent %g /vane/gall)
:: (vent %f /vane/ford)
:: (vent %a /vane/ames)
:: (vent %b /vane/behn)
:: (vent %d /vane/dill)
:: (vent %e /vane/eyre)
:: ==
::|- ^+ all
::?~ evo all
::~& [%plastic-step p.i.evo]
::=+ gat=.*(all .*(all [0 42]))
::=+ nex=+:.*([-.gat [[now i.evo] +>.gat]] -.gat)
::$(evo t.evo, all nex)
::
:: load files. ship and desk are in generator beak. case is now.
:: source files:
::
:: sys/hoon compiler
:: sys/arvo kernel
:: sys/zuse standard library
:: sys/vane/ames network vane
:: sys/vane/behn timer vane
:: sys/vane/clay revision-control vane
:: sys/vane/dill console vane
:: sys/vane/eyre web/internet vane
:: sys/vane/ford build vane
:: sys/vane/gall app vane
:: sys/vane/jael security vane
::
=+ sys=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/sys
=+ compiler-source=.^(@t %cx (welp sys /hoon/hoon))
~& %metal-parsing
=+ compiler-twig=(ream compiler-source)
~& %metal-parsed
=+ compiler-trap=q:(~(mint ut %noun) %noun compiler-twig)
~& %metal-compiled
=+ kernel-source=.^(@t %cx (welp sys /arvo/hoon))
=+ ^= vane-sequence
|^ ^- (list ovum)
:~ (vent %$ /zuse)
[[%name (scot %p who) ~] [%veal who]]
(vent %c /vane/clay)
(vent %g /vane/gall)
(vent %f /vane/ford)
(vent %a /vane/ames)
(vent %b /vane/behn)
(vent %d /vane/dill)
(vent %e /vane/eyre)
(vent %j /vane/jael)
==
::
++ vent
|= {abr/term den/path}
=+ pax=(weld sys den)
=+ txt=.^(@ %cx (welp pax /hoon))
`ovum`[[%vane den] [%veer abr pax txt]]
--
~& %metal-firing
^- @p
%- mug
.* :* event-zero
event-one
compiler-trap
compiler-source
kernel-source
vane-sequence
==
[2 [0 3] [0 2]]

575
sys/arvo.hoon Normal file
View File

@ -0,0 +1,575 @@
:: ::
:::: 6: layer six
::
=< |= ovo/*
~> %slog.[0 leaf/"arvo-event"]
.(+>
+:(poke *@da ovo)
~% %hex + ~
|%
::
:::: 6a: arvo core
::
++ mean |=(a/tang (fear (flop a) |.(!!))) :: deify stack trace
++ fear :: insert user mean
|* {a/tang _|?(**)}
^+ (+<+)
=> .(a `tang`a)
?~ a (+<+)
~_(i.a $(a t.a))
::
++ slog :: deify printf
=| pri/@ :: priority level
|= a/tang ^+ same :: .= ~&(%a 1)
?~(a same ~>(%slog.[pri i.a] $(a t.a))) :: ((slog ~[>%a<]) 1)
::
++ sloy
|= sod/slyd
^- slyt
|= {ref/* raw/*}
=+ pux=((soft path) raw)
?~ pux ~
?. ?=({@ @ @ @ *} u.pux) ~
=+ :* hyr=(slay i.u.pux)
fal=(slay i.t.u.pux)
dyc=(slay i.t.t.u.pux)
ved=(slay i.t.t.t.u.pux)
tyl=t.t.t.t.u.pux
==
?. ?=({$~ $$ $tas @} hyr) ~
?. ?=({$~ $$ $p @} fal) ~
?. ?=({$~ $$ $tas @} dyc) ~
?. ?=(^ ved) ~
=+ ron=q.p.u.hyr
=+ bed=[[q.p.u.fal q.p.u.dyc (case p.u.ved)] (flop tyl)]
=+ bop=(sod ref ~ ron bed)
?~ bop ~
?~ u.bop [~ ~]
[~ ~ +.q.u.u.bop]
::
++ vent :: vane core
|= {lal/@tas vil/vile bud/vase sew/(pair worm vase)}
~% %vent +>+ ~
|%
++ ruck :: update vase
|= {pax/path txt/@ta}
^+ +>
=- ?:(?=($| -.res) ((slog p.res) +>.$) p.res)
^= res %- mule |.
=+ arg=[~2000.1.1 0 =>(~ |~(* ~))]
=+ rig=(slym q.sew arg)
=+ rev=(slym (slap bud (rain pax txt)) bud)
=+ syg=(slym rev arg)
~| %load-lost
+>.^$(q.sew (slam (slap syg [%limb %load]) (slap rig [%limb %stay])))
::
++ wink :: deploy
|= {now/@da eny/@ ski/slyd}
=+ rig=(slym q.sew +<) :: activate vane
~% %wink +>+> ~
|%
++ doze
|= {now/@da hen/duct}
^- (unit @da)
((hard (unit @da)) q:(slym (slap rig [%limb %doze]) +<))
::
++ 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=(slot 6 gat)
=+ ^= hig
?- -.hil
$& (~(nest wa p.sew) p.sam p.p.hil)
$| (~(nets wa p.sew) p.sam p.p.hil)
==
?.(-.hig ~ `[(slym gat +>.hil) +.hig])
::
++ 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-z ~/(%slur-z |=({gat/vase hil/mill} =+(%z (slur gat hil))))
::
++ slur-pro :: profiling slur
~/ %slur-pro
|= {lal/@tas gat/vase hil/mill}
?+ lal (slur-z gat hil)
$a (slur-a gat hil)
$b (slur-b gat hil)
$c (slur-c gat hil)
$d (slur-d gat hil)
$e (slur-e gat hil)
$f (slur-f gat hil)
$g (slur-g gat hil)
==
::
++ song :: reduce metacard
~/ %song ::
|= mex/vase :: mex: vase of card
^- (unit (pair mill worm)) ::
=^ hip p.sew (~(nell wa p.sew) p.mex) ::
?. hip ~ :: a card is a cell
?. ?=($meta -.q.mex) `[[%& mex] p.sew] :: ordinary card
=^ tiv p.sew (~(slot wa p.sew) 3 mex) ::
=^ hip p.sew (~(nell wa p.sew) p.tiv) ::
?. hip ~ :: a vase is a cell
=^ vax p.sew (~(slot wa p.sew) 2 tiv) ::
=^ hip p.sew (~(nest wa p.sew) typ.vil p.vax) ::
?. hip ~ :: vase head is span
%+ biff ::
=+ mut=(milt q.tiv) :: card span, value
|- ^- (unit (pair milt worm)) ::
?. ?=({$meta p/* q/milt} q.mut) `[mut p.sew] :: ordinary metacard
=^ hip p.sew (~(nets wa p.sew) 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 p.sew (~(spot wa p.sew) 3 wec)
?+ q.caq [%| (cat 3 %funk (@tas 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 p.sew (~(spot wa p.sew) 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 p.sew (~(spot wa p.sew) 3 caq)
%+ bind (song yav)
|= {hil/mill vel/worm}
[%& [%give hil] vel]
::
{$sick p/{p/@tas q/*}}
%- (bond |.([%| p.p.q.caq]))
=^ yav p.sew (~(spot wa p.sew) 3 caq)
%+ bind (song yav)
|= {hil/mill vel/worm}
[%& [%sick 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 p.sew (~(spot wa p.sew) 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) [~ p.sew]
=^ hed p.sew (~(slot wa p.sew) 2 vud)
=^ tal p.sew (~(slot wa p.sew) 3 vud)
=^ mov p.sew (need (sump hed))
=^ moz p.sew $(vud tal)
[[mov moz] p.sew]
::
++ scry :: read namespace
~/ %scry
|= $: fur/(unit (set monk))
ren/@t
bed/beam
==
^- (unit (unit (cask)))
:: ~& [%arvo-scry ren bed]
=+ ^= old
:* fur
ren
[%& p.bed]
q.bed
`coin`[%$ r.bed]
(flop s.bed)
==
^- (unit (unit (cask)))
=+ pro=(slym (slap rig [%limb %scry]) old)
?~ q.pro ~
?~ +.q.pro [~ ~]
=+ dat=(slot 7 pro)
[~ ~ (mark -.q.dat) +.q.dat]
::
++ soar :: scrub vane
|= sev/vase
^- vase
?: &(=(-.q.q.sew -.q.sev) =(+>.q.q.sew +>.q.sev))
q.sew :: unchanged, use old
sev(+<.q [*@da *@ =>(~ |~(* ~))]) :: clear to stop leak
::
++ swim
~/ %swim
|= $: org/@tas
pux/(unit wire)
hen/duct
hil/mill
==
^- {{p/(list move) q/worm} q/vase}
:: ~& [%swim-wyt `@ud`~(wyt in p.sew)]
=+ ^= pru
?~ pux
~| [%swim-call-vane lal ({term $~} +.p.hil)]
=^ vax p.sew (~(slap wa p.sew) rig [%limb %call])
%^ slur-pro lal vax
(slid [%& duc.vil hen] (slix hil))
~| [%swim-take-vane lal ({term $~} +.p.hil)]
=^ vax p.sew (~(slap wa p.sew) 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 (@tas +>-.hil)]
[[~ p.sew] q.sew]
=^ pro p.sew (need pru)
=^ moz p.sew (~(slap wa p.sew) pro [%limb %p])
=^ vem p.sew (~(slap wa p.sew) pro [%limb %q])
[(said moz) (soar vem)]
--
--
::
++ vint :: create vane
|= {lal/@tas vil/vile bud/vase pax/path txt/@ta} ::
=- ?:(?=($| -.res) ((slog p.res) ~) (some p.res))
^= res %- mule |.
(vent lal vil bud *worm (slym (slap bud (rain pax txt)) bud))
::
++ viol :: vane tools
|= but/span
^- vile
=+ pal=|=(a/@t ^-(span (~(play ut but) (vice a))))
:* typ=(pal '*span')
duc=(pal '*duct')
pah=(pal '*path')
mev=(pal '*{$meta $vase}')
==
::
++ is :: operate in time
|= {vil/vile eny/@ bud/vase niz/(pair worm (list {p/@tas q/vase}))}
|_ now/@da
++ beck
^- slyd
|= {* fur/(unit (set monk)) ron/term bed/beam}
^- (unit (unit (cask)))
=> .(fur ?^(fur fur `[[%& p.bed] ~ ~])) :: XX heinous
=+ lal=(end 3 1 ron)
=+ ren=(rsh 3 1 ron)
|- ^- (unit (unit (cask)))
?~ q.niz ~
?. =(lal p.i.q.niz) $(q.niz t.q.niz)
%- scry:(wink:(vent lal vil bud p.niz q.i.q.niz) now (shax now) ..^$)
[fur ren bed]
::
++ dink :: vase by char
|= din/@tas ^- vase
?~(q.niz !! ?:(=(din p.i.q.niz) q.i.q.niz $(q.niz t.q.niz)))
::
++ dint :: input routing
|= hap/path ^- @tas
?+ hap !!
{@ $ames *} %a
{@ $boat *} %c
{@ $newt *} %a
{@ $sync *} %c
{@ $term *} %d
{@ $http *} %e
{@ $behn *} %b
==
::
++ doos :: sleep until
|= hap/path ^- (unit @da)
=+ lal=(dint hap)
(doze:(wink:(vent lal vil bud p.niz (dink lal)) now 0 beck) now [hap ~])
::
++ hurl :: start loop
|= {lac/? ovo/ovum}
~? &(!lac !=(%belt -.q.ovo)) [%unix -.q.ovo p.ovo]
^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))}
?> ?=(^ p.ovo)
%+ kick lac
:~ :* i.p.ovo
~
:^ %pass t.p.ovo
(dint p.ovo)
:+ %&
[%cell [%atom %tas `%soft] %noun]
[%soft q.ovo]
==
==
::
++ race :: take
|= {org/@tas lal/@tas pux/(unit wire) hen/duct hil/mill ves/vase}
^- {p/{p/(list move) q/worm} q/vase}
=+ ven=(vent lal vil bud [p.niz ves])
=+ win=(wink:ven now (shax now) beck)
(swim:win org pux hen hil)
::
++ fire :: execute
|= {org/term lal/term pux/(unit wire) hen/duct hil/mill}
?: &(?=(^ pux) ?=($~ hen))
[[[[lal u.pux] (curd +>.hil)]~ ~] niz]
=+ naf=q.niz
|- ^- {{p/(list ovum) q/(list muse)} _niz}
?~ naf [[~ ~] [p.niz ~]]
?. =(lal p.i.naf)
=+ tuh=$(naf t.naf)
[-.tuh [+<.tuh [i.naf +>.tuh]]]
=+ fiq=(race org lal pux hen hil q.i.naf)
[[~ (turn p.p.fiq |=(a/move [lal a]))] [q.p.fiq [[p.i.naf q.fiq] t.naf]]]
::
++ jack :: dispatch card
|= {lac/? gum/muse}
^- {{p/(list ovum) q/(list muse)} _niz}
:: =. lac |(lac ?=(?(%g %f) p.gum))
:: =. lac &(lac !?=($b p.gum))
%+ fire
p.gum
?- -.r.gum
$pass
~? &(!lac !=(%$ p.gum))
:^ %pass [p.gum p.q.r.gum]
[(@tas +>-.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.r.gum]
!!
~? &(!lac |(!=(%blit +>-.p.r.gum) !=(%d p.gum)))
[%give p.gum (@tas +>-.p.r.gum) `duct`q.gum]
[i.i.q.gum [~ t.i.q.gum] t.q.gum p.r.gum]
::
$slip
~? !lac [%slip p.gum (@tas +>-.q.p.r.gum) q.gum]
[p.p.r.gum ~ q.gum q.p.r.gum]
::
$sick
?> ?=(^ q.gum)
?> ?=(^ i.q.gum)
~? !lac [%sick p.gum (@tas +>-.p.r.gum) `duct`q.gum]
[i.i.q.gum ?~(t.i.q.gum ~ [~ t.i.q.gum]) t.q.gum p.r.gum]
==
::
++ kick :: new main loop
|= {lac/? mor/(list muse)}
=| ova/(list ovum)
|- ^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))}
?~ mor [(flop ova) niz]
=^ nyx niz (jack lac i.mor)
$(ova (weld p.nyx ova), mor (weld q.nyx t.mor))
--
--
::
:::: Arvo interface
::
=+ pit=`vase`!>(.) ::
!:
=+ vil=(viol p.pit) :: cached reflexives
=| $: lac/? :: laconic bit
bod/(unit vase) :: standard library
urb/(unit ship) :: identity
eny/@ :: entropy
niz/(pair worm (list {p/@tas q/vase})) :: modules
== ::
=< |%
++ come |= {@ (list ovum) pone} :: 11
^- {(list ovum) _+>}
~& %hoon-come
=^ rey +>+ (^come +<)
[rey +>.$]
++ keep |=(* (^keep ((hard {@da path}) +<))) :: 4
++ load |= {@ (list ovum) pane} :: 86
^- {(list ovum) _+>}
~& %hoon-load
=^ rey +>+ (^load +<)
[rey +>.$]
++ peek |=(* (^peek ((hard {@da path}) +<))) :: 87
++ poke |= * :: 42
^- {(list ovum) _+>}
=> .(+< ((hard {now/@da ovo/ovum}) +<))
=^ ova +>+ (^poke now ovo)
|- ^- {(list ovum) _+>}
?~ ova
[~ +>.^$]
?: ?=($verb -.q.i.ova)
$(ova t.ova, lac !lac)
?: ?=($veer -.q.i.ova)
$(ova t.ova, +>+.^$ (veer now q.i.ova))
?: ?=($vega -.q.i.ova)
(fall (vega now t.ova (path +.q.i.ova)) [~ +>.^$])
?: ?=(?($init $veal) -.q.i.ova)
=+ avo=$(ova t.ova, +>+.^$ (boot (@ +.q.i.ova)))
[[i.ova -.avo] +.avo]
?: ?=($mass -.q.i.ova)
=+ avo=$(ova t.ova)
:_ +.avo
:_ -.avo
%= i.ova
q.q
:- %userspace
:- %|
:~ hoon+`pit
zuse+`mast
hoon-cache+`p.niz
q.q.i.ova
dot+`.
==
==
=+(avo=$(ova t.ova) [[i.ova -.avo] +.avo])
++ wish |=(* (^wish ((hard @ta) +<))) :: 20
--
|%
++ boot :: set singlehome
|= {who/@p}
^+ +>
?: &(?=(^ urb) (lth u.urb who)) +>
+>(urb `who, bod ?~(bod ~ bod(-.q.u who)))
::
++ come :: load incompatible
|= {yen/@ ova/(list ovum) nyf/pone}
^+ [ova +>]
(load yen ova (turn nyf |=({a/@tas b/vise} [a (slim b)])))
::
++ keep :: wakeup delay
|= {now/@da hap/path}
=> .(+< ((hard {now/@da hap/path}) +<))
(~(doos (is vil eny mast niz) now) hap)
::
++ load :: load compatible
|= {yen/@ ova/(list ovum) nyf/pane}
^+ [ova +>]
=: eny yen
q.niz nyf
==
|- ^+ [ova +>.^$]
?~ ova
[~ +>.^$]
?: ?=($verb -.q.i.ova)
$(ova t.ova, lac !lac)
?: ?=($veer -.q.i.ova)
$(ova t.ova, +>.^$ (veer *@da q.i.ova))
=+(avo=$(ova t.ova) [[i.ova -.avo] +.avo])
::
++ mast ?~(bod pit u.bod) :: stdlib if installed
++ peek :: external inspect
|= {now/@da hap/path}
^- (unit)
?~ hap [~ hoon]
=+ rob=((sloy ~(beck (is vil eny mast niz) now)) [151 %noun] hap)
?~ rob ~
?~ u.rob ~
[~ u.u.rob]
::
++ poke :: external apply
|= {now/@da ovo/ovum}
^- {(list ovum) _+>}
=. eny (mix eny (shaz now))
:: ~& [%poke -.q.ovo]
?: ?=(?($veer $vega $verb $veal) -.q.ovo)
::
:: these effects on arvo proper fall through and
:: are handled in post.
::
[[ovo ~] +>.$]
=^ zef niz
(~(hurl (is vil eny mast niz) now) lac ovo)
[zef +>.$]
::
++ vega :: reboot kernel
|= {now/@da ova/(list ovum) hap/path}
^- (unit {p/(list ovum) q/*})
=- ?:(?=($| -.res) ((slog p.res) ~) `p.res)
^= res %- mule |.
=+ pax=(weld hap `path`[%hoon ~])
~& [%vega-start hap]
=+ src=((hard @t) (need (peek now cx+pax)))
=+ saz=(shax src)
=+ gen=(rain hap src)
~& %vega-parsed
=+ ken=.*(0 q:(~(mint ut %noun) %noun gen))
=+ ^= nex
=+ gat=.*(ken .*(ken [0 87]))
(need ((hard (unit @)) .*([-.gat [[now ~] +>.gat]] -.gat)))
~& [%vega-compiled hoon nex]
?> (lte nex hoon)
=+ gat=.*(ken .*(ken [0 ?:(=(nex hoon) 86 11)]))
=+ sam=[eny ova q.niz]
=+ raw=.*([-.gat [sam +>.gat]] -.gat)
[[[~ %vega hap] ((list ovum) -.raw)] +.raw]
::
++ veer :: install vane/tang
|= {now/@da fav/curd}
=> .(fav ((hard {$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)
=+ orb=`@p`?~(urb 0xffff.ffff.ffff.ffff.ffff.ffff.ffff.ffff u.urb)
+>.^$(bod `[[%cell [%face %our [%atom %p ~]] p.vax] [orb q.vax]])
%_ +>.^$
q.niz
|- ^+ q.niz
?~ q.niz
~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)]
=+ vin=(vint lal.fav vil mast pax.fav txt.fav)
?~ vin
q.niz
[[lal.fav q.sew:u.vin] q.niz]
?. =(lal.fav p.i.q.niz)
[i.q.niz $(q.niz t.q.niz)]
~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)]
:_ t.q.niz
:- p.i.q.niz
q.sew:(ruck:(vent lal.fav vil mast [p.niz q.i.q.niz]) pax.fav txt.fav)
==
::
++ wish :: external compute
|= txt/@
q:(slap mast (ream txt))
--

9862
sys/hoon.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

2229
sys/vane/ames.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

225
sys/vane/behn.hoon Normal file
View File

@ -0,0 +1,225 @@
!: :: %behn, just a timer
!? 164
::::
=, ^behn
|= pit/vase
=> =~
|%
++ sqeu |* {a/_* b/_*} :: binary skew queno
$: r/@u :: rank+depth
k/a :: priority
n/b :: value
c/(broq a b) :: children
== ::
++ broq |* {a/_* b/_*} :: brodal skew qeu
(list (sqeu a b)) ::
++ move {p/duct q/(wind note gift:able)} :: local move
++ note $~ :: out request $->
++ sign $~ :: in result $<-
++ clok (broq @da duct) :: stored timers
--
::
|%
++ raze
|= tym/{p/clok q/clok}
^+ tym
?~ p.tym tym
?~ q.tym tym
?: (gth p:~(get up p.tym) p:~(get up q.tym)) :: killed nonexisting
~& [%snooze-lost del=p:~(get up q.tym) top=p:~(get up p.tym)]
$(q.tym ~(pop up q.tym))
?: =(~(get up p.tym) ~(get up q.tym))
$(tym [~(pop up p.tym) ~(pop up q.tym)])
tym
::
++ up :: priority queue
=+ [key=@da val=duct]
=+ cmp=lte :: lte=min, gte=max
=> |%
++ link
|= {p/(sqeu key val) q/(sqeu key val)} :: link eq rank
^- (sqeu key val)
?> =(r.p r.q)
?: (cmp k.p k.q)
[r=+(r.p) k=k.p n=n.p c=[i=q t=c.p]]
[r=+(r.q) k=k.q n=n.q c=[i=p t=c.q]]
::
++ sink :: skew link
|= {p/(sqeu key val) q/(sqeu key val) r/(sqeu key val)}
^- (sqeu key val)
?: &((cmp k.q k.p) (cmp k.q k.r))
[r=+(r.q) k=k.q n=n.q c=[i=p t=[i=r t=c.q]]]
?: &((cmp k.r k.p) (cmp k.r k.q))
[r=+(r.r) k=k.r n=n.r c=[i=p t=[i=q t=c.r]]]
[r=+(r.q) k=k.p n=n.p c=[i=q t=[i=r t=~]]]
::
++ sert :: internal ins op
|= {p/(sqeu key val) q/(broq key val)}
^- (broq key val)
?~ q [p ~]
?> (lte r.p r.i.q)
?: (lth r.p r.i.q)
[i=p t=q]
$(p (link p i.q), q t.q)
::
++ uniq :: remove init dup
|= q/(broq key val)
?~ q ~
(sert i.q t.q)
::
++ meek :: unique meld
|= {p/(broq key val) q/(broq key val)}
^- (broq key val)
?~ p q
?~ q p
?: (lth r.i.p r.i.q)
[i.p $(p t.p)]
?: (lth r.i.q r.i.p)
[i.q $(q t.q)]
(sert (link i.p i.q) $(p t.p, q t.q))
::
++ mini :: getmin
|= q/(broq key val)
^- p/{(sqeu key val) (broq key val)}
?~ q ~|(%fatal-mini-empty !!)
?~ t.q [i=i.q t=~]
=+ [l r]=$(q t.q)
?: (cmp k.i.q k.l)
[i.q t.q]
[l [i.q r]]
::
++ spit :: split
|= {p/(broq key val) q/(list {k/key n/val}) r/(broq key val)}
^- {t/(broq key val) x/(list {k/key n/val})}
?~ r
[t=p x=q]
?: =(0 r.i.r)
$(q [[k=k.i.r n=n.i.r] q], r t.r)
$(p [i.r p], r t.r)
--
|_ a/(broq key val) :: public interface
++ put :: insert element
|= {k/key n/val}
^+ a
?~ a [i=[r=0 k=k n=n c=~] t=~]
?~ t.a [i=[r=0 k=k n=n c=~] t=a]
?: =(r.i.a r.i.t.a)
[i=(sink [r=0 k=k n=n c=~] i.a i.t.a) t=t.t.a]
[i=[r=0 k=k n=n c=~] t=a]
::
++ pop :: remove top
^+ a
=+ ?~ a ~|(%empty-broq-pop !!)
[l r]=(mini a)
=+ [t x]=(spit ~ ~ c.l)
=. a r
=. a (uni t)
(gas x)
::
++ gas
|= b/(list {k/key n/val})
^+ a
(roll b |=({{k/key n/val} q/_a} (put(a q) k n)))
::
++ tap
^- (list {k/key n/val})
?~ a ~
[get tap(a pop)]
::
++ get :: retrieve top
^- {p/key q/val}
?~ a ~|(%empty-broq-peek !!)
?~ t.a [k n]:i.a
=+ m=get(a t.a)
?.((cmp k.i.a p.m) m [k n]:i.a)
::
++ uni :: merge
|= q/(broq key val)
^+ a
(meek (uniq a) (uniq q))
--
--
. ==
=| $: $0 ::
tym/{p/clok q/clok} :: positive+negative
== ::
|= {now/@da eny/@ ski/sley} :: current invocation
^?
|% :: poke+peek pattern
++ call :: handle request
|= $: hen/duct
hic/(hypo (hobo task:able))
==
^- {p/(list move) q/_..^$}
=> %= . :: XX temporary
q.hic
^- task:able
?: ?=($soft -.q.hic)
:: ~& [%behn-call-soft (,@tas `*`-.p.q.hic)]
((hard task:able) p.q.hic)
?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic
~& [%behn-call-flub (@tas `*`-.q.hic)]
((hard task:able) q.hic)
==
=^ mof tym
?- -.q.hic
$rest
=. q.tym (~(put up q.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
::
$wait
=. p.tym (~(put up p.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
::
$wake
|- ^+ [*(list move) tym]
=. tym (raze tym)
?: =([~ ~] tym) [~ tym] :: XX TMI
?: =(~ p.tym)
~& %weird-wake [~ tym]
=+ nex=~(get up p.tym)
?: (lte now p.nex) [~ tym]
=^ mof tym $(p.tym ~(pop up p.tym))
[[`move`[q.nex %give %wake ~] mof] tym]
::
$wegh
:_ tym :_ ~
:^ hen %give %mass
:- %behn
:- %|
:~ tym+[%& tym]
==
==
[mof ..^$]
::
++ doze
|= {now/@da hen/duct}
^- (unit @da)
?~ p.tym ~
(some p:[~(get up p.tym)])
::
++ load
|= old/{$0 tym/{clok clok}}
^+ ..^$
..^$(tym tym.old)
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
^- (unit (unit cage))
?. ?=($& -.why) ~
=* who p.why
=+ ^= liz
|- ^- (list {@da duct})
=. tym (raze tym)
?~ p.tym ~
[~(get up p.tym) $(p.tym ~(pop up p.tym))]
[~ ~ %tank !>(>liz<)]
::
++ stay [%0 tym]
++ take :: process move
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]
!!
--

3701
sys/vane/clay.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

536
sys/vane/dill.hoon Normal file
View File

@ -0,0 +1,536 @@
!:
:: dill (4d), terminal handling
::
|= pit/vase
=, ^dill
=> |% :: interface tiles
++ gill (pair ship term) :: general contact
-- ::
=> |% :: console protocol
++ all-axle ?(old-axle axle) ::
++ old-axle :: all dill state
$: $2 ::
ore/(unit ship) :: identity once set
hey/(unit duct) :: default duct
dug/(map duct axon) :: conversations
== ::
++ axle ::
$: $3 ::
ore/(unit ship) :: identity once set
hey/(unit duct) :: default duct
dug/(map duct axon) :: conversations
$= hef :: other weights
$: a/(unit mass) ::
b/(unit mass) ::
c/(unit mass) ::
e/(unit mass) ::
f/(unit mass) ::
g/(unit mass) ::
== ::
== ::
++ axon :: dill per duct
$: ram/term :: console program
tem/(unit (list dill-belt)) :: pending, reverse
wid/_80 :: terminal width
pos/@ud :: cursor position
see/(list @c) :: current line
== ::
-- => ::
|% :: protocol outward
++ mess ::
$% {$dill-belt p/(hypo dill-belt)} ::
== ::
++ move {p/duct q/(wind note gift:able)} :: local move
++ note-ames :: weird ames move
$% {$make p/(unit @t) q/@ud r/@ s/?} ::
{$sith p/@p q/@uw r/?} ::
== ::
++ note-clay ::
$% {$merg p/@p q/@tas r/@p s/@tas t/case u/germ:^clay}:: merge desks
{$warp p/sock q/riff:^clay} :: wait for clay hack
== ::
++ note-dill :: note to self, odd
$% {$crud p/@tas q/(list tank)} ::
{$heft $~} ::
{$init p/ship} ::
{$text p/tape} ::
{$veer p/@ta q/path r/@t} :: install vane
{$vega p/path} :: reboot by path
{$verb $~} :: verbose mode
== ::
++ note-gall ::
$% {$conf dock $load ship desk} ::
{$deal p/sock q/cush:^gall} ::
== ::
++ note :: out request $->
$? {?($a $b $c $e $f $g) $wegh $~} ::
$% {$a note-ames} ::
{$c note-clay} ::
{$d note-dill} ::
{$g note-gall} ::
== == ::
++ sign-ames ::
$% {$nice $~} ::
{$init p/ship} ::
== ::
++ sign-clay ::
$% {$mere p/(each (set path) (pair term tang))} ::
{$note p/@tD q/tank} ::
{$writ p/riot:^clay} ::
== ::
++ sign-dill ::
$% {$blit p/(list blit)} ::
== ::
++ sign-gall ::
$% {$onto p/(each suss:^gall tang)} ::
{$unto p/cuft:^gall} ::
== ::
++ sign :: in result $<-
$? {?($a $b $c $e $f $g) $mass p/mass} ::
$% {$a sign-ames} ::
{$c sign-clay} ::
{$d sign-dill} ::
{$g sign-gall} ::
== == ::
:::::::: :: dill tiles
--
=| all/axle
|= {now/@da eny/@ ski/sley} :: current invocation
=> |%
++ as :: per cause
|_ $: {moz/(list move) hen/duct our/ship}
axon
==
++ abet :: resolve
^- {(list move) axle}
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
::
++ call :: receive input
|= kyz/task:able
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
$flow +>
$harm +>
$hail (send %hey ~)
$belt (send `dill-belt`p.kyz)
$text (from %out (tuba p.kyz))
$crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
$blew (send %rez p.p.kyz q.p.kyz)
$heft heft
$tick =+ ^= ges ^- gens:^ames
:- %en
=+ can=(clan:title:jael p.kyz)
?- can
$czar [%czar ~]
$duke [%duke %anon ~]
$earl [%earl (scot %p p.kyz)]
$king [%king (scot %p p.kyz)]
$pawn [%pawn ~]
==
=+ yen=(scot %p (shax :(mix %ticket eny now)))
=+ ^= beg ^- {his/@p tic/@p yen/@t ges/gens:^ames}
[p.kyz q.kyz yen ges]
=+ cmd=[%hood %poke `cage`[%helm-begin !>(beg)]]
%= +>.$
moz
:_(moz [hen %pass ~ %g %deal [our our] cmd])
==
$veer (dump kyz)
$vega (dump kyz)
$verb (dump kyz)
==
::
++ crud
|= {err/@tas tac/(list tank)}
=+ ^= wol ^- wall
:- (trip err)
(zing (turn (flop tac) |=(a/tank (~(win re a) [0 wid]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (from %out (tuba i.wol)))
::
++ dump :: pass down to hey
|= git/gift:able
?> ?=(^ hey.all)
+>(moz [[u.hey.all %give git] moz])
::
++ done :: return gift
|= git/gift:able
+>(moz :_(moz [hen %give git]))
::
++ from :: receive belt
|= bit/dill-blit
^+ +>
?: ?=($mor -.bit)
|- ^+ +>.^$
?~ p.bit +>.^$
$(p.bit t.p.bit, +>.^$ ^$(bit i.p.bit))
?: ?=($out -.bit)
%+ done %blit
:~ [%lin p.bit]
[%mor ~]
[%lin see]
[%hop pos]
==
?: ?=($klr -.bit)
%+ done %blit
:~ [%lin (cvrt:ansi p.bit)]
[%mor ~]
[%lin see]
[%hop pos]
==
?: ?=($pro -.bit)
(done(see p.bit) %blit [[%lin p.bit] [%hop pos] ~])
?: ?=($pom -.bit)
=. see (cvrt:ansi p.bit)
(done %blit [[%lin see] [%hop pos] ~])
?: ?=($hop -.bit)
(done(pos p.bit) %blit [bit ~])
?: ?=($qit -.bit)
(dump %logo ~)
(done %blit [bit ~])
::
++ ansi
|%
++ cvrt :: stub to (list @c)
|= a/stub :: with ANSI codes
^- (list @c)
%- zing %+ turn a
|= a/(pair stye (list @c))
^- (list @c)
;: weld
?: =(0 ~(wyt in p.p.a)) ~
`(list @c)`(zing (turn (~(tap in p.p.a)) ef))
(bg p.q.p.a)
(fg q.q.p.a)
q.a
?~(p.p.a ~ (ef ~))
(bg ~)
(fg ~)
==
::
++ ef |=(a/^deco (scap (deco a))) :: ANSI effect
::
++ fg |=(a/^tint (scap (tint a))) :: ANSI foreground
::
++ bg :: ANSI background
|= a/^tint
%- scap
=>((tint a) [+(p) q]) :: (add 10 fg)
::
++ scap :: ANSI escape seq
|= a/$^((pair @ @) @)
%- (list @c)
:+ 27 '[' :: "\033[{a}m"
?@(a :~(a 'm') :~(p.a q.a 'm'))
::
++ deco :: ANSI effects
|= a/^deco ^- @
?- a
$~ '0'
$br '1'
$un '4'
$bl '5'
==
::
++ tint :: ANSI colors (fg)
|= a/^tint
^- (pair @ @)
:- '3'
?- a
$k '0'
$r '1'
$g '2'
$y '3'
$b '4'
$m '5'
$c '6'
$w '7'
$~ '9'
==
--
::
++ heft
%_ .
moz
:* [hen %pass /heft/ames %a %wegh ~]
[hen %pass /heft/behn %b %wegh ~]
[hen %pass /heft/clay %c %wegh ~]
[hen %pass /heft/eyre %e %wegh ~]
[hen %pass /heft/ford %f %wegh ~]
[hen %pass /heft/gall %g %wegh ~]
moz
==
==
::
++ init :: initialize
~& [%dill-init our ram]
=+ myt=(flop (need tem))
=+ can=(clan:title:jael our)
=. tem ~
=. moz :_(moz [hen %pass / %c %merg our %home our %base da+now %init])
=. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]])
=. +> ?: ?=(?($czar $pawn) can) +>
(sync %base (sein:title:jael our) %kids)
=. +> ?: ?=(?($czar $pawn) can)
(sync %home our %base)
(init-sync %home our %base)
=. +> ?. ?=(?($duke $king $czar) can) +>
(sync %kids our %base)
=. +> autoload
=. +> peer
|- ^+ +>+
?~ myt +>+
$(myt t.myt, +>+ (send i.myt))
::
++ into :: preinitialize
|= gyl/(list gill)
%_ +>
tem `(turn gyl |=(a/gill [%yow a]))
moz
:_ moz
:* hen
%pass
/
%c
[%warp [our our] %base `[%sing %y [%ud 1] /]]
==
==
::
++ send :: send action
|= bet/dill-belt
?^ tem
+>(tem `[bet u.tem])
%_ +>
moz
:_ moz
[hen %pass ~ %g %deal [our our] ram %poke [%dill-belt -:!>(bet) bet]]
==
++ peer
%_ .
moz
:_(moz [hen %pass ~ %g %deal [our our] ram %peer /drum])
==
::
++ sync
|= syn/{desk ship desk}
%_ +>.$
moz
:_ moz
:* hen %pass /sync %g %deal [our our]
ram %poke %hood-sync -:!>(syn) syn
==
==
::
++ init-sync
|= syn/{desk ship desk}
%_ +>.$
moz
:_ moz
:* hen %pass /init-sync %g %deal [our our]
ram %poke %hood-init-sync -:!>(syn) syn
==
==
::
++ autoload
%_ .
moz
:_ moz
:* hen %pass /autoload %g %deal [our our]
ram %poke %kiln-start-autoload [%atom %n `~] ~
==
==
::
++ pump :: send diff ack
%_ .
moz
:_(moz [hen %pass ~ %g %deal [our our] ram %pump ~])
==
::
++ take :: receive
|= sih/sign
^+ +>
?- sih
{?($a $b $c $e $f $g) $mass *}
(wegt -.sih p.sih)
::
{$a $nice *}
:: ~& [%take-nice-ames sih]
+>
::
{$a $init *}
+>(moz :_(moz [hen %give +.sih]))
::
{$c $mere *}
?: ?=($& -.p.sih)
+>.$
(mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih)
::
{$g $onto *}
:: ~& [%take-gall-onto +>.sih]
?- -.+>.sih
$| (crud %onto p.p.+>.sih)
$& (done %blit [%lin (tuba "{<p.p.sih>}")]~)
==
::
{$g $unto *}
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
$coup ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
$quit peer
$reap ?~ p.p.+>.sih
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
$diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih))
$doff !!
==
::
{$c $note *}
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
{$c $writ *}
init
::
{$d $blit *}
(done +.sih)
==
::
++ wegh
^- mass
:- %dill
:- %|
:~ all+[%& [ore hey dug]:all]
==
::
++ wegt
|= {lal/?($a $b $c $e $f $g) mas/mass}
^+ +>
=. hef.all
?- lal
$a ~?(?=(^ a.hef.all) %double-mass-a hef.all(a `mas))
$b ~?(?=(^ b.hef.all) %double-mass-b hef.all(b `mas))
$c ~?(?=(^ c.hef.all) %double-mass-c hef.all(c `mas))
$e ~?(?=(^ e.hef.all) %double-mass-e hef.all(e `mas))
$f ~?(?=(^ f.hef.all) %double-mass-f hef.all(f `mas))
$g ~?(?=(^ g.hef.all) %double-mass-g hef.all(g `mas))
==
?. ?& ?=(^ a.hef.all)
?=(^ b.hef.all)
?=(^ c.hef.all)
?=(^ e.hef.all)
?=(^ f.hef.all)
?=(^ g.hef.all)
==
+>.$
%+ done(hef.all [~ ~ ~ ~ ~ ~])
%mass
=> [hef.all d=wegh]
[%vanes %| ~[u.a u.c d u.e u.f u.g u.b]]
--
::
++ ax :: make ++as
|= {hen/duct kyz/task:able} ::
?~ ore.all ~
=+ nux=(~(get by dug.all) hen)
?^ nux
(some ~(. as [~ hen u.ore.all] u.nux))
?. ?=($flow -.kyz) ~
%- some
%. q.kyz
%~ into as
:- [~ hen u.ore.all]
:* p.kyz
[~ ~]
80
0
(tuba "<awaiting {(trip p.kyz)}, this may take a few minutes>")
== ==
--
|% :: poke+peek pattern
++ call :: handle request
|= $: hen/duct
hic/(hypo (hobo task:able))
==
^+ [p=*(list move) q=..^$]
=> %= . :: XX temporary
q.hic
^- task:able
?: ?=($soft -.q.hic)
:: ~& [%dill-call-soft (@tas `*`-.p.q.hic)]
((hard task:able) p.q.hic)
?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic
~& [%dill-call-flub (@tas `*`-.q.hic)]
((hard task:able) q.hic)
==
?: ?=($boot -.q.hic)
:_(..^$ [hen %pass ~ (note %a p.q.hic)]~)
?: ?=($flog -.q.hic)
:: ~& [%dill-flog +.q.hic]
?: ?=({$crud $hax-init {$leaf *} $~} p.q.hic)
=+ him=(slav %p (crip p.i.q.p.q.hic))
:_(..^$ ?~(hey.all ~ [u.hey.all %give %init him]~))
?: ?=({$crud $hax-heft $~} p.q.hic)
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d %heft ~]~))
:_(..^$ ?~(hey.all ~ [u.hey.all %slip %d p.q.hic]~))
=. hey.all ?^(hey.all hey.all `hen)
?: ?=($init -.q.hic)
:: ~& [%call-init hen]
?: =(ore.all `p.q.hic)
[[hen %give q.hic]~ ..^$]
=: ore.all `p.q.hic
dug.all ~
==
=^ moz all abet:(need (ax (need hey.all) [%flow %hood ~]))
?: |((lth p.q.hic 256) (gte p.q.hic (bex 64))) [moz ..^$] :: XX HORRIBLE
[:_(moz [(need hey.all) %give %init p.q.hic]) ..^$]
=+ nus=(ax hen q.hic)
?~ nus
~& [%dill-no-flow q.hic]
[~ ..^$]
=^ moz all abet:(call:u.nus q.hic)
[moz ..^$]
::
++ doze
|= {now/@da hen/duct}
^- (unit @da)
~
::
++ load :: trivial
|= old/all-axle
?: ?=($2 -.old)
$(old [%3 ore hey dug ~ ~ ~ ~ ~ ~]:old)
..^$(all old)
:: |= old=* :: diable
:: ..^$(ore.all `~zod)
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
^- (unit (unit cage))
?. ?=($& -.why) ~
=* his p.why
[~ ~]
::
++ stay all
::
++ take :: process move
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]
?: =(~ ore.all)
?: ?=({$a $init *} q.hin)
:: ~& [%take-init hen]
=. hey.all ?^(hey.all hey.all `hen)
[[[hen %give +.q.hin] ~] ..^$]
:: [~ ..^$]
~& [%take-back q.hin]
[~ ..^$]
?. (~(has by dug.all) hen)
~& [%take-weird-sign q.hin]
~& [%take-weird-hen hen]
[~ ..^$]
=+ our=?>(?=(^ ore.all) u.ore.all)
=^ moz all
abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin)
[moz ..^$]
--

2058
sys/vane/eyre.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

1959
sys/vane/ford.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

1314
sys/vane/gall.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

1972
sys/vane/jael.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

4540
sys/zuse.hoon Normal file
View File

File diff suppressed because it is too large Load Diff