diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml deleted file mode 100644 index 87cb1a4bbb..0000000000 --- a/.stylish-haskell.yaml +++ /dev/null @@ -1,84 +0,0 @@ -steps: - # Convert some ASCII sequences to their Unicode equivalents. This is disabled - # by default. - # - unicode_syntax: - # # In order to make this work, we also need to insert the UnicodeSyntax - # # language pragma. If this flag is set to true, we insert it when it's - # # not already present. You may want to disable it if you configure - # # language extensions using some other method than pragmas. Default: - # # true. - # add_language_pragma: true - - - simple_align: - cases: true - top_level_patterns: true - records: true - - # Import cleanup - - imports: - align: group - list_align: after_alias - pad_module_names: true - long_list_align: inline - empty_list_align: inherit - list_padding: 4 - separate_lists: false - space_surround: false - - - language_pragmas: - style: vertical - align: true - remove_redundant: true - - - tabs: - spaces: 4 - - - trailing_whitespace: {} - - # squash: {} - -columns: 80 - -newline: lf - -language_extensions: - - ApplicativeDo - - BangPatterns - - BlockArguments - - DataKinds - - DefaultSignatures - - DeriveAnyClass - - DeriveDataTypeable - - DeriveFoldable - - DeriveGeneric - - DeriveTraversable - - DerivingStrategies - - EmptyDataDecls - - FlexibleContexts - - FlexibleInstances - - FunctionalDependencies - - GADTs - - GeneralizedNewtypeDeriving - - LambdaCase - - MagicHash - - MultiParamTypeClasses - - NamedFieldPuns - - NoImplicitPrelude - - NumericUnderscores - - OverloadedStrings - - PartialTypeSignatures - - PatternSynonyms - - QuasiQuotes - - Rank2Types - - RankNTypes - - RecordWildCards - - ScopedTypeVariables - - StandaloneDeriving - - TemplateHaskell - - TupleSections - - TypeApplications - - TypeFamilies - - TypeOperators - - UnboxedTuples - - UnicodeSyntax - - ViewPatterns diff --git a/pkg/arvo/sys/arvo.hoon b/pkg/arvo/sys/arvo.hoon index 128cee38c5..48fab24725 100644 --- a/pkg/arvo/sys/arvo.hoon +++ b/pkg/arvo/sys/arvo.hoon @@ -435,8 +435,8 @@ ++ sane |= kel=wynn ^- ? - ?: =(~ kel) & - =^ las=weft kel kel + ?: =(~ kel) & ::XX TMI + =^ las=weft kel ?> ?=(^ kel) kel |- ^- ? ?~ kel & ?& (gte num.las num.i.kel) @@ -1337,7 +1337,7 @@ loop(run t.run) =. dud ~ =. gem p.i.run - =^ mov=move q.i.run q.i.run + =^ mov=move q.i.run ?> ?=(^ q.i.run) q.i.run loop:(step mov) :: +step: advance the loop one step by routing a move :: @@ -1532,7 +1532,7 @@ ++ gest |= =ovum ^- $>(%pass ball) - =^ way=term wire.ovum wire.ovum + =^ way=term wire.ovum ?> ?=(^ wire.ovum) wire.ovum :: :: %$: default, routed to arvo-proper as trivial vase :: @: route to vane as $hobo diff --git a/pkg/arvo/sys/hoon.hoon b/pkg/arvo/sys/hoon.hoon index cec72ed060..74b3162116 100644 --- a/pkg/arvo/sys/hoon.hoon +++ b/pkg/arvo/sys/hoon.hoon @@ -6525,6 +6525,7 @@ [%ktwt p=hoon] :: ^? bivariant [%kttr p=spec] :: ^* example [%ktcl p=spec] :: ^: filter + [%ktcb p=hoon q=hoon] :: ^_ test :: :::::: hints [%sgbr p=hoon q=hoon] :: ~| sell on trace [%sgcb p=hoon q=hoon] :: ~_ tank on trace @@ -8659,12 +8660,14 @@ [%tskt *] :: =^ =+ wuy=(weld q.gen `wing`[%v ~]) :: :+ %tsgr [%ktts %v %$ 1] :: => v=. - :+ %tsls [%ktts %a %tsgr [%limb %v] r.gen] :: =+ a==>(v \r.gen) - :^ %tsdt wuy [%tsgl [%$ 3] [%limb %a]] - :+ %tsgr :- :+ %ktts [%over [%v ~] p.gen] - [%tsgl [%$ 2] [%limb %a]] - [%limb %v] - s.gen + :+ %tsls :+ %ktts %a :: =+ ^= a + :+ %tsgr [%limb %v] :: => v + [%ktcb [%kttr %base %cell] r.gen] :: ^_(*^ R.GEN) + :^ %tsdt wuy [%tsgl [%$ 3] [%limb %a]] :: =. Q.GEN.v +.a + :+ %tsgr :- :+ %ktts [%over [%v ~] p.gen] :: => [P.GEN=-.a v] + [%tsgl [%$ 2] [%limb %a]] :: + [%limb %v] :: + s.gen :: S.GEN :: [%tsgl *] [%tsgr q.gen p.gen] [%tsls *] [%tsgr [p.gen [%$ 1]] q.gen] @@ -9763,6 +9766,8 @@ |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) ?: ?&(!how ?=([%wtbr *] gen)) |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) + ?: ?=([%wtzp *] gen) + $(how !how, gen p.gen) =+ neg=~(open ap gen) ?:(=(neg gen) sut $(gen neg)) :: @@ -9999,6 +10004,9 @@ :: [%ktls *] =+(hif=(nice (play p.gen)) [hif q:$(gen q.gen, gol hif)]) + :: + [%ktcb *] + =+(hif=(nice (play p.gen)) $(gen q.gen, gol hif)) :: [%ktpm *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %zinc)) q.vat]) [%ktsg *] (blow gol p.gen) @@ -10178,6 +10186,10 @@ [%ktls *] =+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)] =+($(gen q.gen, gol p.hif) hif) + :: + [%ktcb *] + =+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)] + $(gen q.gen, gol p.hif) :: [%ktpm *] =+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) (wrap(sut q.vat) %zinc)]) @@ -10545,6 +10557,7 @@ [%dtwt *] bool [%hand *] p.gen [%ktbr *] (wrap(sut $(gen p.gen)) %iron) + [%ktcb *] $(gen q.gen) [%ktls *] $(gen p.gen) [%ktpm *] (wrap(sut $(gen p.gen)) %zinc) [%ktsg *] $(gen p.gen) @@ -13195,6 +13208,7 @@ ['?' (rune wut %ktwt expa)] ['*' (rune tar %kttr exqa)] [':' (rune col %ktcl exqa)] + ['#' (rune hax %ktcb expb)] == == :- '~' @@ -13901,12 +13915,37 @@ :: ++ h135 . ++ h136 + =, h135 + |% + :: hoon 136 omitted leading zeroes from @da's date rendering. these helpers + :: are provided to make rendering in the old style easier. + :: + ++ scot |=(mol=dime ~(rent co %$ mol)) + ++ scow |=(mol=dime ~(rend co %$ mol)) + ++ co + => [+>:co:h135 .] + |_ lot=coin + +* co135 ~(. co:h135 lot) + ++ rear rear:co135 + ++ rent ~+ `@ta`(rap 3 rend) + ++ rend + ^- tape + ?. ?=([%$ %da @] lot) rend:co135 + =+ yod=(yore q.p.lot) + =? rep ?=(^ f.t.yod) ['.' (s-co f.t.yod)] + =? rep !&(?=(~ f) =(0 h) =(0 m) =(0 s)):t.yod + =. rep ['.' (y-co s.t.yod)] + =. rep ['.' (y-co m.t.yod)] + ['.' '.' (y-co h.t.yod)] + =. rep ['.' (a-co d.t.yod)] + =. rep ['.' (a-co m.yod)] + =? rep !a.yod ['-' rep] + ['~' (a-co y.yod)] + -- :: hoon 136 had doccords, in $spec's %gist, $skin's and $note's %help, :: and in $tome. dropped types replaced with * below for brevity. :: migration helpers at the end of this core. :: - =, h135 - |% +$ abel typo :: original sin: type +$ alas (list (pair term hoon)) :: alias list +$ woof $@(@ [~ p=hoon]) :: simple embed diff --git a/pkg/arvo/sys/lull.hoon b/pkg/arvo/sys/lull.hoon index de8b7bef4c..b6f465a078 100644 --- a/pkg/arvo/sys/lull.hoon +++ b/pkg/arvo/sys/lull.hoon @@ -988,6 +988,32 @@ == :: :::: :: (1a2) + :: + ++ acru $_ ^? :: asym cryptosuite + |% :: opaque object + ++ as ^? :: asym ops + |% ++ seal |~([a=pass b=@] *@) :: encrypt to a + ++ sign |~(a=@ *@) :: certify as us + ++ sigh |~(a=@ *@) :: certification only + ++ sure |~(a=@ *(unit @)) :: authenticate from us + ++ safe |~([a=@ b=@] *?) :: authentication only + ++ tear |~([a=pass b=@] *(unit @)) :: accept from a + -- ::as :: + ++ de |~([a=@ b=@] *(unit @)) :: symmetric de, soft + ++ dy |~([a=@ b=@] *@) :: symmetric de, hard + ++ en |~([a=@ b=@] *@) :: symmetric en + ++ ex ^? :: export + |% ++ fig *@uvH :: fingerprint + ++ pac *@uvG :: default passcode + ++ pub *pass :: public key + ++ sec *ring :: private key + -- ::ex :: + ++ nu ^? :: reconstructors + |% ++ pit |~([a=@ b=@] ^?(..nu)) :: from [width seed] + ++ nol |~(a=ring ^?(..nu)) :: from ring + ++ com |~(a=pass ^?(..nu)) :: from pass + -- ::nu :: + -- ::acru ::::: :: (1a2) :: +protocol-version: current version of the ames wire protocol :: ++ protocol-version `?(%0 %1 %2 %3 %4 %5 %6 %7)`%0 @@ -1831,7 +1857,7 @@ =| s=(list) |- ^- * ?: =(i n) - =^ d s s + =^ d s ?> ?=(^ s) s |-(?~(s d $(d [i.s d], s t.s))) :: =/ d=* i @@ -1840,7 +1866,7 @@ |- ^- * ?: =(0 j) ^$(s [d s]) - =^ e s s + =^ e s ?> ?=(^ s) s $(d [e d], j (dec j)) :: ++ unroll @@ -2545,7 +2571,6 @@ tom=(map tako norm) :: tomb policies nor=norm :: default policy mim=(map path mime) :: mime cache - fod=flue :: ford cache wic=(map weft yoki) :: commit-in-waiting liv=zest :: running agents ren=rein :: force agents on/off @@ -2599,17 +2624,6 @@ +$ norm (axal ?) :: tombstone policy +$ open $-(path vase) :: get prelude +$ page ^page :: export for compat - +$ pour :: ford build w/content - $% [%file =path] - [%nave =mark] - [%dais =mark] - [%cast =mars] - [%tube =mars] - :: leafs - :: - [%vale =path =lobe] - [%arch =path =(map path lobe)] - == +$ rang :: repository $+ rang $: hut=(map tako yaki) :: changes @@ -2645,13 +2659,6 @@ +$ rule [mod=?(%black %white) who=(set whom)] :: node permission +$ rump [p=care q=case r=@tas s=path] :: relative path +$ saba [p=ship q=@tas r=moar s=dome] :: patch+merge - +$ soak :: ford result - $% [%cage =cage] - [%vase =vase] - [%arch dir=(map @ta vase)] - [%dais =dais] - [%tube =tube] - == +$ soba (list [p=path q=miso]) :: delta +$ suba (list [p=path q=misu]) :: delta +$ tako @uvI :: yaki ref @@ -2792,54 +2799,6 @@ (sham [%tako (roll p add) q t]) [p q has t] :: - :: $leak: ford cache key - :: - :: This includes all build inputs, including transitive dependencies, - :: recursively. - :: - +$ leak - $~ [*pour ~] - $: =pour - deps=(set leak) - == - :: - :: $flow: global ford cache - :: - :: Refcount includes references from other items in the cache, and - :: from spills in each desk - :: - :: This is optimized for minimizing the number of rebuilds, and given - :: that, minimizing the amount of memory used. It is relatively slow - :: to lookup, because generating a cache key can be fairly slow (for - :: files, it requires parsing; for tubes, it even requires building - :: the marks). - :: - +$ flow (map leak [refs=@ud =soak]) - :: - :: Per-desk ford cache - :: - :: Spill is the set of "roots" we have into the global ford cache. - :: We add a root for everything referenced directly or indirectly on - :: a desk, then invalidate them on commit only if their dependencies - :: change. - :: - :: Sprig is a fast-lookup index over the global ford cache. The only - :: goal is to make cache hits fast. - :: - +$ flue [spill=(set leak) sprig=(map mist [=leak =soak])] - :: - :: Ford build without content. - :: - +$ mist - $% [%file =path] - [%nave =mark] - [%dais =mark] - [%cast =mars] - [%tube =mars] - [%vale =path] - [%arch =path] - == - :: :: $pile: preprocessed hoon source file :: :: /- sur-file :: surface imports from /sur @@ -3960,6 +3919,274 @@ *(quip card _^|(..on-init)) -- -- + :: + ++ egg-aid + |% + ++ latest + |= e=egg-any + ^- egg + ?- -.e + %20 +.e + %16 $(e [%20 (egg-16-to-20 +.e)]) + %15 $(e [%16 (egg-15-to-16 +.e)]) + == + :: + ++ egg-16-to-20 + |= e=egg-16 + ^- egg + ?. ?=(%live -.e) e + e(+.old-state (next-vase:h136 +.old-state.e)) + :: + ++ egg-15-to-16 + |= e=egg-15 + ^- egg-16 + ?: ?=(%nuke -.e) [%nuke ~ ~] + %= e + ken [ken.e ~ ~] + :: + sky + =| =farm + =/ ski ~(tap by sky.e) + |- ^+ farm + ?~ ski + farm + =/ [=spur p=plot] i.ski + =; new + ?~ nex=(~(put-grow of-farm farm) spur new) + ~& %weird + !! :: shouldn't continue else loss of ref integrity + :: $(ski t.ski) + $(farm u.nex, ski t.ski) + :- ~ + =/ m ~(val by fan.p) + %+ gas:on-path *_fan.p + %+ turn + ^- (list @) + =/ wit ~(wyt by fan.p) + ?: =(0 wit) ~ + (gulf 1 wit) + |= a=@ud + [a (snag (dec a) m)] + == + -- + :: + ++ on-path ((on @ud (pair @da (each page @uvI))) lte) + ++ of-farm + |_ =farm + ++ key-coops + |= pos=path + ^- (list coop) + =/ frm (get-farm pos) + ?~ frm ~ + =. farm u.frm + |- + ?: ?=(%coop -.farm) + ~[pos] + %- zing + %+ turn ~(tap by q.farm) + |= [seg=@ta f=^farm] + ^- (list coop) + ^$(pos (snoc pos seg), farm f) + :: + ++ match-coop + =| wer=path + |= =path + ^- (unit coop) + ?: ?=(%coop -.farm) + `(flop wer) + ?~ path + ~ + ?~ nex=(~(get by q.farm) i.path) + ~ + $(wer [i.path wer], path t.path, farm u.nex) + :: + ++ put + |= [=path =plot] + ^- _farm + ?: ?=(%coop -.farm) + farm(q (~(put by q.farm) path plot)) + ?~ path + farm(p `plot) + =/ nex (~(get by q.farm) i.path) + =/ res $(path t.path, farm ?~(nex *^farm u.nex)) + farm(q (~(put by q.farm) i.path res)) + :: + ++ put-grow + |= [=path =plot] + ^- (unit _farm) + ?: ?=(%coop -.farm) + ~ + ?~ path + `farm(p `plot) + =/ nex (~(get by q.farm) i.path) + =/ res + $(path t.path, farm ?~(nex *^farm u.nex)) + ?~ res ~ + `farm(q (~(put by q.farm) i.path u.res)) + :: + ++ put-tend + |= [=path =plot] + ^- (unit _farm) + ?: ?=(%coop -.farm) + `farm(q (~(put by q.farm) path plot)) + ?~ path + `farm(p `plot) + ?~ nex=(~(get by q.farm) i.path) + ~ + =/ res + $(path t.path, farm u.nex) + ?~ res ~ + `farm(q (~(put by q.farm) i.path u.res)) + :: + ++ grow + |= [=spur now=@da =page] + =/ ski (gut spur) + %+ put spur + =- ski(fan (put:on-path fan.ski -< -> &/page)) + ?~ las=(ram:on-path fan.ski) + [?~(bob.ski 1 +(u.bob.ski)) now] + :_ (max now +(p.val.u.las)) + ?~(bob.ski +(key.u.las) +((max key.u.las u.bob.ski))) + :: + ++ germ + |= [=coop =hutch] + ^- (unit _farm) + ?~ coop + ?. |(=(%coop -.farm) =([%page ~ ~] farm)) + ~ + `[%coop hutch ~] + ?: ?=(%coop -.farm) + ~ + ?~ nex=(~(get by q.farm) i.coop) + ~ + $(coop t.coop, farm u.nex) + :: + ++ tend + |= [=coop =path =plot] + ^- (unit _farm) + ?~ coop + ?. ?=(%coop -.farm) + ~ + `farm(q (~(put by q.farm) path plot)) + ?. ?=(%plot -.farm) + ~ + ?~ nex=(~(get by q.farm) i.coop) + ~ + $(coop t.coop, farm u.nex) + :: + ++ del + |= =path + ^+ farm + ?: ?=(%coop -.farm) + farm(q (~(del by q.farm) path)) + ?~ path + farm(p ~) + ?~ nex=(~(get by q.farm) i.path) + farm + $(path t.path, farm u.nex) + :: + ++ gut + |= =path + ^- plot + (fall (get path) *plot) + :: + ++ put-hutch + |= [=path =hutch] + ^- (unit _farm) + ?~ path + ?: ?=(%coop -.farm) + `farm(p hutch) + ?. =([%plot ~ ~] farm) + ~ + `[%coop hutch ~] + ?: ?=(%coop -.farm) + ~ + =/ nex (~(gut by q.farm) i.path *^farm) + =/ res $(path t.path, farm nex) + ?~ res ~ + `farm(q (~(put by q.farm) i.path u.res)) + :: + ++ get-hutch + |= =path + ^- (unit hutch) + ?~ path + ?. ?=(%coop -.farm) + ~ + `p.farm + ?: ?=(%coop -.farm) + ~ + ?~ nex=(~(get by q.farm) i.path) + ~ + $(path t.path, farm u.nex) + :: + ++ get-farm + |= =path + ^- (unit ^farm) + ?: ?=(%coop -.farm) + ?~ (~(get by q.farm) path) + ~ + `farm + ?~ path ~ + ?~ nex=(~(get by q.farm) i.path) + ~ + $(path t.path, farm u.nex) + :: + ++ get + |= =path + ^- (unit plot) + ?: ?=(%coop -.farm) + (~(get by q.farm) path) + ?~ path + p.farm + ?~ nex=(~(get by q.farm) i.path) + ~ + $(path t.path, farm u.nex) + :: + ++ tap-plot + =| wer=path + |- ^- (list [path plot]) + =* tap-plot $ + ?: ?=(%coop -.farm) + %+ turn ~(tap by q.farm) + |= [=path =plot] + [(welp wer path) plot] + %+ welp ?~(p.farm ~ [wer u.p.farm]~) + %- zing + %+ turn ~(tap by q.farm) + |= [seg=@ta f=^farm] + ^- (list [path plot]) + tap-plot(wer (snoc wer seg), farm f) + :: + ++ run-plot + |* fun=gate + %- ~(gas by *(map path _(fun))) + %+ turn tap-plot + |= [=path =plot] + [path (fun plot)] + :: + ++ gas-hutch + |= =(list [=coop =hutch]) + ^- (unit _farm) + ?~ list + `farm + =/ nex + (put-hutch i.list) + ?~ nex ~ + $(farm u.nex, list t.list) + :: + ++ tap-hutch + =| wer=path + %- ~(gas in *(set [=coop =hutch])) + |- ^- (list [=coop =hutch]) + =* loop $ + ?: ?=(%coop -.farm) + [wer p.farm]~ + %- zing + %+ turn ~(tap by q.farm) + |= [seg=@ta f=^farm] + ^- (list [=coop =hutch]) + loop(wer (snoc wer seg), farm f) + -- -- ::gall :: %iris http-client interface :: diff --git a/pkg/arvo/sys/vane/ames.hoon b/pkg/arvo/sys/vane/ames.hoon index 66629c2357..5c884aed96 100644 --- a/pkg/arvo/sys/vane/ames.hoon +++ b/pkg/arvo/sys/vane/ames.hoon @@ -8138,7 +8138,7 @@ |- ^+ fine ?: |(=(~ nex.keen) =(inx max)) fine - =^ =want nex.keen nex.keen + =^ =want nex.keen ?> ?=(^ nex.keen) nex.keen =. last-sent.want now =. tries.want +(tries.want) =. wan.keen (put:fi-mop wan.keen [fra .]:want) @@ -12595,7 +12595,12 @@ `+<.u.peer ?~ muth [~ ~] ?. =(life.u.muth u.her-lyf) [~ ~] - ``azimuth-peer-state/!>(+.u.muth) + =/ ded + =/ msg (jam open-packet) + =/ sig (sign-raw:ed:crypto msg [sgn.pub sgn.sek]:saf.ames-state) + (jam sig msg) + :+ ~ ~ + [%message !>(proof/ded)] :: publisher-side, weight of a noun at .pat, as measured by .boq :: ++ peek-whey diff --git a/pkg/arvo/sys/vane/clay.hoon b/pkg/arvo/sys/vane/clay.hoon index 76ec14f3cb..97d846ff69 100644 --- a/pkg/arvo/sys/vane/clay.hoon +++ b/pkg/arvo/sys/vane/clay.hoon @@ -203,7 +203,6 @@ $: rom=room :: domestic hoy=(map ship rung) :: foreign ran=rang :: hashes - fad=flow :: ford cache mon=(map term beam) :: mount points hez=(unit duct) :: sync duct cez=(map @ta crew) :: permission groups @@ -447,14 +446,6 @@ :: [deletes changes] :: -++ pour-to-mist - |= =pour - ^- mist - ?+ -.pour pour - %vale [%vale path.pour] - %arch [%arch path.pour] - == -:: ++ fell-to-page |= =fell ^- (unit page) @@ -465,6 +456,15 @@ %1 peg.fell == :: +++ has-arm + |= [arm=@tas =mark core=vase] + ^- ? + =/ rib (mule |.((slub core [%wing ~[arm]]))) + ?: ?=(%| -.rib) %.n + =/ lab (mule |.((slob mark p.p.rib))) + ?: ?=(%| -.lab) %.n + p.lab +:: ++ rave-to-rove |= rav=rave ^- rove @@ -495,6 +495,10 @@ ~> %memo./clay/pile ((pile-rule pax) [1 1] (trip txt)) ?^ res pile.u.res + (report-error pax txt hair) +:: +++ report-error + |= [pax=path txt=@t =hair] %- mean =/ lyn p.hair =/ col q.hair @@ -509,8 +513,33 @@ leaf+(runt [(dec col) '-'] "^") == :: +++ parsing-rules + |% + ++ pant + |* fel=^rule + ;~(pose fel (easy ~)) + :: + ++ mast + |* [bus=^rule fel=^rule] + ;~(sfix (more bus fel) bus) + :: + ++ rune + |* [bus=^rule fel=^rule] + %- pant + %+ mast gap + ;~(pfix fas bus gap fel) + :: + ++ taut-rule + %+ cook |=(taut +<) + ;~ pose + (stag ~ ;~(pfix tar sym)) + ;~(plug (stag ~ sym) ;~(pfix tis sym)) + (cook |=(a=term [`a a]) sym) + == + -- +:: ++ pile-rule - => ..lull + => [..lull parsing-rules] =, clay |= pax=path %- full @@ -519,7 +548,6 @@ :: parse optional /? and ignore :: ;~(plug gay (punt ;~(plug fas wut gap dem gap))) - |^ ;~ plug %+ cook (bake zing (list (list taut))) %+ rune hep @@ -555,29 +583,6 @@ %+ stag %tssg (most gap tall:(vang & pax)) == - :: - ++ pant - |* fel=^rule - ;~(pose fel (easy ~)) - :: - ++ mast - |* [bus=^rule fel=^rule] - ;~(sfix (more bus fel) bus) - :: - ++ rune - |* [bus=^rule fel=^rule] - %- pant - %+ mast gap - ;~(pfix fas bus gap fel) - :: - ++ taut-rule - %+ cook |=(taut +<) - ;~ pose - (stag ~ ;~(pfix tar sym)) - ;~(plug (stag ~ sym) ;~(pfix tis sym)) - (cook |=(a=term [`a a]) sym) - == - -- -- => ~% %clay + ~ |% @@ -604,12 +609,6 @@ ++ fusion ~% %fusion ..fusion ~ |% - :: +wrap: external wrapper - :: - ++ wrap - |* [* state:ford] - [+<- +<+< +<+>-] :: [result cache.state flue] - :: ++ with-face |=([face=@tas =vase] vase(p [%face face p.vase])) ++ with-faces =| res=(unit vase) @@ -623,47 +622,364 @@ ++ ford !. => |% - +$ state - $: cache=flow - flue - cycle=(set mist) - drain=(map mist leak) - stack=(list (set leak)) - == +$ args + $+ args $: files=(map path (each page lobe)) file-store=(map lobe page) verb=@ - cache=flow - flue + == + :: + +$ bush + $% [%file =cage] + [%hoon text=@t deps=(list (pair (unit term) bush)) =path] + [%arch =spec files=(map @ta bush) =path] + [%mark grad=(unit (trel bush bush bush)) cor=vase =mark] + [%tube p=$@(?(%same %mime) [a=[=mark =bush] b=[=mark =bush]])] :: identity/mime -> hoon + == + :: + +$ bush-node + $% [%hoon =path] + [%file =mark =path] :: leaf + [%mark =mark] + [%tube =mars] + [%arch =spec =path] + == + -- + => |% + ++ bush-to-vase + =/ only-prelude=? | + =| sut=vase + |= =bush + ^- vase + =* b2v-buc $ + ?- -.bush + %file + q.cage.bush + :: + %hoon + =. sut zuse.bud + =; tus=vase + ?: only-prelude tus + ~> %memo./clay/ford + :: %- (trace 1 |.("make: hoon: {(spud path.bush)}")) + (slub tus hoon:(parse-pile path.bush text.bush)) + =. only-prelude | + ~> %memo./clay/ford + |- ^- vase + ?~ deps.bush sut + =/ dep=vase b2v-buc(bush q.i.deps.bush, only-prelude |) + =? p.dep ?=(^ p.i.deps.bush) [%face u.p.i.deps.bush p.dep] + $(deps.bush t.deps.bush, sut (slop dep sut)) + :: + %arch + ~> %memo./clay/ford + :: %- (trace 1 |.("make: arch: {(spud path.bush)}")) + =/ [type-val=type type-map=type] + => [sut=sut spec=spec.bush ..ut] + ~> %memo./clay/ford + :- (~(play ut p.sut) [%kttr spec]) + %- ~(play ut p.sut) + [%kttr %make [%wing ~[%map]] ~[[%base %atom %ta] spec]] + :: + =. sut *vase + ~> %memo./clay/ford + =/ res=(map @ta vase) + (~(run by files.bush) bush-to-vase) + :: + :- type-map + |- + ?~ res ~ + ?. (~(nest ut type-val) | p.q.n.res) + ~| [%nest-fail path.bush p.n.res] + !! + :- [p.n.res q.q.n.res] + [$(res l.res) $(res r.res)] + :: + %mark + =. sut *vase + ~> %memo./clay/ford + :: %- (trace 1 |.("make: mark: %{(trip mark.bush)}")) + =* cor cor.bush + ?~ grad.bush + %+ slub (slop (with-face cor+cor) zuse.bud) + !, *hoon + =/ typ _+<.cor + =/ dif _*diff:grad:cor + ^- (nave:clay typ dif) + |% + ++ diff |=([old=typ new=typ] (diff:~(grad cor old) new)) + ++ form form:grad:cor + ++ join + |= [a=dif b=dif] + ^- (unit (unit dif)) + ?: =(a b) + ~ + `(join:grad:cor a b) + ++ mash + |= [a=[=ship =desk =dif] b=[=ship =desk =dif]] + ^- (unit dif) + ?: =(dif.a dif.b) + ~ + `(mash:grad:cor a b) + ++ pact |=([v=typ d=dif] (pact:~(grad cor v) d)) + ++ vale noun:grab:cor + -- + =/ deg=vase (bush-to-vase p.u.grad.bush) + =/ tub=vase (bush-to-vase q.u.grad.bush) + =/ but=vase (bush-to-vase r.u.grad.bush) + %+ slub + (with-faces deg+deg tub+tub but+but cor+cor nave+nave.bud ~) + !, *hoon + =/ typ _+<.cor + =/ dif _*diff:deg + ^- (nave typ dif) + |% + ++ diff + |= [old=typ new=typ] + ^- dif + (diff:deg (tub old) (tub new)) + ++ form form:deg + ++ join join:deg + ++ mash mash:deg + ++ pact + |= [v=typ d=dif] + ^- typ + (but (pact:deg (tub v) d)) + ++ vale noun:grab:cor + -- + :: + %tube + =. sut *vase + ~> %memo./clay/ford + ?@ p.bush + ?- p.bush + %same + :: %- (trace 4 |.("make: tube: identity shortcircuit")) + same.bud + :: + %mime + :: %- (trace 4 |.("make: tube: hoon -> mime")) + =>(..zuse !>(|=(m=mime q.q.m))) + == + =/ a a.p.bush + =/ b b.p.bush + :: %- (trace 1 |.("make: tube: %{(trip mark.a)} -> %{(trip mark.b)}")) + =/ old (bush-to-vase bush.a) + ?: (has-arm %grow mark.b old) + :: %- (trace 4 |.("+grow:{(trip mark.a)}")) + %+ slub (with-faces cor+old ~) + ^- hoon + :+ %brcl !,(*hoon v=+<.cor) + :+ %sggr + [%spin %cltr [%sand %t (crip "grow-{}->{}")] ~] + :+ %tsgl limb/mark.b + !,(*hoon ~(grow cor v)) + =/ new (bush-to-vase bush.b) + =/ arm=? (has-arm %grab mark.a new) + =/ rab + %- mule |. + %+ slap new + ^- hoon + :+ %sggr + [%spin %cltr [%sand %t (crip "grab-{}->{}")] ~] + tsgl/[limb/mark.a limb/%grab] + :: + ?: &(arm ?=(%& -.rab) ?=(^ q.p.rab)) + :: %- (trace 4 |.("+grab:{(trip mark.b)}")) + p.rab + ?: ?=(%noun mark.b) + :: %- (trace 4 |.("default")) + same.bud + ~|(no-cast-between+[mark.a mark.b] !!) :: XX +jump arm, +grab with @tas product + :: == -- ~% %ford-gate ..ford ~ |= args - :: nub: internal mutable state for this computation - :: - =| nub=state - =. cache.nub cache - =. spill.nub spill - =. sprig.nub sprig ~% %ford-core ..$ ~ |% + :: Chapter for constructing $bush (dependency graph of a file) given its + :: desk-wide identifier + :: + +| %bush-construction + :: + ++ parse-header + |= [pax=path txt=@t] + ^- (list (pair (unit term) bush-node)) + ~> %memo./clay/ford + =* out (list (pair (unit term) bush-node)) + =/ [=hair res=(unit [=out =nail])] + (header-rule [1 1] (trip txt)) + ?^ res out.u.res + (report-error pax txt hair) + :: + ++ header-rule + |^ + =, parsing-rules + %+ cook pile-header-to-bush + %+ ifix + :_ gay + :: parse optional /? and ignore + :: + ;~(plug gay (punt ;~(plug fas wut gap dem gap))) + ;~ plug + %+ cook (bake zing (list (list taut))) + %+ rune hep + (most ;~(plug com gaw) taut-rule) + :: + %+ cook (bake zing (list (list taut))) + %+ rune lus + (most ;~(plug com gaw) taut-rule) + :: + %+ rune tis + ;~(plug sym ;~(pfix gap stap)) + :: + %+ rune sig + ;~((glue gap) sym wyde:vast stap) + :: + %+ rune cen + ;~(plug sym ;~(pfix gap ;~(pfix cen sym))) + :: + %+ rune buc + ;~ (glue gap) + sym + ;~(pfix cen sym) + ;~(pfix cen sym) + == + :: + %+ rune tar + ;~ (glue gap) + sym + ;~(pfix cen sym) + ;~(pfix stap) + == + == + :: + ++ pile-header-to-bush + |= $: sur=(list taut) + lib=(list taut) + raw=(list [face=term =path]) + raz=(list [face=term =spec =path]) + maz=(list [face=term =mark]) + caz=(list [face=term =mars]) + bar=(list [face=term =mark =path]) + == + ^- (list (pair (unit term) bush-node)) + %- zing + ^- (list (list (pair (unit term) bush-node))) + :~ + (turn sur (taut-to-bush-node %sur)) + (turn lib (taut-to-bush-node %lib)) + (turn raw |=([face=term =path] [`face hoon+(snoc path %hoon)])) + (turn raz |=([face=term =spec =path] [`face arch+[spec path]])) + (turn maz |=([face=term =mark] [`face mark+mark])) + (turn caz |=([face=term =mars] [`face tube+mars])) + (turn bar |=([face=term =mark =path] [`face file+[mark path]])) + == + :: + ++ taut-to-bush-node + |= prefix=term + |= =taut + ^- (pair (unit term) bush-node) + :- face.taut + [%hoon (fit-path prefix pax.taut)] + -- + :: + ++ build-bush + |= nod=bush-node + ^- bush + :: the cycle set below catches dependency cycles in the bush, + :: but it can't catch cycles which are reentrant through read-file + :: or cast-path. for those cases, we use loop detection + :: as implemented in the runtime. + :: example: + :: 1. copy a mark (e.g. noun.hoon) as foo.hoon + :: 2. commit a %foo page directly to clay: *%/foo/foo &foo 42 + :: 3. add a /* import to the mark definition: /* foo %foo /foo/foo + :: 4. try scrying for that file: .^(* %cx %/foo/foo) + :: + ~> %loop.'clay: loop detected' + ~> %memo./clay/ford + %- %+ trace 1 |. + ?- -.nod + %hoon "bush: hoon: {(spud path.nod)}" + %file "bush: file: mar=%{(trip mark.nod)} {(spud path.nod)}" + %mark "bush: mark: %{(trip mark.nod)}" + %tube "bush: tube: %{(trip a.mars.nod)} -> %{(trip b.mars.nod)}" + %arch "bush: arch: {(spud path.nod)}" + == + =| cycle=(set bush-node) + |- ^- bush + =* bush-loop $ + ?: (~(has in cycle) nod) ~| [cycle+nod cycle] !! + =. cycle (~(put in cycle) nod) + ?- -.nod + %file + =/ file=cage (cast-path path.nod mark.nod) + [%file file] + :: + %hoon + =/ file=cage (read-file path.nod) + ?> =(%hoon p.file) + =+ !<(src=@t q.file) + =/ deps=(list (pair (unit term) bush-node)) + (parse-header path.nod src) + :: + :^ %hoon src + %+ turn deps + |= [u=(unit term) don=bush-node] + [u bush-loop(nod don)] + path.nod + :: + %mark + =/ cor=vase (build-fit %mar mark.nod) + =/ gad=vase (slap cor limb/%grad) + ?^ q.gad [%mark ~ cor mark.nod] + =/ deg bush-loop(nod mark+q.gad) + =/ tub bush-loop(nod tube+[mark.nod q.gad]) + =/ but bush-loop(nod tube+[q.gad mark.nod]) + [%mark `[deg tub but] cor mark.nod] + :: + %tube + ?: =(a.mars.nod b.mars.nod) tube+%same + ?: =([%mime %hoon] [a.mars.nod b.mars.nod]) tube+%mime + :+ %tube + [a.mars.nod bush-loop(nod hoon+(fit-path %mar a.mars.nod))] + [b.mars.nod bush-loop(nod hoon+(fit-path %mar b.mars.nod))] + :: + %arch + =/ fiz=(list @ta) + =/ len (lent path.nod) + %+ murn ~(tap by files) + |= [pax=path *] + ^- (unit @ta) + ?. =(path.nod (scag len pax)) + ~ + =/ pat (slag len pax) + ?: ?=([@ %hoon ~] pat) + `i.pat + ~ + :: + =| rez=(map @ta bush) + |- + ?~ fiz + [%arch spec.nod rez path.nod] + =* nom=@ta i.fiz + =/ pax=path (weld path.nod nom %hoon ~) + =/ res=bush bush-loop(nod hoon+pax) + $(fiz t.fiz, rez (~(put by rez) nom res)) + == + :: + +| %external-interface + :: :: +read-file: retrieve marked, validated file contents at path :: ++ read-file ~/ %read-file |= =path - ^- [cage state] + ^- cage + ~> %memo./clay/ford ~| %error-validating^path - %- soak-cage - %+ gain-sprig vale+path |. - =. stack.nub [~ stack.nub] - ?: (~(has in cycle.nub) vale+path) - ~|(cycle+vale+path^cycle.nub !!) - =. cycle.nub (~(put in cycle.nub) vale+path) - %+ gain-leak vale+path - |= nob=state - =. nub nob %- (trace 1 |.("read file {(spud path)}")) =/ file ~| %file-not-found^path @@ -673,104 +989,30 @@ p.file ~| %tombstoned-file^path^p.file (~(got by file-store) p.file) - =^ =cage nub (validate-page path page) - [[%cage cage] nub] + (validate-page path page) :: :: +build-nave: build a statically typed mark core :: ++ build-nave ~/ %build-nave |= mak=mark - ^- [vase state] + ^- vase + ~> %memo./clay/ford ~| %error-building-mark^mak - %- soak-vase - %+ gain-sprig nave+mak |. - =. stack.nub [~ stack.nub] - ?: (~(has in cycle.nub) nave+mak) - ~|(cycle+nave+mak^cycle.nub !!) - =. cycle.nub (~(put in cycle.nub) nave+mak) - %- (trace 1 |.("make mark {}")) - =^ cor=vase nub (build-fit %mar mak) - =/ gad=vase (slub cor limb/%grad) - ?@ q.gad - =+ !<(mok=mark gad) - =^ deg=vase nub ^$(mak mok) - =^ tub=vase nub (build-cast mak mok) - =^ but=vase nub (build-cast mok mak) - %+ gain-leak nave+mak - |= nob=state - =. nub nob - :_ nub :- %vase - ^- vase :: vase of nave - %+ slub - (with-faces deg+deg tub+tub but+but cor+cor nave+nave.bud ~) - !, *hoon - =/ typ _+<.cor - =/ dif _*diff:deg - ^- (nave typ dif) - |% - ++ diff - |= [old=typ new=typ] - ^- dif - (diff:deg (tub old) (tub new)) - ++ form form:deg - ++ join join:deg - ++ mash mash:deg - ++ pact - |= [v=typ d=dif] - ^- typ - (but (pact:deg (tub v) d)) - ++ vale noun:grab:cor - -- - %+ gain-leak nave+mak - |= nob=state - =. nub nob - :_ nub :- %vase - ^- vase :: vase of nave - %+ slub (slop (with-face cor+cor) zuse.bud) - !, *hoon - =/ typ _+<.cor - =/ dif _*diff:grad:cor - ^- (nave:clay typ dif) - |% - ++ diff |=([old=typ new=typ] (diff:~(grad cor old) new)) - ++ form form:grad:cor - ++ join - |= [a=dif b=dif] - ^- (unit (unit dif)) - ?: =(a b) - ~ - `(join:grad:cor a b) - ++ mash - |= [a=[=ship =desk =dif] b=[=ship =desk =dif]] - ^- (unit dif) - ?: =(dif.a dif.b) - ~ - `(mash:grad:cor a b) - ++ pact |=([v=typ d=dif] (pact:~(grad cor v) d)) - ++ vale noun:grab:cor - -- + (bush-to-vase (build-bush %mark mak)) :: +build-dais: build a dynamically typed mark definition :: ++ build-dais ~/ %build-dais |= mak=mark - ^- [dais state] + ^- dais + ~> %memo./clay/ford ~| %error-building-dais^mak - %- soak-dais - %+ gain-sprig dais+mak |. - =. stack.nub [~ stack.nub] - ?: (~(has in cycle.nub) dais+mak) - ~|(cycle+dais+mak^cycle.nub !!) - =. cycle.nub (~(put in cycle.nub) dais+mak) - =^ nav=vase nub (build-nave mak) - %+ gain-leak dais+mak - |= nob=state - =. nub nob + =/ nav=vase (build-nave mak) %- (trace 1 |.("make dais {}")) - :_ nub :- %dais ^- dais => [nav=nav ..zuse] + ~> %memo./clay/ford |_ sam=vase ++ diff |= new=vase @@ -806,320 +1048,80 @@ ++ build-cast ~/ %build-cast |= [a=mark b=mark] - ^- [vase state] + ^- vase + ~> %memo./clay/ford ~| error-building-cast+[a b] - %- soak-vase - %+ gain-sprig cast+a^b |. - =. stack.nub [~ stack.nub] - ?: (~(has in cycle.nub) cast+[a b]) - ~|(cycle+cast+[a b]^cycle.nub !!) - ?: =(a b) - %+ gain-leak cast+a^b - |= nob=state - %- (trace 4 |.("identity shortcircuit")) - =. nub nob - :_(nub vase+same.bud) - ?: =([%mime %hoon] [a b]) - %- (trace 4 |.("%mime -> %hoon shortcircuit")) - :_(nub [%vase =>(..zuse !>(|=(m=mime q.q.m)))]) - :: try +grow; is there a +grow core with a .b arm? - :: - %- (trace 1 |.("make cast {} -> {}")) - =^ old=vase nub (build-fit %mar a) - ?: (has-arm %grow b old) - :: +grow core has .b arm; use that - :: - %+ gain-leak cast+a^b - |= nob=state - %- (trace 4 |.("{} -> {}: +{(trip b)}:grow:{(trip a)}")) - =. nub nob - :_ nub :- %vase - %+ slub (with-faces cor+old ~) - ^- hoon - :+ %brcl !,(*hoon v=+<.cor) - :+ %sggr - [%spin %cltr [%sand %t (crip "grow-{}->{}")] ~] - :+ %tsgl limb/b - !,(*hoon ~(grow cor v)) - :: try direct +grab - :: - =^ new=vase nub (build-fit %mar b) - =/ arm=? (has-arm %grab a new) - =/ rab - %- mule |. - %+ slap new - ^- hoon - :+ %sggr - [%spin %cltr [%sand %t (crip "grab-{}->{}")] ~] - tsgl/[limb/a limb/%grab] - ?: &(arm ?=(%& -.rab) ?=(^ q.p.rab)) - %+ gain-leak cast+a^b - |= nob=state - %- (trace 4 |.("{} -> {}: +{(trip a)}:grab:{(trip b)}")) - =. nub nob - :_(nub vase+p.rab) - :: try +jump - :: - =/ jum (mule |.((slub old tsgl/[limb/b limb/%jump]))) - ?: &((has-arm %jump a old) ?=(%& -.jum)) - =/ via !<(mark p.jum) - %- (trace 4 |.("{} -> {}: via {} per +jump:{(trip a)}")) - (compose-casts a via b) - ?: &(arm ?=(%& -.rab)) - =/ via !<(mark p.rab) - %- (trace 4 |.("{} -> {}: via {} per +grab:{(trip b)}")) - (compose-casts a via b) - ?: ?=(%noun b) - %+ gain-leak cast+a^b - |= nob=state - %- (trace 4 |.("{} -> {} default")) - =. nub nob - :_(nub vase+same.bud) - ~|(no-cast-from+[a b] !!) - :: - ++ compose-casts - |= [x=mark y=mark z=mark] - ^- [soak state] - =^ uno=vase nub (build-cast x y) - =^ dos=vase nub (build-cast y z) - %+ gain-leak cast+x^z - |= nob=state - =. nub nob - :_ nub :- %vase - %+ slub - (with-faces uno+uno dos+dos ~) - !,(*hoon |=(_+<.uno (dos (uno +<)))) - :: - ++ has-arm - |= [arm=@tas =mark core=vase] - ^- ? - =/ rib (mule |.((slub core [%wing ~[arm]]))) - ?: ?=(%| -.rib) %.n - =/ lab (mule |.((slob mark p.p.rib))) - ?: ?=(%| -.lab) %.n - p.lab + (bush-to-vase (build-bush %tube a b)) :: +build-tube: produce a $tube mark conversion gate from .a to .b :: ++ build-tube |= [a=mark b=mark] - ^- [tube state] + ^- tube ~> %spin.[%build-tube] ~> %spin.[a] ~> %spin.[b] + ~> %memo./clay/ford ~| error-building-tube+[a b] - %- soak-tube - %+ gain-sprig tube+a^b |. - =. stack.nub [~ stack.nub] - ?: (~(has in cycle.nub) tube+[a b]) - ~|(cycle+tube+[a b]^cycle.nub !!) - =^ gat=vase nub (build-cast a b) - %+ gain-leak tube+a^b - |= nob=state - =. nub nob + =/ gat=vase (build-cast a b) %- (trace 1 |.("make tube {} -> {}")) - :_(nub [%tube =>([gat=gat ..zuse] |=(v=vase (slam gat v)))]) + => [gat=gat ..zuse] + ~> %memo./clay/ford + |=(v=vase (slam gat v)) :: ++ validate-page |= [=path =page] - ^- [cage state] + ^- cage ~| validate-page-fail+path^from+p.page =/ mak=mark (head (flop path)) ?: =(mak p.page) (page-to-cage page) - =^ [mark vax=vase] nub (page-to-cage page) - =^ =tube nub (build-tube p.page mak) - :_(nub [mak (tube vax)]) + =/ [mark vax=vase] (page-to-cage page) + =/ =tube (build-tube p.page mak) + [mak (tube vax)] :: ++ page-to-cage |= =page - ^- [cage state] + ^- cage ?: =(%hoon p.page) - :_(nub [%hoon [%atom %t ~] q.page]) + [%hoon [%atom %t ~] ;;(@ q.page)] ?: =(%mime p.page) - :_(nub [%mime =>([;;(mime q.page) ..zuse] !>(-))]) - =^ =dais nub (build-dais p.page) - :_(nub [p.page (vale:dais q.page)]) + [%mime =>([;;(mime q.page) ..zuse] !>(-))] + =/ =dais (build-dais p.page) + :- p.page + => [dais=dais dat=q.page] + ~> %memo./clay/ford + (vale:dais dat) :: ++ cast-path |= [=path mak=mark] - ^- [cage state] + ^- cage + ~> %memo./clay/ford =/ mok (head (flop path)) ~| error-casting-path+[path mok mak] - =^ cag=cage nub (read-file path) + =/ cag=cage (read-file path) ?: =(mok mak) - [cag nub] - =^ =tube nub (build-tube mok mak) + cag + =/ =tube (build-tube mok mak) ~| error-running-cast+[path mok mak] - :_(nub [mak (tube q.cag)]) - :: - ++ run-pact - |= [old=page diff=page] - ^- [cage state] - ?: ?=(%hoon p.old) - =/ txt=wain (to-wain:format ;;(@t q.old)) - =+ ;;(dif=(urge cord) q.diff) - =/ new=@t (of-wain:format (lurk:differ txt dif)) - :_(nub [%hoon =>([new ..zuse] !>(-))]) - =^ dys=dais nub (build-dais p.old) - =^ syd=dais nub (build-dais p.diff) - :_(nub [p.old (~(pact dys (vale:dys q.old)) (vale:syd q.diff))]) + [mak (tube q.cag)] :: ++ prelude |= =path ^- vase - =^ cag=cage nub (read-file path) - ?> =(%hoon p.cag) - =+ !<(txt=@t q.cag) - =/ =pile (parse-pile path txt) - =. hoon.pile !,(*hoon .) - =^ res=vase nub (run-prelude pile) - res - :: - ++ build-dependency - ~/ %build-dep - |= dep=(each [dir=path fil=path] path) - ^- [vase state] - =/ =path - ?:(?=(%| -.dep) p.dep fil.p.dep) - ~| %error-building^path - %- soak-vase - %+ gain-sprig file+path |. - =. stack.nub [~ stack.nub] - %- (trace 1 |.("make file {(spud path)}")) - ?: (~(has in cycle.nub) file+path) - ~|(cycle+file+path^cycle.nub !!) - =. cycle.nub (~(put in cycle.nub) file+path) - =^ cag=cage nub (read-file path) - ?> =(%hoon p.cag) - =+ !<(txt=@t q.cag) - =/ =pile (parse-pile path txt) - =^ sut=vase nub (run-prelude pile) - %+ gain-leak file+path - |= nob=state - =. nub nob - =/ res=vase (slub sut hoon.pile) - [[%vase res] nub] + %*($ bush-to-vase +< (build-bush %hoon path), only-prelude &) :: ++ build-file |= =path - (build-dependency |+path) - :: +build-directory: builds files in top level of a directory - :: - :: this excludes files directly at /path/hoon, - :: instead only including files in the unix-style directory at /path, - :: such as /path/file/hoon, but not /path/more/file/hoon. - :: - ++ build-directory - |= =path - ^- [(map @ta vase) state] - %- soak-arch - %+ gain-sprig arch+path |. - =. stack.nub [~ stack.nub] - %+ gain-leak arch+path - |= nob=state - =. nub nob - =/ fiz=(list @ta) - =/ len (lent path) - %+ murn ~(tap by files) - |= [pax=^path *] - ^- (unit @ta) - ?. =(path (scag len pax)) - ~ - =/ pat (slag len pax) - ?: ?=([@ %hoon ~] pat) - `i.pat - ~ - :: - =| rez=(map @ta vase) - |- - ?~ fiz - [[%arch rez] nub] - =* nom=@ta i.fiz - =/ pax=^path (weld path nom %hoon ~) - =^ res nub (build-dependency &+[path pax]) - $(fiz t.fiz, rez (~(put by rez) nom res)) - :: - ++ run-prelude - |= =pile - =/ sut=vase zuse.bud - =^ sut=vase nub (run-tauts sut %sur sur.pile) - =^ sut=vase nub (run-tauts sut %lib lib.pile) - =^ sut=vase nub (run-raw sut raw.pile) - =^ sut=vase nub (run-raz sut raz.pile) - =^ sut=vase nub (run-maz sut maz.pile) - =^ sut=vase nub (run-caz sut caz.pile) - =^ sut=vase nub (run-bar sut bar.pile) - [sut nub] - :: - ++ run-tauts - |= [sut=vase wer=?(%lib %sur) taz=(list taut)] - ^- [vase state] - ?~ taz [sut nub] - =^ pin=vase nub (build-fit wer pax.i.taz) - =? p.pin ?=(^ face.i.taz) [%face u.face.i.taz p.pin] - $(sut (slop pin sut), taz t.taz) - :: - ++ run-raw - |= [sut=vase raw=(list [face=term =path])] - ^- [vase state] - ?~ raw [sut nub] - =^ pin=vase nub (build-file (snoc path.i.raw %hoon)) - =. p.pin [%face face.i.raw p.pin] - $(sut (slop pin sut), raw t.raw) - :: - ++ run-raz - |= [sut=vase raz=(list [face=term =spec =path])] - ^- [vase state] - ?~ raz [sut nub] - =^ res=(map @ta vase) nub - (build-directory path.i.raz) - =; pin=vase - =. p.pin [%face face.i.raz p.pin] - $(sut (slop pin sut), raz t.raz) - :: - =/ =type (~(play ut p.sut) [%kttr spec.i.raz]) - :: ensure results nest in the specified type, - :: and produce a homogenous map containing that type. - :: - :- %- ~(play ut p.sut) - [%kttr %make [%wing ~[%map]] ~[[%base %atom %ta] spec.i.raz]] - |- - ?~ res ~ - ?. (~(nest ut type) | p.q.n.res) - ~| [%nest-fail path.i.raz p.n.res] - !! - :- [p.n.res q.q.n.res] - [$(res l.res) $(res r.res)] - :: - ++ run-maz - |= [sut=vase maz=(list [face=term =mark])] - ^- [vase state] - ?~ maz [sut nub] - =^ pin=vase nub (build-nave mark.i.maz) - =. p.pin [%face face.i.maz p.pin] - $(sut (slop pin sut), maz t.maz) - :: - ++ run-caz - |= [sut=vase caz=(list [face=term =mars])] - ^- [vase state] - ?~ caz [sut nub] - =^ pin=vase nub (build-cast mars.i.caz) - =. p.pin [%face face.i.caz p.pin] - $(sut (slop pin sut), caz t.caz) - :: - ++ run-bar - |= [sut=vase bar=(list [face=term =mark =path])] - ^- [vase state] - ?~ bar [sut nub] - =^ =cage nub (cast-path [path mark]:i.bar) - =. p.q.cage [%face face.i.bar p.q.cage] - $(sut (slop q.cage sut), bar t.bar) - :: + ^- vase + ~> %memo./clay/ford + (bush-to-vase (build-bush %hoon path)) :: +build-fit: build file at path, maybe converting '-'s to '/'s in path :: ++ build-fit |= [pre=@tas pax=@tas] - ^- [vase state] + ^- vase (build-file (fit-path pre pax)) :: + +| %helpers + :: :: +fit-path: find path, maybe converting '-'s to '/'s :: :: Try '-' before '/', applied left-to-right through the path, @@ -1137,144 +1139,11 @@ pux $(paz t.paz) :: - ++ all-fits - |= [=term suf=term] - ^- (list path) - %+ turn (segments suf) - |= seg=path - [term (snoc seg %hoon)] - :: - :: Gets a map of the data at the given path and all children of it. - :: - :: i.e. +dip:of for a map, except doesn't shorten paths - :: - ++ dip-hat - |= pax=path - ^- (map path (each page lobe)) - %- malt - %+ skim ~(tap by files) - |= [p=path *] - ?| ?=(~ pax) - ?& !?=(~ p) - =(-.pax -.p) - $(p +.p, pax +.pax) - == == - :: ++ trace |= [pri=@ print=(trap tape)] (^trace verb pri print) - :: - ++ mist-to-pour - |= =mist - ^- pour - ?+ -.mist mist - %vale - :+ %vale path.mist - ~| %file-not-found-mist^path.mist - =/ lob (~(got by files) path.mist) - ?- -.lob - %& (page-to-lobe p.lob) - %| p.lob - == - :: - %arch - =/ dip (dip-hat path.mist) - :+ %arch path.mist - %- ~(run by dip) - |= file=(each page lobe) - ?- -.file - %& (page-to-lobe p.file) - %| p.file - == - == - :: - ++ soak-cage |=([s=soak n=state] ?>(?=(%cage -.s) [cage.s n])) - ++ soak-vase |=([s=soak n=state] ?>(?=(%vase -.s) [vase.s n])) - ++ soak-dais |=([s=soak n=state] ?>(?=(%dais -.s) [dais.s n])) - ++ soak-tube |=([s=soak n=state] ?>(?=(%tube -.s) [tube.s n])) - ++ soak-arch |=([s=soak n=state] ?>(?=(%arch -.s) [dir.s n])) - :: - ++ gain-sprig - |= [=mist next=(trap [soak state])] - ^- [soak state] - ?~ got=(~(get by sprig.nub) mist) - $:next - =? stack.nub ?=(^ stack.nub) - stack.nub(i (~(put in i.stack.nub) leak.u.got)) - [soak.u.got nub] - :: - ++ gain-leak - |= [=mist next=$-(state [soak state])] - ^- [soak state] - =^ top=(set leak) stack.nub stack.nub - =/ =leak [(mist-to-pour mist) top] - =. cycle.nub (~(del in cycle.nub) mist) - =? stack.nub ?=(^ stack.nub) - stack.nub(i (~(put in i.stack.nub) leak)) - =/ spilt (~(has in spill.nub) leak) - =^ =soak nub - ?^ got=(~(get by cache.nub) leak) - %- %+ trace 3 |. - =/ refs ?:(spilt 0 1) - %+ welp "cache {}: adding {}, " - "giving {<(add refs refs.u.got)>}" - =? cache.nub !spilt - (~(put by cache.nub) leak [+(refs.u.got) soak.u.got]) - [soak.u.got nub] - %- (trace 2 |.("cache {}: creating")) - =^ =soak nub (next nub) - =. cache.nub (~(put by cache.nub) leak [1 soak]) - :: If we're creating a cache entry, add refs to our dependencies - :: - =/ deps ~(tap in deps.leak) - |- - ?~ deps - [soak nub] - =/ got (~(got by cache.nub) i.deps) - %- %+ trace 3 |. - %+ welp "cache {} for {}" - ": bumping to ref {}" - =. cache.nub (~(put by cache.nub) i.deps got(refs +(refs.got))) - $(deps t.deps) - ?: spilt - [soak nub] - %- (trace 3 |.("spilt {}")) - =: spill.nub (~(put in spill.nub) leak) - sprig.nub (~(put by sprig.nub) mist leak soak) - == - [soak nub] -- :: - ++ lose-leak - |= [verb=@ fad=flow =leak] - ^- flow - ?~ got=(~(get by fad) leak) - %- (trace verb 0 |.("lose missing leak {}")) - fad - ?: (lth 1 refs.u.got) - %- (trace verb 3 |.("cache {}: decrementing from {}")) - =. fad (~(put by fad) leak u.got(refs (dec refs.u.got))) - fad - =+ ?. =(0 refs.u.got) ~ - ((trace verb 0 |.("lose zero leak {}")) ~) - %- (trace verb 2 |.("cache {}: freeing")) - =. fad (~(del by fad) leak) - =/ leaks ~(tap in deps.leak) - |- ^- flow - ?~ leaks - fad - =. fad ^$(leak i.leaks) - $(leaks t.leaks) - :: - ++ lose-leaks - |= [verb=@ fad=flow leaks=(set leak)] - ^- flow - =/ leaks ~(tap in leaks) - |- - ?~ leaks - fad - $(fad (lose-leak verb fad i.leaks), leaks t.leaks) - :: ++ trace |= [verb=@ pri=@ print=(trap tape)] ?: (lth verb pri) @@ -1391,12 +1260,11 @@ :: ++ aver |= [for=(unit ship) mun=mood] - ^- [(unit (unit cage)) _..park] + ^- (unit (unit cage)) =+ ezy=?~(ref ~ (~(get by haw.u.ref) mun)) ?^ ezy - [`u.ezy ..park] + `u.ezy ?: ?=([%s [%ud *] %late *] mun) - :_ ..park ^- (unit (unit cage)) :+ ~ ~ ^- cage @@ -1407,8 +1275,8 @@ =+ tak=(case-to-tako case.mun) ?: ?=([%s case %case ~] mun) :: case existence check - [``[%flag !>(!=(~ tak))] ..park] - ?~(tak [~ ..park] (read-at-tako:ze for u.tak mun)) + ``[%flag !>(!=(~ tak))] + ?~(tak ~ (read-at-tako:ze for u.tak mun)) :: :: Queue a move. :: @@ -1545,25 +1413,11 @@ :: :: Create a ford appropriate for the aeon :: - :: Don't forget to call +tako-flow! - :: ++ tako-ford |= tak=tako %- ford:fusion - :- (~(run by q:(tako-to-yaki:ze tak)) |=(=lobe |+lobe)) - [lat.ran veb.bug fad ?:(=(tak (aeon-to-tako:ze let.dom)) fod.dom [~ ~])] - :: Produce ford cache appropriate for the aeon - :: - ++ tako-flow - |* [tak=tako res=* fud=flow fod=flue] - :- res - ^+ ..park - ?: &(?=(~ ref) =((aeon-to-tako:ze let.dom) tak)) - ..park(fad fud, fod.dom fod) - :: if in the past, don't update ford cache, since any results have - :: no roots - :: - ..park + :_ [lat.ran veb.bug] + (~(run by q:(tako-to-yaki:ze tak)) |=(=lobe |+lobe)) :: ++ request-wire |= [kind=@ta =ship =desk index=@ud] @@ -1929,7 +1783,6 @@ (get-changes q.old-yaki new-data) ~| [from=let.dom deletes=deletes changes=~(key by changes)] :: - :: promote ford cache :: promote and fill in mime cache :: =/ invalid (~(uni in deletes) ~(key by changes)) @@ -1969,14 +1822,7 @@ =? updated updated (did-kernel-update invalid) => ?. updated . ~>(%slog.0^leaf/"clay: rebuilding {} after kernel update" .) - :: clear caches if zuse reloaded - :: - =/ old-fod fod.dom - =. fod.dom - ?: updated [~ ~] - (promote-ford fod.dom invalid) - =. fad - (lose-leaks:fusion veb.bug fad (~(dif in spill.old-fod) spill.fod.dom)) + :: =? changes updated (changes-for-upgrade q.old-yaki deletes changes) :: =/ files @@ -1985,7 +1831,7 @@ %- ~(dif by (~(uni by original) changes)) %- ~(gas by *(map path (each page lobe))) (turn ~(tap in deletes) |=(=path [path |+*lobe])) - =/ =args:ford:fusion [files lat.ran veb.bug fad fod.dom] + =/ =args:ford:fusion [files lat.ran veb.bug] :: =^ change-cages args (checkout-changes args changes) =/ sane-continuation (sane-changes changes change-cages) @@ -2031,8 +1877,6 @@ =. mim.dom mim.res =. args args.res :: - =. fod.dom [spill sprig]:args - =. fad cache.args =. ..park (emil (print q.old-yaki data)) :: if upgrading kelvin and there's a commit-in-waiting, use that :: @@ -2127,44 +1971,6 @@ =/ pre=_changes (~(run by old) |=(lob=lobe |+lob)) (~(uni by pre) changes) :: - ++ promote-ford - |= [fod=flue invalid=(set path)] - ^- flue - =/ old=(list leak) ~(tap in spill.fod) - =| new=flue - |- ^- flue - ?~ old - new - =/ invalid - |- ^- ? - ?| ?+ -.pour.i.old %| - %vale (~(has in invalid) path.pour.i.old) - %arch - :: TODO: overly conservative, should be only direct hoon - :: children - :: - =/ len (lent path.pour.i.old) - %- ~(any in invalid) - |= =path - =(path.pour.i.old (scag len path)) - == - :: - =/ deps ~(tap in deps.i.old) - |- ^- ? - ?~ deps - %| - ?| ^$(i.old i.deps) - $(deps t.deps) - == - == - =? new !invalid - :- (~(put in spill.new) i.old) - =/ =mist (pour-to-mist pour.i.old) - ?~ got=(~(get by sprig.fod) mist) - sprig.new - (~(put by sprig.new) mist u.got) - $(old t.old) - :: ++ page-to-cord |= =page ^- @t @@ -2191,14 +1997,9 @@ [built=(map path [lobe cage]) cache=_ford-args] == ^+ [built ford-args] - =. ford-args cache - =/ [=cage fud=flow fod=flue] + =/ =cage :: ~> %slog.[0 leaf/"clay: validating {(spud path)}"] - %- wrap:fusion (read-file:(ford:fusion ford-args) path) - =. cache.ford-args fud - =. spill.ford-args spill.fod - =. sprig.ford-args sprig.fod =/ =lobe ?- -.change %| p.change @@ -2280,7 +2081,7 @@ =/ original=(map path (each page lobe)) (~(run by q.yaki) |=(=lobe |+lobe)) (~(uni by original) changes) - =/ =args:ford:fusion [all-changes lat.ran veb.bug ~ ~ ~] + =/ =args:ford:fusion [all-changes lat.ran veb.bug] =^ all-change-cages args (checkout-changes args all-changes) =/ ccs=(list [=path =lobe =cage]) ~(tap by change-cages) |- ^+ *sane-changes @@ -2839,18 +2640,12 @@ =/ peg=(unit page) (~(get by lat.ran) lobe) ?~ peg ~ - =/ [=cage *] - %- wrap:fusion - (page-to-cage:(tako-ford (~(got by hit.dom) let.dom)) u.peg) - `cage + `(page-to-cage:(tako-ford (~(got by hit.dom) let.dom)) u.peg) :: ++ get-dais |= =mark ^- dais - =/ [=dais *] - %- wrap:fusion - (build-dais:(tako-ford (~(got by hit.dom) let.dom)) mark) - dais + (build-dais:(tako-ford (~(got by hit.dom) let.dom)) mark) :: :: Diff two files on bob-desk :: @@ -3075,12 +2870,9 @@ |- ^- [(map path (unit mime)) args:ford:fusion] ?~ cans [mim ford-args] - =/ [=cage fud=flow fod=flue] + =/ =cage ~| mime-cast-fail+i.cans - (wrap:fusion (cast-path:(ford:fusion ford-args) i.cans %mime)) - =. cache.ford-args fud - =. spill.ford-args spill.fod - =. sprig.ford-args sprig.fod + (cast-path:(ford:fusion ford-args) i.cans %mime) =^ mim ford-args $(cans t.cans) [(~(put by mim) i.cans `!<(mime q.cage)) ford-args] :: @@ -3150,8 +2942,7 @@ (~(put by mon) pot [her syd ud+for-yon] spur) =/ =yaki (~(got by hut.ran) (~(got by hit.dom) u.yon)) =/ files (~(run by q.yaki) |=(=lobe |+lobe)) - =/ =args:ford:fusion - [files lat.ran veb.bug fad ?:(=(yon let.dom) fod.dom [~ ~])] + =/ =args:ford:fusion [files lat.ran veb.bug] =^ mim args (checkout-mime args ~ ~(key by files)) =. mim.dom (apply-changes-to-mim mim.dom mim) @@ -3348,7 +3139,7 @@ ?: &(?=(^ for) !(foreign-capable rav)) ~& [%bad-foreign-request-care from=for rav] ..start-request - =^ [new-sub=(unit rove) cards=(list card)] ..start-request + =/ [new-sub=(unit rove) cards=(list card)] (try-fill-sub for (rave-to-rove rav)) =. ..start-request (send-cards cards [hen ~ ~]) ?~ new-sub @@ -3473,7 +3264,6 @@ ^- (unit cage) =/ vale-result %- mule |. - %- wrap:fusion :: Use %base's marks to validate, so we don't have to build the :: foreign marks :: @@ -3485,7 +3275,7 @@ ?: ?=(%| -.vale-result) %- (slog >%validate-x-failed< p.vale-result) ~ - `-.p.vale-result + `p.vale-result :: :: Make sure the incoming data is a %z response :: @@ -3808,7 +3598,7 @@ ..wake(qyx qux) ?: =(~ ducts.i.subs) $(subs t.subs) - =^ [new-sub=(unit rove) cards=(list card)] ..park + =/ [new-sub=(unit rove) cards=(list card)] (try-fill-sub wove.i.subs) =. ..wake (send-cards cards ducts.i.subs) =? qux ?=(^ new-sub) @@ -3821,7 +3611,7 @@ :: ++ try-fill-sub |= [far=(unit [=ship ver=@ud]) rov=rove] - ^- [[(unit rove) (list card)] _..park] + ^- [(unit rove) (list card)] =/ for=(unit ship) ?~(far ~ `ship.u.far) ?- -.rov %sing @@ -3830,28 +3620,28 @@ ?^ cache-value :: if we have a result in our cache, produce it :: - :_ ..park :- ~ :_ ~ + :- ~ :_ ~ (writ ?~(u.cache-value ~ `[mood.rov u.u.cache-value])) :: else, check to see if rove is for an aeon we know :: =/ tako=(unit tako) (case-to-tako case.mood.rov) ?~ tako - [[`rov ~] ..park] + [`rov ~] :: we have the appropriate tako, so read in the data :: - =^ value=(unit (unit cage)) ..park + =/ value=(unit (unit cage)) (read-at-tako:ze for u.tako mood.rov) ?~ value :: we don't have the data directly. how can we fetch it? :: ?: =(0v0 u.tako) ~& [%clay-sing-indirect-data-0 `path`[syd '0' path.mood.rov]] - [[~ ~] ..park] + [~ ~] ~& [%clay-sing-indirect-data desk=syd mood=mood.rov tako=u.tako] - [[`rov ~] ..park] + [`rov ~] :: we have the data, so produce the results :: - :_ ..park :- ~ :_ ~ + :- ~ :_ ~ %- writ ?~ u.value ~ @@ -3863,7 +3653,7 @@ ?. ?=(~ for) :: reject if foreign (doesn't work over the network) :: - [[~ ~] ..park] + [~ ~] :: because %mult requests need to wait on multiple files for each :: revision that needs to be checked for changes, we keep two :: cache maps. {old} is the revision at {(dec aeon)}, {new} is @@ -3890,36 +3680,29 @@ =/ aeon=(unit aeon) (case-to-aeon case.mool.rov) :: if we still don't, wait. :: - ?~ aeon [(store rov) ..park] + ?~ aeon (store rov) :: if we do, update the request and retry. :: $(aeon.rov `+(u.aeon), old-cach.rov ~, new-cach.rov ~) :: if old isn't complete, try filling in the gaps. :: - =^ o ..park - ?: (complete old-cach.rov) - [old-cach.rov ..park] + =? old-cach.rov !(complete old-cach.rov) (read-unknown mool.rov(case [%ud (dec u.aeon.rov)]) old-cach.rov) - =. old-cach.rov o :: if the next aeon we want to compare is in the future, wait again. :: =/ next-aeon=(unit aeon) (case-to-aeon [%ud u.aeon.rov]) - ?~ next-aeon [(store rov) ..park] + ?~ next-aeon (store rov) :: if new isn't complete, try filling in the gaps. :: - =^ n ..park - ?: (complete new-cach.rov) - [new-cach.rov ..park] + =? new-cach.rov !(complete new-cach.rov) (read-unknown mool.rov(case [%ud u.aeon.rov]) new-cach.rov) - =. new-cach.rov n :: if new still isn't complete, wait again. :: ?. (complete new-cach.rov) - [(store rov) ..park] + (store rov) :: if old not complete, give a result (possible false positive). :: ?: !(complete old-cach.rov) - :_ ..park %- respond %- malt %+ murn ~(tap in paths.mool.rov) @@ -3964,7 +3747,7 @@ :: if there are any changes, send response. if none, move on to :: next aeon. :: - ?^ changes [(respond changes) ..park] + ?^ changes (respond changes) $(u.aeon.rov +(u.aeon.rov), new-cach.rov ~) :: :: check again later @@ -4021,7 +3804,7 @@ :: ++ read-unknown |= [=mool hav=(map (pair care path) cach)] - ^- [_hav _..park] + ^+ hav =? hav ?=(~ hav) %- malt ^- (list (pair (pair care path) cach)) %+ turn @@ -4029,22 +3812,16 @@ |= [c=care p=path] ^- [[care path] cach] [[c p] ~] - |- ^+ [hav ..park] - ?~ hav [hav ..park] - =^ lef ..park $(hav l.hav) - =. l.hav lef - =^ rig ..park $(hav r.hav) - =. r.hav rig + |- ^+ hav + ?~ hav hav + =. l.hav $(hav l.hav) + =. r.hav $(hav r.hav) =/ [[=care =path] =cach] n.hav - ?^ cach - [hav ..park] - =^ q ..park (aver for care case.mool path) - =. q.n.hav q - [hav ..park] + ?^ cach hav + hav(q.n (aver for care case.mool path)) -- :: %many - :_ ..park ?. |(?=(~ for) (allowed-by:ze u.for path.moat.rov per.red)) [~ ~] =/ from-aeon (case-to-aeon from.moat.rov) @@ -4173,61 +3950,51 @@ ++ read-a !. |= [=tako =path] - ^- [(unit (unit cage)) _..park] - =^ =vase ..park + ^- (unit (unit cage)) + =/ =vase ~_ leaf/"clay: %a build failed {<[syd tako path]>}" - %+ tako-flow tako - %- wrap:fusion (build-file:(tako-ford tako) path) - :_(..park [~ ~ %vase !>(vase)]) + [~ ~ %vase !>(vase)] :: ++ read-b !. |= [=tako =path] - ^- [(unit (unit cage)) _..park] + ^- (unit (unit cage)) ?. ?=([@ ~] path) - [[~ ~] ..park] - =^ =dais ..park - %+ tako-flow tako - %- wrap:fusion + [~ ~] + =/ =dais (build-dais:(tako-ford tako) i.path) - :_(..park [~ ~ %dais !>(dais)]) + [~ ~ %dais !>(dais)] :: ++ read-c !. |= [=tako =path] - ^- [(unit (unit cage)) _..park] + ^- (unit (unit cage)) ?. ?=([@ @ ~] path) - [[~ ~] ..park] - =^ =tube ..park - %+ tako-flow tako - %- wrap:fusion + [~ ~] + =/ =tube (build-tube:(tako-ford tako) [i i.t]:path) - :_(..park [~ ~ %tube !>(tube)]) + [~ ~ %tube !>(tube)] :: ++ read-e !. |= [=tako =path] - ^- [(unit (unit cage)) _..park] + ^- (unit (unit cage)) ?. ?=([@ ~] path) - [[~ ~] ..park] - =^ =vase ..park - %+ tako-flow tako - %- wrap:fusion + [~ ~] + =/ =vase (build-nave:(tako-ford tako) i.path) - :_(..park [~ ~ %nave vase]) + [~ ~ %nave vase] :: ++ read-f !. |= [=tako =path] - ^- [(unit (unit cage)) _..park] + ^- (unit (unit cage)) ?. ?=([@ @ ~] path) - [[~ ~] ..park] - =^ =vase ..park - %+ tako-flow tako - %- wrap:fusion + [~ ~] + =/ =vase (build-cast:(tako-ford tako) [i i.t]:path) - :_(..park [~ ~ %cast vase]) + [~ ~ %cast vase] :: :: TODO move to +read-buc :: @@ -4356,10 +4123,9 @@ :: ++ read-r |= [tak=tako pax=path] - ^- [(unit (unit cage)) _..park] - =^ x ..park (read-x tak pax) - :_ ..park - ?~ x ~ + ^- (unit (unit cage)) + =/ x (read-x tak pax) + ?~ x ~ ?~ u.x [~ ~] ``[p.u.u.x !>(q.u.u.x)] :: +read-s: produce miscellaneous @@ -4424,14 +4190,11 @@ ``uvi+[-:!>(*@uvI) (content-hash u.yak /)] :: %cage - :: should save ford cache - :: =/ =lobe (slav %uv i.t.pax) =/ peg=(unit page) (~(get by lat.ran) lobe) ?~ peg ~ - =/ [=cage *] - %- wrap:fusion + =/ =cage (page-to-cage:(tako-ford tak) u.peg) ``cage+[-:!>(*^cage) cage] :: @@ -4549,17 +4312,13 @@ :: ++ read-x |= [tak=tako pax=path] - ^- [(unit (unit cage)) _..park] + ^- (unit (unit cage)) =/ q (read-q tak pax) - ?~ q `..park - ?~ u.q [[~ ~] ..park] + ?~ q ~ + ?~ u.q [~ ~] :: should convert any lobe to cage :: - =^ =cage ..park - %+ tako-flow tak - %- wrap:fusion - (page-to-cage:(tako-ford tak) p.u.u.q q.q.u.u.q) - [``cage ..park] + ``(page-to-cage:(tako-ford tak) p.u.u.q q.q.u.u.q) :: :: Gets an arch (directory listing) at a node. :: @@ -4604,7 +4363,7 @@ :: ++ read-at-tako :: read-at-tako:ze |= [for=(unit ship) tak=tako mun=mood] :: seek and read - ^- [(unit (unit cage)) _..park] + ^- (unit (unit cage)) :: non-zero commits must be known, and reachable from within this desk :: ?. ?| =(0v0 tak) @@ -4619,34 +4378,34 @@ == |(?=(~ for) (may-read u.for care.mun tak path.mun)) == == - [~ ..park] + ~ :: virtualize to catch and produce deterministic failures :: |^ =/ res (mule |.(read)) ?: ?=(%& -.res) p.res - %. [[~ ~] ..park] + %. [~ ~] (slog leaf+"clay: read-at-tako fail {<[desk=syd mun]>}" (flop p.res)) :: ++ read - ^- [(unit (unit cage)) _..park] + ^- (unit (unit cage)) ?- care.mun %a (read-a tak path.mun) %b (read-b tak path.mun) %c (read-c tak path.mun) - %d [(read-d tak path.mun) ..park] + %d (read-d tak path.mun) %e (read-e tak path.mun) %f (read-f tak path.mun) - %p [(read-p path.mun) ..park] - %q [(read-q tak path.mun) ..park] + %p (read-p path.mun) + %q (read-q tak path.mun) %r (read-r tak path.mun) - %s [(read-s tak path.mun case.mun) ..park] - %t [(read-t tak path.mun) ..park] - %u [(read-u tak path.mun) ..park] - %v [(read-v tak path.mun) ..park] - %w [(read-w tak) ..park] + %s (read-s tak path.mun case.mun) + %t (read-t tak path.mun) + %u (read-u tak path.mun) + %v (read-v tak path.mun) + %w (read-w tak) %x (read-x tak path.mun) - %y [(read-y tak path.mun) ..park] - %z [(read-z tak path.mun) ..park] + %y (read-y tak path.mun) + %z (read-z tak path.mun) == -- -- @@ -4677,15 +4436,6 @@ %- tako-ford:den ::TODO is this +got after +got semantically correct? (~(got by hit.dom:(~(got by dos.rom) syd)) ?~(yon let.dom:den u.yon)) - :: +wrap: save ford cache - :: - ++ wrap - |* [her=ship syd=desk yon=(unit aeon) res=* =state:ford:fusion] - =^ moves ruf - =/ den ((de now rof hen ruf) her syd) - =/ tak (aeon-to-tako:ze:den ?~(yon let.dom:den u.yon)) - abet:+:(tako-flow:den tak res cache.state &2.state) - [res (emil moves)] :: ++ trace |= [pri=@ print=(trap tape)] @@ -4713,7 +4463,7 @@ ?. =(%live liv.dom.den) %- (trace 2 |.("{} is not live")) $(desks t.desks) - =^ res den (aver:den ~ %x da+now /desk/bill) + =/ res (aver:den ~ %x da+now /desk/bill) =. ruf +:abet:den =/ bill ?. ?=([~ ~ *] res) *bill @@ -4732,11 +4482,10 @@ %+ turn sat |= [=desk =bill] leaf+"goad: output: {}: {}" - =^ agents ..abet (build-agents sat) + =/ agents (build-agents sat) :: TODO: enable if we can reduce memory usage :: - :: =. ..abet - :: (build-marks (turn (skip sat |=([desk =bill] =(bill ~))) head)) + :: =+ (build-marks (turn (skip sat |=([desk =bill] =(bill ~))) head)) :: =. ..abet tare :: [tare] > (emit hen %pass /lu/load %g %load agents) @@ -4789,73 +4538,70 @@ :: ++ build-agents |= sat=(list [=desk =bill]) - ^- [load:gall _..abet] + ^- load:gall =| lad=load:gall - |- ^- [load:gall _..abet] + |- ^- load:gall ?~ sat - [lad ..abet] + lad =/ f (ford our desk.i.sat ~) - =^ new=load:gall ..abet - %- wrap :^ our desk.i.sat ~ - |- ^- [load:gall state:ford:fusion] + =/ new=load:gall + |- ^- load:gall ?~ bill.i.sat - [~ nub.f] - =^ =vase nub.f + ~ + =/ =vase %- road |. (build-file:f /app/[i.bill.i.sat]/hoon) =/ agent ~| [%building-app bill.i.sat] !<(agent:gall vase) - =^ lid nub.f $(bill.i.sat t.bill.i.sat) - [[[i.bill.i.sat [our desk.i.sat da+now] agent] lid] nub.f] + =/ lid $(bill.i.sat t.bill.i.sat) + [[i.bill.i.sat [our desk.i.sat da+now] agent] lid] =. lad (weld lad new) $(sat t.sat) :: build-dais for each mark :: ++ build-marks |= desks=(list desk) - ^+ ..abet - ?~ desks - ..abet + ^- ~ + ?~ desks ~ + =- $(desks t.desks) =/ f (ford our i.desks ~) - =^ null ..abet - %- wrap :^ our i.desks ~ - =^ marks=(list mark) nub.f - =/ pax=path / - |- ^- [(list mark) _nub.f] - =/ den ((de now rof hen ruf) our i.desks) - =^ res den (aver:den ~ %y da+now mar+pax) - ?. ?=([~ ~ *] res) - [~ nub.f] - =/ arch ~| [%building-arch i.desks] !<(arch q.u.u.res) - =/ m1=(list mark) - ?. ?& ?=(^ fil.arch) - ?=(^ pax) - =(/hoon (slag (dec (lent pax)) `path`pax)) - == - ~ - :_ ~ - ?~ t.pax - '' - |- ^- mark - ?~ t.t.pax - i.pax - (rap 3 i.pax '-' $(pax t.pax) ~) - :: - =^ m2 nub.f - |- ^- [(list mark) _nub.f] - ?~ dir.arch - [~ nub.f] - =^ n1 nub.f ^$(pax (weld pax /[p.n.dir.arch])) - =^ n2 nub.f $(dir.arch l.dir.arch) - =^ n3 nub.f $(dir.arch r.dir.arch) - [:(weld n1 n2 n3) nub.f] - [(weld m1 m2) nub.f] - :: - |- ^- [~ state:ford:fusion] - ?~ marks - [~ nub.f] - =^ =dais nub.f (build-dais:f i.marks) - $(marks t.marks) - $(desks t.desks) + =/ marks=(list mark) + =/ pax=path / + |- ^- (list mark) + =/ den ((de now rof hen ruf) our i.desks) + =/ res (aver:den ~ %y da+now mar+pax) + ?. ?=([~ ~ *] res) + ~ + =/ arch ~| [%building-arch i.desks] !<(arch q.u.u.res) + =/ m1=(list mark) + ?. ?& ?=(^ fil.arch) + ?=(^ pax) + =(/hoon (slag (dec (lent pax)) `path`pax)) + == + ~ + :_ ~ + ?~ t.pax + '' + |- ^- mark + ?~ t.t.pax + i.pax + (rap 3 i.pax '-' $(pax t.pax) ~) + :: + =/ m2 + |- ^- (list mark) + ?~ dir.arch + ~ + =/ n1 ^$(pax (weld pax /[p.n.dir.arch])) + =/ n2 $(dir.arch l.dir.arch) + =/ n3 $(dir.arch r.dir.arch) + :(weld n1 n2 n3) + (weld m1 m2) + :: + |- ^- ~ + ?~ marks ~ + =- $(marks t.marks) + ~| i.desks + %- road |. + ~:(build-dais:f i.marks) :: ++ tore ^- rock:tire @@ -5142,22 +4888,6 @@ [moves ..^$] :: [%trim ~] - =: fad.ruf *flow - dos.rom.ruf - %- ~(run by dos.rom.ruf) - |= =dojo - dojo(fod.dom *flue) - :: - hoy.ruf - %- ~(run by hoy.ruf) - |= =rung - %= rung - rus - %- ~(run by rus.rung) - |= =rede - rede(fod.dom *flue) - == - == [~ ..^$] :: [%fine ~] @@ -5269,9 +4999,7 @@ == :: ++ load - :: latest $raft-* is equivalent to top-level $raft, - :: save for the stubbing out of the cache types. - :: +clear-cache inflates to $raft. + :: latest $raft-* is equivalent to top-level $raft :: => |% +$ raft-any @@ -5287,12 +5015,30 @@ [%7 raft-7] [%6 raft-6] == - +$ raft-16 _%*(. *raft fad **, rom *room-16, hoy *(map ship rung-16)) - +$ room-16 _%*(. *room dos *(map desk dojo-16)) - +$ rung-16 _%*(. *rung rus *(map desk rede-16)) - +$ rede-16 _%*(. *rede dom *dome-16) - +$ dojo-16 _%*(. *dojo dom *dome-16) - +$ dome-16 _%*(. *dome fod **) + +$ raft-16 raft + :: + +$ flow (map leak [refs=@ud =soak]) + +$ leak + $~ [*pour ~] + $: =pour + deps=(set leak) + == + +$ pour + $% [%file =path] + [%nave =mark] + [%dais =mark] + [%cast =mars] + [%tube =mars] + [%vale =path =lobe] + [%arch =path =(map path lobe)] + == + +$ soak + $% [%cage =cage] + [%vase =vase] + [%arch dir=(map @ta vase)] + [%dais =dais] + [%tube =tube] + == :: +$ raft-15 $+ raft-15 @@ -5743,31 +5489,8 @@ =? old ?=(%14 -.old) 15+(raft-14-to-15 +.old) =? old ?=(%15 -.old) 16+(raft-15-to-16 +.old) ?> ?=(%16 -.old) - ..^^$(ruf (clear-cache +.old)) - :: - :: We clear the ford cache so we don't have to know how to upgrade - :: the types, which are complicated and eg contravariant in +hoon. - :: Also, many of the results would be different if zuse is different. + ..^^$(ruf +.old) :: - ++ clear-cache - |= raf=raft-16 - ^- raft - %= raf - fad *flow - dos.rom - %- ~(run by dos.rom.raf) - |= doj=dojo-16 - ^- dojo - doj(fod.dom *flue) - :: - hoy - %- ~(run by hoy.raf) - |= =rung-16 - %- ~(run by rus.rung-16) - |= =rede-16 - ^- rede - rede-16(dom dom.rede-16(fod *flue)) - == :: +raft-6-to-7: delete stale ford caches (they could all be invalid) :: ++ raft-6-to-7 @@ -6065,23 +5788,28 @@ |= d=dojo-13 d(fiz [fiz.d ese=%.y]) == - :: +raft-15-to-16: update type of type + :: +raft-15-to-16: update type of type, remove ford cache :: ++ raft-15-to-16 |= raf=raft-15 |^ ^- raft-16 + =< [&1 &2 &3 |4] %= raf dos.rom %- ~(run by dos.rom.raf) |= d=dojo-15 - d(qyx (cult-15-to-cult qyx.d)) + d(qyx (cult-15-to-cult qyx.d), dom (dome-13-to-dome dom.d)) :: hoy %- ~(run by hoy.raf) |= r=rung-15 %- ~(run by rus.r) |= r=rede-15 - r(ref (bind ref.r rind-15-to-rind), qyx (cult-15-to-cult qyx.r)) + %= r + ref (bind ref.r rind-15-to-rind) + qyx (cult-15-to-cult qyx.r) + dom (dome-13-to-dome dom.r) + == == :: ++ cult-15-to-cult @@ -6093,6 +5821,11 @@ ^- [wove (set duct)] [w(rove (rove-15-to-rove rove.w)) s] :: + ++ dome-13-to-dome + |= d=dome-13 + ^- dome + [let hit lab tom nor mim wic liv ren]:d + :: ++ rove-15-to-rove |= r=rove-15 ?+ -.r r @@ -6163,7 +5896,7 @@ ?. aut ~ =/ for=(unit ship) ?~(lyc ~ ?~(u.lyc ~ `n.u.lyc)) =/ den ((de now rof [/scryduct ~] ruf) his syd) - =/ result (mule |.(-:(aver:den for u.run u.luk tyl))) + =/ result (mule |.((aver:den for u.run u.luk tyl))) ?: ?=(%| -.result) %- (slog >%clay-scry-fail< p.result) ~ @@ -6181,12 +5914,10 @@ ?~ path ~ ?+ i.path ~ - %sweep ``[%sweep !>(sweep)] %rang ``[%rang !>(ran.ruf)] %tomb ``[%flag !>((tomb t.path))] %cult ``[%cult !>((cult t.path))] %esse (esse t.path) - %flow ``[%flow !>(fad.ruf)] %domes domes %tire ``[%tire !>(tore:(lu now rof *duct ruf))] %tyre ``[%tyre !>(tyr.ruf)] @@ -6250,92 +5981,13 @@ =+ !<(=arch q.u.u.cay) ?~ fil.arch %| (~(has by lat.ran.ruf) u.fil.arch) - :: - :: Check for refcount errors - :: - ++ sweep - ^- (list [need=@ud have=@ud leak]) - =/ marked=(map leak [need=@ud have=@ud]) - (~(run by fad.ruf) |=([refs=@ud *] [0 refs])) - =. marked - =/ items=(list [=leak *]) ~(tap by fad.ruf) - |- ^+ marked - ?~ items - marked - =/ deps ~(tap in deps.leak.i.items) - |- ^+ marked - ?~ deps - ^$(items t.items) - =. marked - %+ ~(put by marked) i.deps - =/ gut (~(gut by marked) i.deps [0 0]) - [+(-.gut) +.gut] - $(deps t.deps) - :: - =/ spills=(list (set leak)) - %+ welp - %+ turn ~(tap by dos.rom.ruf) - |= [* =dojo] - spill.fod.dom.dojo - %- zing - %+ turn ~(tap by hoy.ruf) - |= [* =rung] - %+ turn ~(tap by rus.rung) - |= [* =rede] - spill.fod.dom.rede - :: - =. marked - |- - ?~ spills - marked - =/ leaks ~(tap in i.spills) - |- - ?~ leaks - ^$(spills t.spills) - =. marked - %+ ~(put by marked) i.leaks - =/ gut (~(gut by marked) i.leaks [0 0]) - [+(-.gut) +.gut] - $(leaks t.leaks) - :: - %+ murn ~(tap by marked) - |= [=leak need=@ud have=@ud] - ?: =(need have) - ~ - `u=[need have leak] -- :: -:: We clear the ford cache by replacing it with its bunt as a literal, -:: with its singleton type. This nests within +flow and +flue without -:: reference to +type, +hoon, or anything else in the sample of cache -:: objects. Otherwise we would be contravariant in those types, which -:: makes them harder to change. -:: ++ stay ^- raft-any:load - =/ flu [~ ~] - =+ `flue`flu - =/ flo ~ - =+ `flow`flo :- ver ^- raft-16:load - %= ruf - fad flo - dos.rom - %- ~(run by dos.rom.ruf) - |= =dojo - dojo(fod.dom flu) - :: - hoy - %- ~(run by hoy.ruf) - |= =rung - %= rung - rus - %- ~(run by rus.rung) - |= =rede - rede(fod.dom flu) - == - == + ruf :: ++ take :: accept response ~/ %clay-take @@ -6610,7 +6262,6 @@ |= [=desk =dojo] :+ desk %| :~ mime+&+mim.dom.dojo - flue+&+fod.dom.dojo dojo+&+dojo == :~ :+ %object-store %| @@ -6622,14 +6273,12 @@ == domestic+|+domestic foreign+&+hoy.ruf - ford-cache+&+fad.ruf == =/ domestic %+ turn (sort ~(tap by dos.rom.ruf) aor) |= [=desk =dojo] :+ desk %| :~ mime+&+mim.dom.dojo - flue+&+fod.dom.dojo dojo+&+dojo == :~ :+ %object-store %| @@ -6638,7 +6287,6 @@ == domestic+|+domestic foreign+&+hoy.ruf - ford-cache+&+fad.ruf == :: ++ tomb diff --git a/pkg/arvo/sys/vane/gall.hoon b/pkg/arvo/sys/vane/gall.hoon index 62ca6b9714..a57f608e9e 100644 --- a/pkg/arvo/sys/vane/gall.hoon +++ b/pkg/arvo/sys/vane/gall.hoon @@ -130,225 +130,6 @@ pen=(jug spar:ames wire) gem=(jug coop [path page]) == == -:: -++ of-farm - |_ =farm - ++ key-coops - |= pos=path - ^- (list coop) - =/ frm (get-farm pos) - ?~ frm ~ - =. farm u.frm - |- - ?: ?=(%coop -.farm) - ~[pos] - %- zing - %+ turn ~(tap by q.farm) - |= [seg=@ta f=^farm] - ^- (list coop) - ^$(pos (snoc pos seg), farm f) - :: - ++ match-coop - =| wer=path - |= =path - ^- (unit coop) - ?: ?=(%coop -.farm) - `(flop wer) - ?~ path - ~ - ?~ nex=(~(get by q.farm) i.path) - ~ - $(wer [i.path wer], path t.path, farm u.nex) - :: - ++ put - |= [=path =plot] - ^- _farm - ?: ?=(%coop -.farm) - farm(q (~(put by q.farm) path plot)) - ?~ path - farm(p `plot) - =/ nex (~(get by q.farm) i.path) - =/ res $(path t.path, farm ?~(nex *^farm u.nex)) - farm(q (~(put by q.farm) i.path res)) - :: - ++ put-grow - |= [=path =plot] - ^- (unit _farm) - ?: ?=(%coop -.farm) - ~ - ?~ path - `farm(p `plot) - =/ nex (~(get by q.farm) i.path) - =/ res - $(path t.path, farm ?~(nex *^farm u.nex)) - ?~ res ~ - `farm(q (~(put by q.farm) i.path u.res)) - :: - ++ put-tend - |= [=path =plot] - ^- (unit _farm) - ?: ?=(%coop -.farm) - `farm(q (~(put by q.farm) path plot)) - ?~ path - `farm(p `plot) - ?~ nex=(~(get by q.farm) i.path) - ~ - =/ res - $(path t.path, farm u.nex) - ?~ res ~ - `farm(q (~(put by q.farm) i.path u.res)) - :: - ++ grow - |= [=spur now=@da =page] - =/ ski (gut spur) - %+ put spur - =- ski(fan (put:on-path fan.ski -< -> &/page)) - ?~ las=(ram:on-path fan.ski) - [?~(bob.ski 1 +(u.bob.ski)) now] - :_ (max now +(p.val.u.las)) - ?~(bob.ski +(key.u.las) +((max key.u.las u.bob.ski))) - :: - ++ germ - |= [=coop =hutch] - ^- (unit _farm) - ?~ coop - ?. |(=(%coop -.farm) =([%page ~ ~] farm)) - ~ - `[%coop hutch ~] - ?: ?=(%coop -.farm) - ~ - ?~ nex=(~(get by q.farm) i.coop) - ~ - $(coop t.coop, farm u.nex) - :: - ++ tend - |= [=coop =path =plot] - ^- (unit _farm) - ?~ coop - ?. ?=(%coop -.farm) - ~ - `farm(q (~(put by q.farm) path plot)) - ?. ?=(%plot -.farm) - ~ - ?~ nex=(~(get by q.farm) i.coop) - ~ - $(coop t.coop, farm u.nex) - :: - ++ del - |= =path - ^+ farm - ?: ?=(%coop -.farm) - farm(q (~(del by q.farm) path)) - ?~ path - farm(p ~) - ?~ nex=(~(get by q.farm) i.path) - farm - $(path t.path, farm u.nex) - :: - ++ gut - |= =path - ^- plot - (fall (get path) *plot) - :: - ++ put-hutch - |= [=path =hutch] - ^- (unit _farm) - ?~ path - ?: ?=(%coop -.farm) - `farm(p hutch) - ?. =([%plot ~ ~] farm) - ~ - `[%coop hutch ~] - ?: ?=(%coop -.farm) - ~ - =/ nex (~(gut by q.farm) i.path *^farm) - =/ res $(path t.path, farm nex) - ?~ res ~ - `farm(q (~(put by q.farm) i.path u.res)) - :: - ++ get-hutch - |= =path - ^- (unit hutch) - ?~ path - ?. ?=(%coop -.farm) - ~ - `p.farm - ?: ?=(%coop -.farm) - ~ - ?~ nex=(~(get by q.farm) i.path) - ~ - $(path t.path, farm u.nex) - :: - ++ get-farm - |= =path - ^- (unit ^farm) - ?: ?=(%coop -.farm) - ?~ (~(get by q.farm) path) - ~ - `farm - ?~ path ~ - ?~ nex=(~(get by q.farm) i.path) - ~ - $(path t.path, farm u.nex) - :: - ++ get - |= =path - ^- (unit plot) - ?: ?=(%coop -.farm) - (~(get by q.farm) path) - ?~ path - p.farm - ?~ nex=(~(get by q.farm) i.path) - ~ - $(path t.path, farm u.nex) - :: - ++ tap-plot - =| wer=path - |- ^- (list [path plot]) - =* tap-plot $ - ?: ?=(%coop -.farm) - %+ turn ~(tap by q.farm) - |= [=path =plot] - [(welp wer path) plot] - %+ welp ?~(p.farm ~ [wer u.p.farm]~) - %- zing - %+ turn ~(tap by q.farm) - |= [seg=@ta f=^farm] - ^- (list [path plot]) - tap-plot(wer (snoc wer seg), farm f) - :: - ++ run-plot - |* fun=gate - %- ~(gas by *(map path _(fun))) - %+ turn tap-plot - |= [=path =plot] - [path (fun plot)] - :: - ++ gas-hutch - |= =(list [=coop =hutch]) - ^- (unit _farm) - ?~ list - `farm - =/ nex - (put-hutch i.list) - ?~ nex ~ - $(farm u.nex, list t.list) - :: - ++ tap-hutch - =| wer=path - %- ~(gas in *(set [=coop =hutch])) - |- ^- (list [=coop =hutch]) - =* loop $ - ?: ?=(%coop -.farm) - [wer p.farm]~ - %- zing - %+ turn ~(tap by q.farm) - |= [seg=@ta f=^farm] - ^- (list [=coop =hutch]) - loop(wer (snoc wer seg), farm f) - -- -:: -++ on-path ((on @ud (pair @da (each page @uvI))) lte) :: $blocked-move: enqueued move to an agent :: +$ blocked-move [=duct =routes move=(each deal unto)] @@ -3017,40 +2798,7 @@ |= old=spore-15 :- %16 ^- spore-16 - %= old - eggs - %- ~(urn by eggs.old) - |= [=term e=egg-15] - ^- egg-16 - ?: ?=(%nuke -.e) [%nuke ~ ~] - %= e - ken [ken.e ~ ~] - :: - sky - =| =farm - =/ ski ~(tap by sky.e) - |- ^+ farm - ?~ ski - farm - =/ [=spur p=plot] i.ski - =; new - ?~ nex=(~(put-grow of-farm farm) spur new) - ~& %weird - !! :: shouldn't continue else loss of ref integrity - :: $(ski t.ski) - $(farm u.nex, ski t.ski) - :- ~ - =/ m ~(val by fan.p) - %+ gas:on-path *_fan.p - %+ turn - ^- (list @) - =/ wit ~(wyt by fan.p) - ?: =(0 wit) ~ - (gulf 1 wit) - |= a=@ud - [a (snag (dec a) m)] - == - == + old(eggs (~(run by eggs.old) egg-15-to-16:egg-aid)) :: drop unto blocked moves :: ++ spore-16-to-17 @@ -3106,12 +2854,7 @@ ^- spore-20 :- %20 %= old - eggs - %- ~(run by eggs.old) - |= e=egg-16 - ^- egg - ?. ?=(%live -.e) e - e(+.old-state (next-vase:h136 +.old-state.e)) + eggs (~(run by eggs.old) egg-16-to-20:egg-aid) :: blocked %- ~(run by blocked.old) diff --git a/pkg/arvo/sys/zuse.hoon b/pkg/arvo/sys/zuse.hoon index 81467795b1..11205acb55 100644 --- a/pkg/arvo/sys/zuse.hoon +++ b/pkg/arvo/sys/zuse.hoon @@ -1659,8 +1659,128 @@ ^- @ (jam (~(en sivc:aes (shaz key) ~) msg)) -- + -- ::cric + :: :: + :::: ++crub:crypto :: (2b4) suite B, Ed + :: :::: + ++ crub !: + ^- acru + =| [pub=[cry=@ sgn=@] sek=(unit [cry=@ sgn=@])] + |% + :: :: ++as:crub:crypto + ++ as :: + |% + :: :: ++sign:as:crub: + ++ sign :: + |= msg=@ + ^- @ux + (jam [(sigh msg) msg]) + :: :: ++sigh:as:crub: + ++ sigh :: + |= msg=@ + ^- @ux + ?~ sek ~| %pubkey-only !! + (sign:ed msg sgn.u.sek) + :: :: ++sure:as:crub: + ++ sure :: + |= txt=@ + ^- (unit @ux) + =+ ;;([sig=@ msg=@] (cue txt)) + ?. (safe sig msg) ~ + (some msg) + :: :: ++safe:as:crub: + ++ safe + |= [sig=@ msg=@] + ^- ? + (veri:ed sig msg sgn.pub) + :: :: ++seal:as:crub: + ++ seal :: + |= [bpk=pass msg=@] + ^- @ux + ?~ sek ~| %pubkey-only !! + ?> =('b' (end 3 bpk)) + =+ pk=(rsh 8 (rsh 3 bpk)) + =+ shar=(shax (shar:ed pk cry.u.sek)) + =+ smsg=(sign msg) + (jam (~(en siva:aes shar ~) smsg)) + :: :: ++tear:as:crub: + ++ tear :: + |= [bpk=pass txt=@] + ^- (unit @ux) + ?~ sek ~| %pubkey-only !! + ?> =('b' (end 3 bpk)) + =+ pk=(rsh 8 (rsh 3 bpk)) + =+ shar=(shax (shar:ed pk cry.u.sek)) + =+ ;;([iv=@ len=@ cph=@] (cue txt)) + =+ try=(~(de siva:aes shar ~) iv len cph) + ?~ try ~ + (sure:as:(com:nu:crub bpk) u.try) + -- ::as + :: :: ++de:crub:crypto + ++ de :: decrypt + |= [key=@J txt=@] + ^- (unit @ux) + =+ ;;([iv=@ len=@ cph=@] (cue txt)) + %^ ~(de sivc:aes (shaz key) ~) + iv + len + cph + :: :: ++dy:crub:crypto + ++ dy :: need decrypt + |= [key=@J cph=@] + (need (de key cph)) + :: :: ++en:crub:crypto + ++ en :: encrypt + |= [key=@J msg=@] + ^- @ux + (jam (~(en sivc:aes (shaz key) ~) msg)) + :: :: ++ex:crub:crypto + ++ ex :: extract + |% + :: :: ++fig:ex:crub:crypto + ++ fig :: fingerprint + ^- @uvH + (shaf %bfig pub) + :: :: ++pac:ex:crub:crypto + ++ pac :: private fingerprint + ^- @uvG + ?~ sek ~| %pubkey-only !! + (end 6 (shaf %bcod sec)) + :: :: ++pub:ex:crub:crypto + ++ pub :: public key + ^- pass + (cat 3 'b' (cat 8 sgn.^pub cry.^pub)) + :: :: ++sec:ex:crub:crypto + ++ sec :: private key + ^- ring + ?~ sek ~| %pubkey-only !! + (cat 3 'B' (cat 8 sgn.u.sek cry.u.sek)) + -- ::ex + :: :: ++nu:crub:crypto + ++ nu :: + |% + :: :: ++pit:nu:crub:crypto + ++ pit :: create keypair + |= [w=@ seed=@] + =+ wid=(add (div w 8) ?:(=((mod w 8) 0) 0 1)) + =+ bits=(shal wid seed) + =+ [c=(rsh 8 bits) s=(end 8 bits)] + ..nu(pub [cry=(puck:ed c) sgn=(puck:ed s)], sek `[cry=c sgn=s]) + :: :: ++nol:nu:crub:crypto + ++ nol :: activate secret + |= a=ring + =+ [mag=(end 3 a) bod=(rsh 3 a)] + ~| %not-crub-seckey ?> =('B' mag) + =+ [c=(rsh 8 bod) s=(end 8 bod)] + ..nu(pub [cry=(puck:ed c) sgn=(puck:ed s)], sek `[cry=c sgn=s]) + :: :: ++com:nu:crub:crypto + ++ com :: activate public + |= a=pass + =+ [mag=(end 3 a) bod=(rsh 3 a)] + ~| %not-crub-pubkey ?> =('b' mag) + ..nu(pub [cry=(rsh 8 bod) sgn=(end 8 bod)], sek ~) + -- ::nu -- ::crub - ++ crub !! :: :: :::: ++crua:crypto :: (2b5) suite B, RSA :: :::: diff --git a/pkg/base-dev/lib/pill.hoon b/pkg/base-dev/lib/pill.hoon index d28525b1a0..9549152c1a 100644 --- a/pkg/base-dev/lib/pill.hoon +++ b/pkg/base-dev/lib/pill.hoon @@ -572,6 +572,8 @@ =^ ton memo $(formula next.formula) ?. ?=(%0 -.ton) [ton memo] + ?: ?=([%clay %ford *] product.clue) + [ton memo] [ton (~(put by memo) [subject next.formula] product.ton)] =^ next memo =? trace diff --git a/tests/lib/vere/dawn.hoon b/tests/lib/vere/dawn.hoon index e72c04e719..8d72b6b3f9 100644 --- a/tests/lib/vere/dawn.hoon +++ b/tests/lib/vere/dawn.hoon @@ -48,19 +48,25 @@ !> |+[%not-keyed ~] !> (veri:dawn ~zod fed =>(pot .(net ~)) ~) :: -++ test-veri-wrong-key +++ test-veri-wrong-key-cric =/ fed [~zod 1 sec:ex:(pit:nu:cric:crypto 24 %foo %b ~) ~] %+ expect-eq !> |+[%key-mismatch ~] !> (veri:dawn ~zod fed pot ~) :: +++ test-veri-wrong-key-crub + =/ fed [~zod 1 sec:ex:(pit:nu:crub:crypto 24 %foo) ~] + %+ expect-eq + !> |+[%key-mismatch ~] + !> (veri:dawn ~zod fed pot ~) +:: ++ test-veri-life-mismatch =/ fed [~zod 2 sec ~] %+ expect-eq !> |+[%life-mismatch ~] !> (veri:dawn ~zod fed pot ~) :: -++ test-veri-bad-multikey +++ test-veri-bad-multikey-cric =/ fed=feed:jael :- [%1 ~] :- ~zod @@ -71,6 +77,17 @@ !> |+[%key-mismatch %life-mismatch ~] !> (veri:dawn ~zod fed pot ~) :: +++ test-veri-bad-multikey-crub + =/ fed=feed:jael + :- [%1 ~] + :- ~zod + :~ [1 sec:ex:(pit:nu:crub:crypto 24 %foo)] + [2 sec] + == + %+ expect-eq + !> |+[%key-mismatch %life-mismatch ~] + !> (veri:dawn ~zod fed pot ~) +:: ++ test-veri-none-multikey %+ expect-eq !> |+[%no-key ~] @@ -88,7 +105,7 @@ !> (veri:dawn ~zod fed pot `[2 &]) == :: -++ test-veri-earl-good +++ test-veri-earl-good-cric =/ cic (pit:nu:cric:crypto 24 %foo %b ~) =/ who ~simtel-mithet-dozzod-dozzod =/ fed @@ -101,7 +118,19 @@ !> &+fed !> (veri:dawn who fed pot ~) :: -++ test-veri-earl-parent-not-keyed +++ test-veri-earl-good-crub + =/ cub (pit:nu:crub:crypto 24 %foo) + =/ who ~simtel-mithet-dozzod-dozzod + =/ fed + =/ sig + %- sign:as:(nol:nu:crub:crypto sec) + (shaf %earl (sham who 1 pub:ex:cub)) + [[%2 ~] who 0 [1 sec:ex:cub]~] + %+ expect-eq + !> &+fed + !> (veri:dawn who fed pot ~) +:: +++ test-veri-earl-parent-not-keyed-cric =/ cic (pit:nu:cric:crypto 24 %foo %b ~) =/ who ~simtel-mithet-dozzod-dozzod =/ fed @@ -114,7 +143,19 @@ !> &+fed !> (veri:dawn who fed =>(pot .(net ~)) ~) :: -++ test-veri-pawn-good +++ test-veri-earl-parent-not-keyed-crub + =/ cub (pit:nu:crub:crypto 24 %foo) + =/ who ~simtel-mithet-dozzod-dozzod + =/ fed + =/ sig + %- sign:as:(nol:nu:crub:crypto sec) + (shaf %earl (sham who 1 pub:ex:cub)) + [[%2 ~] who 0 [1 sec:ex:cub]~] + %+ expect-eq + !> &+fed + !> (veri:dawn who fed =>(pot .(net ~)) ~) +:: +++ test-veri-pawn-good-cric =/ cic (pit:nu:cric:crypto 24 %foo %b ~) =/ who=ship `@`fig:ex:cic =/ fed [who 1 sec:ex:cic ~] @@ -122,7 +163,15 @@ !> &+[[%2 ~] who 0 [1 sec:ex:cic]~] !> (veri:dawn who fed *point:azimuth-types ~) :: -++ test-veri-pawn-key-mismatch +++ test-veri-pawn-good-crub + =/ cub (pit:nu:crub:crypto 24 %foo) + =/ who=ship `@`fig:ex:cub + =/ fed [who 1 sec:ex:cub ~] + %+ expect-eq + !> &+[[%2 ~] who 0 [1 sec:ex:cub]~] + !> (veri:dawn who fed *point:azimuth-types ~) +:: +++ test-veri-pawn-key-mismatch-cric =/ cic (pit:nu:cric:crypto 24 %foo %b ~) =/ who=ship `@`fig:ex:cic =/ sed [who 1 sec:ex:(pit:nu:cric:crypto 24 %bar %b ~) ~] @@ -130,7 +179,15 @@ !> |+[%key-mismatch ~] !> (veri:dawn who sed *point:azimuth-types ~) :: -++ test-veri-pawn-invalid-life +++ test-veri-pawn-key-mismatch-crub + =/ cub (pit:nu:crub:crypto 24 %foo) + =/ who=ship `@`fig:ex:cub + =/ sed [who 1 sec:ex:(pit:nu:crub:crypto 24 %bar) ~] + %+ expect-eq + !> |+[%key-mismatch ~] + !> (veri:dawn who sed *point:azimuth-types ~) +:: +++ test-veri-pawn-invalid-life-cric =/ cic (pit:nu:cric:crypto 24 %foo %b ~) =/ who=ship `@`fig:ex:cic =/ sed [who 2 sec:ex:cic ~] @@ -138,11 +195,27 @@ !> |+[%invalid-life ~] !> (veri:dawn who sed *point:azimuth-types ~) :: -++ test-veri-pawn-already-booted +++ test-veri-pawn-invalid-life-crub + =/ cub (pit:nu:crub:crypto 24 %foo) + =/ who=ship `@`fig:ex:cub + =/ sed [who 2 sec:ex:cub ~] + %+ expect-eq + !> |+[%invalid-life ~] + !> (veri:dawn who sed *point:azimuth-types ~) +:: +++ test-veri-pawn-already-booted-cric =/ cic (pit:nu:cric:crypto 24 %foo %b ~) =/ who=ship `@`fig:ex:cic =/ sed [who 1 sec:ex:cic ~] %+ expect-eq !> |+[%already-booted ~] !> (veri:dawn who sed *point:azimuth-types `[1 |]) +:: +++ test-veri-pawn-already-booted-crub + =/ cub (pit:nu:crub:crypto 24 %foo) + =/ who=ship `@`fig:ex:cub + =/ sed [who 1 sec:ex:cub ~] + %+ expect-eq + !> |+[%already-booted ~] + !> (veri:dawn who sed *point:azimuth-types `[1 |]) -- diff --git a/tests/sys/hoon/auras.hoon b/tests/sys/hoon/auras.hoon index 46ca51177c..9b2e3cfb2f 100644 --- a/tests/sys/hoon/auras.hoon +++ b/tests/sys/hoon/auras.hoon @@ -166,6 +166,11 @@ !> (scot %da ~2000.12.12) == :: +++ test-render-da-136 + %+ expect-eq + !> ~.~2000.1.1 + !> (scot:h136 %da ~2000.01.01) +:: ++ test-sane %- expect !>(((sane %t) '🤔')) diff --git a/tests/sys/hoon/chip.hoon b/tests/sys/hoon/chip.hoon new file mode 100644 index 0000000000..4ae90a0d79 --- /dev/null +++ b/tests/sys/hoon/chip.hoon @@ -0,0 +1,64 @@ +/+ *test +|% +++ test-negated-wuttis + %- expect-fail |. + %+ ride %noun + ''' + =/ u=(unit) ~ + ?. !?=(~ u) %blah + ?-(u ~ %empty, ^ %value) + ''' +:: +++ test-negated-wuttis-2 + %- expect-success |. + %+ ride %noun + ''' + =/ u=$@(~ [~ u=*]) [~ 123] + ?>(!?=(~ u) u.u) + ''' +:: +++ test-wutpam-specialization + %- expect-success |. + %+ ride %noun + ''' + =/ n=[p=* q=* r=*] [[1 2] [3 4] [5 6]] + ?> ?&(?=([p=* *] p.n) ?=([p=* *] q.n) ?=([p=* *] r.n)) + [p.p.n p.q.n p.r.n] + ''' +:: +++ test-wutbar-no-specialization + %- expect-success |. + %+ ride %noun + ''' + =/ n=[p=* q=* r=*] [[1 2] [3 4] [5 6]] + ?> ?|(?=([p=* *] p.n) ?=([p=* *] q.n) ?=([p=* *] r.n)) + [p.n q.n r.n] + ''' +:: +++ test-wutbar-no-specialization-demorgan + %- expect-success |. + %+ ride %noun + ''' + =/ n=[p=* q=* r=*] [[1 2] [3 4] [5 6]] + ?> !?&(!?=([p=* *] p.n) !?=([p=* *] q.n) !?=([p=* *] r.n)) + [p.n q.n r.n] + ''' +:: +++ test-sequential-narrowing + %- expect-success |. + %+ ride -:!>(unit=unit) + ''' + =/ c=[o=(unit (unit @)) d=(unit (unit @))] [``1 ~] + ?> ?&(?=(^ o.c) ?=(^ u.o.c) ?=(~ d.c)) + [u.u.o.c `~`d.c] + ''' +:: +++ test-sequential-narrowing-demorgan + %- expect-success |. + %+ ride -:!>(unit=unit) + ''' + =/ c=[o=(unit (unit @)) d=(unit (unit @))] [``1 ~] + ?> !?|(!?=(^ o.c) !?=(^ u.o.c) !?=(~ d.c)) + [u.u.o.c `~`d.c] + ''' +-- diff --git a/tests/sys/hoon/tisket.hoon b/tests/sys/hoon/tisket.hoon new file mode 100644 index 0000000000..53529386f1 --- /dev/null +++ b/tests/sys/hoon/tisket.hoon @@ -0,0 +1,6 @@ +/+ *test +|% +++ test-tisket-atom-product + %- expect-fail |. + (ride %noun '=+ a=1 =^ b a `$@(@ [* @])`2 ~') +-- diff --git a/tests/sys/vane/clay.hoon b/tests/sys/vane/clay.hoon index b290a15690..a3f7ca433c 100644 --- a/tests/sys/vane/clay.hoon +++ b/tests/sys/vane/clay.hoon @@ -18,18 +18,6 @@ =/ clay-gate (clay-raw ~nul) =/ fusion fusion:clay-gate :: -=> |% - ++ leak-to-deps - |= =leak:fusion - ^- (set mist:fusion) - %- sy - |- ^- (list mist:fusion) - %- zing - %+ turn ~(tap in deps.leak) - |= l=leak:fusion - :- (pour-to-mist:fusion pour.l) - ^$(leak l) - -- |% ++ test-parse-pile ^- tang =/ src '.' @@ -100,8 +88,6 @@ files=(my [/lib/self/hoon &+hoon+source]~) file-store=~ 0 - *flow:fusion - *flue:fusion == (build-file:ford /lib/self/hoon) :: @@ -115,19 +101,12 @@ files=(my [/mar/mime/hoon &+hoon+mar-mime]~) file-store=~ 0 - *flow:fusion - *flue:fusion == - =/ [res=vase nub=state:ford:fusion] (build-nave:ford %mime) - =/ =leak:fusion leak:(~(got by sprig.nub) file+/mar/mime/hoon) + =/ res=vase (build-nave:ford %mime) ;: weld %+ expect-eq !>(*mime) (slap res !,(*hoon *vale)) - :: - %+ expect-eq - !> (~(gas in *(set mist:fusion)) vale+/mar/mime/hoon ~) - !> (leak-to-deps leak) == :: ++ test-mar-udon ^- tang @@ -142,23 +121,12 @@ == file-store=~ 0 - *flow:fusion - *flue:fusion == - =/ [res=vase nub=state:ford:fusion] (build-nave:ford %udon) - =/ =leak:fusion leak:(~(got by sprig.nub) file+/mar/udon/hoon) + =/ res=vase (build-nave:ford %udon) ;: weld %+ expect-eq !>(*@t) (slap res !,(*hoon *vale)) - :: - %+ expect-eq - !> %- ~(gas in *(set mist:fusion)) - :~ vale+/mar/udon/hoon - vale+/lib/cram/hoon - file+/lib/cram/hoon - == - !> (leak-to-deps leak) == :: ++ test-cast-html-mime ^- tang @@ -172,10 +140,8 @@ files file-store=~ 0 - *flow:fusion - *flue:fusion == - =/ [res=vase nub=state:ford:fusion] (build-cast:ford %html %mime) + =/ res=vase (build-cast:ford %html %mime) %+ expect-eq (slam res !>('')) !> `mime`[/text/html 13 ''] @@ -191,10 +157,8 @@ files file-store=~ 0 - *flow:fusion - *flue:fusion == - =/ [res=vase nub=state:ford:fusion] (build-file:ford /lib/foo/hoon) + =/ res=vase (build-file:ford /lib/foo/hoon) %+ expect-eq res !> *mime @@ -211,10 +175,8 @@ files file-store=~ 0 - *flow:fusion - *flue:fusion == - =/ [res=vase nub=state:ford:fusion] (build-file:ford /lib/foo/hoon) + =/ res=vase (build-file:ford /lib/foo/hoon) %+ expect-eq res !> '' @@ -225,19 +187,12 @@ files=(my [/gen/hello/hoon &+hoon+gen-hello]~) file-store=~ 0 - *flow:fusion - *flue:fusion == - =/ [res=vase nub=state:ford:fusion] (build-file:ford /gen/hello/hoon) - =/ =leak:fusion leak:(~(got by sprig.nub) file+/gen/hello/hoon) + =/ res=vase (build-file:ford /gen/hello/hoon) ;: weld %+ expect-eq !> noun+'hello, bob' (slap res (ream '(+ [*^ [%bob ~] ~])')) - :: - %+ expect-eq - !> (~(gas in *(set mist:fusion)) vale+/gen/hello/hoon ~) - !> (leak-to-deps leak) == :: ++ test-lib-strandio ^- tang @@ -251,24 +206,11 @@ == file-store=~ 0 - *flow:fusion - *flue:fusion == - =/ [res=vase nub=state:ford:fusion] (build-file:ford /lib/strandio/hoon) - =/ =leak:fusion leak:(~(got by sprig.nub) file+/lib/strandio/hoon) + =/ res=vase (build-file:ford /lib/strandio/hoon) ;: weld %- expect !>((slab %read %get-our -.res)) - :: - %+ expect-eq - !> %- ~(gas in *(set mist:fusion)) - :~ vale+/lib/strandio/hoon - file+/lib/strand/hoon - vale+/lib/strand/hoon - file+/sur/spider/hoon - vale+/sur/spider/hoon - == - !> (leak-to-deps leak) == :: :: |utilities: helper functions for testing