diff --git a/app/dojo.hoon b/app/dojo.hoon index fc35da4d56..ef6f61e476 100644 --- a/app/dojo.hoon +++ b/app/dojo.hoon @@ -23,10 +23,10 @@ poy/(unit dojo-project) :: working $: :: sur: structure imports :: - sur=(list cable:ford-api) + sur=(list cable:ford) :: lib: library imports :: - lib=(list cable:ford-api) + lib=(list cable:ford) == var/(map term cage) :: variable state old/(set term) :: used TLVs @@ -108,7 +108,7 @@ mark {$hiss hiss:eyre} == - [%build wire @p ? schematic:ford-api] + [%build wire @p ? schematic:ford] [%kill wire @p] {$deal wire sock term club} :: {$info wire @p toro:clay} :: @@ -126,7 +126,7 @@ $= result $% :: %complete: contains the result of the completed build :: - [%complete build-result=build-result:ford-api] + [%complete build-result=build-result:ford] :: %incomplete: couldn't finish build; contains error message :: [%incomplete =tang] @@ -223,13 +223,13 @@ :: ++ parse-cables %+ cook - |= cables=(list cable:ford-api) + |= cables=(list cable:ford) :+ 0 %ex ^- hoon :: :- %clsg %+ turn cables - |= cable=cable:ford-api + |= cable=cable:ford ^- hoon :: :+ %clhp @@ -249,7 +249,7 @@ :: NOTE: This is a verbatim duplicate of Ford's cable parsing :: ++ parse-cable - %+ cook |=(a=cable:ford-api a) + %+ cook |=(a=cable:ford a) ;~ pose (stag ~ ;~(pfix tar sym)) (cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym)) @@ -338,7 +338,7 @@ ++ dy-abet +>(poy `+<) :: resolve ++ dy-amok +>(poy ~) :: terminate ++ dy-ford :: send work to ford - |= [way=wire schematic=schematic:ford-api] + |= [way=wire schematic=schematic:ford] ^+ +>+> ?> ?=($~ pux) :: pin all builds to :now.hid so they don't get cached forever @@ -361,7 +361,7 @@ ++ dy-slam :: call by ford |= {way/wire gat/vase sam/vase} ^+ +>+> - (dy-ford way `schematic:ford-api`[%call [%$ %noun gat] [%$ %noun sam]]) + (dy-ford way `schematic:ford`[%call [%$ %noun gat] [%$ %noun sam]]) :: ++ dy-errd :: reject change, abet |= {rev/(unit sole-edit) err/@u} @@ -527,13 +527,13 @@ $lib %_ . lib - ((dy-cast (list cable:ford-api) !>(*(list cable:ford-api))) q.cay) + ((dy-cast (list cable:ford) !>(*(list cable:ford))) q.cay) == :: $sur %_ . sur - ((dy-cast (list cable:ford-api) !>(*(list cable:ford-api))) q.cay) + ((dy-cast (list cable:ford) !>(*(list cable:ford))) q.cay) == :: $dir =+ ^= pax ^- path @@ -1248,7 +1248,7 @@ ++ dy-silk-vase |=(vax/vase [%$ %noun vax]) :: vase to silk ++ dy-silk-sources :: arglist to silk |= src/(list dojo-source) - ^- schematic:ford-api + ^- schematic:ford :: :+ %$ %noun |- @@ -1257,7 +1257,7 @@ :: ++ dy-silk-config :: configure |= {cay/cage cig/dojo-config} - ^- [wire schematic:ford-api] + ^- [wire schematic:ford] ?. (~(nest ut [%cell [%atom %$ ~] %noun]) | p.q.cay) :: :: naked gate @@ -1280,10 +1280,10 @@ :+ [%$ %noun !>([now=now.hid eny=eny.hid bec=he-beak])] (dy-silk-sources p.cig) :+ %mute [%$ %noun (fall (slew 27 gat) !>(~))] - ^- (list [wing schematic:ford-api]) + ^- (list [wing schematic:ford]) %+ turn ~(tap by q.cig) |= {a/term b/(unit dojo-source)} - ^- [wing schematic:ford-api] + ^- [wing schematic:ford] :- [a ~] :+ %$ %noun ?~(b !>([~ ~]) (dy-vase p.u.b)) @@ -1373,7 +1373,7 @@ ?: ?=($ur -.bil) (dy-eyre /hand p.bil [q.bil %get ~ ~]) %- dy-ford - ^- [path schematic:ford-api] + ^- [path schematic:ford] ?- -.bil $ge (dy-silk-config (dy-cage p.p.p.bil) q.p.bil) $dv [/hand [%core [he-disc (weld /hoon (flop p.bil))]]] @@ -1419,13 +1419,13 @@ :: ++ dy-mare :: build expression |= gen/hoon - ^- schematic:ford-api + ^- schematic:ford =+ too=(dy-hoon-mark gen) =- ?~(too - [%cast he-disc u.too -]) :+ %ride gen :- [%$ dy-hoon-head] :^ %plan he-rail `coin`blob+** - `scaffold:ford-api`[he-rail zuse sur lib ~ ~] + `scaffold:ford`[he-rail zuse sur lib ~ ~] :: ++ dy-step :: advance project |= nex/@ud @@ -1544,7 +1544,7 @@ |= $: way=wire date=@da $= result - $% [%complete build-result=build-result:ford-api] + $% [%complete build-result=build-result:ford] [%incomplete =tang] == == ^+ +> @@ -1559,7 +1559,7 @@ :: %success :: - %. (result-to-cage:ford-api build-result.result) + %. (result-to-cage:ford build-result.result) =+ dye=~(. dy u.poy(pux ~)) ?+ way !! {$hand $~} dy-hand:dye diff --git a/lib/ford-turbo.hoon b/lib/ford-turbo.hoon deleted file mode 100644 index f0373ee114..0000000000 --- a/lib/ford-turbo.hoon +++ /dev/null @@ -1,5862 +0,0 @@ -!: -:: -:: sys/zuse/hoon -:: -:: |ford: build system vane interface -:: -|% -++ ford-api ^? - |% - :: |able:ford: ford's public +move interface - :: - ++ able ^? - |% - :: +task:able:ford: requests to ford - :: - += task - $% :: %make: perform a build, either live or once - :: - $: %make - :: our: who our ship is (remove after cc-release) - :: - our=@p - :: plan: the schematic to build - :: - =schematic - == - :: %kill: stop a build; send on same duct as original %make request - :: - $: %kill - :: our: who our ship is (remove after cc-release)s - :: - our=@p - == - :: %wegh: produce memory usage information - :: - [%wegh ~] - :: %wipe: clear cache - :: - [%wipe ~] - == - :: +gift:able:ford: responses from ford - :: - += gift - $% :: %mass: memory usage; response to %wegh +task - :: - [%mass p=mass] - :: %made: build result; response to %make +task - :: - $: %made - :: date: formal date of the build - :: - date=@da - :: result: result of the build; either complete build, or error - :: - $= result - $% :: %complete: contains the result of the completed build - :: - [%complete =build-result] - :: %incomplete: couldn't finish build; contains error message - :: - [%incomplete =tang] - == == == - -- - :: +disc: a desk on a ship; can be used as a beak that varies with time - :: - += disc [=ship =desk] - :: +rail: a time-varying full path - :: - :: This can be thought of as a +beam without a +case, which is what - :: would specify the time. :spur is flopped just like the +spur in a +beam. - :: - += rail [=disc =spur] - :: +resource: time-varying dependency on a value from the urbit namespace - :: - += resource - $: :: vane which we are querying - :: - vane=?(%c %g) - :: type of request - :: - :: TODO: care:clay should be cleaned up in zuse as it is a general - :: type, not a clay specific one. - :: - care=care:clay - :: path on which to depend, missing time, which will be filled in - :: - =rail - == - :: +build-result: the referentially transparent result of a +build - :: - :: A +build produces either an error or a result. A result is a tagged - :: union of the various kinds of datatypes a build can produce. The tag - :: represents the sub-type of +schematic that produced the result. - :: - += build-result - $% :: %error: the build produced an error whose description is :message - :: - [%error message=tang] - :: %success: result of successful +build, tagged by +schematic sub-type - :: - $: %success - $^ [head=build-result tail=build-result] - $% [%$ =cage] - [%pin date=@da =build-result] - [%alts =build-result] - [%bake =cage] - [%bunt =cage] - [%call =vase] - [%cast =cage] - [%core =vase] - [%diff =cage] - [%dude =build-result] - [%hood =scaffold] - [%join =cage] - [%mash =cage] - [%mute =cage] - [%pact =cage] - [%path =rail] - [%plan =vase] - [%reef =vase] - [%ride =vase] - [%same =build-result] - [%scry =cage] - [%slim [=type =nock]] - [%slit =type] - [%vale =cage] - [%volt =cage] - == == == - :: - :: +schematic: plan for building - :: - ++ schematic - :: If the head of the +schematic is a pair, it's an auto-cons - :: schematic. Its result will be the pair of results of its - :: sub-schematics. - :: - $^ [head=schematic tail=schematic] - :: - $% :: %$: literal value. Produces its input unchanged. - :: - $: %$ - :: literal: the value to be produced by the build - :: - literal=cage - == - :: %pin: pins a sub-schematic to a date - :: - :: There is a difference between live builds and once builds. In - :: live builds, we produce results over and over again and aren't - :: pinned to a specifc time. In once builds, we want to specify a - :: specific date, which we apply recursively to any sub-schematics - :: contained within :schematic. - :: - :: If a build has a %pin at the top level, we consider it to be a - :: once build. Otherwise, we consider it to be a live build. We do - :: this so schematics which depend on the result of a once build can - :: be cached, giving the client explicit control over the caching - :: behaviour. - :: - $: %pin - :: date: time at which to perform the build - :: - date=@da - :: schematic: wrapped schematic of pinned time - :: - =schematic - == - :: %alts: alternative build choices - :: - :: Try each choice in :choices, in order; accept the first one that - :: succeeds. Note that the result inherits the dependencies of all - :: failed schematics, as well as the successful one. - :: - $: %alts - :: choices: list of build options to try - :: - choices=(list schematic) - == - :: %bake: run a file through a renderer - :: - $: %bake - :: renderer: name of renderer; also its file path in ren/ - :: - renderer=term - :: query-string: the query string of the renderer's http path - :: - query-string=coin - :: path-to-render: full path of file to render - :: - path-to-render=rail - == - :: %bunt: produce the default value for a mark - :: - $: %bunt - :: disc where in clay to load the mark from - :: - =disc - :: mark: name of mark; also its file path in mar/ - :: - mark=term - == - :: %call: call a gate on a sample - :: - $: %call - :: gate: schematic whose result is a gate - :: - gate=schematic - :: sample: schematic whose result will be the gate's sample - :: - sample=schematic - == - :: %cast: cast the result of a schematic through a mark - :: - $: %cast - :: disc where in clay to load the mark from - :: - =disc - :: mark: name of mark; also its file path in ren/ - :: - mark=term - :: input: schematic whose result will be run through the mark - :: - input=schematic - == - :: %core: build a hoon program from a source file - :: - $: %core - :: source-path: clay path from which to load hoon source - :: - source-path=rail - == - :: %diff: produce marked diff from :first to :second - :: - $: %diff - :: disc where in clay to load the mark from - :: - =disc - :: old: schematic producing data to be used as diff starting point - :: - start=schematic - :: new: schematic producing data to be used as diff ending point - :: - end=schematic - == - :: %dude: wrap a failure's error message with an extra message - :: - $: %dude - :: error: a trap producing an error message to wrap the original - :: - error=(trap tank) - :: attempt: the schematic to try, whose error we wrap, if any - :: - attempt=schematic - == - :: %hood: create a +hood from a hoon source file - :: - $: %hood - :: source-path: clay path from which to load hoon source - :: - source-path=rail - == - :: %join: merge two diffs into one diff; produces `~` if conflicts - :: - $: %join - :: disc where in clay to load the mark from - :: - =disc - :: mark: name of the mark to use for diffs; also file path in mar/ - :: - mark=term - :: first: schematic producing first diff - :: - first=schematic - :: second: schematic producing second diff - :: - second=schematic - == - :: %mash: force a merge, annotating any conflicts - :: - $: %mash - :: disc where in clay to load the mark from - :: - =disc - :: mark: name of mark used in diffs; also file path in mar/ - :: - mark=term - :: first: marked schematic producing first diff - :: - first=[=disc mark=term =schematic] - :: second: marked schematic producing second diff - :: - second=[=disc mark=term =schematic] - == - :: %mute: mutate a noun by replacing its wings with new values - :: - $: %mute - :: subject: schematic producing the noun to mutate - :: - subject=schematic - :: mutations: axes and schematics to produce their new contents - :: - mutations=(list (pair wing schematic)) - == - :: %pact: patch a marked noun by applying a diff - :: - $: %pact - :: disc where in clay to load marks from - :: - =disc - :: start: schematic producing a noun to be patched - :: - start=schematic - :: diff: schematic producing the diff to apply to :start - :: - diff=schematic - == - :: %path: resolve a path with `-`s to a path with `/`s - :: - :: Resolve +raw-path to a path containing a file, replacing - :: any `-`s in the path with `/`s if no file exists at the - :: original path. Produces an error if multiple files match, - :: e.g. a/b/c and a/b-c, or a/b/c and a-b/c. - :: - $: %path - :: disc: the +disc forming the base of the path to be resolved - :: - =disc - :: prefix: path prefix under which to resolve :raw-path, e.g. lib - :: - prefix=@tas - :: raw-path: the file path to be resolved - :: - raw-path=@tas - == - :: %plan: build a hoon program from a preprocessed source file - :: - $: %plan - :: path-to-render: the clay path of a file being rendered - :: - :: TODO: Once we've really implemented this, write the - :: documentation. (This is the path that starts out as the path - :: of the hoon source which generated the scaffold, but can be - :: changed with `/:`.) - :: - path-to-render=rail - :: query-string: the query string of the http request - :: - query-string=coin - :: scaffold: preprocessed hoon source and imports - :: - =scaffold - == - :: %reef: produce a hoon+zuse kernel. used internally for caching - :: - $: %reef - :: disc: location of sys/hoon/hoon and sys/zuse/hoon - :: - =disc - == - :: %ride: eval hoon as formula with result of a schematic as subject - :: - $: %ride - :: formula: a hoon to be evaluated against a subject - :: - formula=hoon - :: subject: a schematic whose result will be used as subject - :: - subject=schematic - == - :: %same: the identity function - :: - :: Functionally used to "unpin" a build for caching reasons. If you - :: run a %pin build, it is treated as a once build and is therefore - :: not cached. Wrapping the %pin schematic in a %same schematic - :: converts it to a live build, which will be cached due to live - :: build subscription semantics. - :: - $: %same - :: schematic that we evaluate to - :: - =schematic - == - :: %scry: lookup a value from the urbit namespace - :: - $: %scry - :: resource: a namespace request, with unspecified time - :: - :: Schematics can only be resolved when specifying a time, - :: which will convert this +resource into a +scry-request. - :: - =resource - == - :: %slim: compile a hoon against a subject type - :: - $: %slim - :: compile-time subject type for the :formula - :: - subject-type=type - :: formula: a +hoon to be compiled to (pair type nock) - :: - formula=hoon - == - :: %slit: get type of gate product - :: - $: %slit - :: gate: a vase containing a gate - :: - gate=vase - :: sample: a vase containing the :gate's sample - :: - sample=vase - == - :: %vale: coerce a noun to a mark, validated - :: - $: %vale - :: disc where in clay to load the mark from - :: - =disc - :: mark: name of mark to use; also file path in mar/ - :: - mark=term - :: input: the noun to be converted using the mark - :: - input=* - == - :: %volt: coerce a noun to a mark, unsafe - :: - $: %volt - :: disc where in clay to load the mark from - :: - =disc - :: mark: name of mark to use; also file path in mar/ - :: - mark=term - :: input: the noun to be converted using the mark - :: - input=* - == - == - :: - :: +scaffold: program construction in progress - :: - :: A source file with all its imports and requirements, which will be - :: built and combined into one final product. - :: - += scaffold - $: :: source-rail: the file this scaffold was parsed from - :: - source-rail=rail - :: zuse-version: the kelvin version of the standard library - :: - zuse-version=@ud - :: structures: files from %/sur which are included - :: - structures=(list cable) - :: libraries: files from %/lib which are included - :: - libraries=(list cable) - :: cranes: a list of resources to transform and include - :: - cranes=(list crane) - :: sources: hoon sources, either parsed or on the filesystem - :: - sources=(list brick) - == - :: +cable: a reference to something on the filesystem - :: - += cable - $: :: face: the face to wrap around the imported file - :: - face=(unit term) - :: file-path: location in clay - :: - file-path=term - == - :: +brick: hoon code, either directly specified or referencing clay - :: - += brick - $% $: :: %direct: inline parsed hoon - :: - %direct - source=hoon - == - $: :: %indirect: reference to a hoon file in clay - :: - %indirect - location=beam - == == - :: +truss: late-bound path - :: - :: TODO: the +tyke data structure should be rethought, possibly as part - :: of this effort since it is actually a `(list (unit hoon))`, when it - :: only represents @tas. It should be a structure which explicitly - :: represents a path with holes that need to be filled in. - :: - += truss - $: pre=(unit tyke) - pof=(unit [p=@ud q=tyke]) - == - :: +crane: parsed rune used to include and transform resources - :: - :: Cranes lifting cranes lifting cranes! - :: - :: A recursive tree of Ford directives that specifies instructions for - :: including and transforming resources from the Urbit namespace. - :: - += crane - $% $: :: %fssg: `/~` hoon literal - :: - :: `/~ ` produces a crane that evaluates arbitrary hoon. - :: - %fssg - =hoon - == - $: :: %fsbc: `/$` process query string - :: - :: `/$` will call a gate with the query string supplied to this - :: build. If no query string, this errors. - :: - %fsbc - =hoon - == - $: :: %fsbr: `/|` first of many options that succeeds - :: - :: `/|` takes a series of cranes and produces the first one - :: (left-to-right) that succeeds. If none succeed, it produces - :: stack traces from all of its arguments. - :: - %fsbr - :: choices: cranes to try - :: - choices=(list crane) - == - $: :: %fsts: `/=` wrap a face around a crane - :: - :: /= runs a crane (usually produced by another ford rune), takes - :: the result of that crane, and wraps a face around it. - :: - %fsts - :: face: face to apply - :: - face=term - :: crane: internal build step - :: - =crane - == - $: :: %fsdt: `/.` null-terminated list - :: - :: Produce a null-terminated list from a sequence of cranes, - :: terminated by a `==`. - :: - %fsdt - :: items: cranes to evaluate - :: - items=(list crane) - == - $: :: %fscm: `/,` switch by path - :: - :: `/,` is a switch statement, which picks a branch to evaluate - :: based on whether the current path matches the path in the - :: switch statement. Takes a sequence of pairs of (path, crane) - :: terminated by a `==`. - :: - %fscm - :: cases: produces evaluated crane of first +spur match - :: - cases=(list (pair spur crane)) - == - $: :: %fspm: `/&` pass through a series of marks - :: - :: `/&` passes a crane through multiple marks, right-to-left. - :: - %fspm - :: marks: marks to apply to :crane, in reverse order - :: - marks=(list mark) - =crane - == - $: :: %fscb: `/_` run a crane on each file in the current directory - :: - :: `/_` takes a crane as an argument. It produces a new crane - :: representing the result of mapping the supplied crane over the - :: list of files in the current directory. The keys in the - :: resulting map are the basenames of the files in the directory, - :: and each value is the result of running that crane on the - :: contents of the file. - :: - %fscb - =crane - == - $: :: %fssm: `/;` operate on - :: - :: `/;` takes a hoon and a crane. The hoon should evaluate to a - :: gate, which is then called with the result of the crane as its - :: sample. - :: - %fssm - =hoon - =crane - == - $: :: %fscl: `/:` evaluate at path - :: - :: `/:` takes a path and a +crane, and evaluates the crane with - :: the current path set to the supplied path. - :: - %fscl - :: path: late bound path to be resolved relative to current beak - :: - :: This becomes current path of :crane - :: - path=truss - =crane - == - $: :: %fskt: `/^` cast - :: - :: `/^` takes a +mold and a +crane, and casts the result of the - :: crane to the mold. - :: - %fskt - :: mold: evaluates to a mold to be applied to :crane - :: - mold=hoon - =crane - == - $: :: %fszp: `/!mark/` evaluate as hoon, then pass through mark - :: - %fszp - =mark - == - $: :: %fszy: `/mark/` passes current path through :mark - :: - %fszy - =mark - == == - -- --- -:: -:: sys/ford/hoon -:: pit: a +vase of the hoon+zuse kernel, which is a deeply nested core -:: -|= pit=vase -:: -=, ford-api -:: ford internal data structures -:: -=> =~ -=, ford-api :: TODO remove once in vane -|% -:: +move: arvo moves that ford can emit -:: -+= move - :: - $: :: duct: request identifier - :: - =duct - :: card: move contents; either a +note or a +gift:able - :: - card=(wind note gift:able) - == -:: +note: private request from ford to another vane -:: -+= note - $% :: %c: to clay - :: - $: %c - :: %warp: internal (intra-ship) file request - :: - $% $: %warp - :: sock: pair of requesting ship, requestee ship - :: - =sock - :: riff: clay request contents - :: - riff=riff:clay - == == == - :: %f: to ford itself - :: - $: %f - :: %make: perform a build - :: - $% $: %make - :: schematic: the schematic to build - :: - =schematic - == == == - :: %g: to gall - :: - $: %g - :: %unto: full transmission - :: - :: TODO: document more fully - :: - $% $: %deal - :: sock: pair of requesting ship, requestee ship - :: - =sock - :: cush: gall request contents - :: - cush=cush:gall - == == == == -:: +sign: private response from another vane to ford -:: -+= sign - $% :: %c: from clay - :: - $: %c - $% :: %writ: internal (intra-ship) file response - :: - $: %writ - :: riot: response contents - :: - riot=riot:clay - == - :: %wris: response to %mult; many changed files - :: - $: %wris - :: case: case of the new files - :: - :: %wris can only return dates to us. - :: - case=[%da p=@da] - :: care-paths: the +care:clay and +path of each file - :: - care-paths=(set [care=care:clay =path]) - == == == == --- -:: -=, ford-api :: TODO remove once in vane -:: -|% -:: -:: +axle: overall ford state -:: -+= axle - $: :: date: date at which ford's state was updated to this data structure - :: - date=%~2018.3.14 - :: state-by-ship: storage for all the @p's this ford has been - :: - :: Once the cc-release boot sequence lands, we can remove this - :: mapping, since an arvo will not change @p identities. until - :: then, we need to support a ship booting as a comet before - :: becoming its adult identity. - :: - state-by-ship=(map ship ford-state) - == -:: +ford-state: all state that ford maintains for a @p ship identity -:: -+= ford-state - $: :: results: all stored build results - :: - :: Ford generally stores the result for all the most recently - :: completed live builds, unless it's been asked to wipe its cache. - :: - results=(map build cache-line) - :: builds: registry of all attempted builds - :: - builds=build-registry - :: components: bidirectional linkages between sub-builds and clients - :: - :: The first of the two jugs maps from a build to its sub-builds. - :: The second of the two jugs maps from a build to its client builds. - :: - components=build-dag - :: provisional-components: expected linkage we can't prove yet - :: - :: During the +gather step, we promote builds, but our promotion - :: decisions may be wrong. We record our predictions here so we - :: can undo them. - :: - provisional-components=build-dag - :: rebuilds: bidirectional links between old and new identical builds - :: - :: Old and new build must have the same schematic and result. - :: This can form a chain, like build<-->build<-->build. - :: - $= rebuilds - $: :: new: map from old build to new build - :: - new=(map build build) - :: old: map from new build to old build - :: - old=(map build build) - == - :: blocks: map from +resource to all builds waiting for its retrieval - :: - blocks=(jug scry-request build) - :: next-builds: builds to perform in the next iteration - :: - next-builds=(set build) - :: candidate-builds: builds which might go into next-builds - :: - candidate-builds=(list build) - :: blocked builds: mappings between blocked and blocking builds - :: - blocked-builds=build-dag - :: - :: build request tracking - :: - :: listeners: external requests for a build - :: - :: Listeners get copied from the root build to every sub-build to - :: facilitate quickly checking which listeners are attached to a leaf - :: build. - :: - listeners=(jug build listener) - :: root-listeners: listeners attached only to root builds - :: - root-listeners=(jug build listener) - :: builds-by-listener: reverse lookup for :root-listeners - :: - :: A duct can only be attached to one root build, and it is either - :: live or once. :builds-by-listener can be used to look up a +build - :: for a +duct, or to look up whether a duct is live or once. - :: - builds-by-listener=(map duct [=build live=?]) - :: - :: update tracking - :: - :: resources-by-disc: live clay resources - :: - :: Used for looking up which +resource's rely on a particular - :: +disc, so that we can send a new Clay subscription with all - :: the resources we care about within that disc. - :: - resources-by-disc=(jug disc resource) - :: latest-by-disc: latest formal date of a completed live build on disc - :: - :: Updated each time we complete a build of a +resource, - :: if the build's formal date is later than the stored value. - :: - latest-by-disc=(map disc @da) - :: clay-subscriptions: ducts we'll use to cancel existing clay requests - :: - clay-subscriptions=(set disc) - :: resource-updates: all clay updates we need to know about - :: - :: resource-updates stores all Clay changes at dates that - :: Ford needs to track because Ford is tracking attempted builds with - :: that formal date. - :: - resource-updates=(jug @da resource) - == -:: +build-registry: a registry of all attempted builds -:: -+= build-registry - $: :: builds-by-schematic: all attempted builds, sorted by time - :: - :: For each schematic we've attempted to build at any time, - :: list the formal dates of all build attempts, sorted newest first. - :: - by-schematic=(map schematic (list @da)) - :: builds-by-date: all attempted builds, grouped by time - :: - by-date=(jug @da schematic) - == -:: +build-dag: a directed acyclic graph of builds -:: -+= build-dag - $: :: sub-builds: jug from a build to its sub-builds - :: - sub-builds=(jug build build) - :: client-builds: jug from a build to its client builds - :: - client-builds=(jug build build) - == -:: +build: a referentially transparent request for a build. -:: -:: Each unique +build will always produce the same +build-result -:: when run (if it completes). A live build consists of a sequence of -:: instances of +build with the same :plan and increasing :date. -:: -+= build - $: :: date: the formal date of this build; unrelated to time of execution - :: - date=@da - :: schematic: the schematic that determines how to run this build - :: - =schematic - == -:: +cache-line: a record of our result of running a +build -:: -:: Proof that a build has been run. Might include the result if Ford is -:: caching it. If Ford wiped the result from its cache, the result will -:: be replaced with a tombstone so Ford still knows the build has been -:: run before. Otherwise, contains the last accessed time of the result, -:: for use in cache reclamation. -:: -+= cache-line - $% :: %value: the result of running a +build, and its last access time - :: - $: %value - :: last-accessed: the last time this result was accessed - :: - :: Updated every time this result is used in another build or - :: requested in a build request. - :: - last-accessed=@da - :: build-result: the referentially transparent result of a +build - :: - =build-result - == - :: %tombstone: marker that this build has been run and its result wiped - :: - [%tombstone ~] - == -:: +listener: either a :live :duct or a once :duct -:: -+= listener - $: :: duct: where to send a response - :: - =duct - :: live: whether :duct had requested a live build - :: - live=? - == -:: +scry-request: parsed arguments to a scry operation -:: -+= scry-request - $: :: vane: the vane from which to make the request - :: - :: TODO: use +vane here - :: - vane=?(%c %g) - :: care: type of request - :: - care=care:clay - :: beam: request path - :: - =beam - == -:: +build-receipt: result of running +make -:: -:: A +build-receipt contains all information necessary to perform the -:: effects and state mutations indicated by a call to +make. If :build -:: succeeded, :result will be %build-result; otherwise, it will be %blocks. -:: -:: After +make runs on a batch of builds, the resulting +build-receipt's are -:: applied one at a time. -:: -+= build-receipt - $: :: build: the build we worked on - :: - =build - :: result: the outcome of this build - :: - $= result - $% :: %build-result: the build produced a result - :: - $: %build-result - =build-result - == - :: %blocks: the build blocked on the following builds or resource - :: - $: %blocks - :: builds: builds that :build blocked on - :: - builds=(list build) - :: scry-blocked: namespace request that :build blocked on - :: - scry-blocked=(unit scry-request) - == - == - :: sub-builds: subbuilds of :build - :: - :: While running +make on :build, we need to keep track of any - :: sub-builds that we try to access so we can keep track of - :: component linkages and cache access times. - :: - sub-builds=(list build) - == -:: +vane: short names for vanes -:: -:: TODO: move to zuse -:: -+= vane ?(%a %b %c %d %e %f %g) --- -=, format -|% -:: +tear: split a +term into segments delimited by `-` -:: -++ tear - |= a=term - ^- (list term) - :: sym-no-heps: a parser for terms with no heps and a leading letter - :: - =/ sym-no-heps (cook crip ;~(plug low (star ;~(pose low nud)))) - :: - (fall (rush a (most hep sym-no-heps)) /[a]) -:: +segments: TODO rename -:: -++ segments - |= path-part=@tas - ^- (list path) - :: - =/ join |=([a=@tas b=@tas] (crip "{(trip a)}-{(trip b)}")) - :: - =/ torn=(list @tas) (tear path-part) - :: - |- ^- (list (list @tas)) - :: - ?< ?=(~ torn) - :: - ?: ?=([@ ~] torn) - ~[torn] - :: - %- zing - %+ turn $(torn t.torn) - |= s=(list @tas) - ^- (list (list @tas)) - :: - ?> ?=(^ s) - ~[[i.torn s] [(join i.torn i.s) t.s]] -:: +build-to-tape: convert :build to a printable format -:: -++ build-to-tape - |= =build - ^- tape - :: - =/ enclose |=(tape "[{+<}]") - =/ date=@da date.build - =/ =schematic schematic.build - :: - %- enclose - %+ welp (trip (scot %da date)) - %+ welp " " - :: - ?+ -.schematic - :(welp "[" (trip -.schematic) " {<`@uvI`(mug schematic)>}]") - :: - %$ - "literal" - :: - ^ - %- enclose - ;:(welp $(build [date head.schematic]) " " $(build [date tail.schematic])) - :: - %scry - (spud (en-beam (extract-beam resource.schematic ~))) - :: - :: %slim - :: "slim {} {}" - == -:: +unify-jugs: make a new jug, unifying sets for all keys -:: -++ unify-jugs - |* [a=(jug) b=(jug)] - ^+ a - :: - =/ tapped ~(tap by b) - :: - |- ^+ a - ?~ tapped a - :: - =/ key p.i.tapped - =/ vals ~(tap in q.i.tapped) - :: - =. a - |- ^+ a - ?~ vals a - :: - $(vals t.vals, a (~(put ju a) key i.vals)) - :: - $(tapped t.tapped) -:: +scry-request-to-path: encode a +scry-request in a +wire -:: -++ scry-request-to-path - |= =scry-request - ^- path - =/ =term (cat 3 [vane care]:scry-request) - [term (en-beam beam.scry-request)] -:: +path-to-resource: decode a +resource from a +wire -:: -++ path-to-resource - |= =path - ^- (unit resource) - :: - =/ scry-request=(unit scry-request) (path-to-scry-request path) - ?~ scry-request - ~ - =+ [vane care bem]=u.scry-request - =/ =beam bem - =/ =rail [disc=[p.beam q.beam] spur=s.beam] - `[vane care rail] -:: +path-to-scry-request: parse :path to a :scry-request -:: -++ path-to-scry-request - |= =path - ^- (unit scry-request) - :: - ?. ?=([@ @ *] path) - ~ - :: parse :path's components into :vane, :care, and :rail - :: - =/ vane=(unit ?(%c %g)) ((soft ?(%c %g)) (end 3 1 i.path)) - ?~ vane - ~ - =/ care=(unit care:clay) ((soft care:clay) (rsh 3 1 i.path)) - ?~ care - ~ - =/ rest=(unit ^path) ((soft ^path) t.path) - ?~ rest - ~ - =/ beam (de-beam u.rest) - ?~ beam - ~ - :: - `[u.vane u.care u.beam] -:: +extract-beam: obtain a +beam from a +resource -:: -:: Fills case with [%ud 0] for live resources if :date is `~`. -:: For once resources, ignore :date. -:: -++ extract-beam - |= [=resource date=(unit @da)] ^- beam - :: - =/ =case ?~(date [%ud 0] [%da u.date]) - :: - =, rail.resource - [[ship.disc desk.disc case] spur] -:: +extract-disc: obtain a +disc from a +resource -:: -++ extract-disc - |= =resource ^- disc - disc.rail.resource -:: +get-sub-schematics: find any schematics contained within :schematic -:: -++ get-sub-schematics - |= =schematic - ^- (list ^schematic) - ?- -.schematic - ^ ~[head.schematic tail.schematic] - %$ ~ - %pin ~[schematic.schematic] - %alts choices.schematic - %bake ~ - %bunt ~ - %call ~[gate.schematic sample.schematic] - %cast ~[input.schematic] - %core ~ - %diff ~[start.schematic end.schematic] - %dude ~[attempt.schematic] - %hood ~ - %join ~[first.schematic second.schematic] - %mash ~[schematic.first.schematic schematic.second.schematic] - %mute [subject.schematic (turn mutations.schematic tail)] - %pact ~[start.schematic diff.schematic] - %path ~ - %plan ~ - %reef ~ - %ride ~[subject.schematic] - %same ~[schematic.schematic] - %scry ~ - %slim ~ - %slit ~ - %vale ~ - %volt ~ - == -:: +result-to-cage -:: -:: Maybe we should return vases instead of cages. -:: -++ result-to-cage - |= result=build-result - ^- cage - ?: ?=(%error -.result) - [%tang !>(message.result)] - ?- -.+.result - ^ [%noun (slop q:$(result head.result) q:$(result tail.result))] - %$ cage.result - %pin $(result build-result.result) - %alts $(result build-result.result) - %bake cage.result - %bunt cage.result - %call [%noun vase.result] - %cast cage.result - %core [%noun vase.result] - %diff cage.result - %dude $(result build-result.result) - %hood [%noun !>(scaffold.result)] - %join cage.result - %mash cage.result - %mute cage.result - %pact cage.result - %path [%noun !>(rail.result)] - %plan [%noun vase.result] - %reef [%noun vase.result] - %ride [%noun vase.result] - %same $(result build-result.result) - %scry cage.result - %slim [%noun !>([type nock]:result)] - %slit [%noun !>(type.result)] - %vale cage.result - %volt cage.result - == -:: +date-from-schematic: finds the latest pin date from this schematic tree. -:: -++ date-from-schematic - |= =schematic - ^- @da - =+ children=(get-sub-schematics schematic) - =/ dates (turn children date-from-schematic) - =+ children-latest=(roll dates max) - ?. ?=(%pin -.schematic) - children-latest - (max date.schematic children-latest) -:: +is-schematic-live: -:: -:: A schematic is live if it is not pinned. -:: -++ is-schematic-live - |= =schematic - ^- ? - !?=(%pin -.schematic) -:: +is-listener-live: helper function for loops -:: -++ is-listener-live |=(=listener live.listener) -:: +by-schematic: door for manipulating :by-schematic.builds.ford-state -:: -:: The :dates list for each key in :builds is sorted in reverse -:: chronological order. These operations access and mutate keys and values -:: of :builds and maintain that sort order. -:: -++ by-schematic - |_ builds=(map schematic (list @da)) - :: +put: add a +build to :builds - :: - :: If :build already exists in :builds, this is a no-op. - :: Otherwise, replace the value at the key :schematic.build - :: with a new :dates list that contains :date.build. - :: - ++ put - |= =build - ^+ builds - %+ ~(put by builds) schematic.build - :: - =/ dates (fall (~(get by builds) schematic.build) ~) - ?^ (find [date.build]~ dates) - dates - (sort [date.build dates] gte) - :: +del: remove a +build from :builds - :: - :: Removes :build from :builds by replacing the value at - :: the key :schematic.build with a new :dates list with - :: :date.build omitted. If the resulting :dates list is - :: empty, then remove the key-value pair from :builds. - :: - ++ del - |= =build - ^+ builds - =. builds %+ ~(put by builds) schematic.build - :: - ~| build+build - =/ dates (~(got by builds) schematic.build) - =/ date-index (need (find [date.build]~ dates)) - (oust [date-index 1] dates) - :: if :builds has an empty entry for :build, delete it - :: - =? builds - =(~ (~(got by builds) schematic.build)) - (~(del by builds) schematic.build) - :: - builds - :: +find-previous: find the most recent older build with :schematic.build - :: - ++ find-previous - |= =build - ^- (unit ^build) - :: - =/ dates=(list @da) (fall (~(get by builds) schematic.build) ~) - :: - |- ^- (unit ^build) - ?~ dates ~ - :: - ?: (lth i.dates date.build) - `[i.dates schematic.build] - $(dates t.dates) - :: +find-next: find the earliest build of :schematic.build later than :build - :: - ++ find-next - |= =build - ^- (unit ^build) - :: - =/ dates=(list @da) (flop (fall (~(get by builds) schematic.build) ~)) - :: - |- ^- (unit ^build) - ?~ dates ~ - :: - ?: (gth i.dates date.build) - `[i.dates schematic.build] - $(dates t.dates) - -- -:: +by-builds: door for manipulating :builds.state -:: -++ by-builds - |_ builds=build-registry - :: +put: add a +build - :: - ++ put - |= =build - ^+ builds - :: - %_ builds - by-date - (~(put ju by-date.builds) date.build schematic.build) - :: - by-schematic - (~(put by-schematic by-schematic.builds) build) - == - :: +del: remove a build - :: - ++ del - |= =build - ^+ builds - :: - %_ builds - by-date - (~(del ju by-date.builds) date.build schematic.build) - :: - by-schematic - (~(del by-schematic by-schematic.builds) build) - == - -- -:: +by-build-dag: door for manipulating a :build-dag -:: -++ by-build-dag - |_ dag=build-dag - :: +get-subs: produce a list of sub-builds. - :: - ++ get-subs - |= =build - ^- (list ^build) - =- ~(tap in (fall - ~)) - (~(get by sub-builds.dag) build) - :: +get-clients: produce a list of client-builds. - :: - ++ get-clients - |= =build - ^- (list ^build) - =- ~(tap in (fall - ~)) - (~(get by client-builds.dag) build) - :: - :: +put: add a linkage between a :client and a :sub +build - :: - ++ put - |= [client=build sub=build] - ^+ dag - %_ dag - sub-builds (~(put ju sub-builds.dag) client sub) - client-builds (~(put ju client-builds.dag) sub client) - == - :: +del: delete a linkage between a :client and a :sub +build - :: - ++ del - |= [client=build sub=build] - ^+ dag - %_ dag - sub-builds (~(del ju sub-builds.dag) client sub) - client-builds (~(del ju client-builds.dag) sub client) - == - :: +del-build: remove all linkages containing :build - :: - ++ del-build - |= =build - ^+ dag - :: - %_ dag - :: remove the mapping from :build to its sub-builds - :: - sub-builds - (~(del by sub-builds.dag) build) - :: for each +build in :kids, remove :build from its clients - :: - client-builds - %+ roll ~(tap in (~(get ju sub-builds.dag) build)) - |= [kid=^build clients=_client-builds.dag] - (~(del ju clients) kid build) - == - -- -:: +parse-scaffold: produces a parser for a hoon file with +crane instances -:: -:: Ford parses a superset of hoon which contains additional runes to -:: represent +crane s. This parses to a +scaffold. -:: -:: src-beam: +beam of the source file we're parsing -++ parse-scaffold - |= src-beam=beam - :: - =/ hoon-parser (vang & (en-beam src-beam)) - |^ :: - %+ cook - |= a=[@ud (list ^cable) (list ^cable) (list ^crane) (list ^brick)] - ^- scaffold - [[[p q] s]:src-beam a] - :: - %+ ifix [gay gay] - ;~ plug - :: - :: parses the zuse version, eg "/? 309" - ;~ pose - (ifix [;~(plug fas wut gap) gap] dem) - (easy zuse) - == - :: - :: pareses the structures, eg "/- types" - ;~ pose - (ifix [;~(plug fas hep gap) gap] (most ;~(plug com gaw) cable)) - (easy ~) - == - :: - :: parses the libraries, eg "/+ lib1, lib2" - ;~ pose - (ifix [;~(plug fas lus gap) gap] (most ;~(plug com gaw) cable)) - (easy ~) - == - :: - :: todo: the rest of the horns - (star ;~(sfix crane gap)) - :: - (most gap brick) - == - :: +beam: parses a hood path and converts it to a beam - :: - ++ beam - %+ sear de-beam - ;~ pfix - fas - (sear plex (stag %clsg poor)):hoon-parser - == - :: +brick: parses a +^brick, a direct or indirect piece of hoon code - :: - ++ brick - ;~ pose - (stag %indirect ;~(pfix fas fas gap beam)) - (stag %direct tall:hoon-parser) - == - :: +cable: parses a +^cable, a reference to something on the filesystem - :: - :: This parses: - :: - :: `library` -> wraps `library` around the library `library` - :: `face=library` -> wraps `face` around the library `library` - :: `*library` -> exposes `library` directly to the subject - :: - ++ cable - %+ cook |=(a=^cable a) - ;~ pose - (stag ~ ;~(pfix tar sym)) - (cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym)) - (cook |=(a=term [`a a]) sym) - == - :: +crane: all runes that start with / which aren't /?, /-, /+ or //. - :: - ++ crane - =< apex - :: whether we allow tall form - =| allow-tall-form=? - :: - |% - ++ apex - %+ knee *^crane |. ~+ - ;~ pfix fas - ;~ pose - :: `/~` hoon literal - (stag %fssg ;~(pfix sig hoon)) - :: `/$` process query string - (stag %fsbc ;~(pfix buc hoon)) - :: `/|` first of many options that succeeds - (stag %fsbr ;~(pfix bar parse-alts)) - :: `/=` wrap a face around a crane - (stag %fsts ;~(pfix tis parse-face)) - :: `/.` null terminated list - (stag %fsdt ;~(pfix dot parse-list)) - :: `/,` switch by path - (stag %fscm ;~(pfix com parse-switch)) - :: `/&` pass through a series of mark - (stag %fspm ;~(pfix pam parse-pipe)) - :: `/_` run a crane on each file in the current directory - (stag %fscb ;~(pfix cab subcrane)) - :: `/;` passes date through a gate - (stag %fssm ;~(pfix sem parse-gate)) - :: `/:` evaluate at path - (stag %fscl ;~(pfix col parse-at-path)) - :: `/^` cast - (stag %fskt ;~(pfix ket parse-cast)) - :: `/!mark/ evaluate as hoon, then pass through mark - (stag %fszp ;~(pfix zap ;~(sfix sym fas))) - :: `/mark/` passes current path through :mark - (stag %fszy ;~(sfix sym fas)) - == - == - :: +parse-alts: parse a set of alternatives - :: - ++ parse-alts - %+ wide-or-tall - (ifix [pel per] (most ace subcrane)) - ;~(sfix (star subcrane) gap duz) - :: +parse-face: parse a face around a subcrane - :: - ++ parse-face - %+ wide-or-tall - ;~(plug sym ;~(pfix tis subcrane)) - ;~(pfix gap ;~(plug sym subcrane)) - :: +parse-list: parse a null terminated list of cranes - :: - ++ parse-list - %+ wide-or-tall - fail - ;~(sfix (star subcrane) gap duz) - :: +parse-switch: parses a list of [path crane] - :: - ++ parse-switch - %+ wide-or-tall - fail - =- ;~(sfix (star -) gap duz) - ;~(pfix gap fas ;~(plug static-path subcrane)) - :: +parse-pipe: parses a pipe of mark conversions - :: - ++ parse-pipe - %+ wide-or-tall - ;~(plug (plus ;~(sfix sym pam)) subcrane) - =+ (cook |=(a=term [a ~]) sym) - ;~(pfix gap ;~(plug - subcrane)) - :: +parse-gate: parses a gate applied to a crane - :: - ++ parse-gate - %+ wide-or-tall - ;~(plug ;~(sfix wide:hoon-parser sem) subcrane) - ;~(pfix gap ;~(plug tall:hoon-parser subcrane)) - :: +parse-at-path: parses a late bound bath - :: - ++ parse-at-path - %+ wide-or-tall - ;~(plug ;~(sfix late-bound-path col) subcrane) - ;~(pfix gap ;~(plug late-bound-path subcrane)) - :: +parse-cast: parses a mold and then the subcrane to apply that mold to - :: - ++ parse-cast - %+ wide-or-tall - ;~(plug ;~(sfix wide:hoon-parser ket) subcrane) - ;~(pfix gap ;~(plug tall:hoon-parser subcrane)) - :: +crane: parses a subcrane - :: - ++ subcrane - %+ wide-or-tall - apex(allow-tall-form |) - ;~(pfix gap apex) - :: +wide-or-tall: parses tall form hoon if :allow-tall-form is %.y - :: - ++ wide-or-tall - |* [wide=rule tall=rule] - ?. allow-tall-form wide - ;~(pose wide tall) - :: +hoon: parses hoon as an argument to a crane - :: - ++ hoon - %+ wide-or-tall - (ifix [sel ser] (stag %cltr (most ace wide:hoon-parser))) - ;~(pfix gap tall:hoon-parser) - -- - :: +static-path: parses a path - :: - ++ static-path - (sear plex (stag %clsg (more fas hasp))):hoon-parser - :: +late-bound-path: a path whose time varies - :: - ++ late-bound-path - ;~ pfix fas - %+ cook |=(a=truss a) - => hoon-parser - ;~ plug - (stag ~ gash) - ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~)) - == - == - -- -:: +per-event: per-event core -:: -++ per-event - :: moves: the moves to be sent out at the end of this event, reversed - :: - =| moves=(list move) - :: dirty-discs: discs whose resources have changed during this event - :: - =| dirty-discs=(set disc) - :: scry-results: responses to scry's to handle in this event - :: - :: If a value is `~`, the requested resource is not available. - :: Otherwise, the value will contain a +cage. - :: - =| scry-results=(map scry-request (unit cage)) - :: the +per-event gate; each event will have a different sample - :: - :: Not a `|_` because of the `=/`s at the beginning. - :: Produces a core containing four public arms: - :: +start-build, +rebuild, +unblock, and +cancel. - :: - |= [[our=@p =duct now=@da scry=sley] state=ford-state] - :: original-clay-subscriptions: outstanding clay subscriptions at event start - :: - =/ original-clay-subscriptions clay-subscriptions.state - :: original-resources-by-disc: :resources-by-disc.state at event start - :: - =/ original-resources-by-disc resources-by-disc.state - :: - |% - :: |entry-points: externally fired arms - :: - ::+| entry-points - :: - :: +start-build: perform a fresh +build, either live or once - :: - ++ start-build - |= =schematic - ^- [(list move) ford-state] - :: - =< finalize - :: - |^ =+ live=(is-schematic-live schematic) - ?: live - start-live-build - start-once-build - :: - ++ start-live-build - ^+ this - =/ =build [now schematic] - :: - =. state (associate-build build duct %.y) - :: - (execute-loop (sy build ~)) - :: - ++ start-once-build - ^+ this - =/ pin-date=@da (date-from-schematic schematic) - =/ =build [pin-date schematic] - :: - =. state (associate-build build duct %.n) - :: - (execute-loop (sy build ~)) - :: +associate-build: associate +listener with :build in :state - :: - ++ associate-build - |= [=build duct=^duct live=?] - ^+ state - :: - %_ state - listeners - (~(put ju listeners.state) build [duct live]) - :: - builds-by-listener - (~(put by builds-by-listener.state) duct [build live]) - :: - root-listeners - (~(put ju root-listeners.state) build [duct live]) - == - :: - -- - :: +rebuild: rebuild any live builds based on +resource updates - :: - ++ rebuild - |= [ship=@p desk=@tas case=[%da p=@da] care-paths=(set [care=care:clay =path])] - ^- [(list move) ford-state] - :: - =< finalize - :: - =/ date=@da p.case - :: - =/ =disc [ship desk] - :: delete the now-dead clay subscription - :: - =. clay-subscriptions.state (~(del in clay-subscriptions.state) disc) - :: - =/ resources=(list resource) - %+ turn ~(tap in care-paths) - |= [care=care:clay =path] ^- resource - :: - [%c care rail=[disc spur=(flop path)]] - :: store changed resources persistently in case rebuilds finish later - :: - =. resource-updates.state - %+ roll resources - |= [=resource resource-updates=_resource-updates.state] - :: - (~(put ju resource-updates) date resource) - :: rebuild resource builds at the new date - :: - %- execute-loop - %- sy - %+ turn resources - |=(=resource `build`[date [%scry resource]]) - :: +unblock: continue builds that had blocked on :resource - :: - ++ unblock - |= [=scry-request scry-result=(unit cage)] - ^- [(list move) ford-state] - :: - =< finalize - :: place :scry-result in :scry-results.per-event - :: - :: We don't want to call the actual +scry function again, - :: because we already tried that in a previous event and it - :: had no synchronous answer. This +unblock call is a result - :: of the response to the asynchronous request we made to - :: retrieve that resource from another vane. - :: - :: Instead, we'll intercept any calls to +scry by looking up - :: the arguments in :scry-results.per-event. This is ok because - :: in this function we attempt to run every +build that had - :: blocked on the resource, so the information is guaranteed - :: to be used during this event before it goes out of scope. - :: - =. scry-results (~(put by scry-results) scry-request scry-result) - :: find all the :blocked-builds to continue - :: - =/ blocked-builds (~(get ju blocks.state) scry-request) - :: - (execute-loop blocked-builds) - :: +cancel: cancel a build - :: - :: When called on a live build, removes all tracking related to the live - :: build, and no more %made moves will be sent for that build. - :: - :: When called on a once build, removes all tracking related to the once - :: build, and that build will never be completed or have a %made sent. - :: - :: When called on a build that isn't registered in :state, such as a - :: completed once build, or a build that has already been canceled, - :: prints and no-ops. - :: - ++ cancel ^+ [moves state] - :: - =< finalize - :: - =/ build-and-live (~(get by builds-by-listener.state) duct) - :: - ?~ build-and-live - ~&(no-build-for-duct+duct this) - :: - =+ [build live]=u.build-and-live - :: old-rebuilds and listeners don't interact well. - :: - :: Have two ducts listening to the same build, causing a promotion. - :: The new build has an old build. Both ducts by :builds-by-listener - :: point to th new build. The new build has an old build and thus - :: never gets cleaned up. - :: - =. state (remove-listener-from-build [duct live] build) - :: - (cleanup build) - :: +remove-listener-from-build: recursively remove listener from (sub)builds - :: - ++ remove-listener-from-build - |= [=listener =build] - ^+ state - :: - =? state (~(has ju root-listeners.state) build listener) - %_ state - builds-by-listener - (~(del by builds-by-listener.state) duct.listener) - :: - root-listeners - (~(del ju root-listeners.state) build listener) - == - :: - =/ original-build build - =/ builds=(list ^build) ~[build] - :: - |- ^+ state - ?~ builds - state - :: - =. build i.builds - :: are there any clients with this listener? - :: - =/ clients-with-listener=? - %+ lien - %~ tap in - =/ clients=(set ^build) - (fall (~(get by client-builds.components.state) build) ~) - %- ~(uni in clients) - (fall (~(get by client-builds.provisional-components.state) build) ~) - :: - |= client=^build - (~(has ju listeners.state) client listener) - :: when there are clients, don't remove the listener from this build - :: - ?: clients-with-listener - $(builds t.builds) - :: - =. listeners.state - (~(del ju listeners.state) build listener) - :: - =/ sub-builds (~(get-subs by-build-dag components.state) build) - :: - =/ provisional-sub-builds - (~(get-subs by-build-dag provisional-components.state) build) - :: - =/ new-builds=(list ^build) - ?: =(build original-build) ~ - (drop (~(find-next by-schematic by-schematic.builds.state) build)) - :: - $(builds :(welp t.builds sub-builds provisional-sub-builds new-builds)) - :: |construction: arms for performing builds - :: - ::+| construction - :: - :: +execute-loop: +execute repeatedly until there's no more work to do - :: - :: TODO: This implementation is for simplicity. In the longer term, we'd - :: like to just perform a single run through +execute and set a Behn timer - :: to wake us up immediately. This has the advantage that Ford stops hard - :: blocking the main Urbit event loop, letting other work be done. - :: - ++ execute-loop - |= builds=(set build) - ^+ ..execute - :: - =. ..execute (execute builds) - :: - ?: ?& ?=(~ next-builds.state) - ?=(~ candidate-builds.state) - == - ..execute - :: - $(builds ~) - :: +execute: main recursive construction algorithm - :: - :: Performs the three step build process: First, figure out which builds - :: we're going to run this loop through the ford algorithm. Second, run - :: the gathered builds, possibly in parallel. Third, apply the +build-receipt - :: algorithms to the ford state. - :: - ++ execute - |= builds=(set build) - ^+ ..execute - :: - |^ ^+ ..execute - :: - =. ..execute (gather builds) - :: - =^ build-receipts ..execute run-builds - :: - (reduce build-receipts) - :: +gather: collect builds to be run in a batch - :: - :: The +gather phase is the first of the three parts of +execute. In - :: +gather, we look through each item in :candidate-builds.state. If we - :: should run the candidate build this cycle through the +execute loop, - :: we place it in :next-builds.state. +gather runs until it has no more - :: candidates. - :: - ++ gather - |= builds=(set build) - ^+ ..execute - :: add builds that were triggered by incoming event to the candidate list - :: - =. candidate-builds.state - (weld candidate-builds.state ~(tap in builds)) - :: - |^ :: - ?~ candidate-builds.state - ..execute - :: - =/ next i.candidate-builds.state - => .(candidate-builds.state t.candidate-builds.state) - :: - $(..execute (gather-build next)) - :: +gather-build: looks at a single candidate build - :: - :: This gate inspects a single build. It might move it to :next-builds, - :: or promote it using an old build. It also might add this build's - :: sub-builds to :candidate-builds. - :: - ++ gather-build - |= =build - ^+ ..execute - :: if we already have a result for this build, don't rerun the build - :: - =^ current-result results.state (access-cache build) - ?: ?=([~ %value *] current-result) - ..execute - :: place :build in :builds.state if it isn't already there - :: - =. builds.state (~(put by-builds builds.state) build) - :: old-build: most recent previous build with :schematic.build - :: - =/ old-build=(unit ^build) - (~(find-previous by-schematic by-schematic.builds.state) build) - :: if no previous builds exist, we need to run :build - :: - ?~ old-build - (add-build-to-next build) - :: copy :old-build's live listeners - :: - =. state (copy-old-live-listeners u.old-build build) - :: if any resources have changed, we need to rebuild :build - :: - ?: (resources-changed build) - (add-build-to-next build) - :: if we don't have :u.old-build's result cached, we need to run :build - :: - =^ old-cache-line results.state (access-cache u.old-build) - ?~ old-cache-line - (add-build-to-next build) - :: if :u.old-build's result has been wiped, we need to run :build - :: - ?: ?=(%tombstone -.u.old-cache-line) - (add-build-to-next build) - :: if any ancestors are pinned, we must rerun - :: - :: We can't cleanly promote a once build to a live build because we - :: didn't register its resources in the live tracking system. - :: - ?: (has-pinned-client u.old-build) - (add-build-to-next build) - :: old-subs: sub-builds of :u.old-build - :: - =/ old-subs (~(get-subs by-build-dag components.state) u.old-build) - :: - =/ new-subs (turn old-subs |=(^build +<(date date.build))) - :: if all subs are in old.rebuilds.state, promote ourselves - :: - ?: (levy new-subs ~(has by old.rebuilds.state)) - (on-all-subs-are-rebuilds u.old-build build new-subs) - :: - =. state (record-sub-builds-as-provisional build new-subs) - :: all new-subs have results, some are not rebuilds - :: - :: We rerun :build because these non-rebuild results might be different, - :: possibly giving :build a different result. - :: - =/ uncached-new-subs (skip new-subs is-build-cached) - ?~ uncached-new-subs - (add-build-to-next build) - :: otherwise, not all new subs have results and we shouldn't be run - :: - (on-not-all-subs-have-results build uncached-new-subs) - :: +add-build-to-next: run this build during the +make phase - :: - ++ add-build-to-next - |= =build - ..execute(next-builds.state (~(put in next-builds.state) build)) - :: +on-all-subs-are-rebuilds: promote when all sub-builds are rebuilds - :: - :: When all subs are rebuilds, we promote :old and add builds - :: unblocked by this promotion to our :candidate-builds. - :: - ++ on-all-subs-are-rebuilds - |= [old=build new=build new-subs=(list build)] - ^+ ..execute - :: link all :new-subs to :build in :components.state - :: - =. state - %+ roll new-subs - :: - |= [new-sub=build state=_state] - :: - state(components (~(put by-build-dag components.state) new new-sub)) - :: - =^ wiped-rebuild ..execute (promote-build old date.new) - =? next-builds.state - ?=(^ wiped-rebuild) - (~(put in next-builds.state) u.wiped-rebuild) - :: - =^ unblocked-clients state (mark-as-done new) - =. candidate-builds.state - (welp unblocked-clients candidate-builds.state) - :: - ..execute - :: +on-not-all-subs-have-results: this build can't be run at this time - :: - :: When all our sub builds don't have results, we can't add :build to - :: :next-builds.state. Instead, put all the remaining uncached new - :: subs into :candidate-builds.state. - :: - :: If all of our sub-builds finish immediately (i.e. promoted) when - :: they pass through +gather-internal, they will add :build back to - :: :candidate-builds.state and we will run again before +execute runs - :: +make. - :: - ++ on-not-all-subs-have-results - |= [=build uncached-new-subs=(list build)] - ^+ ..execute - :: - =. blocked-builds.state - %+ roll uncached-new-subs - |= [new-sub=^build blocked-builds=_blocked-builds.state] - :: - (~(put by-build-dag blocked-builds) build new-sub) - :: - %_ ..execute - candidate-builds.state - :(welp uncached-new-subs candidate-builds.state) - == - :: +copy-old-live-listeners: copies each live listener from :old to :new - :: - ++ copy-old-live-listeners - |= [old=build new=build] - ^+ state - :: - =/ old-live-listeners=(list listener) - =- (skim - is-listener-live) - =- ~(tap in `(set listener)`(fall - ~)) - (~(get by listeners.state) old) - :: - %+ roll old-live-listeners - |= [=listener state=_state] - :: - state(listeners (~(put ju listeners.state) new listener)) - :: +record-sub-builds-as-provisional: - :: - :: When we can't directly promote ourselves, we're going to rerun - :: our build. It's possible that the sub-builds are different, in - :: which case we'll need to clean up the current sub-build dependency. - :: - ++ record-sub-builds-as-provisional - |= [=build new-subs=(list build)] - ^+ state - :: - %_ state - provisional-components - %+ roll new-subs - |= [new-sub=^build provisional-components=_provisional-components.state] - :: - (~(put by-build-dag provisional-components) build new-sub) - == - -- - :: +promote-build: promote result of :build to newer :date - :: - :: Also performs relevant accounting, and possibly sends %made moves. - :: - ++ promote-build - |= [old-build=build date=@da] - ^- [(unit build) _..execute] - :: grab the previous result, freshening the cache - :: - =^ old-cache-line results.state (access-cache old-build) - :: we can only promote a cached result, not missing or a %tombstone - :: - ?> ?=([~ %value *] old-cache-line) - :: :new-build is :old-build at :date; promotion destination - :: - =/ new-build=build old-build(date date) - :: copy the old result to :new-build - :: - =. results.state (~(put by results.state) new-build u.old-cache-line) - :: link :old-build and :new-build persistently - :: - :: We store identical rebuilds persistently so that we know we don't - :: have to promote or rerun clients of the new rebuild. - :: - =. rebuilds.state (link-rebuilds old-build new-build) - :: if this is the newest %scry on :disc, update :latest-by-disc.state - :: - :: :latest-by-disc.state is used to create Clay subscriptions. This - :: promoted build may now be the latest time for this :disc. - :: - =? latest-by-disc.state - ?& ?=(%scry -.schematic.old-build) - =/ disc (extract-disc resource.schematic.old-build) - ~| [disc+disc latest-by-disc+latest-by-disc.state] - (gth date (~(got by latest-by-disc.state) disc)) - == - =/ disc (extract-disc resource.schematic.old-build) - (~(put by latest-by-disc.state) disc date) - :: sanity check that +promote-build was called on a registered build - :: - ?> (~(has ju by-date.builds.state) date.new-build schematic.new-build) - :: mirror linkages between :old-build and subs to :new-build and subs - :: - =. components.state - %+ roll (~(get-subs by-build-dag components.state) old-build) - :: - |= [old-sub=build components=_components.state] - :: - =/ new-sub=build old-sub(date date) - (~(put by-build-dag components) new-build new-sub) - :: promoted builds are no longer provisional - :: - =. provisional-components.state - %+ roll (~(get-subs by-build-dag provisional-components.state) new-build) - :: - |= [old-sub=build provisional-components=_provisional-components.state] - :: - =/ new-sub=build old-sub(date date) - (~(del by-build-dag provisional-components) new-build new-sub) - :: send %made moves for the previously established live listeners - :: - :: We only want to send %made moves for live listeners which were - :: already on :new-build. We don't want to send %made moves for - :: listeners that we copy from :old-build because :new-build has the - :: same result as :old-build; therefore, we would be sending a - :: duplicate %made. - :: - =. ..execute (send-mades new-build (root-live-listeners new-build)) - :: move live listeners from :old-build to :new-build - :: - :: When we promote a build, we advance the live listeners from - :: :old-build to :new-build. Live listeners should be attached to the - :: most recent completed build for a given schematic. - :: - =. state (advance-live-listeners old-build new-build) - :: send %made moves for once listeners and delete them - :: - :: If we have once listeners, we can send %made moves for them and - :: then no longer track them. - :: - =. ..execute (send-mades new-build (root-once-listeners new-build)) - =. state (delete-root-once-listeners new-build) - :: send %made moves for future builds - :: - :: We may have future results queued, waiting on this build to send a - :: %made. Now that we've sent current %made moves, we can send future - :: ones, as we need to send these in chronological order by formal - :: date. - :: - =^ wiped-rebuild ..execute (send-future-mades new-build) - :: :old-build might no longer be tracked by anything - :: - =. ..execute (cleanup old-build) - :: - [wiped-rebuild ..execute] - :: +send-future-mades: send %made moves for future rebuilds - :: - :: If a future rebuild has been wiped, then produce it along with - :: a modified `..execute` core. - :: - ++ send-future-mades - |= =build - ^- [(unit ^build) _..execute] - :: - =^ result results.state (access-cache build) - :: - =/ next (~(find-next by-schematic by-schematic.builds.state) build) - ?~ next - :: no future build - :: - [~ ..execute] - :: - =^ next-result results.state (access-cache u.next) - ?~ next-result - :: unfinished future build - :: - [~ ..execute] - :: if :next's result hasn't been wiped - :: - ?: ?& ?=(%value -.u.next-result) - !(has-pinned-client u.next) - == - :: - =. state (advance-live-listeners build u.next) - =. ..execute (cleanup build) - :: if the result has changed, send %made moves for live listeners - :: - =? ..execute - ?& ?=([~ %value *] result) - !=(build-result.u.result build-result.u.next-result) - == - (send-mades u.next (root-live-listeners u.next)) - :: - $(build u.next) - :: if :next has been wiped, produce it - :: - [`u.next ..execute] - :: +run-builds: run the builds and produce +build-receipts - :: - :: Runs the builds and cleans up the build lists afterwards. - :: - :: TODO: When the vere interpreter has a parallel variant of +turn, use - :: that as each build might take a while and there are no data - :: dependencies between builds here. - :: - ++ run-builds - ^- [(list build-receipt) _..execute] - :: - =/ build-receipts=(list build-receipt) - (turn ~(tap in next-builds.state) make) - :: - =. next-builds.state ~ - [build-receipts ..execute] - :: reduce: apply +build-receipts produce from the +make phase. - :: - :: +gather produces builds to run make on. +make produces - :: +build-receipts. It is in +reduce where we take these +build-receipts and - :: apply them to ..execute. - :: - ++ reduce - |= build-receipts=(list build-receipt) - ^+ ..execute - :: sort :build-receipts so blocks are processed before completions - :: - :: It's possible for a build to block on a sub-build that was run - :: in the same batch. If that's the case, make sure we register - :: that the build blocked on the sub-build before registering the - :: completion of the sub-build. This way, when we do register the - :: completion of the sub-build, we will know which builds are blocked - :: on the sub-build, so we can enqueue those blocked clients to be - :: rerun. - :: - =. build-receipts - %+ sort build-receipts - |= [a=build-receipt b=build-receipt] - ^- ? - ?=(%blocks -.result.a) - :: - |^ ^+ ..execute - ?~ build-receipts ..execute - :: - =. ..execute (apply-build-receipt i.build-receipts) - $(build-receipts t.build-receipts) - :: +apply-build-receipt: applies a single state diff to ..execute - :: - ++ apply-build-receipt - |= made=build-receipt - :: update live resource tracking if the build is a live %scry - :: - =? ..execute - ?& ?=(%scry -.schematic.build.made) - (is-build-live build.made) - == - :: - (do-live-scry-accounting build.made resource.schematic.build.made) - :: process :sub-builds.made - :: - =. state (track-sub-builds build.made sub-builds.made) - :: - ?- -.result.made - %build-result - (apply-build-result made) - :: - %blocks - (apply-blocks build.made result.made sub-builds.made) - == - :: +do-live-scry-accounting: updates tracking for a live %scry build - :: - ++ do-live-scry-accounting - |= [=build =resource] - ^+ ..execute - =/ =disc (extract-disc resource) - :: - %_ ..execute - :: link :disc to :resource - :: - resources-by-disc.state - (~(put ju resources-by-disc.state) [disc resource]) - :: mark :disc as dirty - :: - dirty-discs - (~(put in dirty-discs) disc) - :: update :latest-by-disc.state if :date.build is later - :: - latest-by-disc.state - =/ latest-date (~(get by latest-by-disc.state) disc) - :: - ?: ?& ?=(^ latest-date) - (lte date.build u.latest-date) - == - latest-by-disc.state - :: - (~(put by latest-by-disc.state) disc date.build) - == - :: +track-sub-builds: - :: - :: For every sub-build discovered while running :build, we have to make - :: sure that we track that sub-build and that it is associated with the - :: right listeners. - :: - ++ track-sub-builds - |= [=build sub-builds=(list build)] - ^+ state - %+ roll sub-builds - |= [sub-build=^build accumulator=_state] - =. state accumulator - :: freshen cache for sub-build - :: - =. results.state +:(access-cache sub-build) - :: - %_ state - builds - (~(put by-builds builds.state) sub-build) - :: - components - (~(put by-build-dag components.state) build sub-build) - :: - listeners - :: - =/ unified-listeners - %- ~(uni in (fall (~(get by listeners.state) sub-build) ~)) - (fall (~(get by listeners.state) build) ~) - :: don't put a key with an empty value - :: - ?~ unified-listeners - listeners.state - :: - (~(put by listeners.state) sub-build unified-listeners) - == - :: - :: +| apply-build-result - :: - :: +apply-build-result: apply a %build-result +build-receipt to ..execute - :: - :: Our build produced an actual result. - :: - ++ apply-build-result - |= $: =build - $: %build-result - =build-result - == - sub-builds=(list build) - == - ^+ ..execute - :: - ?> (~(has ju by-date.builds.state) date.build schematic.build) - :: record the result returned from the build - :: - =. results.state - %+ ~(put by results.state) build - [%value last-accessed=now build-result] - :: queue clients we can run now that we have this build result - :: - =^ unblocked-clients state (mark-as-done build) - =. next-builds.state (~(gas in next-builds.state) unblocked-clients) - :: :previous-build: last build of :schematic.build before :build if any - :: - =/ previous-build - (~(find-previous by-schematic by-schematic.builds.state) build) - :: :previous-result: result of :previous-build if any - :: - =^ previous-result results.state - ?~ previous-build - [~ results.state] - (access-cache u.previous-build) - :: promote live listeners if we can - :: - :: When we have a :previous-build with a :previous-result, and the - :: previous-build isn't a descendant of a %pin schematic, we need to - :: advance live listeners because this is now the most recent build. - :: - =? state - ?& ?=(^ previous-build) - ?=(^ previous-result) - :: TODO: double check on the tests for this. it seems wrong, - :: as a build could have an unpinned client and a pinned - :: client - !(has-pinned-client u.previous-build) - == - (advance-live-listeners u.previous-build build) - :: send results to once listeners and delete them - :: - :: Once listeners are deleted as soon as their %made has been sent - :: because they don't maintain a subscription to the build. - :: - =. ..execute (send-mades build (root-once-listeners build)) - =. state (delete-root-once-listeners build) - :: does :build have the same result as :u.previous-build? - :: - :: We consider a result the same if we have a :previous-build which - :: has a real %value, the current :build-result is the same, and - :: the :previous-build doesn't have a pinned client. We can't - :: promote pinned builds, so we always consider the result to be - :: different. - :: - =/ same-result=? - ?& ?=(^ previous-build) - !(has-pinned-client u.previous-build) - ?=([~ %value *] previous-result) - =(build-result build-result.u.previous-result) - == - :: if we have the same result, link the rebuilds - :: - :: We store identical rebuilds persistently so that we know we don't - :: have to promote or rerun clients of the new rebuild. - :: - =? rebuilds.state - same-result - :: - ?> ?=(^ previous-build) - (link-rebuilds u.previous-build build) - :: if the result has changed, inform all live listeners - :: - =? ..execute - !same-result - (send-mades build (root-live-listeners build)) - :: if the result has changed, rerun all old clients - :: - :: When we have a previous result which isn't the same, we need to - :: rerun old clients at the current time. Since those clients have - :: sub-builds with new results, the results of clients might also be - :: different. - :: - =? state - &(!same-result ?=(^ previous-build)) - (enqueue-client-rebuilds build u.previous-build) - :: clean up provisional builds - :: - =. state (unlink-used-provisional-builds build sub-builds) - =. ..execute (cleanup-orphaned-provisional-builds build) - :: if we had a previous build, clean it up - :: - =? ..execute - ?=(^ previous-build) - (cleanup u.previous-build) - :: clean up our current build - :: - :: If :build was a once build, now that we've sent its %made moves, we - :: can delete it. - :: - =. ..execute (cleanup build) - :: now that we've handled :build, check any future builds - :: - :: We may have future results queued, waiting on this build to send - :: a %made. Now that we've sent current %made moves, we can send - :: future ones, as we need to send these in chronological order by - :: formal date. - :: - =^ wiped-rebuild ..execute (send-future-mades build) - ?~ wiped-rebuild - ..execute - :: if a future-build's result was wiped from the cache, rebuild it. - :: - =. next-builds.state (~(put in next-builds.state) u.wiped-rebuild) - :: - ..execute - :: +enqueue-client-rebuilds: rerun old clients, updated to current time - :: - ++ enqueue-client-rebuilds - |= [=build previous-build=build] - ^+ state - :: - =/ clients-to-rebuild=(list ^build) - %+ turn - %+ weld - (~(get-clients by-build-dag components.state) previous-build) - :: - =/ older-build (~(get by old.rebuilds.state) previous-build) - ?~ older-build - ~ - :: - (~(get-clients by-build-dag components.state) u.older-build) - :: - |= old-client=^build - old-client(date date.build) - :: - %+ roll clients-to-rebuild - |= [client=^build state=_state] - :: - %_ state - :: - next-builds - (~(put in next-builds.state) client) - :: - provisional-components - (~(put by-build-dag provisional-components.state) client build) - :: - builds - (~(put by-builds builds.state) client) - == - :: +unlink-used-provisional-builds: - :: - :: The first step in provisional build cleanup is to remove - :: sub-builds which were actually depended on from the provisional - :: build set because they're no longer provisional. - :: - ++ unlink-used-provisional-builds - |= [=build sub-builds=(list build)] - ^+ state - :: - %_ state - provisional-components - %+ roll sub-builds - |= $: sub-build=^build - provisional-components=_provisional-components.state - == - :: - (~(del by-build-dag provisional-components) build sub-build) - == - :: +cleanup-orphaned-provisional-builds: delete extraneous sub-builds - :: - :: Any builds left in :provisional-components.state for our build - :: are orphaned builds. However, these builds may have other - :: listeners and we don't want to delete those. - :: - ++ cleanup-orphaned-provisional-builds - |= =build - ^+ ..execute - :: - %+ roll - (~(get-subs by-build-dag provisional-components.state) build) - :: - |= [sub-build=^build accumulator=_..execute] - =. ..execute accumulator - :: calculate the listeners to remove - :: - :: Orphaned sub-builds have a set of listeners attached to them. - :: We want to find the listeners which shouldn't be there and - :: remove them. - :: - =/ provisional-client-listeners=(set listener) - (fall (~(get by listeners.state) build) ~) - :: unify listener sets of all provisional client builds of :sub-build - :: - =/ all-other-client-listeners=(set listener) - %+ roll - %~ tap in - :: omit :build; it's all *other* client listeners - :: - =- (~(del in -) build) - =- (fall - ~) - (~(get by client-builds.provisional-components.state) sub-build) - |= [build=^build listeners=(set listener)] - :: - %- ~(uni in listeners) - (fall (~(get by listeners.state) build) ~) - :: remove the orphaned build from provisional builds - :: - =. provisional-components.state - (~(del by-build-dag provisional-components.state) build sub-build) - :: orphaned-listeners: the clients we actually have to remove - :: - :: The clients that are actually orphaned are the ones which are - :: in :provisional-client-listeners, but not - :: :all-other-client-listeners. - :: - =/ orphaned-listeners - (~(dif in provisional-client-listeners) all-other-client-listeners) - :: remove orphaned listeners from :sub-build - :: - :: We need to do this after we've removed :sub-build from - :: :provisional-components.state because otherwise that provisional - :: client link will prevent the listener from being removed. - :: - =. state - %+ roll ~(tap in orphaned-listeners) - |= [=listener accumulator=_state] - =. state accumulator - :: - (remove-listener-from-build listener sub-build) - :: - (cleanup sub-build) - :: - :: +| apply-blocks - :: - :: +apply-blocks: apply a %blocks +build-receipt to ..execute - :: - :: :build blocked. Record information about what builds it blocked on - :: and try those blocked builds as candidates in the next pass. - :: - ++ apply-blocks - |= $: =build - $: %blocks - blocks=(list build) - scry-blocked=(unit scry-request) - == - sub-builds=(list build) - == - ^+ ..execute - :: if we scryed, send clay a request for the path we blocked on reading - :: - =? moves - ?=(^ scry-blocked) - :: TODO: handle other vanes - :: - ?> ?=(%c vane.u.scry-blocked) - :: - [(clay-request-for-scry-request date.build u.scry-blocked) moves] - :: register resource block in :blocks.state - :: - =? blocks.state - ?=(^ scry-blocked) - (~(put ju blocks.state) u.scry-blocked build) - :: register blocks on sub-builds in :blocked-builds.state - :: - =. state (register-sub-build-blocks build blocks) - :: - ..execute - :: +clay-request-for-scry-request: new move to request blocked resource - :: - ++ clay-request-for-scry-request - |= [date=@da =scry-request] - ^- move - :: - =/ =wire - (welp /(scot %p our)/scry-request (scry-request-to-path scry-request)) - :: - =/ =note - =/ =disc [p q]:beam.scry-request - :* %c %warp sock=[our their=ship.disc] desk.disc - `[%sing care.scry-request case=[%da date] (flop s.beam.scry-request)] - == - :: - [duct=~ [%pass wire note]] - :: +register-sub-build-blocks: book-keeping on blocked builds - :: - :: When we receive a %blocks +build-receipt, we need to register that - :: :build is blocked on each item in :blocks, along with queuing - :: each block as a candidate build. - :: - ++ register-sub-build-blocks - |= [=build blocks=(list build)] - ^+ state - :: - %+ roll blocks - |= [block=^build state=_state] - :: we must run +apply-build-receipt on :build.made before :block - :: - ?< (~(has by results.state) block) - :: - %_ state - blocked-builds - (~(put by-build-dag blocked-builds.state) build block) - :: - candidate-builds - [block candidate-builds.state] - == - -- - :: +resources-changed: did resources change since :previous-build? - :: - ++ resources-changed - |= =build - ^- ? - ?. ?=(%scry -.schematic.build) - | - :: - =/ =resource resource.schematic.build - :: - ?. ?=(%c -.resource) - | - :: - =/ updates (fall (~(get by resource-updates.state) date.build) ~) - :: - (~(has in updates) resource) - :: +link-rebuilds: link old and new same build in :rebuilds.state - :: - ++ link-rebuilds - |= [old-build=build new-build=build] - ^+ rebuilds.state - :: - %_ rebuilds.state - old (~(put by old.rebuilds.state) new-build old-build) - new (~(put by new.rebuilds.state) old-build new-build) - == - :: +delete-root-once-listeners: remove once listeners on :build from :state - :: - ++ delete-root-once-listeners - |= =build - ^+ state - :: - %+ roll (root-once-listeners build) - |= [=listener accumulator=_state] - =. state accumulator - (remove-listener-from-build listener build) - -- - :: +make: attempt to perform :build, non-recursively - :: - :: Registers component linkages between :build and its sub-builds. - :: Attempts to perform +scry if necessary. Does not directly enqueue - :: any moves. - :: - ++ make - |= =build - ^- build-receipt - :: accessed-builds: builds accessed/depended on during this run. - :: - =| accessed-builds=(list ^build) - :: dispatch based on the kind of +schematic in :build - :: - :: - |^ =, schematic.build - :: - ?- -.schematic.build - :: - ^ (make-autocons [head tail]) - :: - %$ (make-literal literal) - :: - %pin (make-pin date schematic) - %alts (make-alts choices) - %bake (make-bake renderer query-string path-to-render) - %bunt (make-bunt disc mark) - %call (make-call gate sample) - %cast (make-cast disc mark input) - %core (make-core source-path) - %diff (make-diff disc start end) - %dude (make-dude error attempt) - %hood (make-hood source-path) - %join (make-join disc mark first second) - %mash (make-mash disc mark first second) - %mute (make-mute subject mutations) - %pact (make-pact disc start diff) - %path (make-path disc prefix raw-path) - %plan (make-plan path-to-render query-string scaffold) - %reef (make-reef disc) - %ride (make-ride formula subject) - %same (make-same schematic) - %scry (make-scry resource) - %slim (make-slim subject-type formula) - %slit (make-slit gate sample) - %vale (make-vale disc mark input) - %volt (make-volt disc mark input) - == - :: |schematic-handlers:make: implementation of the schematics - :: - :: All of these produce a value of the same type as +make itself. - :: - :: +| schematic-handlers - :: - ++ make-autocons - |= [head=schematic tail=schematic] - ^- build-receipt - :: - =/ head-build=^build [date.build head] - =/ tail-build=^build [date.build tail] - =^ head-result accessed-builds (depend-on head-build) - =^ tail-result accessed-builds (depend-on tail-build) - :: - =| blocks=(list ^build) - =? blocks ?=(~ head-result) [head-build blocks] - =? blocks ?=(~ tail-result) [tail-build blocks] - :: if either build blocked, we're not done - :: - ?^ blocks - :: - [build [%blocks blocks ~] accessed-builds] - :: - ?< ?=(~ head-result) - ?< ?=(~ tail-result) - :: - =- [build [%build-result -] accessed-builds] - `build-result`[%success u.head-result u.tail-result] - :: - ++ make-literal - |= =cage - ^- build-receipt - [build [%build-result %success %$ cage] accessed-builds] - :: - ++ make-pin - |= [date=@da =schematic] - ^- build-receipt - :: pinned-sub: sub-build with the %pin date as formal date - :: - =/ pinned-sub=^build [date schematic] - :: - =^ result accessed-builds (depend-on pinned-sub) - :: - ?~ result - [build [%blocks ~[pinned-sub] ~] accessed-builds] - [build [%build-result %success %pin date u.result] accessed-builds] - :: - ++ make-alts - |= choices=(list schematic) - ^- build-receipt - :: - ?~ choices - (return-error [leaf+"%alts: all options failed"]~) - :: - =/ choice=^build [date.build i.choices] - :: - =^ result accessed-builds (depend-on choice) - ?~ result - [build [%blocks ~[choice] ~] accessed-builds] - :: - ?: ?=([%error *] u.result) - $(choices t.choices) - :: - [build [%build-result %success %alts u.result] accessed-builds] - :: - ++ make-bake - |= [renderer=term query-string=coin path-to-render=rail] - ^- build-receipt - :: path-build: find the file path for the renderer source - :: - =/ path-build=^build - [date.build [%path disc.path-to-render %ren renderer]] - :: - =^ path-result accessed-builds (depend-on path-build) - ?~ path-result - [build [%blocks [path-build]~ ~] accessed-builds] - :: if there's a renderer called :renderer, use it on :path-to-render - :: - ?: ?=([~ %success %path *] path-result) - :: build a +scaffold from the renderer source - :: - =/ hood-build=^build [date.build [%hood rail.u.path-result]] - :: - =^ hood-result accessed-builds (depend-on hood-build) - ?~ hood-result - [build [%blocks [hood-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %hood *] hood-result) - (wrap-error hood-result) - :: link the renderer, passing through :path-to-render and :query-string - :: - =/ plan-build=^build - :- date.build - [%plan path-to-render query-string scaffold.u.hood-result] - :: - =^ plan-result accessed-builds (depend-on plan-build) - ?~ plan-result - [build [%blocks [plan-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %plan *] plan-result) - (wrap-error plan-result) - :: - =/ =build-result - [%success %bake %noun vase.u.plan-result] - :: - [build [%build-result build-result] accessed-builds] - :: no renderer, try mark; retrieve directory listing of :path-to-render - :: - :: There might be multiple files of different marks stored at - :: :path-to-render. Retrieve the directory listing for - :: :path-to-render, then check which of the path segments in - :: that directory are files (not just folders), then for each - :: file try to %cast its mark to the desired mark (:renderer). - :: - :: Start by retrieving the directory listing, using :toplevel-build. - :: - =/ toplevel-build=^build - [date.build [%scry %c %y path-to-render]] - :: - =^ toplevel-result accessed-builds (depend-on toplevel-build) - ?~ toplevel-result - [build [%blocks [toplevel-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %scry *] toplevel-result) - (wrap-error toplevel-result) - :: - =/ toplevel-arch=arch ;;(arch q.q.cage.u.toplevel-result) - :: find the :sub-path-segments that could be files - :: - :: Filter out path segments that aren't a +term, - :: since those aren't valid marks and therefore can't - :: be the last segment of a filepath in Clay. - :: - =/ sub-path-segments=(list @ta) - (skim (turn ~(tap by dir.toplevel-arch) head) (sane %tas)) - :: create :sub-builds to check which :sub-path-segments are files - :: - =/ sub-builds=(list ^build) - %+ turn sub-path-segments - |= sub=@ta - ^- ^build - :- date.build - [%scry %c %y path-to-render(spur [sub spur.path-to-render])] - :: - =| $= results - (list [kid=^build sub-path=@ta result=(unit build-result)]) - :: run :sub-builds - :: - =/ subs-results - |- ^+ [results accessed-builds] - ?~ sub-builds [results accessed-builds] - ?> ?=(^ sub-path-segments) - :: - =/ kid=^build i.sub-builds - =/ sub-path=@ta i.sub-path-segments - :: - =^ result accessed-builds (depend-on kid) - =. results [[kid sub-path result] results] - :: - $(sub-builds t.sub-builds, sub-path-segments t.sub-path-segments) - :: apply mutations from depending on :sub-builds - :: - =: results -.subs-results - accessed-builds +.subs-results - == - :: split :results into completed :mades and incomplete :blocks - :: - =/ split-results - (skid results |=([* * r=(unit build-result)] ?=(^ r))) - :: - =/ mades=_results -.split-results - =/ blocks=_results +.split-results - :: if any builds blocked, produce them all as %blocks - :: - ?^ blocks - [build [%blocks (turn `_results`blocks head) ~] accessed-builds] - :: check for errors - :: - =/ errors=_results - %+ skim results - |= [* * r=(unit build-result)] - ?=([~ %error *] r) - :: if any errored, produce the first error, as is tradition - :: - ?^ errors - ?> ?=([~ %error *] result.i.errors) - =/ =build-result - [%error message.u.result.i.errors] - :: - [build [%build-result build-result] accessed-builds] - :: marks: list of the marks of the files at :path-to-render - :: - =/ marks=(list @tas) - %+ murn results - |= [kid=^build sub-path=@ta result=(unit build-result)] - ^- (unit @tas) - :: - ?> ?=([@da %scry %c %y *] kid) - ?> ?=([~ %success %scry *] result) - :: - =/ =arch ;;(arch q.q.cage.u.result) - :: if it's a directory, not a file, we can't load it - :: - ?~ fil.arch - ~ - [~ `@tas`sub-path] - :: sort marks in alphabetical order - :: - =. marks (sort marks lte) - :: try to convert files to the destination mark, in order - :: - =/ alts-build=^build - :: - :+ date.build %alts - ^= choices ^- (list schematic) - :: - %+ turn marks - |= mark=term - ^- schematic - :: - =/ file=rail path-to-render(spur [mark spur.path-to-render]) - :: - [%cast disc.file renderer [%scry %c %x file]] - :: - =^ alts-result accessed-builds (depend-on alts-build) - ?~ alts-result - [build [%blocks [alts-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %alts *] alts-result) - (wrap-error alts-result) - :: - =/ =build-result - [%success %bake (result-to-cage u.alts-result)] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-bunt - |= [=disc mark=term] - ^- build-receipt - :: resolve path of the mark definition file - :: - =/ path-build=^build [date.build [%path disc %mar mark]] - :: - =^ path-result accessed-builds (depend-on path-build) - ?~ path-result - [build [%blocks [path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] path-result) - (wrap-error path-result) - :: build the mark core from source - :: - =/ core-build=^build [date.build [%core rail.u.path-result]] - :: - =^ core-result accessed-builds (depend-on core-build) - ?~ core-result - [build [%blocks [core-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] core-result) - (wrap-error core-result) - :: extract the sample from the mark core - :: - =/ mark-vase=vase vase.u.core-result - ~| %mark-vase - =+ [sample-type=p sample-value=q]:(slot 6 mark-vase) - :: if sample is wrapped in a face, unwrap it - :: - =? sample-type ?=(%face -.sample-type) q.sample-type - :: - =/ =cage [mark sample-type sample-value] - [build [%build-result %success %bunt cage] accessed-builds] - :: - ++ make-call - |= [gate=schematic sample=schematic] - ^- build-receipt - :: - =/ gate-build=^build [date.build gate] - =^ gate-result accessed-builds (depend-on gate-build) - :: - =/ sample-build=^build [date.build sample] - =^ sample-result accessed-builds (depend-on sample-build) - :: - =| blocks=(list ^build) - =? blocks ?=(~ gate-result) [[date.build gate] blocks] - =? blocks ?=(~ sample-result) [[date.build sample] blocks] - ?^ blocks - :: - [build [%blocks blocks ~] accessed-builds] - :: - ?< ?=(~ gate-result) - ?< ?=(~ sample-result) - :: - =/ gate-vase=vase q:(result-to-cage u.gate-result) - =/ sample-vase=vase q:(result-to-cage u.sample-result) - :: - :: run %slit to get the resulting type of calculating the gate - :: - =/ slit-schematic=schematic [%slit gate-vase sample-vase] - =/ slit-build=^build [date.build slit-schematic] - =^ slit-result accessed-builds (depend-on slit-build) - ?~ slit-result - [build [%blocks [date.build slit-schematic]~ ~] accessed-builds] - :: - ?. ?=([~ %success %slit *] slit-result) - (wrap-error slit-result) - :: - :: How much duplication is there going to be here between +call and - :: +ride? Right now, we're just !! on scrys, but for reals we want it to - :: do the same handling. - ?> &(?=(^ q.gate-vase) ?=(^ +.q.gate-vase)) - =/ val - (mong [q.gate-vase q.sample-vase] intercepted-scry) - :: - ?- -.val - %0 - :* build - [%build-result %success %call [type.u.slit-result p.val]] - accessed-builds - == - :: - %1 - =/ blocked-paths=(list path) ((hard (list path)) p.val) - (blocked-paths-to-receipt %call blocked-paths) - :: - %2 - (return-error [[%leaf "ford: %call failed:"] p.val]) - == - :: - ++ make-cast - |= [=disc mark=term input=schematic] - ^- build-receipt - :: find the path of the destination mark source - :: - =/ final-mark-path-build=^build [date.build [%path disc %mar mark]] - :: - =^ final-mark-path-result accessed-builds - (depend-on final-mark-path-build) - :: - ?~ final-mark-path-result - [build [%blocks [final-mark-path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] final-mark-path-result) - (wrap-error final-mark-path-result) - :: - =/ final-mark-path=rail rail.u.final-mark-path-result - :: build the destination mark source into a +vase of the mark core - :: - =/ final-mark-build=^build [date.build [%core final-mark-path]] - :: - =^ final-mark-result accessed-builds (depend-on final-mark-build) - ?~ final-mark-result - [build [%blocks [final-mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] final-mark-result) - (wrap-error final-mark-result) - :: - =/ final-mark=vase vase.u.final-mark-result - :: run the :input schematic to obtain the mark and value of the input - :: - =/ input-build=^build [date.build input] - :: - =^ input-result accessed-builds (depend-on input-build) - ?~ input-result - [build [%blocks [input-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success *] input-result) - (wrap-error input-result) - :: - =/ input-result-cage=cage (result-to-cage u.input-result) - :: - |^ :: if :final-mark has no +grab arm, grow from the input mark - :: - ?. (slob %grab p.final-mark) - grow - :: find +grab within the destination mark core - :: - =/ grab-build=^build - [date.build [%ride [%limb %grab] [%$ %noun final-mark]]] - :: - =^ grab-result accessed-builds (depend-on grab-build) - ?~ grab-result - [build [%blocks [grab-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grab-result) - (wrap-error grab-result) - :: if the +grab core has no arm for the input mark, grow from input - :: - ?. (slob p.input-result-cage p.vase.u.grab-result) - grow - :: find an arm for the input's mark within the +grab core - :: - =/ grab-mark-build=^build - :- date.build - [%ride [%limb p.input-result-cage] [%$ %noun vase.u.grab-result]] - :: - =^ grab-mark-result accessed-builds (depend-on grab-mark-build) - ?~ grab-mark-result - [build [%blocks [grab-mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grab-mark-result) - (wrap-error grab-mark-result) - :: slam the +mark-name:grab gate on the result of running :input - :: - =/ call-build=^build - :- date.build - [%call gate=[%$ %noun vase.u.grab-mark-result] sample=input] - :: - =^ call-result accessed-builds (depend-on call-build) - ?~ call-result - [build [%blocks [call-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] call-result) - (wrap-error call-result) - :: - =/ =build-result - [%success %cast [mark vase.u.call-result]] - :: - [build [%build-result build-result] accessed-builds] - :: +grow: grow from the input mark to the destination mark - :: - ++ grow - ^- build-receipt - :: we couldn't grab; try to +grow from the input mark - :: - =/ starting-mark-path-build=^build - [date.build [%path disc %mar p.input-result-cage]] - :: - =^ starting-mark-path-result accessed-builds - (depend-on starting-mark-path-build) - ?~ starting-mark-path-result - [build [%blocks [starting-mark-path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] starting-mark-path-result) - (wrap-error starting-mark-path-result) - :: grow the value from the initial mark to the final mark - :: - :: Replace the input mark's sample with the input's result, - :: then fire the mark-name:grow arm to produce a result. - :: - =/ grow-build=^build - :- date.build - :+ %ride - formula=`hoon`[%tsgl [%wing ~[mark]] [%wing ~[%grow]]] - ^= subject - ^- schematic - :* %mute - ^- schematic - [%core rail.u.starting-mark-path-result] - ^= mutations - ^- (list [wing schematic]) - [[%& 6]~ [%$ input-result-cage]]~ - == - :: - =^ grow-result accessed-builds (depend-on grow-build) - ?~ grow-result - [build [%blocks [grow-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grow-result) - (wrap-error grow-result) - :: make sure the product nests in the sample of the destination mark - :: - =/ bunt-build=^build [date.build [%bunt disc mark]] - :: - =^ bunt-result accessed-builds (depend-on bunt-build) - ?~ bunt-result - [build [%blocks [bunt-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %bunt *] bunt-result) - (wrap-error bunt-result) - :: - ?. (~(nest ut p.q.cage.u.bunt-result) | p.vase.u.grow-result) - (return-error [leaf+"ford: %cast failed: nest fail"]~) - :: - =/ =build-result - [%success %cast mark vase.u.grow-result] - :: - [build [%build-result build-result] accessed-builds] - -- - :: - ++ make-core - |= source-path=rail - ^- build-receipt - :: convert file at :source-path to a +scaffold - :: - =/ hood-build=^build [date.build [%hood source-path]] - :: - =^ hood-result accessed-builds (depend-on hood-build) - ?~ hood-result - [build [%blocks [hood-build]~ ~] accessed-builds] - :: - ?: ?=(%error -.u.hood-result) - (wrap-error hood-result) - :: build the +scaffold into a program - :: - ?> ?=([%success %hood *] u.hood-result) - :: - =/ plan-build=^build - [date.build [%plan source-path `coin`[%many ~] scaffold.u.hood-result]] - :: - =^ plan-result accessed-builds (depend-on plan-build) - ?~ plan-result - [build [%blocks [plan-build]~ ~] accessed-builds] - :: - ?: ?=(%error -.u.plan-result) - (wrap-error plan-result) - :: - ?> ?=([%success %plan *] u.plan-result) - [build [%build-result %success %core vase.u.plan-result] accessed-builds] - :: - ++ make-diff - |= [=disc start=schematic end=schematic] - ^- build-receipt - :: run both input schematics as an autocons build - :: - =/ sub-build=^build [date.build [start end]] - :: - =^ sub-result accessed-builds (depend-on sub-build) - ?~ sub-result - [build [%blocks [sub-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success ^ ^] sub-result) - (wrap-error sub-result) - ?. ?=([%success *] head.u.sub-result) - (wrap-error `head.u.sub-result) - ?. ?=([%success *] tail.u.sub-result) - (wrap-error `tail.u.sub-result) - :: - =/ start-cage=cage (result-to-cage head.u.sub-result) - =/ end-cage=cage (result-to-cage tail.u.sub-result) - :: if the marks aren't the same, we can't diff them - :: - ?. =(p.start-cage p.end-cage) - %- return-error :_ ~ :- %leaf - "ford: %diff failed: mark mismatch: %{} / %{}" - :: if the values are the same, the diff is null - :: - ?: =(q.q.start-cage q.q.end-cage) - =/ =build-result - [%success %diff [%null [%atom %n ~] ~]] - :: - [build [%build-result build-result] accessed-builds] - :: - =/ mark-path-build=^build [date.build [%path disc %mar p.start-cage]] - :: - =^ mark-path-result accessed-builds (depend-on mark-path-build) - ?~ mark-path-result - [build [%blocks [mark-path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] mark-path-result) - (wrap-error mark-path-result) - :: - =/ mark-build=^build [date.build [%core rail.u.mark-path-result]] - :: - =^ mark-result accessed-builds (depend-on mark-build) - ?~ mark-result - [build [%blocks [mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] mark-result) - (wrap-error mark-result) - :: - ?. (slab %grad p.vase.u.mark-result) - %- return-error :_ ~ :- %leaf - "ford: %diff failed: %{} mark has no +grad arm" - :: - =/ grad-build=^build - [date.build [%ride [%limb %grad] [%$ %noun vase.u.mark-result]]] - :: - =^ grad-result accessed-builds (depend-on grad-build) - ?~ grad-result - [build [%blocks [grad-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grad-result) - (wrap-error grad-result) - :: if +grad produced a @tas, convert to that mark and diff those - :: - ?@ q.vase.u.grad-result - =/ mark=(unit @tas) ((sand %tas) q.vase.u.grad-result) - ?~ mark - %- return-error :_ ~ :- %leaf - "ford: %diff failed: %{} mark has invalid +grad arm" - :: - =/ diff-build=^build - :- date.build - :^ %diff - disc - [%cast disc u.mark [%$ start-cage]] - [%cast disc u.mark [%$ end-cage]] - :: - =^ diff-result accessed-builds (depend-on diff-build) - ?~ diff-result - [build [%blocks [diff-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %diff *] diff-result) - (wrap-error diff-result) - :: - =/ =build-result - [%success %diff cage.u.diff-result] - :: - [build [%build-result build-result] accessed-builds] - :: +grad produced a cell, which should be a core with a +form arm - :: - ?. (slab %form p.vase.u.grad-result) - %- return-error :_ ~ :- %leaf - "ford: %diff failed: %{} mark has no +form:grab arm" - :: the +grab core should also contain a +diff arm - :: - ?. (slab %diff p.vase.u.grad-result) - %- return-error :_ ~ :- %leaf - "ford: %diff failed: %{} mark has no +diff:grab arm" - :: - =/ diff-build=^build - :- date.build - :+ %call - :: - ^= gate - :+ %ride - :: - formula=`hoon`[%tsgl [%wing ~[%diff]] [%wing ~[%grad]]] - :: - ^= subject - :+ %mute - :: - subject=`schematic`[%$ %noun vase.u.mark-result] - :: - ^= mutations - ^- (list [wing schematic]) - [[%& 6]~ [%$ start-cage]]~ - :: - sample=`schematic`[%$ end-cage] - :: - =^ diff-result accessed-builds (depend-on diff-build) - ?~ diff-result - [build [%blocks [diff-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] diff-result) - (wrap-error diff-result) - :: - =/ form-build=^build - [date.build [%ride [%limb %form] [%$ %noun vase.u.grad-result]]] - :: - =^ form-result accessed-builds (depend-on form-build) - ?~ form-result - [build [%blocks [form-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] form-result) - (wrap-error form-result) - :: - =/ mark=(unit @tas) ((soft @tas) q.vase.u.form-result) - ?~ mark - %- return-error :_ ~ :- %leaf - "ford: %diff failed: invalid +form result: {(text vase.u.form-result)}" - :: - =/ =build-result - [%success %diff [u.mark vase.u.diff-result]] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-dude - |= [error=(trap tank) attempt=schematic] - ^- build-receipt - :: - =/ attempt-build=^build [date.build attempt] - =^ attempt-result accessed-builds (depend-on attempt-build) - ?~ attempt-result - :: - [build [%blocks ~[[date.build attempt]] ~] accessed-builds] - :: - ?. ?=([%error *] u.attempt-result) - [build [%build-result %success %dude u.attempt-result] accessed-builds] - :: - (return-error [$:error message.u.attempt-result]) - :: - ++ make-hood - |= source-path=rail - ^- build-receipt - :: - =/ scry-build=^build [date.build [%scry [%c %x source-path]]] - =^ scry-result accessed-builds (depend-on scry-build) - ?~ scry-result - :: - [build [%blocks ~[scry-build] ~] accessed-builds] - :: - ?: ?=([~ %error *] scry-result) - (wrap-error scry-result) - =+ as-cage=(result-to-cage u.scry-result) - :: hoon files must be atoms to parse - :: - ?. ?=(@ q.q.as-cage) - (return-error [%leaf "ford: %hood: file not an atom"]~) - :: - =* src-beam [[ship.disc desk.disc [%ud 0]] spur]:source-path - =/ parsed - ((full (parse-scaffold src-beam)) [1 1] (trip q.q.as-cage)) - :: - ?~ q.parsed - (return-error [%leaf "syntax error: {} {}"]~) - :: - [build [%build-result %success %hood p.u.q.parsed] accessed-builds] - :: - ++ make-join - |= [disc=^disc mark=term first=schematic second=schematic] - ^- build-receipt - :: - =/ initial-build=^build - [date.build [first second] [%path disc %mar mark]] - :: - =^ initial-result accessed-builds (depend-on initial-build) - ?~ initial-result - [build [%blocks [initial-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success [%success ^ ^] %success %path *] initial-result) - (wrap-error initial-result) - ?. ?=([%success *] head.head.u.initial-result) - (wrap-error `head.head.u.initial-result) - ?. ?=([%success *] tail.head.u.initial-result) - (wrap-error `tail.head.u.initial-result) - :: - =/ first-cage=cage (result-to-cage head.head.u.initial-result) - =/ second-cage=cage (result-to-cage tail.head.u.initial-result) - =/ mark-path=rail rail.tail.u.initial-result - :: TODO: duplicate logic with +make-pact and others - :: - =/ mark-build=^build [date.build [%core mark-path]] - :: - =^ mark-result accessed-builds (depend-on mark-build) - ?~ mark-result - [build [%blocks [mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] mark-result) - (wrap-error mark-result) - :: - =/ mark-vase=vase vase.u.mark-result - :: - ?. (slab %grad p.mark-vase) - %- return-error :_ ~ :- %leaf - "ford: %join failed: %{} mark has no +grad arm" - :: - =/ grad-build=^build - [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] - :: - =^ grad-result accessed-builds (depend-on grad-build) - ?~ grad-result - [build [%blocks [grad-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grad-result) - (wrap-error grad-result) - :: - =/ grad-vase=vase vase.u.grad-result - :: if +grad produced a mark, delegate %join behavior to that mark - :: - ?@ q.grad-vase - :: if +grad produced a term, make sure it's a valid mark - :: - =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) - ?~ grad-mark - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark invalid +grad" - :: - =/ join-build=^build - [date.build [%join disc mark [%$ first-cage] [%$ second-cage]]] - :: - =^ join-result accessed-builds (depend-on join-build) - ?~ join-result - [build [%blocks [join-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %join *] join-result) - (wrap-error join-result) - :: - [build [%build-result u.join-result] accessed-builds] - :: make sure the +grad core has a +form arm - :: - ?. (slab %form p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %join failed: no +form:grad in %{} mark" - :: make sure the +grad core has a +join arm - :: - ?. (slab %join p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %join failed: no +join:grad in %{} mark" - :: fire the +form:grad arm, which should produce a mark - :: - =/ form-build=^build - [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] - :: - =^ form-result accessed-builds (depend-on form-build) - ?~ form-result - [build [%blocks [form-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] form-result) - (wrap-error form-result) - :: - =/ form-mark=(unit term) ((soft @tas) q.vase.u.form-result) - ?~ form-mark - %- return-error :_ ~ :- %leaf - "ford: %join failed: %{} mark invalid +form:grad" - :: the mark produced by +form:grad should match both diffs - :: - ?. &(=(u.form-mark p.first-cage) =(u.form-mark p.second-cage)) - %- return-error :_ ~ :- %leaf - "ford: %join failed: mark mismatch" - :: if the diffs are identical, just produce the first - :: - ?: =(q.q.first-cage q.q.second-cage) - [build [%build-result %success %join first-cage] accessed-builds] - :: call the +join:grad gate on the two diffs - :: - =/ diff-build=^build - :- date.build - :+ %call - :+ %ride - [%limb %join] - [%$ %noun grad-vase] - [%$ %noun (slop q.first-cage q.second-cage)] - :: - =^ diff-result accessed-builds (depend-on diff-build) - ?~ diff-result - [build [%blocks [diff-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] diff-result) - (wrap-error diff-result) - :: the result was a unit; if `~`, use %null mark; otherwise grab tail - :: - =/ =build-result - :+ %success %join - ?@ q.vase.u.diff-result - [%null vase.u.diff-result] - [u.form-mark (slot 3 vase.u.diff-result)] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-mash - |= $: disc=^disc - mark=term - first=[disc=^disc mark=term =schematic] - second=[disc=^disc mark=term =schematic] - == - ^- build-receipt - :: - =/ initial-build=^build - [date.build [schematic.first schematic.second] [%path disc %mar mark]] - :: - =^ initial-result accessed-builds (depend-on initial-build) - ?~ initial-result - [build [%blocks [initial-build]~ ~] accessed-builds] - :: TODO: duplicate logic with +make-join - :: - ?. ?=([~ %success [%success ^ ^] %success %path *] initial-result) - (wrap-error initial-result) - ?. ?=([%success *] head.head.u.initial-result) - (wrap-error `head.head.u.initial-result) - ?. ?=([%success *] tail.head.u.initial-result) - (wrap-error `tail.head.u.initial-result) - :: - =/ first-cage=cage (result-to-cage head.head.u.initial-result) - =/ second-cage=cage (result-to-cage tail.head.u.initial-result) - =/ mark-path=rail rail.tail.u.initial-result - :: TODO: duplicate logic with +make-pact and others - :: - =/ mark-build=^build [date.build [%core mark-path]] - :: - =^ mark-result accessed-builds (depend-on mark-build) - ?~ mark-result - [build [%blocks [mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] mark-result) - (wrap-error mark-result) - :: - =/ mark-vase=vase vase.u.mark-result - :: - ?. (slab %grad p.mark-vase) - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark has no +grad arm" - :: - =/ grad-build=^build - [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] - :: - =^ grad-result accessed-builds (depend-on grad-build) - ?~ grad-result - [build [%blocks [grad-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grad-result) - (wrap-error grad-result) - :: - =/ grad-vase=vase vase.u.grad-result - :: if +grad produced a mark, delegate %mash behavior to that mark - :: - ?@ q.grad-vase - :: if +grad produced a term, make sure it's a valid mark - :: - =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) - ?~ grad-mark - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark invalid +grad" - :: - =/ mash-build=^build - :- date.build - :- %mash - :^ disc u.grad-mark - [disc.first mark.first [%$ first-cage]] - [disc.second mark.second [%$ second-cage]] - :: - =^ mash-result accessed-builds (depend-on mash-build) - ?~ mash-result - [build [%blocks [mash-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %mash *] mash-result) - (wrap-error mash-result) - :: - =/ =build-result - [%success %mash cage.u.mash-result] - :: - [build [%build-result build-result] accessed-builds] - :: - ?. (slab %form p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark has no +form:grad" - :: - ?. (slab %mash p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark has no +mash:grad" - :: - =/ form-build=^build - [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] - :: - =^ form-result accessed-builds (depend-on form-build) - ?~ form-result - [build [%blocks [form-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] form-result) - (wrap-error form-result) - :: - =/ form-mark=(unit term) ((soft @tas) q.vase.u.form-result) - ?~ form-mark - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark invalid +form:grad" - :: - ?. &(=(u.form-mark p.first-cage) =(u.form-mark p.second-cage)) - %- return-error :_ ~ :- %leaf - "ford: %mash failed: mark mismatch" - :: - ?: =(q.q.first-cage q.q.second-cage) - =/ =build-result - [%success %mash [%null [%atom %n ~] ~]] - :: - [build [%build-result build-result] accessed-builds] - :: call the +mash:grad gate on two [ship desk diff] triples - :: - =/ mash-build=^build - :- date.build - :+ %call - :+ %ride - [%limb %mash] - [%$ %noun grad-vase] - :+ %$ %noun - %+ slop - ;: slop - [[%atom %p ~] ship.disc.first] - [[%atom %tas ~] desk.disc.first] - q.first-cage - == - ;: slop - [[%atom %p ~] ship.disc.second] - [[%atom %tas ~] desk.disc.second] - q.second-cage - == - :: - =^ mash-result accessed-builds (depend-on mash-build) - ?~ mash-result - [build [%blocks [mash-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] mash-result) - (wrap-error mash-result) - :: - =/ =build-result - [%success %mash [u.form-mark vase.u.mash-result]] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-mute - |= [subject=schematic mutations=(list [=wing =schematic])] - ^- build-receipt - :: run the subject build to produce the noun to be mutated - :: - =/ subject-build=^build [date.build subject] - =^ subject-result accessed-builds (depend-on subject-build) - ?~ subject-result - [build [%blocks [subject-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success *] subject-result) - (wrap-error subject-result) - :: - =/ subject-cage=cage (result-to-cage u.subject-result) - :: - =/ subject-vase=vase q.subject-cage - :: run the mutants as sub-builds - :: - =^ results-raw accessed-builds - %+ roll mutations - |= $: [=wing =schematic] - $= accumulator - $: results=(list [wing ^build (unit build-result)]) - accessed-builds=_accessed-builds - == == - ^+ accumulator - :: - =. accessed-builds accessed-builds.accumulator - :: - =/ sub-build=^build [date.build schematic] - :: - =^ result accessed-builds.accumulator (depend-on sub-build) - =. results.accumulator [[wing sub-build result] results.accumulator] - :: - accumulator - :: help out the type system - :: - =/ results=(list [wing ^build (unit build-result)]) results-raw - :: check for errors - :: - =/ error=tang - %- zing ^- (list tang) - %+ murn results - |= [* * result=(unit build-result)] - ^- (unit tang) - ?. ?=([~ %error *] result) - ~ - `message.u.result - :: only produce the first error, as is tradition - :: - ?^ error - =. error [leaf+"ford: %mute failed: " error] - [build [%build-result %error error] accessed-builds] - :: if any sub-builds blocked, produce all blocked sub-builds - :: - =/ blocks=(list ^build) - %+ murn `(list [wing ^build (unit build-result)])`results - |= [* sub=^build result=(unit build-result)] - ^- (unit ^build) - ?^ result - ~ - `sub - :: - ?^ blocks - [build [%blocks blocks ~] accessed-builds] - :: all builds succeeded; retrieve vases from results - :: - =/ successes=(list [=wing =vase]) - %+ turn results - |= [=wing * result=(unit build-result)] - ^- [^wing vase] - :: - ?> ?=([~ %success *] result) - :: - [wing q:(result-to-cage u.result)] - :: create and run a +build to apply all mutations in order - :: - =/ ride-build=^build - :- date.build - :+ %ride - :: formula: a `%_` +hoon that applies a list of mutations - :: - :: The hoon ends up looking like: - :: ``` - :: %_ +2 - :: wing-1 +6 - :: wing-2 +14 - :: ... - :: == - :: ``` - :: - ^= formula - ^- hoon - :+ %cncb [%& 2]~ - =/ axis 3 - :: - |- ^- (list [wing hoon]) - ?~ successes ~ - :: - :- [wing.i.successes [%$ (peg axis 2)]] - $(successes t.successes, axis (peg axis 3)) - :: subject: list of :subject-vase and mutations, as literal schematic - :: - :: The subject ends up as a vase of something like this: - :: ``` - :: :~ original-subject - :: mutant-1 - :: mutant-2 - :: ... - :: == - :: ``` - :: - ^= subject ^- schematic - :+ %$ %noun - ^- vase - %+ slop subject-vase - |- ^- vase - ?~ successes [[%atom %n ~] ~] - :: - (slop vase.i.successes $(successes t.successes)) - :: - =^ ride-result accessed-builds (depend-on ride-build) - ?~ ride-result - [build [%blocks [ride-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] ride-result) - (wrap-error ride-result) - :: - =/ =build-result - [%success %mute p.subject-cage vase.u.ride-result] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-pact - |= [disc=^disc start=schematic diff=schematic] - ^- build-receipt - :: first, build the inputs - :: - =/ initial-build=^build [date.build start diff] - :: - =^ initial-result accessed-builds (depend-on initial-build) - ?~ initial-result - [build [%blocks [initial-build]~ ~] accessed-builds] - :: - ?> ?=([~ %success ^ ^] initial-result) - =/ start-result=build-result head.u.initial-result - =/ diff-result=build-result tail.u.initial-result - :: - ?. ?=(%success -.start-result) - (wrap-error `start-result) - ?. ?=(%success -.diff-result) - (wrap-error `diff-result) - :: - =/ start-cage=cage (result-to-cage start-result) - =/ diff-cage=cage (result-to-cage diff-result) - :: - =/ start-mark=term p.start-cage - =/ diff-mark=term p.diff-cage - :: load the starting mark from the filesystem - :: - =/ mark-path-build=^build [date.build [%path disc %mar start-mark]] - :: - =^ mark-path-result accessed-builds - (depend-on mark-path-build) - :: - ?~ mark-path-result - [build [%blocks [mark-path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] mark-path-result) - (wrap-error mark-path-result) - :: - =/ mark-build=^build [date.build [%core rail.u.mark-path-result]] - :: - =^ mark-result accessed-builds (depend-on mark-build) - ?~ mark-result - [build [%blocks [mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] mark-result) - (wrap-error mark-result) - :: - =/ mark-vase=vase vase.u.mark-result - :: fire the +grad arm of the mark core - :: - ?. (slab %grad p.mark-vase) - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark has no +grad arm" - :: - =/ grad-build=^build - [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] - :: - =^ grad-result accessed-builds (depend-on grad-build) - ?~ grad-result - [build [%blocks [grad-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grad-result) - (wrap-error grad-result) - :: - =/ grad-vase=vase vase.u.grad-result - :: +grad can produce a term or a core - :: - :: If a mark's +grad arm produces a mark (as a +term), - :: it means we should use that mark's machinery to run %pact. - :: In this way, a mark can delegate its patching machinery to - :: another mark. - :: - :: First we cast :start-cage to the +grad mark, then we run - :: a new %pact build on the result of that, which will use the - :: +grad mark's +grad arm. Finally we cast the %pact result back to - :: :start-mark, since we're trying to produce a patched version of - :: the initial marked value (:start-cage). - :: - ?@ q.grad-vase - :: if +grad produced a term, make sure it's a valid mark - :: - =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) - ?~ grad-mark - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark invalid +grad" - :: cast :start-cage to :grad-mark, %pact that, then cast back to start - :: - =/ cast-build=^build - :- date.build - :^ %cast disc start-mark - :^ %pact disc - :^ %cast disc u.grad-mark - [%$ start-cage] - [%$ diff-cage] - :: - =^ cast-result accessed-builds (depend-on cast-build) - ?~ cast-result - [build [%blocks [cast-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %cast *] cast-result) - (wrap-error cast-result) - :: - =/ =build-result - [%success %pact cage.u.cast-result] - :: - [build [%build-result build-result] accessed-builds] - :: +grad produced a core; make sure it has a +form arm - :: - :: +grad can produce a core containing +pact and +form - :: arms. +form:grad, which produces a mark (as a term), is used - :: to verify that the diff is of the correct mark. - :: - :: +pact:grad produces a gate that gets slammed with the diff - :: as its sample and produces a mutant version of :start-cage - :: by applying the diff. - :: - ?. (slab %form p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %pact failed: no +form:grad in %{} mark" - :: we also need a +pact arm in the +grad core - :: - ?. (slab %pact p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %pact failed: no +pact:grad in %{} mark" - :: fire the +form arm in the core produced by +grad - :: - =/ form-build=^build - [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] - :: - =^ form-result accessed-builds (depend-on form-build) - ?~ form-result - [build [%blocks [form-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] form-result) - (wrap-error form-result) - :: +form:grad should produce a mark - :: - =/ form-mark=(unit @tas) ((soft @tas) q.vase.u.form-result) - ?~ form-mark - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark invalid +form:grad" - :: mark produced by +form:grad needs to match the mark of the diff - :: - ?. =(u.form-mark diff-mark) - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark invalid +form:grad" - :: call +pact:grad on the diff - :: - =/ pact-build=^build - :- date.build - :+ %call - ^- schematic - :+ %ride - [%tsgl [%limb %pact] [%limb %grad]] - ^- schematic - :+ %mute - ^- schematic - [%$ %noun mark-vase] - ^- (list [wing schematic]) - [[%& 6]~ [%$ start-cage]]~ - ^- schematic - [%$ diff-cage] - :: - =^ pact-result accessed-builds (depend-on pact-build) - ?~ pact-result - [build [%blocks [pact-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] pact-result) - (wrap-error pact-result) - :: - =/ =build-result - [%success %pact start-mark vase.u.pact-result] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-path - |= [disc=^disc prefix=@tas raw-path=@tas] - ^- build-receipt - :: possible-spurs: flopped paths to which :raw-path could resolve - :: - =/ possible-spurs=(list spur) (turn (segments raw-path) flop) - :: sub-builds: scry builds to check each path in :possible-paths - :: - =/ sub-builds=(list ^build) - %+ turn possible-spurs - |= possible-spur=spur - ^- ^build - :: full-spur: wrap :possible-spur with :prefix and /hoon suffix - :: - =/ full-spur=spur :(welp /hoon possible-spur /[prefix]) - :: - [date.build [%scry %c %x `rail`[disc full-spur]]] - :: results: accumulator for results of sub-builds - :: - =| results=(list [kid=^build result=(unit build-result)]) - :: depend on all the sub-builds and collect their results - :: - =/ subs-results - |- ^+ [results accessed-builds] - ?~ sub-builds [results accessed-builds] - :: - =/ kid=^build i.sub-builds - :: - =^ result accessed-builds (depend-on kid) - =. results [[kid result] results] - :: - $(sub-builds t.sub-builds) - :: apply mutations from depending on sub-builds - :: - =: results -.subs-results - accessed-builds +.subs-results - == - :: split :results into completed :mades and incomplete :blocks - :: - =+ split-results=(skid results |=([* r=(unit build-result)] ?=(^ r))) - :: - =/ mades=_results -.split-results - =/ blocks=_results +.split-results - :: if any builds blocked, produce them all in %blocks - :: - ?^ blocks - [build [%blocks (turn `_results`blocks head) ~] accessed-builds] - :: matches: builds that completed with a successful result - :: - =/ matches=_results - %+ skim mades - |= [* r=(unit build-result)] - :: - ?=([~ %success *] r) - :: if no matches, error out - :: - ?~ matches - =/ =beam - [[ship.disc desk.disc [%da date.build]] /hoon/[raw-path]/[prefix]] - :: - (return-error [%leaf "%path: no matches for {<(en-beam beam)>}"]~) - :: if exactly one path matches, succeed with the matching path - :: - ?: ?=([* ~] matches) - =* kid kid.i.matches - ?> ?=(%scry -.schematic.kid) - :: - :* build - [%build-result %success %path rail.resource.schematic.kid] - accessed-builds - == - :: multiple paths matched; error out - :: - %- return-error - :: - :- [%leaf "multiple matches for %path: "] - :: tmi; cast :matches back to +list - :: - %+ roll `_results`matches - |= [[kid=^build result=(unit build-result)] message=tang] - ^- tang - :: - ?> ?=(%scry -.schematic.kid) - :: beam: reconstruct request from :kid's schematic and date - :: - =/ =beam - :* [ship.disc desk.disc [%da date.kid]] - spur.rail.resource.schematic.kid - == - :: - [[%leaf "{<(en-beam beam)>}"] message] - :: - ++ make-plan - |= [path-to-render=rail query-string=coin =scaffold] - ^- build-receipt - :: TODO: support query-string - :: TODO: support indirect hoons - :: - :: blocks: accumulator for blocked sub-builds - :: - =| blocks=(list ^build) - :: error-message: accumulator for failed sub-builds - :: - =| error-message=tang - :: - |^ :: imports: structure and library +cables, with %sur/%lib prefixes - :: - =/ imports=(list [prefix=?(%sur %lib) =cable]) - %+ welp - (turn structures.scaffold |=(cable [%sur +<])) - (turn libraries.scaffold |=(cable [%lib +<])) - :: path-builds: %path sub-builds to resolve import paths - :: - =/ path-builds (gather-path-builds imports) - :: - =^ path-results ..$ (resolve-builds path-builds) - ?^ blocks - [build [%blocks blocks ~] accessed-builds] - :: - ?^ error-message - (return-error error-message) - :: tmi; remove type specializations - :: - => .(blocks *(list ^build), error-message *tang) - :: core-builds: %core sub-builds to produce library vases - :: - =/ core-builds (gather-core-builds path-results) - :: - =^ core-results ..$ (resolve-builds core-builds) - ?^ blocks - [build [%blocks blocks ~] accessed-builds] - :: - ?^ error-message - (return-error error-message) - :: reef-build: %reef build to produce standard library - :: - =/ reef-build=^build [date.build [%reef disc.path-to-render]] - :: - =^ reef-result accessed-builds (depend-on reef-build) - ?~ reef-result - [build [%blocks [reef-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %reef *] reef-result) - (wrap-error reef-result) - :: subject: tuple of imports and standard library - :: - =/ subject=vase - (link-imports imports vase.u.reef-result core-results) - :: tmi; remove type specializations - :: - => .(blocks *(list ^build), error-message *tang) - :: iterate over each crane - :: - =^ crane-result ..$ - (compose-cranes [%noun subject] cranes.scaffold) - ?: ?=(%error -.crane-result) - (return-error message.crane-result) - ?: ?=(%block -.crane-result) - [build [%blocks builds.crane-result ~] accessed-builds] - :: combined-hoon: source hoons condensed into a single +hoon - :: - =/ combined-hoon=hoon (stack-sources sources.scaffold) - :: compile :combined-hoon against :subject - :: - =/ compile=^build - [date.build [%ride combined-hoon [%$ subject.crane-result]]] - :: - =^ compiled accessed-builds (depend-on compile) - :: compilation blocked; produce block on sub-build - :: - ?~ compiled - [build [%blocks ~[compile] ~] accessed-builds] - :: compilation failed; error out - :: - ?. ?=([~ %success %ride *] compiled) - (wrap-error compiled) - :: compilation succeeded: produce resulting +vase - :: - [build [%build-result %success %plan vase.u.compiled] accessed-builds] - :: +compose-result: the result of a single composition - :: - += compose-result - $% [%subject subject=cage] - [%block builds=(list ^build)] - [%error message=tang] - == - :: +compose-cranes: runs each crane and composes the results - :: - :: For each crane in :cranes, runs it and composes its result into a - :: new subject, which is returned if there are no errors or blocks. - :: - ++ compose-cranes - |= [subject=cage cranes=(list crane)] - ^- $: compose-result - _..compose-cranes - == - :: - ?~ cranes - [[%subject subject] ..compose-cranes] - :: - =^ result ..compose-cranes (run-crane subject i.cranes) - ?+ -.result [result ..compose-cranes] - :: - %subject - $(cranes t.cranes, subject [%noun (slop q.subject.result q.subject)]) - == - :: +run-crane: runs an individual :crane against :subject - :: - ++ run-crane - |= [subject=cage =crane] - ^- compose-cranes - :: - |^ ?- -.crane - %fssg (run-fssg +.crane) - %fsbc (run-fsbc +.crane) - %fsbr (run-fsbr +.crane) - %fsts (run-fsts +.crane) - %fscm (run-fscm +.crane) - %fspm (run-fspm +.crane) - %fscb (run-fscb +.crane) - %fsdt (run-fsdt +.crane) - %fssm (run-fssm +.crane) - %fscl (run-fscl +.crane) - %fskt (run-fskt +.crane) - %fszp (run-fszp +.crane) - %fszy (run-fszy +.crane) - == - :: +run-fssg: runs the `/~` rune - :: - ++ run-fssg - |= =hoon - ^- compose-cranes - :: - =/ ride-build=^build - [date.build [%ride hoon [%$ subject]]] - =^ ride-result accessed-builds (depend-on ride-build) - ?~ ride-result - [[%block [ride-build]~] ..run-crane] - ?: ?=([~ %error *] ride-result) - [[%error [leaf+"/~ failed: " message.u.ride-result]] ..run-crane] - ?> ?=([~ %success %ride *] ride-result) - [[%subject %noun vase.u.ride-result] ..run-crane] - :: +run-fsbc: runes the `/$` rune - :: - ++ run-fsbc - |= =hoon - ^- compose-cranes - :: - =/ query-compile-build=^build - [date.build [%ride ((jock |) query-string) [%$ %noun !>(~)]]] - =^ query-compile-result accessed-builds (depend-on query-compile-build) - ?~ query-compile-result - [[%block [query-compile-build]~] ..run-crane] - ?: ?=([~ %error *] query-compile-result) - [[%error [leaf+"/; failed: " message.u.query-compile-result]] ..run-crane] - ?> ?=([~ %success %ride *] query-compile-result) - :: TODO: if we had a slop build type, everything could be crammed - :: into one sub-build. - :: - =/ =beam - =, path-to-render - [[ship.disc desk.disc [%da date.build]] spur] - =+ arguments=(slop !>(beam) vase.u.query-compile-result) - :: - =/ call-build=^build - [date.build [%call [%ride hoon [%$ subject]] [%$ %noun arguments]]] - =^ call-result accessed-builds (depend-on call-build) - ?~ call-result - [[%block [call-build]~] ..run-crane] - ?: ?=([~ %error *] call-result) - [[%error [leaf+"/; failed: " message.u.call-result]] ..run-crane] - ?> ?=([~ %success %call *] call-result) - :: - [[%subject %noun vase.u.call-result] ..run-crane] - :: +run-fsbr: runes the `/|` rune - :: - ++ run-fsbr - |= choices=(list ^crane) - ^- compose-cranes - :: - ?~ choices - [[%error [leaf+"/| failed: out of options"]~] ..run-crane] - :: - =^ child ..run-crane (run-crane subject i.choices) - ?. ?=([%error *] child) - [child ..run-crane] - $(choices t.choices) - :: +run-fsts: runs the `/=` rune - :: - ++ run-fsts - |= [face=term sub-crane=^crane] - ^- compose-cranes - :: - =^ child ..run-crane (run-crane subject sub-crane) - ?. ?=([%subject *] child) - [child ..run-crane] - :_ ..run-crane - :* %subject - p.subject.child - [[%face [~ face] p.q.subject.child] q.q.subject.child] - == - :: +run-fscm: runs the `/,` rune - :: - ++ run-fscm - |= cases=(list [=spur crane=^crane]) - ^- compose-cranes - :: - ?~ cases - [[%error [leaf+"/, failed: no match"]~] ..run-crane] - :: - ?. .= spur.i.cases - (scag (lent spur.i.cases) (flop spur.path-to-render)) - $(cases t.cases) - :: - (run-crane subject crane.i.cases) - :: +run-fspm: runs the `/&` rune - :: - ++ run-fspm - |= [marks=(list mark) sub-crane=^crane] - ^- compose-cranes - :: - =^ child ..run-crane (run-crane subject sub-crane) - ?. ?=([%subject *] child) - [child ..run-crane] - :: - =/ cast-build=^build - :- date.build - |- - ^- schematic - ?~ marks - :: TODO: If we were keeping track of the mark across runes, this - :: wouldn't have %noun here. This is case where it might matter. - :: - [%$ subject.child] - [%cast disc.source-rail.scaffold i.marks $(marks t.marks)] - =^ cast-result accessed-builds (depend-on cast-build) - ?~ cast-result - [[%block [cast-build]~] ..run-crane] - :: - ?: ?=([~ %error *] cast-result) - [[%error [leaf+"/& failed: " message.u.cast-result]] ..run-crane] - ?> ?=([~ %success %cast *] cast-result) - :: - [[%subject cage.u.cast-result] ..run-crane] - :: +run-fscb: runs the `/_` rune - :: - ++ run-fscb - |= sub-crane=^crane - ^- compose-cranes - :: perform a scry to get the contents of +path-to-render - :: - =/ toplevel-build=^build - [date.build [%scry [%c %y path-to-render]]] - :: - =^ toplevel-result accessed-builds (depend-on toplevel-build) - ?~ toplevel-result - [[%block ~[toplevel-build]] ..run-crane] - :: - ?: ?=([~ %error *] toplevel-result) - [[%error [leaf+"/_ failed: " message.u.toplevel-result]] ..run-crane] - ?> ?=([~ %success %scry *] toplevel-result) - :: - =/ toplevel-arch=arch ;;(arch q.q.cage.u.toplevel-result) - :: sub-path: each possible sub-directory to check - :: - =/ sub-paths=(list @ta) - (turn ~(tap by dir.toplevel-arch) head) - :: for each directory in :toplevel-arch, issue a sub-build - :: - =/ sub-builds=(list ^build) - %+ turn sub-paths - |= sub=@ta - ^- ^build - [date.build [%scry [%c %y path-to-render(spur [sub spur.path-to-render])]]] - :: results: accumulator for results of sub-builds - :: - =| results=(list [kid=^build sub-path=@ta results=(unit build-result)]) - :: resolve all the :sub-builds - :: - :: TODO: It feels like this running sub build and filtering - :: results could be generalized. - :: - =/ subs-results - |- ^+ [results accessed-builds] - ?~ sub-builds [results accessed-builds] - ?> ?=(^ sub-paths) - :: - =/ kid=^build i.sub-builds - =/ sub-path=@ta i.sub-paths - :: - =^ result accessed-builds (depend-on kid) - =. results [[kid sub-path result] results] - :: - $(sub-builds t.sub-builds, sub-paths t.sub-paths) - :: apply mutations from depending on sub-builds - :: - =: results -.subs-results - accessed-builds +.subs-results - == - :: split :results into completed :mades and incomplete :blocks - :: - =+ split-results=(skid results |=([* * r=(unit build-result)] ?=(^ r))) - :: - =/ mades=_results -.split-results - =/ blocks=_results +.split-results - :: if any builds blocked, produce them all in %blocks - :: - ?^ blocks - [[%block (turn `_results`blocks head)] ..run-crane] - :: find the first error and return it if exists - :: - =/ errors=_results - %+ skim results - |= [* * r=(unit build-result)] - ?=([~ %error *] r) - ?^ errors - ?> ?=([~ %error *] results.i.errors) - [[%error message.u.results.i.errors] ..run-crane] - :: get a list of valid sub-paths - :: - :: :results is now a list of the :build-result of %cy on each path - :: in :toplevel-arch. What we want is to now filter this list so - :: that we filter files out. - :: - =/ sub-paths=(list [=rail sub-path=@ta]) - %+ murn results - |= [build=^build sub-path=@ta result=(unit build-result)] - ^- (unit [rail @ta]) - :: - ?> ?=([@da %scry %c %y *] build) - ?> ?=([~ %success %scry *] result) - =/ =arch ;;(arch q.q.cage.u.result) - :: - ?~ dir.arch - ~ - `[rail.resource.schematic.build sub-path] - :: keep track of the original value so we can reset it - :: - =/ old-path-to-render path-to-render - :: apply each of the filtered :sub-paths to the :sub-crane. - :: - =^ crane-results ..run-crane - %+ roll sub-paths - |= $: [=rail sub-path=@ta] - accumulator=[(list [sub-path=@ta =compose-result]) _..run-crane] - == - =. ..run-crane +.accumulator - =. path-to-render rail - =^ result ..run-crane (run-crane subject sub-crane) - [[[sub-path result] -.accumulator] ..run-crane] - :: set :path-to-render back - :: - =. path-to-render old-path-to-render - :: if any sub-cranes error, return the first error - :: - =/ error-list=(list [@ta =compose-result]) - %+ skim crane-results - |= [@ta =compose-result] - =(%error -.compose-result) - :: - ?^ error-list - [compose-result.i.error-list ..run-crane] - :: if any sub-cranes block, return all blocks - :: - =/ block-list=(list ^build) - =| block-list=(list ^build) - |- - ^+ block-list - ?~ crane-results - block-list - ?. ?=(%block -.compose-result.i.crane-results) - $(crane-results t.crane-results) - =. block-list - (weld builds.compose-result.i.crane-results block-list) - $(crane-results t.crane-results) - :: - ?^ block-list - [[%block block-list] ..run-crane] - :: put the data in map order - :: - =/ result-map=(map @ta vase) - %- my - %+ turn crane-results - |= [path=@ta =compose-result] - ^- (pair @ta vase) - :: - ?> ?=([%subject *] compose-result) - [path q.subject.compose-result] - :: convert the map into a flat format for return - :: - :: This step flattens the values out of the map for return. Let's - :: say we're doing a /_ over a directory of files that just have a - :: single @ud in them. We want the return value of /_ to have the - :: nest in (map @ta @ud) instead of returning a (map @ta vase). - :: - =/ as-vase=vase - |- - ^- vase - :: - ?~ result-map - [[%atom %n `0] 0] - :: - %+ slop - (slop [[%atom %ta ~] p.n.result-map] q.n.result-map) - (slop $(result-map l.result-map) $(result-map r.result-map)) - :: - [[%subject %noun as-vase] ..run-crane] - :: +run-fsdt: runs the `/.` rune - :: - ++ run-fsdt - |= sub-cranes=(list ^crane) - ^- compose-cranes - :: - =^ list-results ..run-crane - %+ roll sub-cranes - |= $: sub-crane=^crane - accumulator=[(list compose-result) _..run-crane] - == - =. ..run-crane +.accumulator - =^ result ..run-crane (run-crane subject sub-crane) - [[result -.accumulator] ..run-crane] - :: if any sub-cranes error, return the first error - :: - =/ error-list=(list compose-result) - %+ skim list-results - |= =compose-result - =(%error -.compose-result) - :: - ?^ error-list - [i.error-list ..run-crane] - :: if any sub-cranes block, return all blocks - :: - =/ block-list=(list ^build) - =| block-list=(list ^build) - |- - ^+ block-list - ?~ list-results - block-list - ?. ?=(%block -.i.list-results) - $(list-results t.list-results) - =. block-list (weld builds.i.list-results block-list) - $(list-results t.list-results) - :: - ?^ block-list - [[%block block-list] ..run-crane] - :: concatenate all the results together with null termination - :: - =. list-results (flop list-results) - :: - =/ final-result=vase - |- - ^- vase - ?~ list-results - [[%atom %n `~] 0] - ?> ?=(%subject -.i.list-results) - (slop q.subject.i.list-results $(list-results t.list-results)) - :: - [[%subject %noun final-result] ..run-crane] - :: +run-fssm: runs the `/;` rune - :: - ++ run-fssm - |= [=hoon sub-crane=^crane] - ^- compose-cranes - :: - =^ child ..run-crane (run-crane subject sub-crane) - ?. ?=([%subject *] child) - [child ..run-crane] - :: - =/ call-build=^build - [date.build [%call [%ride hoon [%$ subject]] [%$ subject.child]]] - =^ call-result accessed-builds (depend-on call-build) - ?~ call-result - [[%block [call-build]~] ..run-crane] - ?: ?=([~ %error *] call-result) - [[%error [leaf+"/; failed: " message.u.call-result]] ..run-crane] - ?> ?=([~ %success %call *] call-result) - :: - [[%subject %noun vase.u.call-result] ..run-crane] - :: +run-fscl: runs the `/:` rune - :: - ++ run-fscl - |= [=truss sub-crane=^crane] - ^- compose-cranes - :: - =/ =beam - =, source-rail.scaffold - [[ship.disc desk.disc [%ud 0]] spur] - =/ hoon-parser (vang & (en-beam beam)) - :: - =+ tuz=(posh:hoon-parser truss) - ?~ tuz - [[%error [leaf+"/: failed: bad tusk: {}"]~] ..run-crane] - =+ pax=(plex:hoon-parser %clsg u.tuz) - ?~ pax - [[%error [leaf+"/: failed: bad path: {}"]~] ..run-crane] - =+ bem=(de-beam u.pax) - ?~ bem - [[%error [leaf+"/: failed: bad beam: {}"]~] ..run-crane] - :: - =. path-to-render [[p q] s]:u.bem - (run-crane subject sub-crane) - :: +run-fskt: runs the `/^` rune - :: - ++ run-fskt - |= [mold=hoon sub-crane=^crane] - ^- compose-cranes - :: - =^ child ..run-crane (run-crane subject sub-crane) - ?. ?=([%subject *] child) - [child ..run-crane] - :: - =/ bunt-build=^build - [date.build [%ride [%bunt mold] [%$ subject]]] - =^ bunt-result accessed-builds (depend-on bunt-build) - ?~ bunt-result - [[%block [bunt-build]~] ..run-crane] - ?: ?=([~ %error *] bunt-result) - [[%error [leaf+"/^ failed: " message.u.bunt-result]] ..run-crane] - ?> ?=([~ %success %ride *] bunt-result) - :: - ?. (~(nest ut p.vase.u.bunt-result) | p.q.subject.child) - [[%error [leaf+"/^ failed: nest-fail"]~] ..run-crane] - [[%subject %noun [p.vase.u.bunt-result q.q.subject.child]] ..run-crane] - :: +run-fszp: runs the `/!mark/` "rune" - :: - ++ run-fszp - |= =mark - ^- compose-cranes - :: - =/ hoon-path=rail - =, path-to-render - [disc [%hoon spur]] - :: - =/ hood-build=^build [date.build [%hood hoon-path]] - =^ hood-result accessed-builds (depend-on hood-build) - ?~ hood-result - [[%block [hood-build]~] ..run-crane] - ?: ?=([~ %error *] hood-result) - [[%error [leaf+"/! failed: " message.u.hood-result]] ..run-crane] - ?> ?=([~ %success %hood *] hood-result) - :: - =/ plan-build=^build - :- date.build - [%plan path-to-render query-string scaffold.u.hood-result] - =^ plan-result accessed-builds (depend-on plan-build) - ?~ plan-result - [[%block [plan-build]~] ..run-crane] - ?: ?=([~ %error *] plan-result) - [[%error [leaf+"/! failed: " message.u.plan-result]] ..run-crane] - ?> ?=([~ %success %plan *] plan-result) - :: if :mark is %noun, don't perform mark translation; just return - :: - :: If we were to verify the product type with %noun, this would - :: cast to *, which would overwrite :vase.u.plan-result's actual - :: product type - :: - ?: =(%noun mark) - [[%subject %noun vase.u.plan-result] ..run-crane] - :: - =/ vale-build=^build - :- date.build - [%vale disc.source-rail.scaffold mark q.vase.u.plan-result] - =^ vale-result accessed-builds (depend-on vale-build) - ?~ vale-result - [[%block [vale-build]~] ..run-crane] - ?: ?=([~ %error *] vale-result) - [[%error [leaf+"/! failed: " message.u.vale-result]] ..run-crane] - ?> ?=([~ %success %vale *] vale-result) - :: - [[%subject cage.u.vale-result] ..run-crane] - :: +run-fszy: runs the `/mark/` "rune" - :: - ++ run-fszy - |= =mark - ^- compose-cranes - :: - =/ bake-build=^build - :- date.build - [%bake mark query-string path-to-render] - =^ bake-result accessed-builds (depend-on bake-build) - ?~ bake-result - [[%block [bake-build]~] ..run-crane] - ?: ?=([~ %error *] bake-result) - [[%error [leaf+"/mark/ failed: " message.u.bake-result]] ..run-crane] - ?> ?=([~ %success %bake *] bake-result) - :: - [[%subject cage.u.bake-result] ..run-crane] - -- - :: +gather-path-builds: produce %path builds to resolve import paths - :: - ++ gather-path-builds - |= imports=(list [prefix=?(%sur %lib) =cable]) - ^- (list ^build) - :: - %+ turn imports - |= [prefix=?(%sur %lib) =cable] - ^- ^build - [date.build [%path disc.source-rail.scaffold prefix file-path.cable]] - :: +resolve-builds: run a list of builds and collect results - :: - :: If a build blocks, put its +tang in :error-message and stop. - :: All builds that block get put in :blocks. Results of - :: successful builds are produced in :results. - :: - ++ resolve-builds - =| results=(list build-result) - |= builds=(list ^build) - ^+ [results ..^$] - :: - ?~ builds - [results ..^$] - :: - =^ result accessed-builds (depend-on i.builds) - ?~ result - =. blocks [i.builds blocks] - $(builds t.builds) - :: - ?. ?=(%success -.u.result) - =. error-message [[%leaf "%plan failed: "] message.u.result] - [results ..^$] - :: - =. results [u.result results] - $(builds t.builds) - :: +gather-core-builds: produce %core builds from resolved paths - :: - ++ gather-core-builds - |= path-results=(list build-result) - ^- (list ^build) - %+ turn path-results - |= result=build-result - ^- ^build - :: - ?> ?=([%success %path *] result) - :: - [date.build [%core rail.result]] - :: +link-imports: link libraries and structures with standard library - :: - :: Prepends each library vase onto the standard library vase. - :: Wraps a face around each library to prevent namespace leakage - :: unless imported as *lib-name. - :: - ++ link-imports - |= $: imports=(list [?(%lib %sur) =cable]) - reef=vase - core-results=(list build-result) - == - ^- vase - :: - =/ subject=vase reef - :: - =/ core-vases=(list vase) - %+ turn core-results - |= result=build-result - ^- vase - ?> ?=([%success %core *] result) - vase.result - :: link structures and libraries into a subject for compilation - :: - |- ^+ subject - ?~ core-vases subject - ?< ?=(~ imports) - :: cons this vase onto the head of the subject - :: - =. subject - %- slop :_ subject - :: check if the programmer named the library - :: - ?~ face.cable.i.imports - :: no face assigned to this library, so use vase as-is - :: - i.core-vases - :: use the library name as a face to prevent namespace leakage - :: - ^- vase - [[%face face.cable.i.imports p.i.core-vases] q.i.core-vases] - :: - $(core-vases t.core-vases, imports t.imports) - :: +stack-sources: combine bricks into one +hoon: =~(hoon1 hoon2 ...) - :: - ++ stack-sources - |= sources=(list brick) - ^- hoon - :: - =- [%tssg -] - %+ turn sources - |= =brick - ^- hoon - :: - ?> ?=(%direct -.brick) - source.brick - -- - :: - ++ make-reef - |= =disc - ^- build-receipt - :: short-circuit to :pit if asked for current %home desk - :: - :: This avoids needing to recompile the kernel if we're asked - :: for the kernel we're already running. Note that this fails - :: referential transparency if |autoload is turned off. - :: - ?: ?& =(disc [our %home]) - :: is :date.build the latest commit on the %home desk? - :: - ?| =(now date.build) - :: - =/ =beam [[our %home [%da date.build]] /hoon/hoon/sys] - :: - .= (scry [%143 %noun] ~ %cw beam) - (scry [%143 %noun] ~ %cw beam(r [%da now])) - == == - :: - [build [%build-result %success %reef pit] accessed-builds] - :: - =/ hoon-scry - [date.build [%scry %c %x [disc /hoon/hoon/sys]]] - :: - =^ hoon-scry-result accessed-builds (depend-on hoon-scry) - :: - =/ arvo-scry - [date.build [%scry %c %x [disc /hoon/arvo/sys]]] - :: - =^ arvo-scry-result accessed-builds (depend-on arvo-scry) - :: - =/ zuse-scry - [date.build [%scry %c %x [disc /hoon/zuse/sys]]] - :: - =^ zuse-scry-result accessed-builds (depend-on zuse-scry) - :: - =| blocks=(list ^build) - =? blocks ?=(~ hoon-scry-result) [hoon-scry blocks] - =? blocks ?=(~ arvo-scry-result) [arvo-scry blocks] - =? blocks ?=(~ zuse-scry-result) [zuse-scry blocks] - :: - ?^ blocks - [build [%blocks blocks ~] accessed-builds] - :: - ?. ?=([~ %success %scry *] hoon-scry-result) - (wrap-error hoon-scry-result) - :: - ?. ?=([~ %success %scry *] arvo-scry-result) - (wrap-error arvo-scry-result) - :: - ?. ?=([~ %success %scry *] zuse-scry-result) - (wrap-error zuse-scry-result) - :: omit case from path to prevent cache misses - :: - =/ hoon-path=path - /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/hoon/sys - =/ hoon-hoon=hoon (rain hoon-path ;;(@t q.q.cage.u.hoon-scry-result)) - :: - =/ arvo-path=path - /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/arvo/sys - =/ arvo-hoon=hoon (rain arvo-path ;;(@t q.q.cage.u.arvo-scry-result)) - :: - =/ zuse-path=path - /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/zuse/sys - =/ zuse-hoon=hoon (rain zuse-path ;;(@t q.q.cage.u.zuse-scry-result)) - :: - =/ zuse-build=^build - :* date.build - %ride zuse-hoon - %ride arvo-hoon - %ride hoon-hoon - [%$ %noun !>(~)] - == - :: - =^ zuse-build-result accessed-builds (depend-on zuse-build) - ?~ zuse-build-result - [build [%blocks [zuse-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] zuse-build-result) - (wrap-error zuse-build-result) - :: - :+ build - [%build-result %success %reef vase.u.zuse-build-result] - accessed-builds - :: - ++ make-ride - |= [formula=hoon =schematic] - ^- build-receipt - :: - =^ result accessed-builds (depend-on [date.build schematic]) - ?~ result - [build [%blocks [date.build schematic]~ ~] accessed-builds] - :: - =* subject u.result - =* subject-cage (result-to-cage subject) - =/ slim-schematic=^schematic [%slim p.q.subject-cage formula] - =^ slim-result accessed-builds (depend-on [date.build slim-schematic]) - ?~ slim-result - [build [%blocks [date.build slim-schematic]~ ~] accessed-builds] - :: - ?. ?=([~ %success %slim *] slim-result) - (wrap-error slim-result) - :: - =/ val - (mock [q.q.subject-cage nock.u.slim-result] intercepted-scry) - :: val is a toon, which might be a list of blocks. - :: - ?- -.val - :: - %0 - :* build - [%build-result %success %ride [type.u.slim-result p.val]] - accessed-builds - == - :: - %1 - =/ blocked-paths=(list path) ((hard (list path)) p.val) - (blocked-paths-to-receipt %ride blocked-paths) - :: - %2 - (return-error [[%leaf "ford: %ride failed:"] p.val]) - == - :: - ++ make-same - |= =schematic - ^- build-receipt - :: - =^ result accessed-builds (depend-on [date.build schematic]) - :: - ?~ result - [build [%blocks [date.build schematic]~ ~] accessed-builds] - [build [%build-result %success %same u.result] accessed-builds] - :: - ++ make-scry - :: TODO: All accesses to :state which matter happens in this function; - :: those calculations need to be lifted out of +make into +execute. - :: - |= =resource - ^- build-receipt - :: construct a full +beam to make the scry request - :: - =/ =beam (extract-beam resource `date.build) - :: - =/ =scry-request [vane.resource care.resource beam] - :: perform scry operation if we don't already know the result - :: - :: Look up :scry-request in :scry-results.per-event to avoid - :: rerunning a previously blocked +scry. - :: - =/ scry-response - ?: (~(has by scry-results) scry-request) - (~(get by scry-results) scry-request) - (scry [%143 %noun] ~ `@tas`(cat 3 [vane care]:resource) beam) - :: scry blocked - :: - ?~ scry-response - :: :build blocked on :scry-request - :: - :: Enqueue a request +move to fetch the blocked resource. - :: Link :block and :build in :blocks.state so we know - :: which build to rerun in a later event when we +unblock - :: on that +resource. - :: - =/ already-blocked=? (~(has by blocks.state) scry-request) - :: store :scry-request in persistent state - :: - =. blocks.state (~(put ju blocks.state) scry-request build) - :: - ?: already-blocked - :: this resource was already blocked, so don't duplicate move - :: - [build [%blocks ~ ~] accessed-builds] - :: - [build [%blocks ~ `scry-request] accessed-builds] - :: scry failed - :: - ?~ u.scry-response - %- return-error - :~ leaf+"scry failed for" - leaf+"%c{(trip care.resource)} {<(en-beam beam)>}" - == - :: scry succeeded - :: - [build [%build-result %success %scry u.u.scry-response] accessed-builds] - :: - ++ make-slim - |= [subject-type=type formula=hoon] - ^- build-receipt - :: - =/ compiled=(each (pair type nock) tang) - (mule |.((~(mint ut subject-type) [%noun formula]))) - :: - :* build - ?- -.compiled - %| [%build-result %error [leaf+"%slim failed: " p.compiled]] - %& [%build-result %success %slim p.compiled] - == - accessed-builds - == - :: - ++ make-slit - |= [gate=vase sample=vase] - ^- build-receipt - :: - =/ product=(each type tang) - (mule |.((slit p.gate p.sample))) - :: - :* build - ?- -.product - %| :* %build-result %error - :* (~(dunk ut p.sample) %have) - (~(dunk ut (~(peek ut p.gate) %free 6)) %want) - leaf+"%slit failed: " - p.product - == - == - %& [%build-result %success %slit p.product] - == - accessed-builds - == - :: - ++ make-volt - |= [=disc mark=term input=*] - ^- build-receipt - :: - =/ bunt-build=^build [date.build [%bunt disc mark]] - :: - =^ bunt-result accessed-builds (depend-on bunt-build) - ?~ bunt-result - [build [%blocks [bunt-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %bunt *] bunt-result) - (wrap-error bunt-result) - :: - =/ =build-result - [%success %volt [mark p.q.cage.u.bunt-result input]] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-vale - :: TODO: better docs - :: - |= [=disc mark=term input=*] - ^- build-receipt - :: don't validate for the %noun mark - :: - ?: =(%noun mark) - =/ =build-result [%success %vale [%noun %noun input]] - :: - [build [%build-result build-result] accessed-builds] - :: - =/ path-build [date.build [%path disc %mar mark]] - :: - =^ path-result accessed-builds (depend-on path-build) - ?~ path-result - [build [%blocks [path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] path-result) - (wrap-error path-result) - :: - =/ bunt-build=^build [date.build [%bunt disc mark]] - :: - =^ bunt-result accessed-builds (depend-on bunt-build) - ?~ bunt-result - [build [%blocks [bunt-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %bunt *] bunt-result) - (wrap-error bunt-result) - :: - =/ mark-sample=vase q.cage.u.bunt-result - :: - =/ call-build=^build - :^ date.build - %call - ^= gate - :* %ride - :: (ream 'noun:grab') - formula=`hoon`[%tsgl [%wing ~[%noun]] [%wing ~[%grab]]] - subject=`schematic`[%core rail.u.path-result] - == - sample=[%$ %noun %noun input] - :: - =^ call-result accessed-builds (depend-on call-build) - ?~ call-result - [build [%blocks [call-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] call-result) - (wrap-error call-result) - :: - =/ product=vase vase.u.call-result - :: TODO: why do we check nesting here? - :: - ?> (~(nest ut p.mark-sample) | p.product) - :: check mold idempotence; if different, nest fail - :: - ?: =(q.product input) - =/ =build-result - [%success %vale [mark p.mark-sample q.product]] - :: - [build [%build-result build-result] accessed-builds] - :: - %- return-error - =/ =beam [[ship.disc desk.disc %da date.build] spur.rail.u.path-result] - [leaf+"ford: %vale failed: invalid input for mark: {<(en-beam beam)>}"]~ - :: |utilities:make: helper arms - :: - ::+| utilities - :: +wrap-error: wrap an error message around a failed sub-build - :: - ++ wrap-error - |= result=(unit build-result) - ^- build-receipt - :: - ?> ?=([~ %error *] result) - =/ message=tang - [[%leaf "ford: {<-.schematic.build>} failed: "] message.u.result] - :: - [build [%build-result %error message] accessed-builds] - :: +return-error: returns a specific failure message - :: - ++ return-error - |= =tang - ^- build-receipt - [build [%build-result %error tang] accessed-builds] - :: - ++ depend-on - |= kid=^build - ^- [(unit build-result) _accessed-builds] - :: - =. accessed-builds [kid accessed-builds] - :: +access-cache will mutate :results.state - :: - :: It's okay to ignore this because the accessed-builds get gathered - :: and merged during the +reduce step. - :: - =/ maybe-cache-line -:(access-cache kid) - ?~ maybe-cache-line - [~ accessed-builds] - :: - =* cache-line u.maybe-cache-line - ?: ?=(%tombstone -.cache-line) - [~ accessed-builds] - :: - [`build-result.cache-line accessed-builds] - :: +blocked-paths-to-receipt: handle the %2 case for mock - :: - :: Multiple schematics handle +toon instances. This handles the %2 case - :: for a +toon and transforms it into a +build-receipt so we depend on - :: the blocked paths correctly. - :: - ++ blocked-paths-to-receipt - |= [name=term blocked-paths=(list path)] - ^- build-receipt - :: - =/ blocks-or-failures=(list (each ^build tank)) - %+ turn blocked-paths - |= =path - :: - =/ scry-request=(unit scry-request) (path-to-scry-request path) - ?~ scry-request - [%| [%leaf "ford: {}: invalid scry path: {}"]] - :: - =* case r.beam.u.scry-request - :: - ?. ?=(%da -.case) - [%| [%leaf "ford: {}: invalid case in scry path: {}"]] - :: - =/ date=@da p.case - :: - =/ resource=(unit resource) (path-to-resource path) - ?~ resource - :- %| - [%leaf "ford: {}: invalid resource in scry path: {}"] - :: - =/ sub-schematic=^schematic [%pin date %scry u.resource] - :: - [%& `^build`[date sub-schematic]] - :: - =/ failed=tang - %+ murn blocks-or-failures - |= block=(each ^build tank) - ^- (unit tank) - ?- -.block - %& ~ - %| `p.block - == - :: - ?^ failed - :: some failed - :: - [build [%build-result %error failed] accessed-builds] - :: no failures - :: - =/ blocks=(list ^build) - %+ turn blocks-or-failures - |= block=(each ^build tank) - ?> ?=(%& -.block) - :: - p.block - :: - =. accessed-builds - %+ roll blocks - |= [block=^build accumulator=_accessed-builds] - =. accessed-builds accumulator - +:(depend-on [date.block schematic.block]) - :: - :: TODO: Here we are passing a single ~ for :scry-blocked. Should we - :: be passing one or multiple resource back instead? Maybe not? Are - :: we building blocking schematics, which they themselves will scry? - :: - [build [%blocks blocks ~] accessed-builds] - -- - :: |utilities:per-event: helper arms - :: - ::+| utilities - :: - ++ this . - :: +intercepted-scry: use local results as a scry facade - :: - ++ intercepted-scry - %- sloy ^- slyd - |= [ref=* (unit (set monk)) =term =beam] - ^- (unit (unit (cask))) - ?> ?=([@ *] ref) - =/ hoon-version=@ud -.ref - =/ =type ((hard type) +.ref) - :: - ~| hoon-version=hoon-version - ?> ?=(?(%143 %151) hoon-version) - :: - =/ vane=(unit ?(%c %g)) ((soft ?(%c %g)) (end 3 1 term)) - ?~ vane - ~ - =/ care=(unit care:clay) ((soft care:clay) (rsh 3 1 term)) - ?~ care - ~ - :: - =/ =resource - [u.vane u.care rail=[[p.beam q.beam] s.beam]] - :: TODO: handle other kinds of +case - :: - =/ date=@da - ~| bad-case+r.beam - ?> ?=(%da -.r.beam) - p.r.beam - :: - =/ =build [date %scry resource] - :: if the actual scry produces a value, use that value; otherwise use local - :: - =/ scry-response (scry +<.$) - :: - ?^ scry-response - scry-response - :: look up the scry result from our permanent state - :: - :: Note: we can't freshen this cache entry because we can't modify - :: the state in this gate. - :: - =/ local-result (~(get by results.state) build) - ?~ local-result - ~ - ?: ?=(%tombstone -.u.local-result) - ~ - :: - =/ local-cage=cage (result-to-cage build-result.u.local-result) - :: if :local-result does not nest in :type, produce an error - :: - ?. -:(nets:wa type `^type`p.q.local-cage) - [~ ~] - :: - [~ ~ `(cask)`local-cage] - :: +mark-as-done: store :build as complete and produce any unblocked clients - :: - :: We may not know about these unblocked clients, so we register them in - :: the state. - :: - ++ mark-as-done - |= =build - ^- [(list ^build) _state] - :: - =/ client-builds=(list ^build) - (~(get-clients by-build-dag blocked-builds.state) build) - :: - =. blocked-builds.state - %+ roll client-builds - :: - |= [client=^build blocked-builds=_blocked-builds.state] - :: - (~(del by-build-dag blocked-builds) client build) - :: - :_ state - :: - %+ roll client-builds - :: - |= [client=^build next-builds=(list ^build)] - :: - ?: (is-build-blocked client) - next-builds - [client next-builds] - :: +send-mades: send one %made move for :build per listener in :listeners - :: - ++ send-mades - |= [=build listeners=(list listener)] ^+ this - :: - =^ result results.state (access-cache build) - :: - ?> ?=([~ %value *] result) - :: - %_ this - moves - %+ roll listeners - |= [=listener moves=_moves] - :: - :_ moves - :* duct.listener %give - %made date.build %complete build-result.u.result - == - == - :: +unlink-sub-builds - :: - ++ unlink-sub-builds - |= =build - ^+ ..execute - :: - =/ kids=(list ^build) - %~ tap in - %- ~(uni in (~(get ju sub-builds.components.state) build)) - (~(get ju sub-builds.provisional-components.state) build) - :: - =. components.state - (~(del-build by-build-dag components.state) build) - :: - =. provisional-components.state - (~(del-build by-build-dag provisional-components.state) build) - :: - %+ roll kids - |= [kid=^build accumulator=_..execute] - :: - =. ..execute accumulator - (cleanup kid) - :: +advance-live-listeners: move live listeners from :old to :new - :: - ++ advance-live-listeners - |= [old=build new=build] - ^+ state - :: - =/ old-live-listeners=(list listener) - =- (skim - is-listener-live) - =- ~(tap in `(set listener)`(fall - ~)) - (~(get by listeners.state) old) - :: - =/ old-root-listeners - ~(tap in (fall (~(get by root-listeners.state) old) ~)) - :: - =. state - %+ roll old-root-listeners - |= [=listener state=_state] - :: - ?. (is-listener-live listener) - state - %_ state - :: - root-listeners - =- (~(put ju -) new listener) - (~(del ju root-listeners.state) old listener) - :: - builds-by-listener - (~(put by builds-by-listener.state) duct.listener [new &]) - == - :: - %+ roll old-live-listeners - |= [=listener accumulator=_state] - =. state accumulator - :: if :listener ain't live, we wrote this wrong - :: - ?> live.listener - :: - =. listeners.state (~(put ju listeners.state) new listener) - :: - (remove-listener-from-build listener old) - :: +root-live-listeners: live listeners for which :build is the root build - :: - ++ root-live-listeners - |= =build - ^- (list listener) - :: - (skim (root-listeners build) is-listener-live) - :: +root-once-listeners: once listeners for which :build is the root build - :: - ++ root-once-listeners - |= =build - ^- (list listener) - :: - (skip (root-listeners build) is-listener-live) - :: +root-listeners: listeners for which :build is the root build - :: - ++ root-listeners - |= =build - ^- (list listener) - :: - =- ~(tap in `(set listener)`(fall - ~)) - (~(get by root-listeners.state) build) - :: +is-build-blocked: is :build blocked on either builds or a resource? - :: - ++ is-build-blocked - |= =build - ^- ? - :: - ?: (~(has by sub-builds.blocked-builds.state) build) - & - ?. ?=(%scry -.schematic.build) - | - (~(has by blocks.state) resource.schematic.build build) - :: +is-build-cached: - :: - ++ is-build-cached - |= =build - ^- ? - ?=([~ %value *] (~(get by results.state) build)) - :: +is-build-live: whether this is a live or a once build - :: - ++ is-build-live - |= =build - ^- ? - :: - ?: ?=(%pin -.schematic.build) - %.n - ?: (has-pinned-client build) - %.n - :: check if :build has any live listeners - :: - =/ listeners ~(tap in (fall (~(get by listeners.state) build) ~)) - ?~ listeners - %.y - (lien `(list listener)`listeners is-listener-live) - :: +has-pinned-client: %.y if any of our ancestors are a %pin - :: - ++ has-pinned-client - |= =build - ^- ? - :: iterate across all clients recursively, exiting early on %pin - :: - =/ clients (~(get-clients by-build-dag components.state) build) - |- - ?~ clients - %.n - ?: ?=(%pin -.schematic.i.clients) - %.y - %_ $ - clients - %+ weld t.clients - (~(get-clients by-build-dag components.state) i.clients) - == - :: +access-cache: access the +cache-line for :build, updating :last-accessed - :: - :: Usage: - :: ``` - :: =^ maybe-cache-line results.state (access-cache build) - :: ``` - :: - ++ access-cache - |= =build - ^- [(unit cache-line) _results.state] - :: - =/ maybe-original=(unit cache-line) (~(get by results.state) build) - ?~ maybe-original - [~ results.state] - :: - =/ original=cache-line u.maybe-original - :: - ?: ?=(%tombstone -.original) - [`original results.state] - :: - =/ mutant=cache-line original(last-accessed now) - :: - [`mutant (~(put by results.state) build mutant)] - :: +finalize: convert per-event state to moves and persistent state - :: - :: Converts :done-live-roots to %made +move's, performs +duct - :: accounting, and runs +cleanup on completed once builds and - :: stale live builds. - :: - ++ finalize - ^- [(list move) ford-state] - :: once we're done, +flop :moves to put them in chronological order - :: - =< [(flop moves) state] - :: - =/ discs ~(tap in dirty-discs) - :: - |- ^+ this - ?~ discs this - :: - =* disc i.discs - :: resources: all resources on :disc - :: - =/ resources=(set resource) - (fall (~(get by resources-by-disc.state) disc) ~) - :: if no resources on :disc, don't make a new clay subscription - :: - ?~ resources - :: cancel clay subscriptions when we don't have any resources left - :: - ?: (~(has in original-clay-subscriptions) disc) - =+ [their desk]=disc - =/ =note - :^ %c %warp sock=[our their] - ^- riff:clay - [desk ~] - :: - =. moves :_ moves - ^- move - [duct=~ [%pass wire=(clay-sub-wire disc) note]] - :: - =. clay-subscriptions.state (~(del in clay-subscriptions.state) disc) - :: - =. latest-by-disc.state (~(del by latest-by-disc.state) disc) - :: - $(discs t.discs) - :: - $(discs t.discs) - :: prevent thrashing; don't unsubscribe then immediately resubscribe - :: - :: When we send a request to a foreign ship, that ship may have - :: started responding before we send a cancellation. In that case, - :: canceling and then resubscribing might cause the foreign ship - :: to send the response twice, which would be extra network traffic. - :: - ?: ?& (~(has in original-clay-subscriptions) disc) - :: - (~(has in clay-subscriptions.state) disc) - :: - .= (~(get by original-resources-by-disc) disc) - (~(get by resources-by-disc.state) disc) - == - :: - $(discs t.discs) - :: request-contents: the set of [care path]s to subscribe to in clay - :: - =/ request-contents=(set [care:clay path]) - %- sy ^- (list [care:clay path]) - %+ murn ~(tap in `(set resource)`resources) - |= =resource ^- (unit [care:clay path]) - :: - ?. ?=(%c -.resource) ~ - :: - `[care.resource (flop spur.rail.resource)] - :: if :request-contents is `~`, this code is incorrect - :: - ?< ?=(~ request-contents) - :: their: requestee +ship - :: - =+ [their desk]=disc - =/ latest-date (~(got by latest-by-disc.state) disc) - :: - =/ =note - :^ %c %warp sock=[our their] - ^- riff:clay - [desk `[%mult case=[%da latest-date] request-contents]] - :: - =. moves :_ moves - ^- move - [duct=~ [%pass wire=(clay-sub-wire disc) note]] - :: - =. clay-subscriptions.state (~(put in clay-subscriptions.state) disc) - :: - $(discs t.discs) - :: +cleanup: try to clean up a build and its sub-builds - :: - ++ cleanup - |= =build - ^+ this - :: does this build even exist?! - :: - ?. (~(has ju by-date.builds.state) date.build schematic.build) - this - :: - :: if something depends on this build, no-op and return - :: - ?: ?| (~(has by client-builds.components.state) build) - (~(has by client-builds.provisional-components.state) build) - (~(has by old.rebuilds.state) build) - (~(has by listeners.state) build) - == - :: ~& :* %cleanup-no-op - :: build=(build-to-tape build) - :: has-client-builds=(~(has by client-builds.components.state) build) - :: has-provisional=(~(has by client-builds.provisional-components.state) build) - :: has-old-rebuilds=(~(has by old.rebuilds.state) build) - :: listeners=(~(get by listeners.state) build) - :: == - this - :: ~& [%cleaning-up (build-to-tape build)] - :: remove :build from :state, starting with its cache line - :: - =. results.state (~(del by results.state) build) - :: remove :build from the list of attempted builds - :: - =. builds.state (~(del by-builds builds.state) build) - :: if no more builds at this date, remove the date from :resource-updates - :: - =? resource-updates.state - !(~(has by by-date.builds.state) date.build) - (~(del by resource-updates.state) date.build) - :: - =? blocks.state - :: - ?=(%scry -.schematic.build) - :: - =/ =scry-request - =, resource.schematic.build - [vane care `beam`[[ship.disc.rail desk.disc.rail [%da date.build]] spur.rail]] - :: - (~(del ju blocks.state) scry-request build) - :: check if :build depends on a live clay +resource - :: - =/ has-live-resource ?=([%scry %c *] schematic.build) - :: clean up dependency tracking and maybe cancel clay subscription - :: - =? this has-live-resource - :: type system didn't know, so tell it again - :: - ?> ?=([%scry %c *] schematic.build) - :: - =/ =resource resource.schematic.build - =/ =disc (extract-disc resource) - :: - =/ should-delete-resource=? - :: checks if there are other live builds of this resource - :: - =/ dates=(list @da) - (fall (~(get by by-schematic.builds.state) schematic.build) ~) - ?! - %+ lien dates - |= date=@da - ^- ? - =/ other-build [date schematic.build] - =/ listeners=(set listener) - (fall (~(get by listeners.state) other-build) ~) - :: - (lien ~(tap in listeners) is-listener-live) - :: - =? resources-by-disc.state should-delete-resource - (~(del ju resources-by-disc.state) disc resource) - :: - =? dirty-discs should-delete-resource - (~(put in dirty-discs) disc) - :: - this - :: this also recurses on our children - :: - =. ..execute (unlink-sub-builds build) - :: if there is a newer rebuild of :build, delete the linkage - :: - =/ rebuild (~(get by new.rebuilds.state) build) - =? rebuilds.state ?=(^ rebuild) - %_ rebuilds.state - new (~(del by new.rebuilds.state) build) - old (~(del by old.rebuilds.state) u.rebuild) - == - :: if we have a :newer-build, clean it up too - :: - =/ newer-build - (~(find-next by-schematic by-schematic.builds.state) build) - :: - ?~ newer-build - this - :: - (cleanup u.newer-build) - :: +clay-sub-wire: the wire to use for a clay subscription - :: - ++ clay-sub-wire - |= =disc ^- wire - :: - =+ [their desk]=disc - :: - /(scot %p our)/clay-sub/(scot %p their)/[desk] - -- --- -:: -:: end =~ -:: -. == -=, ford-api :: TODO remove once in vane -:: -:::: vane core - :: -=| axle -|= [now=@da eny=@ scry=sley] -:: allow jets to be registered within this core -:: -~% %ford-d ..is ~ :: XX why the '-d'? -:: -:: ^? :: to be added to real vane -:: -|% -:: +call: handle a +task:able from arvo -:: -++ call - |= [=duct type=* wrapped-task=(hobo task:able)] - ^- [(list move) _ford-gate] - :: unwrap :task from :wrapped-task - :: - =/ task=task:able - ?. ?=(%soft -.wrapped-task) - wrapped-task - ((hard task:able) p.wrapped-task) - :: - ?- -.task - :: %make: request to perform a build - :: - %make - :: perform the build indicated by :task - :: - :: First, we find or create the :ship-state for :our.task, - :: modifying :state-by-ship as necessary. Then we dispatch to the |ev - :: by constructing :event-args and using them to create :start-build, - :: which performs the build. The result of :start-build is a pair of - :: :moves and a mutant :ship-state. We update our :state-by-ship map - :: with the new :ship-state and produce it along with :moves. - :: - =^ ship-state state-by-ship (find-or-create-ship-state our.task) - =* event-args [[our.task duct now scry] ship-state] - =* start-build start-build:(per-event event-args) - =^ moves ship-state (start-build schematic.task) - =. state-by-ship (~(put by state-by-ship) our.task ship-state) - :: - [moves ford-gate] - :: - :: %kill: cancel a %make - :: - %kill - :: - =/ ship-state ~|(our+our.task (~(got by state-by-ship) our.task)) - =* event-args [[our.task duct now scry] ship-state] - =^ moves ship-state cancel:(per-event event-args) - =. state-by-ship (~(put by state-by-ship) our.task ship-state) - :: - [moves ford-gate] - :: - :: %wipe: wipe the cache, clearing half the entries - :: - %wipe - :: - =/ ship-states=(list [@p ford-state]) ~(tap by state-by-ship) - :: wipe each ship in the state separately - :: - =. state-by-ship - %+ roll ship-states - |= [[ship=@p state=ford-state] accumulator=(map @p ford-state)] - :: - (~(put by accumulator) ship (wipe state)) - :: - [~ ford-gate] - :: - %wegh !! - == -:: +wipe: wipe half a +ford-state's cache, in LRU (least recently used) order -:: -++ wipe - |= state=ford-state - ^+ state - :: - =/ cache-list=(list [build cache-line]) ~(tap by results.state) - :: - =/ split-cache=[(list [build cache-line]) (list [build cache-line])] - %+ skid cache-list - |=([=build =cache-line] ?=(%tombstone -.cache-line)) - :: - =/ tombstones=(list [build cache-line]) -.split-cache - =/ values=(list [build cache-line]) +.split-cache - :: sort the cache lines in chronological order by :last-accessed - :: - =/ sorted=(list [build cache-line]) - %+ sort values - |= [a=[=build =cache-line] b=[=build =cache-line]] - ^- ? - :: - ?> ?=(%value -.cache-line.a) - ?> ?=(%value -.cache-line.b) - :: - (lte last-accessed.cache-line.a last-accessed.cache-line.b) - :: - =/ num-entries=@ (lent cache-list) - :: num-stale: half of :num-entries, rounded up in case :num-entries is 1 - :: - =/ num-stale (sub num-entries (div num-entries 2)) - ~& "ford: wipe: {} cache entries" - :: - =/ stale=(list [build cache-line]) (scag num-stale sorted) - =/ fresh=(list [build cache-line]) (slag num-stale sorted) - :: - =/ stale-tombstones=(list [build cache-line]) - %+ turn stale - |= [=build =cache-line] - ^+ +< - [build [%tombstone ~]] - :: - =| results=(map build cache-line) - :: - =. results (~(gas by results) tombstones) - =. results (~(gas by results) stale-tombstones) - =. results (~(gas by results) fresh) - :: - state(results results) -:: +take: receive a response from another vane -:: -++ take - |= [=wire =duct wrapped-sign=(hypo sign)] - ^- [(list move) _ford-gate] - :: unwrap :sign from :wrapped-sign - :: - :: TODO: verify wrapped-sign isn't an evil vase? - :: - =/ =sign q.wrapped-sign - :: TODO: support other responses - :: - :: parse :wire into :our, :ship-state, and :resource - :: - ?> ?=([@ @ *] wire) - :: we know :our is already in :state-by-ship because we sent this request - :: - =/ our=@p (slav %p i.wire) - =/ ship-state ~|(our+our (~(got by state-by-ship) our)) - =* event-args [[our duct now scry] ship-state] - :: %clay-sub: response to a clay %mult subscription - :: - =^ moves ship-state - ?: =(%clay-sub i.t.wire) - :: - ?> ?=([%c %wris *] sign) - =+ [ship desk]=(raid:wired t.t.wire ~[%p %tas]) - :: - =* rebuild rebuild:(per-event event-args) - (rebuild ship desk case.sign care-paths.sign) - :: %resource: response to a request for a +resource - :: - ?. =(%scry-request i.t.wire) - :: - ~|(unknown-take+i.t.wire !!) - :: - ?> ?=([%c %writ *] sign) - :: scry-request: the +scry-request we had previously blocked on - :: - =/ =scry-request - ~| [%bad-scry-request wire] - (need (path-to-scry-request t.t.wire)) - :: scry-result: parse a (unit cage) from :sign - :: - :: If the result is `~`, the requested resource was not available. - :: - =/ scry-result=(unit cage) - ?~ riot.sign - ~ - `r.u.riot.sign - :: unblock the builds that had blocked on :resource - :: - =* unblock unblock:(per-event event-args) - (unblock scry-request scry-result) - :: - =. state-by-ship (~(put by state-by-ship) our ship-state) - :: - [moves ford-gate] -:: %utilities -:: -::+| -:: -++ ford-gate ..$ -:: +find-or-create-ship-state: find or create a ford-state for a @p -:: -:: Accesses and modifies :state-by-ship. -:: -++ find-or-create-ship-state - |= our=@p - ^- [ford-state _state-by-ship] - :: - =/ existing (~(get by state-by-ship) our) - ?^ existing - [u.existing state-by-ship] - :: - =| new-state=ford-state - [new-state (~(put by state-by-ship) our new-state)] --- diff --git a/lib/hood/kiln.hoon b/lib/hood/kiln.hoon index a37515b259..967dbf0181 100644 --- a/lib/hood/kiln.hoon +++ b/lib/hood/kiln.hoon @@ -61,7 +61,7 @@ ?> =(src our) => |% :: arvo structures ++ card :: - $% {$exec wire @p $~ {beak silk:ford}} :: + $% {$build wire @p ? schematic:ford} :: {$drop wire @p @tas} :: {$info wire @p @tas nori} :: {$mont wire @tas beam} :: @@ -287,17 +287,20 @@ |= {way/wire are/(each (set path) (pair term tang))} abet:abet:(mere:(take way) are) :: -++ take-made :: - |= {way/wire dep/@uvH reg/gage:ford} - :: hack for |overload - :: - :: We might have gotten an ignorable response back for our cache priming - :: ford call. If it matches our magic wire, ignore it. - :: - ?: =(/prime/cache way) - ~& %cache-primed - abet - abet:abet:(made:(take way) dep reg) +++ made + |= [date=@da result=made-result:ford] + abet +:: ++ take-made :: +:: |= {way/wire dep/@uvH reg/gage:ford} +:: :: hack for |overload +:: :: +:: :: We might have gotten an ignorable response back for our cache priming +:: :: ford call. If it matches our magic wire, ignore it. +:: :: +:: ?: =(/prime/cache way) +:: ~& %cache-primed +:: abet +:: abet:abet:(made:(take way) dep reg) :: ++ take-coup-fancy :: |= {way/wire saw/(unit tang)} @@ -342,23 +345,25 @@ |= {way/wire $~} ?> ?=({@ $~} way) =+ tym=(slav %dr i.way) - :: this builds up a ford build for the front page to prime the cache. - =. +>.$ - =/ request-data :~ - [0 [0 8.080] 0 'localhost' ~] - :: associate 0 as the anonymous ship, which is the ++add result. - [[0 (scot %p (add our ^~((bex 64))))] ~ ~] - 'not-yet-implemented' - `'en-US,en;q=0.9' - `.127.0.0.1 - == - =/ monies/coin [%many ~[[%blob request-data] [%$ ~.n 0]]] - =/ request/silk:ford [%bake %urb monies [our %home [%da now]] /web] - (emit `card`[%exec /kiln/prime/cache our `[[our %home [%da now]] request]]) - =. +>.$ - (emit %wipe /kiln/overload/[i.way] our ~) - =. +>.$ - (emit %wait /kiln/overload/[i.way] (add tym now)) + :: TODO: Cache priming doesn't actually work yet. + :: + :: :: this builds up a ford build for the front page to prime the cache. + :: =. +>.$ + :: =/ request-data :~ + :: [0 [0 8.080] 0 'localhost' ~] + :: :: associate 0 as the anonymous ship, which is the ++add result. + :: [[0 (scot %p (add our ^~((bex 64))))] ~ ~] + :: 'not-yet-implemented' + :: `'en-US,en;q=0.9' + :: `.127.0.0.1 + :: == + :: =/ monies/coin [%many ~[[%blob request-data] [%$ ~.n 0]]] + :: =/ request/silk:ford [%bake %urb monies [our %home [%da now]] /web] + :: (emit `card`[%exec /kiln/prime/cache our `[[our %home [%da now]] request]]) + :: =. +>.$ + :: (emit %wipe /kiln/overload/[i.way] our ~) + :: =. +>.$ + :: (emit %wait /kiln/overload/[i.way] (add tym now)) abet :: ++ spam @@ -484,29 +489,29 @@ p.res (ford-fail p.res) :: - ++ gage-to-cages - |= gag/gage:ford ^- (list (pair cage cage)) - (unwrap-tang (gage-to-tage gag)) - :: - ++ gage-to-tage - |= gag/gage:ford - ^- (each (list (pair cage cage)) tang) - ?. ?=($tabl -.gag) - (mule |.(`$~`(ford-fail >%strange-gage< ~))) - =< ?+(. [%& .] {@ *} .) - |- ^- ?((list {cage cage}) (each $~ tang)) - ?~ p.gag ~ - ?- -.p.i.p.gag - $tabl (mule |.(`$~`(ford-fail >%strange-gage< ~))) - $| (mule |.(`$~`(ford-fail p.p.i.p.gag))) - $& - ?- -.q.i.p.gag - $tabl (mule |.(`$~`(ford-fail >%strange-gage< ~))) - $| (mule |.(`$~`(ford-fail p.q.i.p.gag))) - $& =+ $(p.gag t.p.gag) - ?+(- [[p.p p.q]:i.p.gag -] {@ *} -) - == - == + :: ++ gage-to-cages + :: |= gag/gage:ford ^- (list (pair cage cage)) + :: (unwrap-tang (gage-to-tage gag)) + :: :: + :: ++ gage-to-tage + :: |= gag/gage:ford + :: ^- (each (list (pair cage cage)) tang) + :: ?. ?=($tabl -.gag) + :: (mule |.(`$~`(ford-fail >%strange-gage< ~))) + :: =< ?+(. [%& .] {@ *} .) + :: |- ^- ?((list {cage cage}) (each $~ tang)) + :: ?~ p.gag ~ + :: ?- -.p.i.p.gag + :: $tabl (mule |.(`$~`(ford-fail >%strange-gage< ~))) + :: $| (mule |.(`$~`(ford-fail p.p.i.p.gag))) + :: $& + :: ?- -.q.i.p.gag + :: $tabl (mule |.(`$~`(ford-fail >%strange-gage< ~))) + :: $| (mule |.(`$~`(ford-fail p.q.i.p.gag))) + :: $& =+ $(p.gag t.p.gag) + :: ?+(- [[p.p p.q]:i.p.gag -] {@ *} -) + :: == + :: == :: ++ perform :: ^+ . @@ -544,75 +549,82 @@ ++ mere |= are/(each (set path) (pair term tang)) ^+ +> - ?: =(%meld gem) - ?: ?=($& -.are) - ?. auto - =+ "merged with strategy {}" - win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~])) - :: ~? > =(~ p.are) [%mere-no-conflict syd] - =+ "mashing conflicts" - => .(+>.$ (spam leaf+- ~)) - =+ tic=(cat 3 syd '-scratch') - %- blab :_ ~ - :* ost %exec /kiln/[syd] - our ~ [our tic %da now] %tabl - ^- (list (pair silk:ford silk:ford)) - :: ~& > kiln-mashing+[p.are syd=syd +<.abet] - %+ turn ~(tap in p.are) - |= pax/path - ^- (pair silk:ford silk:ford) - :- [%$ %path -:!>(*path) pax] - =+ base=[%file [our tic %da now] (flop pax)] - =+ alis=[%file [her sud cas] (flop pax)] - =+ bobs=[%file [our syd %da now] (flop pax)] - =+ dali=[%diff base alis] - =+ dbob=[%diff base bobs] - =+ ^- for/mark - =+ (slag (dec (lent pax)) pax) - ?~(- %$ i.-) - [%mash for [her sud dali] [our syd dbob]] - == - =+ "failed to merge with strategy meld" - lose:(spam leaf+- >p.p.are< q.p.are) - ?: ?=($& -.are) - =+ "merged with strategy {}" - win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~])) - ?. auto - =+ "failed to merge with strategy {}" - lose:(spam leaf+- >p.p.are< q.p.are) - ?+ gem - (spam leaf+"strange auto" >gem< ~) - :: - $init - =+ :- "auto merge failed on strategy %init" - "I'm out of ideas" - lose:(spam leaf+-< leaf+-> [>p.p.are< q.p.are]) - :: - $fine - ?. ?=($bad-fine-merge p.p.are) - =+ "auto merge failed on strategy %fine" - lose:(spam leaf+- >p.p.are< q.p.are) - => (spam leaf+"%fine merge failed, trying %meet" ~) - perform(gem %meet) - :: - $meet - ?. ?=($meet-conflict p.p.are) - =+ "auto merge failed on strategy %meet" - lose:(spam leaf+- >p.p.are< q.p.are) - => (spam leaf+"%meet merge failed, trying %mate" ~) - perform(gem %mate) - :: - $mate - ?. ?=($mate-conflict p.p.are) - =+ "auto merge failed on strategy %mate" - lose:(spam leaf+- >p.p.are< q.p.are) - => .(gem %meld) - =+ tic=(cat 3 syd '-scratch') - => =+ :- "%mate merge failed with conflicts," - "setting up scratch space at %{(trip tic)}" - [tic=tic (spam leaf+-< leaf+-> q.p.are)] - (fancy-merge tic our syd %init) - == + ~& %todo-renable-mere + +> + :: ?: =(%meld gem) + :: ?: ?=($& -.are) + :: ?. auto + :: =+ "merged with strategy {}" + :: win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~])) + :: :: ~? > =(~ p.are) [%mere-no-conflict syd] + :: =+ "mashing conflicts" + :: => .(+>.$ (spam leaf+- ~)) + :: =+ tic=(cat 3 syd '-scratch') + :: %- blab :_ ~ + :: :* ost %build /kiln/[syd] our live=%.n + :: :: our ~ [our tic %da now] %tabl + :: ^- schematic:ford + :: :- %list + :: ^- (list schematic:ford) + :: :: ~& > kiln-mashing+[p.are syd=syd +<.abet] + :: %+ turn ~(tap in p.are) + :: |= pax/path + :: ^- [schematic:ford schematic:ford] + :: :- [%$ %path -:!>(*path) pax] + :: =+ base=[%pin [%scry [[our tic] (flop pax)]]] + :: :: =+ base=[%file [our tic %da now] (flop pax)] + :: ?> ?=([%da @] cas) + :: =+ alis=[%pin p.cas [%scry [[our syd] (flop pax)]]] + :: :: =+ alis=[%file [her sud cas] (flop pax)] + :: =+ bobs=[%file [our syd %da now] (flop pax)] + :: =+ dali=[%diff base alis] + :: =+ dbob=[%diff base bobs] + :: =+ ^- for/mark + :: =+ (slag (dec (lent pax)) pax) + :: ?~(- %$ i.-) + :: [%mash [our tic] for [her sud dali] [our syd dbob]] + :: == + :: =+ "failed to merge with strategy meld" + :: lose:(spam leaf+- >p.p.are< q.p.are) + :: ?: ?=($& -.are) + :: =+ "merged with strategy {}" + :: win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~])) + :: ?. auto + :: =+ "failed to merge with strategy {}" + :: lose:(spam leaf+- >p.p.are< q.p.are) + :: ?+ gem + :: (spam leaf+"strange auto" >gem< ~) + :: :: + :: $init + :: =+ :- "auto merge failed on strategy %init" + :: "I'm out of ideas" + :: lose:(spam leaf+-< leaf+-> [>p.p.are< q.p.are]) + :: :: + :: $fine + :: ?. ?=($bad-fine-merge p.p.are) + :: =+ "auto merge failed on strategy %fine" + :: lose:(spam leaf+- >p.p.are< q.p.are) + :: => (spam leaf+"%fine merge failed, trying %meet" ~) + :: perform(gem %meet) + :: :: + :: $meet + :: ?. ?=($meet-conflict p.p.are) + :: =+ "auto merge failed on strategy %meet" + :: lose:(spam leaf+- >p.p.are< q.p.are) + :: => (spam leaf+"%meet merge failed, trying %mate" ~) + :: perform(gem %mate) + :: :: + :: $mate + :: ?. ?=($mate-conflict p.p.are) + :: =+ "auto merge failed on strategy %mate" + :: lose:(spam leaf+- >p.p.are< q.p.are) + :: => .(gem %meld) + :: =+ tic=(cat 3 syd '-scratch') + :: => =+ :- "%mate merge failed with conflicts," + :: "setting up scratch space at %{(trip tic)}" + :: [tic=tic (spam leaf+-< leaf+-> q.p.are)] + :: (fancy-merge tic our syd %init) + :: == :: ++ tape-to-tanks |= a/tape ^- (list tank) @@ -624,54 +636,63 @@ (welp (tape-to-tanks "\0a{c}{a}") >b< ~) :: ++ made - |= {dep/@uvH reg/gage:ford} + |= [date=@da result=made-result:ford] + :: |= {dep/@uvH reg/gage:ford} ^+ +> - ?: ?=($| -.reg) - =+ "failed to mash" - lose:(spam leaf+- p.reg) - =+ ^- can/(list (pair path (unit miso))) - %+ turn (gage-to-cages reg) - |= {pax/cage dif/cage} - ^- (pair path (unit miso)) - ?. ?=($path p.pax) - ~| "strange path mark: {}" - !! - [((hard path) q.q.pax) ?:(?=($null p.dif) ~ `[%dif dif])] - :: ~& > kiln-made+[(turn can head) syd=syd +<.abet] - =+ notated=(skid can |=({path a/(unit miso)} ?=(^ a))) - =+ annotated=(turn `(list (pair path *))`-.notated head) - =+ unnotated=(turn `(list (pair path *))`+.notated head) - =+ `desk`(cat 3 syd '-scratch') - =+ ^- tan/(list tank) - %- zing - ^- (list (list tank)) - :~ %- tape-to-tanks - """ - done setting up scratch space in {<[-]>} - please resolve the following conflicts and run - |merge {} our {<[-]>} - """ - %^ tanks-if-any - "annotated conflicts in:" annotated - "" - %^ tanks-if-any - "unannotated conflicts in:" unnotated - """ - some conflicts could not be annotated. - for these, the scratch space contains - the most recent common ancestor of the - conflicting content. + ~& %todo-reenable-made + +> + :: :: + :: ?. ?=([%complete %success *] result) + :: =+ "failed to mash" + :: lose:(spam leaf+- p.reg) + :: ?> ?=([%complete %success %list *] result) + :: =+ ^- can/(list (pair path (unit miso))) + :: %+ turn results.build-result.result + :: |= res=build-result + :: ^- (pair path (unit miso)) + :: ?> ?=(%$ -.res) + :: =+ pax=(result-to-cage:ford head.res) + :: =+ dif=(result-to-cage:ford tail.res) + :: :: + :: ?. ?=($path p.pax) + :: ~| "strange path mark: {}" + :: !! + :: [((hard path) q.q.pax) ?:(?=($null p.dif) ~ `[%dif dif])] + :: :: ~& > kiln-made+[(turn can head) syd=syd +<.abet] + :: =+ notated=(skid can |=({path a/(unit miso)} ?=(^ a))) + :: =+ annotated=(turn `(list (pair path *))`-.notated head) + :: =+ unnotated=(turn `(list (pair path *))`+.notated head) + :: =+ `desk`(cat 3 syd '-scratch') + :: =+ ^- tan/(list tank) + :: %- zing + :: ^- (list (list tank)) + :: :~ %- tape-to-tanks + :: """ + :: done setting up scratch space in {<[-]>} + :: please resolve the following conflicts and run + :: |merge {} our {<[-]>} + :: """ + :: %^ tanks-if-any + :: "annotated conflicts in:" annotated + :: "" + :: %^ tanks-if-any + :: "unannotated conflicts in:" unnotated + :: """ + :: some conflicts could not be annotated. + :: for these, the scratch space contains + :: the most recent common ancestor of the + :: conflicting content. - """ - == - =< win - %- blab:(spam tan) - :_ ~ - :* ost %info /kiln/[syd] our - (cat 3 syd '-scratch') %& - %+ murn can - |= {p/path q/(unit miso)} - `(unit (pair path miso))`?~(q ~ `[p u.q]) - == + :: """ + :: == + :: =< win + :: %- blab:(spam tan) + :: :_ ~ + :: :* ost %info /kiln/[syd] our + :: (cat 3 syd '-scratch') %& + :: %+ murn can + :: |= {p/path q/(unit miso)} + :: `(unit (pair path miso))`?~(q ~ `[p u.q]) + :: == -- -- diff --git a/lib/hood/write.hoon b/lib/hood/write.hoon index 2a706bc4af..840a546056 100644 --- a/lib/hood/write.hoon +++ b/lib/hood/write.hoon @@ -16,7 +16,7 @@ :: |% ++ data $%({$json json} {$mime mime}) -++ card $% {$exec wire @p $~ {beak silk:ford}} +++ card $% {$build wire @p ? schematic:ford} {$info wire @p toro:clay} == -- @@ -126,21 +126,34 @@ :: ++ poke--data |= {{ext/(unit @t) pax/path} dat/data} ^+ abet - ?~ ext $(ext [~ -.dat]) - =+ cay=?-(-.dat $json [-.dat !>(+.dat)], $mime [-.dat !>(+.dat)]) - ?: =(u.ext -.dat) - (made pax ~ &+cay) - =< abet - %^ emit %exec write+pax :: XX defer %nice - [our ~ beak-now %cast u.ext $+cay] + abet + :: ?~ ext $(ext [~ -.dat]) + :: =+ cay=?-(-.dat $json [-.dat !>(+.dat)], $mime [-.dat !>(+.dat)]) + :: ?: =(u.ext -.dat) + :: (made pax ~ &+cay) + :: =< abet + :: %^ emit %build write+pax live=%.n :: XX defer %nice + :: ^- schematic:ford :: SYNTAX ERROR AT START OF LINE? + :: =/ =beak beak-now + :: [%cast [p q]:beak u.ext [%$ cay]] :: ++ made - |= {pax/wire @ res/gage:ford} ^+ abet - :: ?. =(our src) - :: ~|(foreign-write/[our=our src=src] !!) - ?+ -.res ~|(gage+-.res !!) - $| (mean p.res) - $& =- abet:(emit %info write+~ our -) - (foal :(welp (en-beam beak-now ~) pax /[-.p.res]) p.res) - == + |= [pax=wire date=@da result=made-result:ford] + ^+ abet + abet + :: :: |= {pax/wire @ res/gage:ford} ^+ abet + :: :: ?. =(our src) + :: :: ~|(foreign-write/[our=our src=src] !!) + :: ?: ?=(%incomplete -.result) + :: (mean tang.result) + :: :: + :: =/ build-result build-result.result.sih + :: :: + :: ?: ?=([%error *] build-result) + :: (mean message.build-result) + :: :: + :: =/ =cage (result-to-cage:ford build-result) + :: :: + :: =- abet:(emit %info write+~ our -) + :: (foal :(welp (en-beam beak-now ~) pax /[-.p.cage]) p.cage) -- diff --git a/sys/arvo.hoon b/sys/arvo.hoon index 90c3a665d8..c18805f140 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -166,7 +166,6 @@ ++ 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-t ~/(%slur-t |=({gat/vase hil/mill} =+(%t (slur gat hil)))) ++ slur-z ~/(%slur-z |=({gat/vase hil/mill} =+(%z (slur gat hil)))) :: ++ slur-pro :: profiling slur @@ -180,7 +179,6 @@ $e (slur-e gat hil) $f (slur-f gat hil) $g (slur-g gat hil) - $t (slur-t gat hil) == :: ++ song :: reduce metacard diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index da7cf580f2..1e55f886e2 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -335,8 +335,8 @@ $: $d :: $% {$flog p/{$crud p/@tas q/(list tank)}} :: to %dill == == :: - $: $t :: - $% [%build our=@p live=? schematic=schematic:ford-api] :: + $: $f :: + $% [%build our=@p live=? schematic=schematic:ford] :: == == $: $b :: $% {$wait p/@da} :: @@ -353,8 +353,8 @@ {$mere p/(each (set path) (pair term tang))} {$writ p/riot} :: == == :: - $: $t :: - $% [%made date=@da result=made-result:ford-api] :: + $: $f :: + $% [%made date=@da result=made-result:ford] :: == == :: $: $b :: $% {$wake $~} :: timer activate @@ -483,7 +483,7 @@ :: ++gage-to-success-cages? :: ++ made-result-to-cages - |= result=made-result:ford-api + |= result=made-result:ford ^- (list (pair cage cage)) (unwrap-tang (made-result-to-cages-or-error result)) :: @@ -491,20 +491,19 @@ :: ++gage-to-cages? :: ++ made-result-to-success-cages - |= result=made-result:ford-api + |= result=made-result:ford ^- (list (pair cage cage)) ?. ?=([%complete %success %list *] result) (ford-fail >%strange-ford-result< ~) :: process each row in the list, filtering out errors :: %+ murn results.build-result.result - |= row=build-result:ford-api + |= row=build-result:ford ^- (unit [cage cage]) :: ?. ?=([%success [%success *] [%success *]] row) ~ - =, ford-api - `[(result-to-cage head.row) (result-to-cage tail.row)] + `[(result-to-cage:ford head.row) (result-to-cage:ford tail.row)] :: :: Expects a single-level gage (i.e. a list of pairs of cages). If the :: result is of a different form, or if some of the computations in the gage @@ -512,14 +511,14 @@ :: of cages. :: ++ made-result-to-cages-or-error - |= result=made-result:ford-api + |= result=made-result:ford ^- (each (list (pair cage cage)) tang) :: ?: ?=([%incomplete *] result) (mule |.(`$~`(ford-fail tang.result))) ?. ?=([%complete %success %list *] result) (mule |.(`$~`(ford-fail >%strange-ford-result -.build-result.result< ~))) - =/ results=(list build-result:ford-api) + =/ results=(list build-result:ford) results.build-result.result =< ?+(. [%& .] {@ *} .) |- @@ -535,8 +534,8 @@ :: =+ $(results t.results) ?: ?=([@ *] -) - - =, ford-api - [[(result-to-cage head.i.results) (result-to-cage tail.i.results)] -] + :_ - + [(result-to-cage:ford head.i.results) (result-to-cage:ford tail.i.results)] :: :: Assumes the list of pairs of cages is actually a listified map of paths :: to cages, and converts it to (map path cage) or a stack trace on error. @@ -597,7 +596,7 @@ (emit hen %give %writ ~ [p.mun q.mun syd] r.mun p.dat) %- emit :* hen %pass [%blab p.mun (scot q.mun) syd r.mun] - %t %build our live=%.n %pin + %f %build our live=%.n %pin (case-to-date q.mun) (lobe-to-schematic:ze [her syd] r.mun p.dat) == @@ -812,9 +811,9 @@ +>.$ %- emit ^- move - :* hen %pass [%ergoing (scot %p her) syd ~] %t + :* hen %pass [%ergoing (scot %p her) syd ~] %f %build our live=%.n %list - ^- (list schematic:ford-api) + ^- (list schematic:ford) %+ turn `(list path)`mus |= a/path :- [%$ %path !>(a)] @@ -1130,8 +1129,8 @@ ^- (list move) :~ :* hen %pass [%inserting (scot %p her) syd (scot %da wen) ~] - %t %build our live=%.n %pin wen %list - ^- (list schematic:ford-api) + %f %build our live=%.n %pin wen %list + ^- (list schematic:ford) %+ turn ins |= {pax/path mis/miso} ?> ?=($ins -.mis) @@ -1141,8 +1140,8 @@ == :* hen %pass [%diffing (scot %p her) syd (scot %da wen) ~] - %t %build our live=%.n %pin wen %list - ^- (list schematic:ford-api) + %f %build our live=%.n %pin wen %list + ^- (list schematic:ford) %+ turn dif |= {pax/path mis/miso} ?> ?=($dif -.mis) @@ -1153,9 +1152,9 @@ == :* hen %pass [%castifying (scot %p her) syd (scot %da wen) ~] - %t %build our live=%.n %pin wen %list + %f %build our live=%.n %pin wen %list ::~ [her syd %da wen] %tabl - ^- (list schematic:ford-api) + ^- (list schematic:ford) %+ turn mut |= {pax/path mis/miso} ?> ?=($mut -.mis) @@ -1230,7 +1229,7 @@ :: diffs and mutations), then we go ahead and run ++apply-edit. :: ++ take-inserting - |= {wen/@da res/made-result:ford-api} + |= {wen/@da res/made-result:ford} ^+ +> ?~ dok ~& %clay-take-inserting-unexpected-made +>.$ @@ -1258,7 +1257,7 @@ :: insertions and mutations), then we go ahead and run ++apply-edit. :: ++ take-diffing - |= {wen/@da res/made-result:ford-api} + |= {wen/@da res/made-result:ford} ^+ +> ?~ dok ~& %clay-take-diffing-unexpected-made +>.$ @@ -1289,7 +1288,7 @@ :: this is handled in ++take-mutating. :: ++ take-castify - |= {wen/@da res/made-result:ford-api} + |= {wen/@da res/made-result:ford} ^+ +> ?~ dok ~& %clay-take-castifying-unexpected-made +>.$ @@ -1309,8 +1308,8 @@ %- emit :* hen %pass [%mutating (scot %p her) syd (scot %da wen) ~] - %t %build our live=%.n %pin wen %list - ^- (list schematic:ford-api) + %f %build our live=%.n %pin wen %list + ^- (list schematic:ford) %+ turn cat |= {pax/path cay/cage} :- [%$ %path -:!>(*path) pax] @@ -1328,7 +1327,7 @@ :: ++apply-edit. :: ++ take-mutating - |= {wen/@da res/made-result:ford-api} + |= {wen/@da res/made-result:ford} ^+ +> ?~ dok ~& %clay-take-mutating-unexpected-made +>.$ @@ -1405,12 +1404,12 @@ |= hat/(map path lobe) ^+ +> %- emit - :* hen %pass [%patching (scot %p her) syd ~] %t + :* hen %pass [%patching (scot %p her) syd ~] %f %build our live=%.n %list - ^- (list schematic:ford-api) + ^- (list schematic:ford) %+ turn ~(tap by hat) |= {a/path b/lobe} - ^- schematic:ford-api + ^- schematic:ford :- [%$ %path-hash !>([a b])] (lobe-to-schematic:ze [her syd] a b) == @@ -1426,12 +1425,12 @@ :: mim in dok). The result is handled in ++take-ergo. :: ++ take-patch - |= res/made-result:ford-api + |= res/made-result:ford ^+ +> :: ~& %taking-patch ?. ?=([%complete %success *] res) =. dok ~ - =* message (made-result-as-error:ford-api res) + =* message (made-result-as-error:ford res) (print-to-dill '!' %rose [" " "" ""] leaf+"clay patch failed" message) :: ~& %editing =+ ^- sim/(list (pair path misu)) @@ -1492,12 +1491,12 @@ :: ~& %forming-ergo :: =- ~& %formed-ergo - %- emit(dok ~) - :* hen %pass [%ergoing (scot %p her) syd ~] %t + :* hen %pass [%ergoing (scot %p her) syd ~] %f %build our live=%.n %list - ^- (list schematic:ford-api) + ^- (list schematic:ford) %+ turn ~(tap in sum) |= a/path - ^- schematic:ford-api + ^- schematic:ford :- [%$ %path !>(a)] =+ b=(~(got by can) a) ?: ?=($del -.b) @@ -1518,7 +1517,7 @@ :: an %ergo card) to keep unix up-to-date. Send this to unix. :: ++ take-ergo - |= res/made-result:ford-api + |= res/made-result:ford ^+ +> ?: ?=([%incomplete *] res) (print-to-dill '!' %rose [" " "" ""] leaf+"clay ergo failed" tang.res) @@ -1664,7 +1663,7 @@ %- emit :* hen %pass [%foreign-x (scot %p our) (scot %p her) syd car (scot cas) pax] - %t %build our live=%.n %pin + %f %build our live=%.n %pin (case-to-date cas) (vale-page [her syd] peg) == @@ -1675,8 +1674,8 @@ :: purposes. :: ++ vale-page - |= [disc=disc:ford-api a=page] - ^- schematic:ford-api + |= [disc=disc:ford a=page] + ^- schematic:ford ?. ?=($hoon p.a) [%vale disc a] ?. ?=(@t q.a) [%dude |.(>%weird-hoon<) %ride [%zpzp ~] %$ *cage] [%$ p.a [%atom %t ~] q.a] @@ -1686,15 +1685,15 @@ :: This completes the receiving of %x foreign data. :: ++ take-foreign-x - |= {car/care cas/case pax/path res/made-result:ford-api} + |= {car/care cas/case pax/path res/made-result:ford} ^+ +> ?> ?=(^ ref) ?. ?=([%complete %success *] res) ~| "validate foreign x failed" - =+ why=(made-result-as-error:ford-api res) + =+ why=(made-result-as-error:ford res) ~> %mean.|.(%*(. >[%plop-fail %why]< |1.+> why)) !! - =* as-cage `(result-to-cage:ford-api build-result.res) + =* as-cage `(result-to-cage:ford build-result.res) wake(haw.u.ref (~(put by haw.u.ref) [car cas pax] as-cage)) :: :: When we get a %w foreign update, store this in our state. @@ -1773,9 +1772,9 @@ %- emit :* hen %pass [%foreign-plops (scot %p our) (scot %p her) syd lum ~] - %t %build our live=%.n %pin (case-to-date cas) + %f %build our live=%.n %pin (case-to-date cas) %list - ^- (list schematic:ford-api) + ^- (list schematic:ford) %+ turn ~(tap in pop) |= a/plop ?- -.a @@ -1789,7 +1788,7 @@ :: state. :: ++ take-foreign-plops - |= {lem/(unit @da) res/made-result:ford-api} + |= {lem/(unit @da) res/made-result:ford} ^+ +> ?> ?=(^ ref) ?> ?=(^ nak.u.ref) @@ -2069,8 +2068,8 @@ :: Creates a schematic out of a page (which is a [mark noun]). :: ++ page-to-schematic - |= [disc=disc:ford-api a=page] - ^- schematic:ford-api + |= [disc=disc:ford a=page] + ^- schematic:ford :: ?. ?=($hoon p.a) [%volt disc a] :: %hoon bootstrapping @@ -2079,15 +2078,15 @@ :: Creates a schematic out of a lobe (content hash). :: ++ lobe-to-schematic - |= [disc=disc:ford-api pax=path lob=lobe] - ^- schematic:ford-api + |= [disc=disc:ford pax=path lob=lobe] + ^- schematic:ford :: =+ ^- hat/(map path lobe) ?: =(let.dom 0) ~ q:(aeon-to-yaki let.dom) =+ lol=`(unit lobe)`?.(=(~ ref) `0vsen.tinel (~(get by hat) pax)) - |- ^- schematic:ford-api + |- ^- schematic:ford ?: =([~ lob] lol) =+ (need (need (read-x let.dom pax))) ?> ?=($& -<) @@ -2750,7 +2749,7 @@ :: we're in, and call the appropriate function for that stage. :: ++ route - |= {sat/term res/(each riot made-result:ford-api)} + |= {sat/term res/(each riot made-result:ford)} ^+ +>.$ ?. =(sat wat.dat) ~| :* %hold-your-horses-merge-out-of-order @@ -3037,11 +3036,11 @@ :* hen %pass =+ (cat 3 %diff- nam) [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali - ~] - %t %build p.bob live=%.n %pin (case-to-date r.oth) %list - ^- (list schematic:ford-api) + %f %build p.bob live=%.n %pin (case-to-date r.oth) %list + ^- (list schematic:ford) %+ murn ~(tap by q.bas.dat) |= {pax/path lob/lobe} - ^- (unit schematic:ford-api) + ^- (unit schematic:ford) =+ a=(~(get by q.yak) pax) ?~ a ~ @@ -3068,7 +3067,7 @@ :: call ++diff-bob. :: ++ diffed-ali - |= res/made-result:ford-api + |= res/made-result:ford ^+ +> =+ tay=(made-result-to-cages-or-error res) ?: ?=($| -.tay) @@ -3116,7 +3115,7 @@ :: call ++merge. :: ++ diffed-bob - |= res/made-result:ford-api + |= res/made-result:ford ^+ +> =+ tay=(made-result-to-cages-or-error res) ?: ?=($| -.tay) @@ -3166,11 +3165,11 @@ %- emit(wat.dat %merge) :* hen %pass [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %merge ~] - %t %build p.bob live=%.n %list - ^- (list schematic:ford-api) + %f %build p.bob live=%.n %list + ^- (list schematic:ford) %+ turn ~(tap by (~(int by can.dal.dat) can.dob.dat)) |= {pax/path *} - ^- schematic:ford-api + ^- schematic:ford =+ cal=(~(got by can.dal.dat) pax) =+ cob=(~(got by can.dob.dat) pax) =+ ^= her @@ -3184,7 +3183,7 @@ :: Put merged changes in bof.dat and call ++build. :: ++ merged - |= res/made-result:ford-api + |= res/made-result:ford =+ tay=(made-result-to-cages-or-error res) ?: ?=($| -.tay) (error:he %merge-bad-made leaf+"merging failed" p.tay) @@ -3206,11 +3205,11 @@ %- emit(wat.dat %build) :* hen %pass [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %build ~] - %t %build p.bob live=%.n %list - ^- (list schematic:ford-api) + %f %build p.bob live=%.n %list + ^- (list schematic:ford) %+ murn ~(tap by bof.dat) |= {pax/path cay/(unit cage)} - ^- (unit schematic:ford-api) + ^- (unit schematic:ford) ?~ cay ~ :- ~ @@ -3232,7 +3231,7 @@ :: Sum all the changes into a new commit (new.dat), and checkout. :: ++ built - |= res/made-result:ford-api + |= res/made-result:ford ^+ +> =+ tay=(made-result-to-cages-or-error res) ?: ?=($| -.tay) @@ -3352,12 +3351,12 @@ %- emit(wat.dat %checkout) :* hen %pass [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %checkout ~] - %t %build p.bob live=%.n %pin (case-to-date r.val) %list + %f %build p.bob live=%.n %pin (case-to-date r.val) %list :: ~ val %tabl - ^- (list schematic:ford-api) + ^- (list schematic:ford) %+ murn ~(tap by q.new.dat) |= {pax/path lob/lobe} - ^- (unit schematic:ford-api) + ^- (unit schematic:ford) ?: (~(has by bop.dat) pax) ~ `[[%$ %path !>(pax)] (merge-lobe-to-schematic:he [p q]:val pax lob)] @@ -3367,7 +3366,7 @@ :: some of the changes, call ++ergo. :: ++ checked-out - |= res/made-result:ford-api + |= res/made-result:ford ^+ +> =+ tay=(made-result-to-cages-or-error res) ?: ?=($| -.tay) @@ -3410,11 +3409,11 @@ %- emit(wat.dat %ergo) :* hen %pass [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %ergo ~] - %t %build p.bob live=%.n %pin (case-to-date r.val) %list - ^- (list schematic:ford-api) + %f %build p.bob live=%.n %pin (case-to-date r.val) %list + ^- (list schematic:ford) %+ turn ~(tap in sum) |= a/path - ^- schematic:ford-api + ^- schematic:ford :- [%$ %path !>(a)] =+ b=(~(got by erg.dat) a) ?. b @@ -3427,7 +3426,7 @@ :: Tell unix about the changes made by the merge. :: ++ ergoed - |= res/made-result:ford-api + |= res/made-result:ford ^+ +> =+ tay=(made-result-to-cages-or-error res) ?: ?=($| -.tay) @@ -3486,8 +3485,8 @@ :: We short-circuit if we already have the content somewhere. :: ++ merge-lobe-to-schematic - |= [disc=disc:ford-api pax=path lob=lobe] - ^- schematic:ford-api + |= [disc=disc:ford pax=path lob=lobe] + ^- schematic:ford =+ hat=q.ali.dat =+ hot=q.bob.dat =+ ^= lal @@ -3495,7 +3494,7 @@ |= had/dome (~(get by q:(tako-to-yaki (~(got by hit.had) let.had))) pax) =+ lol=(~(get by hot) pax) - |- ^- schematic:ford-api + |- ^- schematic:ford ?: =([~ lob] lol) =+ (need (need (read-x let.dom pax))) ?> ?=($& -<) @@ -3952,7 +3951,7 @@ ?> ?=($made +<.q.hin) ?. ?=([%complete %success *] result.q.hin) ~| %blab-fail - ~> %mean.|.((made-result-as-error:ford-api result.q.hin)) + ~> %mean.|.((made-result-as-error:ford result.q.hin)) !! :: interpolate ford fail into stack trace :_ ..^$ :_ ~ :* hen %give %writ ~ @@ -3960,7 +3959,7 @@ [i.t.tea ((hard case) +>:(slay i.t.t.tea)) i.t.t.t.tea] :: `path`t.t.t.t.tea - `cage`(result-to-cage:ford-api build-result.result.q.hin) + `cage`(result-to-cage:ford build-result.result.q.hin) == ?- -.+.q.hin :: diff --git a/sys/vane/eyre.hoon b/sys/vane/eyre.hoon index 5263f62d25..ec142854ca 100644 --- a/sys/vane/eyre.hoon +++ b/sys/vane/eyre.hoon @@ -29,12 +29,12 @@ {$this p/? q/clip r/httq} :: proxied request {$meta vase} :: type check == == :: + $: $f :: + $% [%build our=@p live=? schematic=schematic:ford] + [%kill our=@p] + == == $: $g :: to %gall $% {$deal p/sock q/cush:gall} :: full transmission - == == - $: $t :: - $% [%build our=@p live=? schematic=schematic:ford-api] - [%kill our=@p] == == == :: ++ sign :: in result $<- $? $: $a :: by %ames @@ -50,8 +50,8 @@ $: $e :: by self $% {$thou p/httr} :: response for proxy == == :: - $: $t - $% [%made date=@da result=made-result:ford-api] :: + $: $f + $% [%made date=@da result=made-result:ford] :: == == $: @tas :: by any $% {$crud p/@tas q/(list tank)} :: @@ -791,7 +791,7 @@ :: ~& did-thud+[-.lid hen] ?- -.lid $exec - (pass-note p.lid %t [%kill our]) + (pass-note p.lid %f [%kill our]) :: $poll ?. (~(has by wix) p.lid) @@ -955,7 +955,7 @@ [%| tang.result.sih] ?: ?=([%complete %error *] result.sih) [%| message.build-result.result.sih] - [%& [p q.q]:(result-to-cage:ford-api build-result.result.sih)] + [%& [p q.q]:(result-to-cage:ford build-result.result.sih)] (ames-gram (slav %p p.tee) got-inner+~ (slav %uv q.tee) res) :: {$ha *} @@ -964,7 +964,7 @@ (fail-turbo 404 tang.result.sih) ?: ?=([%complete %error *] result.sih) (fail-turbo 404 message.build-result.result.sih) - =/ cay=cage (result-to-cage:ford-api build-result.result.sih) + =/ cay=cage (result-to-cage:ford build-result.result.sih) ?: ?=($red-quri p.cay) =+ url=(apex:en-purl ((hard quri) q.q.cay)) (give-thou 307 [location+(crip url)]~ ~) @@ -988,7 +988,7 @@ ?. ?=([%complete %success *] result.sih) (give-turbo-sigh result.sih) :: - =/ cay/cage (result-to-cage:ford-api build-result.result.sih) + =/ cay/cage (result-to-cage:ford build-result.result.sih) ?> ?=($hiss p.cay) ?: =('~' p.tee) (eyre-them tee q.cay) @@ -1004,7 +1004,7 @@ ((slog tang.result.sih) +>.^$) ?: ?=([%complete %error *] result.sih) ((slog message.build-result.result.sih) +>.^$) - =/ cay=cage (result-to-cage:ford-api build-result.result.sih) + =/ cay=cage (result-to-cage:ford build-result.result.sih) %+ get-rush:(ire-ix p.tee) q.tee ?> ?=($json p.cay) :: XX others ((hard json) q.q.cay) @@ -1051,7 +1051,7 @@ |= [tea=whir mar=mark cay=cage] =/ disc [p q]:(norm-beak -.top) %^ execute-turbo tea live=%.n - ^- schematic:ford-api + ^- schematic:ford [%cast disc mar [%$ cay]] :: ++ cast-thou :: turbo @@ -1090,14 +1090,14 @@ +>.$ :: ++ exec-turbo-live - |= [tea=whir req=schematic:ford-api] + |= [tea=whir req=schematic:ford] =. lyv (~(put by lyv) hen [%exec tea]) (execute-turbo tea live=%.n req) :: ++ execute-turbo - |= [tea=whir live=? request=schematic:ford-api] + |= [tea=whir live=? request=schematic:ford] %+ pass-note tea - :* %t %build our live + :* %f %build our live [%dude [|.(+)]:[%leaf "eyre: execute {}"] request] == :: @@ -1139,12 +1139,12 @@ [%tang !>(p.res)] :: ++ give-turbo-sigh - |= result=made-result:ford-api + |= result=made-result:ford ~& %give-turbo-sigh =- +>.$(mow :_(mow [hen %give %sigh `cage`-])) ?: ?=(%incomplete -.result) [%tang !>(tang.result)] - (result-to-cage:ford-api build-result.result) + (result-to-cage:ford build-result.result) :: ++ mean-json |=({sas/@uG err/ares} (give-json sas ~ (ares-to-json err))) ++ nice-json |=(* (give-json 200 ~ (frond:enjs %ok %b &))) @@ -1220,12 +1220,12 @@ ~& [%bake pez] %+ exec-turbo-live p.pez - ^- schematic:ford-api + ^- schematic:ford :- %alts :~ - ^- schematic:ford-api + ^- schematic:ford [%bake q.pez r.pez [[p q] s]:s.pez] :: - ^- schematic:ford-api + ^- schematic:ford [%bake %red-quri r.pez [[p q] s]:s.pez] == :: @@ -1937,7 +1937,7 @@ ++ self . ++ abet +>(sec (~(put by sec) +<- +<+)) ++ execute-turbo - |= [wir=whir-se live=? schematic=schematic:ford-api] + |= [wir=whir-se live=? schematic=schematic:ford] (execute-turbo:abet se+[wir usr dom] live schematic) ++ dead-this |=(a/tang (fail:abet 500 0v0 a)) ++ dead-hiss |=(a/tang pump(req ~(nap to req), ..vi (give-sigh %| a))) @@ -1955,11 +1955,11 @@ ++ build %^ execute-turbo %core live=%.y :::+ %dude [|.(+)]:>%mod-samp< - ^- schematic:ford-api + ^- schematic:ford :+ %mute - ^- schematic:ford-api + ^- schematic:ford [%core [[our %home] (flop %_(dom . sec+dom))]] - ^- (list (pair wing schematic:ford-api)) + ^- (list (pair wing schematic:ford)) :* [[%& 12]~ %$ bale+!>(*(bale @))] :: XX specify on type? ?~ cor ~ ?~ u.cor ~ @@ -1974,7 +1974,7 @@ %^ execute-turbo arm live=%.n call+[ride+[limb+arm prep-cor] [%$ sam]] :: - ++ prep-cor ^- schematic:ford-api + ++ prep-cor ^- schematic:ford ?~ cor ~|(%no-core !!) ?~ u.cor ~|(%nil-driver !!) :+ %$ %core @@ -2028,7 +2028,7 @@ == :: ++ get-made - |= [wir/whir-se result=made-result:ford-api] ^+ abet + |= [wir/whir-se result=made-result:ford] ^+ abet :: |= {wir/whir-se dep/@uvH res/(each cage tang)} ^+ abet ?: ?=($core wir) (made-core result) %. result @@ -2040,12 +2040,12 @@ == :: ++ made-core - |= [result=made-result:ford-api] + |= [result=made-result:ford] :: |= {dep/@uvH gag/(each cage tang)} :: ~& got-update/dep :: =. ..vi (pass-note %core [%f [%wasp our dep &]]) ?: ?=([%complete %success *] result) - =/ =cage (result-to-cage:ford-api build-result.result) + =/ =cage (result-to-cage:ford build-result.result) pump(cor `q:cage) ?: &(=(~ cor) =(%$ usr)) =. cor `~ @@ -2116,8 +2116,8 @@ $(a t.a) :: ++ on-ford-fail - |= {err/$-(tang _abet) try/$-(made-result:ford-api _abet)} - |= a/made-result:ford-api ^+ abet + |= {err/$-(tang _abet) try/$-(made-result:ford _abet)} + |= a/made-result:ford ^+ abet ?: ?=(%incomplete -.a) (err tang.a) ?: ?=(%error -.build-result.a) @@ -2126,13 +2126,13 @@ :: ++ on-error |= {err/$-(tang _abet) handle-move/_|.(|~(vase abet))} - |= a=made-result:ford-api ^+ abet + |= a=made-result:ford ^+ abet =+ try=(possibly-stateful |=(b/_self (handle-move(+ b)))) :: XX types ?: ?=(%incomplete -.a) (err tang.a) ?: ?=(%error -.build-result.a) (err message.build-result.a) - =/ =cage (result-to-cage:ford-api build-result.a) + =/ =cage (result-to-cage:ford build-result.a) =- ?-(-.- $& p.-, $| (err p.-)) (mule |.(~|(driver+dom ~|(bad-res+p.q.cage (try q.cage))))) :: diff --git a/sys/vane/ford.hoon b/sys/vane/ford.hoon index 92979af7ae..1d0065e650 100644 --- a/sys/vane/ford.hoon +++ b/sys/vane/ford.hoon @@ -1,2009 +1,5424 @@ -!::::: -:: :: %ford, new execution control -!? 164 -:::: -|= pit/vase +:: pit: a +vase of the hoon+zuse kernel, which is a deeply nested core +:: +|= pit=vase +:: =, ford -=, format +:: ford internal data structures +:: => =~ -:: structures +=, ford :: TODO remove once in vane |% -++ heel path :: functional ending -++ move {p/duct q/(wind note gift:able)} :: local move -++ note :: out request $-> - $% $: $c :: to %clay - $% {$warp p/sock q/riff:clay} :: - == == :: - $: $f :: to %ford - $% {$exec p/@p q/(unit bilk:ford)} :: - == == :: - $: $g :: to %gall - $% {$deal p/sock q/cush:gall} :: - == == == :: -++ sign :: in result $<- - $% $: $c :: by %clay - $% {$writ p/riot:clay} :: - == == :: - $: $f :: by %ford - $% {$made p/@uvH q/gage:ford} :: - == == :: - $: $g :: by %gall - $% {$unto p/cuft:gall} :: - == == == :: --- :: -|% :: structures -++ axle :: all %ford state - $: $0 :: version for update - pol/(map ship baby) :: - == :: -++ baby :: state by ship - $: tad/{p/@ud q/(map @ud task)} :: tasks by number - dym/(map duct @ud) :: duct to task number - jav/(map * calx) :: cache - deh/deps :: dephash definitions - sup/(jug @uvH duct) :: hash listeners - out/(set beam) :: listening beams - == :: -++ deps :: - $: def/(map @uvH (set beam)) :: hash obligations - bak/(jug beam @uvH) :: update to hash - == :: -++ bolt :: gonadic edge - |* a/mold :: product clam - $: p/cafe :: cache - $= q :: - $% {$0 p/(set beam) q/a} :: depends+product - {$1 p/(set {van/vane ren/care:clay bem/beam tan/tang})} :: blocks - {$2 p/(set beam) q/tang} :: depends+error - == :: - == :: -++ burg :: gonadic rule - |* {a/mold b/mold} :: from and to - $-({c/cafe d/a} (bolt b)) :: -:: :: -++ cafe :: live cache - $: p/(set calx) :: used - q/(map * calx) :: cache - r/deps :: depends - == :: -:: :: -++ calm :: cache metadata - $: laz/@da :: last accessed - dep/(set beam) :: dependencies - == :: -++ calx :: concrete cache line - $% {$hood p/calm q/(pair beam cage) r/hood} :: compile - {$bake p/calm q/(pair mark beam) r/(unit vase)} :: load - {$boil p/calm q/(trel coin beam beam) r/vase} :: execute - {$path p/calm q/beam r/(unit beam)} :: -to/ transformation - {$slit p/calm q/{p/type q/type} r/type} :: slam type - {$slim p/calm q/{p/type q/hoon} r/(pair type nock)}:: mint - {$slap p/calm q/{p/vase q/hoon} r/vase} :: compute - {$slam p/calm q/{p/vase q/vase} r/vase} :: compute - == :: -++ task :: problem in progress - $: nah/duct :: cause - {bek/beak kas/silk} :: problem - keg/(map (pair term beam) cage) :: block results - kig/(set (trel vane care:clay beam)) :: blocks - == :: -++ gagl (list (pair gage gage)) :: -++ vane ?($a $b $c $d $e $f $g) :: --- :: -|% :: -++ calf :: reduce calx - |* sem/* :: a typesystem hack - |= cax/calx - ?+ sem !! - $hood ?>(?=($hood -.cax) r.cax) - $bake ?>(?=($bake -.cax) r.cax) - $boil ?>(?=($boil -.cax) r.cax) - $path ?>(?=($path -.cax) r.cax) - $slap ?>(?=($slap -.cax) r.cax) - $slam ?>(?=($slam -.cax) r.cax) - $slim ?>(?=($slim -.cax) r.cax) - $slit ?>(?=($slit -.cax) r.cax) +:: +move: arvo moves that ford can emit +:: ++= move + :: + $: :: duct: request identifier + :: + =duct + :: card: move contents; either a +note or a +gift:able + :: + card=(wind note gift:able) == +:: +note: private request from ford to another vane :: -++ calk :: cache lookup - |= a/cafe :: - |= {b/@tas c/*} :: - ^- {(unit calx) cafe} :: - =+ d=(~(get by q.a) [b c]) :: - ?~ d [~ a] :: - [d a(p (~(put in p.a) u.d))] :: -:: :: -++ came :: - |= {a/cafe b/calx} :: cache install - ^- cafe :: - a(q (~(put by q.a) [-.b q.b] b)) :: -:: :: -++ faun (flux |=(a/vase [%& %noun a])) :: vase to gage -++ flay :: unwrap gage to cage - |= {a/cafe b/gage} ^- (bolt cage) - ?- -.b - $tabl (flaw a >%bad-marc< ~) - $| (flaw a p.b) - $& (fine a p.b) - == ++= note + $% :: %c: to clay + :: + $: %c + :: %warp: internal (intra-ship) file request + :: + $% $: %warp + :: sock: pair of requesting ship, requestee ship + :: + =sock + :: riff: clay request contents + :: + riff=riff:clay + == == == + :: %g: to gall + :: + $: %g + :: %unto: full transmission + :: + :: TODO: document more fully + :: + $% $: %deal + :: sock: pair of requesting ship, requestee ship + :: + =sock + :: cush: gall request contents + :: + cush=cush:gall + == == == == +:: +sign: private response from another vane to ford :: -++ fret :: lift error - |= a/(bolt gage) ^- (bolt gage) - ?. ?=($2 -.q.a) a - [p.a [%0 p.q.a `gage`[%| q.q.a]]] -:: -++ fine |* {a/cafe b/*} :: bolt from data - [p=`cafe`a q=[%0 p=*(set beam) q=b]] :: -++ flaw |= {a/cafe b/tang} :: bolt from error - [p=a q=[%2 p=*(set beam) q=b]] :: -++ flag :: beam into deps - |* {a/beam b/(bolt)} :: - ?: ?=($1 -.q.b) b - =. p.q.b (~(put in p.q.b) a) - b -:: :: -++ flue |=(a/cafe (fine a ~)) :: cafe to empty -++ flux |* a/_* :: bolt lift (fmap) - |* {cafe _,.+<.a} - (fine +<- (a +<+)) -:: -++ lark :: filter arch names - |= {wox/$-(knot (unit @)) arc/arch} - ^- (map @ knot) - %- ~(gas by *(map @ knot)) - =| rac/(list (pair @ knot)) - |- ^+ rac - ?~ dir.arc rac - =. rac $(dir.arc l.dir.arc, rac $(dir.arc r.dir.arc)) - =+ gib=(wox p.n.dir.arc) - ?~(gib rac [[u.gib p.n.dir.arc] rac]) -:: -++ tack :: fold path to term - |= a/{i/term t/(list term)} ^- term - (rap 3 |-([i.a ?~(t.a ~ ['-' $(a t.a)])])) -:: -++ tear :: split term - =- |=(a/term `(list term)`(fall (rush a (most hep sym)) /[a])) - sym=(cook crip ;~(plug low (star ;~(pose low nud)))) -:: -++ za :: per event - =| $: $: our/ship :: computation owner - hen/duct :: event floor - $: now/@da :: event date - eny/@ :: unique entropy - ska/sley :: system namespace - == :: - mow/(list move) :: pending actions - == :: - bay/baby :: all owned state - == :: - |% - ++ this . - ++ abet :: resolve - ^- {(list move) baby} - [(flop mow) bay] - :: - ++ pass - |= {wir/wire noe/note} ^+ this - %_(+> mow :_(mow [hen %pass wir noe])) - :: - ++ deps-take :: take rev update - |= {ren/care:clay bem/beam sih/sign} - =< abet ^+ +> - ?. ?=($writ &2.sih) - ~|([%bad-dep &2.sih] !!) - ?~ p.sih +> :: acknowledged - =. out.bay (~(del in out.bay) bem) - =/ des ~(tap in (~(get ju bak.deh.bay) bem)) - |- ^+ this - ?~ des this - %_ $ - sup.bay (~(del by sup.bay) i.des) - des t.des - mow - %- weld :_ mow - %+ turn ~(tap in (~(get ju sup.bay) i.des)) - |=(a/duct `move`[a %give %news i.des]) - == - :: - ++ exec-cancel - =< abet ^+ . - =+ nym=(~(get by dym.bay) hen) - ?~ nym :: XX should never - ~& [%ford-mystery hen] - this - =+ tas=(need (~(get by q.tad.bay) u.nym)) - abut:~(decamp zo [u.nym tas]) - :: - ++ exec-start - |= kub/bilk - =< abet ^+ +> - =+ num=p.tad.bay - ?< (~(has by dym.bay) hen) - =: p.tad.bay +(p.tad.bay) - dym.bay (~(put by dym.bay) hen num) - == - ~(exec zo [num `task`[hen kub ~ ~]]) - :: - ++ task-take - |= {num/@ud {van/vane ren/care:clay bem/beam} sih/sign} - =< abet ^+ +> - ?: ?=({$unto $quit *} +.sih) - +>.$ - =+ tus=(~(get by q.tad.bay) num) - ?~ tus - ~& [%ford-lost van num] - +>.$ - (~(take zo [num u.tus]) [van ren bem] sih) - :: - ::+| - :: - ++ wasp :: get next revision - ~% %ford-w ..is ~ - |= {dep/@uvH ask/?} - =< abet ^+ +> - :: - :: - ?: =(`@`0 dep) - ~&(dep-empty+hen +>.$) - ?: =(dep 0vtest) :: upstream testing - +>.$(mow ?.(ask mow :_(mow [hen %give %news dep]))) - :: - ?. (~(has by def.deh.bay) dep) - ~&([%wasp-unknown dep] this) - =/ bes (~(got by def.deh.bay) dep) - :: - |^ ?:(ask start cancel) - ++ start - ^+ this - ?: (~(has by sup.bay) dep) - this(sup.bay (~(put ju sup.bay) dep hen)) - =. sup.bay (~(put ju sup.bay) dep hen) ++= sign + $% :: %c: from clay :: - => .(bes ~(tap in bes)) - |- ^+ this - ?~ bes this - :: already sent - ?: (~(has in out.bay) i.bes) $(bes t.bes) - %_ $ - out.bay (~(put in out.bay) i.bes) - bes t.bes - mow :_(mow [hen (pass-warp %z i.bes &)]) - == - :: - ++ cancel - ^+ this - =. sup.bay (~(del ju sup.bay) dep hen) - ?^ sup.bay :: other listeners exist - this - => .(bes ~(tap in bes)) - |- ^+ this - ?~ bes this - ?> (~(has in out.bay) i.bes) :: already cancelled - ?: (~(any in (~(get ju bak.deh.bay) i.bes)) ~(has by sup.bay)) - :: if any other dep cares about this beam, stay subscribed - $(bes t.bes) - %_ $ - out.bay (~(del in out.bay) i.bes) - bes t.bes - mow :_(mow [hen (pass-warp %z i.bes |)]) - == - -- - :: - ++ pass-warp - |= {ren/care:clay bem/beam ask/?} - :: ~& warp+[(en-beam bem) ask] - :+ %pass [(scot %p our) ren (en-beam bem)] - [%c [%warp [our p.bem] q.bem ?.(ask ~ `[%next ren r.bem (flop s.bem)])]] - :: - :: - ++ zo - ~% %ford-z ..is ~ - =| dyv/@ :: recursion level - |_ {num/@ud task} - ++ abet :: store a blocked task - %_(..zo q.tad.bay (~(put by q.tad.bay) num +<+)) - :: - ++ abut :: remove a task - %_ ..zo - q.tad.bay (~(del by q.tad.bay) num) - dym.bay (~(del by dym.bay) nah) - == - :: - ++ decamp :: stop requests - ^+ . - =+ kiz=~(tap in kig) - |- ^+ +> - ?~ kiz +> - $(kiz t.kiz, mow :_(mow [hen (cancel i.kiz)])) - :: - ++ cancel :: stop a request - |= {van/vane ren/care:clay bem/beam} - ^- (wind note gift:able) - ?+ van ~|(stub-cancel+van !!) - $c [%pass (camp-wire +<) van [%warp [our p.bem] q.bem ~]] - $g [%pass (camp-wire +<) van [%deal [our p.bem] q.bem [%pull ~]]] - == - :: - ++ camp-wire :: encode block - |= {van/vane ren/care:clay bem/beam} ^- wire - [(scot %p our) (scot %ud num) van ren (en-beam bem)] - :: - ++ camp :: request data - |= {van/vane ren/care:clay bem/beam} - ^+ +> - ~& >> [%camping van ren bem] - %_ +>.$ - kig (~(put in kig) +<) - mow - :_ mow - :- hen - ?+ van ~&(%camp-stub !!) - $g - =/ tyl/path - ?. ?=($x ren) - s.bem - ?> ?=(^ s.bem) - t.s.bem + $: %c + $% :: %writ: internal (intra-ship) file response :: - :+ %pass (camp-wire +<.$) - [%g [%deal [our p.bem] q.bem [%peer %scry ren (flop tyl)]]] - :: - $c - :+ %pass (camp-wire +<.$) - [%c [%warp [our p.bem] q.bem [~ %sing ren r.bem (flop s.bem)]]] - == - == - :: - ++ take :: handle ^take - |= {{van/vane ren/care:clay bem/beam} sih/sign} - ^+ ..zo - ?- &2.sih - $writ (take-writ [van ren bem] p.sih) - $made (take-made [van ren bem] [p q]:sih) - $unto - ?+ -.p.sih ~|(ford-strange-unto+[-.p.sih] !!) - $diff (take-diff [van ren bem] p.p.sih) - $reap ?~ p.p.sih ..zo - ((slog leaf+"ford-reap-fail" u.p.p.sih) ..zo) - == - == - :: - ++ take-diff - |= {{van/vane ren/care:clay bem/beam} cag/cage} - ^+ ..zo - ?> ?=($g van) - ?: |(!?=($x ren) =(-.s.bem p.cag)) - =. kig (~(del in kig) +<-.$) - =. mow :_(mow [hen (cancel van ren bem)]) - =+ (cat 3 van ren) - exec(keg (~(put by keg) [- bem] cag)) - =. mow - :_ mow - :^ hen %pass (camp-wire van ren bem) - [%f %exec our ~ bek %cast ((hard mark) -.s.bem) %$ cag] - ..zo - :: - ++ take-made - |= {{van/vane ren/care:clay bem/beam} dep/@uvH gag/gage} :: XX depends? - ^+ ..zo - ?> ?=($g van) - =. kig (~(del in kig) +<-.$) - =. mow :_(mow [hen (cancel van ren bem)]) - ?: ?=($| -.gag) - abut:(give [%made dep %| leaf+"ford-scry-made-fail" p.gag]) - ?: ?=($tabl -.gag) - abut:(give [%made dep %| leaf+"ford-scry-made-strange" ~]) - =+ (cat 3 van ren) - exec(keg (~(put by keg) [- bem] p.gag)) - :: - ++ take-writ - |= {{van/vane ren/care:clay bem/beam} rot/riot:clay} - ^+ ..zo - ?> ?=($c van) - =. kig (~(del in kig) +<-.$) - ?~ rot - =^ dep deh.bay (daze ~ deh.bay) :: dependencies? - abut:(give [%made dep %| (smyt ren (en-beam bem)) ~]) - =+ (cat 3 van ren) - exec(keg (~(put by keg) [- bem] r.u.rot)) - :: - ::+| - :: - ::> Exec proper - :: - ++ clad :: hash dependencies - |* hoc/(bolt) ^+ [*@uvH hoc] - ?: ?=($1 -.q.hoc) [*@uvH hoc] - =^ dep r.p.hoc (daze [p.q r.p]:hoc) - [dep hoc] - :: - ++ clef :: cache a result - |* sem/* - |* {hoc/(bolt) fun/(burg)} - ?- -.q.hoc - $2 hoc - $1 hoc - $0 - =^ cux p.hoc ((calk p.hoc) sem q.q.hoc) - ?^ cux - [p=p.hoc q=[%0 p=dep.p.u.cux q=((calf sem) u.cux)]] - =+ nuf=(cope hoc fun) - ?- -.q.nuf - $2 nuf - $1 nuf - $0 - :: ~& :- %clef-new - :: ?+ sem `term`sem - :: $hood [%hood (en-beam &1.q.q.hoc)] - :: $bake [%bake `mark`&1.q.q.hoc (en-beam |2.q.q.hoc)] - :: == - :- p=(came p.nuf `calx`[sem `calm`[now p.q.nuf] q.q.hoc q.q.nuf]) - q=q.nuf - == - == - :: - ++ coax !. :: bolt together - |* {hoc/(bolt) fun/(burg)} - ?- -.q.hoc - $0 =+ nuf=(fun p.hoc +<+.fun) - :- p=p.nuf - ^= q - ?- -.q.nuf - $0 [%0 p=(~(uni in p.q.hoc) p.q.nuf) q=[q.q.hoc q.q.nuf]] - $1 q.nuf - $2 q.nuf - == - $1 =+ nuf=(fun p.hoc +<+.fun) - :- p=p.nuf - ^= q - ?- -.q.nuf - $0 q.hoc - $1 [%1 p=(~(uni in p.q.nuf) p.q.hoc)] - $2 q.nuf - == - $2 hoc - == - :: - ++ cool :: error caption - |* {cyt/$@(term (trap tank)) hoc/(bolt)} - ?. ?=($2 -.q.hoc) hoc - [p=p.hoc q=[%2 p=p.q.hoc q=[?^(cyt *cyt >`@tas`cyt<) q.q.hoc]]] - :: - ++ cope :: bolt along - |* {hoc/(bolt) fun/(burg)} - ?- -.q.hoc - $1 hoc - $2 hoc - $0 =+ nuf=(fun p.hoc q.q.hoc) - :- p=p.nuf - ^= q - ?- -.q.nuf - $1 q.nuf - $2 [%2 p=(~(uni in `_p.q.nuf`p.q.hoc) p.q.nuf) q=q.q.nuf] - $0 [%0 p=(~(uni in `_p.q.nuf`p.q.hoc) p.q.nuf) q=q.q.nuf] - == == - :: - ++ coop :: bolt fallback - |* {hoc/(bolt) fun/$-(cafe (bolt))} - ?- -.q.hoc - $1 hoc - $0 hoc - $2 =+ nuf=(fun p.hoc) - :- p=p.nuf - ^= q - ?- -.q.nuf - $1 q.nuf - $0 [%0 p=(~(uni in `_p.q.nuf`p.q.hoc) p.q.nuf) q=q.q.nuf] - $2 =. q.q.nuf (welp q.q.nuf q.q.hoc) - [%2 p=(~(uni in `_p.q.nuf`p.q.hoc) p.q.nuf) q=q.q.nuf] - == == - :: - ++ coup :: toon to bolt - |= cof/cafe - |* {ton/toon fun/gate} - :- p=cof - ^= q - ?- -.ton - $2 [%2 p=*(set beam) q=p.ton] - $0 [%0 p=*(set beam) q=(fun p.ton)] - $1 :: ~& [%coup-need ((list path) p.ton)] - =- ?- -.faw - $& :- %1 - ^= p - %- silt - %+ turn p.faw - |=(a/{vane care:clay beam} [-.a +<.a +>.a *tang]) - $| [%2 p=*(set beam) q=p.faw] - == - ^= faw - |- ^- (each (list (trel vane care:clay beam)) tang) - ?~ p.ton [%& ~] - =+ nex=$(p.ton t.p.ton) - =+ err=|=(a/tape [%| leaf+a ?:(?=($& -.nex) ~ p.nex)]) - =+ pax=(path i.p.ton) - ?~ pax (err "blocking empty") - =+ ren=((soft care:clay) (rsh 3 1 i.pax)) - ?~ ren - (err "blocking not care: {}") - =+ zis=(de-beam t.pax) - ?~ zis - (err "blocking not beam: {}") - ?: ?=($g (end 3 1 i.pax)) - ?- -.nex - $& [%& [%g u.ren u.zis] p.nex] - $| nex - == - ?: ?=($c (end 3 1 i.pax)) - ?- -.nex - $& [%& [%c u.ren u.zis] p.nex] - $| nex - == - (err "blocking bad vane") - == - :: - ++ cowl :: each to bolt - |= cof/cafe - |* {tod/(each * tang) fun/gate} - %+ (coup cof) - ?- -.tod - $& [%0 p=p.tod] - $| [%2 p=p.tod] - == - fun - :: - ++ tabl-run :: apply to all elems - |= fun/(burg cage gage) - |= {cof/cafe gag/gage} - ^- (bolt gage) - ?. ?=($tabl -.gag) - (cope (flay cof gag) fun) - %+ cope - |- ^- (bolt (list (pair gage gage))) - ?~ p.gag (fine cof ~) - %. [cof p.gag] - ;~ cope - ;~ coax - |=({cof/cafe {^ q/gage} t/gagl} (fret ^^$(cof cof, gag q))) - |=({cof/cafe ^ t/gagl} ^$(cof cof, p.gag t)) + $: %writ + :: riot: response contents + :: + riot=riot:clay == - (flux |=({v/gage t/gagl} [[p.i.p.gag v] t])) - == - (flux |=(rex/gagl [%tabl rex])) - :: - ++ some-in-map - |* fun/(burg knot (unit)) - =+ res=_(need [?+(-.q !! $0 q.q)]:*fun) - =+ marv=(map knot res) - |= {cof/cafe sud/(map knot $~)} ^- (bolt marv) - ?~ sud (flue cof) - %. [cof sud] - ;~ cope - ;~ coax - |=({cof/cafe _sud} ^$(cof cof, sud l)) - |=({cof/cafe _sud} ^$(cof cof, sud r)) - |= {cof/cafe {dir/@ta $~} ^} - %+ cope (fun cof dir) - (flux (lift |*(* [dir +<]))) - == - %- flux - |= {lam/marv ram/marv nod/(unit {knot res})} - ?^(nod [u.nod lam ram] (~(uni by lam) ram)) - == - ++ dash :: process cache - |= cof/cafe - ^+ +> - %_(+> jav.bay q.cof, deh.bay r.cof) - :: - ++ diff :: diff - |= {cof/cafe kas/silk kos/silk} - ^- (bolt gage) - %. [cof kas kos] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope (make cof p) flay)) - |=({cof/cafe p/silk q/silk} (cope (make cof q) flay)) - == - |= {cof/cafe cay/cage coy/cage} ^- (bolt gage) - ?. =(p.cay p.coy) - %+ flaw cof :_ ~ - leaf+"diff on data of different marks: {(trip p.cay)} {(trip p.coy)}" - ?: =(q.q.cay q.q.coy) - (fine cof [%& %null [%atom %n ~] ~]) - :: - %+ cope (fang cof p.cay) - |= {cof/cafe pro/vase} - ?. (slab %grad p.pro) - (flaw cof leaf+"no ++grad" ~) - =+ gar=(slap pro [%limb %grad]) - ?@ q.gar - =+ for=((sand %tas) q.gar) - ?~ for (flaw cof leaf+"bad mark ++grad" ~) - %+ make cof ^- silk - :+ %diff - [%cast u.for [%$ cay]] - [%cast u.for [%$ coy]] - ?. (slab %form p.gar) - (flaw cof leaf+"no ++form:grad" ~) - ?. (slab %diff p.gar) - (flaw cof leaf+"no ++diff:grad" ~) - %+ cope (keel cof pro [[%& 6]~ q.cay]~) - |= {cof/cafe pox/vase} - %+ cope - %^ maul cof - (slap (slap pox [%limb %grad]) [%limb %diff]) - q.coy - |= {cof/cafe dif/vase} - =+ for=((soft @tas) q:(slap gar [%limb %form])) - ?~ for - (flaw cof leaf+"bad ++form:grad" ~) - (fine cof [%& u.for dif]) - == - :: - ++ daze :: remember depends - |= {dep/(set beam) deh/deps} - ^+ [*@uvH deh] - =. dep - =< (silt (skip ~(tap in dep) .)) - |= dap/beam ^- ? - ?~ s.dap | - =>(.(s.dap t.s.dap) |((~(has in dep) dap) $)) - ?: =(~ dep) [0v0 deh] - =+ hap=(sham dep) - :+ hap - (~(put by def.deh) hap dep) - (~(gas ju bak.deh) (turn ~(tap in dep) |=(a/beam [a hap]))) - :: - ++ exec :: execute task - ^+ ..zo - ?: !=(~ kig) ..zo - =+ bot=(make-with-normalized-beak [~ jav.bay deh.bay] kas) - =^ dep bot (clad bot) - =. ..exec (dash p.bot) - ?- -.q.bot - $0 abut:(give [%made dep q.q.bot]) - $2 abut:(give [%made dep %| q.q.bot]) - $1 =+ zuk=~(tap by p.q.bot) - =< abet - |- ^+ ..exec - ?~ zuk ..exec - %= $ - zuk t.zuk - ..exec `_..exec`(camp van.p.i.zuk ren.q.i.zuk bem.q.i.zuk) - == == - :: - ++ give :: return gift - |= gef/gift:able - %_(+> mow :_(mow [hen %give gef])) - :: - ++ compile-to-hood - ~/ %compile-to-hood - |= {cof/cafe bem/beam} - :: ~& compile-to-hood+(en-beam bem) - ^- (bolt hood) - %+ cool |.(leaf+"ford: compile-to-hood {<[(en-beam bem)]>}") - %+ cope (load-file cof %*(. bem s [%hoon s.bem])) - |= {cof/cafe cay/cage} - %+ (clef %hood) (fine cof bem(r [%ud 0]) cay) - ^- (burg (pair beam cage) hood) - ~% %hood-miss ..abet ~ - |= {cof/cafe bem/beam cay/cage} - ?. ?=(@ q.q.cay) - (flaw cof ~) - =+ vex=((full (fair bem)) [[1 1] (trip q.q.cay)]) - ?~ q.vex - (flaw cof [%leaf "syntax error: {} {}"] ~) - (fine cof p.u.q.vex) - :: - ++ fame :: beam with - as / - ~/ %fame - |= {cof/cafe bem/beam} - ^- (bolt beam) - =; une/(bolt (unit beam)) - %+ cope une - |= {cof/cafe bom/(unit beam)} ^- (bolt beam) - ?^ bom (fine cof u.bom) - (flaw cof leaf+"fame: no {<(en-beam bem)>}" ~) - %+ (clef %path) (fine cof bem) - |= {cof/cafe bem/beam} - =^ pax bem [(flop s.bem) bem(s ~)] - |^ opts - ++ opts :: search unless done - ^- (bolt (unit beam)) - ?^ pax (wide(pax t.pax) (tear i.pax)) - %+ cope (load-to-mark cof %hoon bem) - (flux |=(a/(unit vase) ?~(a ~ `bem))) - :: - ++ wide :: match segments - |= sub/(list term) ^- (bolt (unit beam)) - ?~ sub opts - ?~ t.sub opts(s.bem [i.sub s.bem]) - => .(sub `(list term)`sub) :: TMI - =- (cope - flat) - %^ filter-at-beam cof bem - |= {cof/cafe dir/knot} ^- (bolt (unit beam)) - =+ sus=(tear dir) - ?. =(sus (scag (lent sus) sub)) - (flue cof) - %_ ^$ - cof cof - sub (slag (lent sus) sub) - s.bem [dir s.bem] - == - :: - ++ flat :: at most one - |= {cof/cafe opt/(map term beam)} ^- (bolt (unit beam)) - ?~ opt (flue cof) - ?: ?=({^ $~ $~} opt) (fine cof `q.n.opt) - =+ all=(~(run by `(map term beam)`opt) en-beam) - (flaw cof leaf+"fame: fork {}" ~) - -- - :: - ++ fang :: protocol door - |= {cof/cafe for/mark} ^- (bolt vase) - :: ~& fang+for - (load-core cof bek /[for]/mar) - :: - ++ fair :: hood parsing rule - |= bem/beam - ?> ?=({$ud $0} r.bem) :: XX sentinel - =+ vez=(vang & (en-beam bem)) - =< hood - |% - ++ case - %+ sear - |= a/coin ^- (unit ^case) - ?. ?=({$$ ^case} a) ~ - [~ u=p.a] - nuck:so - :: - ++ mota ;~(pfix pat mota:vez) :: atom odor - ++ hath (sear plex (stag %clsg poor)):vez :: hood path - ++ have (sear de-beam ;~(pfix fas hath)) :: hood beam - ++ hith :: static path - => vez - (sear plex (stag %clsg (more fas hasp))) - :: - ++ hive :: late-bound path - ;~ pfix fas - %+ cook |=(a/hops a) - => vez - ;~ plug - (stag ~ gash) - ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~)) - == - == - :: - ++ hood - %+ ifix [gay gay] - ;~ plug - ;~ pose - (ifix [;~(plug fas wut gap) gap] dem) - (easy zuse) - == - :: - ;~ pose - (ifix [;~(plug fas hep gap) gap] (most ;~(plug com gaw) hoof)) - (easy ~) - == - :: - ;~ pose - (ifix [;~(plug fas lus gap) gap] (most ;~(plug com gaw) hoof)) - (easy ~) - == - :: - (star ;~(sfix horn gap)) - (most gap hoop) - == - :: - ++ hoot - ;~ plug - sym - %- punt - ;~(pfix fas ;~((glue fas) case ship)) - == - :: - ++ ship ;~(pfix sig fed:ag) - ++ hoof - %+ cook |=(a/^hoof a) - ;~ pose - (stag %| ;~(pfix tar hoot)) - (stag %& hoot) - == - :: - ++ hoop - ;~ pose - (stag %| ;~(pfix fas fas gap have)) - (stag %& tall:vez) - == - :: - ++ horn :: horn parser - =< apex - =| tol/? :: allow tall form - |% - ++ apex - %+ knee *^horn |. ~+ - ;~ pfix fas - ;~ pose - (stag %fssg ;~(pfix sig hoon:read)) :: /~ hoon by hand - (stag %fsbc ;~(pfix buc hoon:read)) :: /$ extra arguments - (stag %fsbr ;~(pfix bar alts:read)) :: /| or (options) - (stag %fshx ;~(pfix hax horn:read)) :: /# insert dephash - (stag %fspt ;~(pfix pat horn:read)) :: /@ insert dephash - (stag %fsts ;~(pfix tis name:read)) :: /= apply face - (stag %fsdt ;~(pfix dot list:read)) :: /. list - (stag %fscm ;~(pfix com case:read)) :: /, switch by path - (stag %fscn ;~(pfix cen horn:read)) :: /% propagate args - (stag %fspm ;~(pfix pam pipe:read)) :: /& translates - (stag %fscb ;~(pfix cab horn:read)) :: /_ homo map - (stag %fssm ;~(pfix sem gate:read)) :: /; operate on - (stag %fscl ;~(pfix col path:read)) :: /: relative to - (stag %fskt ;~(pfix ket cast:read)) :: /^ cast - (stag %fszp ;~(pfix zap ;~(sfix sym fas))):: /!mark/ run to mark - (stag %fszy ;~(sfix sym fas)) :: /mark/ render file - == - == - :: - ++ rail :: wide or tall - |* {wid/rule tal/rule} - ?. tol wid :: !tol -> only wide - ;~(pose wid tal) - :: - ++ read - |% ++ hoon - %+ rail - (ifix [sel ser] (stag %cltr (most ace wide:vez))) - ;~(pfix gap tall:vez) + :: %wris: response to %mult; many changed files :: - ++ alts - %+ rail - (ifix [pel per] (most ace horn)) - ;~(sfix (star horn) gap duz) - :: - ++ horn - %+ rail - apex(tol |) - ;~(pfix gap apex) - :: - ++ name - %+ rail - ;~(plug sym ;~(pfix tis horn)) - ;~(pfix gap ;~(plug sym horn)) - :: - ++ list - %+ rail fail - ;~(sfix (star horn) gap duz) - :: - ++ case - %+ rail fail - =- ;~(sfix (star -) gap duz) - ;~(pfix gap fas ;~(plug hith horn)) - :: - ++ pipe - %+ rail - ;~(plug (plus ;~(sfix sym pam)) horn) - =+ (cook |=(a/term [a ~]) sym) - ;~(pfix gap ;~(plug - horn)) - :: - ++ gate - %+ rail - ;~(plug ;~(sfix wide:vez sem) horn) - ;~(pfix gap ;~(plug tall:vez horn)) - :: - ++ path - %+ rail - ;~(plug ;~(sfix hive col) horn) - ;~(pfix gap ;~(plug hive horn)) - :: - ++ cast - %+ rail - ;~(plug ;~(sfix wide:vez ket) horn) - ;~(pfix gap ;~(plug tall:vez horn)) - -- - -- - -- - :: - ++ join - |= {cof/cafe for/mark kas/silk kos/silk} - ^- (bolt gage) - %. [cof kas kos] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope (make cof p) flay)) - |=({cof/cafe p/silk q/silk} (cope (make cof q) flay)) - == - |= {cof/cafe cay/cage coy/cage} ^- (bolt gage) - :: - %+ cope (fang cof for) - |= {cof/cafe pro/vase} - ?. (slab %grad p.pro) - (flaw cof leaf+"no ++grad" ~) - =+ gar=(slap pro [%limb %grad]) - ?@ q.gar - =+ too=((sand %tas) q.gar) - ?~ too (flaw cof leaf+"bad mark ++grad" ~) - (make cof %join u.too [%$ cay] [%$ coy]) - ?. (slab %form p.gar) - (flaw cof leaf+"no ++form:grad" ~) - =+ fom=((soft @tas) q:(slap gar [%limb %form])) - ?~ fom - (flaw cof leaf+"bad ++form:grad" ~) - ?. &(=(u.fom p.cay) =(u.fom p.coy)) - %+ flaw cof :_ :_ ~ - leaf+"join on data of bad marks: {(trip p.cay)} {(trip p.coy)}" - leaf+"expected mark {(trip u.fom)}" - ?: =(q.q.cay q.q.coy) - (fine cof [%& cay]) - ?. (slab %join p.gar) - (flaw cof leaf+"no ++join:grad" ~) - %+ cope - %^ maul cof - (slap (slap pro [%limb %grad]) [%limb %join]) - (slop q.cay q.coy) - |= {cof/cafe dif/vase} - ?@ q.dif - (fine cof [%& %null dif]) - (fine cof [%& u.fom (slot 3 dif)]) - == - :: - ++ mash - |= {cof/cafe for/mark mas/milk mos/milk} - ^- (bolt gage) - %. [cof r.mas r.mos] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope (make cof p) flay)) - |=({cof/cafe p/silk q/silk} (cope (make cof q) flay)) - == - |= {cof/cafe cay/cage coy/cage} ^- (bolt gage) - %+ cope (fang cof for) - |= {cof/cafe pro/vase} - ?. (slab %grad p.pro) - (flaw cof leaf+"no ++grad" ~) - =+ gar=(slap pro [%limb %grad]) - ?@ q.gar - =+ too=((sand %tas) q.gar) - ?~ too (flaw cof leaf+"bad mark ++grad" ~) - %+ make cof - `silk`[%mash u.too [p.mas q.mas [%$ cay]] [p.mos q.mos [%$ coy]]] - ?. (slab %form p.gar) - (flaw cof leaf+"no ++form:grad" ~) - =+ fom=((soft @tas) q:(slap gar [%limb %form])) - ?~ fom - (flaw cof leaf+"bad ++form:grad" ~) - ?. &(=(u.fom p.cay) =(u.fom p.coy)) - %+ flaw cof :_ :_ ~ - leaf+"mash on data of bad marks: {(trip p.cay)} {(trip p.coy)}" - leaf+"expected mark {(trip u.fom)}" - ?: =(q.q.cay q.q.coy) - (fine cof %& cay) - ?. (slab %mash p.gar) - (fine cof %& %null [%atom %n ~] ~) - %+ cope - %^ maul cof - (slap (slap pro [%limb %grad]) [%limb %mash]) - %+ slop - :(slop [[%atom %p ~] p.mas] [[%atom %tas ~] q.mas] q.cay) - :(slop [[%atom %p ~] p.mos] [[%atom %tas ~] q.mos] q.coy) - (flux |=(dif/vase [%& u.fom dif])) - == - :: - ++ kale :: mutate - |= {cof/cafe kas/silk muy/(list (pair wing silk))} - ^- (bolt gage) - %+ cope - |- ^- (bolt (list (pair wing vase))) - ?~ muy (flue cof) - %+ cope (cope (make cof q.i.muy) flay) - |= {cof/cafe cay/cage} - %+ cope ^$(muy t.muy) - |= {cof/cafe rex/(list (pair wing vase))} - (fine cof [[p.i.muy q.cay] rex]) - |= {cof/cafe yom/(list (pair wing vase))} - %+ cope (make cof kas) - %- tabl-run - |= {cof/cafe cay/cage} - %+ cope (keel cof q.cay yom) - (flux |=(vax/vase [%& p.cay vax])) - :: - ++ keel :: apply mutations - |= {cof/cafe suh/vase yom/(list (pair wing vase))} - ^- (bolt vase) - %+ cool - =< |. ^- tank - :+ %palm [" " ~ ~ ~] - ~[leaf+"ford: keel" rose+[" " ~ ~]^(murn yom +)] - |= {a/wing b/type *} ^- (unit tank) - =+ typ=(mule |.(p:(slap suh wing+a))) - ?: ?=($| -.typ) - (some (show [%c %pull] %l a)) - ?: (~(nest ut p.typ) | b) ~ - %^ some %palm ["." ~ ~ ~] - ~[(show [%c %mute] %l a) >[p.typ b]<] - %^ wrapped-slap cof - %+ slop suh - |- ^- vase - ?~ yom [[%atom %n ~] ~] - (slop q.i.yom $(yom t.yom)) - ^- hoon - :+ %cncb [%& 2]~ - =+ axe=3 - |- ^- (list (pair wing hoon)) - ?~ yom ~ - :- [p.i.yom [%$ (peg axe 2)]] - $(yom t.yom, axe (peg axe 3)) - :: - ++ lads :: possible children - |= {cof/cafe bem/beam} - ^- (bolt (map knot $~)) - %^ filter-at-beam cof bem - |= {cof/cafe dir/knot} - %+ cope (load-arch cof bem(s [dir s.bem])) - (flux |=(a/arch ?~(dir.a ~ (some ~)))) - :: - ++ laze :: find real or virtual - |= {cof/cafe bem/beam} - %^ filter-at-beam cof bem - |= {cof/cafe for/mark} - ^- (bolt (unit $~)) - ?. ((sane %tas) for) (flue cof) - =. s.bem [for s.bem] - %+ cope (load-arch cof bem) - |= {cof/cafe arc/arch} - (fine cof (bind fil.arc $~)) - :: - ++ lace :: load file - |= {cof/cafe for/mark bem/beam} - ^- (bolt vase) - %+ cool |.(leaf+"ford: load {} {<(en-beam bem)>}") - =. s.bem [for s.bem] - %+ cope (load-file cof bem) - |= {cof/cafe cay/cage} ^- (bolt vase) - ?. =(for p.cay) - (flaw cof leaf+"unexpected mark {}" ~) - (fine cof q.cay) - :: - ++ lake :: check+coerce - |= {fit/? for/mark} - |= {cof/cafe sam/vase} - ^- (bolt vase) - :: - :: don't verify the product type when using the %noun mark, since - :: that would cast to *, which would prevent the product from - :: being used as a gate or other typed structure. - ?: =(for %noun) (fine cof sam) - :: - %+ cool |.(leaf+"ford: check {<[for bek `@p`(mug q.sam)]>}") - %+ cope (fang cof for) - |= {cof/cafe tux/vase} - =+ typ=p:(slot 6 tux) - =. typ ?+(-.typ typ $face q.typ) - ?: (~(nest ut typ) | p.sam) - (fine cof typ q.sam) - ?. fit (flaw cof [%leaf "ford: invalid type: {}"]~) - ?. (slob %grab p.tux) - (flaw cof [%leaf "ford: no grab: {<[for bek]>}"]~) - =+ gab=(slap tux [%limb %grab]) - ?. (slob %noun p.gab) - (flaw cof [%leaf "ford: no noun: {<[for bek]>}"]~) - %+ cope (maul cof (slap gab [%limb %noun]) [%noun q.sam]) - |= {cof/cafe pro/vase} - ?> (~(nest ut typ) | p.pro) - ?: =(q.pro q.sam) - (fine cof typ q.pro) - (flaw cof [%leaf "ford: invalid content: {<[for bek]>}"]~) - :: - ++ normalize-beak - |= {cof/cafe bem/beam} - ^- (bolt beam) - ?: ?=($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 ud:((hard cass:clay) +.+:(need u.von))])) - :: - ++ infer-product-type - |= {cof/cafe typ/type gen/hoon} - %+ (cowl cof) (mule |.((~(play ut typ) gen))) - |=(ref/type ref) - :: - ++ filter-at-beam - |* {cof/cafe bem/beam fun/(burg knot (unit))} - %+ cope (load-arch cof bem) - |=({cof/cafe arc/arch} ((some-in-map fun) cof dir.arc)) - :: - ++ load-core - |= {cof/cafe bem/beam} ^- (bolt vase) - %+ cope (normalize-beak cof bem) - |= {cof/cafe bem/beam} - (load-with-path cof many+~ bem bem) - :: - ++ load-with-path - ~/ %load-with-path - |= {cof/cafe arg/coin bem/beam bom/beam} - %+ cope (normalize-beak cof bem) - |= {cof/cafe bem/beam} - %+ (clef %boil) (fine cof arg bem bom) - |= {cof/cafe arg/coin bem/beam bom/beam} - %+ cope (fame cof bem) - |= {cof/cafe bem/beam} - (cope (compile-to-hood cof bem) abut:(meow bom arg)) - :: - ++ load-arch - |= {cof/cafe bem/beam} - ^- (bolt arch) - =+ von=(syve [151 %noun] ~ %cy bem) - ?~ von [p=cof q=[%1 [%c %y bem ~] ~ ~]] - ?> ?=({$~ $arch ^} u.von) - =+ arc=((hard arch) q.q.u.u.von) - %+ cope (normalize-beak cof bem) - |= {cof/cafe bem/beam} - (flag bem (fine cof arc)) - :: - ++ load-file - ~/ %load-file - |= {cof/cafe bem/beam} - ^- (bolt cage) - ?: =([%ud 0] r.bem) - (flaw cof [leaf+"ford: no data: {<(en-beam bem(s ~))>}"]~) - =+ von=(syve [151 %noun] ~ %cx bem) - ?~ von - [p=cof q=[%1 [[%c %x bem ~] ~ ~]]] - ?~ u.von - (flaw cof leaf+"file not found" (smyt (en-beam bem)) ~) - (fine cof u.u.von) - :: - ++ load-time - ~/ %load-time - |= {cof/cafe bem/beam} - ^- (bolt time) - ?: =([%ud 0] r.bem) - (flaw cof [leaf+"ford: no data: {<(en-beam bem(s ~))>}"]~) - ?. =(%ud -.r.bem) - ~|(%beam-not-normalized !!) ::XX flaw? - =+ von=(syve [151 %noun] ~ %cw bem) - ?~ von - [p=cof q=[%1 [[%c %w bem ~] ~ ~]]] - ?. ?=([~ %time * @da] u.von) - (flaw cof leaf+"ford: bad-revision: {<(bind u.von head)>}" ~) - (fine cof q.q.u.u.von) - :: - ++ load-to-mark - ~/ %load-to-mark - |= {cof/cafe for/mark bem/beam} - %+ (clef %bake) (flag bem (fine cof for bem)) - |= {cof/cafe for/mark bem/beam} - ^- (bolt (unit vase)) - %+ cope (laze cof bem) - |= {cof/cafe mal/(map mark $~)} - ?: (~(has by mal) for) - (cope (lace cof for bem) (flux some)) - =+ opt=(silt (turn ~(tap by mal) head)) :: XX asymptotics - %+ cope (find-translation-path cof for opt) - |= {cof/cafe wuy/(list @tas)} - ?~ wuy (flue cof) - %+ cope - (lace cof i.wuy bem) - |= {cof/cafe hoc/vase} - (cope (run-marks cof i.wuy t.wuy hoc) (flux some)) - :: - ++ render-or-load - |= {cof/cafe for/mark arg/coin bem/beam} - ^- (bolt vase) - %+ coop - %+ cool |.(leaf+"load: attempt renderer") - (load-with-path cof arg [-.bem /[for]/ren] bem) - |= cof/cafe ^- (bolt vase) - %+ cool |.(leaf+"load: attempt mark") - %+ cope (load-to-mark cof for bem) - |= {cof/cafe vux/(unit vase)} - ?^ vux (fine cof u.vux) - (flaw cof leaf+"ford: no {} at {<(en-beam bem)>}" ~) - :: - ++ translate-mark - ~/ %translate-mark - |= {cof/cafe too/mark for/mark vax/vase} - =* translate-mark-jet . - :: ~$ translate-mark - ^- (bolt vase) - :: %+ cool |.(leaf+"ford: translate-mark {} {} {}") - ?: =(too for) (fine cof vax) - ?: |(=(%noun for) =(%$ for)) - ((lake & too) cof vax) - %+ cope (fang cof for) - |= {cof/cafe pro/vase} ^- (bolt vase) - ?: :: =< $ ~% %limb-grow translate-mark-jet ~ |. - &((slob %grow p.pro) (slob too p:(slap pro [%limb %grow]))) - :: ~$ translate-mark-grow - :: =< $ ~% %grow translate-mark-jet ~ |. - %+ cool |.(leaf+"ford: grow {} to {}") - %+ cope (keel cof pro [[%& 6]~ vax]~) - |= {cof/cafe pox/vase} - (wrapped-slap cof pox [%tsgr [%limb %grow] [%limb too]]) - %+ cope (fang cof too) - ~% %grab translate-mark-jet ~ - |= {cof/cafe pro/vase} - =+ :: =< $ ~% %limb-grab + ~ |. - ^= zat ^- (unit vase) - ?. (slob %grab p.pro) ~ - =+ gab=(slap pro [%limb %grab]) - ?. (slob for p.gab) ~ - `(slap gab [%limb for]) - ?~ zat - :: ~$ translate-mark-miss - (flaw cof [%leaf "ford: no translate-mark: {<[for too]>}"]~) - :: ~$ translate-mark-grab - ~| [%translate-mark-maul for too] - (maul cof u.zat vax) - :: - ++ translation-targets - ~/ %translation-targets - |= {cof/cafe for/mark} ^- (bolt (set @tas)) - %+ cope (coop (fang cof for) |=(cof/cafe (fine cof %void ~))) - %- flux - |= vax/vase ^- (set mark) - %- =- ~(gas in `(set mark)`-) - ?. (slob %grow p.vax) ~ - (silt (sloe p:(slap vax [%limb %grow]))) - ?. (slob %garb p.vax) ~ - =+ (slap vax [%limb %garb]) - (fall ((soft (list mark)) q) ~) - :: - ++ find-translation-path - ~/ %find-translation-path - |= {cof/cafe too/mark fro/(set mark)} - =* find-translation-path-jet . - :: ~& find-translation-path+[too=too fro=fro] - :: =- =+ (cope - (flux |=(a/(list mark) ~&(find-translation-pathed+a ~)))) - :: +< - ^- (bolt (list mark)) - =; gro/(burg (set mark) (list mark)) - %+ coop (gro cof too ~ ~) :: XX better grab layer - ~% %grab find-translation-path-jet ~ - |= cof/cafe - %+ cool |.(leaf+"cast: finding grabbable grow destinations") - %+ cope (fang cof too) - |= {cof/cafe vax/vase} ^- (bolt (list mark)) - ?. (slob %grab p.vax) (flue cof) - %+ cope - (gro cof (silt (sloe p:(slap vax [%limb %grab])))) - (flux |=(a/path (welp a /[too]))) - |= {cof/cafe tag/(set mark)} - =| $: war/(map mark (list mark)) - pax/(list mark) - won/{p/mark q/(qeu mark)} - == - %. [cof fro] - |= {cof/cafe fro/(set mark)} ^- (bolt (list mark)) - ?: (~(has in tag) p.won) - (fine cof (flop pax)) - =+ for=(skip ~(tap in fro) ~(has by war)) - =. for (sort for aor) :: XX useful? - =: q.won (~(gas to q.won) for) - war (~(gas by war) (turn for |=(mark [+< pax]))) - == - ?: =(~ q.won) - (flue cof) - =. won ~(get to q.won) - %+ cope (translation-targets cof p.won) - |= {cof/cafe fro/(set mark)} - =. pax [p.won (~(got by war) p.won)] - ^$(cof cof, fro fro) - :: - ++ run-marks - |= {cof/cafe for/mark yaw/(list mark) vax/vase} - ^- (bolt vase) - ?~ yaw (fine cof vax) - %+ cope (translate-mark cof i.yaw for vax) - |= {cof/cafe yed/vase} - ^$(cof cof, for i.yaw, yaw t.yaw, vax yed) - :: - ++ mint-cached - ~/ %mint-cached - |= {cof/cafe sut/type gen/hoon} - ^- (bolt (pair type nock)) - %+ (clef %slim) (fine cof sut gen) - |= {cof/cafe sut/type gen/hoon} - =+ puz=(mule |.((~(mint ut sut) [%noun gen]))) - ?- -.puz - $| (flaw cof p.puz) - $& (fine cof p.puz) - == - :: - ++ wrapped-slap :: slap - ~/ %wrapped-slap - |= {cof/cafe vax/vase gen/hoon} - ^- (bolt vase) - %+ cope (mint-cached cof p.vax gen) - |= {cof/cafe typ/type fol/nock} - %+ (coup cof) (mock [q.vax fol] (sloy syve)) - |=(val/* `vase`[typ val]) - :: - ++ make-with-normalized-beak :: normalize root beak - |= {cof/cafe kas/silk} - %+ cope (normalize-beak cof bek ~) - |=({cof/cafe byk/beak *} (make(bek byk) cof kas)) - :: - ++ abbrev :: shorten coin - |=(a/coin ?-(-.a $$ a, $blob a(p (mug p.a)), $many a(p (turn p.a ..$)))) - :: - ++ make :: reduce silk - |= {cof/cafe kas/silk} - :: =+ ^= pre - :: ?+ -.kas `term`-.kas - :: ^ %cell - :: $bake [-.kas p.kas (en-beam r.kas) ~(rent co (abbrev q.kas))] - :: $core [-.kas (en-beam p.kas)] - :: == - :: ~? !=(%$ pre) [dyv `term`(cat 3 %make (fil 3 dyv ' ')) pre] - :: =- ~? !=(%$ pre) [dyv `term`(cat 3 %made (fil 3 dyv ' ')) pre] - - :: - =. dyv +(dyv) :: go deeper - ^- (bolt gage) - ?- -.kas - ^ - %. [cof p.kas q.kas] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope ^$(cof cof, kas p.kas) flay)) - |=({cof/cafe p/silk q/silk} (cope ^$(cof cof, kas q.kas) flay)) - == :: XX merge %tabl - :: - |= {cof/cafe bor/cage heg/cage} ^- (bolt gage) - (faun cof (slop q.bor q.heg)) - == - :: - $$ (fine cof %& p.kas) - $alts - |- ^- (bolt gage) - ?~ p.kas (flaw cof leaf+"ford: out of options" ~) - %+ coop (cool %option ^$(cof cof, kas i.p.kas)) - |= cof/cafe ^- (bolt gage) - ^$(cof cof, p.kas t.p.kas) - :: - $bake - ^- (bolt gage) - %+ cool - |.(leaf+"ford: bake {} {<(en-beam r.kas)>} {~(rend co q.kas)}") - %+ cope (normalize-beak cof r.kas) - |= {cof/cafe bem/beam} - %+ cope (render-or-load cof p.kas q.kas bem) - |= {cof/cafe vax/vase} - (fine cof `gage`[%& p.kas vax]) - :: - $bunt - %+ cool |.(leaf+"ford: bunt {}") - %+ cope (fang cof p.kas) - |= {cof/cafe tux/vase} - =+ [typ=p val=q]:(slot 6 tux) - =. typ ?+(-.typ typ $face q.typ) - (fine cof [%& p.kas [typ val]]) - :: - $call - :: %+ cool |.(leaf+"ford: call {<`@p`(mug kas)>}") - %. [cof p.kas q.kas] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope ^$(cof cof, kas p) flay)) - |=({cof/cafe p/silk q/silk} ^$(cof cof, kas q)) - == - :: - |= {cof/cafe gat/cage sam/gage} - %. [cof sam] - %- tabl-run - |= {cof/cafe sam/cage} - (cope (maul cof q.gat q.sam) faun) - == - :: - $cast - %+ cool |.(leaf+"ford: cast {}") - %+ cope $(kas q.kas) - %- tabl-run - |= {cof/cafe cay/cage} - :: ~$ make-cast - :: ~> %live. :: ~$(make-cast-{to}--{from} ~) - :: (rap 3 %make-cast- p.kas '--' p.cay ~) - ^- (bolt gage) - %+ cool |.(leaf+"ford: casting {} to {}") - %+ cope (find-translation-path cof p.kas p.cay `~) - |= {cof/cafe wuy/(list @tas)} - %+ cope - ?~ wuy - (translate-mark cof p.kas p.cay q.cay) - (run-marks cof i.wuy t.wuy q.cay) - (flux |=(vax/vase [%& p.kas vax])) - :: - $core - %+ cool |.(leaf+"ford: core {<(en-beam p.kas)>}") - :: code runtime behaviour is frequently affected by marks - :: TODO: track this more formally - %+ flag [bek /mar] - :: until /? is in use, any hoon may implicitly depend on arvo types - %+ flag [bek /arvo/hoon] - %+ flag [bek /arvo/zuse] - (cope (load-core cof p.kas) (flux |=(a/vase [%& %core a]))) - :: - $diff - %+ cool |.(leaf+"ford: diff {<`@p`(mug p.kas)>} {<`@p`(mug q.kas)>}") - (diff cof p.kas q.kas) - :: - $dude (cool p.kas $(kas q.kas)) - $file - %+ cool |.(leaf+"ford: file {}") - %+ cope (load-file cof p.kas) - (flux |=(cay/cage [%& cay])) - :: - $flag - =+ rez=$(kas q.kas) - ?: ?=($1 -.q.rez) rez - =- rez(p.q -) - |- ^- (set beam) - ?~ p.kas p.q.rez - =. p.q.rez $(p.kas l.p.kas) - =. p.q.rez $(p.kas r.p.kas) - ?^ n.p.kas - (~(put in p.q.rez) n.p.kas) - =+ dap=(~(get by def.deh.bay) n.p.kas) - ?~ dap ~&(flag-missed+n.p.kas p.q.rez) - (~(uni in p.q.rez) u.dap) - :: XX revisit ^ during dependency review - $join - %+ cool - |. - leaf+"ford: join {} {<`@p`(mug q.kas)>} {<`@p`(mug r.kas)>}" - (join cof p.kas q.kas r.kas) - :: - $mash - %+ cool - |. - leaf+"ford: mash {} {<`@p`(mug q.kas)>} {<`@p`(mug r.kas)>}" - (mash cof p.kas q.kas r.kas) - :: - $mute (kale cof p.kas q.kas) - $pact - %+ cool |.(leaf+"ford: pact {<`@p`(mug p.kas)>} {<`@p`(mug q.kas)>}") - (pact cof p.kas q.kas) - :: - $plan (cope (abut:(meow p.kas q.kas) cof r.kas) faun) - $reef (faun cof pit) - $ride - %+ cool |.(leaf+"ford: build failed {}") - %+ cope $(kas q.kas) - %- tabl-run - |= {cof/cafe cay/cage} - %+ cope (wrapped-slap cof q.cay p.kas) - |= {cof/cafe vax/vase} - (faun cof vax) - :: - $tabl - %+ cope - |- ^- (bolt (list (pair gage gage))) - ?~ p.kas (fine cof ~) - %. [cof p.kas] - ;~ cope - ;~ coax - |=({cof/cafe _p.kas} (fret ^^$(cof cof, kas p.i))) - |=({cof/cafe _p.kas} (fret ^^$(cof cof, kas q.i))) - |=({cof/cafe _p.kas} ^$(cof cof, p.kas t)) - == - (flux |=({k/gage v/gage t/(list {gage gage})} [[k v] t])) - == - (flux |=(rex/(list (pair gage gage)) [%tabl rex])) - :: - $vale - %+ cool |.(leaf+"ford: vale {} {<`@p`(mug q.kas)>}") - %+ cope ((lake & p.kas) cof [%noun q.kas]) - (flux |=(vax/vase `gage`[%& p.kas vax])) - :: - $volt - %+ cool |.(leaf+"ford: volt {}") - %+ cope $(kas [%bunt p.p.kas]) - %- tabl-run - |= {cof/cafe cay/cage} - ^- (bolt gage) - (fine cof [%& p.p.kas p.q.cay q.p.kas]) - == - :: - ++ malt :: cached slit - ~/ %slit - |= {cof/cafe gat/type sam/type} - ^- (bolt type) - %+ (clef %slit) (fine cof gat sam) - |= {cof/cafe gat/type sam/type} - %+ cool |.(%.(%have ~(dunk ut sam))) - %+ cool |.(%.(%want ~(dunk ut (~(peek ut gat) %free 6)))) - =+ top=(mule |.((slit gat sam))) - ?- -.top - $| (flaw cof p.top) - $& (fine cof p.top) - == - :: - ++ maul :: slam - ~/ %maul - |= {cof/cafe gat/vase sam/vase} - ^- (bolt vase) - %+ cope (malt cof p.gat p.sam) - |= {cof/cafe typ/type} - %+ (coup cof) (mong [q.gat q.sam] (sloy syve)) - |=(val/* `vase`[typ val]) - :: - ++ meow :: assemble - :: =+ dyv=0 - |= {how/beam arg/coin} - =| $: rop/(map term (pair hoof hoon)) :: structures - bil/(map term (pair hoof hoon)) :: libraries - boy/(list hoon) :: body stack - lit/? :: drop arguments - == - ~% %meow ..meow ~ - |% - ++ able :: assemble preamble - ^- hoon - :+ %tsgr - ?: =(~ rop) - [%$ 1] - :+ %brcn [~ ~] - =- [[0 [~ ~] -] ~ ~] - (~(run by rop) |=({^ a/hoon} [~ %ash a])) - ?: =(~ bil) - [%$ 1] - :+ %brcn [~ ~] - =- [[0 [~ ~] -] ~ ~] - (~(run by bil) |=({^ a/hoon} [~ %ash a])) - :: - ++ abut :: generate - |= {cof/cafe hyd/hood} - ^- (bolt vase) - %+ cope (apex cof hyd) - |= {cof/cafe sel/_..abut} - =. ..abut sel - %+ cope (wrapped-slap cof pit able) - |= {cof/cafe bax/vase} - %+ cope (chap cof bax [%fsdt fan.hyd]) - |= {cof/cafe mar/mark gox/vase} - %+ cope (wrapped-slap cof (slop gox bax) [%tssg (flop boy)]) - |= {cof/cafe fin/vase} - (fine cof fin) - :: ~> %slog.[0 ~(duck ut p.q.cay)] - :: - :: ++ libs `(set term)`(silt (turn ~(tap by bil) head.is)) - ++ apex :: build to body - |= {cof/cafe hyd/hood} - ^- (bolt _..apex) - %+ cope (body cof src.hyd) - ::=. dyv +(dyv) - ::~& [`term`(cat 3 %apex (fil 4 dyv ' ')) `path`(flop s.how) libs] - ::=- ~& [`term`(cat 3 %xepa (fil 4 dyv ' ')) `path`(flop s.how)] - - |= {cof/cafe sel/_..apex} - =. ..apex sel - %+ cope (neck cof lib.hyd) - |= {cof/cafe sel/_..apex} - =. ..apex sel(boy boy) - %+ cope (head cof sur.hyd) - |= {cof/cafe sel/_..apex} - (fine cof sel) - :: - ++ body :: produce functions - |= {cof/cafe src/(list hoop)} - ^- (bolt _..body) - ?~ src (fine cof ..body) - %+ cope (wilt cof i.src) - |= {cof/cafe sel/_..body} - ^$(src t.src, ..body sel, cof cof) - :: - ++ chai :: atomic map - |= {cof/cafe bax/vase hon/horn} - ^- (bolt vase) - %+ cope - %+ cope (lads cof how) - %- some-in-map - |= {cof/cafe dir/knot} - =+ nod=(chap(s.how [dir s.how]) cof bax hon) - ?: ?=($2 -.q.nod) - (flue p.nod) - (cope nod (flux some)) - %- flux - |= doy/(map @ cage) ^- vase - ?~ doy [[%atom %n `0] 0] - %+ slop - (slop [[%atom %ta ~] p.n.doy] q.q.n.doy) - (slop $(doy l.doy) $(doy r.doy)) - :: - ++ chap :: produce resources - |= {cof/cafe bax/vase hon/horn} - ^- (bolt cage) - ?- -.hon - $fssg - (cope (wrapped-slap cof bax p.hon) (flux |=(a/vase [%noun a]))) - :: - $fsbc - %+ cope (wrapped-slap cof bax p.hon) - |= {cof/cafe gat/vase} - %+ cope (wrapped-slap cof !>(~) ((jock |) arg)) - |= {cof/cafe val/vase} - %+ cope (maul cof gat (slop !>(how) val)) - (flux |=(a/vase noun+a)) - :: - $fsbr - |- ^- (bolt cage) - ?~ p.hon (flaw cof leaf+"ford: out of options" ~) - %+ coop (cool %option ^$(cof cof, hon i.p.hon)) - |= cof/cafe ^- (bolt cage) - ^$(cof cof, p.hon t.p.hon) - :: - $fshx - =+ [dep bot]=(clad $(hon p.hon)) :: XX review - %+ cope bot - %- flux - |= {mark vax/vase} - [%noun (slop [atom+['uvH' ~] dep] vax)] - :: - $fspt - ?. ?=([$fszy @] p.hon) - (flaw cof leaf+"ford: STUB /@ only implemented for /mark/" ~) - %+ cope $(cof cof, hon p.hon) - |= {cof/cafe mark vax/vase} - %+ cope (normalize-beak cof how(s [q.p.hon s.how])) - |= {cof/cafe bem/beam} - ?> ?=(%ud -.r.bem) - %+ cope (load-arch cof bem) - |= {cof/cafe ark/arch} - ?~ fil.ark (flaw cof leaf+"ford: no file {<(tope bem)>}" ~) - =; res - =. q.res ::XX prevent infinite dependency loop - ?-(-.q.res $1 [!!], ?($0 $2) q.res(p ~)) - res - :: - |- ^- (bolt cage) ::TODO do this in clay - =/ bom bem(p.r (dec p.r.bem)) - %+ cope (load-arch cof bom) - |= {cof/cafe ork/arch} - ?: =(fil.ork fil.ark) ^$(cof cof, bem bom) - %+ cope (load-time cof bem(s ~)) - (flux |=(wen/time [%noun (slop !>(wen) vax)])) - :: - $fsts - %+ cope $(hon q.hon) - %- flux - |= {mar/mark vax/vase} - [mar [%face [~ p.hon] p.vax] q.vax] - :: - $fsdt - %+ cope - %+ cope - |- ^- (bolt (list vase)) - ?~ p.hon (flue cof) - %+ cope ^$(cof cof, hon i.p.hon) - |= {cof/cafe mar/mark vax/vase} - %+ cope ^$(cof cof, p.hon t.p.hon) - (flux |=(tev/(list vase) [vax tev])) - |= {cof/cafe tev/(list vase)} - %+ fine cof - |- ^- vase - ?~ tev [[%atom %n `~] 0] - (slop i.tev $(tev t.tev)) - (flux |=(a/vase noun+a)) - :: - $fscm - =+ opt=|.(>(turn p.hon |=({a/path ^} a))<) - |- ^- (bolt cage) - ?~ p.hon (flaw cof leaf+"ford: no match" >(en-beam how)< $:opt ~) - ?: =(p.i.p.hon (scag (lent p.i.p.hon) (flop s.how))) - ^$(hon q.i.p.hon) - $(p.hon t.p.hon) - :: - $fscn $(hon p.hon, lit |) - $fspm - %+ cope $(hon q.hon) - |= {cof/cafe cay/cage} ^- (bolt cage) - ?~ p.hon (fine cof cay) - %+ cope $(p.hon t.p.hon) - |= {cof/cafe cay/cage} - (cope (make cof %cast i.p.hon $+cay) flay) - :: - $fscb - %+ cope (chai cof bax p.hon) - (flux |=(a/vase noun+a)) - :: - $fssm - %+ cope $(hon q.hon) - |= {cof/cafe mar/mark sam/vase} - %+ cope (wrapped-slap cof bax p.hon) - |= {cof/cafe gat/vase} - %+ cope (maul cof gat sam) - (flux |=(a/vase noun+a)) - :: - $fscl - =+ vez=(vang & (en-beam how)) - =+ tuz=(posh:vez p.hon) - ?~ tuz (flaw cof leaf+"bad tusk: {}" ~) - =+ pax=(plex:vez %clsg u.tuz) - ?~ pax (flaw cof leaf+"bad path: {}" ~) - =+ bem=(de-beam u.pax) - ?~ bem (flaw cof leaf+"bad beam: {}" ~) - $(hon q.hon, how u.bem) - :: - $fskt - %+ cope $(hon q.hon) - |= {cof/cafe mar/mark vax/vase} - %+ cope (wrapped-slap cof bax [%bunt p.hon]) - |= {cof/cafe tug/vase} - ?. (~(nest ut p.tug) | p.vax) - (flaw cof [%leaf "type error: {} {}"]~) - (fine cof [mar p.tug q.vax]) - :: - $fszp - %+ cool |.(leaf+"ford: hook {} {<(en-beam how)>}") - %. [cof how] - ;~ cope - compile-to-hood - abut:(meow how arg) - (lake | q.hon) - (flux |=(a/vase [q.hon a])) - == - :: - $fszy - =? arg lit many+~ - (cope (make cof %bake q.hon arg how) flay) - == - :: - ++ head :: consume structures - |= {cof/cafe bir/(list hoof)} - ^- (bolt _..head) - ?~ bir - (fine cof ..head) - =. boy - ?: p.i.bir boy - (welp boy [[%tscm [%limb q.i.bir] [%$ 1]] ~]) - =+ byf=(~(get by rop) q.i.bir) - ?^ byf - ?. =(+:`hoof`i.bir +:`hoof`p.u.byf) - (flaw cof [%leaf "structure mismatch: {<~[p.u.byf q.i.bir]>}"]~) - $(bir t.bir) - %+ cope (fame cof (hone %sur i.bir)) - |= {cof/cafe bem/beam} - %+ cope (compile-to-hood cof bem) - |= {cof/cafe hyd/hood} - %+ cope (apex(how bem, boy ~) cof hyd) - |= {cof/cafe sel/_..head} - =. ..head - %= sel - boy boy - how how - rop %+ ~(put by (~(uni by rop) rop.sel)) - q.i.bir - [i.bir [%tssg (flop boy.sel)]] - == - ^^^$(cof cof, bir t.bir) - :: - ++ hone :: plant hoof - |= {way/@tas huf/hoof} - ^- beam - ?~ r.huf - how(s ~[q.huf way]) - [[q.u.r.huf q.how p.u.r.huf] ~[q.huf way]] - :: - ++ neck :: consume libraries - |= {cof/cafe bir/(list hoof)} - ^- (bolt _..neck) - ?~ bir (fine cof ..neck) - =. boy - ?: p.i.bir boy -:: ~& ford+tscm+[q.i.bir boy] - (welp boy [[%tscm [%limb q.i.bir] [%$ 1]] ~]) - =+ byf=(~(get by bil) q.i.bir) - ?^ byf - ?. =(+:`hoof`i.bir +:`hoof`p.u.byf) - (flaw cof [%leaf "library mismatch: {<~[p.u.byf i.bir]>}"]~) - $(bir t.bir) - %+ cope (fame cof (hone %lib i.bir)) - |= {cof/cafe bem/beam} - %+ cope (compile-to-hood cof bem) - |= {cof/cafe hyd/hood} - %+ cope (apex(how bem, boy ~) cof hyd) - |= {cof/cafe sel/_..neck} - =. ..neck - %= sel - how how - bil %+ ~(put by (~(uni by bil) bil.sel)) - q.i.bir - [i.bir [%tssg (flop boy.sel)]] - == - ^^^$(cof cof, bir t.bir) - :: - ++ wilt :: process body entry - |= {cof/cafe hop/hoop} - ^- (bolt _..wilt) - ?- -.hop - $& (fine cof ..wilt(boy [p.hop boy])) - $| - =. r.p.hop ?:(?=({$ud $0} r.p.hop) r.how r.p.hop) - %+ cool |.(leaf+"ford: wilt {<[(en-beam p.hop)]>}") - %+ cope (load-arch cof p.hop) - |= {cof/cafe arc/arch} - ?: (~(has by dir.arc) %hoon) - %+ cope (compile-to-hood cof p.hop) - |= {cof/cafe hyd/hood} - %+ cope (apex(boy ~) cof hyd) - (flux |=(sel/_..wilt sel(boy [[%tssg boy.sel] boy]))) - =+ [all=(lark (slat %tas) arc) sel=..wilt] - %+ cope - |- ^- (bolt (pair (map term (pair what foot)) _..wilt)) - ?~ all (fine cof ~ ..wilt) - %+ cope $(all l.all) - |= {cof/cafe lef/(map term (pair what foot)) sel/_..wilt} - %+ cope ^$(all r.all, cof cof, sel sel) - |= {cof/cafe rig/(map term (pair what foot)) sel/_..wilt} - %+ cope - %= ^^^^$ - cof cof - ..wilt sel(boy ~) - s.p.hop [p.n.all s.p.hop] - == - |= {cof/cafe sel/_..wilt} - %+ fine cof - :_ sel - ^- (map term (pair what foot)) - [[p.n.all [~ %ash [%tssg boy.sel]]] lef rig] - |= {cof/cafe mav/(map term (pair what foot)) sel/_..wilt} - ?~ mav - (flaw cof [%leaf "source missing: {<(en-beam p.hop)>}"]~) - (fine cof sel(boy [[%brcn [~ ~] [[0 [~ ~] mav] ~ ~]] boy])) - == - -- - :: - ++ pact-hoon :: .hoon special case - |= {a/@t b/(urge:clay cord)} ^- @t - ~| %lurk-hoon - =, format =, differ - (of-wain (lurk (to-wain a) b)) - :: - ++ pact :: patch - |= {cof/cafe kas/silk kos/silk} - ^- (bolt gage) - %. [cof kas kos] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope (make cof p) flay)) - |=({cof/cafe p/silk q/silk} (cope (make cof q) flay)) - == - |= {cof/cafe cay/cage coy/cage} ^- (bolt gage) - %+ cope (fang cof p.cay) - |= {cof/cafe pro/vase} - ?. (slab %grad p.pro) - (flaw cof leaf+"no ++grad" ~) - =+ gar=(slap pro [%limb %grad]) - ?@ q.gar - =+ for=((sand %tas) q.gar) - ?~ for (flaw cof leaf+"bad mark ++grad" ~) - (make cof `silk`[%cast p.cay %pact [%cast u.for %$ cay] %$ coy]) - ?. (slab %form p.gar) - (flaw cof leaf+"no ++form:grad" ~) - =+ for=((soft @tas) q:(slap gar [%limb %form])) - ?~ for - (flaw cof leaf+"bad ++form:grad" ~) - ?. =(u.for p.coy) - %+ flaw cof :_ ~ - =< leaf+"pact on data with wrong form: {-} {+<} {+>}" - [(trip p.cay) (trip u.for) (trip p.coy)] - ?. (slab %pact p.gar) - (flaw cof leaf+"no ++pact:grad" ~) - %+ cope (keel cof pro [[%& 6]~ q.cay]~) - |= {cof/cafe pox/vase} - %+ cope - %^ maul cof - (slap (slap pox [%limb %grad]) [%limb %pact]) - q.coy - (flux |=(pat/vase [%& p.cay pat])) - == - :: - ++ syve - ^- sley - |= {ref/* sec/(unit (set monk)) tem/term bem/beam} - ^- (unit (unit cage)) - ?> =(%151 -.ref) - %- %- lift |= (unit cage) :: ignore block - %+ biff +< - |= cay/cage ^- (unit cage) - ?. -:(nets:wa +.ref `type`p.q.cay) :: error if bad type - ~& :^ %ford-syve-lost `path`[tem (en-beam bem)] - want=;;(type +.ref) - have=p.q.cay - ~ - `cay - ^- (unit (unit cage)) - =+ (~(get by keg) tem bem) - ?^ - - (some -) - (ska +<.$) - -- - -- -:: + $: %wris + :: case: case of the new files + :: + :: %wris can only return dates to us. + :: + case=[%da p=@da] + :: care-paths: the +care:clay and +path of each file + :: + care-paths=(set [care=care:clay =path]) + == == == == -- -. == -=| axle -=* lex - -|= {now/@da eny/@ ski/sley} :: activate -^? :: opaque core -~% %ford-d ..is ~ -|% :: -++ call :: request - |= {hen/duct typ/* kyz/(hobo task:able)} - ^+ [p=*(list move) q=..^$] - =/ kis/task:able ?.(?=($soft -.kyz) kyz ((hard task:able) p.kyz)) - ?: ?=($wegh -.kis) - :_ ..^$ :_ ~ - :^ hen %give %mass - :- %ford - :- %& 0 - =+ our=p.kis - =+ ^= bay ^- baby - =+ buy=(~(get by pol.lex) our) - ?~(buy *baby u.buy) - =^ mos bay - ?- -.kis - $wipe ~&(ford-cache-wiped/at=now [~ bay(jav ~)]) - $wasp - (~(wasp za [our hen [now eny ski] ~] bay) q.kis) - $exec - ?~ q.kis - ~(exec-cancel za [our hen [now eny ski] ~] bay) - (~(exec-start za [our hen [now eny ski] ~] bay) u.q.kis) +:: +=, ford :: TODO remove once in vane +:: +|% +:: +:: +axle: overall ford state +:: ++= axle + $: :: date: date at which ford's state was updated to this data structure + :: + date=%~2018.6.28 + :: state-by-ship: storage for all the @p's this ford has been + :: + :: Once the cc-release boot sequence lands, we can remove this + :: mapping, since an arvo will not change @p identities. until + :: then, we need to support a ship booting as a comet before + :: becoming its adult identity. + :: + state-by-ship=(map ship ford-state) + == +:: +ford-state: all state that ford maintains for a @p ship identity +:: ++= ford-state + $: :: builds: per-build state machine for all builds + :: + :: Ford holds onto all in-progress builds that were either directly + :: requested by a duct (root builds) or that are dependencies + :: (sub-builds) of a directly requested build. + :: + :: It also stores the last completed version of each live build tree + :: (root build and sub-builds), and any cached builds. + :: + builds=(map build build-status) + :: ducts: per-duct state machine for all incoming ducts (build requests) + :: + :: Ford tracks every duct that has requested a build until it has + :: finished dealing with that request. + :: + :: For live ducts, we store the duct while we repeatedly run new + :: versions of the live build it requested until it is explicitly + :: canceled by the requester. + :: + :: A once (non-live) duct, on the other hand, will be removed + :: as soon as the requested build has been completed. + :: + ducts=(map duct duct-status) + :: builds-by-schematic: all attempted builds, sorted by time + :: + :: For each schematic we've attempted to build at any time, + :: list the formal dates of all build attempts, sorted newest first. + :: + builds-by-schematic=(map schematic (list @da)) + :: pending-scrys: outgoing requests for static resources + :: + pending-scrys=(request-tracker scry-request) + :: pending-subscriptions: outgoing subscriptions on live resources + :: + pending-subscriptions=(request-tracker subscription) + == +:: +build-status: current data for a build, including construction status +:: +:: +build-status stores the construction status of a build as a finite state +:: machine (:state). It stores links to dependent sub-builds in :subs, and +:: per-duct client builds in :clients. +:: ++= build-status + $: :: requesters: ducts for whom this build is the root build + :: + requesters=(set duct) + :: clients: per duct information for this build + :: + clients=(jug duct build) + :: subs: sub-builds of this build, for whom this build is a client + :: + subs=(map build build-relation) + :: state: a state machine for tracking the build's progress + :: + $= state + $% $: :: %untried: build has not been started yet + :: + %untried ~ + == + $: :: %blocked: build blocked on either sub-builds or resource + :: + :: If we're in this state and there are no blocks in :subs, + :: then we're blocked on a resource. + :: + %blocked ~ + == + $: :: %unblocked: we were blocked but now we aren't + :: + %unblocked ~ + == + $: :: %complete: build has finished running and has a result + :: + %complete + :: build-record: the product of the build, possibly tombstoned + :: + =build-record + == == == +:: +duct-status: information relating a build to a duct +:: ++= duct-status + $: :: live: whether this duct is being run live + :: + $= live + $% [%once in-progress=@da] + $: %live + :: + :: + in-progress=(unit @da) + :: the last subscription we made + :: + :: This can possibly have an empty set of resources, in which + :: we never sent a move. + :: + :: NOTE: This implies that a single live build can only depend + :: on live resources from a single disc. We don't have a + :: working plan for fixing this and will need to think very + :: hard about the future. + :: + last-sent=(unit [date=@da subscription=(unit subscription)]) + == == + :: root-schematic: the requested build for this duct + :: + root-schematic=schematic + == +:: +build-relation: how do two builds relate to each other? +:: +:: A +build-relation can be either :verified or not, and :blocked or not. +:: It is a symmetric relation between two builds, in the sense that both +:: the client and the sub will store the same relation, just pointing to +:: the other build. +:: +:: If it's not :verified, then the relation is a guess based on previous +:: builds. These guesses are used to ensure that we hold onto builds we +:: expect to be used in future builds. Each time we run +make on a build, +:: it might produce new :verified sub-builds, which may have been unverified +:: until then. Once a build completes, any unverified sub-builds must be +:: cleaned up, since it turned out they weren't used by the build after all. +:: +:: :blocked is used to note that a build can't be completed until that +:: sub-build has been completed. A relation can be :blocked but not :verified +:: if we're trying to promote a build, but we haven't run all its sub-builds +:: yet. In that case, we'll try to promote or run the sub-build in order to +:: determine whether we can promote the client. Until the sub-build has been +:: completed, the client is provisionally blocked on the sub-build. +:: ++= build-relation + $: :: verified: do we know this relation is real, or is it only a guess? + :: + verified=? + :: is this build blocked on this other build? + :: + blocked=? + == +:: +build-record: information associated with the result of a completed +build +:: ++= build-record + $% $: :: %tombstone: the build's result has been wiped + :: + %tombstone ~ + == + $: :: %value: we have the +build-result + :: + %value + :: last-accessed: last time we looked at the result + :: + :: This is used for LRU cache reclamation. + :: + last-accessed=@da + :: build-result: the stored value of the build's product + :: + =build-result + == == +:: +build: a referentially transparent request for a build +:: +:: Each unique +build will always produce the same +build-result +:: when run (if it completes). A live build consists of a sequence of +:: instances of +build with the same :schematic and increasing :date. +:: ++= build + $: :: date: the formal date of this build; unrelated to time of execution + :: + date=@da + :: schematic: the schematic that determines how to run this build + :: + =schematic + == +:: +request-tracker: generic tracker and multiplexer for pending requests +:: +++ request-tracker + |* request-type=mold + %+ map request-type + $: :: waiting: ducts blocked on this request + :: + waiting=(set duct) + :: originator: the duct that kicked off the request + :: + originator=duct + == +:: +subscription: a single subscription to changes on a set of resources +:: ++= subscription + $: :: date: date this was made + :: + date=@da + :: disc: ship and desk for all :resources + :: + =disc + :: resources: we will be notified if any of these resources change + :: + resources=(set resource) + == +:: +scry-request: parsed arguments to a scry operation +:: ++= scry-request + $: :: vane: the vane from which to make the request + :: + :: TODO: use +vane here + :: + vane=?(%c %g) + :: care: type of request + :: + care=care:clay + :: beam: request path + :: + =beam + == +:: +build-receipt: result of running +make +:: +:: A +build-receipt contains all information necessary to perform the +:: effects and state mutations indicated by a call to +make. If :build +:: succeeded, :result will be %build-result; otherwise, it will be %blocks. +:: +:: After +make runs on a batch of builds, the resulting +build-receipt's are +:: applied one at a time. +:: ++= build-receipt + $: :: build: the build we worked on + :: + =build + :: result: the outcome of this build + :: + $= result + $% :: %build-result: the build produced a result + :: + $: %build-result + =build-result + == + :: %blocks: the build blocked on the following builds or resource + :: + $: %blocks + :: builds: builds that :build blocked on + :: + builds=(list build) + :: scry-blocked: namespace request that :build blocked on + :: + scry-blocked=(unit scry-request) + == + == + :: sub-builds: subbuilds of :build + :: + :: While running +make on :build, we need to keep track of any + :: sub-builds that we try to access so we can keep track of + :: component linkages and cache access times. + :: + sub-builds=(list build) + == +:: +vane: short names for vanes +:: +:: TODO: move to zuse +:: ++= vane ?(%a %b %c %d %e %f %g) +-- +=, format +|% +:: +tear: split a +term into segments delimited by `-` +:: +++ tear + |= a=term + ^- (list term) + :: sym-no-heps: a parser for terms with no heps and a leading letter + :: + =/ sym-no-heps (cook crip ;~(plug low (star ;~(pose low nud)))) + :: + (fall (rush a (most hep sym-no-heps)) /[a]) +:: +segments: TODO rename +:: +++ segments + |= path-part=@tas + ^- (list path) + :: + =/ join |=([a=@tas b=@tas] (crip "{(trip a)}-{(trip b)}")) + :: + =/ torn=(list @tas) (tear path-part) + :: + |- ^- (list (list @tas)) + :: + ?< ?=(~ torn) + :: + ?: ?=([@ ~] torn) + ~[torn] + :: + %- zing + %+ turn $(torn t.torn) + |= s=(list @tas) + ^- (list (list @tas)) + :: + ?> ?=(^ s) + ~[[i.torn s] [(join i.torn i.s) t.s]] +:: +build-to-tape: convert :build to a printable format +:: +++ build-to-tape + |= =build + ^- tape + :: + =/ enclose |=(tape "[{+<}]") + =/ date=@da date.build + =/ =schematic schematic.build + :: + %- enclose + %+ welp (trip (scot %da date)) + %+ welp " " + :: + ?+ -.schematic + :(welp "[" (trip -.schematic) " {<`@uvI`(mug schematic)>}]") + :: + %$ + "literal" + :: + ^ + %- enclose + ;:(welp $(build [date head.schematic]) " " $(build [date tail.schematic])) + :: + %alts + ;: welp + %+ roll choices.schematic + |= [choice=^schematic txt=_"[alts"] + :(welp txt " " ^$(schematic.build choice)) + :: + "]" == - [mos ..^$(pol (~(put by pol) our bay))] + :: + %core + :(welp "[core " (spud (en-beam (rail-to-beam source-path.schematic))) "]") + :: + %hood + :(welp "[hood " (spud (en-beam (rail-to-beam source-path.schematic))) "]") + :: + %plan + :(welp "[plan " (spud (en-beam (rail-to-beam path-to-render.schematic))) "]") + :: + %scry + (spud (en-beam (extract-beam resource.schematic ~))) + :: + :: %slim + :: "slim {} {}" + :: + %vale + :(welp "[vale [" (trip (scot %p ship.disc.schematic)) " " (trip desk.disc.schematic) "] " (trip mark.schematic) "]") + == +:: +rail-to-beam :: -++ doze - |= {now/@da hen/duct} - ^- (unit @da) - ~ +++ rail-to-beam + |= =rail + ^- beam + [[ship.disc.rail desk.disc.rail [%ud 0]] spur.rail] +:: +unify-jugs: make a new jug, unifying sets for all keys :: -++ load :: highly forgiving - :: |=(old/axle ..^$(+>- old)) - ::=. old - :: ?. ?=([%0 *] old) old :: remove at 1 - :: :- %1 - :: |- ^- * - :: ?~ +.old ~ - :: ?> ?=([n=[p=* q=[tad=* dym=* deh=* jav=*]] l=* r=*] +.old) - :: :- [p.n.+.old [tad.q.n.+.old dym.q.n.+.old deh.q.n.+.old ~]] - :: [$(+.old l.+.old) $(+.old r.+.old)] - |= old/* - =+ lox=((soft axle) old) +++ unify-jugs + |* [a=(jug) b=(jug)] + ^+ a + :: + =/ tapped ~(tap by b) + :: + |- ^+ a + ?~ tapped a + :: + =/ key p.i.tapped + =/ vals ~(tap in q.i.tapped) + :: + =. a + |- ^+ a + ?~ vals a + :: + $(vals t.vals, a (~(put ju a) key i.vals)) + :: + $(tapped t.tapped) +:: +scry-request-to-path: encode a +scry-request in a +wire +:: +++ scry-request-to-path + |= =scry-request + ^- path + =/ =term (cat 3 [vane care]:scry-request) + [term (en-beam beam.scry-request)] +:: +path-to-resource: decode a +resource from a +wire +:: +++ path-to-resource + |= =path + ^- (unit resource) + :: + =/ scry-request=(unit scry-request) (path-to-scry-request path) + ?~ scry-request + ~ + =+ [vane care bem]=u.scry-request + =/ =beam bem + =/ =rail [disc=[p.beam q.beam] spur=s.beam] + `[vane care rail] +:: +path-to-scry-request: parse :path to a :scry-request +:: +++ path-to-scry-request + |= =path + ^- (unit scry-request) + :: + ?. ?=([@ @ *] path) + ~ + :: parse :path's components into :vane, :care, and :rail + :: + =/ vane=(unit ?(%c %g)) ((soft ?(%c %g)) (end 3 1 i.path)) + ?~ vane + ~ + =/ care=(unit care:clay) ((soft care:clay) (rsh 3 1 i.path)) + ?~ care + ~ + =/ rest=(unit ^path) ((soft ^path) t.path) + ?~ rest + ~ + =/ beam (de-beam u.rest) + ?~ beam + ~ + :: we only operate on dates, not other kinds of +case:clay + :: + ?. ?=(%da -.r.u.beam) + ~ + :: + `[u.vane u.care u.beam] +:: +scry-request-to-build: convert a +scry-request to a %scry build +:: +++ scry-request-to-build + |= =scry-request + ^- build + :: we only operate on dates, not other kinds of +case:clay + :: + ?> ?=(%da -.r.beam.scry-request) + :: + =, scry-request + [p.r.beam [%scry [vane care `rail`[[p q] s]:beam]]] +:: +extract-beam: obtain a +beam from a +resource +:: +:: Fills case with [%ud 0] for live resources if :date is `~`. +:: For once resources, ignore :date. +:: +++ extract-beam + |= [=resource date=(unit @da)] ^- beam + :: + =/ =case ?~(date [%ud 0] [%da u.date]) + :: + =, rail.resource + [[ship.disc desk.disc case] spur] +:: +extract-disc: obtain a +disc from a +resource +:: +++ extract-disc + |= =resource ^- disc + disc.rail.resource +:: +get-sub-schematics: find any schematics contained within :schematic +:: +++ get-sub-schematics + |= =schematic + ^- (list ^schematic) + ?- -.schematic + ^ ~[head.schematic tail.schematic] + %$ ~ + %pin ~[schematic.schematic] + %alts choices.schematic + %bake ~ + %bunt ~ + %call ~[gate.schematic sample.schematic] + %cast ~[input.schematic] + %core ~ + %diff ~[start.schematic end.schematic] + %dude ~[attempt.schematic] + %hood ~ + %join ~[first.schematic second.schematic] + %list schematics.schematic + %mash ~[schematic.first.schematic schematic.second.schematic] + %mute [subject.schematic (turn mutations.schematic tail)] + %pact ~[start.schematic diff.schematic] + %path ~ + %plan ~ + %reef ~ + %ride ~[subject.schematic] + %same ~[schematic.schematic] + %scry ~ + %slim ~ + %slit ~ + %vale ~ + %volt ~ + %walk ~ + == +:: +by-schematic: door for manipulating :by-schematic.builds.ford-state +:: +:: The :dates list for each key in :builds is sorted in reverse +:: chronological order. These operations access and mutate keys and values +:: of :builds and maintain that sort order. +:: +++ by-schematic + |_ builds=(map schematic (list @da)) + :: +put: add a +build to :builds + :: + :: If :build already exists in :builds, this is a no-op. + :: Otherwise, replace the value at the key :schematic.build + :: with a new :dates list that contains :date.build. + :: + ++ put + |= =build + ^+ builds + %+ ~(put by builds) schematic.build + :: + =/ dates (fall (~(get by builds) schematic.build) ~) + ?^ (find [date.build]~ dates) + dates + (sort [date.build dates] gte) + :: +del: remove a +build from :builds + :: + :: Removes :build from :builds by replacing the value at + :: the key :schematic.build with a new :dates list with + :: :date.build omitted. If the resulting :dates list is + :: empty, then remove the key-value pair from :builds. + :: + ++ del + |= =build + ^+ builds + =. builds %+ ~(put by builds) schematic.build + :: + ~| build+build + =/ dates (~(got by builds) schematic.build) + =/ date-index (need (find [date.build]~ dates)) + (oust [date-index 1] dates) + :: if :builds has an empty entry for :build, delete it + :: + =? builds + =(~ (~(got by builds) schematic.build)) + (~(del by builds) schematic.build) + :: + builds + :: +find-previous: find the most recent older build with :schematic.build + :: + ++ find-previous + |= =build + ^- (unit ^build) + :: + =/ dates=(list @da) (fall (~(get by builds) schematic.build) ~) + :: + |- ^- (unit ^build) + ?~ dates ~ + :: + ?: (lth i.dates date.build) + `[i.dates schematic.build] + $(dates t.dates) + :: +find-next: find the earliest build of :schematic.build later than :build + :: + ++ find-next + |= =build + ^- (unit ^build) + :: + =/ dates=(list @da) (flop (fall (~(get by builds) schematic.build) ~)) + :: + |- ^- (unit ^build) + ?~ dates ~ + :: + ?: (gth i.dates date.build) + `[i.dates schematic.build] + $(dates t.dates) + -- +:: +get-request-ducts: all ducts waiting on this request +:: +++ get-request-ducts + |* [tracker=(request-tracker) request=*] + ^- (list duct) + :: + ~(tap in waiting:(~(got by tracker) request)) +:: +put-request: associates a +duct with a request +:: +++ put-request + |* [tracker=(request-tracker) request=* =duct] + :: + %+ ~(put by tracker) request + ?~ existing=(~(get by tracker) request) + [(sy duct ~) duct] + u.existing(waiting (~(put in waiting.u.existing) duct)) +:: +del-request: remove a duct and produce the originating duct if empty +:: +++ del-request + |* [tracker=(request-tracker) request=* =duct] + ^- [(unit ^duct) _tracker] + :: remove :duct from the existing :record of this :request + :: + =/ record (~(got by tracker) request) + =. waiting.record (~(del in waiting.record) duct) + :: if no more ducts wait on :request, delete it + :: + ?^ waiting.record + [~ (~(put by tracker) request record)] + [`originator.record (~(del by tracker) request)] +:: +parse-scaffold: produces a parser for a hoon file with +crane instances +:: +:: Ford parses a superset of hoon which contains additional runes to +:: represent +crane s. This parses to a +scaffold. +:: +:: src-beam: +beam of the source file we're parsing +:: +++ parse-scaffold + |= src-beam=beam + :: + =/ hoon-parser (vang & (en-beam src-beam)) + |^ :: + %+ cook + |= a=[@ud (list ^cable) (list ^cable) (list ^crane) (list hoon)] + ^- scaffold + [[[p q] s]:src-beam a] + :: + %+ ifix [gay gay] + ;~ plug + :: parses the zuse version, eg "/? 309" + :: + ;~ pose + (ifix [;~(plug fas wut gap) gap] dem) + (easy zuse) + == + :: pareses the structures, eg "/- types" + :: + ;~ pose + (ifix [;~(plug fas hep gap) gap] (most ;~(plug com gaw) cable)) + (easy ~) + == + :: parses the libraries, eg "/+ lib1, lib2" + :: + ;~ pose + (ifix [;~(plug fas lus gap) gap] (most ;~(plug com gaw) cable)) + (easy ~) + == + :: + (star ;~(sfix crane gap)) + :: + (most gap tall:hoon-parser) + == + :: +beam: parses a hood path and converts it to a beam + :: + ++ beam + %+ sear de-beam + ;~ pfix + fas + (sear plex (stag %clsg poor)):hoon-parser + == + :: +cable: parses a +^cable, a reference to something on the filesystem + :: + :: This parses: + :: + :: `library` -> wraps `library` around the library `library` + :: `face=library` -> wraps `face` around the library `library` + :: `*library` -> exposes `library` directly to the subject + :: + ++ cable + %+ cook |=(a=^cable a) + ;~ pose + (stag ~ ;~(pfix tar sym)) + (cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym)) + (cook |=(a=term [`a a]) sym) + == + :: +crane: all runes that start with / which aren't /?, /-, /+ or //. + :: + ++ crane + =< apex + :: whether we allow tall form + =| allow-tall-form=? + :: + |% + ++ apex + %+ knee *^crane |. ~+ + ;~ pfix fas + ;~ pose + :: `/~` hoon literal + (stag %fssg ;~(pfix sig hoon)) + :: `/$` process query string + (stag %fsbc ;~(pfix buc hoon)) + :: `/|` first of many options that succeeds + (stag %fsbr ;~(pfix bar parse-alts)) + :: `/=` wrap a face around a crane + (stag %fsts ;~(pfix tis parse-face)) + :: `/.` null terminated list + (stag %fsdt ;~(pfix dot parse-list)) + :: `/,` switch by path + (stag %fscm ;~(pfix com parse-switch)) + :: `/&` pass through a series of mark + (stag %fspm ;~(pfix pam parse-pipe)) + :: `/_` run a crane on each file in the current directory + (stag %fscb ;~(pfix cab subcrane)) + :: `/;` passes date through a gate + (stag %fssm ;~(pfix sem parse-gate)) + :: `/:` evaluate at path + (stag %fscl ;~(pfix col parse-at-path)) + :: `/^` cast + (stag %fskt ;~(pfix ket parse-cast)) + :: `/!mark/ evaluate as hoon, then pass through mark + (stag %fszp ;~(pfix zap ;~(sfix sym fas))) + :: `/mark/` passes current path through :mark + (stag %fszy ;~(sfix sym fas)) + == + == + :: +parse-alts: parse a set of alternatives + :: + ++ parse-alts + %+ wide-or-tall + (ifix [pel per] (most ace subcrane)) + ;~(sfix (star subcrane) gap duz) + :: +parse-face: parse a face around a subcrane + :: + ++ parse-face + %+ wide-or-tall + ;~(plug sym ;~(pfix tis subcrane)) + ;~(pfix gap ;~(plug sym subcrane)) + :: +parse-list: parse a null terminated list of cranes + :: + ++ parse-list + %+ wide-or-tall + fail + ;~(sfix (star subcrane) gap duz) + :: +parse-switch: parses a list of [path crane] + :: + ++ parse-switch + %+ wide-or-tall + fail + =- ;~(sfix (star -) gap duz) + ;~(pfix gap fas ;~(plug static-path subcrane)) + :: +parse-pipe: parses a pipe of mark conversions + :: + ++ parse-pipe + %+ wide-or-tall + ;~(plug (plus ;~(sfix sym pam)) subcrane) + =+ (cook |=(a=term [a ~]) sym) + ;~(pfix gap ;~(plug - subcrane)) + :: +parse-gate: parses a gate applied to a crane + :: + ++ parse-gate + %+ wide-or-tall + ;~(plug ;~(sfix wide:hoon-parser sem) subcrane) + ;~(pfix gap ;~(plug tall:hoon-parser subcrane)) + :: +parse-at-path: parses a late bound bath + :: + ++ parse-at-path + %+ wide-or-tall + ;~(plug ;~(sfix late-bound-path col) subcrane) + ;~(pfix gap ;~(plug late-bound-path subcrane)) + :: +parse-cast: parses a mold and then the subcrane to apply that mold to + :: + ++ parse-cast + %+ wide-or-tall + ;~(plug ;~(sfix wide:hoon-parser ket) subcrane) + ;~(pfix gap ;~(plug tall:hoon-parser subcrane)) + :: +crane: parses a subcrane + :: + ++ subcrane + %+ wide-or-tall + apex(allow-tall-form |) + ;~(pfix gap apex) + :: +wide-or-tall: parses tall form hoon if :allow-tall-form is %.y + :: + ++ wide-or-tall + |* [wide=rule tall=rule] + ?. allow-tall-form wide + ;~(pose wide tall) + :: +hoon: parses hoon as an argument to a crane + :: + ++ hoon + %+ wide-or-tall + (ifix [sel ser] (stag %cltr (most ace wide:hoon-parser))) + ;~(pfix gap tall:hoon-parser) + -- + :: +static-path: parses a path + :: + ++ static-path + (sear plex (stag %clsg (more fas hasp))):hoon-parser + :: +late-bound-path: a path whose time varies + :: + ++ late-bound-path + ;~ pfix fas + %+ cook |=(a=truss a) + => hoon-parser + ;~ plug + (stag ~ gash) + ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~)) + == + == + -- + + +:: +per-event: per-event core +:: +++ per-event + :: moves: the moves to be sent out at the end of this event, reversed + :: + =| moves=(list move) + :: scry-results: responses to scry's to handle in this event + :: + :: If a value is `~`, the requested resource is not available. + :: Otherwise, the value will contain a +cage. + :: + =| scry-results=(map scry-request (unit cage)) + :: next-builds: builds to perform in the next iteration + :: + =| next-builds=(set build) + :: candidate-builds: builds which might go into next-builds + :: + =| candidate-builds=(set build) + :: the +per-event gate; each event will have a different sample + :: + :: Not a `|_` because of the `=/`s at the beginning. + :: Produces a core containing four public arms: + :: +start-build, +rebuild, +unblock, and +cancel. + :: + |= [[our=@p =duct now=@da scry=sley] state=ford-state] + :: + |% + ++ finalize + ^- [(list move) ford-state] + [(flop moves) state] + :: |entry-points: externally fired arms + :: + ::+| entry-points + :: + :: +start-build: perform a fresh +build, either live or once + :: + ++ start-build + |= [=build live=?] + ^- [(list move) ford-state] + :: + =< finalize + :: + =. ducts.state + %+ ~(put by ducts.state) duct + :_ schematic.build + ?: live + [%live in-progress=`date.build last-sent=~] + [%once in-progress=date.build] + :: + =. state (add-build build) + :: + =. builds.state + =< builds + %+ update-build-status build + |= =build-status + build-status(requesters (~(put in requesters.build-status) duct)) + :: + =. builds.state (add-duct-to-subs duct build) + :: + (execute-loop (sy [build ~])) + :: +rebuild: rebuild any live builds based on +resource updates + :: + ++ rebuild + |= [=subscription new-date=@da =disc care-paths=(set [care=care:clay =path])] + ^- [(list move) ford-state] + :: + =< finalize + :: + :: ~& [%rebuild subscription=subscription pending-subscriptions.state] + =. pending-subscriptions.state + +:(del-request pending-subscriptions.state subscription duct) + :: + =/ builds=(list build) + %+ turn ~(tap in care-paths) + |= [care=care:clay =path] + ^- build + :: + [new-date [%scry [%c care rail=[disc spur=(flop path)]]]] + :: + =/ duct-status (~(got by ducts.state) duct) + ?> ?=(%live -.live.duct-status) + :: sanity check; only rebuild once we've completed the previous one + :: + ?> ?=(~ in-progress.live.duct-status) + ?> ?=(^ last-sent.live.duct-status) + :: set the in-progress date for this new build + :: + =. ducts.state + %+ ~(put by ducts.state) duct + duct-status(in-progress.live `new-date) + :: + =/ old-root=build + [date.u.last-sent.live.duct-status root-schematic.duct-status] + =. state + (copy-build-tree-as-provisional old-root new-date=new-date) + :: gather all the :builds, forcing reruns + :: + =. ..execute (gather (sy builds) force=%.y) + :: rebuild resource builds at the new date + :: + (execute-loop ~) + :: +unblock: continue builds that had blocked on :resource + :: + ++ unblock + |= [=scry-request scry-result=(unit cage)] + ^- [(list move) ford-state] + :: + =< finalize + :: place :scry-result in :scry-results.per-event + :: + :: We don't want to call the actual +scry function again, + :: because we already tried that in a previous event and it + :: had no synchronous answer. This +unblock call is a result + :: of the response to the asynchronous request we made to + :: retrieve that resource from another vane. + :: + :: Instead, we'll intercept any calls to +scry by looking up + :: the arguments in :scry-results.per-event. This is ok because + :: in this function we attempt to run every +build that had + :: blocked on the resource, so the information is guaranteed + :: to be used during this event before it goes out of scope. + :: + =. scry-results (~(put by scry-results) scry-request scry-result) + :: + =. pending-scrys.state + +:(del-request pending-scrys.state scry-request duct) + :: + =/ unblocked-build=build (scry-request-to-build scry-request) + =. builds.state + =< builds + %+ update-build-status unblocked-build + |= =build-status + build-status(state [%unblocked ~]) + :: + (execute-loop (sy unblocked-build ~)) + :: +cancel: cancel a build + :: + :: When called on a live build, removes all tracking related to the live + :: build, and no more %made moves will be sent for that build. + :: + :: When called on a once build, removes all tracking related to the once + :: build, and that build will never be completed or have a %made sent. + :: + :: When called on a build that isn't registered in :state, such as a + :: completed once build, or a build that has already been canceled, + :: prints and no-ops. + :: + ++ cancel ^+ [moves state] + :: + =< finalize + :: + ?~ duct-status=(~(get by ducts.state) duct) + ~& [%no-build-for-duct duct] + ..execute + :: :duct is being canceled, so remove it unconditionally + :: + =. ducts.state (~(del by ducts.state) duct) + :: if the duct was not live, cancel any in-progress builds + :: + ?: ?=(%once -.live.u.duct-status) + :: + =/ root-build=build [in-progress.live root-schematic]:u.duct-status + :: + =. ..execute (cancel-scrys root-build) + =. state (remove-duct-from-root root-build) + ..execute + :: if the duct was live and has an unfinished build, cancel it + :: + =? ..execute ?=(^ in-progress.live.u.duct-status) + :: + =/ root-build=build [u.in-progress.live root-schematic]:u.duct-status + :: + =. ..execute (cancel-scrys root-build) + =. state (remove-duct-from-root root-build) + ..execute + :: if there is no completed build for the live duct, we're done + :: + ?~ last-sent=last-sent.live.u.duct-status + ..execute + :: there is a completed build for the live duct, so delete it + :: + =/ root-build=build [date.u.last-sent root-schematic.u.duct-status] + :: + =. state (remove-duct-from-root root-build) + :: + ?~ subscription.u.last-sent + ..execute + (cancel-clay-subscription u.subscription.u.last-sent) + :: +cancel-scrys: cancel all blocked %scry sub-builds of :root-builds + :: + ++ cancel-scrys + |= root-build=build + ^+ ..execute + :: + =/ blocked-sub-scrys ~(tap in (collect-blocked-sub-scrys root-build)) + :: + |- ^+ ..execute + ?~ blocked-sub-scrys ..execute + :: + =. ..execute (cancel-scry-request i.blocked-sub-scrys) + :: + $(blocked-sub-scrys t.blocked-sub-scrys) + :: +remove-duct-from-root: remove :duct from a build tree + :: + ++ remove-duct-from-root + |= =build + ^+ state + :: ~& [%remove-duct-from-root (build-to-tape build) duct] + :: + =. builds.state + =< builds + %+ update-build-status build + |= =build-status + build-status(requesters (~(del in requesters.build-status) duct)) + :: + =. builds.state (remove-duct-from-subs build) + :: + (cleanup build) + :: +add-ducts-to-build-subs: for each sub, add all of :build's ducts + :: + ++ add-ducts-to-build-subs + |= =build + ^+ state + :: + =/ =build-status (~(got by builds.state) build) + =/ new-ducts ~(tap in (~(put in ~(key by clients.build-status)) duct)) + =/ subs ~(tap in ~(key by subs.build-status)) + :: + =. state + |- + ^+ state + ?~ subs state + :: + =. state (add-build i.subs) + :: + $(subs t.subs) + :: + =. builds.state + |- ^+ builds.state + ?~ new-ducts builds.state + :: + =. builds.state (add-duct-to-subs i.new-ducts build) + :: + $(new-ducts t.new-ducts) + :: + state + :: +add-duct-to-subs: attach :duct to :build's descendants + :: + ++ add-duct-to-subs + |= [duct=^duct =build] + ^+ builds.state + :: + =/ =build-status (~(got by builds.state) build) + =/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) + =/ client=^build build + :: + |- ^+ builds.state + ?~ subs builds.state + :: + =/ sub-status=^build-status (~(got by builds.state) i.subs) + :: + =/ already-had-duct=? (~(has by clients.sub-status) duct) + :: + =. clients.sub-status + (~(put ju clients.sub-status) duct client) + :: + =. builds.state (~(put by builds.state) i.subs sub-status) + :: + =? builds.state !already-had-duct ^$(build i.subs) + :: + $(subs t.subs) + :: +remove-duct-from-subs: recursively remove duct from sub-builds + :: + ++ remove-duct-from-subs + |= =build + ^+ builds.state + :: ~& [%remove-duct-from-subs (build-to-tape build)] + :: + =/ =build-status (~(got by builds.state) build) + =/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) + =/ client=^build build + :: + |- ^+ builds.state + ?~ subs builds.state + :: + =/ sub-status=^build-status (~(got by builds.state) i.subs) + :: + =. clients.sub-status + (~(del ju clients.sub-status) duct client) + :: + =. builds.state (~(put by builds.state) i.subs sub-status) + :: + =? builds.state !(~(has by clients.sub-status) duct) + :: + ^$(build i.subs) + :: + $(subs t.subs) + :: +copy-build-tree-as-provisional: prepopulate new live build + :: + :: Make a provisional copy of the completed old root build tree at the + :: :new time. + :: + ++ copy-build-tree-as-provisional + |= [old-root=build new-date=@da] + ^+ state + :: + =/ old-client=build old-root + =/ new-client=build old-client(date new-date) + =. state (add-build new-client) + :: + =. builds.state + =< builds + %+ update-build-status new-client + |= =build-status + build-status(requesters (~(put in requesters.build-status) duct)) + :: + =< copy-node + :: + |% + ++ copy-node + ^+ state + :: + =/ old-build-status=build-status (~(got by builds.state) old-client) + :: + =/ old-subs=(list build) ~(tap in ~(key by subs.old-build-status)) + =/ new-subs=(list build) (turn old-subs |=(a=build a(date new-date))) + :: + =. builds.state + (add-subs-to-client new-client new-subs [verified=%.n blocked=%.y]) + :: + |- + ^+ state + ?~ old-subs + state + :: + =. state (add-client-to-sub i.old-subs) + =. state + copy-node(old-client i.old-subs, new-client i.old-subs(date new-date)) + :: + $(old-subs t.old-subs) + :: + ++ add-client-to-sub + |= old-sub=build + ^+ state + :: + =/ new-sub old-sub(date new-date) + =. state (add-build new-sub) + :: + =. builds.state + =< builds + %+ update-build-status new-sub + |= =build-status + build-status(clients (~(put ju clients.build-status) duct new-client)) + :: + state + -- + :: TODO: consolidate all these new sub/duct functions to one area. + :: + ++ add-subs-to-client + |= [new-client=build new-subs=(list build) =build-relation] + ^+ builds.state + :: + =< builds + %+ update-build-status new-client + |= =build-status + %_ build-status + subs + %- ~(gas by subs.build-status) + %+ murn new-subs + |= sub=build + ^- (unit (pair build ^build-relation)) + :: + ?^ (~(get by subs.build-status) sub) + ~ + `[sub build-relation] + == + :: |construction: arms for performing builds + :: + ::+| construction + :: + :: +execute-loop: +execute repeatedly until there's no more work to do + :: + :: TODO: This implementation is for simplicity. In the longer term, we'd + :: like to just perform a single run through +execute and set a Behn timer + :: to wake us up immediately. This has the advantage that Ford stops hard + :: blocking the main Urbit event loop, letting other work be done. + :: + ++ execute-loop + |= builds=(set build) + ^+ ..execute + :: + =. ..execute (execute builds) + :: + ?: ?& ?=(~ next-builds) + ?=(~ candidate-builds) + == + ..execute + :: + $(builds ~) + :: +execute: main recursive construction algorithm + :: + :: Performs the three step build process: First, figure out which builds + :: we're going to run this loop through the ford algorithm. Second, run + :: the gathered builds, possibly in parallel. Third, apply the +build-receipt + :: algorithms to the ford state. + :: + ++ execute + |= builds=(set build) + ^+ ..execute + :: + =. ..execute (gather builds force=%.n) + :: + =^ build-receipts ..execute run-builds + :: + (reduce build-receipts) + :: +gather: collect builds to be run in a batch + :: + :: The +gather phase is the first of the three parts of +execute. In + :: +gather, we look through each item in :candidate-builds. If we + :: should run the candidate build this cycle through the +execute loop, we + :: place it in :next-builds. +gather runs until it has no more candidates. + :: + ++ gather + |= [builds=(set build) force=?] + ^+ ..execute + :: add builds that were triggered by incoming event to the candidate list + :: + =. candidate-builds (~(uni in candidate-builds) builds) + :: + |^ ^+ ..execute + :: ~& [%candidate-builds (turn ~(tap in candidate-builds) build-to-tape)] + :: + ?: =(~ candidate-builds) + ..execute + :: + =/ next=build + ?< ?=(~ candidate-builds) + n.candidate-builds + =. candidate-builds (~(del in candidate-builds) next) + :: + $(..execute (gather-build next)) + :: +gather-build: looks at a single candidate build + :: + :: This gate inspects a single build. It might move it to :next-builds, + :: or promote it using an old build. It also might add this build's + :: sub-builds to :candidate-builds. + :: + ++ gather-build + |= =build + ^+ ..execute + :: ~& [%gather-build duct (build-to-tape build)] + ~| [%duct duct] + =/ duct-status (~(got by ducts.state) duct) + :: if we already have a result for this build, don't rerun the build + :: + =^ current-result builds.state (access-build-record build) + :: + ?: ?=([~ %value *] current-result) + (on-build-complete build) + :: place :build in :builds.state if it isn't already there + :: + =. state (add-build build) + :: ignore blocked builds + :: + =/ =build-status (~(got by builds.state) build) + ?: ?=(%blocked -.state.build-status) + =. state (add-ducts-to-build-subs build) + :: + =/ sub-scrys=(list scry-request) + ~(tap in (collect-blocked-sub-scrys build)) + :: + =. pending-scrys.state + |- ^+ pending-scrys.state + ?~ sub-scrys pending-scrys.state + :: + =. pending-scrys.state + (put-request pending-scrys.state i.sub-scrys duct) + :: + $(sub-scrys t.sub-scrys) + :: + ..execute + :: old-build: most recent previous build with :schematic.build + :: + =/ old-build=(unit ^build) + ?: ?& ?=(%live -.live.duct-status) + ?=(^ last-sent.live.duct-status) + == + :: check whether :build was run as part of the last live build tree + :: + :: TODO: cleanup docs + :: + =/ possible-build=^build + [date.u.last-sent.live.duct-status schematic.build] + ?: (~(has by builds.state) possible-build) + `possible-build + (~(find-previous by-schematic builds-by-schematic.state) build) + (~(find-previous by-schematic builds-by-schematic.state) build) + :: if no previous builds exist, we need to run :build + :: + ?~ old-build + (add-build-to-next build) + :: + =/ old-build-status=^build-status + ~| [%missing-old-build (build-to-tape u.old-build)] + ~| [%build-state (turn ~(tap in ~(key by builds.state)) build-to-tape)] + (~(got by builds.state) u.old-build) + :: selectively promote scry builds + :: + :: We can only promote a scry if it's not forced and we ran the same + :: scry schematic as a descendant of the root build schematic at the + :: last sent time for this duct. + :: + ?: ?& ?=(%scry -.schematic.build) + ?| force + ?! + ?& ?=(%live -.live.duct-status) + ?=(^ last-sent.live.duct-status) + :: + =/ subscription=(unit subscription) + subscription.u.last-sent.live.duct-status + :: + ?~ subscription + %.n + %- ~(has in resources.u.subscription) + resource.schematic.build + == == == + (add-build-to-next build) + :: if we don't have :u.old-build's result cached, we need to run :build + :: + =^ old-build-record builds.state (access-build-record u.old-build) + ?. ?=([~ %value *] old-build-record) + (add-build-to-next build) + :: + =. old-build-status (~(got by builds.state) u.old-build) + :: + =/ old-subs=(list ^build) ~(tap in ~(key by subs.old-build-status)) + =/ new-subs=(list ^build) + (turn old-subs |=(^build +<(date date.build))) + :: link sub-builds provisionally, blocking on incomplete + :: + :: We don't know that :build will end up depending on :new-subs, + :: so they're not :verified. + :: + =/ split-new-subs + %+ skid new-subs + |= sub=^build + ^- ? + :: + ?~ maybe-build-status=(~(get by builds.state) sub) + %.n + :: + ?& ?=(%complete -.state.u.maybe-build-status) + ?=(%value -.build-record.state.u.maybe-build-status) + == + :: + =/ stored-new-subs=(list ^build) -.split-new-subs + =/ un-stored-new-subs=(list ^build) +.split-new-subs + :: + =. builds.state + (add-subs-to-client build stored-new-subs [verified=%.n blocked=%.n]) + =. builds.state + (add-subs-to-client build un-stored-new-subs [verified=%.n blocked=%.y]) + :: + =. state (add-ducts-to-build-subs build) + :: + ?^ un-stored-new-subs + :: enqueue incomplete sub-builds to be promoted or run + :: + :: When not all our sub builds have results, we can't add :build to + :: :next-builds.state. Instead, put all the remaining uncached new + :: subs into :candidate-builds. + :: + :: If all of our sub-builds finish immediately (i.e. promoted) when + :: they pass through +gather-internal, they will add :build back to + :: :candidate-builds and we will run again before +execute runs + :: +make. + :: + %_ ..execute + candidate-builds + (~(gas in candidate-builds) un-stored-new-subs) + == + :: + =^ promotable builds.state (are-subs-unchanged old-subs new-subs) + ?. promotable + (add-build-to-next build) + :: + ?> =(schematic.build schematic.u.old-build) + ?> (~(has by builds.state) build) + (promote-build u.old-build date.build new-subs) + :: +are-subs-unchanged: checks sub-build equivalence, updating access time + :: + ++ are-subs-unchanged + |= [old-subs=(list build) new-subs=(list build)] + ^- [? _builds.state] + :: + ?~ old-subs + [%.y builds.state] + ?> ?=(^ new-subs) + :: + =^ old-build-record builds.state (access-build-record i.old-subs) + ?. ?=([~ %value *] old-build-record) + [%.n builds.state] + :: + =^ new-build-record builds.state (access-build-record i.new-subs) + ?. ?=([~ %value *] new-build-record) + [%.n builds.state] + :: + ?. =(build-result.u.old-build-record build-result.u.new-build-record) + [%.n builds.state] + $(new-subs t.new-subs, old-subs t.old-subs) + :: +add-build-to-next: run this build during the +make phase + :: + ++ add-build-to-next + |= =build + ..execute(next-builds (~(put in next-builds) build)) + :: +promote-build: promote result of :build to newer :date + :: + :: Also performs relevant accounting, and possibly sends %made moves. + :: + ++ promote-build + |= [old-build=build new-date=@da new-subs=(list build)] + ^+ ..execute + :: ~& [%promote-build (build-to-tape old-build) new-date] + :: grab the previous result, freshening the cache + :: + =^ old-build-record builds.state (access-build-record old-build) + :: we can only promote a cached result, not missing or a %tombstone + :: + ?> ?=([~ %value *] old-build-record) + =/ =build-result build-result.u.old-build-record + :: :new-build is :old-build at :date; promotion destination + :: + =/ new-build=build old-build(date new-date) + :: + =. builds.state =< builds + %+ update-build-status new-build + |= =build-status + ^+ build-status + :: + %_ build-status + :: verify linkages between :new-build and subs + :: + subs + :: + ^- (map build build-relation) + %- my + ^- (list (pair build build-relation)) + %+ turn new-subs + |= sub=build + :: + [sub [verified=& blocked=|]] + :: copy the old result to :new-build + :: + state + [%complete [%value last-accessed=now build-result=build-result]] + == + :: + (on-build-complete new-build) + -- + :: +run-builds: run the builds and produce +build-receipts + :: + :: Runs the builds and cleans up the build lists afterwards. + :: + :: TODO: When the vere interpreter has a parallel variant of +turn, use + :: that as each build might take a while and there are no data + :: dependencies between builds here. + :: + ++ run-builds + ^- [(list build-receipt) _..execute] + :: + =/ build-receipts=(list build-receipt) + (turn ~(tap in next-builds) make) + :: + =. next-builds ~ + [build-receipts ..execute] + :: reduce: apply +build-receipts produce from the +make phase. + :: + :: +gather produces builds to run make on. +make produces + :: +build-receipts. It is in +reduce where we take these +build-receipts and + :: apply them to ..execute. + :: + ++ reduce + |= build-receipts=(list build-receipt) + ^+ ..execute + :: sort :build-receipts so blocks are processed before completions + :: + :: It's possible for a build to block on a sub-build that was run + :: in the same batch. If that's the case, make sure we register + :: that the build blocked on the sub-build before registering the + :: completion of the sub-build. This way, when we do register the + :: completion of the sub-build, we will know which builds are blocked + :: on the sub-build, so we can enqueue those blocked clients to be + :: rerun. + :: + =. build-receipts + %+ sort build-receipts + |= [a=build-receipt b=build-receipt] + ^- ? + ?=(%blocks -.result.a) + :: + |^ ^+ ..execute + ?~ build-receipts ..execute + :: + =. ..execute (apply-build-receipt i.build-receipts) + $(build-receipts t.build-receipts) + :: +apply-build-receipt: applies a single state diff to ..execute + :: + ++ apply-build-receipt + |= made=build-receipt + ^+ ..execute + :: process :sub-builds.made + :: + =. state (track-sub-builds build.made sub-builds.made) + :: ~& [%post-track receipt=made build-state=(~(got by builds.state) build.made)] + :: + ?- -.result.made + %build-result + (apply-build-result [build build-result.result]:made) + :: + %blocks + (apply-blocks [build builds.result scry-blocked.result]:made) + == + :: +track-sub-builds: + :: + :: For every sub-build discovered while running :build, we have to make + :: sure that we track that sub-build and that it is associated with the + :: right ducts. + :: + ++ track-sub-builds + |= [client=build sub-builds=(list build)] + ^+ state + :: ~& [%track-sub-builds build=(build-to-tape client) subs=(turn sub-builds build-to-tape)] + :: mark :sub-builds as :subs in :build's +build-status + :: + =^ build-status builds.state + %+ update-build-status client + |= =build-status + %_ build-status + subs + %- ~(gas by subs.build-status) + %+ turn sub-builds + |= sub=build + :: + =/ blocked=? + ?~ sub-status=(~(get by builds.state) sub) + %.y + !?=([%complete %value *] state.u.sub-status) + :: + [sub [verified=& blocked]] + == + :: + =. state (add-ducts-to-build-subs client) + :: + |- ^+ state + ?~ sub-builds state + :: + =. builds.state + :: + =< builds + %+ update-build-status i.sub-builds + |= build-status=^build-status + %_ build-status + :: freshen :last-accessed date + :: + state + :: + ?. ?=([%complete %value *] state.build-status) + state.build-status + state.build-status(last-accessed.build-record now) + == + :: + $(sub-builds t.sub-builds) + :: +apply-build-result: apply a %build-result +build-receipt to ..execute + :: + :: Our build produced an actual result. + :: + ++ apply-build-result + |= [=build =build-result] + ^+ ..execute + :: ~& [%apply-build-result (build-to-tape build) (~(got by builds.state) build)] + :: + =^ build-status builds.state + %+ update-build-status build + |= =build-status + build-status(state [%complete [%value last-accessed=now build-result]]) + :: + (on-build-complete build) + :: +apply-blocks: apply a %blocks +build-receipt to ..execute + :: + :: :build blocked. Record information about what builds it blocked on + :: and try those blocked builds as candidates in the next pass. + :: + ++ apply-blocks + |= [=build blocks=(list build) scry-blocked=(unit scry-request)] + ^+ ..execute + :: ~& [%apply-blocks duct (build-to-tape build)] + :: if a %scry blocked, register it and maybe send an async request + :: + =? ..execute + ?=(^ scry-blocked) + (start-scry-request u.scry-blocked) + :: we must run +apply-build-receipt on :build.made before :block + :: + ?< %+ lien blocks + |= block=^build + ?~ maybe-build-status=(~(get by builds.state) block) + %.n + ?=(%complete -.state.u.maybe-build-status) + :: transition :build's state machine to the %blocked state + :: + =. builds.state + =< builds + %+ update-build-status build + |= =build-status + build-status(state [%blocked ~]) + :: enqueue :blocks to be run next + :: + =. candidate-builds (~(gas in candidate-builds) blocks) + :: + ..execute + -- + :: +make: attempt to perform :build, non-recursively + :: + :: Registers component linkages between :build and its sub-builds. + :: Attempts to perform +scry if necessary. Does not directly enqueue + :: any moves. + :: + ++ make + |= =build + ^- build-receipt + :: accessed-builds: builds accessed/depended on during this run. + :: + =| accessed-builds=(list ^build) + ~& [%turbo-make (build-to-tape build)] + :: dispatch based on the kind of +schematic in :build + :: + :: + |^ =, schematic.build + :: + ?- -.schematic.build + :: + ^ (make-autocons [head tail]) + :: + %$ (make-literal literal) + :: + %pin (make-pin date schematic) + %alts (make-alts choices ~) + %bake (make-bake renderer query-string path-to-render) + %bunt (make-bunt disc mark) + %call (make-call gate sample) + %cast (make-cast disc mark input) + %core (make-core source-path) + %diff (make-diff disc start end) + %dude (make-dude error attempt) + %hood (make-hood source-path) + %join (make-join disc mark first second) + %list (make-list schematics) + %mash (make-mash disc mark first second) + %mute (make-mute subject mutations) + %pact (make-pact disc start diff) + %path (make-path disc prefix raw-path) + %plan (make-plan path-to-render query-string scaffold) + %reef (make-reef disc) + %ride (make-ride formula subject) + %same (make-same schematic) + %scry (make-scry resource) + %slim (make-slim subject-type formula) + %slit (make-slit gate sample) + %vale (make-vale disc mark input) + %volt (make-volt disc mark input) + %walk (make-walk disc source target) + == + :: |schematic-handlers:make: implementation of the schematics + :: + :: All of these produce a value of the same type as +make itself. + :: + :: +| schematic-handlers + :: + ++ make-autocons + |= [head=schematic tail=schematic] + ^- build-receipt + :: + =/ head-build=^build [date.build head] + =/ tail-build=^build [date.build tail] + =^ head-result accessed-builds (depend-on head-build) + =^ tail-result accessed-builds (depend-on tail-build) + :: + =| blocks=(list ^build) + =? blocks ?=(~ head-result) [head-build blocks] + =? blocks ?=(~ tail-result) [tail-build blocks] + :: if either build blocked, we're not done + :: + ?^ blocks + :: + [build [%blocks blocks ~] accessed-builds] + :: + ?< ?=(~ head-result) + ?< ?=(~ tail-result) + :: + =- [build [%build-result -] accessed-builds] + `build-result`[%success u.head-result u.tail-result] + :: + ++ make-literal + |= =cage + ^- build-receipt + [build [%build-result %success %$ cage] accessed-builds] + :: + ++ make-pin + |= [date=@da =schematic] + ^- build-receipt + :: pinned-sub: sub-build with the %pin date as formal date + :: + =/ pinned-sub=^build [date schematic] + :: + =^ result accessed-builds (depend-on pinned-sub) + :: + ?~ result + [build [%blocks ~[pinned-sub] ~] accessed-builds] + :: + [build [%build-result u.result] accessed-builds] + :: + ++ make-alts + |= [choices=(list schematic) errors=(list tank)] + ^- build-receipt + :: + ?~ choices + (return-error [[%leaf "%alts: all options failed"] errors]) + :: + =/ choice=^build [date.build i.choices] + :: + =^ result accessed-builds (depend-on choice) + ?~ result + [build [%blocks ~[choice] ~] accessed-builds] + :: + ?: ?=([%error *] u.result) + :: TODO: When the type system wises up, fix this: + :: + =/ braces [[' ' ' ' ~] ['{' ~] ['}' ~]] + =/ wrapped-error=tank + [%rose braces `(list tank)`message.u.result] + =. errors (weld errors `(list tank)`[[%leaf "option"] wrapped-error ~]) + $(choices t.choices) + :: + [build [%build-result %success %alts u.result] accessed-builds] + :: + ++ make-bake + |= [renderer=term query-string=coin path-to-render=rail] + ^- build-receipt + :: path-build: find the file path for the renderer source + :: + =/ path-build=^build + [date.build [%path disc.path-to-render %ren renderer]] + :: + =^ path-result accessed-builds (depend-on path-build) + ?~ path-result + [build [%blocks [path-build]~ ~] accessed-builds] + :: + |^ ^- build-receipt + :: if there's a renderer called :renderer, use it on :path-to-render + :: + ?: ?=([~ %success %path *] path-result) + (try-renderer rail.u.path-result) + (try-mark ~) + :: try using a renderer first, falling back to marks on errors + :: + ++ try-renderer + |= =rail + :: build a +scaffold from the renderer source + :: + =/ hood-build=^build [date.build [%hood rail]] + :: + =^ hood-result accessed-builds (depend-on hood-build) + ?~ hood-result + [build [%blocks [hood-build]~ ~] accessed-builds] + :: + ?: ?=([~ %error *] hood-result) + (try-mark message.u.hood-result) + ?> ?=([~ %success %hood *] hood-result) + :: link the renderer, passing through :path-to-render and :query-string + :: + =/ plan-build=^build + :- date.build + [%plan path-to-render query-string scaffold.u.hood-result] + :: + =^ plan-result accessed-builds (depend-on plan-build) + ?~ plan-result + [build [%blocks [plan-build]~ ~] accessed-builds] + :: + ?: ?=([~ %error *] plan-result) + (try-mark message.u.plan-result) + ?> ?=([~ %success %plan *] plan-result) + :: + =/ =build-result + :: TODO: renderers returned their name as the mark in old ford + :: + :: We should rethink whether we want this to be the case going + :: forward, but for now, Eyre depends on this detail to work. + :: + [%success %bake renderer vase.u.plan-result] + :: + [build [%build-result build-result] accessed-builds] + :: + ++ try-mark + |= errors=(list tank) + :: no renderer, try mark; retrieve directory listing of :path-to-render + :: + :: There might be multiple files of different marks stored at + :: :path-to-render. Retrieve the directory listing for + :: :path-to-render, then check which of the path segments in + :: that directory are files (not just folders), then for each + :: file try to %cast its mark to the desired mark (:renderer). + :: + :: Start by retrieving the directory listing, using :toplevel-build. + :: + =/ toplevel-build=^build + [date.build [%scry %c %y path-to-render]] + :: + =^ toplevel-result accessed-builds (depend-on toplevel-build) + ?~ toplevel-result + [build [%blocks [toplevel-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %scry *] toplevel-result) + :: TODO: include :errors in the output since both failed. + :: + (wrap-error toplevel-result) + :: + =/ toplevel-arch=arch ;;(arch q.q.cage.u.toplevel-result) + :: find the :sub-path-segments that could be files + :: + :: Filter out path segments that aren't a +term, + :: since those aren't valid marks and therefore can't + :: be the last segment of a filepath in Clay. + :: + =/ sub-path-segments=(list @ta) + (skim (turn ~(tap by dir.toplevel-arch) head) (sane %tas)) + :: + =/ sub-schematics=(list [sub-path=@ta =schematic]) + %+ turn sub-path-segments + |= sub=@ta + :- sub + [%scry %c %y path-to-render(spur [sub spur.path-to-render])] + :: + =^ schematic-results accessed-builds + (perform-schematics sub-schematics %fail-on-errors *@ta) + ?: ?=([%| *] schematic-results) + :: block or error + p.schematic-results + :: marks: list of the marks of the files at :path-to-render + :: + =/ marks=(list @tas) + %+ murn p.schematic-results + |= [sub-path=@ta result=build-result] + ^- (unit @tas) + :: + ?> ?=([%success %scry *] result) + :: + =/ =arch ;;(arch q.q.cage.result) + :: if it's a directory, not a file, we can't load it + :: + ?~ fil.arch + ~ + [~ `@tas`sub-path] + :: sort marks in alphabetical order + :: + =. marks (sort marks lte) + :: try to convert files to the destination mark, in order + :: + =/ alts-build=^build + :: + :+ date.build %alts + ^= choices ^- (list schematic) + :: + %+ turn marks + |= mark=term + ^- schematic + :: + =/ file=rail path-to-render(spur [mark spur.path-to-render]) + :: + [%cast disc.file renderer [%scry %c %x file]] + :: + =^ alts-result accessed-builds (depend-on alts-build) + ?~ alts-result + [build [%blocks [alts-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %alts *] alts-result) + (wrap-error alts-result) + :: + =/ =build-result + [%success %bake (result-to-cage u.alts-result)] + :: + [build [%build-result build-result] accessed-builds] + -- + :: + ++ make-bunt + |= [=disc mark=term] + ^- build-receipt + :: resolve path of the mark definition file + :: + =/ path-build=^build [date.build [%path disc %mar mark]] + :: + =^ path-result accessed-builds (depend-on path-build) + ?~ path-result + [build [%blocks [path-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %path *] path-result) + (wrap-error path-result) + :: build the mark core from source + :: + =/ core-build=^build [date.build [%core rail.u.path-result]] + :: + =^ core-result accessed-builds (depend-on core-build) + ?~ core-result + [build [%blocks [core-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %core *] core-result) + (wrap-error core-result) + :: extract the sample from the mark core + :: + =/ mark-vase=vase vase.u.core-result + ~| %mark-vase + =+ [sample-type=p sample-value=q]:(slot 6 mark-vase) + :: if sample is wrapped in a face, unwrap it + :: + =? sample-type ?=(%face -.sample-type) q.sample-type + :: + =/ =cage [mark sample-type sample-value] + [build [%build-result %success %bunt cage] accessed-builds] + :: + ++ make-call + |= [gate=schematic sample=schematic] + ^- build-receipt + :: + =/ gate-build=^build [date.build gate] + =^ gate-result accessed-builds (depend-on gate-build) + :: + =/ sample-build=^build [date.build sample] + =^ sample-result accessed-builds (depend-on sample-build) + :: + =| blocks=(list ^build) + =? blocks ?=(~ gate-result) [[date.build gate] blocks] + =? blocks ?=(~ sample-result) [[date.build sample] blocks] + ?^ blocks + :: + [build [%blocks blocks ~] accessed-builds] + :: + ?< ?=(~ gate-result) + ?< ?=(~ sample-result) + :: + =/ gate-vase=vase q:(result-to-cage u.gate-result) + =/ sample-vase=vase q:(result-to-cage u.sample-result) + :: + :: run %slit to get the resulting type of calculating the gate + :: + =/ slit-schematic=schematic [%slit gate-vase sample-vase] + =/ slit-build=^build [date.build slit-schematic] + =^ slit-result accessed-builds (depend-on slit-build) + ?~ slit-result + [build [%blocks [date.build slit-schematic]~ ~] accessed-builds] + :: + ?. ?=([~ %success %slit *] slit-result) + (wrap-error slit-result) + :: + :: How much duplication is there going to be here between +call and + :: +ride? Right now, we're just !! on scrys, but for reals we want it to + :: do the same handling. + ?> &(?=(^ q.gate-vase) ?=(^ +.q.gate-vase)) + =/ val + (mong [q.gate-vase q.sample-vase] intercepted-scry) + :: + ?- -.val + %0 + :* build + [%build-result %success %call [type.u.slit-result p.val]] + accessed-builds + == + :: + %1 + =/ blocked-paths=(list path) ((hard (list path)) p.val) + (blocked-paths-to-receipt %call blocked-paths) + :: + %2 + (return-error [[%leaf "ford: %call failed:"] p.val]) + == + :: + ++ make-cast + |= [=disc mark=term input=schematic] + ^- build-receipt + :: + =/ input-build=^build [date.build input] + :: + =^ input-result accessed-builds (depend-on input-build) + ?~ input-result + [build [%blocks [input-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success *] input-result) + (wrap-error input-result) + :: + =/ result-cage=cage (result-to-cage u.input-result) + :: + =/ translation-path-build=^build + [date.build [%walk disc p.result-cage mark]] + =^ translation-path-result accessed-builds + (depend-on translation-path-build) + :: + ?~ translation-path-result + [build [%blocks [translation-path-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %walk *] translation-path-result) + (wrap-error translation-path-result) + :: + =/ translation-path=(list mark-action) + results.u.translation-path-result + :: + |^ ^- build-receipt + ?~ translation-path + [build [%build-result %success %cast result-cage] accessed-builds] + :: + =^ action-result accessed-builds + =, i.translation-path + ?- -.i.translation-path + %grow (run-grow source target result-cage) + %grab (run-grab source target result-cage) + == + :: + ?- -.action-result + %success + %_ $ + translation-path t.translation-path + result-cage cage.action-result + == + :: + %blocks + [build [%blocks blocks.action-result ~] accessed-builds] + :: + %error + :* build + :* %build-result %error + leaf+"ford: failed to %cast" + tang.action-result + == + accessed-builds + == + == + :: + += action-result + $% :: translation was successful and here's a cage for you + [%success =cage] + :: it was an error. sorry. + [%error =tang] + :: we block on a build + [%blocks blocks=(list ^build)] + == + :: + ++ run-grab + |= [source-mark=term target-mark=term input-cage=cage] + ^- [action-result _accessed-builds] + :: + =/ mark-path-build=^build + [date.build [%path disc %mar target-mark]] + :: + =^ mark-path-result accessed-builds + (depend-on mark-path-build) + ?~ mark-path-result + [[%blocks [mark-path-build]~] accessed-builds] + :: + ?. ?=([~ %success %path *] mark-path-result) + (cast-wrap-error mark-path-result) + :: + =/ mark-core-build=^build [date.build [%core rail.u.mark-path-result]] + :: + =^ mark-core-result accessed-builds (depend-on mark-core-build) + ?~ mark-core-result + [[%blocks ~[mark-core-build]] accessed-builds] + :: find +grab within the destination mark core + :: + =/ grab-build=^build + [date.build [%ride [%limb %grab] [%$ (result-to-cage u.mark-core-result)]]] + :: + =^ grab-result accessed-builds (depend-on grab-build) + ?~ grab-result + [[%blocks [grab-build]~] accessed-builds] + :: + ?. ?=([~ %success %ride *] grab-result) + (cast-wrap-error grab-result) + :: find an arm for the input's mark within the +grab core + :: + =/ grab-mark-build=^build + :- date.build + [%ride [%limb source-mark] [%$ %noun vase.u.grab-result]] + :: + =^ grab-mark-result accessed-builds (depend-on grab-mark-build) + ?~ grab-mark-result + [[%blocks [grab-mark-build]~] accessed-builds] + :: + ?. ?=([~ %success %ride *] grab-mark-result) + (cast-wrap-error grab-mark-result) + :: slam the +mark-name:grab gate on the result of running :input + :: + =/ call-build=^build + :- date.build + [%call gate=[%$ %noun vase.u.grab-mark-result] sample=[%$ input-cage]] + :: + =^ call-result accessed-builds (depend-on call-build) + ?~ call-result + [[%blocks [call-build]~] accessed-builds] + :: + ?. ?=([~ %success %call *] call-result) + (cast-wrap-error call-result) + :: + [[%success [mark vase.u.call-result]] accessed-builds] + :: +grow: grow from the input mark to the destination mark + :: + ++ run-grow + |= [source-mark=term target-mark=term input-cage=cage] + ^- [action-result _accessed-builds] + :: + =/ starting-mark-path-build=^build + [date.build [%path disc %mar source-mark]] + :: + =^ starting-mark-path-result accessed-builds + (depend-on starting-mark-path-build) + ?~ starting-mark-path-result + [[%blocks [starting-mark-path-build]~] accessed-builds] + :: + ?. ?=([~ %success %path *] starting-mark-path-result) + (cast-wrap-error starting-mark-path-result) + :: grow the value from the initial mark to the final mark + :: + :: Replace the input mark's sample with the input's result, + :: then fire the mark-name:grow arm to produce a result. + :: + =/ grow-build=^build + :- date.build + :+ %ride + formula=`hoon`[%tsgl [%wing ~[target-mark]] [%wing ~[%grow]]] + ^= subject + ^- schematic + :* %mute + ^- schematic + [%core rail.u.starting-mark-path-result] + ^= mutations + ^- (list [wing schematic]) + [[%& 6]~ [%$ input-cage]]~ + == + :: + =^ grow-result accessed-builds (depend-on grow-build) + ?~ grow-result + [[%blocks [grow-build]~] accessed-builds] + :: + ?. ?=([~ %success %ride *] grow-result) + (cast-wrap-error grow-result) + :: make sure the product nests in the sample of the destination mark + :: + =/ bunt-build=^build [date.build [%bunt disc target-mark]] + :: + =^ bunt-result accessed-builds (depend-on bunt-build) + ?~ bunt-result + [[%blocks [bunt-build]~] accessed-builds] + :: + ?. ?=([~ %success %bunt *] bunt-result) + (cast-wrap-error bunt-result) + :: + ?. (~(nest ut p.q.cage.u.bunt-result) | p.vase.u.grow-result) + =* src source-mark + =* dst target-mark + :_ accessed-builds + :- %error + [leaf+"ford: %cast from {} to {} failed: nest fail"]~ + :: + [[%success mark vase.u.grow-result] accessed-builds] + :: + ++ cast-wrap-error + |= result=(unit build-result) + ^- [action-result _accessed-builds] + :: + ?> ?=([~ %error *] result) + =/ message=tang + [[%leaf "ford: {<-.schematic.build>} failed: "] message.u.result] + :: + [[%error message] accessed-builds] + -- + :: + ++ make-core + |= source-path=rail + ^- build-receipt + :: convert file at :source-path to a +scaffold + :: + =/ hood-build=^build [date.build [%hood source-path]] + :: + =^ hood-result accessed-builds (depend-on hood-build) + ?~ hood-result + [build [%blocks [hood-build]~ ~] accessed-builds] + :: + ?: ?=(%error -.u.hood-result) + (wrap-error hood-result) + :: build the +scaffold into a program + :: + ?> ?=([%success %hood *] u.hood-result) + :: + =/ plan-build=^build + [date.build [%plan source-path `coin`[%many ~] scaffold.u.hood-result]] + :: + =^ plan-result accessed-builds (depend-on plan-build) + ?~ plan-result + [build [%blocks [plan-build]~ ~] accessed-builds] + :: + ?: ?=(%error -.u.plan-result) + (wrap-error plan-result) + :: + ?> ?=([%success %plan *] u.plan-result) + [build [%build-result %success %core vase.u.plan-result] accessed-builds] + :: + ++ make-diff + |= [=disc start=schematic end=schematic] + ^- build-receipt + :: run both input schematics as an autocons build + :: + =/ sub-build=^build [date.build [start end]] + :: + =^ sub-result accessed-builds (depend-on sub-build) + ?~ sub-result + [build [%blocks [sub-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success ^ ^] sub-result) + (wrap-error sub-result) + ?. ?=([%success *] head.u.sub-result) + (wrap-error `head.u.sub-result) + ?. ?=([%success *] tail.u.sub-result) + (wrap-error `tail.u.sub-result) + :: + =/ start-cage=cage (result-to-cage head.u.sub-result) + =/ end-cage=cage (result-to-cage tail.u.sub-result) + :: if the marks aren't the same, we can't diff them + :: + ?. =(p.start-cage p.end-cage) + %- return-error :_ ~ :- %leaf + "ford: %diff failed: mark mismatch: %{} / %{}" + :: if the values are the same, the diff is null + :: + ?: =(q.q.start-cage q.q.end-cage) + =/ =build-result + [%success %diff [%null [%atom %n ~] ~]] + :: + [build [%build-result build-result] accessed-builds] + :: + =/ mark-path-build=^build [date.build [%path disc %mar p.start-cage]] + :: + =^ mark-path-result accessed-builds (depend-on mark-path-build) + ?~ mark-path-result + [build [%blocks [mark-path-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %path *] mark-path-result) + (wrap-error mark-path-result) + :: + =/ mark-build=^build [date.build [%core rail.u.mark-path-result]] + :: + =^ mark-result accessed-builds (depend-on mark-build) + ?~ mark-result + [build [%blocks [mark-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %core *] mark-result) + (wrap-error mark-result) + :: + ?. (slab %grad p.vase.u.mark-result) + %- return-error :_ ~ :- %leaf + "ford: %diff failed: %{} mark has no +grad arm" + :: + =/ grad-build=^build + [date.build [%ride [%limb %grad] [%$ %noun vase.u.mark-result]]] + :: + =^ grad-result accessed-builds (depend-on grad-build) + ?~ grad-result + [build [%blocks [grad-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] grad-result) + (wrap-error grad-result) + :: if +grad produced a @tas, convert to that mark and diff those + :: + ?@ q.vase.u.grad-result + =/ mark=(unit @tas) ((sand %tas) q.vase.u.grad-result) + ?~ mark + %- return-error :_ ~ :- %leaf + "ford: %diff failed: %{} mark has invalid +grad arm" + :: + =/ diff-build=^build + :- date.build + :^ %diff + disc + [%cast disc u.mark [%$ start-cage]] + [%cast disc u.mark [%$ end-cage]] + :: + =^ diff-result accessed-builds (depend-on diff-build) + ?~ diff-result + [build [%blocks [diff-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %diff *] diff-result) + (wrap-error diff-result) + :: + =/ =build-result + [%success %diff cage.u.diff-result] + :: + [build [%build-result build-result] accessed-builds] + :: +grad produced a cell, which should be a core with a +form arm + :: + ?. (slab %form p.vase.u.grad-result) + %- return-error :_ ~ :- %leaf + "ford: %diff failed: %{} mark has no +form:grab arm" + :: the +grab core should also contain a +diff arm + :: + ?. (slab %diff p.vase.u.grad-result) + %- return-error :_ ~ :- %leaf + "ford: %diff failed: %{} mark has no +diff:grab arm" + :: + =/ diff-build=^build + :- date.build + :+ %call + :: + ^= gate + :+ %ride + :: + formula=`hoon`[%tsgl [%wing ~[%diff]] [%wing ~[%grad]]] + :: + ^= subject + :+ %mute + :: + subject=`schematic`[%$ %noun vase.u.mark-result] + :: + ^= mutations + ^- (list [wing schematic]) + [[%& 6]~ [%$ start-cage]]~ + :: + sample=`schematic`[%$ end-cage] + :: + =^ diff-result accessed-builds (depend-on diff-build) + ?~ diff-result + [build [%blocks [diff-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %call *] diff-result) + (wrap-error diff-result) + :: + =/ form-build=^build + [date.build [%ride [%limb %form] [%$ %noun vase.u.grad-result]]] + :: + =^ form-result accessed-builds (depend-on form-build) + ?~ form-result + [build [%blocks [form-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] form-result) + (wrap-error form-result) + :: + =/ mark=(unit @tas) ((soft @tas) q.vase.u.form-result) + ?~ mark + %- return-error :_ ~ :- %leaf + "ford: %diff failed: invalid +form result: {(text vase.u.form-result)}" + :: + =/ =build-result + [%success %diff [u.mark vase.u.diff-result]] + :: + [build [%build-result build-result] accessed-builds] + :: + ++ make-dude + |= [error=(trap tank) attempt=schematic] + ^- build-receipt + :: + =/ attempt-build=^build [date.build attempt] + =^ attempt-result accessed-builds (depend-on attempt-build) + ?~ attempt-result + :: + [build [%blocks ~[[date.build attempt]] ~] accessed-builds] + :: + ?. ?=([%error *] u.attempt-result) + [build [%build-result u.attempt-result] accessed-builds] + :: + (return-error [$:error message.u.attempt-result]) + :: + ++ make-hood + |= source-path=rail + ^- build-receipt + :: + =/ scry-build=^build [date.build [%scry [%c %x source-path]]] + =^ scry-result accessed-builds (depend-on scry-build) + ?~ scry-result + :: + [build [%blocks ~[scry-build] ~] accessed-builds] + :: + ?: ?=([~ %error *] scry-result) + (wrap-error scry-result) + =+ as-cage=(result-to-cage u.scry-result) + :: hoon files must be atoms to parse + :: + ?. ?=(@ q.q.as-cage) + (return-error [%leaf "ford: %hood: file not an atom"]~) + :: + =* src-beam [[ship.disc desk.disc [%ud 0]] spur]:source-path + =/ parsed + ((full (parse-scaffold src-beam)) [1 1] (trip q.q.as-cage)) + :: + ?~ q.parsed + (return-error [%leaf "syntax error: {} {}"]~) + :: + [build [%build-result %success %hood p.u.q.parsed] accessed-builds] + :: + ++ make-join + |= [disc=^disc mark=term first=schematic second=schematic] + ^- build-receipt + :: + =/ initial-build=^build + [date.build [first second] [%path disc %mar mark]] + :: + =^ initial-result accessed-builds (depend-on initial-build) + ?~ initial-result + [build [%blocks [initial-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success [%success ^ ^] %success %path *] initial-result) + (wrap-error initial-result) + ?. ?=([%success *] head.head.u.initial-result) + (wrap-error `head.head.u.initial-result) + ?. ?=([%success *] tail.head.u.initial-result) + (wrap-error `tail.head.u.initial-result) + :: + =/ first-cage=cage (result-to-cage head.head.u.initial-result) + =/ second-cage=cage (result-to-cage tail.head.u.initial-result) + =/ mark-path=rail rail.tail.u.initial-result + :: TODO: duplicate logic with +make-pact and others + :: + =/ mark-build=^build [date.build [%core mark-path]] + :: + =^ mark-result accessed-builds (depend-on mark-build) + ?~ mark-result + [build [%blocks [mark-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %core *] mark-result) + (wrap-error mark-result) + :: + =/ mark-vase=vase vase.u.mark-result + :: + ?. (slab %grad p.mark-vase) + %- return-error :_ ~ :- %leaf + "ford: %join failed: %{} mark has no +grad arm" + :: + =/ grad-build=^build + [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] + :: + =^ grad-result accessed-builds (depend-on grad-build) + ?~ grad-result + [build [%blocks [grad-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] grad-result) + (wrap-error grad-result) + :: + =/ grad-vase=vase vase.u.grad-result + :: if +grad produced a mark, delegate %join behavior to that mark + :: + ?@ q.grad-vase + :: if +grad produced a term, make sure it's a valid mark + :: + =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) + ?~ grad-mark + %- return-error :_ ~ :- %leaf + "ford: %pact failed: %{} mark invalid +grad" + :: + =/ join-build=^build + [date.build [%join disc mark [%$ first-cage] [%$ second-cage]]] + :: + =^ join-result accessed-builds (depend-on join-build) + ?~ join-result + [build [%blocks [join-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %join *] join-result) + (wrap-error join-result) + :: + [build [%build-result u.join-result] accessed-builds] + :: make sure the +grad core has a +form arm + :: + ?. (slab %form p.grad-vase) + %- return-error :_ ~ :- %leaf + "ford: %join failed: no +form:grad in %{} mark" + :: make sure the +grad core has a +join arm + :: + ?. (slab %join p.grad-vase) + %- return-error :_ ~ :- %leaf + "ford: %join failed: no +join:grad in %{} mark" + :: fire the +form:grad arm, which should produce a mark + :: + =/ form-build=^build + [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] + :: + =^ form-result accessed-builds (depend-on form-build) + ?~ form-result + [build [%blocks [form-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] form-result) + (wrap-error form-result) + :: + =/ form-mark=(unit term) ((soft @tas) q.vase.u.form-result) + ?~ form-mark + %- return-error :_ ~ :- %leaf + "ford: %join failed: %{} mark invalid +form:grad" + :: the mark produced by +form:grad should match both diffs + :: + ?. &(=(u.form-mark p.first-cage) =(u.form-mark p.second-cage)) + %- return-error :_ ~ :- %leaf + "ford: %join failed: mark mismatch" + :: if the diffs are identical, just produce the first + :: + ?: =(q.q.first-cage q.q.second-cage) + [build [%build-result %success %join first-cage] accessed-builds] + :: call the +join:grad gate on the two diffs + :: + =/ diff-build=^build + :- date.build + :+ %call + :+ %ride + [%limb %join] + [%$ %noun grad-vase] + [%$ %noun (slop q.first-cage q.second-cage)] + :: + =^ diff-result accessed-builds (depend-on diff-build) + ?~ diff-result + [build [%blocks [diff-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %call *] diff-result) + (wrap-error diff-result) + :: the result was a unit; if `~`, use %null mark; otherwise grab tail + :: + =/ =build-result + :+ %success %join + ?@ q.vase.u.diff-result + [%null vase.u.diff-result] + [u.form-mark (slot 3 vase.u.diff-result)] + :: + [build [%build-result build-result] accessed-builds] + :: + ++ make-list + |= schematics=(list schematic) + ^- build-receipt + :: + =/ key-and-schematics + (turn schematics |=(=schematic [~ schematic])) + :: depend on builds of each schematic + :: + =^ schematic-results accessed-builds + (perform-schematics key-and-schematics %ignore-errors *~) + ?: ?=([%| *] schematic-results) + :: block or error + p.schematic-results + :: return all builds + :: + =/ =build-result + :+ %success %list + :: the roll above implicitly flopped the results + :: + (flop (turn p.schematic-results tail)) + [build [%build-result build-result] accessed-builds] + :: + ++ make-mash + |= $: disc=^disc + mark=term + first=[disc=^disc mark=term =schematic] + second=[disc=^disc mark=term =schematic] + == + ^- build-receipt + :: + =/ initial-build=^build + [date.build [schematic.first schematic.second] [%path disc %mar mark]] + :: + =^ initial-result accessed-builds (depend-on initial-build) + ?~ initial-result + [build [%blocks [initial-build]~ ~] accessed-builds] + :: TODO: duplicate logic with +make-join + :: + ?. ?=([~ %success [%success ^ ^] %success %path *] initial-result) + (wrap-error initial-result) + ?. ?=([%success *] head.head.u.initial-result) + (wrap-error `head.head.u.initial-result) + ?. ?=([%success *] tail.head.u.initial-result) + (wrap-error `tail.head.u.initial-result) + :: + =/ first-cage=cage (result-to-cage head.head.u.initial-result) + =/ second-cage=cage (result-to-cage tail.head.u.initial-result) + =/ mark-path=rail rail.tail.u.initial-result + :: TODO: duplicate logic with +make-pact and others + :: + =/ mark-build=^build [date.build [%core mark-path]] + :: + =^ mark-result accessed-builds (depend-on mark-build) + ?~ mark-result + [build [%blocks [mark-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %core *] mark-result) + (wrap-error mark-result) + :: + =/ mark-vase=vase vase.u.mark-result + :: + ?. (slab %grad p.mark-vase) + %- return-error :_ ~ :- %leaf + "ford: %mash failed: %{} mark has no +grad arm" + :: + =/ grad-build=^build + [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] + :: + =^ grad-result accessed-builds (depend-on grad-build) + ?~ grad-result + [build [%blocks [grad-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] grad-result) + (wrap-error grad-result) + :: + =/ grad-vase=vase vase.u.grad-result + :: if +grad produced a mark, delegate %mash behavior to that mark + :: + ?@ q.grad-vase + :: if +grad produced a term, make sure it's a valid mark + :: + =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) + ?~ grad-mark + %- return-error :_ ~ :- %leaf + "ford: %mash failed: %{} mark invalid +grad" + :: + =/ mash-build=^build + :- date.build + :- %mash + :^ disc u.grad-mark + [disc.first mark.first [%$ first-cage]] + [disc.second mark.second [%$ second-cage]] + :: + =^ mash-result accessed-builds (depend-on mash-build) + ?~ mash-result + [build [%blocks [mash-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %mash *] mash-result) + (wrap-error mash-result) + :: + =/ =build-result + [%success %mash cage.u.mash-result] + :: + [build [%build-result build-result] accessed-builds] + :: + ?. (slab %form p.grad-vase) + %- return-error :_ ~ :- %leaf + "ford: %mash failed: %{} mark has no +form:grad" + :: + ?. (slab %mash p.grad-vase) + %- return-error :_ ~ :- %leaf + "ford: %mash failed: %{} mark has no +mash:grad" + :: + =/ form-build=^build + [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] + :: + =^ form-result accessed-builds (depend-on form-build) + ?~ form-result + [build [%blocks [form-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] form-result) + (wrap-error form-result) + :: + =/ form-mark=(unit term) ((soft @tas) q.vase.u.form-result) + ?~ form-mark + %- return-error :_ ~ :- %leaf + "ford: %mash failed: %{} mark invalid +form:grad" + :: + ?. &(=(u.form-mark p.first-cage) =(u.form-mark p.second-cage)) + %- return-error :_ ~ :- %leaf + "ford: %mash failed: mark mismatch" + :: + ?: =(q.q.first-cage q.q.second-cage) + =/ =build-result + [%success %mash [%null [%atom %n ~] ~]] + :: + [build [%build-result build-result] accessed-builds] + :: call the +mash:grad gate on two [ship desk diff] triples + :: + =/ mash-build=^build + :- date.build + :+ %call + :+ %ride + [%limb %mash] + [%$ %noun grad-vase] + :+ %$ %noun + %+ slop + ;: slop + [[%atom %p ~] ship.disc.first] + [[%atom %tas ~] desk.disc.first] + q.first-cage + == + ;: slop + [[%atom %p ~] ship.disc.second] + [[%atom %tas ~] desk.disc.second] + q.second-cage + == + :: + =^ mash-result accessed-builds (depend-on mash-build) + ?~ mash-result + [build [%blocks [mash-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %call *] mash-result) + (wrap-error mash-result) + :: + =/ =build-result + [%success %mash [u.form-mark vase.u.mash-result]] + :: + [build [%build-result build-result] accessed-builds] + :: + ++ make-mute + |= [subject=schematic mutations=(list [=wing =schematic])] + ^- build-receipt + :: run the subject build to produce the noun to be mutated + :: + =/ subject-build=^build [date.build subject] + =^ subject-result accessed-builds (depend-on subject-build) + ?~ subject-result + [build [%blocks [subject-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success *] subject-result) + (wrap-error subject-result) + :: + =/ subject-cage=cage (result-to-cage u.subject-result) + :: + =/ subject-vase=vase q.subject-cage + :: + =^ schematic-results accessed-builds + (perform-schematics mutations %fail-on-errors *wing) + ?: ?=([%| *] schematic-results) + :: block or error + p.schematic-results + :: all builds succeeded; retrieve vases from results + :: + =/ successes=(list [=wing =vase]) + %+ turn p.schematic-results + |= [=wing result=build-result] + ^- [^wing vase] + :: + ?> ?=([%success *] result) + :: + [wing q:(result-to-cage result)] + :: create and run a +build to apply all mutations in order + :: + =/ ride-build=^build + :- date.build + :+ %ride + :: formula: a `%_` +hoon that applies a list of mutations + :: + :: The hoon ends up looking like: + :: ``` + :: %_ +2 + :: wing-1 +6 + :: wing-2 +14 + :: ... + :: == + :: ``` + :: + ^= formula + ^- hoon + :+ %cncb [%& 2]~ + =/ axis 3 + :: + |- ^- (list [wing hoon]) + ?~ successes ~ + :: + :- [wing.i.successes [%$ (peg axis 2)]] + $(successes t.successes, axis (peg axis 3)) + :: subject: list of :subject-vase and mutations, as literal schematic + :: + :: The subject ends up as a vase of something like this: + :: ``` + :: :~ original-subject + :: mutant-1 + :: mutant-2 + :: ... + :: == + :: ``` + :: + ^= subject ^- schematic + :+ %$ %noun + ^- vase + %+ slop subject-vase + |- ^- vase + ?~ successes [[%atom %n ~] ~] + :: + (slop vase.i.successes $(successes t.successes)) + :: + =^ ride-result accessed-builds (depend-on ride-build) + ?~ ride-result + [build [%blocks [ride-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] ride-result) + (wrap-error ride-result) + :: + =/ =build-result + [%success %mute p.subject-cage vase.u.ride-result] + :: + [build [%build-result build-result] accessed-builds] + :: + ++ make-pact + |= [disc=^disc start=schematic diff=schematic] + ^- build-receipt + :: first, build the inputs + :: + =/ initial-build=^build [date.build start diff] + :: + =^ initial-result accessed-builds (depend-on initial-build) + ?~ initial-result + [build [%blocks [initial-build]~ ~] accessed-builds] + :: + ?> ?=([~ %success ^ ^] initial-result) + =/ start-result=build-result head.u.initial-result + =/ diff-result=build-result tail.u.initial-result + :: + ?. ?=(%success -.start-result) + (wrap-error `start-result) + ?. ?=(%success -.diff-result) + (wrap-error `diff-result) + :: + =/ start-cage=cage (result-to-cage start-result) + =/ diff-cage=cage (result-to-cage diff-result) + :: + =/ start-mark=term p.start-cage + =/ diff-mark=term p.diff-cage + :: load the starting mark from the filesystem + :: + =/ mark-path-build=^build [date.build [%path disc %mar start-mark]] + :: + =^ mark-path-result accessed-builds + (depend-on mark-path-build) + :: + ?~ mark-path-result + [build [%blocks [mark-path-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %path *] mark-path-result) + (wrap-error mark-path-result) + :: + =/ mark-build=^build [date.build [%core rail.u.mark-path-result]] + :: + =^ mark-result accessed-builds (depend-on mark-build) + ?~ mark-result + [build [%blocks [mark-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %core *] mark-result) + (wrap-error mark-result) + :: + =/ mark-vase=vase vase.u.mark-result + :: fire the +grad arm of the mark core + :: + ?. (slab %grad p.mark-vase) + %- return-error :_ ~ :- %leaf + "ford: %pact failed: %{} mark has no +grad arm" + :: + =/ grad-build=^build + [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] + :: + =^ grad-result accessed-builds (depend-on grad-build) + ?~ grad-result + [build [%blocks [grad-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] grad-result) + (wrap-error grad-result) + :: + =/ grad-vase=vase vase.u.grad-result + :: +grad can produce a term or a core + :: + :: If a mark's +grad arm produces a mark (as a +term), + :: it means we should use that mark's machinery to run %pact. + :: In this way, a mark can delegate its patching machinery to + :: another mark. + :: + :: First we cast :start-cage to the +grad mark, then we run + :: a new %pact build on the result of that, which will use the + :: +grad mark's +grad arm. Finally we cast the %pact result back to + :: :start-mark, since we're trying to produce a patched version of + :: the initial marked value (:start-cage). + :: + ?@ q.grad-vase + :: if +grad produced a term, make sure it's a valid mark + :: + =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) + ?~ grad-mark + %- return-error :_ ~ :- %leaf + "ford: %pact failed: %{} mark invalid +grad" + :: cast :start-cage to :grad-mark, %pact that, then cast back to start + :: + =/ cast-build=^build + :- date.build + :^ %cast disc start-mark + :^ %pact disc + :^ %cast disc u.grad-mark + [%$ start-cage] + [%$ diff-cage] + :: + =^ cast-result accessed-builds (depend-on cast-build) + ?~ cast-result + [build [%blocks [cast-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %cast *] cast-result) + (wrap-error cast-result) + :: + =/ =build-result + [%success %pact cage.u.cast-result] + :: + [build [%build-result build-result] accessed-builds] + :: +grad produced a core; make sure it has a +form arm + :: + :: +grad can produce a core containing +pact and +form + :: arms. +form:grad, which produces a mark (as a term), is used + :: to verify that the diff is of the correct mark. + :: + :: +pact:grad produces a gate that gets slammed with the diff + :: as its sample and produces a mutant version of :start-cage + :: by applying the diff. + :: + ?. (slab %form p.grad-vase) + %- return-error :_ ~ :- %leaf + "ford: %pact failed: no +form:grad in %{} mark" + :: we also need a +pact arm in the +grad core + :: + ?. (slab %pact p.grad-vase) + %- return-error :_ ~ :- %leaf + "ford: %pact failed: no +pact:grad in %{} mark" + :: fire the +form arm in the core produced by +grad + :: + =/ form-build=^build + [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] + :: + =^ form-result accessed-builds (depend-on form-build) + ?~ form-result + [build [%blocks [form-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] form-result) + (wrap-error form-result) + :: +form:grad should produce a mark + :: + =/ form-mark=(unit @tas) ((soft @tas) q.vase.u.form-result) + ?~ form-mark + %- return-error :_ ~ :- %leaf + "ford: %pact failed: %{} mark invalid +form:grad" + :: mark produced by +form:grad needs to match the mark of the diff + :: + ?. =(u.form-mark diff-mark) + %- return-error :_ ~ :- %leaf + "ford: %pact failed: %{} mark invalid +form:grad" + :: call +pact:grad on the diff + :: + =/ pact-build=^build + :- date.build + :+ %call + ^- schematic + :+ %ride + [%tsgl [%limb %pact] [%limb %grad]] + ^- schematic + :+ %mute + ^- schematic + [%$ %noun mark-vase] + ^- (list [wing schematic]) + [[%& 6]~ [%$ start-cage]]~ + ^- schematic + [%$ diff-cage] + :: + =^ pact-result accessed-builds (depend-on pact-build) + ?~ pact-result + [build [%blocks [pact-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %call *] pact-result) + (wrap-error pact-result) + :: + =/ =build-result + [%success %pact start-mark vase.u.pact-result] + :: + [build [%build-result build-result] accessed-builds] + :: + ++ make-path + |= [disc=^disc prefix=@tas raw-path=@tas] + ^- build-receipt + :: possible-spurs: flopped paths to which :raw-path could resolve + :: + =/ possible-spurs=(list spur) (turn (segments raw-path) flop) + :: rails-and-schematics: scrys to check each path in :possible-paths + :: + =/ rails-and-schematics=(list [=rail =schematic]) + %+ turn possible-spurs + |= possible-spur=spur + ^- [rail schematic] + :: full-spur: wrap :possible-spur with :prefix and /hoon suffix + :: + =/ full-spur=spur :(welp /hoon possible-spur /[prefix]) + :: + :- [disc full-spur] + [%scry %c %x `rail`[disc full-spur]] + :: depend on builds of each schematic + :: + =^ schematic-results accessed-builds + (perform-schematics rails-and-schematics %filter-errors *rail) + ?: ?=([%| *] schematic-results) + :: block or error + p.schematic-results + :: matches: builds that completed with a successful result + :: + =/ matches p.schematic-results + :: if no matches, error out + :: + ?~ matches + =/ =beam + [[ship.disc desk.disc [%da date.build]] /hoon/[raw-path]/[prefix]] + :: + (return-error [%leaf "%path: no matches for {<(en-beam beam)>}"]~) + :: if exactly one path matches, succeed with the matching path + :: + ?: ?=([* ~] matches) + [build [%build-result %success %path key.i.matches] accessed-builds] + :: multiple paths matched; error out + :: + %- return-error + :: + :- [%leaf "multiple matches for %path: "] + :: tmi; cast :matches back to +list + :: + %+ roll `_p.schematic-results`matches + |= [[key=rail result=build-result] message=tang] + ^- tang + :: beam: reconstruct request from :kid's schematic and date + :: + =/ =beam [[ship.disc desk.disc [%da date.build]] spur.key] + :: + [[%leaf "{<(en-beam beam)>}"] message] + :: + ++ make-plan + |= [path-to-render=rail query-string=coin =scaffold] + ^- build-receipt + :: TODO: support query-string + :: + :: blocks: accumulator for blocked sub-builds + :: + =| blocks=(list ^build) + :: error-message: accumulator for failed sub-builds + :: + =| error-message=tang + :: + |^ :: imports: structure and library +cables, with %sur/%lib prefixes + :: + =/ imports=(list [prefix=?(%sur %lib) =cable]) + %+ welp + (turn structures.scaffold |=(cable [%sur +<])) + (turn libraries.scaffold |=(cable [%lib +<])) + :: path-builds: %path sub-builds to resolve import paths + :: + =/ path-builds (gather-path-builds imports) + :: + =^ path-results ..$ (resolve-builds path-builds) + ?^ blocks + [build [%blocks blocks ~] accessed-builds] + :: + ?^ error-message + (return-error error-message) + :: tmi; remove type specializations + :: + => .(blocks *(list ^build), error-message *tang) + :: core-builds: %core sub-builds to produce library vases + :: + =/ core-builds (gather-core-builds path-results) + :: + =^ core-results ..$ (resolve-builds core-builds) + ?^ blocks + [build [%blocks blocks ~] accessed-builds] + :: + ?^ error-message + (return-error error-message) + :: reef-build: %reef build to produce standard library + :: + =/ reef-build=^build [date.build [%reef disc.path-to-render]] + :: + =^ reef-result accessed-builds (depend-on reef-build) + ?~ reef-result + [build [%blocks [reef-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %reef *] reef-result) + (wrap-error reef-result) + :: subject: tuple of imports and standard library + :: + =/ subject=vase + (link-imports imports vase.u.reef-result core-results) + :: tmi; remove type specializations + :: + => .(blocks *(list ^build), error-message *tang) + :: iterate over each crane + :: + =^ crane-result ..$ + (compose-cranes [%noun subject] cranes.scaffold) + ?: ?=(%error -.crane-result) + (return-error message.crane-result) + ?: ?=(%block -.crane-result) + [build [%blocks builds.crane-result ~] accessed-builds] + :: combined-hoon: source hoons condensed into a single +hoon + :: + =/ combined-hoon=hoon [%tssg sources.scaffold] + :: compile :combined-hoon against :subject + :: + =/ compile=^build + [date.build [%ride combined-hoon [%$ subject.crane-result]]] + :: + =^ compiled accessed-builds (depend-on compile) + :: compilation blocked; produce block on sub-build + :: + ?~ compiled + [build [%blocks ~[compile] ~] accessed-builds] + :: compilation failed; error out + :: + ?. ?=([~ %success %ride *] compiled) + (wrap-error compiled) + :: compilation succeeded: produce resulting +vase + :: + [build [%build-result %success %plan vase.u.compiled] accessed-builds] + :: +compose-result: the result of a single composition + :: + += compose-result + $% [%subject subject=cage] + [%block builds=(list ^build)] + [%error message=tang] + == + :: +compose-cranes: runs each crane and composes the results + :: + :: For each crane in :cranes, runs it and composes its result into a + :: new subject, which is returned if there are no errors or blocks. + :: + ++ compose-cranes + |= [subject=cage cranes=(list crane)] + ^- $: compose-result + _..compose-cranes + == + :: + ?~ cranes + [[%subject subject] ..compose-cranes] + :: + =^ result ..compose-cranes (run-crane subject i.cranes) + ?+ -.result [result ..compose-cranes] + :: + %subject + $(cranes t.cranes, subject [%noun (slop q.subject.result q.subject)]) + == + :: +run-crane: runs an individual :crane against :subject + :: + ++ run-crane + |= [subject=cage =crane] + ^- compose-cranes + :: + |^ ?- -.crane + %fssg (run-fssg +.crane) + %fsbc (run-fsbc +.crane) + %fsbr (run-fsbr +.crane) + %fsts (run-fsts +.crane) + %fscm (run-fscm +.crane) + %fspm (run-fspm +.crane) + %fscb (run-fscb +.crane) + %fsdt (run-fsdt +.crane) + %fssm (run-fssm +.crane) + %fscl (run-fscl +.crane) + %fskt (run-fskt +.crane) + %fszp (run-fszp +.crane) + %fszy (run-fszy +.crane) + == + :: +run-fssg: runs the `/~` rune + :: + ++ run-fssg + |= =hoon + ^- compose-cranes + :: + =/ ride-build=^build + [date.build [%ride hoon [%$ subject]]] + =^ ride-result accessed-builds (depend-on ride-build) + ?~ ride-result + [[%block [ride-build]~] ..run-crane] + ?: ?=([~ %error *] ride-result) + [[%error [leaf+"/~ failed: " message.u.ride-result]] ..run-crane] + ?> ?=([~ %success %ride *] ride-result) + [[%subject %noun vase.u.ride-result] ..run-crane] + :: +run-fsbc: runes the `/$` rune + :: + ++ run-fsbc + |= =hoon + ^- compose-cranes + :: + =/ query-compile-build=^build + [date.build [%ride ((jock |) query-string) [%$ %noun !>(~)]]] + =^ query-compile-result accessed-builds (depend-on query-compile-build) + ?~ query-compile-result + [[%block [query-compile-build]~] ..run-crane] + ?: ?=([~ %error *] query-compile-result) + [[%error [leaf+"/; failed: " message.u.query-compile-result]] ..run-crane] + ?> ?=([~ %success %ride *] query-compile-result) + :: TODO: if we had a slop build type, everything could be crammed + :: into one sub-build. + :: + =/ =beam + =, path-to-render + [[ship.disc desk.disc [%da date.build]] spur] + =+ arguments=(slop !>(beam) vase.u.query-compile-result) + :: + =/ call-build=^build + [date.build [%call [%ride hoon [%$ subject]] [%$ %noun arguments]]] + =^ call-result accessed-builds (depend-on call-build) + ?~ call-result + [[%block [call-build]~] ..run-crane] + ?: ?=([~ %error *] call-result) + [[%error [leaf+"/; failed: " message.u.call-result]] ..run-crane] + ?> ?=([~ %success %call *] call-result) + :: + [[%subject %noun vase.u.call-result] ..run-crane] + :: +run-fsbr: runes the `/|` rune + :: + ++ run-fsbr + |= choices=(list ^crane) + ^- compose-cranes + :: + ?~ choices + [[%error [leaf+"/| failed: out of options"]~] ..run-crane] + :: + =^ child ..run-crane (run-crane subject i.choices) + ?. ?=([%error *] child) + [child ..run-crane] + $(choices t.choices) + :: +run-fsts: runs the `/=` rune + :: + ++ run-fsts + |= [face=term sub-crane=^crane] + ^- compose-cranes + :: + =^ child ..run-crane (run-crane subject sub-crane) + ?. ?=([%subject *] child) + [child ..run-crane] + :_ ..run-crane + :* %subject + p.subject.child + [[%face [~ face] p.q.subject.child] q.q.subject.child] + == + :: +run-fscm: runs the `/,` rune + :: + ++ run-fscm + |= cases=(list [=spur crane=^crane]) + ^- compose-cranes + :: + ?~ cases + [[%error [leaf+"/, failed: no match"]~] ..run-crane] + :: + ?. .= spur.i.cases + (scag (lent spur.i.cases) (flop spur.path-to-render)) + $(cases t.cases) + :: + (run-crane subject crane.i.cases) + :: +run-fspm: runs the `/&` rune + :: + ++ run-fspm + |= [marks=(list mark) sub-crane=^crane] + ^- compose-cranes + :: + =^ child ..run-crane (run-crane subject sub-crane) + ?. ?=([%subject *] child) + [child ..run-crane] + :: + =/ cast-build=^build + :- date.build + |- + ^- schematic + ?~ marks + :: TODO: If we were keeping track of the mark across runes, this + :: wouldn't have %noun here. This is case where it might matter. + :: + [%$ subject.child] + [%cast disc.source-rail.scaffold i.marks $(marks t.marks)] + =^ cast-result accessed-builds (depend-on cast-build) + ?~ cast-result + [[%block [cast-build]~] ..run-crane] + :: + ?: ?=([~ %error *] cast-result) + [[%error [leaf+"/& failed: " message.u.cast-result]] ..run-crane] + ?> ?=([~ %success %cast *] cast-result) + :: + [[%subject cage.u.cast-result] ..run-crane] + :: +run-fscb: runs the `/_` rune + :: + ++ run-fscb + |= sub-crane=^crane + ^- compose-cranes + :: perform a scry to get the contents of +path-to-render + :: + =/ toplevel-build=^build + [date.build [%scry [%c %y path-to-render]]] + :: + =^ toplevel-result accessed-builds (depend-on toplevel-build) + ?~ toplevel-result + [[%block ~[toplevel-build]] ..run-crane] + :: + ?: ?=([~ %error *] toplevel-result) + [[%error [leaf+"/_ failed: " message.u.toplevel-result]] ..run-crane] + ?> ?=([~ %success %scry *] toplevel-result) + :: + =/ toplevel-arch=arch ;;(arch q.q.cage.u.toplevel-result) + :: sub-path: each possible sub-directory to check + :: + =/ sub-paths=(list @ta) + (turn ~(tap by dir.toplevel-arch) head) + :: for each directory in :toplevel-arch, issue a sub-build + :: + =/ sub-builds=(list ^build) + %+ turn sub-paths + |= sub=@ta + ^- ^build + [date.build [%scry [%c %y path-to-render(spur [sub spur.path-to-render])]]] + :: results: accumulator for results of sub-builds + :: + =| results=(list [kid=^build sub-path=@ta results=(unit build-result)]) + :: resolve all the :sub-builds + :: + :: TODO: It feels like this running sub build and filtering + :: results could be generalized. + :: + =/ subs-results + |- ^+ [results accessed-builds] + ?~ sub-builds [results accessed-builds] + ?> ?=(^ sub-paths) + :: + =/ kid=^build i.sub-builds + =/ sub-path=@ta i.sub-paths + :: + =^ result accessed-builds (depend-on kid) + =. results [[kid sub-path result] results] + :: + $(sub-builds t.sub-builds, sub-paths t.sub-paths) + :: apply mutations from depending on sub-builds + :: + =: results -.subs-results + accessed-builds +.subs-results + == + :: split :results into completed :mades and incomplete :blocks + :: + =+ split-results=(skid results |=([* * r=(unit build-result)] ?=(^ r))) + :: + =/ mades=_results -.split-results + =/ blocks=_results +.split-results + :: if any builds blocked, produce them all in %blocks + :: + ?^ blocks + [[%block (turn `_results`blocks head)] ..run-crane] + :: find the first error and return it if exists + :: + =/ errors=_results + %+ skim results + |= [* * r=(unit build-result)] + ?=([~ %error *] r) + ?^ errors + ?> ?=([~ %error *] results.i.errors) + [[%error message.u.results.i.errors] ..run-crane] + :: get a list of valid sub-paths + :: + :: :results is now a list of the :build-result of %cy on each path + :: in :toplevel-arch. What we want is to now filter this list so + :: that we filter files out. + :: + =/ sub-paths=(list [=rail sub-path=@ta]) + %+ murn results + |= [build=^build sub-path=@ta result=(unit build-result)] + ^- (unit [rail @ta]) + :: + ?> ?=([@da %scry %c %y *] build) + ?> ?=([~ %success %scry *] result) + =/ =arch ;;(arch q.q.cage.u.result) + :: + ?~ dir.arch + ~ + `[rail.resource.schematic.build sub-path] + :: keep track of the original value so we can reset it + :: + =/ old-path-to-render path-to-render + :: apply each of the filtered :sub-paths to the :sub-crane. + :: + =^ crane-results ..run-crane + %+ roll sub-paths + |= $: [=rail sub-path=@ta] + accumulator=[(list [sub-path=@ta =compose-result]) _..run-crane] + == + =. ..run-crane +.accumulator + =. path-to-render rail + =^ result ..run-crane (run-crane subject sub-crane) + [[[sub-path result] -.accumulator] ..run-crane] + :: set :path-to-render back + :: + =. path-to-render old-path-to-render + :: if any sub-cranes error, return the first error + :: + =/ error-list=(list [@ta =compose-result]) + %+ skim crane-results + |= [@ta =compose-result] + =(%error -.compose-result) + :: + ?^ error-list + [compose-result.i.error-list ..run-crane] + :: if any sub-cranes block, return all blocks + :: + =/ block-list=(list ^build) + =| block-list=(list ^build) + |- + ^+ block-list + ?~ crane-results + block-list + ?. ?=(%block -.compose-result.i.crane-results) + $(crane-results t.crane-results) + =. block-list + (weld builds.compose-result.i.crane-results block-list) + $(crane-results t.crane-results) + :: + ?^ block-list + [[%block block-list] ..run-crane] + :: put the data in map order + :: + =/ result-map=(map @ta vase) + %- my + %+ turn crane-results + |= [path=@ta =compose-result] + ^- (pair @ta vase) + :: + ?> ?=([%subject *] compose-result) + [path q.subject.compose-result] + :: convert the map into a flat format for return + :: + :: This step flattens the values out of the map for return. Let's + :: say we're doing a /_ over a directory of files that just have a + :: single @ud in them. We want the return value of /_ to have the + :: nest in (map @ta @ud) instead of returning a (map @ta vase). + :: + =/ as-vase=vase + |- + ^- vase + :: + ?~ result-map + [[%atom %n `0] 0] + :: + %+ slop + (slop [[%atom %ta ~] p.n.result-map] q.n.result-map) + (slop $(result-map l.result-map) $(result-map r.result-map)) + :: + [[%subject %noun as-vase] ..run-crane] + :: +run-fsdt: runs the `/.` rune + :: + ++ run-fsdt + |= sub-cranes=(list ^crane) + ^- compose-cranes + :: + =^ list-results ..run-crane + %+ roll sub-cranes + |= $: sub-crane=^crane + accumulator=[(list compose-result) _..run-crane] + == + =. ..run-crane +.accumulator + =^ result ..run-crane (run-crane subject sub-crane) + [[result -.accumulator] ..run-crane] + :: if any sub-cranes error, return the first error + :: + =/ error-list=(list compose-result) + %+ skim list-results + |= =compose-result + =(%error -.compose-result) + :: + ?^ error-list + [i.error-list ..run-crane] + :: if any sub-cranes block, return all blocks + :: + =/ block-list=(list ^build) + =| block-list=(list ^build) + |- + ^+ block-list + ?~ list-results + block-list + ?. ?=(%block -.i.list-results) + $(list-results t.list-results) + =. block-list (weld builds.i.list-results block-list) + $(list-results t.list-results) + :: + ?^ block-list + [[%block block-list] ..run-crane] + :: concatenate all the results together with null termination + :: + =. list-results (flop list-results) + :: + =/ final-result=vase + |- + ^- vase + ?~ list-results + [[%atom %n `~] 0] + ?> ?=(%subject -.i.list-results) + (slop q.subject.i.list-results $(list-results t.list-results)) + :: + [[%subject %noun final-result] ..run-crane] + :: +run-fssm: runs the `/;` rune + :: + ++ run-fssm + |= [=hoon sub-crane=^crane] + ^- compose-cranes + :: + =^ child ..run-crane (run-crane subject sub-crane) + ?. ?=([%subject *] child) + [child ..run-crane] + :: + =/ call-build=^build + [date.build [%call [%ride hoon [%$ subject]] [%$ subject.child]]] + =^ call-result accessed-builds (depend-on call-build) + ?~ call-result + [[%block [call-build]~] ..run-crane] + ?: ?=([~ %error *] call-result) + [[%error [leaf+"/; failed: " message.u.call-result]] ..run-crane] + ?> ?=([~ %success %call *] call-result) + :: + [[%subject %noun vase.u.call-result] ..run-crane] + :: +run-fscl: runs the `/:` rune + :: + ++ run-fscl + |= [=truss sub-crane=^crane] + ^- compose-cranes + :: + =/ =beam + =, source-rail.scaffold + [[ship.disc desk.disc [%ud 0]] spur] + =/ hoon-parser (vang & (en-beam beam)) + :: + =+ tuz=(posh:hoon-parser truss) + ?~ tuz + [[%error [leaf+"/: failed: bad tusk: {}"]~] ..run-crane] + =+ pax=(plex:hoon-parser %clsg u.tuz) + ?~ pax + [[%error [leaf+"/: failed: bad path: {}"]~] ..run-crane] + =+ bem=(de-beam u.pax) + ?~ bem + [[%error [leaf+"/: failed: bad beam: {}"]~] ..run-crane] + :: + =. path-to-render [[p q] s]:u.bem + (run-crane subject sub-crane) + :: +run-fskt: runs the `/^` rune + :: + ++ run-fskt + |= [mold=hoon sub-crane=^crane] + ^- compose-cranes + :: + =^ child ..run-crane (run-crane subject sub-crane) + ?. ?=([%subject *] child) + [child ..run-crane] + :: + =/ bunt-build=^build + [date.build [%ride [%bunt mold] [%$ subject]]] + =^ bunt-result accessed-builds (depend-on bunt-build) + ?~ bunt-result + [[%block [bunt-build]~] ..run-crane] + ?: ?=([~ %error *] bunt-result) + [[%error [leaf+"/^ failed: " message.u.bunt-result]] ..run-crane] + ?> ?=([~ %success %ride *] bunt-result) + :: + ?. (~(nest ut p.vase.u.bunt-result) | p.q.subject.child) + [[%error [leaf+"/^ failed: nest-fail"]~] ..run-crane] + [[%subject %noun [p.vase.u.bunt-result q.q.subject.child]] ..run-crane] + :: +run-fszp: runs the `/!mark/` "rune" + :: + ++ run-fszp + |= =mark + ^- compose-cranes + :: + =/ hoon-path=rail + =, path-to-render + [disc [%hoon spur]] + :: + =/ hood-build=^build [date.build [%hood hoon-path]] + =^ hood-result accessed-builds (depend-on hood-build) + ?~ hood-result + [[%block [hood-build]~] ..run-crane] + ?: ?=([~ %error *] hood-result) + [[%error [leaf+"/! failed: " message.u.hood-result]] ..run-crane] + ?> ?=([~ %success %hood *] hood-result) + :: + =/ plan-build=^build + :- date.build + [%plan path-to-render query-string scaffold.u.hood-result] + =^ plan-result accessed-builds (depend-on plan-build) + ?~ plan-result + [[%block [plan-build]~] ..run-crane] + ?: ?=([~ %error *] plan-result) + [[%error [leaf+"/! failed: " message.u.plan-result]] ..run-crane] + ?> ?=([~ %success %plan *] plan-result) + :: if :mark is %noun, don't perform mark translation; just return + :: + :: If we were to verify the product type with %noun, this would + :: cast to *, which would overwrite :vase.u.plan-result's actual + :: product type + :: + ?: =(%noun mark) + [[%subject %noun vase.u.plan-result] ..run-crane] + :: + =/ vale-build=^build + :- date.build + [%vale disc.source-rail.scaffold mark q.vase.u.plan-result] + =^ vale-result accessed-builds (depend-on vale-build) + ?~ vale-result + [[%block [vale-build]~] ..run-crane] + ?: ?=([~ %error *] vale-result) + [[%error [leaf+"/! failed: " message.u.vale-result]] ..run-crane] + ?> ?=([~ %success %vale *] vale-result) + :: + [[%subject cage.u.vale-result] ..run-crane] + :: +run-fszy: runs the `/mark/` "rune" + :: + ++ run-fszy + |= =mark + ^- compose-cranes + :: + =/ bake-build=^build + :- date.build + [%bake mark query-string path-to-render] + =^ bake-result accessed-builds (depend-on bake-build) + ?~ bake-result + [[%block [bake-build]~] ..run-crane] + ?: ?=([~ %error *] bake-result) + [[%error [leaf+"/mark/ failed: " message.u.bake-result]] ..run-crane] + ?> ?=([~ %success %bake *] bake-result) + :: + [[%subject cage.u.bake-result] ..run-crane] + -- + :: +gather-path-builds: produce %path builds to resolve import paths + :: + ++ gather-path-builds + |= imports=(list [prefix=?(%sur %lib) =cable]) + ^- (list ^build) + :: + %+ turn imports + |= [prefix=?(%sur %lib) =cable] + ^- ^build + [date.build [%path disc.source-rail.scaffold prefix file-path.cable]] + :: +resolve-builds: run a list of builds and collect results + :: + :: If a build blocks, put its +tang in :error-message and stop. + :: All builds that block get put in :blocks. Results of + :: successful builds are produced in :results. + :: + ++ resolve-builds + =| results=(list build-result) + |= builds=(list ^build) + ^+ [results ..^$] + :: + ?~ builds + [results ..^$] + :: + =^ result accessed-builds (depend-on i.builds) + ?~ result + =. blocks [i.builds blocks] + $(builds t.builds) + :: + ?. ?=(%success -.u.result) + =. error-message [[%leaf "%plan failed: "] message.u.result] + [results ..^$] + :: + =. results [u.result results] + $(builds t.builds) + :: +gather-core-builds: produce %core builds from resolved paths + :: + ++ gather-core-builds + |= path-results=(list build-result) + ^- (list ^build) + %+ turn path-results + |= result=build-result + ^- ^build + :: + ?> ?=([%success %path *] result) + :: + [date.build [%core rail.result]] + :: +link-imports: link libraries and structures with standard library + :: + :: Prepends each library vase onto the standard library vase. + :: Wraps a face around each library to prevent namespace leakage + :: unless imported as *lib-name. + :: + ++ link-imports + |= $: imports=(list [?(%lib %sur) =cable]) + reef=vase + core-results=(list build-result) + == + ^- vase + :: + =/ subject=vase reef + :: + =/ core-vases=(list vase) + %+ turn core-results + |= result=build-result + ^- vase + ?> ?=([%success %core *] result) + vase.result + :: link structures and libraries into a subject for compilation + :: + |- ^+ subject + ?~ core-vases subject + ?< ?=(~ imports) + :: cons this vase onto the head of the subject + :: + =. subject + %- slop :_ subject + :: check if the programmer named the library + :: + ?~ face.cable.i.imports + :: no face assigned to this library, so use vase as-is + :: + i.core-vases + :: use the library name as a face to prevent namespace leakage + :: + ^- vase + [[%face face.cable.i.imports p.i.core-vases] q.i.core-vases] + :: + $(core-vases t.core-vases, imports t.imports) + -- + :: + ++ make-reef + |= =disc + ^- build-receipt + :: short-circuit to :pit if asked for current %home desk + :: + :: This avoids needing to recompile the kernel if we're asked + :: for the kernel we're already running. Note that this fails + :: referential transparency if |autoload is turned off. + :: + ?: ?& =(disc [our %home]) + :: is :date.build the latest commit on the %home desk? + :: + ?| =(now date.build) + :: + =/ =beam [[our %home [%da date.build]] /hoon/hoon/sys] + :: + .= (scry [%143 %noun] ~ %cw beam) + (scry [%143 %noun] ~ %cw beam(r [%da now])) + == == + :: + [build [%build-result %success %reef pit] accessed-builds] + :: + =/ hoon-scry + [date.build [%scry %c %x [disc /hoon/hoon/sys]]] + :: + =^ hoon-scry-result accessed-builds (depend-on hoon-scry) + :: + =/ arvo-scry + [date.build [%scry %c %x [disc /hoon/arvo/sys]]] + :: + =^ arvo-scry-result accessed-builds (depend-on arvo-scry) + :: + =/ zuse-scry + [date.build [%scry %c %x [disc /hoon/zuse/sys]]] + :: + =^ zuse-scry-result accessed-builds (depend-on zuse-scry) + :: + =| blocks=(list ^build) + =? blocks ?=(~ hoon-scry-result) [hoon-scry blocks] + =? blocks ?=(~ arvo-scry-result) [arvo-scry blocks] + =? blocks ?=(~ zuse-scry-result) [zuse-scry blocks] + :: + ?^ blocks + [build [%blocks blocks ~] accessed-builds] + :: + ?. ?=([~ %success %scry *] hoon-scry-result) + (wrap-error hoon-scry-result) + :: + ?. ?=([~ %success %scry *] arvo-scry-result) + (wrap-error arvo-scry-result) + :: + ?. ?=([~ %success %scry *] zuse-scry-result) + (wrap-error zuse-scry-result) + :: omit case from path to prevent cache misses + :: + =/ hoon-path=path + /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/hoon/sys + =/ hoon-hoon=hoon (rain hoon-path ;;(@t q.q.cage.u.hoon-scry-result)) + :: + =/ arvo-path=path + /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/arvo/sys + =/ arvo-hoon=hoon (rain arvo-path ;;(@t q.q.cage.u.arvo-scry-result)) + :: + =/ zuse-path=path + /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/zuse/sys + =/ zuse-hoon=hoon (rain zuse-path ;;(@t q.q.cage.u.zuse-scry-result)) + :: + =/ zuse-build=^build + :* date.build + %ride zuse-hoon + %ride arvo-hoon + %ride hoon-hoon + [%$ %noun !>(~)] + == + :: + =^ zuse-build-result accessed-builds (depend-on zuse-build) + ?~ zuse-build-result + [build [%blocks [zuse-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %ride *] zuse-build-result) + (wrap-error zuse-build-result) + :: + :+ build + [%build-result %success %reef vase.u.zuse-build-result] + accessed-builds + :: + ++ make-ride + |= [formula=hoon =schematic] + ^- build-receipt + :: + =^ result accessed-builds (depend-on [date.build schematic]) + ?~ result + [build [%blocks [date.build schematic]~ ~] accessed-builds] + :: + =* subject u.result + =* subject-cage (result-to-cage subject) + =/ slim-schematic=^schematic [%slim p.q.subject-cage formula] + =^ slim-result accessed-builds (depend-on [date.build slim-schematic]) + ?~ slim-result + [build [%blocks [date.build slim-schematic]~ ~] accessed-builds] + :: + ?. ?=([~ %success %slim *] slim-result) + (wrap-error slim-result) + :: + =/ val + (mock [q.q.subject-cage nock.u.slim-result] intercepted-scry) + :: val is a toon, which might be a list of blocks. + :: + ?- -.val + :: + %0 + :* build + [%build-result %success %ride [type.u.slim-result p.val]] + accessed-builds + == + :: + %1 + =/ blocked-paths=(list path) ((hard (list path)) p.val) + (blocked-paths-to-receipt %ride blocked-paths) + :: + %2 + (return-error [[%leaf "ford: %ride failed:"] p.val]) + == + :: + ++ make-same + |= =schematic + ^- build-receipt + :: + =^ result accessed-builds (depend-on [date.build schematic]) + :: + ?~ result + [build [%blocks [date.build schematic]~ ~] accessed-builds] + [build [%build-result u.result] accessed-builds] + :: + ++ make-scry + :: TODO: All accesses to :state which matter happens in this function; + :: those calculations need to be lifted out of +make into +execute. + :: + |= =resource + ^- build-receipt + :: construct a full +beam to make the scry request + :: + =/ =beam (extract-beam resource `date.build) + :: + =/ =scry-request [vane.resource care.resource beam] + :: perform scry operation if we don't already know the result + :: + :: Look up :scry-request in :scry-results.per-event to avoid + :: rerunning a previously blocked +scry. + :: + =/ scry-response + ?: (~(has by scry-results) scry-request) + (~(get by scry-results) scry-request) + (scry [%143 %noun] ~ `@tas`(cat 3 [vane care]:resource) beam) + :: scry blocked + :: + ?~ scry-response + :: TODO: Verify handling of already blocked scrys later + :: + :: We killed a bunch of code which "worked" but which might have + :: been a no-op. + :: + [build [%blocks ~ `scry-request] accessed-builds] + :: scry failed + :: + ?~ u.scry-response + %- return-error + :~ leaf+"scry failed for" + leaf+"%c{(trip care.resource)} {<(en-beam beam)>}" + == + :: scry succeeded + :: + [build [%build-result %success %scry u.u.scry-response] accessed-builds] + :: + ++ make-slim + |= [subject-type=type formula=hoon] + ^- build-receipt + :: + =/ compiled=(each (pair type nock) tang) + (mule |.((~(mint ut subject-type) [%noun formula]))) + :: + :* build + ?- -.compiled + %| [%build-result %error [leaf+"%slim failed: " p.compiled]] + %& [%build-result %success %slim p.compiled] + == + accessed-builds + == + :: + ++ make-slit + |= [gate=vase sample=vase] + ^- build-receipt + :: + =/ product=(each type tang) + (mule |.((slit p.gate p.sample))) + :: + :* build + ?- -.product + %| :* %build-result %error + :* (~(dunk ut p.sample) %have) + (~(dunk ut (~(peek ut p.gate) %free 6)) %want) + leaf+"%slit failed: " + p.product + == + == + %& [%build-result %success %slit p.product] + == + accessed-builds + == + :: + ++ make-volt + |= [=disc mark=term input=*] + ^- build-receipt + :: + =/ bunt-build=^build [date.build [%bunt disc mark]] + :: + =^ bunt-result accessed-builds (depend-on bunt-build) + ?~ bunt-result + [build [%blocks [bunt-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %bunt *] bunt-result) + (wrap-error bunt-result) + :: + =/ =build-result + [%success %volt [mark p.q.cage.u.bunt-result input]] + :: + [build [%build-result build-result] accessed-builds] + :: + ++ make-vale + :: TODO: better docs + :: + |= [=disc mark=term input=*] + ^- build-receipt + :: don't validate for the %noun mark + :: + ?: =(%noun mark) + =/ =build-result [%success %vale [%noun %noun input]] + :: + [build [%build-result build-result] accessed-builds] + :: + =/ path-build [date.build [%path disc %mar mark]] + :: + =^ path-result accessed-builds (depend-on path-build) + ?~ path-result + [build [%blocks [path-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %path *] path-result) + (wrap-error path-result) + :: + =/ bunt-build=^build [date.build [%bunt disc mark]] + :: + =^ bunt-result accessed-builds (depend-on bunt-build) + ?~ bunt-result + [build [%blocks [bunt-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %bunt *] bunt-result) + (wrap-error bunt-result) + :: + =/ mark-sample=vase q.cage.u.bunt-result + :: + =/ call-build=^build + :^ date.build + %call + ^= gate + :* %ride + :: (ream 'noun:grab') + formula=`hoon`[%tsgl [%wing ~[%noun]] [%wing ~[%grab]]] + subject=`schematic`[%core rail.u.path-result] + == + sample=[%$ %noun %noun input] + :: + =^ call-result accessed-builds (depend-on call-build) + ?~ call-result + [build [%blocks [call-build]~ ~] accessed-builds] + :: + ?. ?=([~ %success %call *] call-result) + (wrap-error call-result) + :: + =/ product=vase vase.u.call-result + :: TODO: why do we check nesting here? + :: + ?> (~(nest ut p.mark-sample) | p.product) + :: check mold idempotence; if different, nest fail + :: + ?: =(q.product input) + =/ =build-result + [%success %vale [mark p.mark-sample q.product]] + :: + [build [%build-result build-result] accessed-builds] + :: + %- return-error + =/ =beam [[ship.disc desk.disc %da date.build] spur.rail.u.path-result] + [leaf+"ford: %vale failed: invalid input for mark: {<(en-beam beam)>}"]~ + :: + ++ make-walk + |= [=disc source=term target=term] + ^- build-receipt + :: + |^ ^- build-receipt + :: load all marks. + :: + =^ load-marks-result accessed-builds + (load-marks-reachable-from [[%grow source] [%grab target] ~]) + ?: ?=([%| *] load-marks-result) + p.load-marks-result + :: find a path through the graph + :: + :: Make a list of individual mark translation actions which will + :: take us from :source to :term. + :: + =/ path (find-path-through p.load-marks-result) + :: if there is no path between these marks, give a nice error message. + :: + ?~ path + :* build + :* %build-result %error + [leaf+"ford: no mark path from {} to {}"]~ + == + accessed-builds + == + :: + :* build + [%build-result %success %walk path] + accessed-builds + == + :: +load-node: a queued loading action + :: + += load-node [type=?(%grab %grow) mark=term] + :: edge-jug: type of our graph representation + :: + += edge-jug (jug source=term [target=term arm=?(%grow %grab)]) + :: mark-path: a path through the mark graph + :: + += mark-path (list mark-action) + :: +load-marks-reachable-from: partial mark graph loading + :: + :: While we can just load all marks in the %/mar directory, this is + :: rather slow. What we do instead is traverse forwards and backwards + :: from the source and target marks: we start at the source mark, + :: check all the grow arms, and then check their grow arms. At the + :: same time, we start from the target mark, check all the grab arms, + :: and then check their grab arms. This gives us a much smaller + :: dependency set than loading the entire %/mar directory. + :: + ++ load-marks-reachable-from + |= queued-nodes=(list load-node) + :: list of nodes in the graph that we've already checked + :: + =| visited=(set load-node) + :: graph of the available edges + :: + =| =edge-jug + :: + |- + ^- [(each ^edge-jug build-receipt) _accessed-builds] + :: no ?~ to prevent tmi + :: + ?: =(~ queued-nodes) + [[%& edge-jug] accessed-builds] + :: + =/ nodes-and-schematics + %+ turn queued-nodes + |= =load-node + ^- [^load-node schematic] + :- load-node + [%path disc %mar mark.load-node] + :: get the path for each mark name + :: + :: For %path builds, any ambiguous path is just filtered out. + :: + =^ path-results accessed-builds + (perform-schematics nodes-and-schematics %filter-errors *load-node) + ?: ?=([%| *] path-results) + [path-results accessed-builds] + :: + =/ nodes-and-cores + %+ turn p.path-results + |= [=load-node =build-result] + ^- [^load-node schematic] + :: + ?> ?=([%success %path *] build-result) + :: + :- load-node + [%core rail.build-result] + :: + =^ core-results accessed-builds + (perform-schematics nodes-and-cores %filter-errors *load-node) + ?: ?=([%| *] core-results) + [core-results accessed-builds] + :: clear the queue before we process the new results + :: + =. queued-nodes ~ + :: + =/ cores p.core-results + :: + |- + ?~ cores + ^$ + :: mark this node as visited + :: + =. visited (~(put in visited) key.i.cores) + :: + =/ target-arms=(list load-node) + ?> ?=([%success %core *] result.i.cores) + ?: =(%grow type.key.i.cores) + (get-arms-of-type %grow vase.result.i.cores) + (get-arms-of-type %grab vase.result.i.cores) + :: filter places we know we've already been. + :: + =. target-arms + %+ skip target-arms ~(has in visited) + =. queued-nodes (weld target-arms queued-nodes) + :: + =. edge-jug + |- + ?~ target-arms + edge-jug + :: + =. edge-jug + ?- type.i.target-arms + :: + %grab + (~(put ju edge-jug) mark.i.target-arms [mark.key.i.cores %grab]) + :: + %grow + (~(put ju edge-jug) mark.key.i.cores [mark.i.target-arms %grow]) + == + $(target-arms t.target-arms) + :: + $(cores t.cores) + :: + ++ get-arms-of-type + |= [type=?(%grab %grow) =vase] + ^- (list load-node) + :: it is valid for this node to not have a +grow arm. + :: + ?. (slob type p.vase) + ~ + :: + %+ turn + (sloe p:(slap vase [%limb type])) + |= arm=term + [type arm] + :: +find-path-through: breadth first search over the mark graph + :: + ++ find-path-through + |= edges=edge-jug + ^- mark-path + :: the source node starts out visited + =/ visited-nodes=(set mark) [source ~ ~] + :: these paths are flopped so we're always inserting to the front. + =| path-queue=(qeu mark-path) + :: start the queue with all the edges which start at the source mark + :: + =. path-queue + =/ start-links (find-links-in-edges edges source) + :: + |- + ^+ path-queue + ?~ start-links + path-queue + :: + =. path-queue (~(put to path-queue) [i.start-links]~) + :: + $(start-links t.start-links) + :: + |- + ^- mark-path + :: + ?: =(~ path-queue) + :: no path found + ~ + =^ current path-queue [p q]:~(get to path-queue) + ?> ?=(^ current) + :: + ?: =(target target.i.current) + :: we have a completed path. paths in the queue are backwards + (flop current) + :: + =+ next-steps=(find-links-in-edges edges target.i.current) + :: filter out already visited nodes + :: + =. next-steps + %+ skip next-steps + |= link=mark-action + (~(has in visited-nodes) source.link) + :: then add the new ones to the set of already visited nodes + :: + =. visited-nodes + (~(gas in visited-nodes) (turn next-steps |=(mark-action source))) + :: now all next steps go in the queue + :: + =. path-queue + %- ~(gas to path-queue) + %+ turn next-steps + |= new-link=mark-action + [new-link current] + :: + $ + :: +find-links-in-edges: gets edges usable by +find-path-through + :: + :: This deals with disambiguating between %grab and %grow so we always + :: pick %grab over %grow. + :: + ++ find-links-in-edges + |= [edges=edge-jug source=term] + ^- (list mark-action) + :: + =+ links=~(tap in (~(get ju edges) source)) + :: + =| results=(set mark-action) + |- + ^- (list mark-action) + ?~ links + ~(tap in results) + :: + ?- arm.i.links + %grab + :: if :results has a %grow entry, remove it before adding our %grab + =/ grow-entry=mark-action [%grow source target.i.links] + =? results (~(has in results) grow-entry) + (~(del in results) grow-entry) + :: + =. results (~(put in results) [%grab source target.i.links]) + $(links t.links) + :: + %grow + :: if :results has a %grab entry, don't add a %grow entry + ?: (~(has in results) [%grab source target.i.links]) + $(links t.links) + :: + =. results (~(put in results) [%grow source target.i.links]) + $(links t.links) + == + -- + :: |utilities:make: helper arms + :: + ::+| utilities + :: +perform-schematics: helper function that performs a list of builds + :: + :: We often need to run a list of builds. This helper method will + :: depend on all :builds, will return a +build-receipt of either the + :: blocks or the first error, or a list of all completed results. + :: + :: This is a wet gate so individual callers can associate their own + :: key types with schematics. + :: + ++ perform-schematics + |* $: builds=(list [key=* =schematic]) + on-error=?(%fail-on-errors %filter-errors %ignore-errors) + key-bunt=* + == + ^- $: (each (list [key=_key-bunt result=build-result]) build-receipt) + _accessed-builds + == + :: + |^ =^ results accessed-builds + =| results=(list [_key-bunt ^build (unit build-result)]) + |- + ^+ [results accessed-builds] + :: + ?~ builds + [results accessed-builds] + :: + =/ sub-build=^build [date.build schematic.i.builds] + =^ result accessed-builds (depend-on sub-build) + =. results [[key.i.builds sub-build result] results] + :: + $(builds t.builds) + ?: =(%fail-on-errors on-error) + (check-errors results) + ?: =(%filter-errors on-error) + (filter-errors results) + (handle-rest results) + :: + ++ check-errors + |= results=(list [_key-bunt ^build (unit build-result)]) + :: + =/ error=tang + %- zing ^- (list tang) + %+ murn results + |= [* * result=(unit build-result)] + ^- (unit tang) + ?. ?=([~ %error *] result) + ~ + `message.u.result + :: only produce the first error, as is tradition + :: + ?^ error + =. error [leaf+"ford: %mute failed: " error] + [[%| [build [%build-result %error error] accessed-builds]] accessed-builds] + (handle-rest results) + :: + ++ filter-errors + |= results=(list [_key-bunt ^build (unit build-result)]) + =. results + %+ skip results + |= [* * r=(unit build-result)] + ?=([~ %error *] r) + (handle-rest results) + :: + ++ handle-rest + |= results=(list [_key-bunt ^build (unit build-result)]) + :: if any sub-builds blocked, produce all blocked sub-builds + :: + =/ blocks=(list ^build) + %+ murn `(list [* ^build (unit build-result)])`results + |= [* sub=^build result=(unit build-result)] + ^- (unit ^build) + ?^ result + ~ + `sub + :: + ?^ blocks + [[%| [build [%blocks blocks ~] accessed-builds]] accessed-builds] + :: + :_ accessed-builds + :- %& + %+ turn results + |* [key=_key-bunt ^build result=(unit build-result)] + ^- [_key-bunt build-result] + [key (need result)] + -- + :: +wrap-error: wrap an error message around a failed sub-build + :: + ++ wrap-error + |= result=(unit build-result) + ^- build-receipt + :: + ?> ?=([~ %error *] result) + =/ message=tang + [[%leaf "ford: {<-.schematic.build>} failed: "] message.u.result] + :: + [build [%build-result %error message] accessed-builds] + :: +return-error: returns a specific failure message + :: + ++ return-error + |= =tang + ^- build-receipt + [build [%build-result %error tang] accessed-builds] + :: + ++ depend-on + |= kid=^build + ^- [(unit build-result) _accessed-builds] + :: + =. accessed-builds [kid accessed-builds] + :: +access-build-record will mutate :results.state + :: + :: It's okay to ignore this because the accessed-builds get gathered + :: and merged during the +reduce step. + :: + =/ maybe-build-record -:(access-build-record kid) + ?~ maybe-build-record + [~ accessed-builds] + :: + =* build-record u.maybe-build-record + ?: ?=(%tombstone -.build-record) + [~ accessed-builds] + :: + [`build-result.build-record accessed-builds] + :: +blocked-paths-to-receipt: handle the %2 case for mock + :: + :: Multiple schematics handle +toon instances. This handles the %2 case + :: for a +toon and transforms it into a +build-receipt so we depend on + :: the blocked paths correctly. + :: + ++ blocked-paths-to-receipt + |= [name=term blocked-paths=(list path)] + ^- build-receipt + :: + =/ blocks-or-failures=(list (each ^build tank)) + %+ turn blocked-paths + |= =path + :: + =/ scry-request=(unit scry-request) (path-to-scry-request path) + ?~ scry-request + [%| [%leaf "ford: {}: invalid scry path: {}"]] + :: + =* case r.beam.u.scry-request + :: + ?. ?=(%da -.case) + [%| [%leaf "ford: {}: invalid case in scry path: {}"]] + :: + =/ date=@da p.case + :: + =/ resource=(unit resource) (path-to-resource path) + ?~ resource + :- %| + [%leaf "ford: {}: invalid resource in scry path: {}"] + :: + =/ sub-schematic=^schematic [%pin date %scry u.resource] + :: + [%& `^build`[date sub-schematic]] + :: + =/ failed=tang + %+ murn blocks-or-failures + |= block=(each ^build tank) + ^- (unit tank) + ?- -.block + %& ~ + %| `p.block + == + :: + ?^ failed + :: some failed + :: + [build [%build-result %error failed] accessed-builds] + :: no failures + :: + =/ blocks=(list ^build) + %+ turn blocks-or-failures + |= block=(each ^build tank) + ?> ?=(%& -.block) + :: + p.block + :: + =. accessed-builds + %+ roll blocks + |= [block=^build accumulator=_accessed-builds] + =. accessed-builds accumulator + +:(depend-on [date.block schematic.block]) + :: + :: TODO: Here we are passing a single ~ for :scry-blocked. Should we + :: be passing one or multiple resource back instead? Maybe not? Are + :: we building blocking schematics, which they themselves will scry? + :: + [build [%blocks blocks ~] accessed-builds] + -- + :: |utilities:per-event: helper arms + :: + ::+| utilities + :: + :: +add-build: store a fresh, unstarted build in the state + :: + ++ add-build + |= =build + ^+ state + :: ~& [%add-build (build-to-tape build)] + :: don't overwrite an existing entry + :: + ?: (~(has by builds.state) build) + state + :: + %_ state + builds-by-schematic + (~(put by-schematic builds-by-schematic.state) build) + :: + builds + %+ ~(put by builds.state) build + :: TODO: when bunts work better, just bunt + :: + =| =build-status + build-status(state [%untried ~]) + == + :: +remove-builds: remove builds and their sub-builds + :: + ++ remove-builds + |= builds=(list build) + :: ~& [%remove-builds (turn builds build-to-tape)] + :: + |^ ^+ state + :: + ?~ builds + state + :: + ?~ maybe-build-status=(~(get by builds.state) i.builds) + $(builds t.builds) + =/ subs ~(tap in ~(key by subs.u.maybe-build-status)) + :: + =^ removed state (remove-single-build i.builds u.maybe-build-status) + ?. removed + $(builds t.builds) + :: + $(builds (welp t.builds subs)) + :: +remove-build: stop storing :build in the state + :: + :: Removes all linkages to and from sub-builds + :: TODO: should we assert we're not subscribed? + :: + ++ remove-single-build + |= [=build =build-status] + ^+ [removed=| state] + :: never delete a build that something depends on + :: + ?^ clients.build-status + :: ~& [%skip-remove-because-clients (build-to-tape build) clients.build-status] + [removed=| state] + ?^ requesters.build-status + :: ~& [%skip-remove-because-requesters (build-to-tape build) requesters.build-status] + [removed=| state] + :: ~& [%removing (build-to-tape build) (~(got by builds.state) build)] + :: nothing depends on :build, so we'll remove it + :: + :- removed=& + ^+ state + :: + =/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) + :: for each sub, remove :build from its :clients + :: + =. builds.state + |- ^+ builds.state + ?~ subs builds.state + :: + =? builds.state (~(has by builds.state) i.subs) + :: + =< builds + %+ update-build-status i.subs + |= build-status=^build-status + ^+ build-status + :: + build-status(clients (~(del ju clients.build-status) duct build)) + :: + $(subs t.subs) + :: + %_ state + builds-by-schematic + (~(del by-schematic builds-by-schematic.state) build) + :: + builds + (~(del by builds.state) build) + == + -- + :: +update-build-status: replace :build's +build-status by running a function + :: + ++ update-build-status + |= [=build update-func=$-(build-status build-status)] + ^- [build-status builds=_builds.state] + :: + =/ original=build-status + ~| [%update-build (build-to-tape build)] + (~(got by builds.state) build) + =/ mutant=build-status (update-func original) + :: + [mutant (~(put by builds.state) build mutant)] + :: +intercepted-scry: use local results as a scry facade + :: + ++ intercepted-scry + %- sloy ^- slyd + |= [ref=* (unit (set monk)) =term =beam] + ^- (unit (unit (cask))) + ?> ?=([@ *] ref) + =/ hoon-version=@ud -.ref + :: + ~| hoon-version=hoon-version + ?> ?=(?(%143 %151) hoon-version) + :: if the actual scry produces a value, use that value; otherwise use local + :: + =/ scry-response (scry +<.$) + :: + ?^ scry-response + scry-response + :: + =/ vane=(unit ?(%c %g)) ((soft ?(%c %g)) (end 3 1 term)) + ?~ vane + ~ + =/ care=(unit care:clay) ((soft care:clay) (rsh 3 1 term)) + ?~ care + ~ + :: + =/ =resource + [u.vane u.care rail=[[p.beam q.beam] s.beam]] + :: TODO: handle other kinds of +case + :: + =/ date=@da + ~| bad-case+r.beam + ?> ?=(%da -.r.beam) + p.r.beam + :: + =/ =build [date %scry resource] + :: look up the scry result from our permanent state + :: + :: Note: we can't freshen this cache entry because we can't modify + :: the state in this gate. + :: + =/ local-result -:(access-build-record build) + ?~ local-result + ~ + ?: ?=(%tombstone -.u.local-result) + ~ + :: + =/ local-cage=cage (result-to-cage build-result.u.local-result) + :: if :local-result does not nest in :type, produce an error + :: + ?. -:(nets:wa +.ref `type`p.q.local-cage) + [~ ~] + :: + [~ ~ `(cask)`local-cage] + :: +unblock-clients-on-duct: unblock and produce clients blocked on :build + :: + ++ unblock-clients-on-duct + =| unblocked=(list build) + |= =build + ^+ [unblocked builds.state] + :: + =/ =build-status + ~| [%unblocking (build-to-tape build)] + (~(got by builds.state) build) + :: + =/ clients=(list ^build) ~(tap in (~(get ju clients.build-status) duct)) + :: + |- + ^+ [unblocked builds.state] + ?~ clients + [unblocked builds.state] + :: + =^ client-status builds.state + %+ update-build-status i.clients + |= client-status=^build-status + :: + =. subs.client-status + %+ ~(put by subs.client-status) build + =/ original (~(got by subs.client-status) build) + original(blocked |) + :: + =? state.client-status + ?& ?=(%blocked -.state.client-status) + :: + ?! + %- ~(any by subs.client-status) + |=(build-relation &(blocked verified)) + == + :: + [%unblocked ~] + client-status + :: + =? unblocked !?=(%blocked -.state.client-status) + [i.clients unblocked] + :: + $(clients t.clients) + :: +on-build-complete: handles completion of any build + :: + ++ on-build-complete + |= =build + ^+ ..execute + :: + :: ~& [%on-build-complete (build-to-tape build)] + =. ..execute (cleanup-orphaned-provisional-builds build) + :: + =/ duct-status (~(got by ducts.state) duct) + :: + =/ =build-status (~(got by builds.state) build) + ?: (~(has in requesters.build-status) duct) + (on-root-build-complete build) + :: + =^ unblocked-clients builds.state (unblock-clients-on-duct build) + =. candidate-builds (~(gas in candidate-builds) unblocked-clients) + :: + ..execute + :: +on-root-build-complete: handle completion or promotion of a root build + :: + :: When a build completes for a duct, we might have to send a %made move + :: on the requesting duct and also do duct and build book-keeping. + :: + ++ on-root-build-complete + |= =build + ^+ ..execute + :: + :: ~& [%on-root-build-complete (build-to-tape build)] + :: + =/ =build-status (~(got by builds.state) build) + =/ =duct-status (~(got by ducts.state) duct) + :: make sure we have something to send + :: + ?> ?=([%complete %value *] state.build-status) + :: send a %made move unless it's an unchanged live build + :: + =? moves + ?! + ?& ?=(%live -.live.duct-status) + ?=(^ last-sent.live.duct-status) + :: + =/ last-build-status + %- ~(got by builds.state) + [date.u.last-sent.live.duct-status schematic.build] + :: + ?> ?=(%complete -.state.last-build-status) + ?& ?=(%value -.build-record.state.last-build-status) + :: + .= build-result.build-record.state.last-build-status + build-result.build-record.state.build-status + == == + :_ moves + ^- move + :: + :* duct %give %made date.build %complete + build-result.build-record.state.build-status + == + :: + ?- -.live.duct-status + %once + =. ducts.state (~(del by ducts.state) duct) + =. state (remove-duct-from-root build) + :: + ..execute + :: + %live + =/ resources=(jug disc resource) (collect-live-resources build) + :: clean up previous build + :: + =? state ?=(^ last-sent.live.duct-status) + =/ old-build=^build build(date date.u.last-sent.live.duct-status) + :: + :: ~& [%remove-previous-duct-from-root duct duct-status (build-to-tape old-build)] + (remove-duct-from-root old-build) + :: + =/ resource-list=(list [=disc resources=(set resource)]) + ~(tap by resources) + :: we can only handle a single subscription + :: + :: In the long term, we need Clay's interface to change so we can + :: subscribe to multiple desks at the same time. + :: + ?: (lth 1 (lent resource-list)) + =. ..execute (send-incomplete build) + =. ducts.state (~(del by ducts.state) duct) + =. state (remove-duct-from-root build) + ..execute + :: + =/ subscription=(unit subscription) + ?~ resource-list + ~ + `[date.build disc.i.resource-list resources.i.resource-list] + :: + =? ..execute ?=(^ subscription) + (start-clay-subscription u.subscription) + :: + =. ducts.state + %+ ~(put by ducts.state) duct + %_ duct-status + live + [%live in-progress=~ last-sent=`[date.build subscription]] + == + :: + ..execute + == + :: +send-incomplete: + :: + ++ send-incomplete + |= =build + ^+ ..execute + :: + =. moves + :_ moves + ^- move + :* duct %give %made date.build + ^- made-result + :- %incomplete + [%leaf "build tried to subscribe to multiple discs"]~ + == + :: + ..execute + :: +cleanup-orphaned-provisional-builds: delete extraneous sub-builds + :: + :: Remove unverified linkages to sub builds. If a sub-build has no other + :: clients on this duct, then it is orphaned and we remove the duct from + :: its subs and call +cleanup on it. + :: + ++ cleanup-orphaned-provisional-builds + |= =build + ^+ ..execute + :: ~& [%cleanup-orphaned-provisional-builds (build-to-tape build)] + :: + =/ =build-status (~(got by builds.state) build) + :: + =/ orphans=(list ^build) + %+ murn ~(tap by subs.build-status) + |= [sub=^build =build-relation] + ^- (unit ^build) + :: + ?: verified.build-relation + ~ + `sub + :: remove links to orphans in :build's +build-status + :: + =^ build-status builds.state + %+ update-build-status build + |= build-status=^build-status + %_ build-status + subs + :: + |- ^+ subs.build-status + ?~ orphans subs.build-status + :: + =. subs.build-status (~(del by subs.build-status) i.orphans) + :: + $(orphans t.orphans) + == + :: + |- ^+ ..execute + ?~ orphans ..execute + :: remove link to :build in :i.orphan's +build-status + :: + =^ orphan-status builds.state + %+ update-build-status i.orphans + |= orphan-status=_build-status + %_ orphan-status + clients (~(del ju clients.orphan-status) duct build) + == + :: + ?: (~(has by clients.orphan-status) duct) + $(orphans t.orphans) + :: :build was the last client on this duct so remove it + :: + =. builds.state (remove-duct-from-subs i.orphans) + =. state (cleanup i.orphans) + $(orphans t.orphans) + :: +access-build-record: access a +build-record, updating :last-accessed + :: + :: Usage: + :: ``` + :: =^ maybe-build-record builds.state (access-build-record build) + :: ``` + :: + ++ access-build-record + |= =build + ^- [(unit build-record) _builds.state] + :: + ?~ maybe-build-status=(~(get by builds.state) build) + [~ builds.state] + :: + =/ =build-status u.maybe-build-status + :: + ?. ?=(%complete -.state.build-status) + [~ builds.state] + :: + ?: ?=(%tombstone -.build-record.state.build-status) + [`build-record.state.build-status builds.state] + :: + =. last-accessed.build-record.state.build-status now + :: + :- `build-record.state.build-status + (~(put by builds.state) build build-status) + :: +cleanup: try to clean up a build and its sub-builds + :: + ++ cleanup + |= =build + ^+ state + :: does this build even exist?! + :: + ?~ maybe-build-status=(~(get by builds.state) build) + :: ~& [%cleanup-no-build (build-to-tape build)] + state + :: + =/ =build-status u.maybe-build-status + :: never delete a build that something depends on + :: + ?^ clients.build-status + :: ~& [%cleanup-clients-no-op (build-to-tape build)] + state + ?^ requesters.build-status + :: ~& [%cleanup-requesters-no-op (build-to-tape build)] + state + :: ~& [%cleanup (build-to-tape build)] + :: + (remove-builds ~[build]) + :: +collect-live-resources: produces all live resources from sub-scrys + :: + ++ collect-live-resources + |= =build + ^- (jug disc resource) + :: ~& [%collect-live-resources (build-to-tape build)] + :: + ?: ?=(%scry -.schematic.build) + =* resource resource.schematic.build + (my [(extract-disc resource) (sy [resource]~)]~) + :: + ?: ?=(%pin -.schematic.build) + ~ + :: + =/ subs ~(tap in ~(key by subs:(~(got by builds.state) build))) + =| resources=(jug disc resource) + |- + ?~ subs + resources + :: + =/ sub-resources=(jug disc resource) ^$(build i.subs) + =. resources (unify-jugs resources sub-resources) + $(subs t.subs) + :: +collect-blocked-resources: produces all blocked resources from sub-scrys + :: + ++ collect-blocked-sub-scrys + |= =build + ^- (set scry-request) + :: + ?: ?=(%scry -.schematic.build) + =, resource.schematic.build + =/ =scry-request + :+ vane care + ^- beam + [[ship.disc.rail desk.disc.rail [%da date.build]] spur.rail] + (sy [scry-request ~]) + :: only recurse on blocked sub-builds + :: + =/ subs=(list ^build) + %+ murn ~(tap by subs:(~(got by builds.state) build)) + |= [sub=^build =build-relation] + ^- (unit ^build) + :: + ?. blocked.build-relation + ~ + `sub + :: + =| scrys=(set scry-request) + |- + ^+ scrys + ?~ subs + scrys + :: + =. scrys (~(uni in scrys) ^$(build i.subs)) + $(subs t.subs) + :: +start-clay-subscription: listen for changes in the filesystem + :: + ++ start-clay-subscription + |= =subscription + ^+ ..execute + :: + =/ already-subscribed=? + (~(has by pending-subscriptions.state) subscription) + :: ~& [%start-clay-subscription subscription already-subscribed=already-subscribed pending-subscriptions.state] + :: + =. pending-subscriptions.state + (put-request pending-subscriptions.state subscription duct) + :: don't send a duplicate move if we're already subscribed + :: + ?: already-subscribed + ..execute + :: + =/ =wire (clay-subscription-wire [date disc]:subscription) + :: + =/ =note + :: request-contents: the set of [care path]s to subscribe to in clay + :: + =/ request-contents=(set [care:clay path]) + %- sy ^- (list [care:clay path]) + %+ murn ~(tap in `(set resource)`resources.subscription) + |= =resource ^- (unit [care:clay path]) + :: + ?. ?=(%c -.resource) ~ + :: + `[care.resource (flop spur.rail.resource)] + :: if :request-contents is `~`, this code is incorrect + :: + ?< ?=(~ request-contents) + :: their: requestee +ship + :: + =+ [their desk]=disc.subscription + :: + :^ %c %warp sock=[our their] + ^- riff:clay + [desk `[%mult `case`[%da date.subscription] request-contents]] + :: + =. moves [`move`[duct [%pass wire note]] moves] + :: + ..execute + :: +cancel-clay-subscription: remove a subscription on :duct + :: + ++ cancel-clay-subscription + |= =subscription + ^+ ..execute + :: + :: ~& [%cancel-clay-subscription subscription pending-subscriptions.state] + =^ originator pending-subscriptions.state + (del-request pending-subscriptions.state subscription duct) + :: if there are still other ducts on this subscription, don't send a move + :: + ?~ originator + ..execute + :: + =/ =wire (clay-subscription-wire [date disc]:subscription) + :: + =/ =note + =+ [their desk]=disc.subscription + [%c %warp sock=[our their] `riff:clay`[desk ~]] + :: + =. moves [`move`[u.originator [%pass wire note]] moves] + :: + ..execute + :: +clay-sub-wire: the wire to use for a clay subscription + :: + :: While it is possible for two different root builds to make + :: subscriptions with the same wire, those wires will always be associated + :: with different ducts, so there's no risk of duplicates. + :: + ++ clay-subscription-wire + |= [date=@da =disc] + ^- wire + :: + =+ [their desk]=disc + :: + /(scot %p our)/clay-sub/(scot %p their)/[desk]/(scot %da date) + :: +start-scry-request: kick off an asynchronous request for a resource + :: + ++ start-scry-request + |= =scry-request + ^+ ..execute + :: we only know how to make asynchronous scrys to clay, for now + :: + ?> ?=(%c vane.scry-request) + :: if we are the first block depending on this scry, send a move + :: + =/ already-started=? (~(has by pending-scrys.state) scry-request) + :: + =. pending-scrys.state + (put-request pending-scrys.state scry-request duct) + :: don't send a duplicate move if we've already sent one + :: + ?: already-started + ..execute + :: + =/ =wire (scry-request-wire scry-request) + :: + =/ =note + =, scry-request + =/ =disc [p q]:beam + :* %c %warp sock=[our their=ship.disc] desk.disc + `[%sing care case=r.beam (flop s.beam)] + == + :: + =. moves [`move`[duct [%pass wire note]] moves] + :: + ..execute + :: +cancel-scry-request: cancel a pending asynchronous scry request + :: + ++ cancel-scry-request + |= =scry-request + ^+ ..execute + :: we only know how to make asynchronous scrys to clay, for now + :: + ?> ?=(%c vane.scry-request) + :: + =^ originator pending-scrys.state + (del-request pending-scrys.state scry-request duct) + :: if there are still other ducts on this subscription, don't send a move + :: + ?~ originator + ..execute + :: + =/ =wire (scry-request-wire scry-request) + :: + =/ =note + =+ [their desk]=[p q]:beam.scry-request + [%c %warp sock=[our their] `riff:clay`[desk ~]] + :: + =. moves [`move`[u.originator [%pass wire note]] moves] + :: + ..execute + :: +scry-request-wire + :: + ++ scry-request-wire + |= =scry-request + ^- wire + (welp /(scot %p our)/scry-request (scry-request-to-path scry-request)) + -- +-- +:: +:: end =~ +:: +. == +=, ford :: TODO remove once in vane +:: +:::: vane core + :: +=| ax=axle +|= [now=@da eny=@ scry-gate=sley] +:: allow jets to be registered within this core +:: +~% %ford-d ..is ~ :: XX why the '-d'? +:: +:: ^? :: to be added to real vane +:: +|% +:: +call: handle a +task:able from arvo +:: +++ call + |= [=duct type=* wrapped-task=(hobo task:able)] + ^- [p=(list move) q=_ford-gate] + :: unwrap :task from :wrapped-task + :: + =/ task=task:able + ?. ?=(%soft -.wrapped-task) + wrapped-task + ((hard task:able) p.wrapped-task) + :: + ?- -.task + :: %build: request to perform a build + :: + %build + :: perform the build indicated by :task + :: + :: First, we find or create the :ship-state for :our.task, + :: modifying :state-by-ship as necessary. Then we dispatch to the |ev + :: by constructing :event-args and using them to create :start-build, + :: which performs the build. The result of :start-build is a pair of + :: :moves and a mutant :ship-state. We update our :state-by-ship map + :: with the new :ship-state and produce it along with :moves. + :: + =^ ship-state state-by-ship.ax (find-or-create-ship-state our.task) + =/ =build [now schematic.task] + =* event-args [[our.task duct now scry-gate] ship-state] + =* start-build start-build:(per-event event-args) + =^ moves ship-state (start-build build live.task) + =. state-by-ship.ax (~(put by state-by-ship.ax) our.task ship-state) + :: + [moves ford-gate] + :: + :: %kill: cancel a %build + :: + %kill + :: + =/ ship-state ~|(our+our.task (~(got by state-by-ship.ax) our.task)) + =* event-args [[our.task duct now scry-gate] ship-state] + =^ moves ship-state cancel:(per-event event-args) + =. state-by-ship.ax (~(put by state-by-ship.ax) our.task ship-state) + :: + [moves ford-gate] + :: + :: %wipe: wipe the cache, clearing half the entries + :: + %wipe + :: + =/ ship-states=(list [@p ford-state]) ~(tap by state-by-ship.ax) + :: wipe each ship in the state separately + :: + =. state-by-ship.ax + %+ roll ship-states + |= [[ship=@p state=ford-state] accumulator=(map @p ford-state)] + :: + (~(put by accumulator) ship (wipe state)) + :: + [~ ford-gate] + :: + %wegh + :_ ford-gate + :_ ~ + :^ duct %give %mass + ^- mass + :- %turbo + :- %| + %+ turn ~(tap by state-by-ship.ax) :: XX single-home + |= [our=@ ford-state] ^- mass + :+ (scot %p our) %| + :: + :~ [%builds [%& builds]] + [%ducts [%& ducts]] + [%builds-by-schematic [%& builds-by-schematic]] + [%pending-scrys [%& pending-scrys]] + [%pending-subscriptions [%& pending-subscriptions]] + == + == +:: +wipe: wipe half a +ford-state's cache, in LRU (least recently used) order +:: +++ wipe + |= state=ford-state + ^+ state + :: + =/ cache-list=(list [build build-record]) + %+ murn ~(tap by builds.state) + |= [=build =build-status] + ^- (unit [^build build-record]) + :: + ?. ?=(%complete -.state.build-status) + ~ + `[build build-record.state.build-status] + :: + =/ split-cache=[(list [build build-record]) (list [build build-record])] + %+ skid cache-list + |=([=build =build-record] ?=(%tombstone -.build-record)) + :: + =/ tombstones=(list [build build-record]) -.split-cache + =/ values=(list [build build-record]) +.split-cache + :: sort the cache lines in chronological order by :last-accessed + :: + =/ sorted=(list [build build-record]) + %+ sort values + |= [a=[=build =build-record] b=[=build =build-record]] + ^- ? + :: + ?> ?=(%value -.build-record.a) + ?> ?=(%value -.build-record.b) + :: + (lte last-accessed.build-record.a last-accessed.build-record.b) + :: + =/ num-entries=@ (lent cache-list) + :: num-stale: half of :num-entries, rounded up in case :num-entries is 1 + :: + =/ num-stale (sub num-entries (div num-entries 2)) + ~& "ford: wipe: {} cache entries" + :: + =/ stale=(list [build build-record]) (scag num-stale sorted) + :: + %_ state + builds + %- ~(gas by builds.state) + %+ turn stale + |= [=build =build-record] + ^- (pair ^build build-status) + :: + =/ =build-status (~(got by builds.state) build) + ?> ?=(%complete -.state.build-status) + :: + [build build-status(build-record.state [%tombstone ~])] + == +:: +take: receive a response from another vane +:: +++ take + |= [=wire =duct wrapped-sign=(hypo sign)] + ^- [p=(list move) q=_ford-gate] + :: unwrap :sign from :wrapped-sign + :: + :: TODO: verify wrapped-sign isn't an evil vase? + :: + =/ =sign q.wrapped-sign + :: TODO: support other responses + :: + :: parse :wire into :our, :ship-state, and :resource + :: + ?> ?=([@ @ *] wire) + :: we know :our is already in :state-by-ship because we sent this request + :: + =/ our=@p (slav %p i.wire) + =/ ship-state ~|(take-our+our (~(got by state-by-ship.ax) our)) + :: + |^ ^- [p=(list move) q=_ford-gate] + :: + =^ moves ship-state + ?+ i.t.wire ~|([%bad-take-wire wire] !!) + %clay-sub take-rebuilds + %scry-request take-unblocks + == + :: + =. state-by-ship.ax (~(put by state-by-ship.ax) our ship-state) + :: + [moves ford-gate] + :: +take-rebuilds: rebuild all live builds affected by the Clay changes + :: + ++ take-rebuilds + ^- [(list move) ford-state] + :: + ?> ?=([%c %wris *] sign) + =+ [ship desk date]=(raid:wired t.t.wire ~[%p %tas %da]) + =/ disc [ship desk] + :: + :: ~& [%pending-subscriptions pending-subscriptions.ship-state] + =/ =subscription + ~| [%ford-take-bad-clay-sub wire=wire duct=duct] + =/ =duct-status (~(got by ducts.ship-state) duct) + ?> ?=(%live -.live.duct-status) + ?> ?=(^ last-sent.live.duct-status) + ?> ?=(^ subscription.u.last-sent.live.duct-status) + u.subscription.u.last-sent.live.duct-status + :: ~& [%subscription subscription] + :: + =/ ducts=(list ^duct) + ~| [%ford-take-missing-subscription subscription] + (get-request-ducts pending-subscriptions.ship-state subscription) + :: ~& [%ducts-for-clay-sub ducts] + :: + =| moves=(list move) + |- ^+ [moves ship-state] + ?~ ducts [moves ship-state] + :: + =* event-args [[our i.ducts now scry-gate] ship-state] + =* rebuild rebuild:(per-event event-args) + =^ duct-moves ship-state + (rebuild subscription p.case.sign disc care-paths.sign) + :: + $(ducts t.ducts, moves (weld moves duct-moves)) + :: +take-unblocks: unblock all builds waiting on this scry request + :: + ++ take-unblocks + ^- [(list move) ford-state] + :: + ?> ?=([%c %writ *] sign) + :: scry-request: the +scry-request we had previously blocked on + :: + =/ =scry-request + ~| [%ford-take-bad-scry-request wire=wire duct=duct] + (need (path-to-scry-request t.t.wire)) + :: scry-result: parse a (unit cage) from :sign + :: + :: If the result is `~`, the requested resource was not available. + :: + =/ scry-result=(unit cage) + ?~ riot.sign + ~ + `r.u.riot.sign + :: + =/ ducts=(list ^duct) + ~| [%ford-take-missing-scry-request scry-request] + (get-request-ducts pending-scrys.ship-state scry-request) + :: ~& [%ducts-for-scrys ducts] + :: + =| moves=(list move) + |- ^+ [moves ship-state] + ?~ ducts [moves ship-state] + :: + =* event-args [[our i.ducts now scry-gate] ship-state] + :: unblock the builds that had blocked on :resource + :: + =* unblock unblock:(per-event event-args) + =^ duct-moves ship-state (unblock scry-request scry-result) + :: + $(ducts t.ducts, moves (weld moves duct-moves)) + -- +:: +load: migrate old state to new state (called on vane reload) +:: +++ load + |= old=axle ^+ ..^$ - ?~ lox - ~& %ford-reset - ..^$ - ..^$(+>- u.lox) + :: + ~! %loading + ..^$(ax old) +:: +stay: produce current state +:: +++ stay `axle`ax +:: +scry: request a path in the urbit namespace :: ++ scry - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) + |= * [~ ~] +:: %utilities :: -++ stay :: save w+o cache - `axle`+>-.$(pol (~(run by pol) |=(a/baby a(jav ~)))) +::+| :: -++ take :: response - |= {tea/wire hen/duct hin/(hypo sign)} - ^+ [p=*(list move) q=..^$] - ?> ?=({@ @ *} tea) - =+ our=(slav %p i.tea) - =+ bay=(~(got by pol.lex) our) - =^ mos bay - ~| tea - =+ dep=((soft care:clay) i.t.tea) - ?^ dep - =+ bem=(need (de-beam t.t.tea)) - (~(deps-take za [our hen [now eny ski] ~] bay) u.dep bem q.hin) - :: - ?^ (slaw %uv i.t.tea) - ~& old-dephash+i.t.tea - [~ bay] - ?> ?=({@ @ ^} t.t.tea) - =+ :* num=(slav %ud i.t.tea) - van=((hard vane) i.t.t.tea) - ren=((hard care:clay) i.t.t.t.tea) - bem=(need (de-beam t.t.t.t.tea)) - == - (~(task-take za [our hen [now eny ski] ~] bay) num [van ren bem] q.hin) - [mos ..^$(pol (~(put by pol) our bay))] +++ ford-gate ..$ +:: +find-or-create-ship-state: find or create a ford-state for a @p +:: +:: Accesses and modifies :state-by-ship. +:: +++ find-or-create-ship-state + |= our=@p + ^- [ford-state _state-by-ship.ax] + :: + =/ existing (~(get by state-by-ship.ax) our) + ?^ existing + [u.existing state-by-ship.ax] + :: + =| new-state=ford-state + [new-state (~(put by state-by-ship.ax) our new-state)] -- diff --git a/sys/vane/gall.hoon b/sys/vane/gall.hoon index 3e91d6e9e9..0f92a66213 100644 --- a/sys/vane/gall.hoon +++ b/sys/vane/gall.hoon @@ -1,3 +1,4 @@ +!: :: :: %gall, agent execution !? 163 :::: @@ -150,7 +151,7 @@ :: +mo-recieve-core: receives an app core built by ford-turbo :: ++ mo-recieve-core - |= [dap=dude byk=beak made-result=made-result:ford-api] + |= [dap=dude byk=beak made-result=made-result:ford] ^+ +> :: ?: ?=([%incomplete *] made-result) @@ -161,7 +162,7 @@ ?: ?=([%error *] build-result) (mo-give %onto %| message.build-result) :: - =/ result-cage=cage (result-to-cage:ford-api build-result) + =/ result-cage=cage (result-to-cage:ford build-result) :: =/ app-data=(unit seat) (~(get by bum) dap) ?^ app-data @@ -206,7 +207,7 @@ ^+ +> %+ mo-pass [%sys %core dap (scot %p p.byk) q.byk (scot r.byk) ~] ^- note-arvo - [%t %build our live=%.y [%core [[p q]:byk [%hoon dap %app ~]]]] + [%f %build our live=%.y [%core [[p q]:byk [%hoon dap %app ~]]]] :: ++ mo-away :: foreign request |= {him/ship caz/cush} :: @@ -306,14 +307,14 @@ ^+ +> ?+ -.pax !! $core - ?> ?=([%t %made *] sih) + ?> ?=([%f %made *] sih) ?> ?=({@ @ @ @ $~} t.pax) (mo-recieve-core i.t.pax (mo-chew t.t.pax) result.sih) :: %pel :: translated peer ?> ?=({@ $~} t.pax) =+ mar=i.t.pax - ?> ?=([%t %made *] sih) + ?> ?=([%f %made *] sih) :: ?: ?=([%incomplete *] result.sih) (mo-give %unto %coup `tang.result.sih) @@ -323,7 +324,7 @@ ?: ?=([%error *] build-result) (mo-give %unto %coup `message.build-result) :: - (mo-give %unto %diff (result-to-cage:ford-api build-result)) + (mo-give %unto %diff (result-to-cage:ford build-result)) :: $red :: diff ack ?> ?=({@ @ @ $~} t.pax) @@ -343,7 +344,7 @@ :: %rep :: reverse request ?> ?=({@ @ @ $~} t.pax) - ?> ?=([%t %made *] sih) + ?> ?=([%f %made *] sih) =+ :* him=(slav %p i.t.pax) dap=i.t.t.pax num=(slav %ud i.t.t.t.pax) @@ -361,7 +362,7 @@ :: :: "XX pump should ack" =. +>.$ (mo-give %mack ~) - =* result-cage (result-to-cage:ford-api build-result) + =* result-cage (result-to-cage:ford build-result) (mo-give(hen (mo-ball him num)) %unto %diff result-cage) :: $req :: inbound request @@ -371,11 +372,17 @@ num=(slav %ud i.t.t.t.pax) == ?: ?=({$f $made *} sih) - ?- -.q.+>.sih - $tabl ~|(%made-tabl !!) - $| (mo-give %mack `p.q.+>.sih) :: XX should crash - $& (mo-pass [%sys pax] %g %deal [him our] i.t.t.pax %poke p.q.+>.sih) - == + ?: ?=([%incomplete *] result.sih) + :: "XX should crash" + (mo-give %mack `tang.result.sih) + :: + =/ build-result build-result.result.sih + :: + ?: ?=([%error *] build-result) + :: "XX should crash" + (mo-give %mack `message.build-result) + =/ cay/cage (result-to-cage:ford build-result) + (mo-pass [%sys pax] %g %deal [him our] i.t.t.pax %poke cay) ?: ?=({$a $woot *} sih) +>.$ :: quit ack, boring ?> ?=({$g $unto *} sih) =+ cuf=`cuft`+>.sih @@ -391,7 +398,7 @@ %val :: inbound validate ?> ?=({@ @ $~} t.pax) =+ [him=(slav %p i.t.pax) dap=i.t.t.pax] - ?> ?=([%t %made *] sih) + ?> ?=([%f %made *] sih) :: ?: ?=([%incomplete *] result.sih) (mo-give %unto %coup `tang.result.sih) @@ -401,7 +408,7 @@ ?: ?=([%error *] build-result) (mo-give %unto %coup `message.build-result) :: - =* result-cage (result-to-cage:ford-api build-result) + =* result-cage (result-to-cage:ford build-result) (mo-clip dap `prey`[%high ~ him] [%poke result-cage]) :: $way :: outbound request @@ -468,12 +475,12 @@ ?: ?=($puff -.cub) %+ mo-pass [%sys %val (scot %p q.q.pry) dap ~] - [%t %build our live=%.n [%vale [p q]:(mo-beak dap) +.cub]] + [%f %build our live=%.n [%vale [p q]:(mo-beak dap) +.cub]] ?: ?=($punk -.cub) %+ mo-pass [%sys %val (scot %p q.q.pry) dap ~] - :* %t %build our live=%.n - ^- schematic:ford-api + :* %f %build our live=%.n + ^- schematic:ford [%cast [p q]:(mo-beak dap) p.cub [%$ q.cub]] == ?: ?=($peer-not -.cub) @@ -510,7 +517,7 @@ $d %+ mo-pass [%sys %rep (scot %p him) dap (scot %ud num) ~] - [%t %build our live=%.n [%vale [p q]:(mo-beak dap) p.ron q.ron]] + [%f %build our live=%.n [%vale [p q]:(mo-beak dap) p.ron q.ron]] :: $x =. +> (mo-give %mack ~) :: XX should crash (mo-give(hen (mo-ball him num)) %unto %quit ~) @@ -588,7 +595,7 @@ ?: =(mar p.cay) [%give %unto p.q.cov] :+ %pass [%sys %pel dap ~] - [%t %build our live=%.n [%cast [p q]:(mo-beak dap) mar [%$ cay]]] + [%f %build our live=%.n [%cast [p q]:(mo-beak dap) mar [%$ cay]]] :: $pass :+ %pass `path`[%use dap p.q.cov] @@ -1213,12 +1220,11 @@ $crew `%c $crow `%c $deal `%g - $exec `%f + $build `%f + $kill `%f $flog `%d $drop `%c $info `%c - %kill `%t - %build `%t $merg `%c $mont `%c $nuke `%a @@ -1232,7 +1238,7 @@ $want `%a $warp `%c $well `%e - $wipe `%f :: XX cache clear + :: $wipe `%f :: XX cache clear == -- -- diff --git a/sys/vane/turbo.hoon b/sys/vane/turbo.hoon deleted file mode 100644 index 80641a2e7a..0000000000 --- a/sys/vane/turbo.hoon +++ /dev/null @@ -1,5424 +0,0 @@ -:: pit: a +vase of the hoon+zuse kernel, which is a deeply nested core -:: -|= pit=vase -:: -=, ford-api -:: ford internal data structures -:: -=> =~ -=, ford-api :: TODO remove once in vane -|% -:: +move: arvo moves that ford can emit -:: -+= move - :: - $: :: duct: request identifier - :: - =duct - :: card: move contents; either a +note or a +gift:able - :: - card=(wind note gift:able) - == -:: +note: private request from ford to another vane -:: -+= note - $% :: %c: to clay - :: - $: %c - :: %warp: internal (intra-ship) file request - :: - $% $: %warp - :: sock: pair of requesting ship, requestee ship - :: - =sock - :: riff: clay request contents - :: - riff=riff:clay - == == == - :: %g: to gall - :: - $: %g - :: %unto: full transmission - :: - :: TODO: document more fully - :: - $% $: %deal - :: sock: pair of requesting ship, requestee ship - :: - =sock - :: cush: gall request contents - :: - cush=cush:gall - == == == == -:: +sign: private response from another vane to ford -:: -+= sign - $% :: %c: from clay - :: - $: %c - $% :: %writ: internal (intra-ship) file response - :: - $: %writ - :: riot: response contents - :: - riot=riot:clay - == - :: %wris: response to %mult; many changed files - :: - $: %wris - :: case: case of the new files - :: - :: %wris can only return dates to us. - :: - case=[%da p=@da] - :: care-paths: the +care:clay and +path of each file - :: - care-paths=(set [care=care:clay =path]) - == == == == --- -:: -=, ford-api :: TODO remove once in vane -:: -|% -:: -:: +axle: overall ford state -:: -+= axle - $: :: date: date at which ford's state was updated to this data structure - :: - date=%~2018.6.28 - :: state-by-ship: storage for all the @p's this ford has been - :: - :: Once the cc-release boot sequence lands, we can remove this - :: mapping, since an arvo will not change @p identities. until - :: then, we need to support a ship booting as a comet before - :: becoming its adult identity. - :: - state-by-ship=(map ship ford-state) - == -:: +ford-state: all state that ford maintains for a @p ship identity -:: -+= ford-state - $: :: builds: per-build state machine for all builds - :: - :: Ford holds onto all in-progress builds that were either directly - :: requested by a duct (root builds) or that are dependencies - :: (sub-builds) of a directly requested build. - :: - :: It also stores the last completed version of each live build tree - :: (root build and sub-builds), and any cached builds. - :: - builds=(map build build-status) - :: ducts: per-duct state machine for all incoming ducts (build requests) - :: - :: Ford tracks every duct that has requested a build until it has - :: finished dealing with that request. - :: - :: For live ducts, we store the duct while we repeatedly run new - :: versions of the live build it requested until it is explicitly - :: canceled by the requester. - :: - :: A once (non-live) duct, on the other hand, will be removed - :: as soon as the requested build has been completed. - :: - ducts=(map duct duct-status) - :: builds-by-schematic: all attempted builds, sorted by time - :: - :: For each schematic we've attempted to build at any time, - :: list the formal dates of all build attempts, sorted newest first. - :: - builds-by-schematic=(map schematic (list @da)) - :: pending-scrys: outgoing requests for static resources - :: - pending-scrys=(request-tracker scry-request) - :: pending-subscriptions: outgoing subscriptions on live resources - :: - pending-subscriptions=(request-tracker subscription) - == -:: +build-status: current data for a build, including construction status -:: -:: +build-status stores the construction status of a build as a finite state -:: machine (:state). It stores links to dependent sub-builds in :subs, and -:: per-duct client builds in :clients. -:: -+= build-status - $: :: requesters: ducts for whom this build is the root build - :: - requesters=(set duct) - :: clients: per duct information for this build - :: - clients=(jug duct build) - :: subs: sub-builds of this build, for whom this build is a client - :: - subs=(map build build-relation) - :: state: a state machine for tracking the build's progress - :: - $= state - $% $: :: %untried: build has not been started yet - :: - %untried ~ - == - $: :: %blocked: build blocked on either sub-builds or resource - :: - :: If we're in this state and there are no blocks in :subs, - :: then we're blocked on a resource. - :: - %blocked ~ - == - $: :: %unblocked: we were blocked but now we aren't - :: - %unblocked ~ - == - $: :: %complete: build has finished running and has a result - :: - %complete - :: build-record: the product of the build, possibly tombstoned - :: - =build-record - == == == -:: +duct-status: information relating a build to a duct -:: -+= duct-status - $: :: live: whether this duct is being run live - :: - $= live - $% [%once in-progress=@da] - $: %live - :: - :: - in-progress=(unit @da) - :: the last subscription we made - :: - :: This can possibly have an empty set of resources, in which - :: we never sent a move. - :: - :: NOTE: This implies that a single live build can only depend - :: on live resources from a single disc. We don't have a - :: working plan for fixing this and will need to think very - :: hard about the future. - :: - last-sent=(unit [date=@da subscription=(unit subscription)]) - == == - :: root-schematic: the requested build for this duct - :: - root-schematic=schematic - == -:: +build-relation: how do two builds relate to each other? -:: -:: A +build-relation can be either :verified or not, and :blocked or not. -:: It is a symmetric relation between two builds, in the sense that both -:: the client and the sub will store the same relation, just pointing to -:: the other build. -:: -:: If it's not :verified, then the relation is a guess based on previous -:: builds. These guesses are used to ensure that we hold onto builds we -:: expect to be used in future builds. Each time we run +make on a build, -:: it might produce new :verified sub-builds, which may have been unverified -:: until then. Once a build completes, any unverified sub-builds must be -:: cleaned up, since it turned out they weren't used by the build after all. -:: -:: :blocked is used to note that a build can't be completed until that -:: sub-build has been completed. A relation can be :blocked but not :verified -:: if we're trying to promote a build, but we haven't run all its sub-builds -:: yet. In that case, we'll try to promote or run the sub-build in order to -:: determine whether we can promote the client. Until the sub-build has been -:: completed, the client is provisionally blocked on the sub-build. -:: -+= build-relation - $: :: verified: do we know this relation is real, or is it only a guess? - :: - verified=? - :: is this build blocked on this other build? - :: - blocked=? - == -:: +build-record: information associated with the result of a completed +build -:: -+= build-record - $% $: :: %tombstone: the build's result has been wiped - :: - %tombstone ~ - == - $: :: %value: we have the +build-result - :: - %value - :: last-accessed: last time we looked at the result - :: - :: This is used for LRU cache reclamation. - :: - last-accessed=@da - :: build-result: the stored value of the build's product - :: - =build-result - == == -:: +build: a referentially transparent request for a build -:: -:: Each unique +build will always produce the same +build-result -:: when run (if it completes). A live build consists of a sequence of -:: instances of +build with the same :schematic and increasing :date. -:: -+= build - $: :: date: the formal date of this build; unrelated to time of execution - :: - date=@da - :: schematic: the schematic that determines how to run this build - :: - =schematic - == -:: +request-tracker: generic tracker and multiplexer for pending requests -:: -++ request-tracker - |* request-type=mold - %+ map request-type - $: :: waiting: ducts blocked on this request - :: - waiting=(set duct) - :: originator: the duct that kicked off the request - :: - originator=duct - == -:: +subscription: a single subscription to changes on a set of resources -:: -+= subscription - $: :: date: date this was made - :: - date=@da - :: disc: ship and desk for all :resources - :: - =disc - :: resources: we will be notified if any of these resources change - :: - resources=(set resource) - == -:: +scry-request: parsed arguments to a scry operation -:: -+= scry-request - $: :: vane: the vane from which to make the request - :: - :: TODO: use +vane here - :: - vane=?(%c %g) - :: care: type of request - :: - care=care:clay - :: beam: request path - :: - =beam - == -:: +build-receipt: result of running +make -:: -:: A +build-receipt contains all information necessary to perform the -:: effects and state mutations indicated by a call to +make. If :build -:: succeeded, :result will be %build-result; otherwise, it will be %blocks. -:: -:: After +make runs on a batch of builds, the resulting +build-receipt's are -:: applied one at a time. -:: -+= build-receipt - $: :: build: the build we worked on - :: - =build - :: result: the outcome of this build - :: - $= result - $% :: %build-result: the build produced a result - :: - $: %build-result - =build-result - == - :: %blocks: the build blocked on the following builds or resource - :: - $: %blocks - :: builds: builds that :build blocked on - :: - builds=(list build) - :: scry-blocked: namespace request that :build blocked on - :: - scry-blocked=(unit scry-request) - == - == - :: sub-builds: subbuilds of :build - :: - :: While running +make on :build, we need to keep track of any - :: sub-builds that we try to access so we can keep track of - :: component linkages and cache access times. - :: - sub-builds=(list build) - == -:: +vane: short names for vanes -:: -:: TODO: move to zuse -:: -+= vane ?(%a %b %c %d %e %f %g) --- -=, format -|% -:: +tear: split a +term into segments delimited by `-` -:: -++ tear - |= a=term - ^- (list term) - :: sym-no-heps: a parser for terms with no heps and a leading letter - :: - =/ sym-no-heps (cook crip ;~(plug low (star ;~(pose low nud)))) - :: - (fall (rush a (most hep sym-no-heps)) /[a]) -:: +segments: TODO rename -:: -++ segments - |= path-part=@tas - ^- (list path) - :: - =/ join |=([a=@tas b=@tas] (crip "{(trip a)}-{(trip b)}")) - :: - =/ torn=(list @tas) (tear path-part) - :: - |- ^- (list (list @tas)) - :: - ?< ?=(~ torn) - :: - ?: ?=([@ ~] torn) - ~[torn] - :: - %- zing - %+ turn $(torn t.torn) - |= s=(list @tas) - ^- (list (list @tas)) - :: - ?> ?=(^ s) - ~[[i.torn s] [(join i.torn i.s) t.s]] -:: +build-to-tape: convert :build to a printable format -:: -++ build-to-tape - |= =build - ^- tape - :: - =/ enclose |=(tape "[{+<}]") - =/ date=@da date.build - =/ =schematic schematic.build - :: - %- enclose - %+ welp (trip (scot %da date)) - %+ welp " " - :: - ?+ -.schematic - :(welp "[" (trip -.schematic) " {<`@uvI`(mug schematic)>}]") - :: - %$ - "literal" - :: - ^ - %- enclose - ;:(welp $(build [date head.schematic]) " " $(build [date tail.schematic])) - :: - %alts - ;: welp - %+ roll choices.schematic - |= [choice=^schematic txt=_"[alts"] - :(welp txt " " ^$(schematic.build choice)) - :: - "]" - == - :: - %core - :(welp "[core " (spud (en-beam (rail-to-beam source-path.schematic))) "]") - :: - %hood - :(welp "[hood " (spud (en-beam (rail-to-beam source-path.schematic))) "]") - :: - %plan - :(welp "[plan " (spud (en-beam (rail-to-beam path-to-render.schematic))) "]") - :: - %scry - (spud (en-beam (extract-beam resource.schematic ~))) - :: - :: %slim - :: "slim {} {}" - :: - %vale - :(welp "[vale [" (trip (scot %p ship.disc.schematic)) " " (trip desk.disc.schematic) "] " (trip mark.schematic) "]") - == -:: +rail-to-beam -:: -++ rail-to-beam - |= =rail - ^- beam - [[ship.disc.rail desk.disc.rail [%ud 0]] spur.rail] -:: +unify-jugs: make a new jug, unifying sets for all keys -:: -++ unify-jugs - |* [a=(jug) b=(jug)] - ^+ a - :: - =/ tapped ~(tap by b) - :: - |- ^+ a - ?~ tapped a - :: - =/ key p.i.tapped - =/ vals ~(tap in q.i.tapped) - :: - =. a - |- ^+ a - ?~ vals a - :: - $(vals t.vals, a (~(put ju a) key i.vals)) - :: - $(tapped t.tapped) -:: +scry-request-to-path: encode a +scry-request in a +wire -:: -++ scry-request-to-path - |= =scry-request - ^- path - =/ =term (cat 3 [vane care]:scry-request) - [term (en-beam beam.scry-request)] -:: +path-to-resource: decode a +resource from a +wire -:: -++ path-to-resource - |= =path - ^- (unit resource) - :: - =/ scry-request=(unit scry-request) (path-to-scry-request path) - ?~ scry-request - ~ - =+ [vane care bem]=u.scry-request - =/ =beam bem - =/ =rail [disc=[p.beam q.beam] spur=s.beam] - `[vane care rail] -:: +path-to-scry-request: parse :path to a :scry-request -:: -++ path-to-scry-request - |= =path - ^- (unit scry-request) - :: - ?. ?=([@ @ *] path) - ~ - :: parse :path's components into :vane, :care, and :rail - :: - =/ vane=(unit ?(%c %g)) ((soft ?(%c %g)) (end 3 1 i.path)) - ?~ vane - ~ - =/ care=(unit care:clay) ((soft care:clay) (rsh 3 1 i.path)) - ?~ care - ~ - =/ rest=(unit ^path) ((soft ^path) t.path) - ?~ rest - ~ - =/ beam (de-beam u.rest) - ?~ beam - ~ - :: we only operate on dates, not other kinds of +case:clay - :: - ?. ?=(%da -.r.u.beam) - ~ - :: - `[u.vane u.care u.beam] -:: +scry-request-to-build: convert a +scry-request to a %scry build -:: -++ scry-request-to-build - |= =scry-request - ^- build - :: we only operate on dates, not other kinds of +case:clay - :: - ?> ?=(%da -.r.beam.scry-request) - :: - =, scry-request - [p.r.beam [%scry [vane care `rail`[[p q] s]:beam]]] -:: +extract-beam: obtain a +beam from a +resource -:: -:: Fills case with [%ud 0] for live resources if :date is `~`. -:: For once resources, ignore :date. -:: -++ extract-beam - |= [=resource date=(unit @da)] ^- beam - :: - =/ =case ?~(date [%ud 0] [%da u.date]) - :: - =, rail.resource - [[ship.disc desk.disc case] spur] -:: +extract-disc: obtain a +disc from a +resource -:: -++ extract-disc - |= =resource ^- disc - disc.rail.resource -:: +get-sub-schematics: find any schematics contained within :schematic -:: -++ get-sub-schematics - |= =schematic - ^- (list ^schematic) - ?- -.schematic - ^ ~[head.schematic tail.schematic] - %$ ~ - %pin ~[schematic.schematic] - %alts choices.schematic - %bake ~ - %bunt ~ - %call ~[gate.schematic sample.schematic] - %cast ~[input.schematic] - %core ~ - %diff ~[start.schematic end.schematic] - %dude ~[attempt.schematic] - %hood ~ - %join ~[first.schematic second.schematic] - %list schematics.schematic - %mash ~[schematic.first.schematic schematic.second.schematic] - %mute [subject.schematic (turn mutations.schematic tail)] - %pact ~[start.schematic diff.schematic] - %path ~ - %plan ~ - %reef ~ - %ride ~[subject.schematic] - %same ~[schematic.schematic] - %scry ~ - %slim ~ - %slit ~ - %vale ~ - %volt ~ - %walk ~ - == -:: +by-schematic: door for manipulating :by-schematic.builds.ford-state -:: -:: The :dates list for each key in :builds is sorted in reverse -:: chronological order. These operations access and mutate keys and values -:: of :builds and maintain that sort order. -:: -++ by-schematic - |_ builds=(map schematic (list @da)) - :: +put: add a +build to :builds - :: - :: If :build already exists in :builds, this is a no-op. - :: Otherwise, replace the value at the key :schematic.build - :: with a new :dates list that contains :date.build. - :: - ++ put - |= =build - ^+ builds - %+ ~(put by builds) schematic.build - :: - =/ dates (fall (~(get by builds) schematic.build) ~) - ?^ (find [date.build]~ dates) - dates - (sort [date.build dates] gte) - :: +del: remove a +build from :builds - :: - :: Removes :build from :builds by replacing the value at - :: the key :schematic.build with a new :dates list with - :: :date.build omitted. If the resulting :dates list is - :: empty, then remove the key-value pair from :builds. - :: - ++ del - |= =build - ^+ builds - =. builds %+ ~(put by builds) schematic.build - :: - ~| build+build - =/ dates (~(got by builds) schematic.build) - =/ date-index (need (find [date.build]~ dates)) - (oust [date-index 1] dates) - :: if :builds has an empty entry for :build, delete it - :: - =? builds - =(~ (~(got by builds) schematic.build)) - (~(del by builds) schematic.build) - :: - builds - :: +find-previous: find the most recent older build with :schematic.build - :: - ++ find-previous - |= =build - ^- (unit ^build) - :: - =/ dates=(list @da) (fall (~(get by builds) schematic.build) ~) - :: - |- ^- (unit ^build) - ?~ dates ~ - :: - ?: (lth i.dates date.build) - `[i.dates schematic.build] - $(dates t.dates) - :: +find-next: find the earliest build of :schematic.build later than :build - :: - ++ find-next - |= =build - ^- (unit ^build) - :: - =/ dates=(list @da) (flop (fall (~(get by builds) schematic.build) ~)) - :: - |- ^- (unit ^build) - ?~ dates ~ - :: - ?: (gth i.dates date.build) - `[i.dates schematic.build] - $(dates t.dates) - -- -:: +get-request-ducts: all ducts waiting on this request -:: -++ get-request-ducts - |* [tracker=(request-tracker) request=*] - ^- (list duct) - :: - ~(tap in waiting:(~(got by tracker) request)) -:: +put-request: associates a +duct with a request -:: -++ put-request - |* [tracker=(request-tracker) request=* =duct] - :: - %+ ~(put by tracker) request - ?~ existing=(~(get by tracker) request) - [(sy duct ~) duct] - u.existing(waiting (~(put in waiting.u.existing) duct)) -:: +del-request: remove a duct and produce the originating duct if empty -:: -++ del-request - |* [tracker=(request-tracker) request=* =duct] - ^- [(unit ^duct) _tracker] - :: remove :duct from the existing :record of this :request - :: - =/ record (~(got by tracker) request) - =. waiting.record (~(del in waiting.record) duct) - :: if no more ducts wait on :request, delete it - :: - ?^ waiting.record - [~ (~(put by tracker) request record)] - [`originator.record (~(del by tracker) request)] -:: +parse-scaffold: produces a parser for a hoon file with +crane instances -:: -:: Ford parses a superset of hoon which contains additional runes to -:: represent +crane s. This parses to a +scaffold. -:: -:: src-beam: +beam of the source file we're parsing -:: -++ parse-scaffold - |= src-beam=beam - :: - =/ hoon-parser (vang & (en-beam src-beam)) - |^ :: - %+ cook - |= a=[@ud (list ^cable) (list ^cable) (list ^crane) (list hoon)] - ^- scaffold - [[[p q] s]:src-beam a] - :: - %+ ifix [gay gay] - ;~ plug - :: parses the zuse version, eg "/? 309" - :: - ;~ pose - (ifix [;~(plug fas wut gap) gap] dem) - (easy zuse) - == - :: pareses the structures, eg "/- types" - :: - ;~ pose - (ifix [;~(plug fas hep gap) gap] (most ;~(plug com gaw) cable)) - (easy ~) - == - :: parses the libraries, eg "/+ lib1, lib2" - :: - ;~ pose - (ifix [;~(plug fas lus gap) gap] (most ;~(plug com gaw) cable)) - (easy ~) - == - :: - (star ;~(sfix crane gap)) - :: - (most gap tall:hoon-parser) - == - :: +beam: parses a hood path and converts it to a beam - :: - ++ beam - %+ sear de-beam - ;~ pfix - fas - (sear plex (stag %clsg poor)):hoon-parser - == - :: +cable: parses a +^cable, a reference to something on the filesystem - :: - :: This parses: - :: - :: `library` -> wraps `library` around the library `library` - :: `face=library` -> wraps `face` around the library `library` - :: `*library` -> exposes `library` directly to the subject - :: - ++ cable - %+ cook |=(a=^cable a) - ;~ pose - (stag ~ ;~(pfix tar sym)) - (cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym)) - (cook |=(a=term [`a a]) sym) - == - :: +crane: all runes that start with / which aren't /?, /-, /+ or //. - :: - ++ crane - =< apex - :: whether we allow tall form - =| allow-tall-form=? - :: - |% - ++ apex - %+ knee *^crane |. ~+ - ;~ pfix fas - ;~ pose - :: `/~` hoon literal - (stag %fssg ;~(pfix sig hoon)) - :: `/$` process query string - (stag %fsbc ;~(pfix buc hoon)) - :: `/|` first of many options that succeeds - (stag %fsbr ;~(pfix bar parse-alts)) - :: `/=` wrap a face around a crane - (stag %fsts ;~(pfix tis parse-face)) - :: `/.` null terminated list - (stag %fsdt ;~(pfix dot parse-list)) - :: `/,` switch by path - (stag %fscm ;~(pfix com parse-switch)) - :: `/&` pass through a series of mark - (stag %fspm ;~(pfix pam parse-pipe)) - :: `/_` run a crane on each file in the current directory - (stag %fscb ;~(pfix cab subcrane)) - :: `/;` passes date through a gate - (stag %fssm ;~(pfix sem parse-gate)) - :: `/:` evaluate at path - (stag %fscl ;~(pfix col parse-at-path)) - :: `/^` cast - (stag %fskt ;~(pfix ket parse-cast)) - :: `/!mark/ evaluate as hoon, then pass through mark - (stag %fszp ;~(pfix zap ;~(sfix sym fas))) - :: `/mark/` passes current path through :mark - (stag %fszy ;~(sfix sym fas)) - == - == - :: +parse-alts: parse a set of alternatives - :: - ++ parse-alts - %+ wide-or-tall - (ifix [pel per] (most ace subcrane)) - ;~(sfix (star subcrane) gap duz) - :: +parse-face: parse a face around a subcrane - :: - ++ parse-face - %+ wide-or-tall - ;~(plug sym ;~(pfix tis subcrane)) - ;~(pfix gap ;~(plug sym subcrane)) - :: +parse-list: parse a null terminated list of cranes - :: - ++ parse-list - %+ wide-or-tall - fail - ;~(sfix (star subcrane) gap duz) - :: +parse-switch: parses a list of [path crane] - :: - ++ parse-switch - %+ wide-or-tall - fail - =- ;~(sfix (star -) gap duz) - ;~(pfix gap fas ;~(plug static-path subcrane)) - :: +parse-pipe: parses a pipe of mark conversions - :: - ++ parse-pipe - %+ wide-or-tall - ;~(plug (plus ;~(sfix sym pam)) subcrane) - =+ (cook |=(a=term [a ~]) sym) - ;~(pfix gap ;~(plug - subcrane)) - :: +parse-gate: parses a gate applied to a crane - :: - ++ parse-gate - %+ wide-or-tall - ;~(plug ;~(sfix wide:hoon-parser sem) subcrane) - ;~(pfix gap ;~(plug tall:hoon-parser subcrane)) - :: +parse-at-path: parses a late bound bath - :: - ++ parse-at-path - %+ wide-or-tall - ;~(plug ;~(sfix late-bound-path col) subcrane) - ;~(pfix gap ;~(plug late-bound-path subcrane)) - :: +parse-cast: parses a mold and then the subcrane to apply that mold to - :: - ++ parse-cast - %+ wide-or-tall - ;~(plug ;~(sfix wide:hoon-parser ket) subcrane) - ;~(pfix gap ;~(plug tall:hoon-parser subcrane)) - :: +crane: parses a subcrane - :: - ++ subcrane - %+ wide-or-tall - apex(allow-tall-form |) - ;~(pfix gap apex) - :: +wide-or-tall: parses tall form hoon if :allow-tall-form is %.y - :: - ++ wide-or-tall - |* [wide=rule tall=rule] - ?. allow-tall-form wide - ;~(pose wide tall) - :: +hoon: parses hoon as an argument to a crane - :: - ++ hoon - %+ wide-or-tall - (ifix [sel ser] (stag %cltr (most ace wide:hoon-parser))) - ;~(pfix gap tall:hoon-parser) - -- - :: +static-path: parses a path - :: - ++ static-path - (sear plex (stag %clsg (more fas hasp))):hoon-parser - :: +late-bound-path: a path whose time varies - :: - ++ late-bound-path - ;~ pfix fas - %+ cook |=(a=truss a) - => hoon-parser - ;~ plug - (stag ~ gash) - ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~)) - == - == - -- - - -:: +per-event: per-event core -:: -++ per-event - :: moves: the moves to be sent out at the end of this event, reversed - :: - =| moves=(list move) - :: scry-results: responses to scry's to handle in this event - :: - :: If a value is `~`, the requested resource is not available. - :: Otherwise, the value will contain a +cage. - :: - =| scry-results=(map scry-request (unit cage)) - :: next-builds: builds to perform in the next iteration - :: - =| next-builds=(set build) - :: candidate-builds: builds which might go into next-builds - :: - =| candidate-builds=(set build) - :: the +per-event gate; each event will have a different sample - :: - :: Not a `|_` because of the `=/`s at the beginning. - :: Produces a core containing four public arms: - :: +start-build, +rebuild, +unblock, and +cancel. - :: - |= [[our=@p =duct now=@da scry=sley] state=ford-state] - :: - |% - ++ finalize - ^- [(list move) ford-state] - [(flop moves) state] - :: |entry-points: externally fired arms - :: - ::+| entry-points - :: - :: +start-build: perform a fresh +build, either live or once - :: - ++ start-build - |= [=build live=?] - ^- [(list move) ford-state] - :: - =< finalize - :: - =. ducts.state - %+ ~(put by ducts.state) duct - :_ schematic.build - ?: live - [%live in-progress=`date.build last-sent=~] - [%once in-progress=date.build] - :: - =. state (add-build build) - :: - =. builds.state - =< builds - %+ update-build-status build - |= =build-status - build-status(requesters (~(put in requesters.build-status) duct)) - :: - =. builds.state (add-duct-to-subs duct build) - :: - (execute-loop (sy [build ~])) - :: +rebuild: rebuild any live builds based on +resource updates - :: - ++ rebuild - |= [=subscription new-date=@da =disc care-paths=(set [care=care:clay =path])] - ^- [(list move) ford-state] - :: - =< finalize - :: - :: ~& [%rebuild subscription=subscription pending-subscriptions.state] - =. pending-subscriptions.state - +:(del-request pending-subscriptions.state subscription duct) - :: - =/ builds=(list build) - %+ turn ~(tap in care-paths) - |= [care=care:clay =path] - ^- build - :: - [new-date [%scry [%c care rail=[disc spur=(flop path)]]]] - :: - =/ duct-status (~(got by ducts.state) duct) - ?> ?=(%live -.live.duct-status) - :: sanity check; only rebuild once we've completed the previous one - :: - ?> ?=(~ in-progress.live.duct-status) - ?> ?=(^ last-sent.live.duct-status) - :: set the in-progress date for this new build - :: - =. ducts.state - %+ ~(put by ducts.state) duct - duct-status(in-progress.live `new-date) - :: - =/ old-root=build - [date.u.last-sent.live.duct-status root-schematic.duct-status] - =. state - (copy-build-tree-as-provisional old-root new-date=new-date) - :: gather all the :builds, forcing reruns - :: - =. ..execute (gather (sy builds) force=%.y) - :: rebuild resource builds at the new date - :: - (execute-loop ~) - :: +unblock: continue builds that had blocked on :resource - :: - ++ unblock - |= [=scry-request scry-result=(unit cage)] - ^- [(list move) ford-state] - :: - =< finalize - :: place :scry-result in :scry-results.per-event - :: - :: We don't want to call the actual +scry function again, - :: because we already tried that in a previous event and it - :: had no synchronous answer. This +unblock call is a result - :: of the response to the asynchronous request we made to - :: retrieve that resource from another vane. - :: - :: Instead, we'll intercept any calls to +scry by looking up - :: the arguments in :scry-results.per-event. This is ok because - :: in this function we attempt to run every +build that had - :: blocked on the resource, so the information is guaranteed - :: to be used during this event before it goes out of scope. - :: - =. scry-results (~(put by scry-results) scry-request scry-result) - :: - =. pending-scrys.state - +:(del-request pending-scrys.state scry-request duct) - :: - =/ unblocked-build=build (scry-request-to-build scry-request) - =. builds.state - =< builds - %+ update-build-status unblocked-build - |= =build-status - build-status(state [%unblocked ~]) - :: - (execute-loop (sy unblocked-build ~)) - :: +cancel: cancel a build - :: - :: When called on a live build, removes all tracking related to the live - :: build, and no more %made moves will be sent for that build. - :: - :: When called on a once build, removes all tracking related to the once - :: build, and that build will never be completed or have a %made sent. - :: - :: When called on a build that isn't registered in :state, such as a - :: completed once build, or a build that has already been canceled, - :: prints and no-ops. - :: - ++ cancel ^+ [moves state] - :: - =< finalize - :: - ?~ duct-status=(~(get by ducts.state) duct) - ~& [%no-build-for-duct duct] - ..execute - :: :duct is being canceled, so remove it unconditionally - :: - =. ducts.state (~(del by ducts.state) duct) - :: if the duct was not live, cancel any in-progress builds - :: - ?: ?=(%once -.live.u.duct-status) - :: - =/ root-build=build [in-progress.live root-schematic]:u.duct-status - :: - =. ..execute (cancel-scrys root-build) - =. state (remove-duct-from-root root-build) - ..execute - :: if the duct was live and has an unfinished build, cancel it - :: - =? ..execute ?=(^ in-progress.live.u.duct-status) - :: - =/ root-build=build [u.in-progress.live root-schematic]:u.duct-status - :: - =. ..execute (cancel-scrys root-build) - =. state (remove-duct-from-root root-build) - ..execute - :: if there is no completed build for the live duct, we're done - :: - ?~ last-sent=last-sent.live.u.duct-status - ..execute - :: there is a completed build for the live duct, so delete it - :: - =/ root-build=build [date.u.last-sent root-schematic.u.duct-status] - :: - =. state (remove-duct-from-root root-build) - :: - ?~ subscription.u.last-sent - ..execute - (cancel-clay-subscription u.subscription.u.last-sent) - :: +cancel-scrys: cancel all blocked %scry sub-builds of :root-builds - :: - ++ cancel-scrys - |= root-build=build - ^+ ..execute - :: - =/ blocked-sub-scrys ~(tap in (collect-blocked-sub-scrys root-build)) - :: - |- ^+ ..execute - ?~ blocked-sub-scrys ..execute - :: - =. ..execute (cancel-scry-request i.blocked-sub-scrys) - :: - $(blocked-sub-scrys t.blocked-sub-scrys) - :: +remove-duct-from-root: remove :duct from a build tree - :: - ++ remove-duct-from-root - |= =build - ^+ state - :: ~& [%remove-duct-from-root (build-to-tape build) duct] - :: - =. builds.state - =< builds - %+ update-build-status build - |= =build-status - build-status(requesters (~(del in requesters.build-status) duct)) - :: - =. builds.state (remove-duct-from-subs build) - :: - (cleanup build) - :: +add-ducts-to-build-subs: for each sub, add all of :build's ducts - :: - ++ add-ducts-to-build-subs - |= =build - ^+ state - :: - =/ =build-status (~(got by builds.state) build) - =/ new-ducts ~(tap in (~(put in ~(key by clients.build-status)) duct)) - =/ subs ~(tap in ~(key by subs.build-status)) - :: - =. state - |- - ^+ state - ?~ subs state - :: - =. state (add-build i.subs) - :: - $(subs t.subs) - :: - =. builds.state - |- ^+ builds.state - ?~ new-ducts builds.state - :: - =. builds.state (add-duct-to-subs i.new-ducts build) - :: - $(new-ducts t.new-ducts) - :: - state - :: +add-duct-to-subs: attach :duct to :build's descendants - :: - ++ add-duct-to-subs - |= [duct=^duct =build] - ^+ builds.state - :: - =/ =build-status (~(got by builds.state) build) - =/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) - =/ client=^build build - :: - |- ^+ builds.state - ?~ subs builds.state - :: - =/ sub-status=^build-status (~(got by builds.state) i.subs) - :: - =/ already-had-duct=? (~(has by clients.sub-status) duct) - :: - =. clients.sub-status - (~(put ju clients.sub-status) duct client) - :: - =. builds.state (~(put by builds.state) i.subs sub-status) - :: - =? builds.state !already-had-duct ^$(build i.subs) - :: - $(subs t.subs) - :: +remove-duct-from-subs: recursively remove duct from sub-builds - :: - ++ remove-duct-from-subs - |= =build - ^+ builds.state - :: ~& [%remove-duct-from-subs (build-to-tape build)] - :: - =/ =build-status (~(got by builds.state) build) - =/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) - =/ client=^build build - :: - |- ^+ builds.state - ?~ subs builds.state - :: - =/ sub-status=^build-status (~(got by builds.state) i.subs) - :: - =. clients.sub-status - (~(del ju clients.sub-status) duct client) - :: - =. builds.state (~(put by builds.state) i.subs sub-status) - :: - =? builds.state !(~(has by clients.sub-status) duct) - :: - ^$(build i.subs) - :: - $(subs t.subs) - :: +copy-build-tree-as-provisional: prepopulate new live build - :: - :: Make a provisional copy of the completed old root build tree at the - :: :new time. - :: - ++ copy-build-tree-as-provisional - |= [old-root=build new-date=@da] - ^+ state - :: - =/ old-client=build old-root - =/ new-client=build old-client(date new-date) - =. state (add-build new-client) - :: - =. builds.state - =< builds - %+ update-build-status new-client - |= =build-status - build-status(requesters (~(put in requesters.build-status) duct)) - :: - =< copy-node - :: - |% - ++ copy-node - ^+ state - :: - =/ old-build-status=build-status (~(got by builds.state) old-client) - :: - =/ old-subs=(list build) ~(tap in ~(key by subs.old-build-status)) - =/ new-subs=(list build) (turn old-subs |=(a=build a(date new-date))) - :: - =. builds.state - (add-subs-to-client new-client new-subs [verified=%.n blocked=%.y]) - :: - |- - ^+ state - ?~ old-subs - state - :: - =. state (add-client-to-sub i.old-subs) - =. state - copy-node(old-client i.old-subs, new-client i.old-subs(date new-date)) - :: - $(old-subs t.old-subs) - :: - ++ add-client-to-sub - |= old-sub=build - ^+ state - :: - =/ new-sub old-sub(date new-date) - =. state (add-build new-sub) - :: - =. builds.state - =< builds - %+ update-build-status new-sub - |= =build-status - build-status(clients (~(put ju clients.build-status) duct new-client)) - :: - state - -- - :: TODO: consolidate all these new sub/duct functions to one area. - :: - ++ add-subs-to-client - |= [new-client=build new-subs=(list build) =build-relation] - ^+ builds.state - :: - =< builds - %+ update-build-status new-client - |= =build-status - %_ build-status - subs - %- ~(gas by subs.build-status) - %+ murn new-subs - |= sub=build - ^- (unit (pair build ^build-relation)) - :: - ?^ (~(get by subs.build-status) sub) - ~ - `[sub build-relation] - == - :: |construction: arms for performing builds - :: - ::+| construction - :: - :: +execute-loop: +execute repeatedly until there's no more work to do - :: - :: TODO: This implementation is for simplicity. In the longer term, we'd - :: like to just perform a single run through +execute and set a Behn timer - :: to wake us up immediately. This has the advantage that Ford stops hard - :: blocking the main Urbit event loop, letting other work be done. - :: - ++ execute-loop - |= builds=(set build) - ^+ ..execute - :: - =. ..execute (execute builds) - :: - ?: ?& ?=(~ next-builds) - ?=(~ candidate-builds) - == - ..execute - :: - $(builds ~) - :: +execute: main recursive construction algorithm - :: - :: Performs the three step build process: First, figure out which builds - :: we're going to run this loop through the ford algorithm. Second, run - :: the gathered builds, possibly in parallel. Third, apply the +build-receipt - :: algorithms to the ford state. - :: - ++ execute - |= builds=(set build) - ^+ ..execute - :: - =. ..execute (gather builds force=%.n) - :: - =^ build-receipts ..execute run-builds - :: - (reduce build-receipts) - :: +gather: collect builds to be run in a batch - :: - :: The +gather phase is the first of the three parts of +execute. In - :: +gather, we look through each item in :candidate-builds. If we - :: should run the candidate build this cycle through the +execute loop, we - :: place it in :next-builds. +gather runs until it has no more candidates. - :: - ++ gather - |= [builds=(set build) force=?] - ^+ ..execute - :: add builds that were triggered by incoming event to the candidate list - :: - =. candidate-builds (~(uni in candidate-builds) builds) - :: - |^ ^+ ..execute - :: ~& [%candidate-builds (turn ~(tap in candidate-builds) build-to-tape)] - :: - ?: =(~ candidate-builds) - ..execute - :: - =/ next=build - ?< ?=(~ candidate-builds) - n.candidate-builds - =. candidate-builds (~(del in candidate-builds) next) - :: - $(..execute (gather-build next)) - :: +gather-build: looks at a single candidate build - :: - :: This gate inspects a single build. It might move it to :next-builds, - :: or promote it using an old build. It also might add this build's - :: sub-builds to :candidate-builds. - :: - ++ gather-build - |= =build - ^+ ..execute - :: ~& [%gather-build duct (build-to-tape build)] - ~| [%duct duct] - =/ duct-status (~(got by ducts.state) duct) - :: if we already have a result for this build, don't rerun the build - :: - =^ current-result builds.state (access-build-record build) - :: - ?: ?=([~ %value *] current-result) - (on-build-complete build) - :: place :build in :builds.state if it isn't already there - :: - =. state (add-build build) - :: ignore blocked builds - :: - =/ =build-status (~(got by builds.state) build) - ?: ?=(%blocked -.state.build-status) - =. state (add-ducts-to-build-subs build) - :: - =/ sub-scrys=(list scry-request) - ~(tap in (collect-blocked-sub-scrys build)) - :: - =. pending-scrys.state - |- ^+ pending-scrys.state - ?~ sub-scrys pending-scrys.state - :: - =. pending-scrys.state - (put-request pending-scrys.state i.sub-scrys duct) - :: - $(sub-scrys t.sub-scrys) - :: - ..execute - :: old-build: most recent previous build with :schematic.build - :: - =/ old-build=(unit ^build) - ?: ?& ?=(%live -.live.duct-status) - ?=(^ last-sent.live.duct-status) - == - :: check whether :build was run as part of the last live build tree - :: - :: TODO: cleanup docs - :: - =/ possible-build=^build - [date.u.last-sent.live.duct-status schematic.build] - ?: (~(has by builds.state) possible-build) - `possible-build - (~(find-previous by-schematic builds-by-schematic.state) build) - (~(find-previous by-schematic builds-by-schematic.state) build) - :: if no previous builds exist, we need to run :build - :: - ?~ old-build - (add-build-to-next build) - :: - =/ old-build-status=^build-status - ~| [%missing-old-build (build-to-tape u.old-build)] - ~| [%build-state (turn ~(tap in ~(key by builds.state)) build-to-tape)] - (~(got by builds.state) u.old-build) - :: selectively promote scry builds - :: - :: We can only promote a scry if it's not forced and we ran the same - :: scry schematic as a descendant of the root build schematic at the - :: last sent time for this duct. - :: - ?: ?& ?=(%scry -.schematic.build) - ?| force - ?! - ?& ?=(%live -.live.duct-status) - ?=(^ last-sent.live.duct-status) - :: - =/ subscription=(unit subscription) - subscription.u.last-sent.live.duct-status - :: - ?~ subscription - %.n - %- ~(has in resources.u.subscription) - resource.schematic.build - == == == - (add-build-to-next build) - :: if we don't have :u.old-build's result cached, we need to run :build - :: - =^ old-build-record builds.state (access-build-record u.old-build) - ?. ?=([~ %value *] old-build-record) - (add-build-to-next build) - :: - =. old-build-status (~(got by builds.state) u.old-build) - :: - =/ old-subs=(list ^build) ~(tap in ~(key by subs.old-build-status)) - =/ new-subs=(list ^build) - (turn old-subs |=(^build +<(date date.build))) - :: link sub-builds provisionally, blocking on incomplete - :: - :: We don't know that :build will end up depending on :new-subs, - :: so they're not :verified. - :: - =/ split-new-subs - %+ skid new-subs - |= sub=^build - ^- ? - :: - ?~ maybe-build-status=(~(get by builds.state) sub) - %.n - :: - ?& ?=(%complete -.state.u.maybe-build-status) - ?=(%value -.build-record.state.u.maybe-build-status) - == - :: - =/ stored-new-subs=(list ^build) -.split-new-subs - =/ un-stored-new-subs=(list ^build) +.split-new-subs - :: - =. builds.state - (add-subs-to-client build stored-new-subs [verified=%.n blocked=%.n]) - =. builds.state - (add-subs-to-client build un-stored-new-subs [verified=%.n blocked=%.y]) - :: - =. state (add-ducts-to-build-subs build) - :: - ?^ un-stored-new-subs - :: enqueue incomplete sub-builds to be promoted or run - :: - :: When not all our sub builds have results, we can't add :build to - :: :next-builds.state. Instead, put all the remaining uncached new - :: subs into :candidate-builds. - :: - :: If all of our sub-builds finish immediately (i.e. promoted) when - :: they pass through +gather-internal, they will add :build back to - :: :candidate-builds and we will run again before +execute runs - :: +make. - :: - %_ ..execute - candidate-builds - (~(gas in candidate-builds) un-stored-new-subs) - == - :: - =^ promotable builds.state (are-subs-unchanged old-subs new-subs) - ?. promotable - (add-build-to-next build) - :: - ?> =(schematic.build schematic.u.old-build) - ?> (~(has by builds.state) build) - (promote-build u.old-build date.build new-subs) - :: +are-subs-unchanged: checks sub-build equivalence, updating access time - :: - ++ are-subs-unchanged - |= [old-subs=(list build) new-subs=(list build)] - ^- [? _builds.state] - :: - ?~ old-subs - [%.y builds.state] - ?> ?=(^ new-subs) - :: - =^ old-build-record builds.state (access-build-record i.old-subs) - ?. ?=([~ %value *] old-build-record) - [%.n builds.state] - :: - =^ new-build-record builds.state (access-build-record i.new-subs) - ?. ?=([~ %value *] new-build-record) - [%.n builds.state] - :: - ?. =(build-result.u.old-build-record build-result.u.new-build-record) - [%.n builds.state] - $(new-subs t.new-subs, old-subs t.old-subs) - :: +add-build-to-next: run this build during the +make phase - :: - ++ add-build-to-next - |= =build - ..execute(next-builds (~(put in next-builds) build)) - :: +promote-build: promote result of :build to newer :date - :: - :: Also performs relevant accounting, and possibly sends %made moves. - :: - ++ promote-build - |= [old-build=build new-date=@da new-subs=(list build)] - ^+ ..execute - :: ~& [%promote-build (build-to-tape old-build) new-date] - :: grab the previous result, freshening the cache - :: - =^ old-build-record builds.state (access-build-record old-build) - :: we can only promote a cached result, not missing or a %tombstone - :: - ?> ?=([~ %value *] old-build-record) - =/ =build-result build-result.u.old-build-record - :: :new-build is :old-build at :date; promotion destination - :: - =/ new-build=build old-build(date new-date) - :: - =. builds.state =< builds - %+ update-build-status new-build - |= =build-status - ^+ build-status - :: - %_ build-status - :: verify linkages between :new-build and subs - :: - subs - :: - ^- (map build build-relation) - %- my - ^- (list (pair build build-relation)) - %+ turn new-subs - |= sub=build - :: - [sub [verified=& blocked=|]] - :: copy the old result to :new-build - :: - state - [%complete [%value last-accessed=now build-result=build-result]] - == - :: - (on-build-complete new-build) - -- - :: +run-builds: run the builds and produce +build-receipts - :: - :: Runs the builds and cleans up the build lists afterwards. - :: - :: TODO: When the vere interpreter has a parallel variant of +turn, use - :: that as each build might take a while and there are no data - :: dependencies between builds here. - :: - ++ run-builds - ^- [(list build-receipt) _..execute] - :: - =/ build-receipts=(list build-receipt) - (turn ~(tap in next-builds) make) - :: - =. next-builds ~ - [build-receipts ..execute] - :: reduce: apply +build-receipts produce from the +make phase. - :: - :: +gather produces builds to run make on. +make produces - :: +build-receipts. It is in +reduce where we take these +build-receipts and - :: apply them to ..execute. - :: - ++ reduce - |= build-receipts=(list build-receipt) - ^+ ..execute - :: sort :build-receipts so blocks are processed before completions - :: - :: It's possible for a build to block on a sub-build that was run - :: in the same batch. If that's the case, make sure we register - :: that the build blocked on the sub-build before registering the - :: completion of the sub-build. This way, when we do register the - :: completion of the sub-build, we will know which builds are blocked - :: on the sub-build, so we can enqueue those blocked clients to be - :: rerun. - :: - =. build-receipts - %+ sort build-receipts - |= [a=build-receipt b=build-receipt] - ^- ? - ?=(%blocks -.result.a) - :: - |^ ^+ ..execute - ?~ build-receipts ..execute - :: - =. ..execute (apply-build-receipt i.build-receipts) - $(build-receipts t.build-receipts) - :: +apply-build-receipt: applies a single state diff to ..execute - :: - ++ apply-build-receipt - |= made=build-receipt - ^+ ..execute - :: process :sub-builds.made - :: - =. state (track-sub-builds build.made sub-builds.made) - :: ~& [%post-track receipt=made build-state=(~(got by builds.state) build.made)] - :: - ?- -.result.made - %build-result - (apply-build-result [build build-result.result]:made) - :: - %blocks - (apply-blocks [build builds.result scry-blocked.result]:made) - == - :: +track-sub-builds: - :: - :: For every sub-build discovered while running :build, we have to make - :: sure that we track that sub-build and that it is associated with the - :: right ducts. - :: - ++ track-sub-builds - |= [client=build sub-builds=(list build)] - ^+ state - :: ~& [%track-sub-builds build=(build-to-tape client) subs=(turn sub-builds build-to-tape)] - :: mark :sub-builds as :subs in :build's +build-status - :: - =^ build-status builds.state - %+ update-build-status client - |= =build-status - %_ build-status - subs - %- ~(gas by subs.build-status) - %+ turn sub-builds - |= sub=build - :: - =/ blocked=? - ?~ sub-status=(~(get by builds.state) sub) - %.y - !?=([%complete %value *] state.u.sub-status) - :: - [sub [verified=& blocked]] - == - :: - =. state (add-ducts-to-build-subs client) - :: - |- ^+ state - ?~ sub-builds state - :: - =. builds.state - :: - =< builds - %+ update-build-status i.sub-builds - |= build-status=^build-status - %_ build-status - :: freshen :last-accessed date - :: - state - :: - ?. ?=([%complete %value *] state.build-status) - state.build-status - state.build-status(last-accessed.build-record now) - == - :: - $(sub-builds t.sub-builds) - :: +apply-build-result: apply a %build-result +build-receipt to ..execute - :: - :: Our build produced an actual result. - :: - ++ apply-build-result - |= [=build =build-result] - ^+ ..execute - :: ~& [%apply-build-result (build-to-tape build) (~(got by builds.state) build)] - :: - =^ build-status builds.state - %+ update-build-status build - |= =build-status - build-status(state [%complete [%value last-accessed=now build-result]]) - :: - (on-build-complete build) - :: +apply-blocks: apply a %blocks +build-receipt to ..execute - :: - :: :build blocked. Record information about what builds it blocked on - :: and try those blocked builds as candidates in the next pass. - :: - ++ apply-blocks - |= [=build blocks=(list build) scry-blocked=(unit scry-request)] - ^+ ..execute - :: ~& [%apply-blocks duct (build-to-tape build)] - :: if a %scry blocked, register it and maybe send an async request - :: - =? ..execute - ?=(^ scry-blocked) - (start-scry-request u.scry-blocked) - :: we must run +apply-build-receipt on :build.made before :block - :: - ?< %+ lien blocks - |= block=^build - ?~ maybe-build-status=(~(get by builds.state) block) - %.n - ?=(%complete -.state.u.maybe-build-status) - :: transition :build's state machine to the %blocked state - :: - =. builds.state - =< builds - %+ update-build-status build - |= =build-status - build-status(state [%blocked ~]) - :: enqueue :blocks to be run next - :: - =. candidate-builds (~(gas in candidate-builds) blocks) - :: - ..execute - -- - :: +make: attempt to perform :build, non-recursively - :: - :: Registers component linkages between :build and its sub-builds. - :: Attempts to perform +scry if necessary. Does not directly enqueue - :: any moves. - :: - ++ make - |= =build - ^- build-receipt - :: accessed-builds: builds accessed/depended on during this run. - :: - =| accessed-builds=(list ^build) - ~& [%turbo-make (build-to-tape build)] - :: dispatch based on the kind of +schematic in :build - :: - :: - |^ =, schematic.build - :: - ?- -.schematic.build - :: - ^ (make-autocons [head tail]) - :: - %$ (make-literal literal) - :: - %pin (make-pin date schematic) - %alts (make-alts choices ~) - %bake (make-bake renderer query-string path-to-render) - %bunt (make-bunt disc mark) - %call (make-call gate sample) - %cast (make-cast disc mark input) - %core (make-core source-path) - %diff (make-diff disc start end) - %dude (make-dude error attempt) - %hood (make-hood source-path) - %join (make-join disc mark first second) - %list (make-list schematics) - %mash (make-mash disc mark first second) - %mute (make-mute subject mutations) - %pact (make-pact disc start diff) - %path (make-path disc prefix raw-path) - %plan (make-plan path-to-render query-string scaffold) - %reef (make-reef disc) - %ride (make-ride formula subject) - %same (make-same schematic) - %scry (make-scry resource) - %slim (make-slim subject-type formula) - %slit (make-slit gate sample) - %vale (make-vale disc mark input) - %volt (make-volt disc mark input) - %walk (make-walk disc source target) - == - :: |schematic-handlers:make: implementation of the schematics - :: - :: All of these produce a value of the same type as +make itself. - :: - :: +| schematic-handlers - :: - ++ make-autocons - |= [head=schematic tail=schematic] - ^- build-receipt - :: - =/ head-build=^build [date.build head] - =/ tail-build=^build [date.build tail] - =^ head-result accessed-builds (depend-on head-build) - =^ tail-result accessed-builds (depend-on tail-build) - :: - =| blocks=(list ^build) - =? blocks ?=(~ head-result) [head-build blocks] - =? blocks ?=(~ tail-result) [tail-build blocks] - :: if either build blocked, we're not done - :: - ?^ blocks - :: - [build [%blocks blocks ~] accessed-builds] - :: - ?< ?=(~ head-result) - ?< ?=(~ tail-result) - :: - =- [build [%build-result -] accessed-builds] - `build-result`[%success u.head-result u.tail-result] - :: - ++ make-literal - |= =cage - ^- build-receipt - [build [%build-result %success %$ cage] accessed-builds] - :: - ++ make-pin - |= [date=@da =schematic] - ^- build-receipt - :: pinned-sub: sub-build with the %pin date as formal date - :: - =/ pinned-sub=^build [date schematic] - :: - =^ result accessed-builds (depend-on pinned-sub) - :: - ?~ result - [build [%blocks ~[pinned-sub] ~] accessed-builds] - :: - [build [%build-result u.result] accessed-builds] - :: - ++ make-alts - |= [choices=(list schematic) errors=(list tank)] - ^- build-receipt - :: - ?~ choices - (return-error [[%leaf "%alts: all options failed"] errors]) - :: - =/ choice=^build [date.build i.choices] - :: - =^ result accessed-builds (depend-on choice) - ?~ result - [build [%blocks ~[choice] ~] accessed-builds] - :: - ?: ?=([%error *] u.result) - :: TODO: When the type system wises up, fix this: - :: - =/ braces [[' ' ' ' ~] ['{' ~] ['}' ~]] - =/ wrapped-error=tank - [%rose braces `(list tank)`message.u.result] - =. errors (weld errors `(list tank)`[[%leaf "option"] wrapped-error ~]) - $(choices t.choices) - :: - [build [%build-result %success %alts u.result] accessed-builds] - :: - ++ make-bake - |= [renderer=term query-string=coin path-to-render=rail] - ^- build-receipt - :: path-build: find the file path for the renderer source - :: - =/ path-build=^build - [date.build [%path disc.path-to-render %ren renderer]] - :: - =^ path-result accessed-builds (depend-on path-build) - ?~ path-result - [build [%blocks [path-build]~ ~] accessed-builds] - :: - |^ ^- build-receipt - :: if there's a renderer called :renderer, use it on :path-to-render - :: - ?: ?=([~ %success %path *] path-result) - (try-renderer rail.u.path-result) - (try-mark ~) - :: try using a renderer first, falling back to marks on errors - :: - ++ try-renderer - |= =rail - :: build a +scaffold from the renderer source - :: - =/ hood-build=^build [date.build [%hood rail]] - :: - =^ hood-result accessed-builds (depend-on hood-build) - ?~ hood-result - [build [%blocks [hood-build]~ ~] accessed-builds] - :: - ?: ?=([~ %error *] hood-result) - (try-mark message.u.hood-result) - ?> ?=([~ %success %hood *] hood-result) - :: link the renderer, passing through :path-to-render and :query-string - :: - =/ plan-build=^build - :- date.build - [%plan path-to-render query-string scaffold.u.hood-result] - :: - =^ plan-result accessed-builds (depend-on plan-build) - ?~ plan-result - [build [%blocks [plan-build]~ ~] accessed-builds] - :: - ?: ?=([~ %error *] plan-result) - (try-mark message.u.plan-result) - ?> ?=([~ %success %plan *] plan-result) - :: - =/ =build-result - :: TODO: renderers returned their name as the mark in old ford - :: - :: We should rethink whether we want this to be the case going - :: forward, but for now, Eyre depends on this detail to work. - :: - [%success %bake renderer vase.u.plan-result] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ try-mark - |= errors=(list tank) - :: no renderer, try mark; retrieve directory listing of :path-to-render - :: - :: There might be multiple files of different marks stored at - :: :path-to-render. Retrieve the directory listing for - :: :path-to-render, then check which of the path segments in - :: that directory are files (not just folders), then for each - :: file try to %cast its mark to the desired mark (:renderer). - :: - :: Start by retrieving the directory listing, using :toplevel-build. - :: - =/ toplevel-build=^build - [date.build [%scry %c %y path-to-render]] - :: - =^ toplevel-result accessed-builds (depend-on toplevel-build) - ?~ toplevel-result - [build [%blocks [toplevel-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %scry *] toplevel-result) - :: TODO: include :errors in the output since both failed. - :: - (wrap-error toplevel-result) - :: - =/ toplevel-arch=arch ;;(arch q.q.cage.u.toplevel-result) - :: find the :sub-path-segments that could be files - :: - :: Filter out path segments that aren't a +term, - :: since those aren't valid marks and therefore can't - :: be the last segment of a filepath in Clay. - :: - =/ sub-path-segments=(list @ta) - (skim (turn ~(tap by dir.toplevel-arch) head) (sane %tas)) - :: - =/ sub-schematics=(list [sub-path=@ta =schematic]) - %+ turn sub-path-segments - |= sub=@ta - :- sub - [%scry %c %y path-to-render(spur [sub spur.path-to-render])] - :: - =^ schematic-results accessed-builds - (perform-schematics sub-schematics %fail-on-errors *@ta) - ?: ?=([%| *] schematic-results) - :: block or error - p.schematic-results - :: marks: list of the marks of the files at :path-to-render - :: - =/ marks=(list @tas) - %+ murn p.schematic-results - |= [sub-path=@ta result=build-result] - ^- (unit @tas) - :: - ?> ?=([%success %scry *] result) - :: - =/ =arch ;;(arch q.q.cage.result) - :: if it's a directory, not a file, we can't load it - :: - ?~ fil.arch - ~ - [~ `@tas`sub-path] - :: sort marks in alphabetical order - :: - =. marks (sort marks lte) - :: try to convert files to the destination mark, in order - :: - =/ alts-build=^build - :: - :+ date.build %alts - ^= choices ^- (list schematic) - :: - %+ turn marks - |= mark=term - ^- schematic - :: - =/ file=rail path-to-render(spur [mark spur.path-to-render]) - :: - [%cast disc.file renderer [%scry %c %x file]] - :: - =^ alts-result accessed-builds (depend-on alts-build) - ?~ alts-result - [build [%blocks [alts-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %alts *] alts-result) - (wrap-error alts-result) - :: - =/ =build-result - [%success %bake (result-to-cage u.alts-result)] - :: - [build [%build-result build-result] accessed-builds] - -- - :: - ++ make-bunt - |= [=disc mark=term] - ^- build-receipt - :: resolve path of the mark definition file - :: - =/ path-build=^build [date.build [%path disc %mar mark]] - :: - =^ path-result accessed-builds (depend-on path-build) - ?~ path-result - [build [%blocks [path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] path-result) - (wrap-error path-result) - :: build the mark core from source - :: - =/ core-build=^build [date.build [%core rail.u.path-result]] - :: - =^ core-result accessed-builds (depend-on core-build) - ?~ core-result - [build [%blocks [core-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] core-result) - (wrap-error core-result) - :: extract the sample from the mark core - :: - =/ mark-vase=vase vase.u.core-result - ~| %mark-vase - =+ [sample-type=p sample-value=q]:(slot 6 mark-vase) - :: if sample is wrapped in a face, unwrap it - :: - =? sample-type ?=(%face -.sample-type) q.sample-type - :: - =/ =cage [mark sample-type sample-value] - [build [%build-result %success %bunt cage] accessed-builds] - :: - ++ make-call - |= [gate=schematic sample=schematic] - ^- build-receipt - :: - =/ gate-build=^build [date.build gate] - =^ gate-result accessed-builds (depend-on gate-build) - :: - =/ sample-build=^build [date.build sample] - =^ sample-result accessed-builds (depend-on sample-build) - :: - =| blocks=(list ^build) - =? blocks ?=(~ gate-result) [[date.build gate] blocks] - =? blocks ?=(~ sample-result) [[date.build sample] blocks] - ?^ blocks - :: - [build [%blocks blocks ~] accessed-builds] - :: - ?< ?=(~ gate-result) - ?< ?=(~ sample-result) - :: - =/ gate-vase=vase q:(result-to-cage u.gate-result) - =/ sample-vase=vase q:(result-to-cage u.sample-result) - :: - :: run %slit to get the resulting type of calculating the gate - :: - =/ slit-schematic=schematic [%slit gate-vase sample-vase] - =/ slit-build=^build [date.build slit-schematic] - =^ slit-result accessed-builds (depend-on slit-build) - ?~ slit-result - [build [%blocks [date.build slit-schematic]~ ~] accessed-builds] - :: - ?. ?=([~ %success %slit *] slit-result) - (wrap-error slit-result) - :: - :: How much duplication is there going to be here between +call and - :: +ride? Right now, we're just !! on scrys, but for reals we want it to - :: do the same handling. - ?> &(?=(^ q.gate-vase) ?=(^ +.q.gate-vase)) - =/ val - (mong [q.gate-vase q.sample-vase] intercepted-scry) - :: - ?- -.val - %0 - :* build - [%build-result %success %call [type.u.slit-result p.val]] - accessed-builds - == - :: - %1 - =/ blocked-paths=(list path) ((hard (list path)) p.val) - (blocked-paths-to-receipt %call blocked-paths) - :: - %2 - (return-error [[%leaf "ford: %call failed:"] p.val]) - == - :: - ++ make-cast - |= [=disc mark=term input=schematic] - ^- build-receipt - :: - =/ input-build=^build [date.build input] - :: - =^ input-result accessed-builds (depend-on input-build) - ?~ input-result - [build [%blocks [input-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success *] input-result) - (wrap-error input-result) - :: - =/ result-cage=cage (result-to-cage u.input-result) - :: - =/ translation-path-build=^build - [date.build [%walk disc p.result-cage mark]] - =^ translation-path-result accessed-builds - (depend-on translation-path-build) - :: - ?~ translation-path-result - [build [%blocks [translation-path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %walk *] translation-path-result) - (wrap-error translation-path-result) - :: - =/ translation-path=(list mark-action) - results.u.translation-path-result - :: - |^ ^- build-receipt - ?~ translation-path - [build [%build-result %success %cast result-cage] accessed-builds] - :: - =^ action-result accessed-builds - =, i.translation-path - ?- -.i.translation-path - %grow (run-grow source target result-cage) - %grab (run-grab source target result-cage) - == - :: - ?- -.action-result - %success - %_ $ - translation-path t.translation-path - result-cage cage.action-result - == - :: - %blocks - [build [%blocks blocks.action-result ~] accessed-builds] - :: - %error - :* build - :* %build-result %error - leaf+"ford: failed to %cast" - tang.action-result - == - accessed-builds - == - == - :: - += action-result - $% :: translation was successful and here's a cage for you - [%success =cage] - :: it was an error. sorry. - [%error =tang] - :: we block on a build - [%blocks blocks=(list ^build)] - == - :: - ++ run-grab - |= [source-mark=term target-mark=term input-cage=cage] - ^- [action-result _accessed-builds] - :: - =/ mark-path-build=^build - [date.build [%path disc %mar target-mark]] - :: - =^ mark-path-result accessed-builds - (depend-on mark-path-build) - ?~ mark-path-result - [[%blocks [mark-path-build]~] accessed-builds] - :: - ?. ?=([~ %success %path *] mark-path-result) - (cast-wrap-error mark-path-result) - :: - =/ mark-core-build=^build [date.build [%core rail.u.mark-path-result]] - :: - =^ mark-core-result accessed-builds (depend-on mark-core-build) - ?~ mark-core-result - [[%blocks ~[mark-core-build]] accessed-builds] - :: find +grab within the destination mark core - :: - =/ grab-build=^build - [date.build [%ride [%limb %grab] [%$ (result-to-cage u.mark-core-result)]]] - :: - =^ grab-result accessed-builds (depend-on grab-build) - ?~ grab-result - [[%blocks [grab-build]~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grab-result) - (cast-wrap-error grab-result) - :: find an arm for the input's mark within the +grab core - :: - =/ grab-mark-build=^build - :- date.build - [%ride [%limb source-mark] [%$ %noun vase.u.grab-result]] - :: - =^ grab-mark-result accessed-builds (depend-on grab-mark-build) - ?~ grab-mark-result - [[%blocks [grab-mark-build]~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grab-mark-result) - (cast-wrap-error grab-mark-result) - :: slam the +mark-name:grab gate on the result of running :input - :: - =/ call-build=^build - :- date.build - [%call gate=[%$ %noun vase.u.grab-mark-result] sample=[%$ input-cage]] - :: - =^ call-result accessed-builds (depend-on call-build) - ?~ call-result - [[%blocks [call-build]~] accessed-builds] - :: - ?. ?=([~ %success %call *] call-result) - (cast-wrap-error call-result) - :: - [[%success [mark vase.u.call-result]] accessed-builds] - :: +grow: grow from the input mark to the destination mark - :: - ++ run-grow - |= [source-mark=term target-mark=term input-cage=cage] - ^- [action-result _accessed-builds] - :: - =/ starting-mark-path-build=^build - [date.build [%path disc %mar source-mark]] - :: - =^ starting-mark-path-result accessed-builds - (depend-on starting-mark-path-build) - ?~ starting-mark-path-result - [[%blocks [starting-mark-path-build]~] accessed-builds] - :: - ?. ?=([~ %success %path *] starting-mark-path-result) - (cast-wrap-error starting-mark-path-result) - :: grow the value from the initial mark to the final mark - :: - :: Replace the input mark's sample with the input's result, - :: then fire the mark-name:grow arm to produce a result. - :: - =/ grow-build=^build - :- date.build - :+ %ride - formula=`hoon`[%tsgl [%wing ~[target-mark]] [%wing ~[%grow]]] - ^= subject - ^- schematic - :* %mute - ^- schematic - [%core rail.u.starting-mark-path-result] - ^= mutations - ^- (list [wing schematic]) - [[%& 6]~ [%$ input-cage]]~ - == - :: - =^ grow-result accessed-builds (depend-on grow-build) - ?~ grow-result - [[%blocks [grow-build]~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grow-result) - (cast-wrap-error grow-result) - :: make sure the product nests in the sample of the destination mark - :: - =/ bunt-build=^build [date.build [%bunt disc target-mark]] - :: - =^ bunt-result accessed-builds (depend-on bunt-build) - ?~ bunt-result - [[%blocks [bunt-build]~] accessed-builds] - :: - ?. ?=([~ %success %bunt *] bunt-result) - (cast-wrap-error bunt-result) - :: - ?. (~(nest ut p.q.cage.u.bunt-result) | p.vase.u.grow-result) - =* src source-mark - =* dst target-mark - :_ accessed-builds - :- %error - [leaf+"ford: %cast from {} to {} failed: nest fail"]~ - :: - [[%success mark vase.u.grow-result] accessed-builds] - :: - ++ cast-wrap-error - |= result=(unit build-result) - ^- [action-result _accessed-builds] - :: - ?> ?=([~ %error *] result) - =/ message=tang - [[%leaf "ford: {<-.schematic.build>} failed: "] message.u.result] - :: - [[%error message] accessed-builds] - -- - :: - ++ make-core - |= source-path=rail - ^- build-receipt - :: convert file at :source-path to a +scaffold - :: - =/ hood-build=^build [date.build [%hood source-path]] - :: - =^ hood-result accessed-builds (depend-on hood-build) - ?~ hood-result - [build [%blocks [hood-build]~ ~] accessed-builds] - :: - ?: ?=(%error -.u.hood-result) - (wrap-error hood-result) - :: build the +scaffold into a program - :: - ?> ?=([%success %hood *] u.hood-result) - :: - =/ plan-build=^build - [date.build [%plan source-path `coin`[%many ~] scaffold.u.hood-result]] - :: - =^ plan-result accessed-builds (depend-on plan-build) - ?~ plan-result - [build [%blocks [plan-build]~ ~] accessed-builds] - :: - ?: ?=(%error -.u.plan-result) - (wrap-error plan-result) - :: - ?> ?=([%success %plan *] u.plan-result) - [build [%build-result %success %core vase.u.plan-result] accessed-builds] - :: - ++ make-diff - |= [=disc start=schematic end=schematic] - ^- build-receipt - :: run both input schematics as an autocons build - :: - =/ sub-build=^build [date.build [start end]] - :: - =^ sub-result accessed-builds (depend-on sub-build) - ?~ sub-result - [build [%blocks [sub-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success ^ ^] sub-result) - (wrap-error sub-result) - ?. ?=([%success *] head.u.sub-result) - (wrap-error `head.u.sub-result) - ?. ?=([%success *] tail.u.sub-result) - (wrap-error `tail.u.sub-result) - :: - =/ start-cage=cage (result-to-cage head.u.sub-result) - =/ end-cage=cage (result-to-cage tail.u.sub-result) - :: if the marks aren't the same, we can't diff them - :: - ?. =(p.start-cage p.end-cage) - %- return-error :_ ~ :- %leaf - "ford: %diff failed: mark mismatch: %{} / %{}" - :: if the values are the same, the diff is null - :: - ?: =(q.q.start-cage q.q.end-cage) - =/ =build-result - [%success %diff [%null [%atom %n ~] ~]] - :: - [build [%build-result build-result] accessed-builds] - :: - =/ mark-path-build=^build [date.build [%path disc %mar p.start-cage]] - :: - =^ mark-path-result accessed-builds (depend-on mark-path-build) - ?~ mark-path-result - [build [%blocks [mark-path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] mark-path-result) - (wrap-error mark-path-result) - :: - =/ mark-build=^build [date.build [%core rail.u.mark-path-result]] - :: - =^ mark-result accessed-builds (depend-on mark-build) - ?~ mark-result - [build [%blocks [mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] mark-result) - (wrap-error mark-result) - :: - ?. (slab %grad p.vase.u.mark-result) - %- return-error :_ ~ :- %leaf - "ford: %diff failed: %{} mark has no +grad arm" - :: - =/ grad-build=^build - [date.build [%ride [%limb %grad] [%$ %noun vase.u.mark-result]]] - :: - =^ grad-result accessed-builds (depend-on grad-build) - ?~ grad-result - [build [%blocks [grad-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grad-result) - (wrap-error grad-result) - :: if +grad produced a @tas, convert to that mark and diff those - :: - ?@ q.vase.u.grad-result - =/ mark=(unit @tas) ((sand %tas) q.vase.u.grad-result) - ?~ mark - %- return-error :_ ~ :- %leaf - "ford: %diff failed: %{} mark has invalid +grad arm" - :: - =/ diff-build=^build - :- date.build - :^ %diff - disc - [%cast disc u.mark [%$ start-cage]] - [%cast disc u.mark [%$ end-cage]] - :: - =^ diff-result accessed-builds (depend-on diff-build) - ?~ diff-result - [build [%blocks [diff-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %diff *] diff-result) - (wrap-error diff-result) - :: - =/ =build-result - [%success %diff cage.u.diff-result] - :: - [build [%build-result build-result] accessed-builds] - :: +grad produced a cell, which should be a core with a +form arm - :: - ?. (slab %form p.vase.u.grad-result) - %- return-error :_ ~ :- %leaf - "ford: %diff failed: %{} mark has no +form:grab arm" - :: the +grab core should also contain a +diff arm - :: - ?. (slab %diff p.vase.u.grad-result) - %- return-error :_ ~ :- %leaf - "ford: %diff failed: %{} mark has no +diff:grab arm" - :: - =/ diff-build=^build - :- date.build - :+ %call - :: - ^= gate - :+ %ride - :: - formula=`hoon`[%tsgl [%wing ~[%diff]] [%wing ~[%grad]]] - :: - ^= subject - :+ %mute - :: - subject=`schematic`[%$ %noun vase.u.mark-result] - :: - ^= mutations - ^- (list [wing schematic]) - [[%& 6]~ [%$ start-cage]]~ - :: - sample=`schematic`[%$ end-cage] - :: - =^ diff-result accessed-builds (depend-on diff-build) - ?~ diff-result - [build [%blocks [diff-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] diff-result) - (wrap-error diff-result) - :: - =/ form-build=^build - [date.build [%ride [%limb %form] [%$ %noun vase.u.grad-result]]] - :: - =^ form-result accessed-builds (depend-on form-build) - ?~ form-result - [build [%blocks [form-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] form-result) - (wrap-error form-result) - :: - =/ mark=(unit @tas) ((soft @tas) q.vase.u.form-result) - ?~ mark - %- return-error :_ ~ :- %leaf - "ford: %diff failed: invalid +form result: {(text vase.u.form-result)}" - :: - =/ =build-result - [%success %diff [u.mark vase.u.diff-result]] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-dude - |= [error=(trap tank) attempt=schematic] - ^- build-receipt - :: - =/ attempt-build=^build [date.build attempt] - =^ attempt-result accessed-builds (depend-on attempt-build) - ?~ attempt-result - :: - [build [%blocks ~[[date.build attempt]] ~] accessed-builds] - :: - ?. ?=([%error *] u.attempt-result) - [build [%build-result u.attempt-result] accessed-builds] - :: - (return-error [$:error message.u.attempt-result]) - :: - ++ make-hood - |= source-path=rail - ^- build-receipt - :: - =/ scry-build=^build [date.build [%scry [%c %x source-path]]] - =^ scry-result accessed-builds (depend-on scry-build) - ?~ scry-result - :: - [build [%blocks ~[scry-build] ~] accessed-builds] - :: - ?: ?=([~ %error *] scry-result) - (wrap-error scry-result) - =+ as-cage=(result-to-cage u.scry-result) - :: hoon files must be atoms to parse - :: - ?. ?=(@ q.q.as-cage) - (return-error [%leaf "ford: %hood: file not an atom"]~) - :: - =* src-beam [[ship.disc desk.disc [%ud 0]] spur]:source-path - =/ parsed - ((full (parse-scaffold src-beam)) [1 1] (trip q.q.as-cage)) - :: - ?~ q.parsed - (return-error [%leaf "syntax error: {} {}"]~) - :: - [build [%build-result %success %hood p.u.q.parsed] accessed-builds] - :: - ++ make-join - |= [disc=^disc mark=term first=schematic second=schematic] - ^- build-receipt - :: - =/ initial-build=^build - [date.build [first second] [%path disc %mar mark]] - :: - =^ initial-result accessed-builds (depend-on initial-build) - ?~ initial-result - [build [%blocks [initial-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success [%success ^ ^] %success %path *] initial-result) - (wrap-error initial-result) - ?. ?=([%success *] head.head.u.initial-result) - (wrap-error `head.head.u.initial-result) - ?. ?=([%success *] tail.head.u.initial-result) - (wrap-error `tail.head.u.initial-result) - :: - =/ first-cage=cage (result-to-cage head.head.u.initial-result) - =/ second-cage=cage (result-to-cage tail.head.u.initial-result) - =/ mark-path=rail rail.tail.u.initial-result - :: TODO: duplicate logic with +make-pact and others - :: - =/ mark-build=^build [date.build [%core mark-path]] - :: - =^ mark-result accessed-builds (depend-on mark-build) - ?~ mark-result - [build [%blocks [mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] mark-result) - (wrap-error mark-result) - :: - =/ mark-vase=vase vase.u.mark-result - :: - ?. (slab %grad p.mark-vase) - %- return-error :_ ~ :- %leaf - "ford: %join failed: %{} mark has no +grad arm" - :: - =/ grad-build=^build - [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] - :: - =^ grad-result accessed-builds (depend-on grad-build) - ?~ grad-result - [build [%blocks [grad-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grad-result) - (wrap-error grad-result) - :: - =/ grad-vase=vase vase.u.grad-result - :: if +grad produced a mark, delegate %join behavior to that mark - :: - ?@ q.grad-vase - :: if +grad produced a term, make sure it's a valid mark - :: - =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) - ?~ grad-mark - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark invalid +grad" - :: - =/ join-build=^build - [date.build [%join disc mark [%$ first-cage] [%$ second-cage]]] - :: - =^ join-result accessed-builds (depend-on join-build) - ?~ join-result - [build [%blocks [join-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %join *] join-result) - (wrap-error join-result) - :: - [build [%build-result u.join-result] accessed-builds] - :: make sure the +grad core has a +form arm - :: - ?. (slab %form p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %join failed: no +form:grad in %{} mark" - :: make sure the +grad core has a +join arm - :: - ?. (slab %join p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %join failed: no +join:grad in %{} mark" - :: fire the +form:grad arm, which should produce a mark - :: - =/ form-build=^build - [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] - :: - =^ form-result accessed-builds (depend-on form-build) - ?~ form-result - [build [%blocks [form-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] form-result) - (wrap-error form-result) - :: - =/ form-mark=(unit term) ((soft @tas) q.vase.u.form-result) - ?~ form-mark - %- return-error :_ ~ :- %leaf - "ford: %join failed: %{} mark invalid +form:grad" - :: the mark produced by +form:grad should match both diffs - :: - ?. &(=(u.form-mark p.first-cage) =(u.form-mark p.second-cage)) - %- return-error :_ ~ :- %leaf - "ford: %join failed: mark mismatch" - :: if the diffs are identical, just produce the first - :: - ?: =(q.q.first-cage q.q.second-cage) - [build [%build-result %success %join first-cage] accessed-builds] - :: call the +join:grad gate on the two diffs - :: - =/ diff-build=^build - :- date.build - :+ %call - :+ %ride - [%limb %join] - [%$ %noun grad-vase] - [%$ %noun (slop q.first-cage q.second-cage)] - :: - =^ diff-result accessed-builds (depend-on diff-build) - ?~ diff-result - [build [%blocks [diff-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] diff-result) - (wrap-error diff-result) - :: the result was a unit; if `~`, use %null mark; otherwise grab tail - :: - =/ =build-result - :+ %success %join - ?@ q.vase.u.diff-result - [%null vase.u.diff-result] - [u.form-mark (slot 3 vase.u.diff-result)] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-list - |= schematics=(list schematic) - ^- build-receipt - :: - =/ key-and-schematics - (turn schematics |=(=schematic [~ schematic])) - :: depend on builds of each schematic - :: - =^ schematic-results accessed-builds - (perform-schematics key-and-schematics %ignore-errors *~) - ?: ?=([%| *] schematic-results) - :: block or error - p.schematic-results - :: return all builds - :: - =/ =build-result - :+ %success %list - :: the roll above implicitly flopped the results - :: - (flop (turn p.schematic-results tail)) - [build [%build-result build-result] accessed-builds] - :: - ++ make-mash - |= $: disc=^disc - mark=term - first=[disc=^disc mark=term =schematic] - second=[disc=^disc mark=term =schematic] - == - ^- build-receipt - :: - =/ initial-build=^build - [date.build [schematic.first schematic.second] [%path disc %mar mark]] - :: - =^ initial-result accessed-builds (depend-on initial-build) - ?~ initial-result - [build [%blocks [initial-build]~ ~] accessed-builds] - :: TODO: duplicate logic with +make-join - :: - ?. ?=([~ %success [%success ^ ^] %success %path *] initial-result) - (wrap-error initial-result) - ?. ?=([%success *] head.head.u.initial-result) - (wrap-error `head.head.u.initial-result) - ?. ?=([%success *] tail.head.u.initial-result) - (wrap-error `tail.head.u.initial-result) - :: - =/ first-cage=cage (result-to-cage head.head.u.initial-result) - =/ second-cage=cage (result-to-cage tail.head.u.initial-result) - =/ mark-path=rail rail.tail.u.initial-result - :: TODO: duplicate logic with +make-pact and others - :: - =/ mark-build=^build [date.build [%core mark-path]] - :: - =^ mark-result accessed-builds (depend-on mark-build) - ?~ mark-result - [build [%blocks [mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] mark-result) - (wrap-error mark-result) - :: - =/ mark-vase=vase vase.u.mark-result - :: - ?. (slab %grad p.mark-vase) - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark has no +grad arm" - :: - =/ grad-build=^build - [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] - :: - =^ grad-result accessed-builds (depend-on grad-build) - ?~ grad-result - [build [%blocks [grad-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grad-result) - (wrap-error grad-result) - :: - =/ grad-vase=vase vase.u.grad-result - :: if +grad produced a mark, delegate %mash behavior to that mark - :: - ?@ q.grad-vase - :: if +grad produced a term, make sure it's a valid mark - :: - =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) - ?~ grad-mark - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark invalid +grad" - :: - =/ mash-build=^build - :- date.build - :- %mash - :^ disc u.grad-mark - [disc.first mark.first [%$ first-cage]] - [disc.second mark.second [%$ second-cage]] - :: - =^ mash-result accessed-builds (depend-on mash-build) - ?~ mash-result - [build [%blocks [mash-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %mash *] mash-result) - (wrap-error mash-result) - :: - =/ =build-result - [%success %mash cage.u.mash-result] - :: - [build [%build-result build-result] accessed-builds] - :: - ?. (slab %form p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark has no +form:grad" - :: - ?. (slab %mash p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark has no +mash:grad" - :: - =/ form-build=^build - [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] - :: - =^ form-result accessed-builds (depend-on form-build) - ?~ form-result - [build [%blocks [form-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] form-result) - (wrap-error form-result) - :: - =/ form-mark=(unit term) ((soft @tas) q.vase.u.form-result) - ?~ form-mark - %- return-error :_ ~ :- %leaf - "ford: %mash failed: %{} mark invalid +form:grad" - :: - ?. &(=(u.form-mark p.first-cage) =(u.form-mark p.second-cage)) - %- return-error :_ ~ :- %leaf - "ford: %mash failed: mark mismatch" - :: - ?: =(q.q.first-cage q.q.second-cage) - =/ =build-result - [%success %mash [%null [%atom %n ~] ~]] - :: - [build [%build-result build-result] accessed-builds] - :: call the +mash:grad gate on two [ship desk diff] triples - :: - =/ mash-build=^build - :- date.build - :+ %call - :+ %ride - [%limb %mash] - [%$ %noun grad-vase] - :+ %$ %noun - %+ slop - ;: slop - [[%atom %p ~] ship.disc.first] - [[%atom %tas ~] desk.disc.first] - q.first-cage - == - ;: slop - [[%atom %p ~] ship.disc.second] - [[%atom %tas ~] desk.disc.second] - q.second-cage - == - :: - =^ mash-result accessed-builds (depend-on mash-build) - ?~ mash-result - [build [%blocks [mash-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] mash-result) - (wrap-error mash-result) - :: - =/ =build-result - [%success %mash [u.form-mark vase.u.mash-result]] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-mute - |= [subject=schematic mutations=(list [=wing =schematic])] - ^- build-receipt - :: run the subject build to produce the noun to be mutated - :: - =/ subject-build=^build [date.build subject] - =^ subject-result accessed-builds (depend-on subject-build) - ?~ subject-result - [build [%blocks [subject-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success *] subject-result) - (wrap-error subject-result) - :: - =/ subject-cage=cage (result-to-cage u.subject-result) - :: - =/ subject-vase=vase q.subject-cage - :: - =^ schematic-results accessed-builds - (perform-schematics mutations %fail-on-errors *wing) - ?: ?=([%| *] schematic-results) - :: block or error - p.schematic-results - :: all builds succeeded; retrieve vases from results - :: - =/ successes=(list [=wing =vase]) - %+ turn p.schematic-results - |= [=wing result=build-result] - ^- [^wing vase] - :: - ?> ?=([%success *] result) - :: - [wing q:(result-to-cage result)] - :: create and run a +build to apply all mutations in order - :: - =/ ride-build=^build - :- date.build - :+ %ride - :: formula: a `%_` +hoon that applies a list of mutations - :: - :: The hoon ends up looking like: - :: ``` - :: %_ +2 - :: wing-1 +6 - :: wing-2 +14 - :: ... - :: == - :: ``` - :: - ^= formula - ^- hoon - :+ %cncb [%& 2]~ - =/ axis 3 - :: - |- ^- (list [wing hoon]) - ?~ successes ~ - :: - :- [wing.i.successes [%$ (peg axis 2)]] - $(successes t.successes, axis (peg axis 3)) - :: subject: list of :subject-vase and mutations, as literal schematic - :: - :: The subject ends up as a vase of something like this: - :: ``` - :: :~ original-subject - :: mutant-1 - :: mutant-2 - :: ... - :: == - :: ``` - :: - ^= subject ^- schematic - :+ %$ %noun - ^- vase - %+ slop subject-vase - |- ^- vase - ?~ successes [[%atom %n ~] ~] - :: - (slop vase.i.successes $(successes t.successes)) - :: - =^ ride-result accessed-builds (depend-on ride-build) - ?~ ride-result - [build [%blocks [ride-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] ride-result) - (wrap-error ride-result) - :: - =/ =build-result - [%success %mute p.subject-cage vase.u.ride-result] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-pact - |= [disc=^disc start=schematic diff=schematic] - ^- build-receipt - :: first, build the inputs - :: - =/ initial-build=^build [date.build start diff] - :: - =^ initial-result accessed-builds (depend-on initial-build) - ?~ initial-result - [build [%blocks [initial-build]~ ~] accessed-builds] - :: - ?> ?=([~ %success ^ ^] initial-result) - =/ start-result=build-result head.u.initial-result - =/ diff-result=build-result tail.u.initial-result - :: - ?. ?=(%success -.start-result) - (wrap-error `start-result) - ?. ?=(%success -.diff-result) - (wrap-error `diff-result) - :: - =/ start-cage=cage (result-to-cage start-result) - =/ diff-cage=cage (result-to-cage diff-result) - :: - =/ start-mark=term p.start-cage - =/ diff-mark=term p.diff-cage - :: load the starting mark from the filesystem - :: - =/ mark-path-build=^build [date.build [%path disc %mar start-mark]] - :: - =^ mark-path-result accessed-builds - (depend-on mark-path-build) - :: - ?~ mark-path-result - [build [%blocks [mark-path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] mark-path-result) - (wrap-error mark-path-result) - :: - =/ mark-build=^build [date.build [%core rail.u.mark-path-result]] - :: - =^ mark-result accessed-builds (depend-on mark-build) - ?~ mark-result - [build [%blocks [mark-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %core *] mark-result) - (wrap-error mark-result) - :: - =/ mark-vase=vase vase.u.mark-result - :: fire the +grad arm of the mark core - :: - ?. (slab %grad p.mark-vase) - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark has no +grad arm" - :: - =/ grad-build=^build - [date.build [%ride [%limb %grad] [%$ %noun mark-vase]]] - :: - =^ grad-result accessed-builds (depend-on grad-build) - ?~ grad-result - [build [%blocks [grad-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] grad-result) - (wrap-error grad-result) - :: - =/ grad-vase=vase vase.u.grad-result - :: +grad can produce a term or a core - :: - :: If a mark's +grad arm produces a mark (as a +term), - :: it means we should use that mark's machinery to run %pact. - :: In this way, a mark can delegate its patching machinery to - :: another mark. - :: - :: First we cast :start-cage to the +grad mark, then we run - :: a new %pact build on the result of that, which will use the - :: +grad mark's +grad arm. Finally we cast the %pact result back to - :: :start-mark, since we're trying to produce a patched version of - :: the initial marked value (:start-cage). - :: - ?@ q.grad-vase - :: if +grad produced a term, make sure it's a valid mark - :: - =/ grad-mark=(unit term) ((sand %tas) q.grad-vase) - ?~ grad-mark - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark invalid +grad" - :: cast :start-cage to :grad-mark, %pact that, then cast back to start - :: - =/ cast-build=^build - :- date.build - :^ %cast disc start-mark - :^ %pact disc - :^ %cast disc u.grad-mark - [%$ start-cage] - [%$ diff-cage] - :: - =^ cast-result accessed-builds (depend-on cast-build) - ?~ cast-result - [build [%blocks [cast-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %cast *] cast-result) - (wrap-error cast-result) - :: - =/ =build-result - [%success %pact cage.u.cast-result] - :: - [build [%build-result build-result] accessed-builds] - :: +grad produced a core; make sure it has a +form arm - :: - :: +grad can produce a core containing +pact and +form - :: arms. +form:grad, which produces a mark (as a term), is used - :: to verify that the diff is of the correct mark. - :: - :: +pact:grad produces a gate that gets slammed with the diff - :: as its sample and produces a mutant version of :start-cage - :: by applying the diff. - :: - ?. (slab %form p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %pact failed: no +form:grad in %{} mark" - :: we also need a +pact arm in the +grad core - :: - ?. (slab %pact p.grad-vase) - %- return-error :_ ~ :- %leaf - "ford: %pact failed: no +pact:grad in %{} mark" - :: fire the +form arm in the core produced by +grad - :: - =/ form-build=^build - [date.build [%ride [%limb %form] [%$ %noun grad-vase]]] - :: - =^ form-result accessed-builds (depend-on form-build) - ?~ form-result - [build [%blocks [form-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] form-result) - (wrap-error form-result) - :: +form:grad should produce a mark - :: - =/ form-mark=(unit @tas) ((soft @tas) q.vase.u.form-result) - ?~ form-mark - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark invalid +form:grad" - :: mark produced by +form:grad needs to match the mark of the diff - :: - ?. =(u.form-mark diff-mark) - %- return-error :_ ~ :- %leaf - "ford: %pact failed: %{} mark invalid +form:grad" - :: call +pact:grad on the diff - :: - =/ pact-build=^build - :- date.build - :+ %call - ^- schematic - :+ %ride - [%tsgl [%limb %pact] [%limb %grad]] - ^- schematic - :+ %mute - ^- schematic - [%$ %noun mark-vase] - ^- (list [wing schematic]) - [[%& 6]~ [%$ start-cage]]~ - ^- schematic - [%$ diff-cage] - :: - =^ pact-result accessed-builds (depend-on pact-build) - ?~ pact-result - [build [%blocks [pact-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] pact-result) - (wrap-error pact-result) - :: - =/ =build-result - [%success %pact start-mark vase.u.pact-result] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-path - |= [disc=^disc prefix=@tas raw-path=@tas] - ^- build-receipt - :: possible-spurs: flopped paths to which :raw-path could resolve - :: - =/ possible-spurs=(list spur) (turn (segments raw-path) flop) - :: rails-and-schematics: scrys to check each path in :possible-paths - :: - =/ rails-and-schematics=(list [=rail =schematic]) - %+ turn possible-spurs - |= possible-spur=spur - ^- [rail schematic] - :: full-spur: wrap :possible-spur with :prefix and /hoon suffix - :: - =/ full-spur=spur :(welp /hoon possible-spur /[prefix]) - :: - :- [disc full-spur] - [%scry %c %x `rail`[disc full-spur]] - :: depend on builds of each schematic - :: - =^ schematic-results accessed-builds - (perform-schematics rails-and-schematics %filter-errors *rail) - ?: ?=([%| *] schematic-results) - :: block or error - p.schematic-results - :: matches: builds that completed with a successful result - :: - =/ matches p.schematic-results - :: if no matches, error out - :: - ?~ matches - =/ =beam - [[ship.disc desk.disc [%da date.build]] /hoon/[raw-path]/[prefix]] - :: - (return-error [%leaf "%path: no matches for {<(en-beam beam)>}"]~) - :: if exactly one path matches, succeed with the matching path - :: - ?: ?=([* ~] matches) - [build [%build-result %success %path key.i.matches] accessed-builds] - :: multiple paths matched; error out - :: - %- return-error - :: - :- [%leaf "multiple matches for %path: "] - :: tmi; cast :matches back to +list - :: - %+ roll `_p.schematic-results`matches - |= [[key=rail result=build-result] message=tang] - ^- tang - :: beam: reconstruct request from :kid's schematic and date - :: - =/ =beam [[ship.disc desk.disc [%da date.build]] spur.key] - :: - [[%leaf "{<(en-beam beam)>}"] message] - :: - ++ make-plan - |= [path-to-render=rail query-string=coin =scaffold] - ^- build-receipt - :: TODO: support query-string - :: - :: blocks: accumulator for blocked sub-builds - :: - =| blocks=(list ^build) - :: error-message: accumulator for failed sub-builds - :: - =| error-message=tang - :: - |^ :: imports: structure and library +cables, with %sur/%lib prefixes - :: - =/ imports=(list [prefix=?(%sur %lib) =cable]) - %+ welp - (turn structures.scaffold |=(cable [%sur +<])) - (turn libraries.scaffold |=(cable [%lib +<])) - :: path-builds: %path sub-builds to resolve import paths - :: - =/ path-builds (gather-path-builds imports) - :: - =^ path-results ..$ (resolve-builds path-builds) - ?^ blocks - [build [%blocks blocks ~] accessed-builds] - :: - ?^ error-message - (return-error error-message) - :: tmi; remove type specializations - :: - => .(blocks *(list ^build), error-message *tang) - :: core-builds: %core sub-builds to produce library vases - :: - =/ core-builds (gather-core-builds path-results) - :: - =^ core-results ..$ (resolve-builds core-builds) - ?^ blocks - [build [%blocks blocks ~] accessed-builds] - :: - ?^ error-message - (return-error error-message) - :: reef-build: %reef build to produce standard library - :: - =/ reef-build=^build [date.build [%reef disc.path-to-render]] - :: - =^ reef-result accessed-builds (depend-on reef-build) - ?~ reef-result - [build [%blocks [reef-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %reef *] reef-result) - (wrap-error reef-result) - :: subject: tuple of imports and standard library - :: - =/ subject=vase - (link-imports imports vase.u.reef-result core-results) - :: tmi; remove type specializations - :: - => .(blocks *(list ^build), error-message *tang) - :: iterate over each crane - :: - =^ crane-result ..$ - (compose-cranes [%noun subject] cranes.scaffold) - ?: ?=(%error -.crane-result) - (return-error message.crane-result) - ?: ?=(%block -.crane-result) - [build [%blocks builds.crane-result ~] accessed-builds] - :: combined-hoon: source hoons condensed into a single +hoon - :: - =/ combined-hoon=hoon [%tssg sources.scaffold] - :: compile :combined-hoon against :subject - :: - =/ compile=^build - [date.build [%ride combined-hoon [%$ subject.crane-result]]] - :: - =^ compiled accessed-builds (depend-on compile) - :: compilation blocked; produce block on sub-build - :: - ?~ compiled - [build [%blocks ~[compile] ~] accessed-builds] - :: compilation failed; error out - :: - ?. ?=([~ %success %ride *] compiled) - (wrap-error compiled) - :: compilation succeeded: produce resulting +vase - :: - [build [%build-result %success %plan vase.u.compiled] accessed-builds] - :: +compose-result: the result of a single composition - :: - += compose-result - $% [%subject subject=cage] - [%block builds=(list ^build)] - [%error message=tang] - == - :: +compose-cranes: runs each crane and composes the results - :: - :: For each crane in :cranes, runs it and composes its result into a - :: new subject, which is returned if there are no errors or blocks. - :: - ++ compose-cranes - |= [subject=cage cranes=(list crane)] - ^- $: compose-result - _..compose-cranes - == - :: - ?~ cranes - [[%subject subject] ..compose-cranes] - :: - =^ result ..compose-cranes (run-crane subject i.cranes) - ?+ -.result [result ..compose-cranes] - :: - %subject - $(cranes t.cranes, subject [%noun (slop q.subject.result q.subject)]) - == - :: +run-crane: runs an individual :crane against :subject - :: - ++ run-crane - |= [subject=cage =crane] - ^- compose-cranes - :: - |^ ?- -.crane - %fssg (run-fssg +.crane) - %fsbc (run-fsbc +.crane) - %fsbr (run-fsbr +.crane) - %fsts (run-fsts +.crane) - %fscm (run-fscm +.crane) - %fspm (run-fspm +.crane) - %fscb (run-fscb +.crane) - %fsdt (run-fsdt +.crane) - %fssm (run-fssm +.crane) - %fscl (run-fscl +.crane) - %fskt (run-fskt +.crane) - %fszp (run-fszp +.crane) - %fszy (run-fszy +.crane) - == - :: +run-fssg: runs the `/~` rune - :: - ++ run-fssg - |= =hoon - ^- compose-cranes - :: - =/ ride-build=^build - [date.build [%ride hoon [%$ subject]]] - =^ ride-result accessed-builds (depend-on ride-build) - ?~ ride-result - [[%block [ride-build]~] ..run-crane] - ?: ?=([~ %error *] ride-result) - [[%error [leaf+"/~ failed: " message.u.ride-result]] ..run-crane] - ?> ?=([~ %success %ride *] ride-result) - [[%subject %noun vase.u.ride-result] ..run-crane] - :: +run-fsbc: runes the `/$` rune - :: - ++ run-fsbc - |= =hoon - ^- compose-cranes - :: - =/ query-compile-build=^build - [date.build [%ride ((jock |) query-string) [%$ %noun !>(~)]]] - =^ query-compile-result accessed-builds (depend-on query-compile-build) - ?~ query-compile-result - [[%block [query-compile-build]~] ..run-crane] - ?: ?=([~ %error *] query-compile-result) - [[%error [leaf+"/; failed: " message.u.query-compile-result]] ..run-crane] - ?> ?=([~ %success %ride *] query-compile-result) - :: TODO: if we had a slop build type, everything could be crammed - :: into one sub-build. - :: - =/ =beam - =, path-to-render - [[ship.disc desk.disc [%da date.build]] spur] - =+ arguments=(slop !>(beam) vase.u.query-compile-result) - :: - =/ call-build=^build - [date.build [%call [%ride hoon [%$ subject]] [%$ %noun arguments]]] - =^ call-result accessed-builds (depend-on call-build) - ?~ call-result - [[%block [call-build]~] ..run-crane] - ?: ?=([~ %error *] call-result) - [[%error [leaf+"/; failed: " message.u.call-result]] ..run-crane] - ?> ?=([~ %success %call *] call-result) - :: - [[%subject %noun vase.u.call-result] ..run-crane] - :: +run-fsbr: runes the `/|` rune - :: - ++ run-fsbr - |= choices=(list ^crane) - ^- compose-cranes - :: - ?~ choices - [[%error [leaf+"/| failed: out of options"]~] ..run-crane] - :: - =^ child ..run-crane (run-crane subject i.choices) - ?. ?=([%error *] child) - [child ..run-crane] - $(choices t.choices) - :: +run-fsts: runs the `/=` rune - :: - ++ run-fsts - |= [face=term sub-crane=^crane] - ^- compose-cranes - :: - =^ child ..run-crane (run-crane subject sub-crane) - ?. ?=([%subject *] child) - [child ..run-crane] - :_ ..run-crane - :* %subject - p.subject.child - [[%face [~ face] p.q.subject.child] q.q.subject.child] - == - :: +run-fscm: runs the `/,` rune - :: - ++ run-fscm - |= cases=(list [=spur crane=^crane]) - ^- compose-cranes - :: - ?~ cases - [[%error [leaf+"/, failed: no match"]~] ..run-crane] - :: - ?. .= spur.i.cases - (scag (lent spur.i.cases) (flop spur.path-to-render)) - $(cases t.cases) - :: - (run-crane subject crane.i.cases) - :: +run-fspm: runs the `/&` rune - :: - ++ run-fspm - |= [marks=(list mark) sub-crane=^crane] - ^- compose-cranes - :: - =^ child ..run-crane (run-crane subject sub-crane) - ?. ?=([%subject *] child) - [child ..run-crane] - :: - =/ cast-build=^build - :- date.build - |- - ^- schematic - ?~ marks - :: TODO: If we were keeping track of the mark across runes, this - :: wouldn't have %noun here. This is case where it might matter. - :: - [%$ subject.child] - [%cast disc.source-rail.scaffold i.marks $(marks t.marks)] - =^ cast-result accessed-builds (depend-on cast-build) - ?~ cast-result - [[%block [cast-build]~] ..run-crane] - :: - ?: ?=([~ %error *] cast-result) - [[%error [leaf+"/& failed: " message.u.cast-result]] ..run-crane] - ?> ?=([~ %success %cast *] cast-result) - :: - [[%subject cage.u.cast-result] ..run-crane] - :: +run-fscb: runs the `/_` rune - :: - ++ run-fscb - |= sub-crane=^crane - ^- compose-cranes - :: perform a scry to get the contents of +path-to-render - :: - =/ toplevel-build=^build - [date.build [%scry [%c %y path-to-render]]] - :: - =^ toplevel-result accessed-builds (depend-on toplevel-build) - ?~ toplevel-result - [[%block ~[toplevel-build]] ..run-crane] - :: - ?: ?=([~ %error *] toplevel-result) - [[%error [leaf+"/_ failed: " message.u.toplevel-result]] ..run-crane] - ?> ?=([~ %success %scry *] toplevel-result) - :: - =/ toplevel-arch=arch ;;(arch q.q.cage.u.toplevel-result) - :: sub-path: each possible sub-directory to check - :: - =/ sub-paths=(list @ta) - (turn ~(tap by dir.toplevel-arch) head) - :: for each directory in :toplevel-arch, issue a sub-build - :: - =/ sub-builds=(list ^build) - %+ turn sub-paths - |= sub=@ta - ^- ^build - [date.build [%scry [%c %y path-to-render(spur [sub spur.path-to-render])]]] - :: results: accumulator for results of sub-builds - :: - =| results=(list [kid=^build sub-path=@ta results=(unit build-result)]) - :: resolve all the :sub-builds - :: - :: TODO: It feels like this running sub build and filtering - :: results could be generalized. - :: - =/ subs-results - |- ^+ [results accessed-builds] - ?~ sub-builds [results accessed-builds] - ?> ?=(^ sub-paths) - :: - =/ kid=^build i.sub-builds - =/ sub-path=@ta i.sub-paths - :: - =^ result accessed-builds (depend-on kid) - =. results [[kid sub-path result] results] - :: - $(sub-builds t.sub-builds, sub-paths t.sub-paths) - :: apply mutations from depending on sub-builds - :: - =: results -.subs-results - accessed-builds +.subs-results - == - :: split :results into completed :mades and incomplete :blocks - :: - =+ split-results=(skid results |=([* * r=(unit build-result)] ?=(^ r))) - :: - =/ mades=_results -.split-results - =/ blocks=_results +.split-results - :: if any builds blocked, produce them all in %blocks - :: - ?^ blocks - [[%block (turn `_results`blocks head)] ..run-crane] - :: find the first error and return it if exists - :: - =/ errors=_results - %+ skim results - |= [* * r=(unit build-result)] - ?=([~ %error *] r) - ?^ errors - ?> ?=([~ %error *] results.i.errors) - [[%error message.u.results.i.errors] ..run-crane] - :: get a list of valid sub-paths - :: - :: :results is now a list of the :build-result of %cy on each path - :: in :toplevel-arch. What we want is to now filter this list so - :: that we filter files out. - :: - =/ sub-paths=(list [=rail sub-path=@ta]) - %+ murn results - |= [build=^build sub-path=@ta result=(unit build-result)] - ^- (unit [rail @ta]) - :: - ?> ?=([@da %scry %c %y *] build) - ?> ?=([~ %success %scry *] result) - =/ =arch ;;(arch q.q.cage.u.result) - :: - ?~ dir.arch - ~ - `[rail.resource.schematic.build sub-path] - :: keep track of the original value so we can reset it - :: - =/ old-path-to-render path-to-render - :: apply each of the filtered :sub-paths to the :sub-crane. - :: - =^ crane-results ..run-crane - %+ roll sub-paths - |= $: [=rail sub-path=@ta] - accumulator=[(list [sub-path=@ta =compose-result]) _..run-crane] - == - =. ..run-crane +.accumulator - =. path-to-render rail - =^ result ..run-crane (run-crane subject sub-crane) - [[[sub-path result] -.accumulator] ..run-crane] - :: set :path-to-render back - :: - =. path-to-render old-path-to-render - :: if any sub-cranes error, return the first error - :: - =/ error-list=(list [@ta =compose-result]) - %+ skim crane-results - |= [@ta =compose-result] - =(%error -.compose-result) - :: - ?^ error-list - [compose-result.i.error-list ..run-crane] - :: if any sub-cranes block, return all blocks - :: - =/ block-list=(list ^build) - =| block-list=(list ^build) - |- - ^+ block-list - ?~ crane-results - block-list - ?. ?=(%block -.compose-result.i.crane-results) - $(crane-results t.crane-results) - =. block-list - (weld builds.compose-result.i.crane-results block-list) - $(crane-results t.crane-results) - :: - ?^ block-list - [[%block block-list] ..run-crane] - :: put the data in map order - :: - =/ result-map=(map @ta vase) - %- my - %+ turn crane-results - |= [path=@ta =compose-result] - ^- (pair @ta vase) - :: - ?> ?=([%subject *] compose-result) - [path q.subject.compose-result] - :: convert the map into a flat format for return - :: - :: This step flattens the values out of the map for return. Let's - :: say we're doing a /_ over a directory of files that just have a - :: single @ud in them. We want the return value of /_ to have the - :: nest in (map @ta @ud) instead of returning a (map @ta vase). - :: - =/ as-vase=vase - |- - ^- vase - :: - ?~ result-map - [[%atom %n `0] 0] - :: - %+ slop - (slop [[%atom %ta ~] p.n.result-map] q.n.result-map) - (slop $(result-map l.result-map) $(result-map r.result-map)) - :: - [[%subject %noun as-vase] ..run-crane] - :: +run-fsdt: runs the `/.` rune - :: - ++ run-fsdt - |= sub-cranes=(list ^crane) - ^- compose-cranes - :: - =^ list-results ..run-crane - %+ roll sub-cranes - |= $: sub-crane=^crane - accumulator=[(list compose-result) _..run-crane] - == - =. ..run-crane +.accumulator - =^ result ..run-crane (run-crane subject sub-crane) - [[result -.accumulator] ..run-crane] - :: if any sub-cranes error, return the first error - :: - =/ error-list=(list compose-result) - %+ skim list-results - |= =compose-result - =(%error -.compose-result) - :: - ?^ error-list - [i.error-list ..run-crane] - :: if any sub-cranes block, return all blocks - :: - =/ block-list=(list ^build) - =| block-list=(list ^build) - |- - ^+ block-list - ?~ list-results - block-list - ?. ?=(%block -.i.list-results) - $(list-results t.list-results) - =. block-list (weld builds.i.list-results block-list) - $(list-results t.list-results) - :: - ?^ block-list - [[%block block-list] ..run-crane] - :: concatenate all the results together with null termination - :: - =. list-results (flop list-results) - :: - =/ final-result=vase - |- - ^- vase - ?~ list-results - [[%atom %n `~] 0] - ?> ?=(%subject -.i.list-results) - (slop q.subject.i.list-results $(list-results t.list-results)) - :: - [[%subject %noun final-result] ..run-crane] - :: +run-fssm: runs the `/;` rune - :: - ++ run-fssm - |= [=hoon sub-crane=^crane] - ^- compose-cranes - :: - =^ child ..run-crane (run-crane subject sub-crane) - ?. ?=([%subject *] child) - [child ..run-crane] - :: - =/ call-build=^build - [date.build [%call [%ride hoon [%$ subject]] [%$ subject.child]]] - =^ call-result accessed-builds (depend-on call-build) - ?~ call-result - [[%block [call-build]~] ..run-crane] - ?: ?=([~ %error *] call-result) - [[%error [leaf+"/; failed: " message.u.call-result]] ..run-crane] - ?> ?=([~ %success %call *] call-result) - :: - [[%subject %noun vase.u.call-result] ..run-crane] - :: +run-fscl: runs the `/:` rune - :: - ++ run-fscl - |= [=truss sub-crane=^crane] - ^- compose-cranes - :: - =/ =beam - =, source-rail.scaffold - [[ship.disc desk.disc [%ud 0]] spur] - =/ hoon-parser (vang & (en-beam beam)) - :: - =+ tuz=(posh:hoon-parser truss) - ?~ tuz - [[%error [leaf+"/: failed: bad tusk: {}"]~] ..run-crane] - =+ pax=(plex:hoon-parser %clsg u.tuz) - ?~ pax - [[%error [leaf+"/: failed: bad path: {}"]~] ..run-crane] - =+ bem=(de-beam u.pax) - ?~ bem - [[%error [leaf+"/: failed: bad beam: {}"]~] ..run-crane] - :: - =. path-to-render [[p q] s]:u.bem - (run-crane subject sub-crane) - :: +run-fskt: runs the `/^` rune - :: - ++ run-fskt - |= [mold=hoon sub-crane=^crane] - ^- compose-cranes - :: - =^ child ..run-crane (run-crane subject sub-crane) - ?. ?=([%subject *] child) - [child ..run-crane] - :: - =/ bunt-build=^build - [date.build [%ride [%bunt mold] [%$ subject]]] - =^ bunt-result accessed-builds (depend-on bunt-build) - ?~ bunt-result - [[%block [bunt-build]~] ..run-crane] - ?: ?=([~ %error *] bunt-result) - [[%error [leaf+"/^ failed: " message.u.bunt-result]] ..run-crane] - ?> ?=([~ %success %ride *] bunt-result) - :: - ?. (~(nest ut p.vase.u.bunt-result) | p.q.subject.child) - [[%error [leaf+"/^ failed: nest-fail"]~] ..run-crane] - [[%subject %noun [p.vase.u.bunt-result q.q.subject.child]] ..run-crane] - :: +run-fszp: runs the `/!mark/` "rune" - :: - ++ run-fszp - |= =mark - ^- compose-cranes - :: - =/ hoon-path=rail - =, path-to-render - [disc [%hoon spur]] - :: - =/ hood-build=^build [date.build [%hood hoon-path]] - =^ hood-result accessed-builds (depend-on hood-build) - ?~ hood-result - [[%block [hood-build]~] ..run-crane] - ?: ?=([~ %error *] hood-result) - [[%error [leaf+"/! failed: " message.u.hood-result]] ..run-crane] - ?> ?=([~ %success %hood *] hood-result) - :: - =/ plan-build=^build - :- date.build - [%plan path-to-render query-string scaffold.u.hood-result] - =^ plan-result accessed-builds (depend-on plan-build) - ?~ plan-result - [[%block [plan-build]~] ..run-crane] - ?: ?=([~ %error *] plan-result) - [[%error [leaf+"/! failed: " message.u.plan-result]] ..run-crane] - ?> ?=([~ %success %plan *] plan-result) - :: if :mark is %noun, don't perform mark translation; just return - :: - :: If we were to verify the product type with %noun, this would - :: cast to *, which would overwrite :vase.u.plan-result's actual - :: product type - :: - ?: =(%noun mark) - [[%subject %noun vase.u.plan-result] ..run-crane] - :: - =/ vale-build=^build - :- date.build - [%vale disc.source-rail.scaffold mark q.vase.u.plan-result] - =^ vale-result accessed-builds (depend-on vale-build) - ?~ vale-result - [[%block [vale-build]~] ..run-crane] - ?: ?=([~ %error *] vale-result) - [[%error [leaf+"/! failed: " message.u.vale-result]] ..run-crane] - ?> ?=([~ %success %vale *] vale-result) - :: - [[%subject cage.u.vale-result] ..run-crane] - :: +run-fszy: runs the `/mark/` "rune" - :: - ++ run-fszy - |= =mark - ^- compose-cranes - :: - =/ bake-build=^build - :- date.build - [%bake mark query-string path-to-render] - =^ bake-result accessed-builds (depend-on bake-build) - ?~ bake-result - [[%block [bake-build]~] ..run-crane] - ?: ?=([~ %error *] bake-result) - [[%error [leaf+"/mark/ failed: " message.u.bake-result]] ..run-crane] - ?> ?=([~ %success %bake *] bake-result) - :: - [[%subject cage.u.bake-result] ..run-crane] - -- - :: +gather-path-builds: produce %path builds to resolve import paths - :: - ++ gather-path-builds - |= imports=(list [prefix=?(%sur %lib) =cable]) - ^- (list ^build) - :: - %+ turn imports - |= [prefix=?(%sur %lib) =cable] - ^- ^build - [date.build [%path disc.source-rail.scaffold prefix file-path.cable]] - :: +resolve-builds: run a list of builds and collect results - :: - :: If a build blocks, put its +tang in :error-message and stop. - :: All builds that block get put in :blocks. Results of - :: successful builds are produced in :results. - :: - ++ resolve-builds - =| results=(list build-result) - |= builds=(list ^build) - ^+ [results ..^$] - :: - ?~ builds - [results ..^$] - :: - =^ result accessed-builds (depend-on i.builds) - ?~ result - =. blocks [i.builds blocks] - $(builds t.builds) - :: - ?. ?=(%success -.u.result) - =. error-message [[%leaf "%plan failed: "] message.u.result] - [results ..^$] - :: - =. results [u.result results] - $(builds t.builds) - :: +gather-core-builds: produce %core builds from resolved paths - :: - ++ gather-core-builds - |= path-results=(list build-result) - ^- (list ^build) - %+ turn path-results - |= result=build-result - ^- ^build - :: - ?> ?=([%success %path *] result) - :: - [date.build [%core rail.result]] - :: +link-imports: link libraries and structures with standard library - :: - :: Prepends each library vase onto the standard library vase. - :: Wraps a face around each library to prevent namespace leakage - :: unless imported as *lib-name. - :: - ++ link-imports - |= $: imports=(list [?(%lib %sur) =cable]) - reef=vase - core-results=(list build-result) - == - ^- vase - :: - =/ subject=vase reef - :: - =/ core-vases=(list vase) - %+ turn core-results - |= result=build-result - ^- vase - ?> ?=([%success %core *] result) - vase.result - :: link structures and libraries into a subject for compilation - :: - |- ^+ subject - ?~ core-vases subject - ?< ?=(~ imports) - :: cons this vase onto the head of the subject - :: - =. subject - %- slop :_ subject - :: check if the programmer named the library - :: - ?~ face.cable.i.imports - :: no face assigned to this library, so use vase as-is - :: - i.core-vases - :: use the library name as a face to prevent namespace leakage - :: - ^- vase - [[%face face.cable.i.imports p.i.core-vases] q.i.core-vases] - :: - $(core-vases t.core-vases, imports t.imports) - -- - :: - ++ make-reef - |= =disc - ^- build-receipt - :: short-circuit to :pit if asked for current %home desk - :: - :: This avoids needing to recompile the kernel if we're asked - :: for the kernel we're already running. Note that this fails - :: referential transparency if |autoload is turned off. - :: - ?: ?& =(disc [our %home]) - :: is :date.build the latest commit on the %home desk? - :: - ?| =(now date.build) - :: - =/ =beam [[our %home [%da date.build]] /hoon/hoon/sys] - :: - .= (scry [%143 %noun] ~ %cw beam) - (scry [%143 %noun] ~ %cw beam(r [%da now])) - == == - :: - [build [%build-result %success %reef pit] accessed-builds] - :: - =/ hoon-scry - [date.build [%scry %c %x [disc /hoon/hoon/sys]]] - :: - =^ hoon-scry-result accessed-builds (depend-on hoon-scry) - :: - =/ arvo-scry - [date.build [%scry %c %x [disc /hoon/arvo/sys]]] - :: - =^ arvo-scry-result accessed-builds (depend-on arvo-scry) - :: - =/ zuse-scry - [date.build [%scry %c %x [disc /hoon/zuse/sys]]] - :: - =^ zuse-scry-result accessed-builds (depend-on zuse-scry) - :: - =| blocks=(list ^build) - =? blocks ?=(~ hoon-scry-result) [hoon-scry blocks] - =? blocks ?=(~ arvo-scry-result) [arvo-scry blocks] - =? blocks ?=(~ zuse-scry-result) [zuse-scry blocks] - :: - ?^ blocks - [build [%blocks blocks ~] accessed-builds] - :: - ?. ?=([~ %success %scry *] hoon-scry-result) - (wrap-error hoon-scry-result) - :: - ?. ?=([~ %success %scry *] arvo-scry-result) - (wrap-error arvo-scry-result) - :: - ?. ?=([~ %success %scry *] zuse-scry-result) - (wrap-error zuse-scry-result) - :: omit case from path to prevent cache misses - :: - =/ hoon-path=path - /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/hoon/sys - =/ hoon-hoon=hoon (rain hoon-path ;;(@t q.q.cage.u.hoon-scry-result)) - :: - =/ arvo-path=path - /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/arvo/sys - =/ arvo-hoon=hoon (rain arvo-path ;;(@t q.q.cage.u.arvo-scry-result)) - :: - =/ zuse-path=path - /(scot %p ship.disc)/(scot %tas desk.disc)/hoon/zuse/sys - =/ zuse-hoon=hoon (rain zuse-path ;;(@t q.q.cage.u.zuse-scry-result)) - :: - =/ zuse-build=^build - :* date.build - %ride zuse-hoon - %ride arvo-hoon - %ride hoon-hoon - [%$ %noun !>(~)] - == - :: - =^ zuse-build-result accessed-builds (depend-on zuse-build) - ?~ zuse-build-result - [build [%blocks [zuse-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %ride *] zuse-build-result) - (wrap-error zuse-build-result) - :: - :+ build - [%build-result %success %reef vase.u.zuse-build-result] - accessed-builds - :: - ++ make-ride - |= [formula=hoon =schematic] - ^- build-receipt - :: - =^ result accessed-builds (depend-on [date.build schematic]) - ?~ result - [build [%blocks [date.build schematic]~ ~] accessed-builds] - :: - =* subject u.result - =* subject-cage (result-to-cage subject) - =/ slim-schematic=^schematic [%slim p.q.subject-cage formula] - =^ slim-result accessed-builds (depend-on [date.build slim-schematic]) - ?~ slim-result - [build [%blocks [date.build slim-schematic]~ ~] accessed-builds] - :: - ?. ?=([~ %success %slim *] slim-result) - (wrap-error slim-result) - :: - =/ val - (mock [q.q.subject-cage nock.u.slim-result] intercepted-scry) - :: val is a toon, which might be a list of blocks. - :: - ?- -.val - :: - %0 - :* build - [%build-result %success %ride [type.u.slim-result p.val]] - accessed-builds - == - :: - %1 - =/ blocked-paths=(list path) ((hard (list path)) p.val) - (blocked-paths-to-receipt %ride blocked-paths) - :: - %2 - (return-error [[%leaf "ford: %ride failed:"] p.val]) - == - :: - ++ make-same - |= =schematic - ^- build-receipt - :: - =^ result accessed-builds (depend-on [date.build schematic]) - :: - ?~ result - [build [%blocks [date.build schematic]~ ~] accessed-builds] - [build [%build-result u.result] accessed-builds] - :: - ++ make-scry - :: TODO: All accesses to :state which matter happens in this function; - :: those calculations need to be lifted out of +make into +execute. - :: - |= =resource - ^- build-receipt - :: construct a full +beam to make the scry request - :: - =/ =beam (extract-beam resource `date.build) - :: - =/ =scry-request [vane.resource care.resource beam] - :: perform scry operation if we don't already know the result - :: - :: Look up :scry-request in :scry-results.per-event to avoid - :: rerunning a previously blocked +scry. - :: - =/ scry-response - ?: (~(has by scry-results) scry-request) - (~(get by scry-results) scry-request) - (scry [%143 %noun] ~ `@tas`(cat 3 [vane care]:resource) beam) - :: scry blocked - :: - ?~ scry-response - :: TODO: Verify handling of already blocked scrys later - :: - :: We killed a bunch of code which "worked" but which might have - :: been a no-op. - :: - [build [%blocks ~ `scry-request] accessed-builds] - :: scry failed - :: - ?~ u.scry-response - %- return-error - :~ leaf+"scry failed for" - leaf+"%c{(trip care.resource)} {<(en-beam beam)>}" - == - :: scry succeeded - :: - [build [%build-result %success %scry u.u.scry-response] accessed-builds] - :: - ++ make-slim - |= [subject-type=type formula=hoon] - ^- build-receipt - :: - =/ compiled=(each (pair type nock) tang) - (mule |.((~(mint ut subject-type) [%noun formula]))) - :: - :* build - ?- -.compiled - %| [%build-result %error [leaf+"%slim failed: " p.compiled]] - %& [%build-result %success %slim p.compiled] - == - accessed-builds - == - :: - ++ make-slit - |= [gate=vase sample=vase] - ^- build-receipt - :: - =/ product=(each type tang) - (mule |.((slit p.gate p.sample))) - :: - :* build - ?- -.product - %| :* %build-result %error - :* (~(dunk ut p.sample) %have) - (~(dunk ut (~(peek ut p.gate) %free 6)) %want) - leaf+"%slit failed: " - p.product - == - == - %& [%build-result %success %slit p.product] - == - accessed-builds - == - :: - ++ make-volt - |= [=disc mark=term input=*] - ^- build-receipt - :: - =/ bunt-build=^build [date.build [%bunt disc mark]] - :: - =^ bunt-result accessed-builds (depend-on bunt-build) - ?~ bunt-result - [build [%blocks [bunt-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %bunt *] bunt-result) - (wrap-error bunt-result) - :: - =/ =build-result - [%success %volt [mark p.q.cage.u.bunt-result input]] - :: - [build [%build-result build-result] accessed-builds] - :: - ++ make-vale - :: TODO: better docs - :: - |= [=disc mark=term input=*] - ^- build-receipt - :: don't validate for the %noun mark - :: - ?: =(%noun mark) - =/ =build-result [%success %vale [%noun %noun input]] - :: - [build [%build-result build-result] accessed-builds] - :: - =/ path-build [date.build [%path disc %mar mark]] - :: - =^ path-result accessed-builds (depend-on path-build) - ?~ path-result - [build [%blocks [path-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %path *] path-result) - (wrap-error path-result) - :: - =/ bunt-build=^build [date.build [%bunt disc mark]] - :: - =^ bunt-result accessed-builds (depend-on bunt-build) - ?~ bunt-result - [build [%blocks [bunt-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %bunt *] bunt-result) - (wrap-error bunt-result) - :: - =/ mark-sample=vase q.cage.u.bunt-result - :: - =/ call-build=^build - :^ date.build - %call - ^= gate - :* %ride - :: (ream 'noun:grab') - formula=`hoon`[%tsgl [%wing ~[%noun]] [%wing ~[%grab]]] - subject=`schematic`[%core rail.u.path-result] - == - sample=[%$ %noun %noun input] - :: - =^ call-result accessed-builds (depend-on call-build) - ?~ call-result - [build [%blocks [call-build]~ ~] accessed-builds] - :: - ?. ?=([~ %success %call *] call-result) - (wrap-error call-result) - :: - =/ product=vase vase.u.call-result - :: TODO: why do we check nesting here? - :: - ?> (~(nest ut p.mark-sample) | p.product) - :: check mold idempotence; if different, nest fail - :: - ?: =(q.product input) - =/ =build-result - [%success %vale [mark p.mark-sample q.product]] - :: - [build [%build-result build-result] accessed-builds] - :: - %- return-error - =/ =beam [[ship.disc desk.disc %da date.build] spur.rail.u.path-result] - [leaf+"ford: %vale failed: invalid input for mark: {<(en-beam beam)>}"]~ - :: - ++ make-walk - |= [=disc source=term target=term] - ^- build-receipt - :: - |^ ^- build-receipt - :: load all marks. - :: - =^ load-marks-result accessed-builds - (load-marks-reachable-from [[%grow source] [%grab target] ~]) - ?: ?=([%| *] load-marks-result) - p.load-marks-result - :: find a path through the graph - :: - :: Make a list of individual mark translation actions which will - :: take us from :source to :term. - :: - =/ path (find-path-through p.load-marks-result) - :: if there is no path between these marks, give a nice error message. - :: - ?~ path - :* build - :* %build-result %error - [leaf+"ford: no mark path from {} to {}"]~ - == - accessed-builds - == - :: - :* build - [%build-result %success %walk path] - accessed-builds - == - :: +load-node: a queued loading action - :: - += load-node [type=?(%grab %grow) mark=term] - :: edge-jug: type of our graph representation - :: - += edge-jug (jug source=term [target=term arm=?(%grow %grab)]) - :: mark-path: a path through the mark graph - :: - += mark-path (list mark-action) - :: +load-marks-reachable-from: partial mark graph loading - :: - :: While we can just load all marks in the %/mar directory, this is - :: rather slow. What we do instead is traverse forwards and backwards - :: from the source and target marks: we start at the source mark, - :: check all the grow arms, and then check their grow arms. At the - :: same time, we start from the target mark, check all the grab arms, - :: and then check their grab arms. This gives us a much smaller - :: dependency set than loading the entire %/mar directory. - :: - ++ load-marks-reachable-from - |= queued-nodes=(list load-node) - :: list of nodes in the graph that we've already checked - :: - =| visited=(set load-node) - :: graph of the available edges - :: - =| =edge-jug - :: - |- - ^- [(each ^edge-jug build-receipt) _accessed-builds] - :: no ?~ to prevent tmi - :: - ?: =(~ queued-nodes) - [[%& edge-jug] accessed-builds] - :: - =/ nodes-and-schematics - %+ turn queued-nodes - |= =load-node - ^- [^load-node schematic] - :- load-node - [%path disc %mar mark.load-node] - :: get the path for each mark name - :: - :: For %path builds, any ambiguous path is just filtered out. - :: - =^ path-results accessed-builds - (perform-schematics nodes-and-schematics %filter-errors *load-node) - ?: ?=([%| *] path-results) - [path-results accessed-builds] - :: - =/ nodes-and-cores - %+ turn p.path-results - |= [=load-node =build-result] - ^- [^load-node schematic] - :: - ?> ?=([%success %path *] build-result) - :: - :- load-node - [%core rail.build-result] - :: - =^ core-results accessed-builds - (perform-schematics nodes-and-cores %filter-errors *load-node) - ?: ?=([%| *] core-results) - [core-results accessed-builds] - :: clear the queue before we process the new results - :: - =. queued-nodes ~ - :: - =/ cores p.core-results - :: - |- - ?~ cores - ^$ - :: mark this node as visited - :: - =. visited (~(put in visited) key.i.cores) - :: - =/ target-arms=(list load-node) - ?> ?=([%success %core *] result.i.cores) - ?: =(%grow type.key.i.cores) - (get-arms-of-type %grow vase.result.i.cores) - (get-arms-of-type %grab vase.result.i.cores) - :: filter places we know we've already been. - :: - =. target-arms - %+ skip target-arms ~(has in visited) - =. queued-nodes (weld target-arms queued-nodes) - :: - =. edge-jug - |- - ?~ target-arms - edge-jug - :: - =. edge-jug - ?- type.i.target-arms - :: - %grab - (~(put ju edge-jug) mark.i.target-arms [mark.key.i.cores %grab]) - :: - %grow - (~(put ju edge-jug) mark.key.i.cores [mark.i.target-arms %grow]) - == - $(target-arms t.target-arms) - :: - $(cores t.cores) - :: - ++ get-arms-of-type - |= [type=?(%grab %grow) =vase] - ^- (list load-node) - :: it is valid for this node to not have a +grow arm. - :: - ?. (slob type p.vase) - ~ - :: - %+ turn - (sloe p:(slap vase [%limb type])) - |= arm=term - [type arm] - :: +find-path-through: breadth first search over the mark graph - :: - ++ find-path-through - |= edges=edge-jug - ^- mark-path - :: the source node starts out visited - =/ visited-nodes=(set mark) [source ~ ~] - :: these paths are flopped so we're always inserting to the front. - =| path-queue=(qeu mark-path) - :: start the queue with all the edges which start at the source mark - :: - =. path-queue - =/ start-links (find-links-in-edges edges source) - :: - |- - ^+ path-queue - ?~ start-links - path-queue - :: - =. path-queue (~(put to path-queue) [i.start-links]~) - :: - $(start-links t.start-links) - :: - |- - ^- mark-path - :: - ?: =(~ path-queue) - :: no path found - ~ - =^ current path-queue [p q]:~(get to path-queue) - ?> ?=(^ current) - :: - ?: =(target target.i.current) - :: we have a completed path. paths in the queue are backwards - (flop current) - :: - =+ next-steps=(find-links-in-edges edges target.i.current) - :: filter out already visited nodes - :: - =. next-steps - %+ skip next-steps - |= link=mark-action - (~(has in visited-nodes) source.link) - :: then add the new ones to the set of already visited nodes - :: - =. visited-nodes - (~(gas in visited-nodes) (turn next-steps |=(mark-action source))) - :: now all next steps go in the queue - :: - =. path-queue - %- ~(gas to path-queue) - %+ turn next-steps - |= new-link=mark-action - [new-link current] - :: - $ - :: +find-links-in-edges: gets edges usable by +find-path-through - :: - :: This deals with disambiguating between %grab and %grow so we always - :: pick %grab over %grow. - :: - ++ find-links-in-edges - |= [edges=edge-jug source=term] - ^- (list mark-action) - :: - =+ links=~(tap in (~(get ju edges) source)) - :: - =| results=(set mark-action) - |- - ^- (list mark-action) - ?~ links - ~(tap in results) - :: - ?- arm.i.links - %grab - :: if :results has a %grow entry, remove it before adding our %grab - =/ grow-entry=mark-action [%grow source target.i.links] - =? results (~(has in results) grow-entry) - (~(del in results) grow-entry) - :: - =. results (~(put in results) [%grab source target.i.links]) - $(links t.links) - :: - %grow - :: if :results has a %grab entry, don't add a %grow entry - ?: (~(has in results) [%grab source target.i.links]) - $(links t.links) - :: - =. results (~(put in results) [%grow source target.i.links]) - $(links t.links) - == - -- - :: |utilities:make: helper arms - :: - ::+| utilities - :: +perform-schematics: helper function that performs a list of builds - :: - :: We often need to run a list of builds. This helper method will - :: depend on all :builds, will return a +build-receipt of either the - :: blocks or the first error, or a list of all completed results. - :: - :: This is a wet gate so individual callers can associate their own - :: key types with schematics. - :: - ++ perform-schematics - |* $: builds=(list [key=* =schematic]) - on-error=?(%fail-on-errors %filter-errors %ignore-errors) - key-bunt=* - == - ^- $: (each (list [key=_key-bunt result=build-result]) build-receipt) - _accessed-builds - == - :: - |^ =^ results accessed-builds - =| results=(list [_key-bunt ^build (unit build-result)]) - |- - ^+ [results accessed-builds] - :: - ?~ builds - [results accessed-builds] - :: - =/ sub-build=^build [date.build schematic.i.builds] - =^ result accessed-builds (depend-on sub-build) - =. results [[key.i.builds sub-build result] results] - :: - $(builds t.builds) - ?: =(%fail-on-errors on-error) - (check-errors results) - ?: =(%filter-errors on-error) - (filter-errors results) - (handle-rest results) - :: - ++ check-errors - |= results=(list [_key-bunt ^build (unit build-result)]) - :: - =/ error=tang - %- zing ^- (list tang) - %+ murn results - |= [* * result=(unit build-result)] - ^- (unit tang) - ?. ?=([~ %error *] result) - ~ - `message.u.result - :: only produce the first error, as is tradition - :: - ?^ error - =. error [leaf+"ford: %mute failed: " error] - [[%| [build [%build-result %error error] accessed-builds]] accessed-builds] - (handle-rest results) - :: - ++ filter-errors - |= results=(list [_key-bunt ^build (unit build-result)]) - =. results - %+ skip results - |= [* * r=(unit build-result)] - ?=([~ %error *] r) - (handle-rest results) - :: - ++ handle-rest - |= results=(list [_key-bunt ^build (unit build-result)]) - :: if any sub-builds blocked, produce all blocked sub-builds - :: - =/ blocks=(list ^build) - %+ murn `(list [* ^build (unit build-result)])`results - |= [* sub=^build result=(unit build-result)] - ^- (unit ^build) - ?^ result - ~ - `sub - :: - ?^ blocks - [[%| [build [%blocks blocks ~] accessed-builds]] accessed-builds] - :: - :_ accessed-builds - :- %& - %+ turn results - |* [key=_key-bunt ^build result=(unit build-result)] - ^- [_key-bunt build-result] - [key (need result)] - -- - :: +wrap-error: wrap an error message around a failed sub-build - :: - ++ wrap-error - |= result=(unit build-result) - ^- build-receipt - :: - ?> ?=([~ %error *] result) - =/ message=tang - [[%leaf "ford: {<-.schematic.build>} failed: "] message.u.result] - :: - [build [%build-result %error message] accessed-builds] - :: +return-error: returns a specific failure message - :: - ++ return-error - |= =tang - ^- build-receipt - [build [%build-result %error tang] accessed-builds] - :: - ++ depend-on - |= kid=^build - ^- [(unit build-result) _accessed-builds] - :: - =. accessed-builds [kid accessed-builds] - :: +access-build-record will mutate :results.state - :: - :: It's okay to ignore this because the accessed-builds get gathered - :: and merged during the +reduce step. - :: - =/ maybe-build-record -:(access-build-record kid) - ?~ maybe-build-record - [~ accessed-builds] - :: - =* build-record u.maybe-build-record - ?: ?=(%tombstone -.build-record) - [~ accessed-builds] - :: - [`build-result.build-record accessed-builds] - :: +blocked-paths-to-receipt: handle the %2 case for mock - :: - :: Multiple schematics handle +toon instances. This handles the %2 case - :: for a +toon and transforms it into a +build-receipt so we depend on - :: the blocked paths correctly. - :: - ++ blocked-paths-to-receipt - |= [name=term blocked-paths=(list path)] - ^- build-receipt - :: - =/ blocks-or-failures=(list (each ^build tank)) - %+ turn blocked-paths - |= =path - :: - =/ scry-request=(unit scry-request) (path-to-scry-request path) - ?~ scry-request - [%| [%leaf "ford: {}: invalid scry path: {}"]] - :: - =* case r.beam.u.scry-request - :: - ?. ?=(%da -.case) - [%| [%leaf "ford: {}: invalid case in scry path: {}"]] - :: - =/ date=@da p.case - :: - =/ resource=(unit resource) (path-to-resource path) - ?~ resource - :- %| - [%leaf "ford: {}: invalid resource in scry path: {}"] - :: - =/ sub-schematic=^schematic [%pin date %scry u.resource] - :: - [%& `^build`[date sub-schematic]] - :: - =/ failed=tang - %+ murn blocks-or-failures - |= block=(each ^build tank) - ^- (unit tank) - ?- -.block - %& ~ - %| `p.block - == - :: - ?^ failed - :: some failed - :: - [build [%build-result %error failed] accessed-builds] - :: no failures - :: - =/ blocks=(list ^build) - %+ turn blocks-or-failures - |= block=(each ^build tank) - ?> ?=(%& -.block) - :: - p.block - :: - =. accessed-builds - %+ roll blocks - |= [block=^build accumulator=_accessed-builds] - =. accessed-builds accumulator - +:(depend-on [date.block schematic.block]) - :: - :: TODO: Here we are passing a single ~ for :scry-blocked. Should we - :: be passing one or multiple resource back instead? Maybe not? Are - :: we building blocking schematics, which they themselves will scry? - :: - [build [%blocks blocks ~] accessed-builds] - -- - :: |utilities:per-event: helper arms - :: - ::+| utilities - :: - :: +add-build: store a fresh, unstarted build in the state - :: - ++ add-build - |= =build - ^+ state - :: ~& [%add-build (build-to-tape build)] - :: don't overwrite an existing entry - :: - ?: (~(has by builds.state) build) - state - :: - %_ state - builds-by-schematic - (~(put by-schematic builds-by-schematic.state) build) - :: - builds - %+ ~(put by builds.state) build - :: TODO: when bunts work better, just bunt - :: - =| =build-status - build-status(state [%untried ~]) - == - :: +remove-builds: remove builds and their sub-builds - :: - ++ remove-builds - |= builds=(list build) - :: ~& [%remove-builds (turn builds build-to-tape)] - :: - |^ ^+ state - :: - ?~ builds - state - :: - ?~ maybe-build-status=(~(get by builds.state) i.builds) - $(builds t.builds) - =/ subs ~(tap in ~(key by subs.u.maybe-build-status)) - :: - =^ removed state (remove-single-build i.builds u.maybe-build-status) - ?. removed - $(builds t.builds) - :: - $(builds (welp t.builds subs)) - :: +remove-build: stop storing :build in the state - :: - :: Removes all linkages to and from sub-builds - :: TODO: should we assert we're not subscribed? - :: - ++ remove-single-build - |= [=build =build-status] - ^+ [removed=| state] - :: never delete a build that something depends on - :: - ?^ clients.build-status - :: ~& [%skip-remove-because-clients (build-to-tape build) clients.build-status] - [removed=| state] - ?^ requesters.build-status - :: ~& [%skip-remove-because-requesters (build-to-tape build) requesters.build-status] - [removed=| state] - :: ~& [%removing (build-to-tape build) (~(got by builds.state) build)] - :: nothing depends on :build, so we'll remove it - :: - :- removed=& - ^+ state - :: - =/ subs=(list ^build) ~(tap in ~(key by subs.build-status)) - :: for each sub, remove :build from its :clients - :: - =. builds.state - |- ^+ builds.state - ?~ subs builds.state - :: - =? builds.state (~(has by builds.state) i.subs) - :: - =< builds - %+ update-build-status i.subs - |= build-status=^build-status - ^+ build-status - :: - build-status(clients (~(del ju clients.build-status) duct build)) - :: - $(subs t.subs) - :: - %_ state - builds-by-schematic - (~(del by-schematic builds-by-schematic.state) build) - :: - builds - (~(del by builds.state) build) - == - -- - :: +update-build-status: replace :build's +build-status by running a function - :: - ++ update-build-status - |= [=build update-func=$-(build-status build-status)] - ^- [build-status builds=_builds.state] - :: - =/ original=build-status - ~| [%update-build (build-to-tape build)] - (~(got by builds.state) build) - =/ mutant=build-status (update-func original) - :: - [mutant (~(put by builds.state) build mutant)] - :: +intercepted-scry: use local results as a scry facade - :: - ++ intercepted-scry - %- sloy ^- slyd - |= [ref=* (unit (set monk)) =term =beam] - ^- (unit (unit (cask))) - ?> ?=([@ *] ref) - =/ hoon-version=@ud -.ref - :: - ~| hoon-version=hoon-version - ?> ?=(?(%143 %151) hoon-version) - :: if the actual scry produces a value, use that value; otherwise use local - :: - =/ scry-response (scry +<.$) - :: - ?^ scry-response - scry-response - :: - =/ vane=(unit ?(%c %g)) ((soft ?(%c %g)) (end 3 1 term)) - ?~ vane - ~ - =/ care=(unit care:clay) ((soft care:clay) (rsh 3 1 term)) - ?~ care - ~ - :: - =/ =resource - [u.vane u.care rail=[[p.beam q.beam] s.beam]] - :: TODO: handle other kinds of +case - :: - =/ date=@da - ~| bad-case+r.beam - ?> ?=(%da -.r.beam) - p.r.beam - :: - =/ =build [date %scry resource] - :: look up the scry result from our permanent state - :: - :: Note: we can't freshen this cache entry because we can't modify - :: the state in this gate. - :: - =/ local-result -:(access-build-record build) - ?~ local-result - ~ - ?: ?=(%tombstone -.u.local-result) - ~ - :: - =/ local-cage=cage (result-to-cage build-result.u.local-result) - :: if :local-result does not nest in :type, produce an error - :: - ?. -:(nets:wa +.ref `type`p.q.local-cage) - [~ ~] - :: - [~ ~ `(cask)`local-cage] - :: +unblock-clients-on-duct: unblock and produce clients blocked on :build - :: - ++ unblock-clients-on-duct - =| unblocked=(list build) - |= =build - ^+ [unblocked builds.state] - :: - =/ =build-status - ~| [%unblocking (build-to-tape build)] - (~(got by builds.state) build) - :: - =/ clients=(list ^build) ~(tap in (~(get ju clients.build-status) duct)) - :: - |- - ^+ [unblocked builds.state] - ?~ clients - [unblocked builds.state] - :: - =^ client-status builds.state - %+ update-build-status i.clients - |= client-status=^build-status - :: - =. subs.client-status - %+ ~(put by subs.client-status) build - =/ original (~(got by subs.client-status) build) - original(blocked |) - :: - =? state.client-status - ?& ?=(%blocked -.state.client-status) - :: - ?! - %- ~(any by subs.client-status) - |=(build-relation &(blocked verified)) - == - :: - [%unblocked ~] - client-status - :: - =? unblocked !?=(%blocked -.state.client-status) - [i.clients unblocked] - :: - $(clients t.clients) - :: +on-build-complete: handles completion of any build - :: - ++ on-build-complete - |= =build - ^+ ..execute - :: - :: ~& [%on-build-complete (build-to-tape build)] - =. ..execute (cleanup-orphaned-provisional-builds build) - :: - =/ duct-status (~(got by ducts.state) duct) - :: - =/ =build-status (~(got by builds.state) build) - ?: (~(has in requesters.build-status) duct) - (on-root-build-complete build) - :: - =^ unblocked-clients builds.state (unblock-clients-on-duct build) - =. candidate-builds (~(gas in candidate-builds) unblocked-clients) - :: - ..execute - :: +on-root-build-complete: handle completion or promotion of a root build - :: - :: When a build completes for a duct, we might have to send a %made move - :: on the requesting duct and also do duct and build book-keeping. - :: - ++ on-root-build-complete - |= =build - ^+ ..execute - :: - :: ~& [%on-root-build-complete (build-to-tape build)] - :: - =/ =build-status (~(got by builds.state) build) - =/ =duct-status (~(got by ducts.state) duct) - :: make sure we have something to send - :: - ?> ?=([%complete %value *] state.build-status) - :: send a %made move unless it's an unchanged live build - :: - =? moves - ?! - ?& ?=(%live -.live.duct-status) - ?=(^ last-sent.live.duct-status) - :: - =/ last-build-status - %- ~(got by builds.state) - [date.u.last-sent.live.duct-status schematic.build] - :: - ?> ?=(%complete -.state.last-build-status) - ?& ?=(%value -.build-record.state.last-build-status) - :: - .= build-result.build-record.state.last-build-status - build-result.build-record.state.build-status - == == - :_ moves - ^- move - :: - :* duct %give %made date.build %complete - build-result.build-record.state.build-status - == - :: - ?- -.live.duct-status - %once - =. ducts.state (~(del by ducts.state) duct) - =. state (remove-duct-from-root build) - :: - ..execute - :: - %live - =/ resources=(jug disc resource) (collect-live-resources build) - :: clean up previous build - :: - =? state ?=(^ last-sent.live.duct-status) - =/ old-build=^build build(date date.u.last-sent.live.duct-status) - :: - :: ~& [%remove-previous-duct-from-root duct duct-status (build-to-tape old-build)] - (remove-duct-from-root old-build) - :: - =/ resource-list=(list [=disc resources=(set resource)]) - ~(tap by resources) - :: we can only handle a single subscription - :: - :: In the long term, we need Clay's interface to change so we can - :: subscribe to multiple desks at the same time. - :: - ?: (lth 1 (lent resource-list)) - =. ..execute (send-incomplete build) - =. ducts.state (~(del by ducts.state) duct) - =. state (remove-duct-from-root build) - ..execute - :: - =/ subscription=(unit subscription) - ?~ resource-list - ~ - `[date.build disc.i.resource-list resources.i.resource-list] - :: - =? ..execute ?=(^ subscription) - (start-clay-subscription u.subscription) - :: - =. ducts.state - %+ ~(put by ducts.state) duct - %_ duct-status - live - [%live in-progress=~ last-sent=`[date.build subscription]] - == - :: - ..execute - == - :: +send-incomplete: - :: - ++ send-incomplete - |= =build - ^+ ..execute - :: - =. moves - :_ moves - ^- move - :* duct %give %made date.build - ^- made-result - :- %incomplete - [%leaf "build tried to subscribe to multiple discs"]~ - == - :: - ..execute - :: +cleanup-orphaned-provisional-builds: delete extraneous sub-builds - :: - :: Remove unverified linkages to sub builds. If a sub-build has no other - :: clients on this duct, then it is orphaned and we remove the duct from - :: its subs and call +cleanup on it. - :: - ++ cleanup-orphaned-provisional-builds - |= =build - ^+ ..execute - :: ~& [%cleanup-orphaned-provisional-builds (build-to-tape build)] - :: - =/ =build-status (~(got by builds.state) build) - :: - =/ orphans=(list ^build) - %+ murn ~(tap by subs.build-status) - |= [sub=^build =build-relation] - ^- (unit ^build) - :: - ?: verified.build-relation - ~ - `sub - :: remove links to orphans in :build's +build-status - :: - =^ build-status builds.state - %+ update-build-status build - |= build-status=^build-status - %_ build-status - subs - :: - |- ^+ subs.build-status - ?~ orphans subs.build-status - :: - =. subs.build-status (~(del by subs.build-status) i.orphans) - :: - $(orphans t.orphans) - == - :: - |- ^+ ..execute - ?~ orphans ..execute - :: remove link to :build in :i.orphan's +build-status - :: - =^ orphan-status builds.state - %+ update-build-status i.orphans - |= orphan-status=_build-status - %_ orphan-status - clients (~(del ju clients.orphan-status) duct build) - == - :: - ?: (~(has by clients.orphan-status) duct) - $(orphans t.orphans) - :: :build was the last client on this duct so remove it - :: - =. builds.state (remove-duct-from-subs i.orphans) - =. state (cleanup i.orphans) - $(orphans t.orphans) - :: +access-build-record: access a +build-record, updating :last-accessed - :: - :: Usage: - :: ``` - :: =^ maybe-build-record builds.state (access-build-record build) - :: ``` - :: - ++ access-build-record - |= =build - ^- [(unit build-record) _builds.state] - :: - ?~ maybe-build-status=(~(get by builds.state) build) - [~ builds.state] - :: - =/ =build-status u.maybe-build-status - :: - ?. ?=(%complete -.state.build-status) - [~ builds.state] - :: - ?: ?=(%tombstone -.build-record.state.build-status) - [`build-record.state.build-status builds.state] - :: - =. last-accessed.build-record.state.build-status now - :: - :- `build-record.state.build-status - (~(put by builds.state) build build-status) - :: +cleanup: try to clean up a build and its sub-builds - :: - ++ cleanup - |= =build - ^+ state - :: does this build even exist?! - :: - ?~ maybe-build-status=(~(get by builds.state) build) - :: ~& [%cleanup-no-build (build-to-tape build)] - state - :: - =/ =build-status u.maybe-build-status - :: never delete a build that something depends on - :: - ?^ clients.build-status - :: ~& [%cleanup-clients-no-op (build-to-tape build)] - state - ?^ requesters.build-status - :: ~& [%cleanup-requesters-no-op (build-to-tape build)] - state - :: ~& [%cleanup (build-to-tape build)] - :: - (remove-builds ~[build]) - :: +collect-live-resources: produces all live resources from sub-scrys - :: - ++ collect-live-resources - |= =build - ^- (jug disc resource) - :: ~& [%collect-live-resources (build-to-tape build)] - :: - ?: ?=(%scry -.schematic.build) - =* resource resource.schematic.build - (my [(extract-disc resource) (sy [resource]~)]~) - :: - ?: ?=(%pin -.schematic.build) - ~ - :: - =/ subs ~(tap in ~(key by subs:(~(got by builds.state) build))) - =| resources=(jug disc resource) - |- - ?~ subs - resources - :: - =/ sub-resources=(jug disc resource) ^$(build i.subs) - =. resources (unify-jugs resources sub-resources) - $(subs t.subs) - :: +collect-blocked-resources: produces all blocked resources from sub-scrys - :: - ++ collect-blocked-sub-scrys - |= =build - ^- (set scry-request) - :: - ?: ?=(%scry -.schematic.build) - =, resource.schematic.build - =/ =scry-request - :+ vane care - ^- beam - [[ship.disc.rail desk.disc.rail [%da date.build]] spur.rail] - (sy [scry-request ~]) - :: only recurse on blocked sub-builds - :: - =/ subs=(list ^build) - %+ murn ~(tap by subs:(~(got by builds.state) build)) - |= [sub=^build =build-relation] - ^- (unit ^build) - :: - ?. blocked.build-relation - ~ - `sub - :: - =| scrys=(set scry-request) - |- - ^+ scrys - ?~ subs - scrys - :: - =. scrys (~(uni in scrys) ^$(build i.subs)) - $(subs t.subs) - :: +start-clay-subscription: listen for changes in the filesystem - :: - ++ start-clay-subscription - |= =subscription - ^+ ..execute - :: - =/ already-subscribed=? - (~(has by pending-subscriptions.state) subscription) - :: ~& [%start-clay-subscription subscription already-subscribed=already-subscribed pending-subscriptions.state] - :: - =. pending-subscriptions.state - (put-request pending-subscriptions.state subscription duct) - :: don't send a duplicate move if we're already subscribed - :: - ?: already-subscribed - ..execute - :: - =/ =wire (clay-subscription-wire [date disc]:subscription) - :: - =/ =note - :: request-contents: the set of [care path]s to subscribe to in clay - :: - =/ request-contents=(set [care:clay path]) - %- sy ^- (list [care:clay path]) - %+ murn ~(tap in `(set resource)`resources.subscription) - |= =resource ^- (unit [care:clay path]) - :: - ?. ?=(%c -.resource) ~ - :: - `[care.resource (flop spur.rail.resource)] - :: if :request-contents is `~`, this code is incorrect - :: - ?< ?=(~ request-contents) - :: their: requestee +ship - :: - =+ [their desk]=disc.subscription - :: - :^ %c %warp sock=[our their] - ^- riff:clay - [desk `[%mult `case`[%da date.subscription] request-contents]] - :: - =. moves [`move`[duct [%pass wire note]] moves] - :: - ..execute - :: +cancel-clay-subscription: remove a subscription on :duct - :: - ++ cancel-clay-subscription - |= =subscription - ^+ ..execute - :: - :: ~& [%cancel-clay-subscription subscription pending-subscriptions.state] - =^ originator pending-subscriptions.state - (del-request pending-subscriptions.state subscription duct) - :: if there are still other ducts on this subscription, don't send a move - :: - ?~ originator - ..execute - :: - =/ =wire (clay-subscription-wire [date disc]:subscription) - :: - =/ =note - =+ [their desk]=disc.subscription - [%c %warp sock=[our their] `riff:clay`[desk ~]] - :: - =. moves [`move`[u.originator [%pass wire note]] moves] - :: - ..execute - :: +clay-sub-wire: the wire to use for a clay subscription - :: - :: While it is possible for two different root builds to make - :: subscriptions with the same wire, those wires will always be associated - :: with different ducts, so there's no risk of duplicates. - :: - ++ clay-subscription-wire - |= [date=@da =disc] - ^- wire - :: - =+ [their desk]=disc - :: - /(scot %p our)/clay-sub/(scot %p their)/[desk]/(scot %da date) - :: +start-scry-request: kick off an asynchronous request for a resource - :: - ++ start-scry-request - |= =scry-request - ^+ ..execute - :: we only know how to make asynchronous scrys to clay, for now - :: - ?> ?=(%c vane.scry-request) - :: if we are the first block depending on this scry, send a move - :: - =/ already-started=? (~(has by pending-scrys.state) scry-request) - :: - =. pending-scrys.state - (put-request pending-scrys.state scry-request duct) - :: don't send a duplicate move if we've already sent one - :: - ?: already-started - ..execute - :: - =/ =wire (scry-request-wire scry-request) - :: - =/ =note - =, scry-request - =/ =disc [p q]:beam - :* %c %warp sock=[our their=ship.disc] desk.disc - `[%sing care case=r.beam (flop s.beam)] - == - :: - =. moves [`move`[duct [%pass wire note]] moves] - :: - ..execute - :: +cancel-scry-request: cancel a pending asynchronous scry request - :: - ++ cancel-scry-request - |= =scry-request - ^+ ..execute - :: we only know how to make asynchronous scrys to clay, for now - :: - ?> ?=(%c vane.scry-request) - :: - =^ originator pending-scrys.state - (del-request pending-scrys.state scry-request duct) - :: if there are still other ducts on this subscription, don't send a move - :: - ?~ originator - ..execute - :: - =/ =wire (scry-request-wire scry-request) - :: - =/ =note - =+ [their desk]=[p q]:beam.scry-request - [%c %warp sock=[our their] `riff:clay`[desk ~]] - :: - =. moves [`move`[u.originator [%pass wire note]] moves] - :: - ..execute - :: +scry-request-wire - :: - ++ scry-request-wire - |= =scry-request - ^- wire - (welp /(scot %p our)/scry-request (scry-request-to-path scry-request)) - -- --- -:: -:: end =~ -:: -. == -=, ford-api :: TODO remove once in vane -:: -:::: vane core - :: -=| ax=axle -|= [now=@da eny=@ scry-gate=sley] -:: allow jets to be registered within this core -:: -~% %ford-d ..is ~ :: XX why the '-d'? -:: -:: ^? :: to be added to real vane -:: -|% -:: +call: handle a +task:able from arvo -:: -++ call - |= [=duct type=* wrapped-task=(hobo task:able)] - ^- [p=(list move) q=_ford-gate] - :: unwrap :task from :wrapped-task - :: - =/ task=task:able - ?. ?=(%soft -.wrapped-task) - wrapped-task - ((hard task:able) p.wrapped-task) - :: - ?- -.task - :: %build: request to perform a build - :: - %build - :: perform the build indicated by :task - :: - :: First, we find or create the :ship-state for :our.task, - :: modifying :state-by-ship as necessary. Then we dispatch to the |ev - :: by constructing :event-args and using them to create :start-build, - :: which performs the build. The result of :start-build is a pair of - :: :moves and a mutant :ship-state. We update our :state-by-ship map - :: with the new :ship-state and produce it along with :moves. - :: - =^ ship-state state-by-ship.ax (find-or-create-ship-state our.task) - =/ =build [now schematic.task] - =* event-args [[our.task duct now scry-gate] ship-state] - =* start-build start-build:(per-event event-args) - =^ moves ship-state (start-build build live.task) - =. state-by-ship.ax (~(put by state-by-ship.ax) our.task ship-state) - :: - [moves ford-gate] - :: - :: %kill: cancel a %build - :: - %kill - :: - =/ ship-state ~|(our+our.task (~(got by state-by-ship.ax) our.task)) - =* event-args [[our.task duct now scry-gate] ship-state] - =^ moves ship-state cancel:(per-event event-args) - =. state-by-ship.ax (~(put by state-by-ship.ax) our.task ship-state) - :: - [moves ford-gate] - :: - :: %wipe: wipe the cache, clearing half the entries - :: - %wipe - :: - =/ ship-states=(list [@p ford-state]) ~(tap by state-by-ship.ax) - :: wipe each ship in the state separately - :: - =. state-by-ship.ax - %+ roll ship-states - |= [[ship=@p state=ford-state] accumulator=(map @p ford-state)] - :: - (~(put by accumulator) ship (wipe state)) - :: - [~ ford-gate] - :: - %wegh - :_ ford-gate - :_ ~ - :^ duct %give %mass - ^- mass - :- %turbo - :- %| - %+ turn ~(tap by state-by-ship.ax) :: XX single-home - |= [our=@ ford-state] ^- mass - :+ (scot %p our) %| - :: - :~ [%builds [%& builds]] - [%ducts [%& ducts]] - [%builds-by-schematic [%& builds-by-schematic]] - [%pending-scrys [%& pending-scrys]] - [%pending-subscriptions [%& pending-subscriptions]] - == - == -:: +wipe: wipe half a +ford-state's cache, in LRU (least recently used) order -:: -++ wipe - |= state=ford-state - ^+ state - :: - =/ cache-list=(list [build build-record]) - %+ murn ~(tap by builds.state) - |= [=build =build-status] - ^- (unit [^build build-record]) - :: - ?. ?=(%complete -.state.build-status) - ~ - `[build build-record.state.build-status] - :: - =/ split-cache=[(list [build build-record]) (list [build build-record])] - %+ skid cache-list - |=([=build =build-record] ?=(%tombstone -.build-record)) - :: - =/ tombstones=(list [build build-record]) -.split-cache - =/ values=(list [build build-record]) +.split-cache - :: sort the cache lines in chronological order by :last-accessed - :: - =/ sorted=(list [build build-record]) - %+ sort values - |= [a=[=build =build-record] b=[=build =build-record]] - ^- ? - :: - ?> ?=(%value -.build-record.a) - ?> ?=(%value -.build-record.b) - :: - (lte last-accessed.build-record.a last-accessed.build-record.b) - :: - =/ num-entries=@ (lent cache-list) - :: num-stale: half of :num-entries, rounded up in case :num-entries is 1 - :: - =/ num-stale (sub num-entries (div num-entries 2)) - ~& "ford: wipe: {} cache entries" - :: - =/ stale=(list [build build-record]) (scag num-stale sorted) - :: - %_ state - builds - %- ~(gas by builds.state) - %+ turn stale - |= [=build =build-record] - ^- (pair ^build build-status) - :: - =/ =build-status (~(got by builds.state) build) - ?> ?=(%complete -.state.build-status) - :: - [build build-status(build-record.state [%tombstone ~])] - == -:: +take: receive a response from another vane -:: -++ take - |= [=wire =duct wrapped-sign=(hypo sign)] - ^- [p=(list move) q=_ford-gate] - :: unwrap :sign from :wrapped-sign - :: - :: TODO: verify wrapped-sign isn't an evil vase? - :: - =/ =sign q.wrapped-sign - :: TODO: support other responses - :: - :: parse :wire into :our, :ship-state, and :resource - :: - ?> ?=([@ @ *] wire) - :: we know :our is already in :state-by-ship because we sent this request - :: - =/ our=@p (slav %p i.wire) - =/ ship-state ~|(take-our+our (~(got by state-by-ship.ax) our)) - :: - |^ ^- [p=(list move) q=_ford-gate] - :: - =^ moves ship-state - ?+ i.t.wire ~|([%bad-take-wire wire] !!) - %clay-sub take-rebuilds - %scry-request take-unblocks - == - :: - =. state-by-ship.ax (~(put by state-by-ship.ax) our ship-state) - :: - [moves ford-gate] - :: +take-rebuilds: rebuild all live builds affected by the Clay changes - :: - ++ take-rebuilds - ^- [(list move) ford-state] - :: - ?> ?=([%c %wris *] sign) - =+ [ship desk date]=(raid:wired t.t.wire ~[%p %tas %da]) - =/ disc [ship desk] - :: - :: ~& [%pending-subscriptions pending-subscriptions.ship-state] - =/ =subscription - ~| [%ford-take-bad-clay-sub wire=wire duct=duct] - =/ =duct-status (~(got by ducts.ship-state) duct) - ?> ?=(%live -.live.duct-status) - ?> ?=(^ last-sent.live.duct-status) - ?> ?=(^ subscription.u.last-sent.live.duct-status) - u.subscription.u.last-sent.live.duct-status - :: ~& [%subscription subscription] - :: - =/ ducts=(list ^duct) - ~| [%ford-take-missing-subscription subscription] - (get-request-ducts pending-subscriptions.ship-state subscription) - :: ~& [%ducts-for-clay-sub ducts] - :: - =| moves=(list move) - |- ^+ [moves ship-state] - ?~ ducts [moves ship-state] - :: - =* event-args [[our i.ducts now scry-gate] ship-state] - =* rebuild rebuild:(per-event event-args) - =^ duct-moves ship-state - (rebuild subscription p.case.sign disc care-paths.sign) - :: - $(ducts t.ducts, moves (weld moves duct-moves)) - :: +take-unblocks: unblock all builds waiting on this scry request - :: - ++ take-unblocks - ^- [(list move) ford-state] - :: - ?> ?=([%c %writ *] sign) - :: scry-request: the +scry-request we had previously blocked on - :: - =/ =scry-request - ~| [%ford-take-bad-scry-request wire=wire duct=duct] - (need (path-to-scry-request t.t.wire)) - :: scry-result: parse a (unit cage) from :sign - :: - :: If the result is `~`, the requested resource was not available. - :: - =/ scry-result=(unit cage) - ?~ riot.sign - ~ - `r.u.riot.sign - :: - =/ ducts=(list ^duct) - ~| [%ford-take-missing-scry-request scry-request] - (get-request-ducts pending-scrys.ship-state scry-request) - :: ~& [%ducts-for-scrys ducts] - :: - =| moves=(list move) - |- ^+ [moves ship-state] - ?~ ducts [moves ship-state] - :: - =* event-args [[our i.ducts now scry-gate] ship-state] - :: unblock the builds that had blocked on :resource - :: - =* unblock unblock:(per-event event-args) - =^ duct-moves ship-state (unblock scry-request scry-result) - :: - $(ducts t.ducts, moves (weld moves duct-moves)) - -- -:: +load: migrate old state to new state (called on vane reload) -:: -++ load - |= old=axle - ^+ ..^$ - :: - ~! %loading - ..^$(ax old) -:: +stay: produce current state -:: -++ stay `axle`ax -:: +scry: request a path in the urbit namespace -:: -++ scry - |= * - [~ ~] -:: %utilities -:: -::+| -:: -++ ford-gate ..$ -:: +find-or-create-ship-state: find or create a ford-state for a @p -:: -:: Accesses and modifies :state-by-ship. -:: -++ find-or-create-ship-state - |= our=@p - ^- [ford-state _state-by-ship.ax] - :: - =/ existing (~(get by state-by-ship.ax) our) - ?^ existing - [u.existing state-by-ship.ax] - :: - =| new-state=ford-state - [new-state (~(put by state-by-ship.ax) our new-state)] --- diff --git a/sys/zuse.hoon b/sys/zuse.hoon index 461cab78ce..58a13064ce 100644 --- a/sys/zuse.hoon +++ b/sys/zuse.hoon @@ -847,94 +847,9 @@ :: :::: :::: ++ford :: (1f) build :: :::: -++ ford ^? - |% - :: :: - :::: ++able:ford :: (1f1) arvo moves - :: :::: - ++ able ^? - |% - ++ gift :: out result <-$ - $% {$made p/@uvH q/gage} :: computed result - {$mass p/mass} :: memory usage - {$news p/@uvH} :: fresh depends - == :: - ++ task :: in request ->$ - $% {$exec p/@p q/(unit bilk)} :: make / kill - {$wasp p/@p q/{@uvH ?}} :: depends ask / kill - {$wegh $~} :: report memory - {$wipe p/@p $~} :: clear cache - == :: - -- ::able - ++ bilk (pair beak silk) :: sourced request - ++ gage :: recursive cage+tang - $% {$& p/cage} :: success - {$| p/tang} :: error - {$tabl p/(list (pair gage gage))} :: table of results - == :: - ++ hood :: assembly plan - $: zus/@ud :: zuse kelvin - sur/(list hoof) :: structures - lib/(list hoof) :: libraries - fan/(list horn) :: resources - src/(list hoop) :: program - == :: - ++ hoof (trel ? term (unit (pair case ship))) :: resource reference - ++ hoop :: source in hood - $% {$& p/hoon} :: direct hoon - {$| p/beam} :: resource location - == :: - ++ hops :: XX late-bound path - $: pre/(unit tyke) :: - pof/(unit {p/@ud q/tyke}) :: - == :: - ++ horn :: resource tree - $% {$fssg p/hoon} :: /~ twig by hand - {$fsbc p/hoon} :: /$ argument - {$fsbr p/(list horn)} :: /| options - {$fshx p/horn} :: /# insert dephash - {$fspt p/horn} :: /@ insert mod-time - {$fsts p/term q/horn} :: /= apply face - {$fsdt p/(list horn)} :: /. list - {$fscm p/(list (pair spur horn))} :: /, switch by path - {$fscn p/horn} :: /% propagate args - {$fspm p/(list mark) q/horn} :: /& translates - {$fscb p/horn} :: /_ homo map - {$fssm p/hoon q/horn} :: /; operate on - {$fscl p/hops q/horn} :: /: relative to - {$fskt p/hoon q/horn} :: /^ cast - {$fszp q/mark} :: /!mark/ eval value - {$fszy q/mark} :: /mark/ static/grow - == :: - ++ milk (trel ship desk silk) :: sourced silk - ++ silk :: construction layer - $^ {p/silk q/silk} :: cons - $% {$$ p/cage} :: literal - {$alts p/(list silk)} :: options - {$bake p/mark q/coin r/beam} :: local synthesis - {$bunt p/mark} :: example of mark - {$call p/silk q/silk} :: slam - {$cast p/mark q/silk} :: translate - {$core p/beam} :: build program - {$diff p/silk q/silk} :: diff - {$dude p/(trap tank) q/silk} :: error wrap - {$file p/beam} :: from clay - {$flag p/(set $@(@uvH beam)) q/silk} :: add dependencies - {$join p/mark q/silk r/silk} :: merge - {$mash p/mark q/milk r/milk} :: annotate - {$mute p/silk q/(list (pair wing silk))} :: mutant - {$pact p/silk q/silk} :: patch - {$plan p/beam q/coin r/hood} :: structured assembly - {$reef $~} :: kernel reef - {$ride p/hoon q/silk} :: silk thru hoon - {$tabl p/(list (pair silk silk))} :: list - {$vale p/mark q/*} :: validate - {$volt p/(cask *)} :: unsafe add type - == :: - -- ::ford :: |ford: build system vane interface :: -++ ford-api ^? +++ ford ^? |% :: |able:ford: ford's public +move interface :: @@ -5833,7 +5748,6 @@ gift:able:eyre gift:able:ford gift:able:gall - gift:able:ford-api == ++ task-arvo :: in request ->$ $? task:able:ames @@ -5843,7 +5757,6 @@ task:able:eyre task:able:ford task:able:gall - task:able:ford-api == ++ note-arvo :: out request $-> $? {@tas $meta vase} @@ -5854,7 +5767,6 @@ {$e task:able:eyre} {$f task:able:ford} {$g task:able:gall} - {$t task:able:ford-api} == == ++ sign-arvo :: in result $<- $% {$a gift:able:ames} @@ -5865,7 +5777,6 @@ {$f gift:able:ford} {$g gift:able:gall} {$j gift:able:jael} - {$t gift:able:ford-api} == :: ++ unix-task :: input from unix