diff --git a/bin/solid.pill b/bin/solid.pill index e4e73943a1..ba31101ee0 100644 --- a/bin/solid.pill +++ b/bin/solid.pill @@ -1,3 +1,3 @@ version https://git-lfs.github.com/spec/v1 -oid sha256:38435a0a23fb4f09d55505915cd8e772b8096fd846c2c8ff3481a5b231deedf6 -size 6331042 +oid sha256:7a5ffa86349b0f418d7d5a5f69a773d29b1d48d80d657058ff5abb0572f5187f +size 6409970 diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index 6ff7667a59..24811726a7 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -537,7 +537,7 @@ ++ group ;~((glue net) ship sym) ++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib ++ ship ;~(pfix sig fed:ag) - ++ path ;~(pfix net ;~(plug urs:ab (easy ~))) ::NOTE short only, tmp + ++ path ;~(pfix fas ;~(plug urs:ab (easy ~))) ::NOTE short only, tmp :: +mang: un/managed indicator prefix :: :: deprecated, as sig prefix is no longer used @@ -619,7 +619,7 @@ ++ letter ;~ pose (stag %url turl) - (stag %me ;~(pfix vat text)) + (stag %me ;~(pfix pat text)) (stag %text ;~(less mic hax text)) == :: +turl: url parser diff --git a/pkg/arvo/app/dojo.hoon b/pkg/arvo/app/dojo.hoon index 2716c009f7..00f51910e2 100644 --- a/pkg/arvo/app/dojo.hoon +++ b/pkg/arvo/app/dojo.hoon @@ -165,7 +165,7 @@ == == :: - ;~ pfix net + ;~ pfix fas ;~ pose (parse-variable (cold %sur hep) ;~(pfix gap parse-cables)) (parse-variable (cold %lib lus) ;~(pfix gap parse-cables)) @@ -179,8 +179,8 @@ ++ parse-sink ;~ pose ;~(plug (cold %file tar) parse-beam) - ;~(plug (cold %flat vat) (most net sym)) - ;~(plug (cold %pill dot) (most net sym)) + ;~(plug (cold %flat pat) (most fas sym)) + ;~(plug (cold %pill dot) (most fas sym)) ;~(plug (cold %http lus) (stag %post parse-url)) ;~(plug (cold %http hep) (stag %put parse-url)) (stag %show (cook $?($1 $2 $3 $4 $5) (cook lent (stun [1 5] wut)))) @@ -218,6 +218,7 @@ ;~(plug (cold %ur lus) parse-url) ;~(plug (cold %ge lus) parse-model) ;~(plug (cold %te hep) sym (star ;~(pfix ace parse-source))) + ;~(plug (cold %as pad) sym ;~(pfix ace parse-source)) ;~(plug (cold %do cab) parse-hoon ;~(pfix ace parse-source)) parse-value == @@ -227,7 +228,7 @@ ;~ pose ;~ plug ;~(pfix sig fed:ag) - ;~(pose ;~(pfix net sym) (easy default-app)) + ;~(pose ;~(pfix fas sym) (easy default-app)) == %+ stag our ;~(pose sym (easy default-app)) @@ -262,7 +263,7 @@ auri:de-purl:html :: ++ parse-model ;~(plug parse-server parse-config) - ++ parse-server (stag 0 (most net sym)) + ++ parse-server (stag 0 (most fas sym)) ++ parse-hoon tall:hoon-parser :: ++ parse-rood @@ -283,10 +284,10 @@ == ++ parse-value ;~ pose - ;~(plug (cold %as pad) sym ;~(pfix ace parse-source)) - (stag %sa ;~(pfix tar pad sym)) + ;~(plug (cold %as pam) sym ;~(pfix ace parse-source)) + (stag %sa ;~(pfix tar pam sym)) (stag %ex parse-hoon) - (stag %tu (ifix [lac rac] (most ace parse-source))) + (stag %tu (ifix [sel ser] (most ace parse-source))) == :: ++ parse-config diff --git a/pkg/arvo/lib/bip32.hoon b/pkg/arvo/lib/bip32.hoon index 1d4722d4e6..90ec0a07be 100644 --- a/pkg/arvo/lib/bip32.hoon +++ b/pkg/arvo/lib/bip32.hoon @@ -81,11 +81,11 @@ ++ derivation-path ;~ pfix ;~(pose (jest 'm/') (easy ~)) - %+ most net + %+ most fas ;~ pose %+ cook |=(i=@ (add i (bex 31))) - ;~(sfix dem say) + ;~(sfix dem soq) :: dem == == diff --git a/pkg/arvo/lib/language-server/build.hoon b/pkg/arvo/lib/language-server/build.hoon index 9c6e3dfd6d..015f37b889 100644 --- a/pkg/arvo/lib/language-server/build.hoon +++ b/pkg/arvo/lib/language-server/build.hoon @@ -7,13 +7,13 @@ =/ parse-pair %+ cook |=([row=@ud col=@ud] [(dec row) col]) - (ifix [lac rac] ;~((glue ace) dem dem)) + (ifix [sel ser] ;~((glue ace) dem dem)) =/ parse-path %+ cook |=(p=path (slag 3 p)) - (ifix [net (jest '::')] (more net urs:ab)) + (ifix [fas (jest '::')] (more fas urs:ab)) =/ parse-full - ;~(plug parse-path ;~(sfix ;~((glue dot) parse-pair parse-pair) ban)) + ;~(plug parse-path ;~(sfix ;~((glue dot) parse-pair parse-pair) gar)) (rust tape parse-full) :: ++ get-errors-from-tang diff --git a/pkg/arvo/mar/lens/command.hoon b/pkg/arvo/mar/lens/command.hoon index b8f0532f2e..9a1defd3a9 100644 --- a/pkg/arvo/mar/lens/command.hoon +++ b/pkg/arvo/mar/lens/command.hoon @@ -37,7 +37,7 @@ %- su ;~ plug sym - ;~(pfix col (more net (cook crip (star ;~(less net prn))))) + ;~(pfix col (more fas (cook crip (star ;~(less fas prn))))) == listen-api+(su ;~(plug sym ;~(pfix col sym))) export+so @@ -59,7 +59,7 @@ %- su ;~ plug sym - ;~(pfix col (more net (cook crip (star ;~(less net prn))))) + ;~(pfix col (more fas (cook crip (star ;~(less fas prn))))) == command+so app+(su sym) diff --git a/pkg/arvo/mar/publish/info.hoon b/pkg/arvo/mar/publish/info.hoon index eb8d7cbcc1..82ce342ef4 100644 --- a/pkg/arvo/mar/publish/info.hoon +++ b/pkg/arvo/mar/publish/info.hoon @@ -49,10 +49,10 @@ (key-val (jest 'description: ') (cook crip (star prn))) %+ key-val (jest 'comments: ') (cook |=(a=@ =(%on a)) ;~(pose (jest %on) (jest %off))) - (key-val (jest 'writers: ') ;~(pfix net (more net urs:ab))) + (key-val (jest 'writers: ') ;~(pfix fas (more fas urs:ab))) ;~ pose - (key-val (jest 'subscribers: ') ;~(pfix net (more net urs:ab))) - ;~(pfix (jest 'subscribers: ') ;~(pfix net (more net urs:ab))) + (key-val (jest 'subscribers: ') ;~(pfix fas (more fas urs:ab))) + ;~(pfix (jest 'subscribers: ') ;~(pfix fas (more fas urs:ab))) == == ++ both-parser diff --git a/pkg/arvo/sys/hoon.hoon b/pkg/arvo/sys/hoon.hoon index b3602bfd43..205d99107e 100644 --- a/pkg/arvo/sys/hoon.hoon +++ b/pkg/arvo/sys/hoon.hoon @@ -5595,47 +5595,59 @@ :: :::: 4h: parsing (ascii glyphs) :: -++ ace (just ' ') -++ ban (just '>') -++ bar (just '|') -++ bas (just '\\') :: XX deprecated -++ bat (just '\\') -++ buc (just '$') :: XX deprecated -++ bus (just '$') -++ cab (just '_') -++ cen (just '%') -++ col (just ':') -++ com (just ',') -++ dot (just '.') -++ fas (just '/') :: XX deprecated? -++ gal (just '<') :: XX deprecated -++ gar (just '>') :: XX deprecated -++ vat (just '@') :: pronounced "at" -++ hax (just '#') -++ hep (just '-') :: pronounced "ep" -++ ket (just '^') -++ leb (just '{') -++ led (just '<') -++ lob (just '{') -++ lit (just '(') -++ lac (just '[') -++ lus (just '+') -++ mic (just ';') :: pronounced "mick" -++ net (just '/') -++ pad (just '&') -++ rac (just ']') -++ reb (just '}') -++ rob (just '}') -++ rit (just ')') -++ say (just '\'') -++ sig (just '~') -++ tar (just '*') -++ tec (just '`') -++ tis (just '=') :: pronounced "is" -++ toc (just '"') :: XX deprecated -++ yel (just '"') -++ wut (just '?') -++ zap (just '!') +++ ace (just ' ') :: spACE +++ bar (just '|') :: vertical BAR +++ bas (just '\\') :: Back Slash (escaped) +++ buc (just '$') :: dollars BUCks +++ cab (just '_') :: CABoose +++ cen (just '%') :: perCENt +++ col (just ':') :: COLon +++ com (just ',') :: COMma +++ doq (just '"') :: Double Quote +++ dot (just '.') :: dot dot dot ... +++ fas (just '/') :: Forward Slash +++ gal (just '<') :: Greater Left +++ gar (just '>') :: Greater Right +++ hax (just '#') :: Hash +++ hep (just '-') :: HyPhen +++ kel (just '{') :: Curly Left +++ ker (just '}') :: Curly Right +++ ket (just '^') :: CareT +++ lus (just '+') :: pLUS +++ mic (just ';') :: seMIColon +++ pal (just '(') :: Paren Left +++ pam (just '&') :: AMPersand pampersand +++ par (just ')') :: Paren Right +++ pat (just '@') :: AT pat +++ sel (just '[') :: Square Left +++ ser (just ']') :: Square Right +++ sig (just '~') :: SIGnature squiggle +++ soq (just '\'') :: Single Quote +++ tar (just '*') :: sTAR +++ tic (just '`') :: backTiCk +++ tis (just '=') :: 'tis tis, it is +++ wut (just '?') :: wut, what? +++ zap (just '!') :: zap! bang! crash!! +:: +++ ban (just '>') :: XX deprecated, use gar +++ bat (just '\\') :: XX deprecated, use bas +++ bus (just '$') :: XX deprecated, use buc +++ lac (just '[') :: XX deprecated, use sel +++ leb (just '{') :: XX deprecated, use kel +++ led (just '<') :: XX deprecated, use gal +++ lit (just '(') :: XX deprecated, use pal +++ lob (just '{') :: XX deprecated, use kel +++ net (just '/') :: XX deprecated, use fas +++ pad (just '&') :: XX deprecated, use pam +++ rac (just ']') :: XX deprecated, use ser +++ reb (just '}') :: XX deprecated, use ker +++ rit (just ')') :: XX deprecated, use par +++ rob (just '}') :: XX deprecated, use ker +++ say (just '\'') :: XX deprecated, use soq +++ tec (just '`') :: XX deprecated, use tic +++ toc (just '"') :: XX deprecated, use doq +++ vat (just '@') :: XX deprecated, use pat +++ yel (just '"') :: XX deprecated, use doq :: :::: 4i: parsing (useful idioms) :: @@ -5662,8 +5674,8 @@ == ++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white ++ gay ;~(pose gap (easy ~)) :: -++ gon ;~(pose ;~(plug bat gay net) (easy ~)) :: long numbers \ / -++ gul ;~(pose (cold 2 led) (cold 3 ban)) :: axis syntax < > +++ gon ;~(pose ;~(plug bas gay fas) (easy ~)) :: long numbers \ / +++ gul ;~(pose (cold 2 gal) (cold 3 gar)) :: axis syntax < > ++ hex (bass 16 (most gon hit)) :: hex to atom ++ hig (shim 'A' 'Z') :: uppercase ++ hit ;~ pose :: hex digits @@ -5703,13 +5715,13 @@ ;~(less ;~(plug (just `@`10) soz) (just `@`10)) == ++ qit ;~ pose :: chars in a cord - ;~(less bat say prn) - ;~(pfix bat ;~(pose bat say mes)) :: escape chars + ;~(less bas soq prn) + ;~(pfix bas ;~(pose bas soq mes)) :: escape chars == -++ qut ;~ simu say :: cord +++ qut ;~ simu soq :: cord ;~ pose ;~ less soz - (ifix [say say] (boss 256 (more gon qit))) + (ifix [soq soq] (boss 256 (more gon qit))) == =+ hed=;~(pose ;~(plug (plus ace) vul) (just '\0a')) %- iny %+ ifix @@ -5718,7 +5730,7 @@ (boss 256 (star qat)) == == -++ soz ;~(plug say say say) :: delimiting ''' +++ soz ;~(plug soq soq soq) :: delimiting ''' ++ sym :: symbol %+ cook |=(a/tape (rap 3 ^-((list @) a))) @@ -5819,7 +5831,7 @@ (cook tuft (ifix [sig dot] hex)) ;~(pfix sig ;~(pose sig dot)) == - ++ voy ;~(pfix bat ;~(pose bat say bix)) + ++ voy ;~(pfix bas ;~(pose bas soq bix)) -- ++ ag |% @@ -6356,7 +6368,7 @@ ++ spat |=(pax/path (crip (spud pax))) :: render path to cord ++ spud |=(pax/path ~(ram re (smyt pax))) :: render path to tape ++ stab :: parse cord to path - =+ fel=;~(pfix net (more net urs:ab)) + =+ fel=;~(pfix fas (more fas urs:ab)) |=(zep/@t `path`(rash zep fel)) :: :::: 4n: virtualization @@ -12176,7 +12188,7 @@ ++ gash %+ cook :: parse path |= a/(list tyke) ^- tyke ?~(a ~ (weld i.a $(a t.a))) - (more net limp) + (more fas limp) ++ gasp ;~ pose :: parse =path= etc. %+ cook |=({a/tyke b/tyke c/tyke} :(weld a b c)) @@ -12189,9 +12201,9 @@ == ++ glam ~+((glue ace)) ++ hasp ;~ pose :: path element - (ifix [lac rac] wide) - (stag %cncl (ifix [lit rit] (most ace wide))) - (stag %sand (stag %tas (cold %$ bus))) + (ifix [sel ser] wide) + (stag %cncl (ifix [pal par] (most ace wide))) + (stag %sand (stag %tas (cold %$ buc))) (stag %sand (stag %t qut)) %+ cook |=(a/coin [%sand ?:(?=({~ $tas *} a) %tas %ta) ~(rent co a)]) @@ -12201,7 +12213,7 @@ |= {a/(list) b/tyke} ?~ a b $(a t.a, b [`[%sand %tas %$] b]) - ;~(plug (star net) gasp) + ;~(plug (star fas) gasp) ++ mota %+ cook |=({a/tape b/tape} (rap 3 (weld a b))) ;~(plug (star low) (star hig)) @@ -12257,7 +12269,7 @@ ++ body ;~ pose ;~ plug :: can duplicate :: - (into ;~(pfix (punt ;~(plug null col ban step)) line)) + (into ;~(pfix (punt ;~(plug null col gar step)) line)) (easy ~) == ;~ plug @@ -12289,11 +12301,11 @@ :: ++ indo |* bod/rule - ;~(pfix col ban ;~(sfix bod (just `@`10) (punt gap))) + ;~(pfix col gar ;~(sfix bod (just `@`10) (punt gap))) :: ++ exit |* bod/rule - ;~(pfix (star ace) col led step bod) + ;~(pfix (star ace) col gal step bod) :: :: fill: full definition :: @@ -12379,7 +12391,7 @@ ++ porc ;~ plug (cook |=(a/(list) (lent a)) (star cen)) - ;~(pfix net gash) + ;~(pfix fas gash) == :: ++ rump @@ -12389,7 +12401,7 @@ ;~(plug rope ;~(pose (stag ~ wede) (easy ~))) :: ++ rood - ;~ pfix net + ;~ pfix fas (stag %clsg poor) == :: @@ -12478,7 +12490,7 @@ ++ wide-attrs :: wide attributes %+ cook |=(a/(unit mart:hoot) (fall a ~)) %- punt - %+ ifix [lit rit] + %+ ifix [pal par] %+ more (jest ', ') ;~((glue ace) a-mane hopefully-quote) :: @@ -12494,7 +12506,7 @@ ++ wide-paren-elems :: wide flow %+ cook |=(a/marl:hoot a) %+ cook join-tops - (ifix [lit rit] (more ace wide-inner-top)) + (ifix [pal par] (more ace wide-inner-top)) :: ::+| :: @@ -12515,7 +12527,7 @@ %+ cook |=(a/marl:hoot a) ;~ pose ;~ less (jest '"""') - (ifix [yel yel] (cook collapse-chars quote-innards)) + (ifix [doq doq] (cook collapse-chars quote-innards)) == :: %- inde @@ -12527,14 +12539,14 @@ %+ cook |=(a/(list $@(@ tuna:hoot)) a) %- star ;~ pose - ;~(pfix bas ;~(pose (mask "-+*%;\{") bas yel bix:ab)) + ;~(pfix bas ;~(pose (mask "-+*%;\{") bas doq bix:ab)) inline-embed - ;~(less bas lob ?:(in-tall-form fail toc) prn) + ;~(less bas kel ?:(in-tall-form fail doq) prn) ?:(lin fail ;~(less (jest '\0a"""') (just '\0a'))) == :: ++ bracketed-elem :: bracketed element - %+ ifix [lob rob] + %+ ifix [kel ker] ;~(plug tag-head wide-elems) :: ++ wrapped-elems :: wrapped tuna @@ -12587,7 +12599,7 @@ ;~ plug (punt ;~(plug (cold %id hax) (cook trip sym))) (cook en-class (star ;~(plug (cold %class dot) sym))) - (punt ;~(plug ;~(pose (cold %href net) (cold %src vat)) soil)) + (punt ;~(plug ;~(pose (cold %href fas) (cold %src pat)) soil)) (easy ~) == :: @@ -12604,7 +12616,7 @@ (stag %& tall-elem) (stag %| wide-quote) (stag %| ;~(pfix tis tall-tail)) - (stag %& ;~(pfix ban gap (stag [%div ~] cram))) + (stag %& ;~(pfix gar gap (stag [%div ~] cram))) (stag %| ;~(plug ;~((glue gap) tuna-mode tall) (easy ~))) (easy %| [;/("\0a")]~) == @@ -13067,20 +13079,20 @@ (cold [%end %stet] duz) :: == end of markdown :: (cold [%one %rule] ;~(plug hep hep hep)) :: --- horizontal ruler - (cold [%one %fens] ;~(plug tec tec tec)) :: ``` code fence + (cold [%one %fens] ;~(plug tic tic tic)) :: ``` code fence (cold [%one %expr] mic) :: ;sail expression :: (cold [%new %head] ;~(plug (star hax) ace)) :: # heading (cold [%new %lint] ;~(plug hep ace)) :: - line item (cold [%new %lite] ;~(plug lus ace)) :: + line item - (cold [%new %bloc] ;~(plug ban ace)) :: > block-quote + (cold [%new %bloc] ;~(plug gar ace)) :: > block-quote :: (easy [%old %text]) :: anything else == == :: :: - ++ calf :: cash but for tec tec + ++ calf :: cash but for tic tic |* tem=rule %- star ;~ pose @@ -13187,17 +13199,17 @@ :: :: "quoted text" :: - (stag %quod (ifix [yel yel] (cool (cash yel) werk))) + (stag %quod (ifix [doq doq] (cool (cash doq) werk))) :: :: `classic markdown quote` :: - (stag %code (ifix [tec tec] (calf tec))) + (stag %code (ifix [tic tic] (calf tic))) :: :: ++arm, +-arm, +$arm, +*arm, ++arm:core, ... :: %+ stag %code ;~ plug - lus ;~(pose lus hep bus tar) + lus ;~(pose lus hep buc tar) low (star ;~(pose nud low hep col)) == :: @@ -13205,8 +13217,8 @@ :: %+ stag %link ;~ (glue (punt whit)) - (ifix [lac rac] (cool (cash rac) werk)) - (ifix [lit rit] (cash rit)) + (ifix [sel ser] (cool (cash ser) werk)) + (ifix [pal par] (cash par)) == :: :: ![alt text](url) @@ -13214,8 +13226,8 @@ %+ stag %mage ;~ pfix zap ;~ (glue (punt whit)) - (ifix [lac rac] (cash rac)) - (ifix [lit rit] (cash rit)) + (ifix [sel ser] (cash ser)) + (ifix [pal par] (cash par)) == == :: @@ -13243,7 +13255,7 @@ tash:so ;~(pfix dot perd:so) ;~(pfix sig ;~(pose twid:so (easy [%$ %n 0]))) - ;~(pfix cen ;~(pose sym bus pad bar qut nuck:so)) + ;~(pfix cen ;~(pose sym buc pam bar qut nuck:so)) == :: ;~(simu whit (easy ~)) @@ -13313,22 +13325,22 @@ %+ cold [[%hr ~] ~]~ ;~(plug (star ace) hep hep hep (star hep) (just '\0a')) :: - ++ tecs - ;~(plug tec tec tec (just '\0a')) + ++ tics + ;~(plug tic tic tic (just '\0a')) :: ++ fens |= col/@u ~+ =/ ind (stun [(dec col) (dec col)] ace) - =/ ind-tecs ;~(plug ind tecs) + =/ ind-tics ;~(plug ind tics) %+ cook |=(txt/tape `tarp`[[%pre ~] ;/(txt) ~]~) :: :: leading outdent is ok since container may :: have already been parsed and consumed - %+ ifix [;~(plug (star ace) tecs) ind-tecs] + %+ ifix [;~(plug (star ace) tics) ind-tics] %^ stir "" |=({a/tape b/tape} "{a}\0a{b}") ;~ pose %+ ifix [ind (just '\0a')] - ;~(less tecs (star prn)) + ;~(less tics (star prn)) :: (cold "" ;~(plug (star ace) (just '\0a'))) == @@ -13396,11 +13408,11 @@ ;~(pfix com (stag %bsmc wide)) :- '$' ;~ pose - ;~ pfix bus + ;~ pfix buc ;~ pose :: XX all three deprecated :: - (stag %leaf (stag %tas (cold %$ bus))) + (stag %leaf (stag %tas (cold %$ buc))) (stag %leaf (stag %t qut)) (stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so)) == @@ -13411,8 +13423,8 @@ ;~ pose ;~ pfix cen ;~ pose - (stag %leaf (stag %tas (cold %$ bus))) - (stag %leaf (stag %f (cold & pad))) + (stag %leaf (stag %tas (cold %$ buc))) + (stag %leaf (stag %f (cold & pam))) (stag %leaf (stag %f (cold | bar))) (stag %leaf (stag %t qut)) (stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so)) @@ -13422,7 +13434,7 @@ :- '(' %+ cook |=(spec +<) %+ stag %make - %+ ifix [lit rit] + %+ ifix [pal par] ;~ plug wide ;~(pose ;~(pfix ace (most ace wyde)) (easy ~)) @@ -13430,19 +13442,19 @@ :- '{' :: XX deprecated :: - (stag %bscl (ifix [lob rob] (most ace wyde))) + (stag %bscl (ifix [kel ker] (most ace wyde))) :- '[' - (stag %bscl (ifix [lac rac] (most ace wyde))) + (stag %bscl (ifix [sel ser] (most ace wyde))) :- '*' (cold [%base %noun] tar) :- '/' - ;~(pfix net (stag %loop ;~(pose (cold %$ bus) sym))) + ;~(pfix fas (stag %loop ;~(pose (cold %$ buc) sym))) :- '@' - ;~(pfix vat (stag %base (stag %atom mota))) + ;~(pfix pat (stag %base (stag %atom mota))) :- '?' ;~ pose %+ stag %bswt - ;~(pfix wut (ifix [lit rit] (most ace wyde))) + ;~(pfix wut (ifix [pal par] (most ace wyde))) :: (cold [%base %flag] wut) == @@ -13471,7 +13483,7 @@ == :- ['a' 'z'] ;~ pose - (stag %bsts ;~(plug sym ;~(pfix ;~(pose net tis) wyde))) + (stag %bsts ;~(plug sym ;~(pfix ;~(pose fas tis) wyde))) (stag %like (most col rope)) == == @@ -13495,11 +13507,11 @@ ;~(pfix cab (stag %ktcl (stag %bscb wide))) :- '$' ;~ pose - ;~ pfix bus + ;~ pfix buc ;~ pose :: XX: these are all obsolete in hoon 142 :: - (stag %leaf (stag %tas (cold %$ bus))) + (stag %leaf (stag %tas (cold %$ buc))) (stag %leaf (stag %t qut)) (stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so)) == @@ -13510,8 +13522,8 @@ ;~ pfix cen ;~ pose (stag %clsg (sear |~({a/@ud b/tyke} (posh ~ ~ a b)) porc)) - (stag %rock (stag %tas (cold %$ bus))) - (stag %rock (stag %f (cold & pad))) + (stag %rock (stag %tas (cold %$ buc))) + (stag %rock (stag %f (cold & pam))) (stag %rock (stag %f (cold | bar))) (stag %rock (stag %t qut)) (cook (jock &) nuck:so) @@ -13521,26 +13533,26 @@ :- '&' ;~ pose (cook |=(a/wing [%cnts a ~]) rope) - (stag %wtpd ;~(pfix pad (ifix [lit rit] (most ace wide)))) - ;~(plug (stag %rock (stag %f (cold & pad))) wede) - (stag %sand (stag %f (cold & pad))) + (stag %wtpd ;~(pfix pam (ifix [pal par] (most ace wide)))) + ;~(plug (stag %rock (stag %f (cold & pam))) wede) + (stag %sand (stag %f (cold & pam))) == :- '\'' (stag %sand (stag %t qut)) :- '(' - (stag %cncl (ifix [lit rit] (most ace wide))) + (stag %cncl (ifix [pal par] (most ace wide))) :- '{' - (stag %ktcl (stag %bscl (ifix [lob rob] (most ace wyde)))) + (stag %ktcl (stag %bscl (ifix [kel ker] (most ace wyde)))) :- '*' ;~ pose (stag %kttr ;~(pfix tar wyde)) (cold [%base %noun] tar) == :- '@' - ;~(pfix vat (stag %base (stag %atom mota))) + ;~(pfix pat (stag %base (stag %atom mota))) :- '+' ;~ pose - (stag %dtls ;~(pfix lus (ifix [lit rit] wide))) + (stag %dtls ;~(pfix lus (ifix [pal par] wide))) :: %+ cook |= a/(list (list woof)) @@ -13574,14 +13586,14 @@ :- ':' ;~ pfix col ;~ pose - (stag %mccl (ifix [lit rit] (most ace wide))) - ;~(pfix net (stag %mcnt wide)) + (stag %mccl (ifix [pal par] (most ace wide))) + ;~(pfix fas (stag %mcnt wide)) == == :- '=' ;~ pfix tis ;~ pose - (stag %dtts (ifix [lit rit] ;~(glam wide wide))) + (stag %dtts (ifix [pal par] ;~(glam wide wide))) :: %+ sear :: mainly used for +skin formation @@ -13596,7 +13608,7 @@ :- '?' ;~ pose %+ stag %ktcl - (stag %bswt ;~(pfix wut (ifix [lit rit] (most ace wyde)))) + (stag %bswt ;~(pfix wut (ifix [pal par] (most ace wyde)))) :: (cold [%base %flag] wut) == @@ -13608,16 +13620,16 @@ (cold [%base %cell] ket) == :- '`' - ;~ pfix tec + ;~ pfix tic ;~ pose %+ cook |=({a/@ta b/hoon} [%ktls [%sand a 0] [%ktls [%sand %$ 0] b]]) - ;~(pfix vat ;~(plug mota ;~(pfix tec wide))) + ;~(pfix pat ;~(plug mota ;~(pfix tic wide))) ;~ pfix tar - (stag %kthp (stag [%base %noun] ;~(pfix tec wide))) + (stag %kthp (stag [%base %noun] ;~(pfix tic wide))) == - (stag %kthp ;~(plug wyde ;~(pfix tec wide))) - (stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tec wide)))) + (stag %kthp ;~(plug wyde ;~(pfix tic wide))) + (stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tic wide)))) (cook |=(a/hoon [[%rock %n ~] a]) wide) == == @@ -13631,7 +13643,7 @@ :- '|' ;~ pose (cook |=(a/wing [%cnts a ~]) rope) - (stag %wtbr ;~(pfix bar (ifix [lit rit] (most ace wide)))) + (stag %wtbr ;~(pfix bar (ifix [pal par] (most ace wide)))) ;~(plug (stag %rock (stag %f (cold | bar))) wede) (stag %sand (stag %f (cold | bar))) == @@ -13641,11 +13653,11 @@ :: ;~ pfix sig ;~ pose - (stag %clsg (ifix [lac rac] (most ace wide))) + (stag %clsg (ifix [sel ser] (most ace wide))) :: %+ stag %cnsg %+ ifix - [lit rit] + [pal par] ;~(glam rope wide (most ace wide)) :: (cook (jock |) twid:so) @@ -13657,18 +13669,18 @@ :- '/' rood :- '<' - (ifix [led ban] (stag %tell (most ace wide))) + (ifix [gal gar] (stag %tell (most ace wide))) :- '>' - (ifix [ban led] (stag %yell (most ace wide))) + (ifix [gar gal] (stag %yell (most ace wide))) == ++ soil ;~ pose ;~ less (jest '"""') - %+ ifix [yel yel] + %+ ifix [doq doq] %- star ;~ pose - ;~(pfix bas ;~(pose bas yel lob bix:ab)) - ;~(less yel bas lob prn) + ;~(pfix bas ;~(pose bas doq kel bix:ab)) + ;~(less doq bas kel prn) (stag ~ sump) == == @@ -13677,13 +13689,13 @@ [(jest '"""\0a') (jest '\0a"""')] %- star ;~ pose - ;~(pfix bas ;~(pose bas lob bix:ab)) - ;~(less bas lob prn) + ;~(pfix bas ;~(pose bas kel bix:ab)) + ;~(less bas kel prn) ;~(less (jest '\0a"""') (just `@`10)) (stag ~ sump) == == - ++ sump (ifix [lob rob] (stag %cltr (most ace wide))) + ++ sump (ifix [kel ker] (stag %cltr (most ace wide))) ++ norm :: rune regular form |= tol/? |% @@ -13691,18 +13703,18 @@ %- stew ^. stet ^. limo :~ :- '$' - ;~ pfix bus + ;~ pfix buc %- stew ^. stet ^. limo :~ [':' (rune col %bscl exqs)] ['%' (rune cen %bscn exqs)] - ['<' (rune led %bsld exqb)] - ['>' (rune ban %bsbn exqb)] + ['<' (rune gal %bsld exqb)] + ['>' (rune gar %bsbn exqb)] ['^' (rune ket %bskt exqb)] ['~' (rune sig %bssg exqd)] ['|' (rune bar %bsbr exqc)] - ['&' (rune pad %bspd exqc)] - ['@' (rune vat %bsvt exqb)] + ['&' (rune pam %bspd exqc)] + ['@' (rune pat %bsvt exqb)] ['_' (rune cab %bscb expa)] ['-' (rune hep %bshp exqb)] ['=' (rune tis %bsts exqg)] @@ -13749,7 +13761,7 @@ ^. stet ^. limo :~ ['_' (rune cab %brcb exqr)] ['%' (runo cen %brcn ~ expe)] - ['@' (runo vat %brvt ~ expe)] + ['@' (runo pat %brvt ~ expe)] [':' (rune col %brcl expb)] ['.' (rune dot %brdt expa)] ['-' (rune hep %brhp expa)] @@ -13758,21 +13770,21 @@ ['*' (rune tar %brtr exqc)] ['=' (rune tis %brts exqc)] ['?' (rune wut %brwt expa)] - ['$' (rune bus %brbs exqe)] + ['$' (rune buc %brbs exqe)] == == :- '$' - ;~ pfix bus + ;~ pfix buc %- stew ^. stet ^. limo - :~ ['@' (stag %ktcl (rune vat %bsvt exqb))] + :~ ['@' (stag %ktcl (rune pat %bsvt exqb))] ['_' (stag %ktcl (rune cab %bscb expa))] [':' (stag %ktcl (rune col %bscl exqs))] ['%' (stag %ktcl (rune cen %bscn exqs))] - ['<' (stag %ktcl (rune led %bsld exqb))] - ['>' (stag %ktcl (rune ban %bsbn exqb))] + ['<' (stag %ktcl (rune gal %bsld exqb))] + ['>' (stag %ktcl (rune gar %bsbn exqb))] ['|' (stag %ktcl (rune bar %bsbr exqc))] - ['&' (stag %ktcl (rune pad %bspd exqc))] + ['&' (stag %ktcl (rune pam %bspd exqc))] ['^' (stag %ktcl (rune ket %bskt exqb))] ['~' (stag %ktcl (rune sig %bssg exqd))] ['-' (stag %ktcl (rune hep %bshp exqb))] @@ -13828,7 +13840,7 @@ ['.' (rune dot %ktdt expb)] ['-' (rune hep %kthp exqc)] ['+' (rune lus %ktls expb)] - ['&' (rune pad %ktpd expa)] + ['&' (rune pam %ktpd expa)] ['~' (rune sig %ktsg expa)] ['=' (rune tis %ktts expj)] ['?' (rune wut %ktwt expa)] @@ -13842,14 +13854,14 @@ %- stew ^. stet ^. limo :~ ['|' (rune bar %sgbr expb)] - ['$' (rune bus %sgbs expf)] + ['$' (rune buc %sgbs expf)] ['_' (rune cab %sgcb expb)] ['%' (rune cen %sgcn hind)] - ['/' (rune net %sgnt hine)] - ['<' (rune led %sgld hinb)] - ['>' (rune ban %sgbn hinb)] + ['/' (rune fas %sgnt hine)] + ['<' (rune gal %sgld hinb)] + ['>' (rune gar %sgbn hinb)] ['+' (rune lus %sgls hinc)] - ['&' (rune pad %sgpd hinf)] + ['&' (rune pam %sgpd hinf)] ['?' (rune wut %sgwt hing)] ['=' (rune tis %sgts expb)] ['!' (rune zap %sgzp expb)] @@ -13860,7 +13872,7 @@ %- stew ^. stet ^. limo :~ [':' (rune col %mccl expi)] - ['/' (rune net %mcnt expa)] + ['/' (rune fas %mcnt expa)] ['<' (rune gal %mcgl exp1)] ['~' (rune sig %mcsg expi)] [';' (rune mic %mcmc exqc)] @@ -13875,10 +13887,10 @@ ['?' (rune wut %tswt expw)] ['^' (rune ket %tskt expt)] [':' (rune col %tscl expp)] - ['/' (rune net %tsnt expo)] + ['/' (rune fas %tsnt expo)] [';' (rune mic %tsmc expo)] - ['<' (rune led %tsld expb)] - ['>' (rune ban %tsbn expb)] + ['<' (rune gal %tsld expb)] + ['>' (rune gar %tsbn expb)] ['-' (rune hep %tshp expb)] ['*' (rune tar %tstr expg)] [',' (rune com %tscm expb)] @@ -13893,15 +13905,15 @@ :~ ['|' (rune bar %wtbr exps)] [':' (rune col %wtcl expc)] ['.' (rune dot %wtdt expc)] - ['<' (rune led %wtld expb)] - ['>' (rune ban %wtbn expb)] + ['<' (rune gal %wtld expb)] + ['>' (rune gar %wtbn expb)] ['-' ;~(pfix hep (toad txhp))] ['^' ;~(pfix ket (toad tkkt))] ['=' ;~(pfix tis (toad txts))] ['#' ;~(pfix hax (toad txhx))] ['+' ;~(pfix lus (toad txls))] - ['&' (rune pad %wtpd exps)] - ['@' ;~(pfix vat (toad tkvt))] + ['&' (rune pam %wtpd exps)] + ['@' ;~(pfix pat (toad tkvt))] ['~' ;~(pfix sig (toad tksg))] ['!' (rune zap %wtzp expa)] == @@ -13914,9 +13926,9 @@ ['.' ;~(pfix dot (toad |.(loaf(bug |))))] [',' (rune com %zpcm expb)] [';' (rune mic %zpmc expb)] - ['>' (rune ban %zpbn expa)] - ['<' (rune led %zpld exqc)] - ['@' (rune vat %zpvt expy)] + ['>' (rune gar %zpbn expa)] + ['<' (rune gal %zpld exqc)] + ['@' (rune pat %zpvt expy)] ['=' (rune tis %zpts expa)] ['?' (rune wut %zpwt hinh)] == @@ -13931,7 +13943,7 @@ (jest '+-') :: XX deprecated == ;~ plug - ;~(pfix gap ;~(pose (cold %$ bus) sym)) + ;~(pfix gap ;~(pose (cold %$ buc) sym)) ;~(pfix gap loaf) == == @@ -13965,14 +13977,14 @@ ;~ pfix (jest '+*') ;~ plug ;~(pfix gap sym) - ;~(pfix gap (ifix [lac rac] (most ace sym))) + ;~(pfix gap (ifix [sel ser] (most ace sym))) ;~(pfix gap loan) == == == :: parses a or [a b c] or a b c == ++ lynx - =/ wid (ifix [lac rac] (most ace sym)) + =/ wid (ifix [sel ser] (most ace sym)) =/ tal ;~ sfix (most gap sym) @@ -14052,7 +14064,7 @@ ++ toad :: untrap parser exp =+ har=expa |@ ++ $ - =+ dur=(ifix [lit rit] $:har(tol |)) + =+ dur=(ifix [pal par] $:har(tol |)) ?:(tol ;~(pose ;~(pfix gap $:har(tol &)) dur) dur) -- :: @@ -14203,12 +14215,12 @@ ++ hine |.(;~(gunk bonk loaf)) :: jet-hint and hoon ++ hinf |. :: 0-3 >s, two hoons ;~ pose - ;~(gunk (cook lent (stun [1 3] ban)) loaf loaf) + ;~(gunk (cook lent (stun [1 3] gar)) loaf loaf) (stag 0 ;~(gunk loaf loaf)) == ++ hing |. :: 0-3 >s, three hoons ;~ pose - ;~(gunk (cook lent (stun [1 3] ban)) loaf loaf loaf) + ;~(gunk (cook lent (stun [1 3] gar)) loaf loaf loaf) (stag 0 ;~(gunk loaf loaf loaf)) == ++ bonk :: jet signature @@ -14224,7 +14236,7 @@ ;~ gunk ;~ pose dem - (ifix [lac rac] ;~(plug dem ;~(pfix ace dem))) + (ifix [sel ser] ;~(plug dem ;~(pfix ace dem))) == loaf == @@ -14237,7 +14249,7 @@ ;~ pose (cold ~ sig) %+ ifix - ?:(tol [;~(plug duz gap) ;~(plug gap duz)] [lit rit]) + ?:(tol [;~(plug duz gap) ;~(plug gap duz)] [pal par]) (more mash ;~(gunk ;~(pfix cen sym) loaf)) == -- @@ -14275,7 +14287,7 @@ ;~(plug (cold %ket ket) wide) ;~ plug (easy %lit) - (ifix [lit rit] lobo) + (ifix [pal par] lobo) == == == @@ -14287,7 +14299,7 @@ %+ cook |=(hoon +<) %+ stag %cltr %+ ifix - [;~(plug lac gap) ;~(plug gap rac)] + [;~(plug sel gap) ;~(plug gap ser)] (most gap tall) :: ++ ropa (most col rope) @@ -14300,13 +14312,13 @@ (cold [%| 0 ~] com) %+ cook |=({a/(list) b/term} ?~(a b [%| (lent a) `b])) - ;~(plug (star ket) ;~(pose sym (cold %$ bus))) + ;~(plug (star ket) ;~(pose sym (cold %$ buc))) :: %+ cook |=(a/axis [%& a]) ;~ pose ;~(pfix lus dim:ag) - ;~(pfix pad (cook |=(a/@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag)) + ;~(pfix pam (cook |=(a/@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag)) ;~(pfix bar (cook |=(a/@ ?:(=(0 a) 1 +((mul 2 $(a (dec a)))))) dim:ag)) ven (cold 1 dot) @@ -14332,9 +14344,7 @@ term [%name term %spec u.unit %base %noun] ;~ plug sym - :: XX: net deprecated - :: - (punt ;~(pfix ;~(pose net tis) wyde)) + (punt ;~(pfix ;~(pose fas tis) wyde)) == :: %+ cook @@ -14352,7 +14362,7 @@ ++ wede :: wide bulb :: XX: lus deprecated :: - ;~(pfix ;~(pose lus net) wide) + ;~(pfix ;~(pose lus fas) wide) ++ wide :: full wide form %+ knee *hoon |.(~+((wart ;~(pose expression:(norm |) long apex:(sail |))))) diff --git a/pkg/arvo/sys/zuse.hoon b/pkg/arvo/sys/zuse.hoon index 4dc733ca8f..218d3852d5 100644 --- a/pkg/arvo/sys/zuse.hoon +++ b/pkg/arvo/sys/zuse.hoon @@ -5636,7 +5636,7 @@ [(rash a fel) b] :: :: ++pa:dejs:format ++ pa :: string as path - (su ;~(pfix net (more net urs:ab))) + (su ;~(pfix fas (more fas urs:ab))) :: :: ++pe:dejs:format ++ pe :: prefix |* {pre/* wit/fist} @@ -6198,7 +6198,7 @@ :: :: ++abox:de-json:html ++ abox :: array %+ stag %a - (ifix [lac (wish rac)] (more (wish com) apex)) + (ifix [sel (wish ser)] (more (wish com) apex)) :: :: ++apex:de-json:html ++ apex :: any value %+ knee *json |. ~+ @@ -6230,7 +6230,7 @@ =* wow `(map @t @)`(malt lip) (sear ~(get by wow) low) =* tuf ;~(pfix (just 'u') (cook tuft qix:ab)) - ;~(pose yel net say bas loo tuf) + ;~(pose doq fas soq bas loo tuf) == :: :: ++expo:de-json:html ++ expo :: exponent @@ -6244,7 +6244,7 @@ ;~(plug dot digs) :: :: ++jcha:de-json:html ++ jcha :: string character - ;~(pose ;~(less yel bas prn) esca) + ;~(pose ;~(less doq bas prn) esca) :: :: ++mayb:de-json:html ++ mayb :: optional |*(bus/rule ;~(pose bus (easy ~))) @@ -6261,7 +6261,7 @@ == :: :: ++obje:de-json:html ++ obje :: object list - %+ ifix [(wish leb) (wish reb)] + %+ ifix [(wish kel) (wish ker)] (more (wish com) pear) :: :: ++obox:de-json:html ++ obox :: object @@ -6275,7 +6275,7 @@ (cook |=(a/@ [a ~]) bus) :: :: ++stri:de-json:html ++ stri :: string - (cook crip (ifix [yel yel] (star jcha))) + (cook crip (ifix [doq doq] (star jcha))) :: :: ++tops:de-json:html ++ tops :: strict value ;~(pose abox obox) @@ -6384,14 +6384,14 @@ ;~(pfix (plus whit) name) ;~ pose %+ ifix - :_ yel - ;~(plug (ifix [. .]:(star whit) tis) yel) - (star ;~(less yel escp)) + :_ doq + ;~(plug (ifix [. .]:(star whit) tis) doq) + (star ;~(less doq escp)) :: %+ ifix - :_ say - ;~(plug (ifix [. .]:(star whit) tis) say) - (star ;~(less say escp)) + :_ soq + ;~(plug (ifix [. .]:(star whit) tis) soq) + (star ;~(less soq escp)) :: (easy ~) == @@ -6407,7 +6407,7 @@ :: :: ++chrd:de-xml:html ++ chrd :: character data %+ cook |=(a/tape ^-(mars ;/(a))) - (plus ;~(less yel ;~(pose (just `@`10) escp))) + (plus ;~(less doq ;~(pose (just `@`10) escp))) :: :: ++comt:de-xml:html ++ comt :: comments =- (ifix [(jest '')] (star -)) @@ -6424,10 +6424,10 @@ ;~(less (jest '?>') prn) :: :: ++escp:de-xml:html ++ escp :: - ;~(pose ;~(less led ban pad prn) enty) + ;~(pose ;~(less gal gar pam prn) enty) :: :: ++enty:de-xml:html ++ enty :: entity - %+ ifix pad^mic + %+ ifix pam^mic ;~ pose =+ def=^+(ent (my:nl [%gt '>'] [%lt '<'] [%amp '&'] [%quot '"'] ~)) %+ sear ~(get by (~(uni by def) ent)) @@ -6443,7 +6443,7 @@ ;~(plug ;~(plug name attr) (cold ~ (star whit))) :: :: ++head:de-xml:html ++ head :: opening tag - (ifix [gal ban] ;~(plug name attr)) + (ifix [gal gar] ;~(plug name attr)) :: :: ++many:de-xml:html ++ many :: contents ;~(pfix (star comt) (star ;~(sfix ;~(pose apex chrd cdat) (star comt)))) @@ -6458,7 +6458,7 @@ ;~(pose ;~(plug ;~(sfix chx col) chx) chx) :: :: ++tail:de-xml:html ++ tail :: closing tag - (ifix [(jest '