mirror of
https://github.com/urbit/shrub.git
synced 2024-12-15 04:22:48 +03:00
Merge branch 'ford-turbo-app' into ford-turbo
This commit is contained in:
Elliot Glaysher
commit
00e43a38ee
109
app/ford-turbo.hoon
Normal file
109
app/ford-turbo.hoon
Normal file
@ -0,0 +1,109 @@
|
||||
/+ ford-turbo
|
||||
::
|
||||
:: testing application for ford-turbo
|
||||
::
|
||||
:: To test our integration with clay, we have a minimal app which translates
|
||||
:: calls from vane move form to gall moves. This proxies filesystem calls
|
||||
:: back and forth.
|
||||
::
|
||||
=, clay
|
||||
::
|
||||
=/ test-pit=vase !>(.)
|
||||
=/ ford-gate (ford-turbo test-pit)
|
||||
::
|
||||
|%
|
||||
++ move (pair bone card)
|
||||
++ card
|
||||
$% [%warp wire sock riff]
|
||||
==
|
||||
--
|
||||
::
|
||||
|_ {bol/bowl:gall turbo/_(ford-gate)}
|
||||
:: +prep: clear the state on each reload
|
||||
::
|
||||
++ prep _`.
|
||||
:: +poke-atom: invoke with `:ford-turbo &atom 0`
|
||||
::
|
||||
++ poke-atom
|
||||
|= a/*
|
||||
^- [(list move) _+>.$]
|
||||
::
|
||||
=. turbo (turbo now.bol eny.bol our-scry)
|
||||
::
|
||||
=^ vane-moves turbo
|
||||
%- call:turbo
|
||||
:* duct=~[/ford-test] type=~ %make our.bol
|
||||
[%scry %c %x rail=[[our.bol %home] /hoon/code/gen]]
|
||||
==
|
||||
::
|
||||
(convert-moves vane-moves)
|
||||
:: clay response to a %multi
|
||||
::
|
||||
++ wris
|
||||
|= {way/wire p/case q/(set (pair care path))}
|
||||
^- [(list move) _+>.$]
|
||||
~& [%wris way p q]
|
||||
::
|
||||
=. turbo (turbo now.bol eny.bol our-scry)
|
||||
::
|
||||
=^ vane-moves turbo
|
||||
%- take:turbo
|
||||
:* wire=way duct=~ *type [%c %wris p q]
|
||||
==
|
||||
(convert-moves vane-moves)
|
||||
:: clay response to a %sing
|
||||
::
|
||||
++ writ
|
||||
|= {way/wire rot/riot}
|
||||
^- [(list move) _+>.$]
|
||||
~& [%writ way rot]
|
||||
::
|
||||
=. turbo (turbo now.bol eny.bol our-scry)
|
||||
::
|
||||
=^ vane-moves turbo
|
||||
%- take:turbo
|
||||
:* wire=way duct=~ *type [%c %writ rot]
|
||||
==
|
||||
(convert-moves vane-moves)
|
||||
:: +convert-moves: converts vane moves to gall moves
|
||||
::
|
||||
:: The moves that come out of a raw call to ford-turbo are set up for
|
||||
:: arvo. Change them so they're in gall format.
|
||||
::
|
||||
++ convert-moves
|
||||
|= vane-moves=(list move:ford-gate)
|
||||
^- [(list move) _+>.$]
|
||||
::
|
||||
=/ gall-moves=(list move)
|
||||
%+ murn vane-moves
|
||||
|= [=duct card=(wind note:ford-gate gift:able:ford-api:ford-gate)]
|
||||
^- (unit move)
|
||||
::
|
||||
?+ -.card !!
|
||||
%pass
|
||||
=* wire p.card
|
||||
?+ -.q.card !!
|
||||
%c `[ost.bol %warp wire sock.q.card riff.q.card]
|
||||
==
|
||||
::
|
||||
%give
|
||||
:: print out the result, but don't do anything else.
|
||||
~& [%give card]
|
||||
~
|
||||
==
|
||||
::
|
||||
~& [%gall-moves gall-moves]
|
||||
::
|
||||
[gall-moves +>.$]
|
||||
:: +our-scry: scry function for ford to use.
|
||||
::
|
||||
:: OK, so maybe we can't just scry here. When we hit .^, we're telling what's
|
||||
:: interpreting us to block if we can't answer synchronously. So the real deal
|
||||
:: is to always block, so ford will emit moves asking for everything asynchronously.
|
||||
++ our-scry
|
||||
|= [one=* two=(unit (set monk)) =term =beam]
|
||||
^- (unit (unit cage))
|
||||
::
|
||||
~& [%scrying-for term beam]
|
||||
~
|
||||
--
|
||||
@ -1438,7 +1438,11 @@
|
||||
::
|
||||
=< finalize
|
||||
::
|
||||
=/ date=@da ?>(?=(%da -.r.beak) p.r.beak)
|
||||
::
|
||||
=/ date=@da
|
||||
?: ?=(%da -.r.beak)
|
||||
p.r.beak
|
||||
da:.^(cass:clay %cw /(scot %p p.beak)/[q.beak]/(scot %da now))
|
||||
=/ =disc [p.beak q.beak]
|
||||
:: delete the now-dead clay subscription
|
||||
::
|
||||
@ -1990,9 +1994,11 @@
|
||||
::
|
||||
?- -.result.made
|
||||
%build-result
|
||||
~& [%build-result build-result.result.made]
|
||||
(apply-build-result made)
|
||||
::
|
||||
%blocks
|
||||
~& [%blocks (turn builds.result.made build-to-tape) scry-blocked.result.made]
|
||||
(apply-blocks build.made result.made sub-builds.made)
|
||||
==
|
||||
:: +do-live-scry-accounting: updates tracking for a live %scry build
|
||||
@ -2426,6 +2432,7 @@
|
||||
++ make
|
||||
|= =build
|
||||
^- build-receipt
|
||||
~& [%make (build-to-tape build)]
|
||||
:: accessed-builds: builds accessed/depended on during this run.
|
||||
::
|
||||
=| accessed-builds=(list ^build)
|
||||
@ -2724,6 +2731,7 @@
|
||||
?: already-blocked
|
||||
:: this resource was already blocked, so don't duplicate move
|
||||
::
|
||||
~& [%already-blocked resource]
|
||||
[build [%blocks ~ ~] accessed-builds |]
|
||||
::
|
||||
[build [%blocks ~ `scry-request] accessed-builds |]
|
||||
|
||||
@ -412,12 +412,12 @@
|
||||
leaf+"bad %writ response"
|
||||
(render "on sync" sud her syd)
|
||||
~
|
||||
=. let ?. ?=($w p.p.u.rot) let ((hard @ud) q.q.r.u.rot)
|
||||
=. let ?. ?=($w p.p.u.rot) let ud:((hard cass:clay) q.q.r.u.rot)
|
||||
%- blab ^- (list move) :_ ~
|
||||
:* ost %merg
|
||||
[%kiln %sync syd (scot %p her) sud ?:(reset /reset /)]
|
||||
our syd her sud ud+let
|
||||
?: =(0 .^(* %cw /(scot %p our)/[syd]/(scot %da now)))
|
||||
?: =(0 ud:.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now)))
|
||||
%init
|
||||
%mate
|
||||
==
|
||||
@ -524,7 +524,7 @@
|
||||
^+ +>
|
||||
?. ?=($auto gim)
|
||||
perform(auto |, gem gim, her her, cas cas, sud sud)
|
||||
?: =(0 .^(@ %cw /(scot %p our)/[syd]/(scot %da now)))
|
||||
?: =(0 ud:.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now)))
|
||||
=> $(gim %init)
|
||||
.(auto &)
|
||||
=> $(gim %fine)
|
||||
|
||||
@ -44,10 +44,9 @@
|
||||
:: Type of request.
|
||||
::
|
||||
:: %d produces a set of desks, %p gets file permissions, %u checks for
|
||||
:: existence, %v produces a ++dome of all desk data, %w with a time or label
|
||||
:: case gets the aeon at that case, %w with a number case is not recommended,
|
||||
:: %x gets file contents, %y gets a directory listing, and %z gets a recursive
|
||||
:: hash of the file contents and children.
|
||||
:: existence, %v produces a ++dome of all desk data, %w gets @ud and @da
|
||||
:: variants for the given case, %x gets file contents, %y gets a directory
|
||||
:: listing, and %z gets a recursive hash of the file contents and children.
|
||||
::
|
||||
:: ++ care ?($d $p $u $v $w $x $y $z)
|
||||
::
|
||||
@ -280,7 +279,7 @@
|
||||
++ wove {p/(unit ship) q/rove} :: stored source + req
|
||||
++ rove :: stored request
|
||||
$% {$sing p/mood} :: single request
|
||||
{$next p/mood q/cach} :: next version
|
||||
{$next p/mood q/(unit aeon) r/cach} :: next version of one
|
||||
$: $mult :: next version of any
|
||||
p/mool :: original request
|
||||
q/(unit aeon) :: checking for change
|
||||
@ -907,7 +906,7 @@
|
||||
:: if the requested case is in the future, we can't know anything yet.
|
||||
?~ aey (store ~ ~ ~)
|
||||
=+ old=(read-all-at cas)
|
||||
=+ yon=+((need (case-to-aeon:ze cas)))
|
||||
=+ yon=+(u.aey)
|
||||
|- ^+ ..start-request
|
||||
:: if we need future revisions to look for change, wait.
|
||||
?: (gth yon let.dom)
|
||||
@ -948,7 +947,7 @@
|
||||
^- rove
|
||||
?: ?=($mult -.rav)
|
||||
[-.rav p.rav nex old new]
|
||||
:+ -.rav p.rav
|
||||
:^ -.rav p.rav nex
|
||||
=+ ole=~(tap by old)
|
||||
?> (lte (lent ole) 1)
|
||||
?~ ole ~
|
||||
@ -1583,7 +1582,7 @@
|
||||
:+ ~
|
||||
p.r.u.rut
|
||||
?+ p.r.u.rut ~| %strange-w-over-nextwork !!
|
||||
$aeon !>(((hard aeon) q.r.u.rut))
|
||||
$cass !>(((hard cass) q.r.u.rut))
|
||||
$null [[%atom %n ~] ~]
|
||||
$nako !>(~|([%harding [&1 &2 &3]:q.r.u.rut] ((hard nako) q.r.u.rut)))
|
||||
==
|
||||
@ -1860,10 +1859,11 @@
|
||||
|^
|
||||
=/ rov/rove
|
||||
?: ?=($mult -.vor) vor
|
||||
=* mod p.vor
|
||||
:* %mult
|
||||
[q.p.vor [[p.p.vor r.p.vor] ~ ~]]
|
||||
`let.dom
|
||||
[[[p.p.vor r.p.vor] q.vor] ~ ~]
|
||||
[q.mod [[p.mod r.mod] ~ ~]]
|
||||
q.vor
|
||||
[[[p.mod r.mod] r.vor] ~ ~]
|
||||
~
|
||||
==
|
||||
?> ?=($mult -.rov)
|
||||
@ -1927,7 +1927,7 @@
|
||||
?: ?=($mult -.vor) rov
|
||||
?> ?=({* $~ $~} r.rov)
|
||||
=* one n.r.rov
|
||||
[%next [p.p.one p.p.rov q.p.one] q.one]
|
||||
[%next [p.p.one p.p.rov q.p.one] q.rov q.one]
|
||||
::
|
||||
++ respond :: send changes
|
||||
|= res/(map mood (each cage lobe))
|
||||
@ -2356,42 +2356,6 @@
|
||||
$delta (~(put in $(lob q.q.gar)) lob)
|
||||
==
|
||||
::
|
||||
:: Should be refactored, is only called form `++read`, and even then it
|
||||
:: can't be called with `$v` as the care, so it's really just a crash.
|
||||
::
|
||||
:: To be clear the refactoring should start at ++read-at-aeon and probably
|
||||
:: eliminate ++read and ++query
|
||||
::
|
||||
++ query :: query:ze
|
||||
|= ren/$?($p $u $v $x $y $z) :: endpoint query
|
||||
^- (unit cage)
|
||||
?- ren
|
||||
$p !!
|
||||
$u !! :: [~ %null [%atom %n] ~]
|
||||
$v [~ %dome !>(dom)]
|
||||
$x !! :: ?~(q.ank.dom ~ [~ q.u.q.ank.dom])
|
||||
$y !! :: [~ %arch !>(as-arch)]
|
||||
$z !! :: [~ %ankh !>(ank.dom)]
|
||||
==
|
||||
::
|
||||
:: See ++query.
|
||||
::
|
||||
++ read :: read:ze
|
||||
|= mun/mood :: read at point
|
||||
^- (unit cage)
|
||||
?: ?=($d p.mun)
|
||||
~& %dead-d ~
|
||||
?: ?=($v p.mun)
|
||||
[~ %dome !>(dom)] :: dead code
|
||||
?: &(?=($w p.mun) !?=($ud -.q.mun))
|
||||
?^(r.mun ~ [~ %aeon !>(let.dom)]) :: dead code
|
||||
?: ?=($w p.mun)
|
||||
=+ ^= yak
|
||||
%- aeon-to-yaki
|
||||
let.dom
|
||||
?^(r.mun ~ !!) :: [~ %w !>([t.yak (forge-nori yak)])])-all
|
||||
(query(ank.dom ank:(descend-path:(zu ank.dom) r.mun)) p.mun) :: dead code
|
||||
::
|
||||
:: Gets the permissions that apply to a particular node.
|
||||
::
|
||||
:: If the node has no permissions of its own, we use its parent's.
|
||||
@ -2483,6 +2447,21 @@
|
||||
~
|
||||
``[%dome -:!>(*dome) dom]
|
||||
::
|
||||
:: Gets all cases refering to the same revision as the given case.
|
||||
::
|
||||
:: For the %da case, we give just the canonical timestamp of the revision.
|
||||
::
|
||||
++ read-w
|
||||
|= cas/case
|
||||
^- (unit (unit (each cage lobe)))
|
||||
=+ aey=(case-to-aeon cas)
|
||||
?~ aey ~
|
||||
=- [~ ~ %& %cass !>(-)]
|
||||
^- cass
|
||||
:- u.aey
|
||||
?: =(0 u.aey) `@da`0
|
||||
t:(aeon-to-yaki u.aey)
|
||||
::
|
||||
:: Gets the data at a node.
|
||||
::
|
||||
:: If it's in our ankh (current state cache), we can just produce the
|
||||
@ -2594,68 +2573,28 @@
|
||||
:: meaning we either have the value directly or a content hash of the
|
||||
:: value.
|
||||
::
|
||||
:: Should change last few lines to an explicit ++read-w.
|
||||
::
|
||||
++ read-at-aeon :: read-at-aeon:ze
|
||||
|= {for/(unit ship) yon/aeon mun/mood} :: seek and read
|
||||
^- (unit (unit (each cage lobe)))
|
||||
?. |(?=($~ for) (may-read u.for p.mun yon r.mun))
|
||||
~
|
||||
?: &(?=($w p.mun) !?=($ud -.q.mun)) :: NB only her speed
|
||||
?^(r.mun [~ ~] [~ ~ %& %aeon !>(yon)])
|
||||
?: ?=($d p.mun)
|
||||
?- p.mun
|
||||
$d
|
||||
=+ rom=(~(get by fat.ruf) her)
|
||||
?~ rom
|
||||
~&(%null-rom-cd [~ ~])
|
||||
?^ r.mun
|
||||
~&(%no-cd-path [~ ~])
|
||||
[~ ~ %& %noun !>(~(key by dos.u.rom))]
|
||||
?: ?=($p p.mun)
|
||||
(read-p r.mun)
|
||||
?: ?=($u p.mun)
|
||||
(read-u yon r.mun)
|
||||
?: ?=($v p.mun)
|
||||
(bind (read-v yon r.mun) (lift |=(a/cage [%& a])))
|
||||
?: ?=($x p.mun)
|
||||
(read-x yon r.mun)
|
||||
?: ?=($y p.mun)
|
||||
:: =- ~& :* %dude-someones-getting-curious
|
||||
:: mun=mun
|
||||
:: yon=yon
|
||||
:: our=our
|
||||
:: her=her
|
||||
:: syd=syd
|
||||
:: hep=-
|
||||
:: ==
|
||||
:: -
|
||||
(bind (read-y yon r.mun) (lift |=(a/cage [%& a])))
|
||||
?: ?=($z p.mun)
|
||||
(bind (read-z yon r.mun) (lift |=(a/cage [%& a])))
|
||||
%+ bind
|
||||
(rewind yon)
|
||||
|= a/(unit _+>.$)
|
||||
^- (unit (each cage lobe))
|
||||
?~ a
|
||||
~
|
||||
`(unit (each cage lobe))`(bind (read:u.a mun) |=(a/cage [%& a]))
|
||||
::
|
||||
:: Stubbed out, should be removed in the refactoring mentioned in ++query.
|
||||
::
|
||||
++ rewind :: rewind:ze
|
||||
|= yon/aeon :: rewind to aeon
|
||||
^- (unit (unit _+>))
|
||||
?: =(let.dom yon) ``+>
|
||||
?: (gth yon let.dom) !! :: don't have version
|
||||
=+ hat=q:(aeon-to-yaki yon)
|
||||
?: (~(any by hat) |=(a/lobe ?=($delta [-:(lobe-to-blob a)])))
|
||||
~
|
||||
~
|
||||
::=+ ^- (map path cage)
|
||||
:: %- ~(run by hat)
|
||||
:: |= a=lobe
|
||||
:: =+ (lobe-to-blob a)
|
||||
:: ?-(-.- %direct q.-, %delta !!)
|
||||
::`+>.$(ank.dom (map-to-ankh -), let.dom yon)
|
||||
::
|
||||
$p (read-p r.mun)
|
||||
$u (read-u yon r.mun)
|
||||
$v (bind (read-v yon r.mun) (lift |=(a/cage [%& a])))
|
||||
$w (read-w q.mun)
|
||||
$x (read-x yon r.mun)
|
||||
$y (bind (read-y yon r.mun) (lift |=(a/cage [%& a])))
|
||||
$z (bind (read-z yon r.mun) (lift |=(a/cage [%& a])))
|
||||
==
|
||||
::
|
||||
:: Traverse an ankh.
|
||||
::
|
||||
@ -3568,7 +3507,7 @@
|
||||
::
|
||||
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|
||||
=| :: instrument state
|
||||
$: $0 :: vane version
|
||||
$: $1 :: vane version
|
||||
ruf/raft :: revision tree
|
||||
== ::
|
||||
|= {now/@da eny/@ ski/sley} :: activate
|
||||
@ -3829,12 +3768,79 @@
|
||||
::
|
||||
++ load
|
||||
=> |%
|
||||
++ axle $%({$0 ruf/raft})
|
||||
++ rove-0
|
||||
$% {$sing p/mood}
|
||||
{$next p/mood q/cach}
|
||||
$: $mult
|
||||
p/mool
|
||||
q/(unit aeon)
|
||||
r/(map (pair care path) cach)
|
||||
s/(map (pair care path) cach)
|
||||
==
|
||||
{$many p/? q/moat r/(map path lobe)}
|
||||
==
|
||||
++ wove-0 (cork wove |=(a/wove a(q (rove-0 q.a))))
|
||||
++ cult-0 (jug wove-0 duct)
|
||||
++ dojo-0 (cork dojo |=(a/dojo a(qyx *cult-0)))
|
||||
++ rede-0 (cork rede |=(a/rede a(qyx *cult-0)))
|
||||
++ room-0 (cork room |=(a/room a(dos (~(run by dos.a) dojo-0))))
|
||||
++ rung-0 (cork rung |=(a/rung a(rus (~(run by rus.a) rede-0))))
|
||||
++ raft-0
|
||||
%+ cork raft
|
||||
|= a/raft
|
||||
%= a
|
||||
fat (~(run by fat.a) room-0)
|
||||
hoy (~(run by hoy.a) rung-0)
|
||||
==
|
||||
::
|
||||
++ axle $%({$1 ruf/raft} {$0 ruf/raft-0})
|
||||
--
|
||||
|= old/axle
|
||||
^+ ..^$
|
||||
?- -.old
|
||||
$0 ..^$(ruf ruf.old)
|
||||
$1
|
||||
..^$(ruf ruf.old)
|
||||
::
|
||||
$0
|
||||
|^
|
||||
=- ^$(old [%1 -])
|
||||
=+ ruf.old
|
||||
:* (~(run by fat) rom)
|
||||
(~(run by hoy) run)
|
||||
ran mon hez ~
|
||||
==
|
||||
::
|
||||
++ wov
|
||||
|= a/wove-0
|
||||
^- wove
|
||||
:- p.a
|
||||
?. ?=($next -.q.a) q.a
|
||||
[%next p.q.a ~ q.q.a]
|
||||
::
|
||||
++ cul
|
||||
|= a/cult-0
|
||||
^- cult
|
||||
%- ~(gas by *cult)
|
||||
%+ turn ~(tap by a)
|
||||
|= {p/wove-0 q/(set duct)}
|
||||
[(wov p) q]
|
||||
::
|
||||
++ rom
|
||||
|= room-0
|
||||
^- room
|
||||
:- hun
|
||||
%- ~(run by dos)
|
||||
|= d/dojo-0
|
||||
^- dojo
|
||||
d(qyx (cul qyx.d))
|
||||
::
|
||||
++ run
|
||||
|= a/rung-0
|
||||
=- a(rus (~(run by rus.a) -))
|
||||
|= r/rede-0
|
||||
^- rede
|
||||
r(qyx (cul qyx.r))
|
||||
--
|
||||
==
|
||||
::
|
||||
++ scry :: inspect
|
||||
@ -3866,7 +3872,7 @@
|
||||
?: ?=($& -.u.u.-) ``p.u.u.-
|
||||
~
|
||||
::
|
||||
++ stay [%0 ruf]
|
||||
++ stay [%1 ruf]
|
||||
++ take :: accept response
|
||||
|= {tea/wire hen/duct hin/(hypo sign)}
|
||||
^+ [p=*(list move) q=..^$]
|
||||
|
||||
@ -1335,7 +1335,8 @@
|
||||
=+ ext=(fall p.pok %urb)
|
||||
=+ bem=?-(-.hem $beam p.hem, $spur [-.top (weld p.hem s.top)])
|
||||
~| bad-beam+q.bem
|
||||
?< =([~ 0] (sky [151 %noun] %cw (en-beam bem(+ ~, r [%da now]))))
|
||||
?< =- ?~(- | =(-.u.- 0))
|
||||
(sky [151 %noun] %cw (en-beam bem(+ ~, r [%da now])))
|
||||
=+ wir=`whir`[%ha (en-beam -.bem ~)]
|
||||
=. wir ?+(mef !! $get wir, $head [%he wir])
|
||||
=. r.bem ?+(r.bem r.bem {$ud $0} da+now)
|
||||
|
||||
@ -1098,7 +1098,7 @@
|
||||
?: ?=($ud -.r.bem) (fine cof bem)
|
||||
=+ von=(syve [151 %noun] ~ %cw bem(s ~))
|
||||
?~ von [p=cof q=[%1 [%c %w bem ~] ~ ~]]
|
||||
(fine cof bem(r [%ud ((hard @) +.+:(need u.von))]))
|
||||
(fine cof bem(r [%ud ud:((hard cass:clay) +.+:(need u.von))]))
|
||||
::
|
||||
++ infer-product-type
|
||||
|= {cof/cafe typ/type gen/hoon}
|
||||
|
||||
@ -441,6 +441,7 @@
|
||||
{$tas p/@tas} :: label
|
||||
{$ud p/@ud} :: number
|
||||
== ::
|
||||
++ cass {ud/@ud da/@da} :: cases for revision
|
||||
++ coop (unit ares) :: e2e ack
|
||||
++ crew (set ship) :: permissions group
|
||||
++ dict {src/path rul/rule} :: effective permission
|
||||
|
||||
Loading…
Reference in New Issue
Block a user