diff --git a/neo/hoon.hoon b/neo/hoon.hoon deleted file mode 100644 index eb2a2cc4e..000000000 --- a/neo/hoon.hoon +++ /dev/null @@ -1,10847 +0,0 @@ -:: :: -:::: /sys/hoon :: - :: :: -~> %slog.[0 leaf+"hoon-assembly"] -=< ride -=> %144 => -:: :: -:::: 0: version stub :: - :: :: -~% %k.144 ~ ~ :: -|% -++ hoon + --- => -:: :: -:::: 1: layer one :: - :: :: - :: 1a: basic arithmetic :: - :: 1b: tree addressing :: - :: 1c: molds and mold builders :: - :: -~% %one + ~ -|% -:: :: -:::: 1a: unsigned arithmetic :: - :: -++ add :: unsigned addition - ~/ %add - |= {a/@ b/@} - ^- @ - ?: =(0 a) b - $(a (dec a), b +(b)) -:: -++ dec :: unsigned decrement - ~/ %dec - |= a/@ - ~_ leaf+"decrement-underflow" - ?< =(0 a) - =+ b=0 - |- ^- @ - ?: =(a +(b)) b - $(b +(b)) -:: -++ div :: unsigned divide - ~/ %div - =+ [a=`@`1 b=`@`1] - |. - ^- @ - ~_ leaf+"divide-by-zero" - ?< =(0 b) - =+ c=0 - |- - ?: (lth a b) c - $(a (sub a b), c +(c)) -:: -++ dvr :: divide w/remainder - ~/ %dvr - |= {a/@ b/@} - ^- {p/@ q/@} - [(div a b) (mod a b)] -:: -++ gte :: unsigned greater/eq - ~/ %gte - |= {a/@ b/@} - ^- ? - !(lth a b) -:: -++ gth :: unsigned greater - ~/ %gth - |= {a/@ b/@} - ^- ? - !(lte a b) -:: -++ lte :: unsigned less/eq - ~/ %lte - |= {a/@ b/@} - |(=(a b) (lth a b)) -:: -++ lth :: unsigned less - ~/ %lth - |= {a/@ b/@} - ^- ? - ?& !=(a b) - |- - ?| =(0 a) - ?& !=(0 b) - $(a (dec a), b (dec b)) - == == == -:: -++ max :: unsigned maximum - ~/ %max - |= {a/@ b/@} - ^- @ - ?: (gth a b) a - b -:: -++ min :: unsigned minimum - ~/ %min - |= {a/@ b/@} - ^- @ - ?: (lth a b) a - b -:: -++ mod :: unsigned modulus - ~/ %mod - |: [a=`@`1 b=`@`1] - ^- @ - ?< =(0 b) - (sub a (mul b (div a b))) -:: -++ mul :: unsigned multiply - ~/ %mul - |: [a=`@`1 b=`@`1] - ^- @ - =+ c=0 - |- - ?: =(0 a) c - $(a (dec a), c (add b c)) -:: -++ sub :: subtract - ~/ %sub - |= {a/@ b/@} - ~_ leaf+"subtract-underflow" - ^- @ - ?: =(0 b) a - $(a (dec a), b (dec b)) -:: :: -:::: 1b: tree addressing :: - :: :: - :: cap, mas, peg :: - :: -++ cap :: fragment head - ~/ %cap - |= a/@ - ^- ?($2 $3) - ?- a - $2 %2 - $3 %3 - ?($0 $1) !! - * $(a (div a 2)) - == -:: -++ mas :: fragment body - ~/ %mas - |= a/@ - ^- @ - ?- a - $1 !! - $2 1 - $3 1 - * (add (mod a 2) (mul $(a (div a 2)) 2)) - == -:: -++ peg :: fragment compose - ~/ %peg - |= {a/@ b/@} - ?< =(0 a) - ^- @ - ?- b - $1 a - $2 (mul a 2) - $3 +((mul a 2)) - * (add (mod b 2) (mul $(b (div b 2)) 2)) - == -:: :: -:::: 1c: ideal containers :: - :: :: - :: -++ ache |*({a/mold b/mold} $%({$| p/b} {$& p/a})) :: a or b, b default -++ bloq @ :: bitblock, eg 3=byte -++ each |*({a/mold b/mold} $%({$& p/a} {$| p/b})) :: a or b, a default -++ gate $-(* *) :: generic mold -++ list |*(a/mold $@($~ {i/a t/(list a)})) :: nullterminated list -++ lone |*(a/mold p/a) :: 1-tuple -++ mold gate :: normalizing gate -++ pair |*({a/mold b/mold} {p/a q/b}) :: 2-tuple -++ pole |*(a/mold $@($~ {a (pole a)})) :: faceless list -++ qual |* {a/mold b/mold c/mold d/mold} :: 4-tuple - {p/a q/b r/c s/d} :: -++ quip |*({a/mold b/mold} {(list a) b}) :: list-with for sip -++ trap |*(a/mold _|?(*a)) :: producer -++ tree |*(a/mold $@($~ {n/a l/(tree a) r/(tree a)})) :: binary tree -++ trel |*({a/mold b/mold c/mold} {p/a q/b r/c}) :: 3-tuple -++ unit |*(a/mold $@($~ {$~ u/a})) :: maybe --- => -:: :: -:::: 2: layer two :: - :: :: - :: 2a: unit logic :: - :: 2b: list logic :: - :: 2c: bit arithmetic :: - :: 2d: bit logic :: - :: 2e: insecure hashing :: - :: 2f: noun ordering :: - :: 2g: unsigned powers :: - :: 2h: set logic :: - :: 2i: map logic :: - :: 2j: jar and jug logic :: - :: 2k: queue logic :: - :: 2l: container from container :: - :: 2m: container from noun :: - :: 2n: functional hacks :: - :: 2o: normalizing containers :: - :: 2p: serialization :: - :: 2q: molds and mold builders :: - :: -~% %two + ~ -|% -:: :: -:::: 2a: unit logic :: - :: :: - :: biff, bind, bond, both, clap, drop, :: - :: fall, flit, lift, mate, need, some :: - :: -++ biff :: apply - |* {a/(unit) b/$-(* (unit))} - ?~ a ~ - (b u.a) -:: -++ bind :: argue - |* {a/(unit) b/$-(* *)} - ?~ a ~ - [~ u=(b u.a)] -:: -++ bond :: replace - |* a/(trap) - |* b/(unit) - ?~ b $:a - u.b -:: -++ both :: all the above - |* {a/(unit) b/(unit)} - ?~ a ~ - ?~ b ~ - [~ u=[u.a u.b]] -:: -++ clap :: combine - |* {a/(unit) b/(unit) c/_|=(^ +<-)} - ?~ a b - ?~ b a - [~ u=(c u.a u.b)] -:: -++ drop :: enlist - |* a/(unit) - ?~ a ~ - [i=u.a t=~] -:: -++ fall :: default - |* {a/(unit) b/*} - ?~(a b u.a) -:: -++ flit :: make filter - |* a/$-(* ?) - |* b/* - ?.((a b) ~ [~ u=b]) -:: -++ hunt :: first of units - |* {ord/$-({* *} ?) one/(unit) two/(unit)} - ^- (unit ?(_,.+.one _,.+.two)) - ?~ one two - ?~ two one - ?:((ord ,.+.one ,.+.two) one two) -:: -++ lift :: lift mold (fmap) - |* a/mold :: flipped - |* b/(unit) :: curried - (bind b a) :: bind -:: -++ mate :: choose - |* {a/(unit) b/(unit)} - ?~ b a - ?~ a b - ?.(=(u.a u.b) ~>(%mean.[%leaf "mate"] !!) a) -:: -++ need :: demand - |* a/(unit) - ?~ a ~>(%mean.[%leaf "need"] !!) - u.a -:: -++ some :: lift (pure) - |* a/* - [~ u=a] -:: -:::: 2b: list logic :: - :: :: - :: :: -:: -++ fand :: all indices - ~/ %fand - |= {nedl/(list) hstk/(list)} - =| i/@ud - =| fnd/(list @ud) - |- ^+ fnd - =+ [n=nedl h=hstk] - |- - ?: |(?=($~ n) ?=($~ h)) - (flop fnd) - ?: =(i.n i.h) - ?~ t.n - ^$(i +(i), hstk +.hstk, fnd [i fnd]) - $(n t.n, h t.h) - ^$(i +(i), hstk +.hstk) -:: -++ find :: first index - ~/ %find - |= {nedl/(list) hstk/(list)} - =| i/@ud - |- ^- (unit @ud) - =+ [n=nedl h=hstk] - |- - ?: |(?=($~ n) ?=($~ h)) - ~ - ?: =(i.n i.h) - ?~ t.n - `i - $(n t.n, h t.h) - ^$(i +(i), hstk +.hstk) -:: -++ flop :: reverse - ~/ %flop - |* a/(list) - => .(a (homo a)) - ^+ a - =+ b=`_a`~ - |- - ?~ a b - $(a t.a, b [i.a b]) -:: -++ gulf :: range inclusive - |= {a/@ b/@} - ^- (list @) - ?:(=(a +(b)) ~ [a $(a +(a))]) -:: -++ homo :: homogenize - |* a/(list) - ^+ =< $ - |% +- $ ?:(*? ~ [i=(snag 0 a) t=$]) - -- - a -:: -++ lent :: length - ~/ %lent - |= a/(list) - ^- @ - =+ b=0 - |- - ?~ a b - $(a t.a, b +(b)) -:: -++ levy - ~/ %levy :: all of - |* {a/(list) b/$-(* ?)} - |- ^- ? - ?~ a & - ?. (b i.a) | - $(a t.a) -:: -++ lien :: some of - ~/ %lien - |* {a/(list) b/$-(* ?)} - |- ^- ? - ?~ a | - ?: (b i.a) & - $(a t.a) -:: -++ limo :: listify - |* a/* - ^+ =< $ - |% +- $ ?~(a ~ ?:(*? [i=-.a t=$] $(a +.a))) - -- - a -:: -++ murn :: maybe transform - ~/ %murn - |* {a/(list) b/$-(* (unit))} - |- - ?~ a ~ - =+ c=(b i.a) - ?~ c - $(a t.a) - [i=u.c t=$(a t.a)] -:: -++ oust :: remove - ~/ %oust - |* {{a/@ b/@} c/(list)} - (weld (scag a c) (slag (add a b) c)) -:: -++ reap :: replicate - ~/ %reap - |* {a/@ b/*} - |- ^- (list _b) - ?~ a ~ - [b $(a (dec a))] -:: -++ reel :: right fold - ~/ %reel - |* {a/(list) b/_|=({* *} +<+)} - |- ^+ ,.+<+.b - ?~ a - +<+.b - (b i.a $(a t.a)) -:: -++ roll :: left fold - ~/ %roll - |* {a/(list) b/_|=({* *} +<+)} - |- ^+ ,.+<+.b - ?~ a - +<+.b - $(a t.a, b b(+<+ (b i.a +<+.b))) -:: -++ scag :: prefix - ~/ %scag - |* {a/@ b/(list)} - |- ^+ b - ?: |(?=($~ b) =(0 a)) ~ - [i.b $(b t.b, a (dec a))] -:: -++ skid :: separate - ~/ %skid - |* {a/(list) b/$-(* ?)} - |- ^+ [p=a q=a] - ?~ a [~ ~] - =+ c=$(a t.a) - ?:((b i.a) [[i.a p.c] q.c] [p.c [i.a q.c]]) -:: -++ skim :: only - ~/ %skim - |* {a/(list) b/$-(* ?)} - |- - ^+ a - ?~ a ~ - ?:((b i.a) [i.a $(a t.a)] $(a t.a)) -:: -++ skip :: except - ~/ %skip - |* {a/(list) b/$-(* ?)} - |- - ^+ a - ?~ a ~ - ?:((b i.a) $(a t.a) [i.a $(a t.a)]) -:: -++ slag :: suffix - ~/ %slag - |* {a/@ b/(list)} - |- ^+ b - ?: =(0 a) b - ?~ b ~ - $(b t.b, a (dec a)) -:: -++ snag :: index - ~/ %snag - |* {a/@ b/(list)} - |- ^+ ?>(?=(^ b) i.b) - ?~ b - ~_ leaf+"snag-fail" - !! - ?: =(0 a) i.b - $(b t.b, a (dec a)) -:: -++ sort !. :: quicksort - ~/ %sort - |* {a/(list) b/$-({* *} ?)} - => .(a ^.(homo a)) - |- ^+ a - ?~ a ~ - %+ weld - $(a (skim t.a |=(c/_i.a (b c i.a)))) - ^+ t.a - [i.a $(a (skim t.a |=(c/_i.a !(b c i.a))))] -:: -++ spin - |* {a/(list) b/_|=({* *} [** +<+]) c/*} - :: ?< ?=($-([_?<(?=($~ a) i.a) _c] [* _c]) b) - |- - ?~ a - ~ - =+ v=(b i.a c) - [i=-.v t=$(a t.a, c +.v)] -:: -++ spun - |* {a/(list) b/_|=({* *} [** +<+])} - =| c/_+<+.b - |- - ?~ a - ~ - =+ v=(b i.a c) - [i=-.v t=$(a t.a, c +.v)] -:: -++ swag :: slice - |* {{a/@ b/@} c/(list)} - (scag +<-> (slag +<-< c)) -:: -++ turn :: transform - ~/ %turn - |* {a/(list) b/$-(* *)} - |- - ?~ a ~ - [i=(b i.a) t=$(a t.a)] -:: -++ weld :: concatenate - ~/ %weld - |* {a/(list) b/(list)} - => .(a ^.(homo a), b ^.(homo b)) - |- ^+ b - ?~ a b - [i.a $(a t.a)] -:: -++ welp :: faceless weld - =| {* *} - |% - +- $ - ?~ +<- - +<-(. +<+) - +<-(+ $(+<- +<->)) - -- -:: -++ zing :: promote - =| * - |% - +- $ - ?~ +< - +< - (welp +<- $(+< +<+)) - -- -:: :: -:::: 2c: bit arithmetic :: - :: :: - :: -++ bex :: binary exponent - ~/ %bex - |= a/@ - ^- @ - ?: =(0 a) 1 - (mul 2 $(a (dec a))) -:: -++ can :: assemble - ~/ %can - |= {a/bloq b/(list {p/@u q/@})} - ^- @ - ?~ b 0 - (add (end a p.i.b q.i.b) (lsh a p.i.b $(b t.b))) -:: -++ cat :: concatenate - ~/ %cat - |= {a/bloq b/@ c/@} - (add (lsh a (met a b) c) b) -:: -++ cut :: slice - ~/ %cut - |= {a/bloq {b/@u c/@u} d/@} - (end a c (rsh a b d)) -:: -++ end :: tail - ~/ %end - |= {a/bloq b/@u c/@} - (mod c (bex (mul (bex a) b))) -:: -++ fil :: fill bloqstream - |= {a/bloq b/@u c/@} - =+ n=0 - =+ d=c - |- ^- @ - ?: =(n b) - (rsh a 1 d) - $(d (add c (lsh a 1 d)), n +(n)) -:: -++ lsh :: left-shift - ~/ %lsh - |= {a/bloq b/@u c/@} - (mul (bex (mul (bex a) b)) c) -:: -++ met :: measure - ~/ %met - |= {a/bloq b/@} - ^- @ - =+ c=0 - |- - ?: =(0 b) c - $(b (rsh a 1 b), c +(c)) -:: -++ rap :: assemble nonzero - ~/ %rap - |= {a/bloq b/(list @)} - ^- @ - ?~ b 0 - (cat a i.b $(b t.b)) -:: -++ rep :: assemble single - ~/ %rep - |= {a/bloq b/(list @)} - ^- @ - =+ c=0 - |- - ?~ b 0 - (add (lsh a c (end a 1 i.b)) $(c +(c), b t.b)) -:: -++ rip :: disassemble - ~/ %rip - |= {a/bloq b/@} - ^- (list @) - ?: =(0 b) ~ - [(end a 1 b) $(b (rsh a 1 b))] -:: -++ rsh :: right-shift - ~/ %rsh - |= {a/bloq b/@u c/@} - (div c (bex (mul (bex a) b))) -:: -++ swp |=({a/bloq b/@} (rep a (flop (rip a b)))) :: reverse bloq order -++ xeb :: binary logarithm - ~/ %xeb - |= a/@ - ^- @ - (met 0 a) -:: -++ fe :: modulo bloq - |_ a/bloq - ++ dif :: difference - |=({b/@ c/@} (sit (sub (add out (sit b)) (sit c)))) - ++ inv |=(b/@ (sub (dec out) (sit b))) :: inverse - ++ net |= b/@ ^- @ :: flip byte endianness - => .(b (sit b)) - ?: (lte a 3) - b - =+ c=(dec a) - %+ con - (lsh c 1 $(a c, b (cut c [0 1] b))) - $(a c, b (cut c [1 1] b)) - ++ out (bex (bex a)) :: mod value - ++ rol |= {b/bloq c/@ d/@} ^- @ :: roll left - =+ e=(sit d) - =+ f=(bex (sub a b)) - =+ g=(mod c f) - (sit (con (lsh b g e) (rsh b (sub f g) e))) - ++ ror |= {b/bloq c/@ d/@} ^- @ :: roll right - =+ e=(sit d) - =+ f=(bex (sub a b)) - =+ g=(mod c f) - (sit (con (rsh b g e) (lsh b (sub f g) e))) - ++ sum |=({b/@ c/@} (sit (add b c))) :: wrapping add - ++ sit |=(b/@ (end a 1 b)) :: enforce modulo - -- -:: :: -:::: 2d: bit logic :: - :: :: - :: -++ con :: binary or - ~/ %con - |= {a/@ b/@} - =+ [c=0 d=0] - |- ^- @ - ?: ?&(=(0 a) =(0 b)) d - %= $ - a (rsh 0 1 a) - b (rsh 0 1 b) - c +(c) - d %+ add d - %^ lsh 0 c - ?& =(0 (end 0 1 a)) - =(0 (end 0 1 b)) - == - == -:: -++ dis :: binary and - ~/ %dis - |= {a/@ b/@} - =| {c/@ d/@} - |- ^- @ - ?: ?|(=(0 a) =(0 b)) d - %= $ - a (rsh 0 1 a) - b (rsh 0 1 b) - c +(c) - d %+ add d - %^ lsh 0 c - ?| =(0 (end 0 1 a)) - =(0 (end 0 1 b)) - == - == -:: -++ mix :: binary xor - ~/ %mix - |= {a/@ b/@} - ^- @ - =+ [c=0 d=0] - |- - ?: ?&(=(0 a) =(0 b)) d - %= $ - a (rsh 0 1 a) - b (rsh 0 1 b) - c +(c) - d (add d (lsh 0 c =((end 0 1 a) (end 0 1 b)))) - == -:: -++ not |= {a/bloq b/@ c/@} :: binary not (sized) - (mix c (dec (bex (mul b (bex a))))) -:: :: -:::: 2e: insecure hashing :: - :: :: - :: -++ fnv |=(a/@ (end 5 1 (mul 16.777.619 a))) :: FNV scrambler -:: -++ muk :: standard murmur3 - ~% %muk ..muk ~ - =+ ~(. fe 5) - |= {syd/@ len/@ key/@} - ?> &((lte (met 5 syd) 1) (lte (met 0 len) 31)) - =/ pad (sub len (met 3 key)) - =/ data (weld (rip 3 key) (reap pad 0)) - =/ nblocks (div len 4) :: intentionally off-by-one - =/ h1 syd - =+ [c1=0xcc9e.2d51 c2=0x1b87.3593] - =/ blocks (rip 5 key) - =/ i nblocks - =. h1 =/ hi h1 |- - ?: =(0 i) hi - =/ k1 (snag (sub nblocks i) blocks) :: negative array index - =. k1 (sit (mul k1 c1)) - =. k1 (rol 0 15 k1) - =. k1 (sit (mul k1 c2)) - =. hi (mix hi k1) - =. hi (rol 0 13 hi) - =. hi (sum (sit (mul hi 5)) 0xe654.6b64) - $(i (dec i)) - =/ tail (slag (mul 4 nblocks) data) - =/ k1 0 - =/ tlen (dis len 3) - =. h1 - ?+ tlen h1 :: fallthrough switch - $3 =. k1 (mix k1 (lsh 0 16 (snag 2 tail))) - =. k1 (mix k1 (lsh 0 8 (snag 1 tail))) - =. k1 (mix k1 (snag 0 tail)) - =. k1 (sit (mul k1 c1)) - =. k1 (rol 0 15 k1) - =. k1 (sit (mul k1 c2)) - (mix h1 k1) - $2 =. k1 (mix k1 (lsh 0 8 (snag 1 tail))) - =. k1 (mix k1 (snag 0 tail)) - =. k1 (sit (mul k1 c1)) - =. k1 (rol 0 15 k1) - =. k1 (sit (mul k1 c2)) - (mix h1 k1) - $1 =. k1 (mix k1 (snag 0 tail)) - =. k1 (sit (mul k1 c1)) - =. k1 (rol 0 15 k1) - =. k1 (sit (mul k1 c2)) - (mix h1 k1) - == - =. h1 (mix h1 len) - |^ (fmix32 h1) - ++ fmix32 - |= h/@ - =. h (mix h (rsh 0 16 h)) - =. h (sit (mul h 0x85eb.ca6b)) - =. h (mix h (rsh 0 13 h)) - =. h (sit (mul h 0xc2b2.ae35)) - =. h (mix h (rsh 0 16 h)) - h - -- - :: - ++ mum :: mug with murmur3 - ~/ %mum - |= a/* - |^ (trim ?@(a a (mix $(a -.a) (mix 0x7fff.ffff $(a +.a))))) - ++ trim :: 31-bit nonzero - |= key/@ - =+ syd=0xcafe.babe - |- ^- @ - =+ haz=(muk syd (met 3 key) key) - =+ ham=(mix (rsh 0 31 haz) (end 0 31 haz)) - ?.(=(0 ham) ham $(syd +(syd))) - -- -:: -++ mug :: 31bit nonzero FNV1a - ~/ %mug - |= a/* - ?^ a - =+ b=[p=$(a -.a) q=$(a +.a)] - |- ^- @ - =+ c=(fnv (mix p.b (fnv q.b))) - =+ d=(mix (rsh 0 31 c) (end 0 31 c)) - ?. =(0 d) d - $(q.b +(q.b)) - =+ b=2.166.136.261 - |- ^- @ - =+ c=b - =+ [d=0 e=(met 3 a)] - |- ^- @ - ?: =(d e) - =+ f=(mix (rsh 0 31 c) (end 0 31 c)) - ?. =(0 f) f - ^$(b +(b)) - $(c (fnv (mix c (cut 3 [d 1] a))), d +(d)) -:: :: -:::: 2f: noun ordering :: - :: :: - :: aor, dor, gor, hor, lor, vor :: - :: -++ aor :: a-order - ~/ %aor - |= {a/* b/*} - ^- ? - ?: =(a b) & - ?. ?=(@ a) - ?: ?=(@ b) | - ?: =(-.a -.b) - $(a +.a, b +.b) - $(a -.a, b -.b) - ?. ?=(@ b) & - |- - =+ [c=(end 3 1 a) d=(end 3 1 b)] - ?: =(c d) - $(a (rsh 3 1 a), b (rsh 3 1 b)) - (lth c d) -:: -++ dor :: d-order - ~/ %dor - |= {a/* b/*} - ^- ? - ?: =(a b) & - ?. ?=(@ a) - ?: ?=(@ b) | - ?: =(-.a -.b) - $(a +.a, b +.b) - $(a -.a, b -.b) - ?. ?=(@ b) & - (lth a b) -:: -++ gor :: g-order - ~/ %gor - |= {a/* b/*} - ^- ? - =+ [c=(mug a) d=(mug b)] - ?: =(c d) - (dor a b) - (lth c d) -:: -++ hor :: h-order - ~/ %hor - |= {a/* b/*} - ^- ? - ?: ?=(@ a) - ?. ?=(@ b) & - (gor a b) - ?: ?=(@ b) | - ?: =(-.a -.b) - (gor +.a +.b) - (gor -.a -.b) -:: -++ lor :: l-order - ~/ %lor - |= {a/* b/*} - ^- ? - ?: =(a b) & - ?@ a - ?^ b & - (lth a b) - ?: =(-.a -.b) - $(a +.a, b +.b) - $(a -.a, b -.b) -:: -++ vor :: v-order - ~/ %vor - |= {a/* b/*} - ^- ? - =+ [c=(mug (mug a)) d=(mug (mug b))] - ?: =(c d) - (dor a b) - (lth c d) -:: :: -:::: :: - :: 2g: unsigned powers :: - :: :: - :: -++ pow :: unsigned exponent - ~/ %pow - |= {a/@ b/@} - ?: =(b 0) 1 - |- ?: =(b 1) a - =+ c=$(b (div b 2)) - =+ d=(mul c c) - ?~ (dis b 1) d (mul d a) -:: -++ sqt :: unsigned sqrt/rem - ~/ %sqt - |= a/@ ^- {p/@ q/@} - ?~ a [0 0] - =+ [q=(div (dec (xeb a)) 2) r=0] - =- [-.b (sub a +.b)] - ^= b |- - =+ s=(add r (bex q)) - =+ t=(mul s s) - ?: =(q 0) - ?:((lte t a) [s t] [r (mul r r)]) - ?: (lte t a) - $(r s, q (dec q)) - $(q (dec q)) -:: :: -:::: :: - :: :: - :: 2h: set logic :: - :: :: - :: -++ in :: set engine - ~/ %in - |_ a/(tree) :: (set) - +- all :: logical AND - ~/ %all - |* b/$-(* ?) - |- ^- ? - ?~ a - & - ?&((b n.a) $(a l.a) $(a r.a)) - :: - +- any :: logical OR - ~/ %any - |* b/$-(* ?) - |- ^- ? - ?~ a - | - ?|((b n.a) $(a l.a) $(a r.a)) - :: - +- apt :: check correctness - =| {l/(unit) r/(unit)} - |- ^- ? - ?~ a & - ?& ?~(l & (hor n.a u.l)) - ?~(r & (hor u.r n.a)) - ?~(l.a & ?&((vor n.a n.l.a) $(a l.a, l `n.a))) - ?~(r.a & ?&((vor n.a n.r.a) $(a r.a, r `n.a))) - == - :: - +- bif :: splits a by b - ~/ %bif - |* b/* - ^+ [l=a r=a] - =< [+< +>] - |- ^+ a - ?~ a - [b ~ ~] - ?: =(b n.a) - a - ?: (hor b n.a) - =+ c=$(a l.a) - ?> ?=(^ c) - [n.c l.c [n.a r.c r.a]] - =+ c=$(a r.a) - ?> ?=(^ c) - [n.c [n.a l.a l.c] r.c] - :: - +- del :: b without any a - ~/ %del - |* b/* - |- ^+ a - ?~ a - ~ - ?. =(b n.a) - ?: (hor b n.a) - [n.a $(a l.a) r.a] - [n.a l.a $(a r.a)] - |- ^- {$?($~ _a)} - ?~ l.a r.a - ?~ r.a l.a - ?: (vor n.l.a n.r.a) - [n.l.a l.l.a $(l.a r.l.a)] - [n.r.a $(r.a l.r.a) r.r.a] - :: - +- dif :: difference - ~/ %dif - |* b/_a - |- ^+ a - ?~ b - a - =+ c=(bif n.b) - ?> ?=(^ c) - =+ d=$(a l.c, b l.b) - =+ e=$(a r.c, b r.b) - |- ^- {$?($~ _a)} - ?~ d e - ?~ e d - ?: (vor n.d n.e) - [n.d l.d $(d r.d)] - [n.e $(e l.e) r.e] - :: - +- dig :: axis of a in b - |= b/* - =+ c=1 - |- ^- (unit @) - ?~ a ~ - ?: =(b n.a) [~ u=(peg c 2)] - ?: (hor b n.a) - $(a l.a, c (peg c 6)) - $(a r.a, c (peg c 7)) - :: - +- gas :: concatenate - ~/ %gas - |= b/(list _?>(?=(^ a) n.a)) - |- ^+ a - ?~ b - a - $(b t.b, a (put i.b)) - :: - +- has :: b exists in a check - ~/ %has - |* b/* - |- ^- ? - ?~ a - | - ?: =(b n.a) - & - ?: (hor b n.a) - $(a l.a) - $(a r.a) - :: - +- int :: intersection - ~/ %int - |* b/_a - |- ^+ a - ?~ b - ~ - ?~ a - ~ - ?. (vor n.a n.b) - $(a b, b a) - ?: =(n.b n.a) - [n.a $(a l.a, b l.b) $(a r.a, b r.b)] - ?: (hor n.b n.a) - %- uni(a $(a l.a, b [n.b l.b ~])) $(b r.b) - %- uni(a $(a r.a, b [n.b ~ r.b])) $(b l.b) - :: - +- put :: puts b in a, sorted - ~/ %put - |* b/* - |- ^+ a - ?~ a - [b ~ ~] - ?: =(b n.a) - a - ?: (hor b n.a) - =+ c=$(a l.a) - ?> ?=(^ c) - ?: (vor n.a n.c) - [n.a c r.a] - [n.c l.c [n.a r.c r.a]] - =+ c=$(a r.a) - ?> ?=(^ c) - ?: (vor n.a n.c) - [n.a l.a c] - [n.c [n.a l.a l.c] r.c] - :: - +- rep :: replace by product - |* b/_|=({* *} +<+) - |- - ?~ a +<+.b - $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b))) - :: - +- run :: apply gate to values - ~/ %run - |* b/gate - =| c/(set _?>(?=(^ a) (b n.a))) - |- ?~ a c - =. c (~(put in c) (b n.a)) - =. c $(a l.a, c c) - $(a r.a, c c) - :: - +- tap :: convert to list - ~/ %tap - |= b/(list _?>(?=(^ a) n.a)) - ^+ b - ?~ a - b - $(a r.a, b [n.a $(a l.a)]) - :: - +- uni :: union - ~/ %uni - |* b/_a - ?: =(a b) a - |- ^+ a - ?~ b - a - ?~ a - b - ?: (vor n.a n.b) - ?: =(n.b n.a) - [n.b $(a l.a, b l.b) $(a r.a, b r.b)] - ?: (hor n.b n.a) - $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) - $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) - ?: =(n.a n.b) - [n.b $(b l.b, a l.a) $(b r.b, a r.a)] - ?: (hor n.a n.b) - $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) - $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) - :: - +- wyt :: size of set - =< $ - ~% %wyt + ~ - |. ^- @ - ?~(a 0 +((add $(a l.a) $(a r.a)))) - -- -:: :: -:::: 2i: map logic :: - :: :: - :: -++ by :: map engine - ~/ %by - =| a/(tree (pair)) :: (map) - =* node ?>(?=(^ a) n.a) - |% - +- all :: logical AND - ~/ %all - |* b/$-(* ?) - |- ^- ? - ?~ a - & - ?&((b q.n.a) $(a l.a) $(a r.a)) - :: - +- any :: logical OR - ~/ %any - |* b/$-(* ?) - |- ^- ? - ?~ a - | - ?|((b q.n.a) $(a l.a) $(a r.a)) - :: - +- bif :: splits a by b - ~/ %bif - |* {b/* c/*} - ^+ [l=a r=a] - =< [+< +>] - |- ^+ a - ?~ a - [[b c] ~ ~] - ?: =(b p.n.a) - ?: =(c q.n.a) - a - [[b c] l.a r.a] - ?: (gor b p.n.a) - =+ d=$(a l.a) - ?> ?=(^ d) - [n.d l.d [n.a r.d r.a]] - =+ d=$(a r.a) - ?> ?=(^ d) - [n.d [n.a l.a l.d] r.d] - :: - +- def :: difference - |* b/_a - ^- (map _p:node (pair (unit _q:node) (unit _q:node))) - !! - :: - +- dep :: difference as patch - |* b/_a - ^+ [p=a q=a] - =+ c=(~(tap by (def b))) - =+ [d e]=[`_a`~ `_a`~] - |- ^+ [d e] - ?~ c [d e] - %= $ - c t.c - d ?~(q.q.i.c d (~(put by d) p.i.c u.q.q.i.c)) - e ?~(p.q.i.c e (~(put by e) p.i.c u.p.q.i.c)) - == - :: - +- del :: delete at key b - ~/ %del - |* b/* - |- ^+ a - ?~ a - ~ - ?. =(b p.n.a) - ?: (gor b p.n.a) - [n.a $(a l.a) r.a] - [n.a l.a $(a r.a)] - |- ^- {$?($~ _a)} - ?~ l.a r.a - ?~ r.a l.a - ?: (vor p.n.l.a p.n.r.a) - [n.l.a l.l.a $(l.a r.l.a)] - [n.r.a $(r.a l.r.a) r.r.a] - :: - +- dif :: difference - ~/ %dif - |* b/_a - |- ^+ a - ?~ b - a - =+ c=(bif p.n.b q.n.b) - ?> ?=(^ c) - =+ d=$(a l.c, b l.b) - =+ e=$(a r.c, b r.b) - |- ^- {$?($~ _a)} - ?~ d e - ?~ e d - ?: (vor p.n.d p.n.e) - [n.d l.d $(d r.d)] - [n.e $(e l.e) r.e] - :: - +- dig :: axis of b key - |= b/* - =+ c=1 - |- ^- (unit @) - ?~ a ~ - ?: =(b p.n.a) [~ u=(peg c 2)] - ?: (gor b p.n.a) - $(a l.a, c (peg c 6)) - $(a r.a, c (peg c 7)) - :: - +- apt :: check correctness - =| {l/(unit) r/(unit)} - |- ^- ? - ?~ a & - ?& ?~(l & (gor p.n.a u.l)) - ?~(r & (gor u.r p.n.a)) - ?~(l.a & ?&((vor p.n.a p.n.l.a) $(a l.a, l `p.n.a))) - ?~(r.a & ?&((vor p.n.a p.n.r.a) $(a r.a, r `p.n.a))) - == - :: - +- gas :: concatenate - ~/ %gas - |* b/(list {p/* q/*}) - => .(b `(list _?>(?=(^ a) n.a))`b) - |- ^+ a - ?~ b - a - $(b t.b, a (put p.i.b q.i.b)) - :: - +- get :: grab value by key - ~/ %get - |= b/* - ^- {$@($~ {$~ u/_?>(?=(^ a) q.n.a)})} - ?~ a - ~ - ?: =(b p.n.a) - [~ u=q.n.a] - ?: (gor b p.n.a) - $(a l.a) - $(a r.a) - :: - +- got - |* b/* - (need (get b)) - :: - +- has :: key existence check - ~/ %has - |* b/* - !=(~ (get b)) - :: - +- int :: intersection - ~/ %int - |* b/_a - |- ^+ a - ?~ b - ~ - ?~ a - ~ - ?: (vor p.n.a p.n.b) - ?: =(p.n.b p.n.a) - [n.b $(a l.a, b l.b) $(a r.a, b r.b)] - ?: (gor p.n.b p.n.a) - %- uni(a $(a l.a, b [n.b l.b ~])) $(b r.b) - %- uni(a $(a r.a, b [n.b ~ r.b])) $(b l.b) - ?: =(p.n.a p.n.b) - [n.b $(b l.b, a l.a) $(b r.b, a r.a)] - ?: (gor p.n.a p.n.b) - %- uni(a $(b l.b, a [n.a l.a ~])) $(a r.a) - %- uni(a $(b r.b, a [n.a ~ r.a])) $(a l.a) - :: - +- mar :: add with validation - |* {b/_?>(?=(^ a) p.n.a) c/(unit _?>(?=(^ a) q.n.a))} - ?~ c - (del b) - (put b u.c) - :: - +- put :: adds key-value pair - ~/ %put - |* {b/* c/*} - |- ^+ a - ?~ a - [[b c] ~ ~] - ?: =(b p.n.a) - ?: =(c q.n.a) - a - [[b c] l.a r.a] - ?: (gor b p.n.a) - =+ d=$(a l.a) - ?> ?=(^ d) - ?: (vor p.n.a p.n.d) - [n.a d r.a] - [n.d l.d [n.a r.d r.a]] - =+ d=$(a r.a) - ?> ?=(^ d) - ?: (vor p.n.a p.n.d) - [n.a l.a d] - [n.d [n.a l.a l.d] r.d] - :: - +- rep :: replace by product - |* b/_|=({* *} +<+) - |- - ?~ a +<+.b - $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b))) - :: - +- rib :: transform + product - |* {b/* c/$-(* *)} - |- ^+ [b a] - ?~ a [b ~] - =+ d=(c n.a b) - =. n.a +.d - =+ e=$(a l.a, b -.d) - =+ f=$(a r.a, b -.e) - [-.f [n.a +.e +.f]] - :: - +- run :: apply gate to values - |* b/$-(* *) - |- - ?~ a a - [n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)] - :: - +- rut :: apply gate to nodes - |* b/gate - |- - ?~ a a - [n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)] - :: - +- tap :: listify pairs - ~/ %tap - |= b/(list _?>(?=(^ a) n.a)) - ^+ b - ?~ a - b - $(a r.a, b [n.a $(a l.a)]) - :: - +- uni :: union, merge - ~/ %uni - |* b/_a - |- ^+ a - ?~ b - a - ?~ a - b - ?: (vor p.n.a p.n.b) - ?: =(p.n.b p.n.a) - [n.b $(a l.a, b l.b) $(a r.a, b r.b)] - ?: (gor p.n.b p.n.a) - $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) - $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) - ?: =(p.n.a p.n.b) - [n.b $(b l.b, a l.a) $(b r.b, a r.a)] - ?: (gor p.n.a p.n.b) - $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) - $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) - :: - +- uno :: general union - |= b/_a - |= meg/$-({_p:node _q:node _q:node} _q:node) - |- ^+ a - ?~ b - a - ?~ a - b - ?: (vor p.n.a p.n.b) - ?: =(p.n.b p.n.a) - [n.b $(a l.a, b l.b) $(a r.a, b r.b)] - ?: (gor p.n.b p.n.a) - $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) - $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) - ?: =(p.n.a p.n.b) - :+ [p.n.a (meg p.n.a q.n.a q.n.b)] - $(b l.b, a l.a) - $(b r.b, a r.a) - ?: (gor p.n.a p.n.b) - $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) - $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) - :: - :: - +- urn :: apply gate to nodes - |* b/$-({* *} *) - |- - ?~ a ~ - [n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)] - :: - +- wyt :: depth of map - |- ^- @ - ?~(a 0 +((add $(a l.a) $(a r.a)))) - :: - +- key :: set of keys - =| b/(set _?>(?=(^ a) p.n.a)) - |- ^+ b - ?~ a b - $(a r.a, b $(a l.a, b (~(put in b) p.n.a))) - :: - +- val :: list of vals - =| b/(list _?>(?=(^ a) q.n.a)) - |- ^+ b - ?~ a b - $(a r.a, b [q.n.a $(a l.a)]) - -- -:: :: -:::: 2j: jar and jug logic :: - :: :: - :: -++ ja :: jar engine - |_ a/(tree (pair * (list))) :: (jar) - +- get :: gets list by key - |* b/* - =+ c=(~(get by a) b) - ?~(c ~ u.c) - :: - +- add :: adds key-list pair - |* {b/* c/*} - =+ d=(get b) - (~(put by a) b [c d]) - -- -++ ju :: jug engine - |_ a/(tree (pair * (tree))) :: (jug) - +- del :: del key-set pair - |* {b/* c/*} - ^+ a - =+ d=(get b) - =+ e=(~(del in d) c) - ?~ e - (~(del by a) b) - (~(put by a) b e) - :: - +- gas :: concatenate - |* b/(list {p/* q/*}) - => .(b `(list _?>(?=({{* ^} ^} a) [p=p q=n.q]:n.a))`b) - |- ^+ a - ?~ b - a - $(b t.b, a (put p.i.b q.i.b)) - :: - +- get :: gets set by key - |* b/* - =+ c=(~(get by a) b) - ?~(c ~ u.c) - :: - +- has :: existence check - |* {b/* c/*} - ^- ? - (~(has in (get b)) c) - :: - +- put :: add key-set pair - |* {b/* c/*} - ^+ a - =+ d=(get b) - (~(put by a) b (~(put in d) c)) - -- -:: :: -:::: 2k: queue logic :: - :: :: - :: -++ to :: queue engine - |_ a/(tree) :: (qeu) - +- bal - |- ^+ a - ?~ a ~ - ?. |(?=($~ l.a) (vor n.a n.l.a)) - $(a [n.l.a l.l.a $(a [n.a r.l.a r.a])]) - ?. |(?=($~ r.a) (vor n.a n.r.a)) - $(a [n.r.a $(a [n.a l.a l.r.a]) r.r.a]) - a - :: - +- dep :: max depth of queue - |- ^- @ - ?~ a 0 - +((max $(a l.a) $(a r.a))) - :: - +- gas :: insert list to que - |= b/(list _?>(?=(^ a) n.a)) - |- ^+ a - ?~(b a $(b t.b, a (put i.b))) - :: - +- get :: head-rest pair - |- ^+ ?>(?=(^ a) [p=n.a q=*(tree _n.a)]) - ?~ a - !! - ?~ r.a - [n.a l.a] - =+ b=$(a r.a) - :- p.b - ?: |(?=($~ q.b) (vor n.a n.q.b)) - [n.a l.a q.b] - [n.q.b [n.a l.a l.q.b] r.q.b] - :: - +- nip :: remove root - |- ^+ a - ?~ a ~ - ?~ l.a r.a - ?~ r.a l.a - ?: (vor n.l.a n.r.a) - [n.l.a l.l.a $(l.a r.l.a)] - [n.r.a $(r.a l.r.a) r.r.a] - :: - +- nap :: removes head - ?> ?=(^ a) - ?: =(~ l.a) r.a - =+ b=get(a l.a) - bal(a ^+(a [p.b q.b r.a])) - :: - +- put :: insert new tail - |* b/* - |- ^+ a - ?~ a - [b ~ ~] - bal(a a(l $(a l.a))) - :: - +- tap :: adds list to end - |= b/(list _?>(?=(^ a) n.a)) - =+ 0 :: hack for jet match - ^+ b - ?~ a - b - $(a r.a, b [n.a $(a l.a)]) - :: - +- top :: produces head - |- ^- (unit _?>(?=(^ a) n.a)) - ?~ a ~ - ?~(r.a [~ n.a] $(a r.a)) - -- -:: :: -:::: 2l: container from container :: - :: :: - :: -++ malt :: map from list - |* a/(list) - (molt `(list {p/_-<.a q/_->.a})`a) -:: -++ molt :: map from pair list - |* a/(list (pair)) :: ^- =,(i.-.a (map _p _q)) - (~(gas by `(tree {p/_p.i.-.a q/_q.i.-.a})`~) a) -:: -++ silt :: set from list - |* a/(list) :: ^- (set _i.-.a) - =+ b=*(tree _?>(?=(^ a) i.a)) - (~(gas in b) a) -:: :: -:::: 2m: container from noun :: - :: :: - :: -++ ly :: list from raw noun - |* a/* - ^+((homo (limo a)) a) -:: -++ my :: map from raw noun - |* a/* - (malt ^+((homo (limo a)) a)) -:: -++ sy :: set from raw noun - |* a/* - (silt ^+((homo (limo a)) a)) -:: :: -:::: 2n: functional hacks :: - :: :: - :: -++ aftr |*(a/$-(* *) |*(b/$-(* *) (pair b a))) :: pair after -++ cork |*({a/_|=(* **) b/gate} (corl b a)) :: compose forward -++ corl :: compose backwards - |* {a/gate b/_|=(* **)} - =< +:|.((a (b))) :: span check - |* c/_+<.b - (a (b c)) -:: -++ cury :: curry left - |* {a/_|=(^ **) b/*} - |* c/_+<+.a - (a b c) -:: -++ curr :: curry right - |* {a/_|=(^ **) c/*} - |* b/_+<+.a - (a b c) -:: -++ fore |*(a/$-(* *) |*(b/$-(* *) (pair a b))) :: pair before -++ hard :: force remold - |* han/$-(* *) - |= fud/* ^- han - ~_ leaf+"hard" - =+ gol=(han fud) - ?>(=(gol fud) gol) -:: -:: -++ head |*(^ ,:+<-) :: get head -++ same |*(* +<) :: identity -++ soft :: maybe remold - |* han/$-(* *) - |= fud/* ^- (unit han) - =+ gol=(han fud) - ?.(=(gol fud) ~ [~ gol]) -:: -++ tail |*(^ ,:+<+) :: get tail -++ test |=(^ =(+<- +<+)) :: equality -:: -:: :: -:::: 2o: normalizing containers :: - :: :: - :: -++ jar |*({a/mold b/mold} (map a (list b))) :: map of lists -++ jug |*({a/mold b/mold} (map a (set b))) :: map of sets -++ map |* {a/mold b/mold} :: table - %+ cork (tree (pair a b)) :: - |= c/(tree (pair a b)) ^+ c :: - ?.(~(apt by c) ~ c) :: -++ qeu |*(a/mold (tree a)) :: queue -++ set |* a/mold :: set - %+ cork (tree a) :: - |= b/(tree a) ^+ b :: - ?.(~(apt in b) ~ b) :: -:: -:::: 2p: serialization :: - :: :: - :: -++ cue :: unpack - ~/ %cue - |= a/@ - ^- * - =+ b=0 - =+ m=`(map @ *)`~ - =< q - |- ^- {p/@ q/* r/(map @ *)} - ?: =(0 (cut 0 [b 1] a)) - =+ c=(rub +(b) a) - [+(p.c) q.c (~(put by m) b q.c)] - =+ c=(add 2 b) - ?: =(0 (cut 0 [+(b) 1] a)) - =+ u=$(b c) - =+ v=$(b (add p.u c), m r.u) - =+ w=[q.u q.v] - [(add 2 (add p.u p.v)) w (~(put by r.v) b w)] - =+ d=(rub c a) - [(add 2 p.d) (need (~(get by m) q.d)) m] -:: -++ jam :: pack - ~/ %jam - |= a/* - ^- @ - =+ b=0 - =+ m=`(map * @)`~ - =< q - |- ^- {p/@ q/@ r/(map * @)} - =+ c=(~(get by m) a) - ?~ c - => .(m (~(put by m) a b)) - ?: ?=(@ a) - =+ d=(mat a) - [(add 1 p.d) (lsh 0 1 q.d) m] - => .(b (add 2 b)) - =+ d=$(a -.a) - =+ e=$(a +.a, b (add b p.d), m r.d) - [(add 2 (add p.d p.e)) (mix 1 (lsh 0 2 (cat 0 q.d q.e))) r.e] - ?: ?&(?=(@ a) (lte (met 0 a) (met 0 u.c))) - =+ d=(mat a) - [(add 1 p.d) (lsh 0 1 q.d) m] - =+ d=(mat u.c) - [(add 2 p.d) (mix 3 (lsh 0 2 q.d)) m] -:: -++ mat :: length-encode - ~/ %mat - |= a/@ - ^- {p/@ q/@} - ?: =(0 a) - [1 1] - =+ b=(met 0 a) - =+ c=(met 0 b) - :- (add (add c c) b) - (cat 0 (bex c) (mix (end 0 (dec c) b) (lsh 0 (dec c) a))) -:: -++ rub :: length-decode - ~/ %rub - |= {a/@ b/@} - ^- {p/@ q/@} - =+ ^= c - =+ [c=0 m=(met 0 b)] - |- ?< (gth c m) - ?. =(0 (cut 0 [(add a c) 1] b)) - c - $(c +(c)) - ?: =(0 c) - [1 0] - =+ d=(add a +(c)) - =+ e=(add (bex (dec c)) (cut 0 [d (dec c)] b)) - [(add (add c c) e) (cut 0 [(add d (dec c)) e] b)] -:: -:::: 2q: molds and mold builders :: - :: :: - :: -++ char @t :: UTF8 byte -++ cord @t :: UTF8, LSB first -++ date {{a/? y/@ud} m/@ud t/tarp} :: parsed date -++ knot @ta :: ASCII text -++ tang (list tank) :: bottom-first error -++ tank $% {$leaf p/tape} :: printing formats - $: $palm :: backstep list - p/{p/tape q/tape r/tape s/tape} :: - q/(list tank) :: - == :: - $: $rose :: flat list - p/{p/tape q/tape r/tape} :: mid open close - q/(list tank) :: - == :: - == :: -++ tanq :: tomorrow's tank - $? {$~ p/(list tanq)} :: list of printables - {$~ $~ p/tape} :: simple string - (pair @tas tanq) :: captioned - == :: -++ tape (list @tD) :: UTF8 string as list -++ tarp {d/@ud h/@ud m/@ud s/@ud f/(list @ux)} :: parsed time -++ term @tas :: ascii symbol -++ wain (list cord) :: text lines -++ wall (list tape) :: text lines --- => -:: :: -:::: 3: layer three :: - :: :: - :: 3a: signed and modular ints :: - :: 3b: floating point :: - :: 3c: urbit time :: - :: 3d: SHA hash family :: - :: 3e: (reserved) :: - :: 3f: scrambling :: - :: 3g: molds and mold builders :: - :: :: -~% %tri + ~ -|% -:: -:::: 3a: signed and modular ints :: - :: :: - :: -++ egcd :: schneier's egcd - |= {a/@ b/@} - =+ si - =+ [c=(sun a) d=(sun b)] - =+ [u=[c=(sun 1) d=--0] v=[c=--0 d=(sun 1)]] - |- ^- {d/@ u/@s v/@s} - ?: =(--0 c) - [(abs d) d.u d.v] - :: ?> ?& =(c (sum (pro (sun a) c.u) (pro (sun b) c.v))) - :: =(d (sum (pro (sun a) d.u) (pro (sun b) d.v))) - :: == - =+ q=(fra d c) - %= $ - c (dif d (pro q c)) - d c - u [(dif d.u (pro q c.u)) c.u] - v [(dif d.v (pro q c.v)) c.v] - == -:: -++ fo :: modulo prime - |_ a/@ - ++ dif - |= {b/@ c/@} - (sit (sub (add a b) (sit c))) - :: - ++ exp - |= {b/@ c/@} - ?: =(0 b) - 1 - =+ d=$(b (rsh 0 1 b)) - =+ e=(pro d d) - ?:(=(0 (end 0 1 b)) e (pro c e)) - :: - ++ fra - |= {b/@ c/@} - (pro b (inv c)) - :: - ++ inv - |= b/@ - =+ c=(dul:si u:(egcd b a) a) - c - :: - ++ pro - |= {b/@ c/@} - (sit (mul b c)) - :: - ++ sit - |= b/@ - (mod b a) - :: - ++ sum - |= {b/@ c/@} - (sit (add b c)) - -- -:: -++ si :: signed integer - |% - ++ abs |=(a/@s (add (end 0 1 a) (rsh 0 1 a))) :: absolute value - ++ dif |= {a/@s b/@s} :: subtraction - (sum a (new !(syn b) (abs b))) - ++ dul |= {a/@s b/@} :: modulus - =+(c=(old a) ?:(-.c (mod +.c b) (sub b +.c))) - ++ fra |= {a/@s b/@s} :: divide - (new =(0 (mix (syn a) (syn b))) (div (abs a) (abs b))) - ++ new |= {a/? b/@} :: [sign value] to @s - `@s`?:(a (mul 2 b) ?:(=(0 b) 0 +((mul 2 (dec b))))) - ++ old |=(a/@s [(syn a) (abs a)]) :: [sign value] - ++ pro |= {a/@s b/@s} :: multiplication - (new =(0 (mix (syn a) (syn b))) (mul (abs a) (abs b))) - ++ rem |=({a/@s b/@s} (dif a (pro b (fra a b)))) :: remainder - ++ sum |= {a/@s b/@s} :: addition - =+ [c=(old a) d=(old b)] - ?: -.c - ?: -.d - (new & (add +.c +.d)) - ?: (gte +.c +.d) - (new & (sub +.c +.d)) - (new | (sub +.d +.c)) - ?: -.d - ?: (gte +.c +.d) - (new | (sub +.c +.d)) - (new & (sub +.d +.c)) - (new | (add +.c +.d)) - ++ sun |=(a/@u (mul 2 a)) :: @u to @s - ++ syn |=(a/@s =(0 (end 0 1 a))) :: sign test - ++ cmp |= {a/@s b/@s} :: compare - ^- @s - ?: =(a b) - --0 - ?: (syn a) - ?: (syn b) - ?: (gth a b) - --1 - -1 - --1 - ?: (syn b) - -1 - ?: (gth a b) - -1 - --1 - -- -:: :: -:::: 3b: floating point :: - :: :: - :: -++ fn :: float, infinity, or NaN - :: s=sign, e=exponent, a=arithmetic form - :: (-1)^s * a * 2^e - $% {$f s/? e/@s a/@u} - {$i s/?} - {$n $~} - == -:: -++ dn :: decimal float, infinity, or NaN - :: (-1)^s * a * 10^e - $% {$d s/? e/@s a/@u} - {$i s/?} - {$n $~} - == -:: -++ rn :: parsed decimal float - :: - $% {$d a/? b/{c/@ {d/@ e/@} f/? i/@}} - {$i a/?} - {$n $~} - == -:: -++ fl :: arb. precision fp - =+ ^- {{p/@u v/@s w/@u} r/$?($n $u $d $z $a) d/$?($d $f $i)} - [[113 -16.494 32.765] %n %d] - :: p=precision: number of bits in arithmetic form; must be at least 2 - :: v=min exponent: minimum value of e - :: w=width: max - min value of e, 0 is fixed point - :: r=rounding mode: nearest (ties to even), up, down, to zero, away from zero - :: d=behavior: return denormals, flush denormals to zero, - :: infinite exponent range - => - ~% %cofl +> ~ - :: internal functions; mostly operating on {e/@s a/@u}, in other words - :: positive numbers. many of these error out if a=0. - |% - ++ rou - |= {a/{e/@s a/@u}} ^- fn (rau a &) - :: - ++ rau - |= {a/{e/@s a/@u} t/?} ^- fn - ?- r - $z (lug %fl a t) $d (lug %fl a t) - $a (lug %ce a t) $u (lug %ce a t) - $n (lug %ne a t) - == - :: - ++ add :: add; exact if e - |= {a/{e/@s a/@u} b/{e/@s a/@u} e/?} ^- fn - =+ q=(dif:si e.a e.b) - |- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exp - ?: e - [%f & e.b (^add (lsh 0 (abs:si q) a.a) a.b)] - =+ [ma=(met 0 a.a) mb=(met 0 a.b)] - =+ ^= w %+ dif:si e.a %- sun:si :: expanded exp of a - ?: (gth prc ma) (^sub prc ma) 0 - =+ ^= x %+ sum:si e.b (sun:si mb) :: highest exp for b - ?: =((cmp:si w x) --1) :: don't need to add - ?- r - $z (lug %fl a &) $d (lug %fl a &) - $a (lug %lg a &) $u (lug %lg a &) - $n (lug %na a &) - == - (rou [e.b (^add (lsh 0 (abs:si q) a.a) a.b)]) - :: - ++ sub :: subtract; exact if e - |= {a/{e/@s a/@u} b/{e/@s a/@u} e/?} ^- fn - =+ q=(dif:si e.a e.b) - |- ?. (syn:si q) - (fli $(b a, a b, q +(q), r swr)) - =+ [ma=(met 0 a.a) mb=(met 0 a.b)] - =+ ^= w %+ dif:si e.a %- sun:si - ?: (gth prc ma) (^sub prc ma) 0 - =+ ^= x %+ sum:si e.b (sun:si +(mb)) - ?: &(!e =((cmp:si w x) --1)) - ?- r - $z (lug %sm a &) $d (lug %sm a &) - $a (lug %ce a &) $u (lug %ce a &) - $n (lug %nt a &) - == - =+ j=(lsh 0 (abs:si q) a.a) - |- ?. (gte j a.b) - (fli $(a.b j, j a.b, r swr)) - =+ i=(^sub j a.b) - ?~ i [%f & zer] - ?: e [%f & e.b i] (rou [e.b i]) - :: - ++ mul :: multiply - |= {a/{e/@s a/@u} b/{e/@s a/@u}} ^- fn - (rou (sum:si e.a e.b) (^mul a.a a.b)) - :: - ++ div :: divide - |= {a/{e/@s a/@u} b/{e/@s a/@u}} ^- fn - =+ [ma=(met 0 a.a) mb=(met 0 a.b)] - =+ v=(dif:si (sun:si ma) (sun:si +((^add mb prc)))) - =. a ?: (syn:si v) a - a(e (sum:si v e.a), a (lsh 0 (abs:si v) a.a)) - =+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)] - (rau [j p.q] =(q.q 0)) - :: - ++ sqt :: square root - |= {a/{e/@s a/@u}} ^- fn - =. a - =+ [w=(met 0 a.a) x=(^mul +(prc) 2)] - =+ ?:((^lth w x) (^sub x w) 0) - =+ ?: =((dis - 1) (dis (abs:si e.a) 1)) - - (^add - 1) - a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) - =+ [y=(^sqt a.a) z=(fra:si e.a --2)] - (rau [z p.y] =(q.y 0)) - :: - ++ lth :: less-than - |= {a/{e/@s a/@u} b/{e/@s a/@u}} ^- ? - ?: =(e.a e.b) (^lth a.a a.b) - =+ c=(cmp:si (ibl a) (ibl b)) - ?: =(c -1) & ?: =(c --1) | - ?: =((cmp:si e.a e.b) -1) - (^lth (rsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b) - (^lth (lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b) - :: - ++ equ :: equals - |= {a/{e/@s a/@u} b/{e/@s a/@u}} ^- ? - ?. =((ibl a) (ibl b)) | - ?: =((cmp:si e.a e.b) -1) - =((lsh 0 (abs:si (dif:si e.a e.b)) a.b) a.a) - =((lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b) - :: - :: integer binary logarithm: 2^ibl(a) <= |a| < 2^(ibl(a)+1) - ++ ibl - |= {a/{e/@s a/@u}} ^- @s - (sum:si (sun:si (dec (met 0 a.a))) e.a) - :: - :: change to a representation where a.a is odd - :: every fn has a unique representation of this kind - ++ uni - |= {a/{e/@s a/@u}} - |- ?: =((end 0 1 a.a) 1) a - $(a.a (rsh 0 1 a.a), e.a (sum:si e.a --1)) - :: - :: expands to either full precision or to denormalized - ++ xpd - |= {a/{e/@s a/@u}} - =+ ma=(met 0 a.a) - ?: (gte ma prc) a - =+ ?: =(den %i) (^sub prc ma) - =+ ^= q - =+ w=(dif:si e.a emn) - ?: (syn:si w) (abs:si w) 0 - (min q (^sub prc ma)) - a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) - :: - :: central rounding mechanism - :: can perform: floor, ceiling, smaller, larger, - :: nearest (round ties to: even, away from 0, toward 0) - :: s is sticky bit: represents a value less than ulp(a) = 2^(e.a) - :: - ++ lug - ~/ %lug - |= {t/$?($fl $ce $sm $lg $ne $na $nt) a/{e/@s a/@u} s/?} ^- fn - ?< =(a.a 0) - =- - ?. =(den %f) - :: flush denormals - ?. ?=({$f *} -) - - ?: =((met 0 ->+>) prc) - [%f & zer] - :: - =+ m=(met 0 a.a) - ?> |(s (gth m prc)) :: require precision - =+ ^= q - =+ ^= f :: reduce precision - ?: (gth m prc) (^sub m prc) 0 - =+ ^= g %- abs:si :: enforce min. exp - ?: =(den %i) --0 - ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0 - (max f g) - =^ b a :- (end 0 q a.a) - a(e (sum:si e.a (sun:si q)), a (rsh 0 q a.a)) - :: - ?~ a.a - ?< =(den %i) - ?- t - $fl [%f & zer] - $sm [%f & zer] - $ce [%f & spd] - $lg [%f & spd] - $ne ?: s [%f & ?:((lte b (bex (dec q))) zer spd)] - [%f & ?:((^lth b (bex (dec q))) zer spd)] - $nt ?: s [%f & ?:((lte b (bex (dec q))) zer spd)] - [%f & ?:((^lth b (bex (dec q))) zer spd)] - $na [%f & ?:((^lth b (bex (dec q))) zer spd)] - == - :: - =. a (xpd a) - :: - =. a - ?- t - $fl a - $lg a(a +(a.a)) - $sm ?. &(=(b 0) s) a - ?: &(=(e.a emn) !=(den %i)) a(a (dec a.a)) - =+ y=(dec (^mul a.a 2)) - ?. (lte (met 0 y) prc) a(a (dec a.a)) - [(dif:si e.a --1) y] - $ce ?: &(=(b 0) s) a a(a +(a.a)) - $ne ?~ b a - =+ y=(bex (dec q)) - ?: &(=(b y) s) :: round halfs to even - ?~ (dis a.a 1) a a(a +(a.a)) - ?: (^lth b y) a a(a +(a.a)) - $na ?~ b a - =+ y=(bex (dec q)) - ?: (^lth b y) a a(a +(a.a)) - $nt ?~ b a - =+ y=(bex (dec q)) - ?: =(b y) ?: s a a(a +(a.a)) - ?: (^lth b y) a a(a +(a.a)) - == - :: - =. a ?. =((met 0 a.a) +(prc)) a - a(a (rsh 0 1 a.a), e (sum:si e.a --1)) - ?~ a.a [%f & zer] - :: - ?: =(den %i) [%f & a] - ?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp - :: - ++ drg :: dragon4; - ~/ %drg :: convert to decimal - |= {a/{e/@s a/@u}} ^- {@s @u} - ?< =(a.a 0) - =. a (xpd a) - =+ r=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) a.a) - =+ s=(lsh 0 ?.((syn:si e.a) (abs:si e.a) 0) 1) - =+ m=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) 1) - =+ [k=--0 q=(^div (^add s 9) 10)] - |- ?: (^lth r q) - %= $ - k (dif:si k --1) - r (^mul r 10) - m (^mul m 10) - == - |- ?: (gte (^add (^mul r 2) m) (^mul s 2)) - $(s (^mul s 10), k (sum:si k --1)) - =+ [u=0 o=0] - |- - =+ v=(dvr (^mul r 10) s) - => %= . - k (dif:si k --1) - u p.v - r q.v - m (^mul m 10) - == - =+ l=(^lth (^mul r 2) m) - =+ ^= h - ?| (^lth (^mul s 2) m) - (gth (^mul r 2) (^sub (^mul s 2) m)) - == - ?: &(!l !h) - $(o (^add (^mul o 10) u)) - =+ q=&(h |(!l (gte (^mul r 2) s))) - =. o (^add (^mul o 10) ?:(q +(u) u)) - [k o] - :: - ++ toj :: round to integer - |= {a/{e/@s a/@u}} ^- fn - ?. =((cmp:si e.a --0) -1) [%f & a] - =+ x=(abs:si e.a) - =+ y=(rsh 0 x a.a) - ?: |(=(r %d) =(r %z)) [%f & --0 y] - =+ z=(end 0 x a.a) - ?: |(=(r %u) =(r %a)) [%f & --0 ?~(z y +(y))] - =+ i=(bex (dec x)) - ?: &(=(z i) =((dis y 1) 0)) [%f & --0 y] - ?: (^lth z i) [%f & --0 y] [%f & --0 +(y)] - :: - ++ ned :: require ?=({$f *} a) - |= {a/fn} ^- {$f s/? e/@s a/@u} - ?: ?=({$f *} a) a - ~_ leaf+"need-float" - !! - :: - ++ shf :: a * 2^b; no rounding - |= {a/fn b/@s} - ?: |(?=({$n *} a) ?=({$i *} a)) a - a(e (sum:si e.a b)) - :: - ++ fli :: flip sign - |= {a/fn} ^- fn - ?-(-.a $f a(s !s.a), $i a(s !s.a), $n a) - :: - ++ swr ?+(r r $d %u, $u %d) :: flipped rounding - ++ prc ?>((gth p 1) p) :: force >= 2 precision - ++ den d :: denorm+flush+inf exp - ++ emn v :: minimum exponent - ++ emx (sum:si emn (sun:si w)) :: maximum exponent - ++ spd [e=emn a=1] :: smallest denormal - ++ spn [e=emn a=(bex (dec prc))] :: smallest normal - ++ lfn [e=emx a=(fil 0 prc 1)] :: largest - ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is > than all - ++ zer [e=--0 a=0] - -- - |% - ++ rou :: round - |= {a/fn} ^- fn - ?. ?=({$f *} a) a - ?~ a.a [%f s.a zer] - ?: s.a (^rou +>.a) - =.(r swr (fli (^rou +>.a))) - :: - ++ syn :: get sign - |= {a/fn} ^- ? - ?-(-.a $f s.a, $i s.a, $n &) - :: - ++ abs :: absolute value - |= {a/fn} ^- fn - ?: ?=({$f *} a) [%f & e.a a.a] - ?: ?=({$i *} a) [%i &] [%n ~] - :: - ++ add :: add - |= {a/fn b/fn} ^- fn - ?: |(?=({$n *} a) ?=({$n *} b)) [%n ~] - ?: |(?=({$i *} a) ?=({$i *} b)) - ?: &(?=({$i *} a) ?=({$i *} b)) - ?: =(a b) a [%n ~] - ?: ?=({$i *} a) a b - ?: |(=(a.a 0) =(a.b 0)) - ?. &(=(a.a 0) =(a.b 0)) %- rou ?~(a.a b a) - [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer] - %- |= {a/fn} - ?. ?=({$f *} a) a - ?. =(a.a 0) a - [%f !=(r %d) zer] - ?: =(s.a s.b) - ?: s.a (^add +>.a +>.b |) - =.(r swr (fli (^add +>.a +>.b |))) - ?: s.a (^sub +>.a +>.b |) - (^sub +>.b +>.a |) - :: - ++ ead :: exact add - |= {a/fn b/fn} ^- fn - ?: |(?=({$n *} a) ?=({$n *} b)) [%n ~] - ?: |(?=({$i *} a) ?=({$i *} b)) - ?: &(?=({$i *} a) ?=({$i *} b)) - ?: =(a b) a [%n ~] - ?: ?=({$i *} a) a b - ?: |(=(a.a 0) =(a.b 0)) - ?. &(=(a.a 0) =(a.b 0)) ?~(a.a b a) - [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer] - %- |= {a/fn} - ?. ?=({$f *} a) a - ?. =(a.a 0) a - [%f !=(r %d) zer] - ?: =(s.a s.b) - ?: s.a (^add +>.a +>.b &) - (fli (^add +>.a +>.b &)) - ?: s.a (^sub +>.a +>.b &) - (^sub +>.b +>.a &) - :: - ++ sub :: subtract - |= {a/fn b/fn} ^- fn (add a (fli b)) - :: - ++ mul :: multiply - |= {a/fn b/fn} ^- fn - ?: |(?=({$n *} a) ?=({$n *} b)) [%n ~] - ?: ?=({$i *} a) - ?: ?=({$i *} b) - [%i =(s.a s.b)] - ?: =(a.b 0) [%n ~] [%i =(s.a s.b)] - ?: ?=({$i *} b) - ?: =(a.a 0) [%n ~] [%i =(s.a s.b)] - ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer] - ?: =(s.a s.b) (^mul +>.a +>.b) - =.(r swr (fli (^mul +>.a +>.b))) - :: - ++ emu :: exact multiply - |= {a/fn b/fn} ^- fn - ?: |(?=({$n *} a) ?=({$n *} b)) [%n ~] - ?: ?=({$i *} a) - ?: ?=({$i *} b) - [%i =(s.a s.b)] - ?: =(a.b 0) [%n ~] [%i =(s.a s.b)] - ?: ?=({$i *} b) - ?: =(a.a 0) [%n ~] [%i =(s.a s.b)] - ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer] - [%f =(s.a s.b) (sum:si e.a e.b) (^^mul a.a a.b)] - :: - ++ div :: divide - |= {a/fn b/fn} ^- fn - ?: |(?=({$n *} a) ?=({$n *} b)) [%n ~] - ?: ?=({$i *} a) - ?: ?=({$i *} b) [%n ~] [%i =(s.a s.b)] - ?: ?=({$i *} b) [%f =(s.a s.b) zer] - ?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer] - ?: =(a.b 0) [%i =(s.a s.b)] - ?: =(s.a s.b) (^div +>.a +>.b) - =.(r swr (fli (^div +>.a +>.b))) - :: - ++ fma :: fused multiply-add - |= {a/fn b/fn c/fn} ^- fn :: (a * b) + c - (add (emu a b) c) - :: - ++ sqt :: square root - |= {a/fn} ^- fn - ?: ?=({$n *} a) [%n ~] - ?: ?=({$i *} a) ?:(s.a a [%n ~]) - ?~ a.a [%f s.a zer] - ?: s.a (^sqt +>.a) [%n ~] - :: - ++ inv :: inverse - |= {a/fn} ^- fn - (div [%f & --0 1] a) - :: - ++ sun :: uns integer to float - |= {a/@u} ^- fn - (rou [%f & --0 a]) - :: - ++ san :: sgn integer to float - |= {a/@s} ^- fn - =+ b=(old:si a) - (rou [%f -.b --0 +.b]) - :: - :: comparisons return ~ in the event of a NaN - ++ lth :: less-than - |= {a/fn b/fn} ^- (unit ?) - ?: |(?=({$n *} a) ?=({$n *} b)) ~ :- ~ - ?: =(a b) | - ?: ?=({$i *} a) !s.a ?: ?=({$i *} b) s.b - ?: |(=(a.a 0) =(a.b 0)) - ?: &(=(a.a 0) =(a.b 0)) | - ?: =(a.a 0) s.b !s.a - ?: !=(s.a s.b) s.b - ?: s.a (^lth +>.a +>.b) (^lth +>.b +>.a) - :: - ++ lte :: less-equal - |= {a/fn b/fn} ^- (unit ?) - %+ bind (lth b a) |= a/? !a - :: - ++ equ :: equal - |= {a/fn b/fn} ^- (unit ?) - ?: |(?=({$n *} a) ?=({$n *} b)) ~ :- ~ - ?: =(a b) & - ?: |(?=({$i *} a) ?=({$i *} b)) | - ?: |(=(a.a 0) =(a.b 0)) - ?: &(=(a.a 0) =(a.b 0)) & | - ?: |(=(e.a e.b) !=(s.a s.b)) | - (^equ +>.a +>.b) - :: - ++ gte :: greater-equal - |= {a/fn b/fn} ^- (unit ?) (lte b a) - :: - ++ gth :: greater-than - |= {a/fn b/fn} ^- (unit ?) (lth b a) - :: - ++ drg :: float to decimal - |= {a/fn} ^- dn - ?: ?=({$n *} a) [%n ~] - ?: ?=({$i *} a) [%i s.a] - ?~ a.a [%d s.a --0 0] - [%d s.a (^drg +>.a)] - :: - ++ grd :: decimal to float - |= {a/dn} ^- fn - ?: ?=({$n *} a) [%n ~] - ?: ?=({$i *} a) [%i s.a] - => .(r %n) - =+ q=(abs:si e.a) - ?: (syn:si e.a) - (mul [%f s.a --0 a.a] [%f & e.a (pow 5 q)]) - (div [%f s.a --0 a.a] [%f & (sun:si q) (pow 5 q)]) - :: - ++ toi :: round to integer @s - |= {a/fn} ^- (unit @s) - =+ b=(toj a) - ?. ?=({$f *} b) ~ :- ~ - =+ c=(^^mul (bex (abs:si e.b)) a.b) - (new:si s.b c) - :: - ++ toj :: round to integer fn - |= {a/fn} ^- fn - ?. ?=({$f *} a) a - ?~ a.a [%f s.a zer] - ?: s.a (^toj +>.a) - =.(r swr (fli (^toj +>.a))) - -- -:: -++ ff :: ieee 754 format fp - |_ {{w/@u p/@u b/@s} r/$?($n $u $d $z $a)} - :: this core has no use outside of the functionality - :: provided to ++rd, ++rs, ++rq, and ++rh - :: - :: w=width: bits in exponent field - :: p=precision: bits in fraction field - :: w=bias: added to exponent when storing - :: r=rounding mode: same as in ++fl - :: - ++ sb (bex (^add w p)) :: sign bit - ++ me (dif:si (dif:si --1 b) (sun:si p)) :: minimum exponent - :: - ++ pa - %*(. fl p +(p), v me, w (^sub (bex w) 3), d %d, r r) - :: - ++ sea :: @r to fn - |= {a/@r} ^- fn - =+ [f=(cut 0 [0 p] a) e=(cut 0 [p w] a)] - =+ s=(sig a) - ?: =(e 0) - ?: =(f 0) [%f s --0 0] [%f s me f] - ?: =(e (fil 0 w 1)) - ?: =(f 0) [%i s] [%n ~] - =+ q=:(sum:si (sun:si e) me -1) - =+ r=(^add f (bex p)) - [%f s q r] - :: - ++ bit |= {a/fn} (bif (rou:pa a)) :: fn to @r w+ rounding - :: - ++ bif :: fn to @r no rounding - |= {a/fn} ^- @r - ?: ?=({$i *} a) - =+ q=(lsh 0 p (fil 0 w 1)) - ?: s.a q (^add q sb) - ?: ?=({$n *} a) (lsh 0 (dec p) (fil 0 +(w) 1)) - ?~ a.a ?: s.a `@r`0 sb - =+ ma=(met 0 a.a) - ?. =(ma +(p)) - ?> =(e.a me) - ?> (^lth ma +(p)) - ?: s.a `@r`a.a (^add a.a sb) - =+ q=(sum:si (dif:si e.a me) --1) - =+ r=(^add (lsh 0 p (abs:si q)) (end 0 p a.a)) - ?: s.a r (^add r sb) - :: - ++ sig :: get sign - |= {a/@r} ^- ? - =(0 (cut 0 [(^add p w) 1] a)) - :: - ++ exp :: get exponent - |= {a/@r} ^- @s - (dif:si (sun:si (cut 0 [p w] a)) b) - :: - ++ add :: add - |= {a/@r b/@r} - (bif (add:pa (sea a) (sea b))) - :: - ++ sub :: subtract - |= {a/@r b/@r} - (bif (sub:pa (sea a) (sea b))) - :: - ++ mul :: multiply - |= {a/@r b/@r} - (bif (mul:pa (sea a) (sea b))) - :: - ++ div :: divide - |= {a/@r b/@r} - (bif (div:pa (sea a) (sea b))) - :: - ++ fma :: fused multiply-add - |= {a/@r b/@r c/@r} - (bif (fma:pa (sea a) (sea b) (sea c))) - :: - ++ sqt :: square root - |= {a/@r} - (bif (sqt:pa (sea a))) - :: - ++ lth :: less-than - |= {a/@r b/@r} (fall (lth:pa (sea a) (sea b)) |) - ++ lte :: less-equals - |= {a/@r b/@r} (fall (lte:pa (sea a) (sea b)) |) - ++ equ :: equals - |= {a/@r b/@r} (fall (equ:pa (sea a) (sea b)) |) - ++ gte :: greater-equals - |= {a/@r b/@r} (fall (gte:pa (sea a) (sea b)) |) - ++ gth :: greater-than - |= {a/@r b/@r} (fall (gth:pa (sea a) (sea b)) |) - ++ sun :: uns integer to @r - |= {a/@u} (bit [%f & --0 a]) - ++ san :: signed integer to @r - |= {a/@s} (bit [%f (syn:si a) --0 (abs:si a)]) - ++ toi :: round to integer - |= {a/@r} (toi:pa (sea a)) - ++ drg :: @r to decimal float - |= {a/@r} (drg:pa (sea a)) - ++ grd :: decimal float to @r - |= {a/dn} (bif (grd:pa a)) - -- -:: -++ rlyd |= a/@rd ^- dn (drg:rd a) :: prep @rd for print -++ rlys |= a/@rs ^- dn (drg:rs a) :: prep @rs for print -++ rlyh |= a/@rh ^- dn (drg:rh a) :: prep @rh for print -++ rlyq |= a/@rq ^- dn (drg:rq a) :: prep @rq for print -++ ryld |= a/dn ^- @rd (grd:rd a) :: finish parsing @rd -++ ryls |= a/dn ^- @rs (grd:rs a) :: finish parsing @rs -++ rylh |= a/dn ^- @rh (grd:rh a) :: finish parsing @rh -++ rylq |= a/dn ^- @rq (grd:rq a) :: finish parsing @rq -:: -++ rd :: double precision fp - ~% %rd +> ~ - |_ r/$?($n $u $d $z) - :: round to nearest, round up, round down, round to zero - :: - ++ ma - %*(. ff w 11, p 52, b --1.023, r r) - :: - ++ sea :: @rd to fn - |= {a/@rd} (sea:ma a) - :: - ++ bit :: fn to @rd - |= {a/fn} ^- @rd (bit:ma a) - :: - ++ add ~/ %add :: add - |= {a/@rd b/@rd} ^- @rd - ~_ leaf+"rd-fail" - (add:ma a b) - :: - ++ sub ~/ %sub :: subtract - |= {a/@rd b/@rd} ^- @rd - ~_ leaf+"rd-fail" - (sub:ma a b) - :: - ++ mul ~/ %mul :: multiply - |= {a/@rd b/@rd} ^- @rd - ~_ leaf+"rd-fail" - (mul:ma a b) - :: - ++ div ~/ %div :: divide - |= {a/@rd b/@rd} ^- @rd - ~_ leaf+"rd-fail" - (div:ma a b) - :: - ++ fma ~/ %fma :: fused multiply-add - |= {a/@rd b/@rd c/@rd} ^- @rd - ~_ leaf+"rd-fail" - (fma:ma a b c) - :: - ++ sqt ~/ %sqt :: square root - |= {a/@rd} ^- @rd ~_ leaf+"rd-fail" - (sqt:ma a) - :: - ++ lth ~/ %lth :: less-than - |= {a/@rd b/@rd} - ~_ leaf+"rd-fail" - (lth:ma a b) - :: - ++ lte ~/ %lte :: less-equals - |= {a/@rd b/@rd} - ~_ leaf+"rd-fail" - (lte:ma a b) - :: - ++ equ ~/ %equ :: equals - |= {a/@rd b/@rd} - ~_ leaf+"rd-fail" - (equ:ma a b) - :: - ++ gte ~/ %gte :: greater-equals - |= {a/@rd b/@rd} - ~_ leaf+"rd-fail" - (gte:ma a b) - :: - ++ gth ~/ %gth :: greater-than - |= {a/@rd b/@rd} - ~_ leaf+"rd-fail" - (gth:ma a b) - :: - ++ sun |= {a/@u} ^- @rd (sun:ma a) :: uns integer to @rd - ++ san |= {a/@s} ^- @rd (san:ma a) :: sgn integer to @rd - ++ sig |= {a/@rd} ^- ? (sig:ma a) :: get sign - ++ exp |= {a/@rd} ^- @s (exp:ma a) :: get exponent - ++ toi |= {a/@rd} ^- (unit @s) (toi:ma a) :: round to integer - ++ drg |= {a/@rd} ^- dn (drg:ma a) :: @rd to decimal float - ++ grd |= {a/dn} ^- @rd (grd:ma a) :: decimal float to @rd - -- -:: -++ rs :: single precision fp - ~% %rs +> ~ - |_ r/$?($n $u $d $z) - :: round to nearest, round up, round down, round to zero - :: - ++ ma - %*(. ff w 8, p 23, b --127, r r) - :: - ++ sea :: @rs to fn - |= {a/@rs} (sea:ma a) - :: - ++ bit :: fn to @rs - |= {a/fn} ^- @rs (bit:ma a) - :: - ++ add ~/ %add :: add - |= {a/@rs b/@rs} ^- @rs - ~_ leaf+"rs-fail" - (add:ma a b) - :: - ++ sub ~/ %sub :: subtract - |= {a/@rs b/@rs} ^- @rs - ~_ leaf+"rs-fail" - (sub:ma a b) - :: - ++ mul ~/ %mul :: multiply - |= {a/@rs b/@rs} ^- @rs - ~_ leaf+"rs-fail" - (mul:ma a b) - :: - ++ div ~/ %div :: divide - |= {a/@rs b/@rs} ^- @rs - ~_ leaf+"rs-fail" - (div:ma a b) - :: - ++ fma ~/ %fma :: fused multiply-add - |= {a/@rs b/@rs c/@rs} ^- @rs - ~_ leaf+"rs-fail" - (fma:ma a b c) - :: - ++ sqt ~/ %sqt :: square root - |= {a/@rs} ^- @rs - ~_ leaf+"rs-fail" - (sqt:ma a) - :: - ++ lth ~/ %lth :: less-than - |= {a/@rs b/@rs} - ~_ leaf+"rs-fail" - (lth:ma a b) - :: - ++ lte ~/ %lte :: less-equals - |= {a/@rs b/@rs} - ~_ leaf+"rs-fail" - (lte:ma a b) - :: - ++ equ ~/ %equ :: equals - |= {a/@rs b/@rs} - ~_ leaf+"rs-fail" - (equ:ma a b) - :: - ++ gte ~/ %gte :: greater-equals - |= {a/@rs b/@rs} - ~_ leaf+"rs-fail" - (gte:ma a b) - :: - ++ gth ~/ %gth :: greater-than - |= {a/@rs b/@rs} - ~_ leaf+"rs-fail" - (gth:ma a b) - :: - ++ sun |= {a/@u} ^- @rs (sun:ma a) :: uns integer to @rs - ++ san |= {a/@s} ^- @rs (san:ma a) :: sgn integer to @rs - ++ sig |= {a/@rs} ^- ? (sig:ma a) :: get sign - ++ exp |= {a/@rs} ^- @s (exp:ma a) :: get exponent - ++ toi |= {a/@rs} ^- (unit @s) (toi:ma a) :: round to integer - ++ drg |= {a/@rs} ^- dn (drg:ma a) :: @rs to decimal float - ++ grd |= {a/dn} ^- @rs (grd:ma a) :: decimal float to @rs - -- -:: -++ rq :: quad precision fp - ~% %rq +> ~ - |_ r/$?($n $u $d $z) - :: round to nearest, round up, round down, round to zero - :: - ++ ma - %*(. ff w 15, p 112, b --16.383, r r) - :: - ++ sea :: @rq to fn - |= {a/@rq} (sea:ma a) - :: - ++ bit :: fn to @rq - |= {a/fn} ^- @rq (bit:ma a) - :: - ++ add ~/ %add :: add - |= {a/@rq b/@rq} ^- @rq - ~_ leaf+"rq-fail" - (add:ma a b) - :: - ++ sub ~/ %sub :: subtract - |= {a/@rq b/@rq} ^- @rq - ~_ leaf+"rq-fail" - (sub:ma a b) - :: - ++ mul ~/ %mul :: multiply - |= {a/@rq b/@rq} ^- @rq - ~_ leaf+"rq-fail" - (mul:ma a b) - :: - ++ div ~/ %div :: divide - |= {a/@rq b/@rq} ^- @rq - ~_ leaf+"rq-fail" - (div:ma a b) - :: - ++ fma ~/ %fma :: fused multiply-add - |= {a/@rq b/@rq c/@rq} ^- @rq - ~_ leaf+"rq-fail" - (fma:ma a b c) - :: - ++ sqt ~/ %sqt :: square root - |= {a/@rq} ^- @rq - ~_ leaf+"rq-fail" - (sqt:ma a) - :: - ++ lth ~/ %lth :: less-than - |= {a/@rq b/@rq} - ~_ leaf+"rq-fail" - (lth:ma a b) - :: - ++ lte ~/ %lte :: less-equals - |= {a/@rq b/@rq} - ~_ leaf+"rq-fail" - (lte:ma a b) - :: - ++ equ ~/ %equ :: equals - |= {a/@rq b/@rq} - ~_ leaf+"rq-fail" - (equ:ma a b) - :: - ++ gte ~/ %gte :: greater-equals - |= {a/@rq b/@rq} - ~_ leaf+"rq-fail" - (gte:ma a b) - :: - ++ gth ~/ %gth :: greater-than - |= {a/@rq b/@rq} - ~_ leaf+"rq-fail" - (gth:ma a b) - :: - ++ sun |= {a/@u} ^- @rq (sun:ma a) :: uns integer to @rq - ++ san |= {a/@s} ^- @rq (san:ma a) :: sgn integer to @rq - ++ sig |= {a/@rq} ^- ? (sig:ma a) :: get sign - ++ exp |= {a/@rq} ^- @s (exp:ma a) :: get exponent - ++ toi |= {a/@rq} ^- (unit @s) (toi:ma a) :: round to integer - ++ drg |= {a/@rq} ^- dn (drg:ma a) :: @rq to decimal float - ++ grd |= {a/dn} ^- @rq (grd:ma a) :: decimal float to @rq - -- -:: -++ rh :: half precision fp - ~% %rh +> ~ - |_ r/$?($n $u $d $z) - :: round to nearest, round up, round down, round to zero - :: - ++ ma - %*(. ff w 5, p 10, b --15, r r) - :: - ++ sea :: @rh to fn - |= {a/@rh} (sea:ma a) - :: - ++ bit :: fn to @rh - |= {a/fn} ^- @rh (bit:ma a) - :: - ++ add ~/ %add :: add - |= {a/@rh b/@rh} ^- @rh - ~_ leaf+"rh-fail" - (add:ma a b) - :: - ++ sub ~/ %sub :: subtract - |= {a/@rh b/@rh} ^- @rh - ~_ leaf+"rh-fail" - (sub:ma a b) - :: - ++ mul ~/ %mul :: multiply - |= {a/@rh b/@rh} ^- @rh - ~_ leaf+"rh-fail" - (mul:ma a b) - :: - ++ div ~/ %div :: divide - |= {a/@rh b/@rh} ^- @rh - ~_ leaf+"rh-fail" - (div:ma a b) - :: - ++ fma ~/ %fma :: fused multiply-add - |= {a/@rh b/@rh c/@rh} ^- @rh - ~_ leaf+"rh-fail" - (fma:ma a b c) - :: - ++ sqt ~/ %sqt :: square root - |= {a/@rh} ^- @rh - ~_ leaf+"rh-fail" - (sqt:ma a) - :: - ++ lth ~/ %lth :: less-than - |= {a/@rh b/@rh} - ~_ leaf+"rh-fail" - (lth:ma a b) - :: - ++ lte ~/ %lte :: less-equals - |= {a/@rh b/@rh} - ~_ leaf+"rh-fail" - (lte:ma a b) - :: - ++ equ ~/ %equ :: equals - |= {a/@rh b/@rh} - ~_ leaf+"rh-fail" - (equ:ma a b) - :: - ++ gte ~/ %gte :: greater-equals - |= {a/@rh b/@rh} - ~_ leaf+"rh-fail" - (gte:ma a b) - :: - ++ gth ~/ %gth :: greater-than - |= {a/@rh b/@rh} - ~_ leaf+"rh-fail" - (gth:ma a b) - :: - ++ tos :: @rh to @rs - |= {a/@rh} (bit:rs (sea a)) - :: - ++ fos :: @rs to @rh - |= {a/@rs} (bit (sea:rs a)) - :: - ++ sun |= {a/@u} ^- @rh (sun:ma a) :: uns integer to @rh - ++ san |= {a/@s} ^- @rh (san:ma a) :: sgn integer to @rh - ++ sig |= {a/@rh} ^- ? (sig:ma a) :: get sign - ++ exp |= {a/@rh} ^- @s (exp:ma a) :: get exponent - ++ toi |= {a/@rh} ^- (unit @s) (toi:ma a) :: round to integer - ++ drg |= {a/@rh} ^- dn (drg:ma a) :: @rh to decimal float - ++ grd |= {a/dn} ^- @rh (grd:ma a) :: decimal float to @rh - -- -:: 3c: urbit time :: -:::: :: - :: year, yore, yell, yule, yall, yawn, yelp, yo :: - :: -++ year :: date to @d - |= det/date - ^- @da - =+ ^= yer - ?: a.det - (add 292.277.024.400 y.det) - (sub 292.277.024.400 (dec y.det)) - =+ day=(yawn yer m.det d.t.det) - (yule day h.t.det m.t.det s.t.det f.t.det) -:: -++ yore :: @d to date - |= now/@da - ^- date - =+ rip=(yell now) - =+ ger=(yall d.rip) - :- ?: (gth y.ger 292.277.024.400) - [a=& y=(sub y.ger 292.277.024.400)] - [a=| y=+((sub 292.277.024.400 y.ger))] - [m.ger d.ger h.rip m.rip s.rip f.rip] -:: -++ yell :: tarp from @d - |= now/@d - ^- tarp - =+ sec=(rsh 6 1 now) - =+ ^= fan - =+ [muc=4 raw=(end 6 1 now)] - |- ^- (list @ux) - ?: |(=(0 raw) =(0 muc)) - ~ - => .(muc (dec muc)) - [(cut 4 [muc 1] raw) $(raw (end 4 muc raw))] - =+ day=(div sec day:yo) - => .(sec (mod sec day:yo)) - =+ hor=(div sec hor:yo) - => .(sec (mod sec hor:yo)) - =+ mit=(div sec mit:yo) - => .(sec (mod sec mit:yo)) - [day hor mit sec fan] -:: -++ yule :: time atom - |= rip/tarp - ^- @d - =+ ^= sec ;: add - (mul d.rip day:yo) - (mul h.rip hor:yo) - (mul m.rip mit:yo) - s.rip - == - =+ ^= fac =+ muc=4 - |- ^- @ - ?~ f.rip - 0 - => .(muc (dec muc)) - (add (lsh 4 muc i.f.rip) $(f.rip t.f.rip)) - (con (lsh 6 1 sec) fac) -:: -++ yall :: day / to day of year - |= day/@ud - ^- {y/@ud m/@ud d/@ud} - =+ [era=0 cet=0 lep=*?] - => .(era (div day era:yo), day (mod day era:yo)) - => ^+ . - ?: (lth day +(cet:yo)) - .(lep &, cet 0) - => .(lep |, cet 1, day (sub day +(cet:yo))) - .(cet (add cet (div day cet:yo)), day (mod day cet:yo)) - =+ yer=(add (mul 400 era) (mul 100 cet)) - |- ^- {y/@ud m/@ud d/@ud} - =+ dis=?:(lep 366 365) - ?. (lth day dis) - =+ ner=+(yer) - $(yer ner, day (sub day dis), lep =(0 (end 0 2 ner))) - |- ^- {y/@ud m/@ud d/@ud} - =+ [mot=0 cah=?:(lep moy:yo moh:yo)] - |- ^- {y/@ud m/@ud d/@ud} - =+ zis=(snag mot cah) - ?: (lth day zis) - [yer +(mot) +(day)] - $(mot +(mot), day (sub day zis)) -:: -++ yawn :: days since Jesus - |= {yer/@ud mot/@ud day/@ud} - ^- @ud - => .(mot (dec mot), day (dec day)) - => ^+ . - %= . - day - =+ cah=?:((yelp yer) moy:yo moh:yo) - |- ^- @ud - ?: =(0 mot) - day - $(mot (dec mot), cah (slag 1 cah), day (add day (snag 0 cah))) - == - |- ^- @ud - ?. =(0 (mod yer 4)) - =+ ney=(dec yer) - $(yer ney, day (add day ?:((yelp ney) 366 365))) - ?. =(0 (mod yer 100)) - =+ nef=(sub yer 4) - $(yer nef, day (add day ?:((yelp nef) 1.461 1.460))) - ?. =(0 (mod yer 400)) - =+ nec=(sub yer 100) - $(yer nec, day (add day ?:((yelp nec) 36.525 36.524))) - (add day (mul (div yer 400) (add 1 (mul 4 36.524)))) -:: -++ yelp :: leap year - |= yer/@ud ^- ? - &(=(0 (mod yer 4)) |(!=(0 (mod yer 100)) =(0 (mod yer 400)))) -:: -++ yo :: time constants - |% ++ cet 36.524 :: (add 24 (mul 100 365)) - ++ day 86.400 :: (mul 24 hor) - ++ era 146.097 :: (add 1 (mul 4 cet)) - ++ hor 3.600 :: (mul 60 mit) - ++ jes 106.751.991.084.417 :: (mul 730.692.561 era) - ++ mit 60 - ++ moh `(list @ud)`[31 28 31 30 31 30 31 31 30 31 30 31 ~] - ++ moy `(list @ud)`[31 29 31 30 31 30 31 31 30 31 30 31 ~] - ++ qad 126.144.001 :: (add 1 (mul 4 yer)) - ++ yer 31.536.000 :: (mul 365 day) - -- -:: :: -:::: 3d: SHA hash family :: - :: :: - :: -++ shad |=(ruz/@ (shax (shax ruz))) :: double sha-256 -++ shaf :: half sha-256 - |= {sal/@ ruz/@} - =+ haz=(shas sal ruz) - (mix (end 7 1 haz) (rsh 7 1 haz)) -:: -++ sham :: 128bit noun hash - |= yux/* ^- @uvH ^- @ - ?@ yux - (shaf %mash yux) - (shaf %sham (jam yux)) -:: -++ shas :: salted hash - |= {sal/@ ruz/@} - (shax (mix sal (shax ruz))) -:: -++ shax :: sha-256 - ~/ %shax - |= ruz/@ ^- @ - (shay [(met 3 ruz) ruz]) -:: -++ shay :: sha-256 with length - ~/ %shay - |= {len/@u ruz/@} ^- @ - => .(ruz (cut 3 [0 len] ruz)) - =+ [few==>(fe .(a 5)) wac=|=({a/@ b/@} (cut 5 [a 1] b))] - =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few] - =+ ral=(lsh 0 3 len) - =+ ^= ful - %+ can 0 - :~ [ral ruz] - [8 128] - [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0] - [64 (~(net fe 6) ral)] - == - =+ lex=(met 9 ful) - =+ ^= kbx 0xc671.78f2.bef9.a3f7.a450.6ceb.90be.fffa. - 8cc7.0208.84c8.7814.78a5.636f.748f.82ee. - 682e.6ff3.5b9c.ca4f.4ed8.aa4a.391c.0cb3. - 34b0.bcb5.2748.774c.1e37.6c08.19a4.c116. - 106a.a070.f40e.3585.d699.0624.d192.e819. - c76c.51a3.c24b.8b70.a81a.664b.a2bf.e8a1. - 9272.2c85.81c2.c92e.766a.0abb.650a.7354. - 5338.0d13.4d2c.6dfc.2e1b.2138.27b7.0a85. - 1429.2967.06ca.6351.d5a7.9147.c6e0.0bf3. - bf59.7fc7.b003.27c8.a831.c66d.983e.5152. - 76f9.88da.5cb0.a9dc.4a74.84aa.2de9.2c6f. - 240c.a1cc.0fc1.9dc6.efbe.4786.e49b.69c1. - c19b.f174.9bdc.06a7.80de.b1fe.72be.5d74. - 550c.7dc3.2431.85be.1283.5b01.d807.aa98. - ab1c.5ed5.923f.82a4.59f1.11f1.3956.c25b. - e9b5.dba5.b5c0.fbcf.7137.4491.428a.2f98 - =+ ^= hax 0x5be0.cd19.1f83.d9ab.9b05.688c.510e.527f. - a54f.f53a.3c6e.f372.bb67.ae85.6a09.e667 - =+ i=0 - |- ^- @ - ?: =(i lex) - (rep 5 (turn (rip 5 hax) net)) - =+ ^= wox - =+ dux=(cut 9 [i 1] ful) - =+ wox=(rep 5 (turn (rip 5 dux) net)) - =+ j=16 - |- ^- @ - ?: =(64 j) - wox - =+ :* l=(wac (sub j 15) wox) - m=(wac (sub j 2) wox) - n=(wac (sub j 16) wox) - o=(wac (sub j 7) wox) - == - =+ x=:(mix (ror 0 7 l) (ror 0 18 l) (rsh 0 3 l)) - =+ y=:(mix (ror 0 17 m) (ror 0 19 m) (rsh 0 10 m)) - =+ z=:(sum n x o y) - $(wox (con (lsh 5 j z) wox), j +(j)) - =+ j=0 - =+ :* a=(wac 0 hax) - b=(wac 1 hax) - c=(wac 2 hax) - d=(wac 3 hax) - e=(wac 4 hax) - f=(wac 5 hax) - g=(wac 6 hax) - h=(wac 7 hax) - == - |- ^- @ - ?: =(64 j) - %= ^$ - i +(i) - hax %+ rep 5 - :~ (sum a (wac 0 hax)) - (sum b (wac 1 hax)) - (sum c (wac 2 hax)) - (sum d (wac 3 hax)) - (sum e (wac 4 hax)) - (sum f (wac 5 hax)) - (sum g (wac 6 hax)) - (sum h (wac 7 hax)) - == - == - =+ l=:(mix (ror 0 2 a) (ror 0 13 a) (ror 0 22 a)) :: s0 - =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj - =+ n=(sum l m) :: t2 - =+ o=:(mix (ror 0 6 e) (ror 0 11 e) (ror 0 25 e)) :: s1 - =+ p=(mix (dis e f) (dis (inv e) g)) :: ch - =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1 - $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g) -:: -++ shaw :: hash to nbits - |= {sal/@ len/@ ruz/@} - (~(raw og (shas sal (mix len ruz))) len) -:: -++ shaz :: sha-512 - |= ruz/@ ^- @ - (shal [(met 3 ruz) ruz]) -:: -++ shal :: sha-512 with length - ~/ %shal - |= {len/@ ruz/@} ^- @ - => .(ruz (cut 3 [0 len] ruz)) - =+ [few==>(fe .(a 6)) wac=|=({a/@ b/@} (cut 6 [a 1] b))] - =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few] - =+ ral=(lsh 0 3 len) - =+ ^= ful - %+ can 0 - :~ [ral ruz] - [8 128] - [(mod (sub 1.920 (mod (add 8 ral) 1.024)) 1.024) 0] - [128 (~(net fe 7) ral)] - == - =+ lex=(met 10 ful) - =+ ^= kbx 0x6c44.198c.4a47.5817.5fcb.6fab.3ad6.faec. - 597f.299c.fc65.7e2a.4cc5.d4be.cb3e.42b6. - 431d.67c4.9c10.0d4c.3c9e.be0a.15c9.bebc. - 32ca.ab7b.40c7.2493.28db.77f5.2304.7d84. - 1b71.0b35.131c.471b.113f.9804.bef9.0dae. - 0a63.7dc5.a2c8.98a6.06f0.67aa.7217.6fba. - f57d.4f7f.ee6e.d178.eada.7dd6.cde0.eb1e. - d186.b8c7.21c0.c207.ca27.3ece.ea26.619c. - c671.78f2.e372.532b.bef9.a3f7.b2c6.7915. - a450.6ceb.de82.bde9.90be.fffa.2363.1e28. - 8cc7.0208.1a64.39ec.84c8.7814.a1f0.ab72. - 78a5.636f.4317.2f60.748f.82ee.5def.b2fc. - 682e.6ff3.d6b2.b8a3.5b9c.ca4f.7763.e373. - 4ed8.aa4a.e341.8acb.391c.0cb3.c5c9.5a63. - 34b0.bcb5.e19b.48a8.2748.774c.df8e.eb99. - 1e37.6c08.5141.ab53.19a4.c116.b8d2.d0c8. - 106a.a070.32bb.d1b8.f40e.3585.5771.202a. - d699.0624.5565.a910.d192.e819.d6ef.5218. - c76c.51a3.0654.be30.c24b.8b70.d0f8.9791. - a81a.664b.bc42.3001.a2bf.e8a1.4cf1.0364. - 9272.2c85.1482.353b.81c2.c92e.47ed.aee6. - 766a.0abb.3c77.b2a8.650a.7354.8baf.63de. - 5338.0d13.9d95.b3df.4d2c.6dfc.5ac4.2aed. - 2e1b.2138.5c26.c926.27b7.0a85.46d2.2ffc. - 1429.2967.0a0e.6e70.06ca.6351.e003.826f. - d5a7.9147.930a.a725.c6e0.0bf3.3da8.8fc2. - bf59.7fc7.beef.0ee4.b003.27c8.98fb.213f. - a831.c66d.2db4.3210.983e.5152.ee66.dfab. - 76f9.88da.8311.53b5.5cb0.a9dc.bd41.fbd4. - 4a74.84aa.6ea6.e483.2de9.2c6f.592b.0275. - 240c.a1cc.77ac.9c65.0fc1.9dc6.8b8c.d5b5. - efbe.4786.384f.25e3.e49b.69c1.9ef1.4ad2. - c19b.f174.cf69.2694.9bdc.06a7.25c7.1235. - 80de.b1fe.3b16.96b1.72be.5d74.f27b.896f. - 550c.7dc3.d5ff.b4e2.2431.85be.4ee4.b28c. - 1283.5b01.4570.6fbe.d807.aa98.a303.0242. - ab1c.5ed5.da6d.8118.923f.82a4.af19.4f9b. - 59f1.11f1.b605.d019.3956.c25b.f348.b538. - e9b5.dba5.8189.dbbc.b5c0.fbcf.ec4d.3b2f. - 7137.4491.23ef.65cd.428a.2f98.d728.ae22 - =+ ^= hax 0x5be0.cd19.137e.2179.1f83.d9ab.fb41.bd6b. - 9b05.688c.2b3e.6c1f.510e.527f.ade6.82d1. - a54f.f53a.5f1d.36f1.3c6e.f372.fe94.f82b. - bb67.ae85.84ca.a73b.6a09.e667.f3bc.c908 - =+ i=0 - |- ^- @ - ?: =(i lex) - (rep 6 (turn (rip 6 hax) net)) - =+ ^= wox - =+ dux=(cut 10 [i 1] ful) - =+ wox=(rep 6 (turn (rip 6 dux) net)) - =+ j=16 - |- ^- @ - ?: =(80 j) - wox - =+ :* l=(wac (sub j 15) wox) - m=(wac (sub j 2) wox) - n=(wac (sub j 16) wox) - o=(wac (sub j 7) wox) - == - =+ x=:(mix (ror 0 1 l) (ror 0 8 l) (rsh 0 7 l)) - =+ y=:(mix (ror 0 19 m) (ror 0 61 m) (rsh 0 6 m)) - =+ z=:(sum n x o y) - $(wox (con (lsh 6 j z) wox), j +(j)) - =+ j=0 - =+ :* a=(wac 0 hax) - b=(wac 1 hax) - c=(wac 2 hax) - d=(wac 3 hax) - e=(wac 4 hax) - f=(wac 5 hax) - g=(wac 6 hax) - h=(wac 7 hax) - == - |- ^- @ - ?: =(80 j) - %= ^$ - i +(i) - hax %+ rep 6 - :~ (sum a (wac 0 hax)) - (sum b (wac 1 hax)) - (sum c (wac 2 hax)) - (sum d (wac 3 hax)) - (sum e (wac 4 hax)) - (sum f (wac 5 hax)) - (sum g (wac 6 hax)) - (sum h (wac 7 hax)) - == - == - =+ l=:(mix (ror 0 28 a) (ror 0 34 a) (ror 0 39 a)) :: S0 - =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj - =+ n=(sum l m) :: t2 - =+ o=:(mix (ror 0 14 e) (ror 0 18 e) (ror 0 41 e)) :: S1 - =+ p=(mix (dis e f) (dis (inv e) g)) :: ch - =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1 - $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g) -:: -++ shan :: sha-1 (deprecated) - |= ruz/@ - =+ [few==>(fe .(a 5)) wac=|=({a/@ b/@} (cut 5 [a 1] b))] - =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few] - =+ ral=(lsh 0 3 (met 3 ruz)) - =+ ^= ful - %+ can 0 - :~ [ral ruz] - [8 128] - [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0] - [64 (~(net fe 6) ral)] - == - =+ lex=(met 9 ful) - =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999 - =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301 - =+ i=0 - |- - ?: =(i lex) - (rep 5 (flop (rip 5 hax))) - =+ ^= wox - =+ dux=(cut 9 [i 1] ful) - =+ wox=(rep 5 (turn (rip 5 dux) net)) - =+ j=16 - |- ^- @ - ?: =(80 j) - wox - =+ :* l=(wac (sub j 3) wox) - m=(wac (sub j 8) wox) - n=(wac (sub j 14) wox) - o=(wac (sub j 16) wox) - == - =+ z=(rol 0 1 :(mix l m n o)) - $(wox (con (lsh 5 j z) wox), j +(j)) - =+ j=0 - =+ :* a=(wac 0 hax) - b=(wac 1 hax) - c=(wac 2 hax) - d=(wac 3 hax) - e=(wac 4 hax) - == - |- ^- @ - ?: =(80 j) - %= ^$ - i +(i) - hax %+ rep 5 - :~ - (sum a (wac 0 hax)) - (sum b (wac 1 hax)) - (sum c (wac 2 hax)) - (sum d (wac 3 hax)) - (sum e (wac 4 hax)) - == - == - =+ fx=(con (dis b c) (dis (not 5 1 b) d)) - =+ fy=:(mix b c d) - =+ fz=:(con (dis b c) (dis b d) (dis c d)) - =+ ^= tem - ?: &((gte j 0) (lte j 19)) - :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox)) - ?: &((gte j 20) (lte j 39)) - :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox)) - ?: &((gte j 40) (lte j 59)) - :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox)) - :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox)) - $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d) -:: -++ og :: shax-powered rng - ~/ %og - |_ a/@ - ++ rad :: random in range - |= b/@ ^- @ - =+ c=(raw (met 0 b)) - ?:((lth c b) c $(a +(a))) - :: - ++ rads :: random continuation - |= b/@ - =+ r=(rad b) - [r +>.$(a (shas %og-s (mix a r)))] - :: - ++ raw :: random bits - ~/ %raw - |= b/@ ^- @ - %+ can - 0 - =+ c=(shas %og-a (mix b a)) - |- ^- (list {@ @}) - ?: =(0 b) - ~ - =+ d=(shas %og-b (mix b (mix a c))) - ?: (lth b 256) - [[b (end 0 b d)] ~] - [[256 d] $(c d, b (sub b 256))] - :: - ++ raws :: random bits - |= b/@ :: continuation - =+ r=(raw b) - [r +>.$(a (shas %og-s (mix a r)))] - -- -:: :: -:::: 3e: AES encryption (XX removed) :: - :: :: - :: -:: :: -:::: 3f: scrambling :: - :: :: - :: ob :: - :: -++ un :: =(x (wred (wren x))) - |% - ++ wren :: conceal structure - |= pyn/@ ^- @ - =+ len=(met 3 pyn) - ?: =(0 len) - 0 - => .(len (dec len)) - =+ mig=(zaft (xafo len (cut 3 [len 1] pyn))) - %+ can 3 - %- flop ^- (list {@ @}) - :- [1 mig] - |- ^- (list {@ @}) - ?: =(0 len) - ~ - => .(len (dec len)) - =+ mog=(zyft :(mix mig (end 3 1 len) (cut 3 [len 1] pyn))) - [[1 mog] $(mig mog)] - :: - ++ wred :: restore structure - |= cry/@ ^- @ - =+ len=(met 3 cry) - ?: =(0 len) - 0 - => .(len (dec len)) - =+ mig=(cut 3 [len 1] cry) - %+ can 3 - %- flop ^- (list {@ @}) - :- [1 (xaro len (zart mig))] - |- ^- (list {@ @}) - ?: =(0 len) - ~ - => .(len (dec len)) - =+ mog=(cut 3 [len 1] cry) - [[1 :(mix mig (end 3 1 len) (zyrt mog))] $(mig mog)] - :: - ++ xafo |=({a/@ b/@} +((mod (add (dec b) a) 255))) - ++ xaro |=({a/@ b/@} +((mod (add (dec b) (sub 255 (mod a 255))) 255))) - :: - ++ zaft :: forward 255-sbox - |= a/@D - =+ ^= b - 0xcc.75bc.86c8.2fb1.9a42.f0b3.79a0.92ca.21f6.1e41.cde5.fcc0. - 7e85.51ae.1005.c72d.1246.07e8.7c64.a914.8d69.d9f4.59c2.8038. - 1f4a.dca2.6fdf.66f9.f561.a12e.5a16.f7b0.a39f.364e.cb70.7318. - 1de1.ad31.63d1.abd4.db68.6a33.134d.a760.edee.5434.493a.e323. - 930d.8f3d.3562.bb81.0b24.43cf.bea5.a6eb.52b4.0229.06b2.6704. - 78c9.45ec.d75e.58af.c577.b7b9.c40e.017d.90c3.87f8.96fa.1153. - 0372.7f30.1c32.ac83.ff17.c6e4.d36d.6b55.e2ce.8c71.8a5b.b6f3. - 9d4b.eab5.8b3c.e7f2.a8fe.9574.5de0.bf20.3f15.9784.9939.5f9c. - e609.564f.d8a4.b825.9819.94aa.2c08.8e4c.9b22.477a.2840.3ed6. - 3750.6ef1.44dd.89ef.6576.d00a.fbda.9ed2.3b6c.7b0c.bde9.2ade. - 5c88.c182.481a.1b0f.2bfd.d591.2726.57ba - (cut 3 [(dec a) 1] b) - :: - ++ zart :: reverse 255-sbox - |= a/@D - =+ ^= b - 0x68.4f07.ea1c.73c9.75c2.efc8.d559.5125.f621.a7a8.8591.5613. - dd52.40eb.65a2.60b7.4bcb.1123.ceb0.1bd6.3c84.2906.b164.19b3. - 1e95.5fec.ffbc.f187.fbe2.6680.7c77.d30e.e94a.9414.fd9a.017d. - 3a7e.5a55.8ff5.8bf9.c181.e5b6.6ab2.35da.50aa.9293.3bc0.cdc6. - f3bf.1a58.4130.f844.3846.744e.36a0.f205.789e.32d8.5e54.5c22. - 0f76.fce7.4569.0d99.d26e.e879.dc16.2df4.887f.1ffe.4dba.6f5d. - bbcc.2663.1762.aed7.af8a.ca20.dbb4.9bc7.a942.834c.105b.c4d4. - 8202.3e61.a671.90e6.273d.bdab.3157.cfa4.0c2e.df86.2496.f7ed. - 2b48.2a9d.5318.a343.d128.be9c.a5ad.6bb5.6dfa.c5e1.3408.128d. - 2c04.0339.97a1.2ff0.49d0.eeb8.6c0a.0b37.b967.c347.d9ac.e072. - e409.7b9f.1598.1d3f.33de.8ce3.8970.8e7a - (cut 3 [(dec a) 1] b) - :: - ++ zyft :: forward 256-sbox - |= a/@D - =+ ^= b - 0xbb49.b71f.b881.b402.17e4.6b86.69b5.1647.115f.dddb.7ca5. - 8371.4bd5.19a9.b092.605d.0d9b.e030.a0cc.78ba.5706.4d2d. - 986a.768c.f8e8.c4c7.2f1c.effe.3cae.01c0.253e.65d3.3872. - ce0e.7a74.8ac6.daac.7e5c.6479.44ec.4143.3d20.4af0.ee6c. - c828.deca.0377.249f.ffcd.7b4f.eb7d.66f2.8951.042e.595a. - 8e13.f9c3.a79a.f788.6199.9391.7fab.6200.4ce5.0758.e2f1. - 7594.c945.d218.4248.afa1.e61a.54fb.1482.bea4.96a2.3473. - 63c2.e7cb.155b.120a.4ed7.bfd8.b31b.4008.f329.fca3.5380. - 9556.0cb2.8722.2bea.e96e.3ac5.d1bc.10e3.2c52.a62a.b1d6. - 35aa.d05e.f6a8.0f3b.31ed.559d.09ad.f585.6d21.fd1d.8d67. - 370b.26f4.70c1.b923.4684.6fbd.cf8b.5036.0539.9cdc.d93f. - 9068.1edf.8f33.b632.d427.97fa.9ee1 - (cut 3 [a 1] b) - :: - ++ zyrt :: reverse 256-sbox - |= a/@D - =+ ^= b - 0x9fc8.2753.6e02.8fcf.8b35.2b20.5598.7caa.c9a9.30b0.9b48. - 47ce.6371.80f6.407d.00dd.0aa5.ed10.ecb7.0f5a.5c3a.e605. - c077.4337.17bd.9eda.62a4.79a7.ccb8.44cd.8e64.1ec4.5b6b. - 1842.ffd8.1dfb.fd07.f2f9.594c.3be3.73c6.2cb6.8438.e434. - 8d3d.ea6a.5268.72db.a001.2e11.de8c.88d3.0369.4f7a.87e2. - 860d.0991.25d0.16b9.978a.4bf4.2a1a.e96c.fa50.85b5.9aeb. - 9dbb.b2d9.a2d1.7bba.66be.e81f.1946.29a8.f5d2.f30c.2499. - c1b3.6583.89e1.ee36.e0b4.6092.937e.d74e.2f6f.513e.9615. - 9c5d.d581.e7ab.fe74.f01b.78b1.ae75.af57.0ec2.adc7.3245. - 12bf.2314.3967.0806.31dc.cb94.d43f.493c.54a6.0421.c3a1. - 1c4a.28ac.fc0b.26ca.5870.e576.f7f1.616d.905f.ef41.33bc. - df4d.225e.2d56.7fd6.1395.a3f8.c582 - (cut 3 [a 1] b) - -- -:: -++ ob - |% - ++ feen :: conceal structure v2 - |= pyn/@ ^- @ - ?: &((gte pyn 0x1.0000) (lte pyn 0xffff.ffff)) - (add 0x1.0000 (fice (sub pyn 0x1.0000))) - ?: &((gte pyn 0x1.0000.0000) (lte pyn 0xffff.ffff.ffff.ffff)) - =+ lo=(dis pyn 0xffff.ffff) - =+ hi=(dis pyn 0xffff.ffff.0000.0000) - %+ con hi - $(pyn lo) - pyn - :: - ++ fend :: restore structure v2 - |= cry/@ ^- @ - ?: &((gte cry 0x1.0000) (lte cry 0xffff.ffff)) - (add 0x1.0000 (teil (sub cry 0x1.0000))) - ?: &((gte cry 0x1.0000.0000) (lte cry 0xffff.ffff.ffff.ffff)) - =+ lo=(dis cry 0xffff.ffff) - =+ hi=(dis cry 0xffff.ffff.0000.0000) - %+ con hi - $(cry lo) - cry - :: - ++ fice :: adapted from - |= nor/@ :: black and rogaway - ^- @ :: "ciphers with - =+ ^= sel :: arbitrary finite - %+ rynd 3 :: domains", 2002 - %+ rynd 2 - %+ rynd 1 - %+ rynd 0 - [(mod nor 65.535) (div nor 65.535)] - (add (mul 65.535 -.sel) +.sel) - :: - ++ teil :: reverse ++fice - |= vip/@ - ^- @ - =+ ^= sel - %+ rund 0 - %+ rund 1 - %+ rund 2 - %+ rund 3 - [(mod vip 65.535) (div vip 65.535)] - (add (mul 65.535 -.sel) +.sel) - :: - ++ rynd :: feistel round - |= {n/@ l/@ r/@} - ^- {@ @} - :- r - ?~ (mod n 2) - (~(sum fo 65.535) l (muk (snag n raku) 2 r)) - (~(sum fo 65.536) l (muk (snag n raku) 2 r)) - :: - ++ rund :: reverse round - |= {n/@ l/@ r/@} - ^- {@ @} - :- r - ?~ (mod n 2) - (~(dif fo 65.535) l (muk (snag n raku) 2 r)) - (~(dif fo 65.536) l (muk (snag n raku) 2 r)) - :: - ++ raku - ^- (list @ux) - :~ 0xb76d.5eed - 0xee28.1300 - 0x85bc.ae01 - 0x4b38.7af7 - == - -- -:: -:::: 3g: molds and mold builders - :: -++ coin $% {$$ p/dime} :: print format - {$blob p/*} :: - {$many p/(list coin)} :: - == :: -++ dime {p/@ta q/@} :: -++ edge {p/hair q/(unit {p/* q/nail})} :: parsing output -++ hair {p/@ud q/@ud} :: parsing trace -++ like |* a/$-(* *) :: generic edge - |= b/_`*`[(hair) ~] :: - :- p=(hair -.b) :: - ^= q :: - ?@ +.b ~ :: - :- ~ :: - u=[p=(a +>-.b) q=[p=(hair -.b) q=(tape +.b)]] :: -++ nail {p/hair q/tape} :: parsing input -++ path (list knot) :: like unix path -++ pint {p/{p/@ q/@} q/{p/@ q/@}} :: line+column range -++ rule _|=(nail *edge) :: parsing rule -++ spot {p/path q/pint} :: range in file -++ tone $% {$0 p/*} :: success - {$1 p/(list)} :: blocks - {$2 p/(list {@ta *})} :: error report - == :: -++ toon $% {$0 p/*} :: success - {$1 p/(list)} :: blocks - {$2 p/(list tank)} :: stack trace - == :: -++ wonk |*(veq/edge ?~(q.veq !! p.u.q.veq)) :: product from edge --- => -:: :: -:::: 4: layer four :: - :: :: - :: 4a: exotic bases :: - :: 4b: text processing :: - :: 4c: tank printer :: - :: 4d: parsing (tracing) :: - :: 4e: parsing (combinators) :: - :: 4f: parsing (rule builders) :: - :: 4g: parsing (outside caller) :: - :: 4h: parsing (ascii glyphs) :: - :: 4i: parsing (useful idioms) :: - :: 4j: parsing (bases and base digits) :: - :: 4k: atom printing :: - :: 4l: atom parsing :: - :: 4m: formatting functions :: - :: 4n: virtualization :: - :: 4o: molds and mold builders :: - :: -~% %qua - + - == - %mute mute - %show show - == -|% -:: -:::: 4a: exotic bases - :: -++ po :: phonetic base - ~/ %po - =+ :- ^= sis :: prefix syllables - 'dozmarbinwansamlitsighidfidlissogdirwacsabwissib\ - /rigsoldopmodfoglidhopdardorlorhodfolrintogsilmir\ - /holpaslacrovlivdalsatlibtabhanticpidtorbolfosdot\ - /losdilforpilramtirwintadbicdifrocwidbisdasmidlop\ - /rilnardapmolsanlocnovsitnidtipsicropwitnatpanmin\ - /ritpodmottamtolsavposnapnopsomfinfonbanmorworsip\ - /ronnorbotwicsocwatdolmagpicdavbidbaltimtasmallig\ - /sivtagpadsaldivdactansidfabtarmonranniswolmispal\ - /lasdismaprabtobrollatlonnodnavfignomnibpagsopral\ - /bilhaddocridmocpacravripfaltodtiltinhapmicfanpat\ - /taclabmogsimsonpinlomrictapfirhasbosbatpochactid\ - /havsaplindibhosdabbitbarracparloddosbortochilmac\ - /tomdigfilfasmithobharmighinradmashalraglagfadtop\ - /mophabnilnosmilfopfamdatnoldinhatnacrisfotribhoc\ - /nimlarfitwalrapsarnalmoslandondanladdovrivbacpol\ - /laptalpitnambonrostonfodponsovnocsorlavmatmipfip' - ^= dex :: suffix syllables - 'zodnecbudwessevpersutletfulpensytdurwepserwylsun\ - /rypsyxdyrnuphebpeglupdepdysputlughecryttyvsydnex\ - /lunmeplutseppesdelsulpedtemledtulmetwenbynhexfeb\ - /pyldulhetmevruttylwydtepbesdexsefwycburderneppur\ - /rysrebdennutsubpetrulsynregtydsupsemwynrecmegnet\ - /secmulnymtevwebsummutnyxrextebfushepbenmuswyxsym\ - /selrucdecwexsyrwetdylmynmesdetbetbeltuxtugmyrpel\ - /syptermebsetdutdegtexsurfeltudnuxruxrenwytnubmed\ - /lytdusnebrumtynseglyxpunresredfunrevrefmectedrus\ - /bexlebduxrynnumpyxrygryxfeptyrtustyclegnemfermer\ - /tenlusnussyltecmexpubrymtucfyllepdebbermughuttun\ - /bylsudpemdevlurdefbusbeprunmelpexdytbyttyplevmyl\ - /wedducfurfexnulluclennerlexrupnedlecrydlydfenwel\ - /nydhusrelrudneshesfetdesretdunlernyrsebhulryllud\ - /remlysfynwerrycsugnysnyllyndyndemluxfedsedbecmun\ - /lyrtesmudnytbyrsenwegfyrmurtelreptegpecnelnevfes' - |% - ++ ins ~/ %ins :: parse prefix - |= a/@tas - =+ b=0 - |- ^- (unit @) - ?:(=(256 b) ~ ?:(=(a (tos b)) [~ b] $(b +(b)))) - ++ ind ~/ %ind :: parse suffix - |= a/@tas - =+ b=0 - |- ^- (unit @) - ?:(=(256 b) ~ ?:(=(a (tod b)) [~ b] $(b +(b)))) - ++ tos ~/ %tos :: fetch prefix - |=(a/@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] sis))) - ++ tod ~/ %tod :: fetch suffix - |=(a/@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] dex))) - -- -:: -++ fa :: base58check - =+ key='123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz' - =+ ^- yek/@ux ~+ - =- yek:(roll (rip 3 key) -) - =+ [a=*char b=*@ yek=`@ux`(fil 3 256 0xff)] - |. - [+(b) (mix yek (lsh 3 `@u`a (~(inv fe 3) b)))] - |% - ++ cha |=(a/char `(unit @uF)`=+(b=(cut 3 [`@`a 1] yek) ?:(=(b 0xff) ~ `b))) - ++ tok - |= a/@ux ^- @ux - =+ b=(pad a) - =- (~(net fe 5) (end 3 4 (shay 32 -))) - (shay (add b (met 3 a)) (lsh 3 b (swp 3 a))) - :: - ++ pad |=(a/@ =+(b=(met 3 a) ?:((gte b 21) 0 (sub 21 b)))) - ++ enc |=(a/@ux `@ux`(mix (lsh 3 4 a) (tok a))) - ++ den - |= a/@ux ^- (unit @ux) - =+ b=(rsh 3 4 a) - ?. =((tok b) (end 3 4 a)) - ~ - `b - -- -:: -:::: 4b: text processing - :: -++ at :: basic printing - |_ a/@ - ++ r - ?: ?& (gte (met 3 a) 2) - |- - ?: =(0 a) - & - =+ vis=(end 3 1 a) - ?& ?|(=('-' vis) ?&((gte vis 'a') (lte vis 'z'))) - $(a (rsh 3 1 a)) - == - == - rtam - ?: (lte (met 3 a) 2) - rud - rux - :: - ++ rf `tape`[?-(a $& '&', $| '|', * !!) ~] - ++ rn `tape`[?>(=(0 a) '~') ~] - ++ rt `tape`['\'' (weld (mesc (trip a)) `tape`['\'' ~])] - ++ rta rt - ++ rtam `tape`['%' (trip a)] - ++ rub `tape`['0' 'b' (rum 2 ~ |=(b/@ (add '0' b)))] - ++ rud (rum 10 ~ |=(b/@ (add '0' b))) - ++ rum - |= {b/@ c/tape d/$-(@ @)} - ^- tape - ?: =(0 a) - [(d 0) c] - =+ e=0 - |- ^- tape - ?: =(0 a) - c - =+ f=&(!=(0 e) =(0 (mod e ?:(=(10 b) 3 4)))) - %= $ - a (div a b) - c [(d (mod a b)) ?:(f [?:(=(10 b) ',' '-') c] c)] - e +(e) - == - :: - ++ rup - =+ b=(met 3 a) - ^- tape - :- '-' - |- ^- tape - ?: (gth (met 5 a) 1) - %+ weld - $(a (rsh 5 1 a), b (sub b 4)) - `tape`['-' '-' $(a (end 5 1 a), b 4)] - ?: =(0 b) - ['~' ~] - ?: (lte b 1) - (trip (tos:po a)) - |- ^- tape - ?: =(2 b) - =+ c=(rsh 3 1 a) - =+ d=(end 3 1 a) - (weld (trip (tod:po c)) (trip (tos:po (mix c d)))) - =+ c=(rsh 3 2 a) - =+ d=(end 3 2 a) - (weld ^$(a c, b (met 3 c)) `tape`['-' $(a (mix c d), b 2)]) - :: - ++ ruv - ^- tape - :+ '0' - 'v' - %^ rum - 64 - ~ - |= b/@ - ?: =(63 b) - '+' - ?: =(62 b) - '-' - ?:((lth b 26) (add 65 b) ?:((lth b 52) (add 71 b) (sub b 4))) - :: - ++ rux `tape`['0' 'x' (rum 16 ~ |=(b/@ (add b ?:((lth b 10) 48 87))))] - -- -++ cass :: lowercase - |= vib/tape - ^- tape - (turn vib |=(a/@ ?.(&((gte a 'A') (lte a 'Z')) a (add 32 a)))) -:: -++ cuss :: uppercase - |= vib/tape - ^- tape - (turn vib |=(a/@ ?.(&((gte a 'a') (lte a 'z')) a (sub a 32)))) -:: -++ crip |=(a/tape `@t`(rap 3 a)) :: tape to cord -:: -++ mesc :: ctrl code escape - |= vib/tape - ^- tape - ?~ vib - ~ - ?: =('\\' i.vib) - ['\\' '\\' $(vib t.vib)] - ?: ?|((gth i.vib 126) (lth i.vib 32) =(`@`39 i.vib)) - ['\\' (welp ~(rux at i.vib) '/' $(vib t.vib))] - [i.vib $(vib t.vib)] -:: -++ runt :: prepend repeatedly - |= {{a/@ b/@} c/tape} - ^- tape - ?: =(0 a) - c - [b $(a (dec a))] -:: -++ sand :: atom sanity - |= a/@ta - (flit (sane a)) -:: -++ sane :: atom sanity - |= a/@ta - |= b/@ ^- ? - ?> =(%t (end 3 1 a)) - =+ [inx=0 len=(met 3 b)] - ?: =(%tas a) - |- ^- ? - ?: =(inx len) & - =+ cur=(cut 3 [inx 1] b) - ?& ?| &((gte cur 'a') (lte cur 'z')) - &(=('-' cur) !=(0 inx) !=(len inx)) - &(&((gte cur '0') (lte cur '9')) !=(0 inx)) - == - $(inx +(inx)) - == - ?: =(%ta a) - |- ^- ? - ?: =(inx len) & - =+ cur=(cut 3 [inx 1] b) - ?& ?| &((gte cur 'a') (lte cur 'z')) - &((gte cur '0') (lte cur '9')) - |(=('-' cur) =('~' cur) =('_' cur) =('.' cur)) - == - $(inx +(inx)) - == - |- ^- ? - ?: =(0 b) & - =+ cur=(end 3 1 b) - ?: &((lth cur 32) !=(10 cur)) | - =+ len=(teff cur) - ?& |(=(1 len) =+(i=1 |-(|(=(i len) &((gte (cut 3 [i 1] b) 128) $(i +(i))))))) - $(b (rsh 3 len b)) - == -:: -++ trim :: tape split - |= {a/@ b/tape} - ^- {p/tape q/tape} - ?~ b - [~ ~] - ?: =(0 a) - [~ b] - =+ c=$(a (dec a), b t.b) - [[i.b p.c] q.c] -:: -++ trip :: cord to tape - ~/ %trip - |= a/@ ^- tape - ?: =(0 (met 3 a)) - ~ - [^-(@ta (end 3 1 a)) $(a (rsh 3 1 a))] -:: -++ teff :: length utf8 - |= a/@t ^- @ - =+ b=(end 3 1 a) - ?: =(0 b) - ?>(=(`@`0 a) 0) - ?> |((gte b 32) =(10 b)) - ?:((lte b 127) 1 ?:((lte b 223) 2 ?:((lte b 239) 3 4))) -:: -++ turf :: utf8 to utf32 - |= a/@t - ^- @c - %+ rap 5 - |- ^- (list @c) - =+ b=(teff a) - ?: =(0 b) ~ - =+ ^= c - %+ can 0 - %+ turn - ^- (list {p/@ q/@}) - ?+ b !! - $1 [[0 7] ~] - $2 [[8 6] [0 5] ~] - $3 [[16 6] [8 6] [0 4] ~] - $4 [[24 6] [16 6] [8 6] [0 3] ~] - == - |=({p/@ q/@} [q (cut 0 [p q] a)]) - ?> =((tuft c) (end 3 b a)) - [c $(a (rsh 3 b a))] -:: -++ tuba :: utf8 to utf32 tape - |= a/tape - ^- (list @c) - (rip 5 (turf (rap 3 a))) :: XX horrible -:: -++ tufa :: utf32 to utf8 tape - |= a/(list @c) - ^- tape - ?~ a "" - (weld (rip 3 (tuft i.a)) $(a t.a)) -:: -++ tuft :: utf32 to utf8 text - |= a/@c - ^- @t - %+ rap 3 - |- ^- (list @) - ?: =(`@`0 a) - ~ - =+ b=(end 5 1 a) - =+ c=$(a (rsh 5 1 a)) - ?: (lte b 0x7f) - [b c] - ?: (lte b 0x7ff) - :* (mix 0b1100.0000 (cut 0 [6 5] b)) - (mix 0b1000.0000 (end 0 6 b)) - c - == - ?: (lte b 0xffff) - :* (mix 0b1110.0000 (cut 0 [12 4] b)) - (mix 0b1000.0000 (cut 0 [6 6] b)) - (mix 0b1000.0000 (end 0 6 b)) - c - == - :* (mix 0b1111.0000 (cut 0 [18 3] b)) - (mix 0b1000.0000 (cut 0 [12 6] b)) - (mix 0b1000.0000 (cut 0 [6 6] b)) - (mix 0b1000.0000 (end 0 6 b)) - c - == -:: -++ wack :: knot escape - |= a/@ta - ^- @ta - =+ b=(rip 3 a) - %+ rap 3 - |- ^- tape - ?~ b - ~ - ?: =('~' i.b) ['~' '~' $(b t.b)] - ?: =('_' i.b) ['~' '-' $(b t.b)] - [i.b $(b t.b)] -:: -++ wick :: knot unescape - |= a/@ - ^- (unit @ta) - =+ b=(rip 3 a) - =- ?^(b ~ (some (rap 3 (flop c)))) - =| c/tape - |- ^- {b/tape c/tape} - ?~ b [~ c] - ?. =('~' i.b) - $(b t.b, c [i.b c]) - ?~ t.b [b ~] - ?- i.t.b - $'~' $(b t.t.b, c ['~' c]) - $'-' $(b t.t.b, c ['_' c]) - @ [b ~] - == -:: -++ woad :: cord unescape - |= a/@ta - ^- @t - %+ rap 3 - |- ^- (list @) - ?: =(`@`0 a) - ~ - =+ b=(end 3 1 a) - =+ c=(rsh 3 1 a) - ?: =('.' b) - [' ' $(a c)] - ?. =('~' b) - [b $(a c)] - => .(b (end 3 1 c), c (rsh 3 1 c)) - ?+ b =- (weld (rip 3 (tuft p.d)) $(a q.d)) - ^= d - =+ d=0 - |- ^- {p/@ q/@} - ?: =('.' b) - [d c] - ?< =(0 c) - %= $ - b (end 3 1 c) - c (rsh 3 1 c) - d %+ add (mul 16 d) - %+ sub b - ?: &((gte b '0') (lte b '9')) 48 - ?>(&((gte b 'a') (lte b 'z')) 87) - == - $'.' ['.' $(a c)] - $'~' ['~' $(a c)] - == -:: -++ wood :: cord escape - |= a/@t - ^- @ta - %+ rap 3 - |- ^- (list @) - ?: =(`@`0 a) - ~ - =+ b=(teff a) - =+ c=(turf (end 3 b a)) - =+ d=$(a (rsh 3 b a)) - ?: ?| &((gte c 'a') (lte c 'z')) - &((gte c '0') (lte c '9')) - =(`@`'-' c) - == - [c d] - ?+ c - :- '~' - =+ e=(met 2 c) - |- ^- tape - ?: =(0 e) - ['.' d] - =. e (dec e) - =+ f=(rsh 2 e c) - [(add ?:((lte f 9) 48 87) f) $(c (end 2 e c))] - :: - $' ' ['.' d] - $'.' ['~' '.' d] - $'~' ['~' '~' d] - == -:: -:::: 4c: tank printer - :: -++ wash :: render tank at width - |= {{tab/@ edg/@} tac/tank} ^- wall - (~(win re tac) tab edg) -:: -++ re - |_ tac/tank - ++ ram - ^- tape - ?- -.tac - $leaf p.tac - $palm ram(tac [%rose [p.p.tac (weld q.p.tac r.p.tac) s.p.tac] q.tac]) - $rose - %+ weld - q.p.tac - |- ^- tape - ?~ q.tac - r.p.tac - =+ voz=$(q.tac t.q.tac) - (weld ram(tac i.q.tac) ?~(t.q.tac voz (weld p.p.tac voz))) - == - :: - ++ win - |= {tab/@ edg/@} - =+ lug=`wall`~ - |^ |- ^- wall - ?- -.tac - $leaf (rig p.tac) - $palm - ?: fit - (rig ram) - ?~ q.tac - (rig q.p.tac) - ?~ t.q.tac - (rig(tab (add 2 tab), lug $(tac i.q.tac)) q.p.tac) - => .(q.tac `(list tank)`q.tac) - =+ lyn=(mul 2 (lent q.tac)) - =+ ^= qyr - |- ^- wall - ?~ q.tac - lug - %= ^$ - tac i.q.tac - tab (add tab (sub lyn 2)) - lug $(q.tac t.q.tac, lyn (sub lyn 2)) - == - (wig(lug qyr) q.p.tac) - :: - $rose - ?: fit - (rig ram) - =. lug - |- ^- wall - ?~ q.tac - ?:(=(~ r.p.tac) lug (rig r.p.tac)) - ^$(tac i.q.tac, lug $(q.tac t.q.tac), tab din) - ?: =(~ q.p.tac) - lug - (wig q.p.tac) - == - :: - ++ din (mod (add 2 tab) (mul 2 (div edg 3))) - ++ fit (lte (lent ram) (sub edg tab)) - ++ rig - |= hom/tape - ^- wall - ?: (lte (lent hom) (sub edg tab)) - [(runt [tab ' '] hom) lug] - => .(tab (add tab 2), edg (sub edg 2)) - =+ mut=(trim (sub edg tab) hom) - :- (runt [(sub tab 2) ' '] ['\\' '/' (weld p.mut `_hom`['\\' '/' ~])]) - => .(hom q.mut) - |- - ?~ hom - :- %+ runt - [(sub tab 2) ' '] - ['\\' '/' (runt [(sub edg tab) ' '] ['\\' '/' ~])] - lug - => .(mut (trim (sub edg tab) hom)) - [(runt [tab ' '] p.mut) $(hom q.mut)] - :: - ++ wig - |= hom/tape - ^- wall - ?~ lug - (rig hom) - =+ lin=(lent hom) - =+ wug=:(add 1 tab lin) - ?. =+ mir=i.lug - |- ?~ mir - | - ?|(=(0 wug) ?&(=(' ' i.mir) $(mir t.mir, wug (dec wug)))) - (rig hom) :: ^ XX regular form? - [(runt [tab ' '] (weld hom `tape`[' ' (slag wug i.lug)])) t.lug] - -- - -- -++ show :: XX deprecated! - |= vem/* - |^ ^- tank - ?: ?=(@ vem) - [%leaf (mesc (trip vem))] - ?- vem - {s/$~ c/*} - [%leaf '\'' (weld (mesc (tape +.vem)) `tape`['\'' ~])] - :: - {s/$a c/@} [%leaf (mesc (trip c.vem))] - {s/$b c/*} (shop c.vem |=(a/@ ~(rub at a))) - {s/{$c p/@} c/*} - :+ %palm - [['.' ~] ['-' ~] ~ ~] - [[%leaf (mesc (trip p.s.vem))] $(vem c.vem) ~] - :: - {s/$d c/*} (shop c.vem |=(a/@ ~(rud at a))) - {s/$k c/*} (tank c.vem) - {s/$h c/*} - :+ %rose - [['/' ~] ['/' ~] ~] - =+ yol=((list @ta) c.vem) - (turn yol |=(a/@ta [%leaf (trip a)])) - :: - {s/$l c/*} (shol c.vem) - {s/$o c/*} - %= $ - vem - :- [%m '%h:<[%d %d].[%d %d]>'] - [-.c.vem +<-.c.vem +<+.c.vem +>-.c.vem +>+.c.vem ~] - == - :: - {s/$p c/*} (shop c.vem |=(a/@ ~(rup at a))) - {s/$q c/*} (shop c.vem |=(a/@ ~(r at a))) - {s/$r c/*} $(vem [[%r ' ' '{' '}'] c.vem]) - {s/$t c/*} (shop c.vem |=(a/@ ~(rt at a))) - {s/$v c/*} (shop c.vem |=(a/@ ~(ruv at a))) - {s/$x c/*} (shop c.vem |=(a/@ ~(rux at a))) - {s/{$m p/@} c/*} (shep p.s.vem c.vem) - {s/{$r p/@} c/*} - $(vem [[%r ' ' (cut 3 [0 1] p.s.vem) (cut 3 [1 1] p.s.vem)] c.vem]) - :: - {s/{$r p/@ q/@ r/@} c/*} - :+ %rose - :* p=(mesc (trip p.s.vem)) - q=(mesc (trip q.s.vem)) - r=(mesc (trip r.s.vem)) - == - |- ^- (list tank) - ?@ c.vem - ~ - [^$(vem -.c.vem) $(c.vem +.c.vem)] - :: - {s/$z c/*} $(vem [[%r %$ %$ %$] c.vem]) - * !! - == - ++ shep - |= {fom/@ gar/*} - ^- tank - =+ l=(met 3 fom) - =+ i=0 - :- %leaf - |- ^- tape - ?: (gte i l) - ~ - =+ c=(cut 3 [i 1] fom) - ?. =(37 c) - (weld (mesc [c ~]) $(i +(i))) - =+ d=(cut 3 [+(i) 1] fom) - ?. .?(gar) - ['\\' '#' $(i (add 2 i))] - (weld ~(ram re (show d -.gar)) $(i (add 2 i), gar +.gar)) - :: - ++ shop - |= {aug/* vel/$-(a/@ tape)} - ^- tank - ?: ?=(@ aug) - [%leaf (vel aug)] - :+ %rose - [[' ' ~] ['[' ~] [']' ~]] - => .(aug `*`aug) - |- ^- (list tank) - ?: ?=(@ aug) - [^$ ~] - [^$(aug -.aug) $(aug +.aug)] - :: - ++ shol - |= lim/* - :+ %rose - [['.' ~] ~ ~] - |- ^- (list tank) - ?: ?=(@ lim) ~ - :_ $(lim +.lim) - ?+ -.lim (show '#') - $~ (show '$') - c/@ (show c.lim) - {$& $1} (show '.') - {$& c/@} - [%leaf '+' ~(rud at c.lim)] - :: - {$| @ $~} (show ',') - {$| n/@ $~ c/@} - [%leaf (weld (reap n.lim '^') ?~(c.lim "$" (trip c.lim)))] - == - -- -:: -:::: 4d: parsing (tracing) - :: -++ last |= {zyc/hair naz/hair} :: farther trace - ^- hair - ?: =(p.zyc p.naz) - ?:((gth q.zyc q.naz) zyc naz) - ?:((gth p.zyc p.naz) zyc naz) -:: -++ lust |= {weq/char naz/hair} :: detect newline - ^- hair - ?:(=(`@`10 weq) [+(p.naz) 1] [p.naz +(q.naz)]) -:: -:::: 4e: parsing (combinators) - :: -++ bend :: conditional comp - ~/ %bend - |* raq/_|*({a/* b/*} [~ u=[a b]]) - ~/ %fun - |* {vex/edge sab/rule} - ?~ q.vex - vex - =+ yit=(sab q.u.q.vex) - =+ yur=(last p.vex p.yit) - ?~ q.yit - [p=yur q=q.vex] - =+ vux=(raq p.u.q.vex p.u.q.yit) - ?~ vux - [p=yur q=q.vex] - [p=yur q=[~ u=[p=u.vux q=q.u.q.yit]]] -:: -++ comp - ~/ %comp - |* raq/_|*({a/* b/*} [a b]) :: arbitrary compose - ~/ %fun - |* {vex/edge sab/rule} - ~! +< - ?~ q.vex - vex - =+ yit=(sab q.u.q.vex) - =+ yur=(last p.vex p.yit) - ?~ q.yit - [p=yur q=q.yit] - [p=yur q=[~ u=[p=(raq p.u.q.vex p.u.q.yit) q=q.u.q.yit]]] -:: -++ fail |=(tub/nail [p=p.tub q=~]) :: never parse -++ glue :: add rule - ~/ %glue - |* bus/rule - ~/ %fun - |* {vex/edge sab/rule} - (plug vex ;~(pfix bus sab)) -:: -++ less :: no first and second - |* {vex/edge sab/rule} - ?~ q.vex - =+ roq=(sab) - [p=(last p.vex p.roq) q=q.roq] - (fail +<.sab) -:: -++ pfix :: discard first rule - ~/ %pfix - (comp |*({a/* b/*} b)) -:: -++ plug :: first then second - ~/ %plug - |* {vex/edge sab/rule} - ?~ q.vex - vex - =+ yit=(sab q.u.q.vex) - =+ yur=(last p.vex p.yit) - ?~ q.yit - [p=yur q=q.yit] - [p=yur q=[~ u=[p=[p.u.q.vex p.u.q.yit] q=q.u.q.yit]]] -:: -++ pose :: first or second - ~/ %pose - |* {vex/edge sab/rule} - ?~ q.vex - =+ roq=(sab) - [p=(last p.vex p.roq) q=q.roq] - vex -:: -++ simu :: first and second - |* {vex/edge sab/rule} - ?~ q.vex - vex - =+ roq=(sab) - roq -:: -++ sfix :: discard second rule - ~/ %sfix - (comp |*({a/* b/*} a)) -:: -:::: 4f: parsing (rule builders) - :: -++ bass :: leftmost base - |* {wuc/@ tyd/rule} - %+ cook - |= waq/(list @) - %+ roll - waq - =|({p/@ q/@} |.((add p (mul wuc q)))) - tyd -:: -++ boss :: rightmost base - |* {wuc/@ tyd/rule} - %+ cook - |= waq/(list @) - %+ reel - waq - =|({p/@ q/@} |.((add p (mul wuc q)))) - tyd -:: -++ cold :: replace w+ constant - ~/ %cold - |* {cus/* sef/rule} - ~/ %fun - |= tub/nail - =+ vex=(sef tub) - ?~ q.vex - vex - [p=p.vex q=[~ u=[p=cus q=q.u.q.vex]]] -:: -++ cook :: apply gate - ~/ %cook - |* {poq/$-(* *) sef/rule} - ~/ %fun - |= tub/nail - =+ vex=(sef tub) - ?~ q.vex - vex - [p=p.vex q=[~ u=[p=(poq p.u.q.vex) q=q.u.q.vex]]] -:: -++ easy :: always parse - ~/ %easy - |* huf/* - ~/ %fun - |= tub/nail - ^- (like _huf) - [p=p.tub q=[~ u=[p=huf q=tub]]] -:: -++ flag - |= {sic/@t non/@t} - ;~(pose (cold %& (jest sic)) (cold %| (jest non))) -:: -++ full :: has to fully parse - |* sef/rule - |= tub/nail - =+ vex=(sef tub) - ?~(q.vex vex ?:(=(~ q.q.u.q.vex) vex [p=p.vex q=~])) -:: -++ funk :: add to tape first - |* {pre/tape sef/rule} - |= tub/nail - (sef p.tub (weld pre q.tub)) -:: -++ here :: place-based apply - ~/ %here - |* {hez/_|=({a/pint b/*} [a b]) sef/rule} - ~/ %fun - |= tub/nail - =+ vex=(sef tub) - ?~ q.vex - vex - [p=p.vex q=[~ u=[p=(hez [p.tub p.q.u.q.vex] p.u.q.vex) q=q.u.q.vex]]] -:: -++ ifix - |* {fel/{rule rule} hof/rule} - ~! +< - ~! +<:-.fel - ~! +<:+.fel - ;~(pfix -.fel ;~(sfix hof +.fel)) -:: -++ jest :: match a cord - |= daf/@t - |= tub/nail - =+ fad=daf - |- ^- (like @t) - ?: =(`@`0 daf) - [p=p.tub q=[~ u=[p=fad q=tub]]] - ?: |(?=($~ q.tub) !=((end 3 1 daf) i.q.tub)) - (fail tub) - $(p.tub (lust i.q.tub p.tub), q.tub t.q.tub, daf (rsh 3 1 daf)) -:: -++ just :: XX redundant, jest - ~/ %just :: match a char - |= daf/char - ~/ %fun - |= tub/nail - ^- (like char) - ?~ q.tub - (fail tub) - ?. =(daf i.q.tub) - (fail tub) - (next tub) -:: -++ knee :: callbacks - |* {gar/* sef/_|.(*rule)} - |= tub/nail - ^- (like _gar) - ((sef) tub) -:: -++ mask :: match char in set - ~/ %mask - |= bud/(list char) - ~/ %fun - |= tub/nail - ^- (like char) - ?~ q.tub - (fail tub) - ?. (lien bud |=(a/char =(i.q.tub a))) - (fail tub) - (next tub) -:: -++ more :: separated, * - |* {bus/rule fel/rule} - ;~(pose (most bus fel) (easy ~)) -:: -++ most :: separated, + - |* {bus/rule fel/rule} - ;~(plug fel (star ;~(pfix bus fel))) -:: -++ next :: consume a char - |= tub/nail - ^- (like char) - ?~ q.tub - (fail tub) - =+ zac=(lust i.q.tub p.tub) - [zac [~ i.q.tub [zac t.q.tub]]] -:: -++ perk :: parse cube fork - |* a/(pole @tas) - ?~ a fail - ;~ pose - (cold -.a (jest -.a)) - $(a +.a) - == -:: -++ pick :: rule for ++each - |* {a/rule b/rule} - ;~ pose - (stag %& a) - (stag %| b) - == -++ plus |*(fel/rule ;~(plug fel (star fel))) :: -++ punt |*({a/rule} ;~(pose (stag ~ a) (easy ~))) :: -++ sear :: conditional cook - |* {pyq/$-(* (unit)) sef/rule} - |= tub/nail - =+ vex=(sef tub) - ?~ q.vex - vex - =+ gey=(pyq p.u.q.vex) - ?~ gey - [p=p.vex q=~] - [p=p.vex q=[~ u=[p=u.gey q=q.u.q.vex]]] -:: -++ shim :: match char in range - ~/ %shim - |= {les/@ mos/@} - ~/ %fun - |= tub/nail - ^- (like char) - ?~ q.tub - (fail tub) - ?. ?&((gte i.q.tub les) (lte i.q.tub mos)) - (fail tub) - (next tub) -:: -++ stag :: add a label - ~/ %stag - |* {gob/* sef/rule} - ~/ %fun - |= tub/nail - =+ vex=(sef tub) - ?~ q.vex - vex - [p=p.vex q=[~ u=[p=[gob p.u.q.vex] q=q.u.q.vex]]] -:: -++ stet :: - |* leh/(list {?(@ {@ @}) rule}) - |- - ?~ leh - ~ - [i=[p=-.i.leh q=+.i.leh] t=$(leh t.leh)] -:: -++ stew :: switch by first char - ~/ %stew - |* leh/(list {p/?(@ {@ @}) q/rule}) :: char+range keys - =+ ^= wor :: range complete lth - |= {ort/?(@ {@ @}) wan/?(@ {@ @})} - ?@ ort - ?@(wan (lth ort wan) (lth ort -.wan)) - ?@(wan (lth +.ort wan) (lth +.ort -.wan)) - =+ ^= hel :: build parser map - =+ hel=`(tree _?>(?=(^ leh) i.leh))`~ - |- ^+ hel - ?~ leh - ~ - =+ yal=$(leh t.leh) - |- ^+ hel - ?~ yal - [i.leh ~ ~] - ?: (wor p.i.leh p.n.yal) - =+ nuc=$(yal l.yal) - ?> ?=(^ nuc) - ?: (vor p.n.yal p.n.nuc) - [n.yal nuc r.yal] - [n.nuc l.nuc [n.yal r.nuc r.yal]] - =+ nuc=$(yal r.yal) - ?> ?=(^ nuc) - ?: (vor p.n.yal p.n.nuc) - [n.yal l.yal nuc] - [n.nuc [n.yal l.yal l.nuc] r.nuc] - ~% %fun ..^$ ~ - |= tub/nail - ?~ q.tub - (fail tub) - |- - ?~ hel - (fail tub) - ?: ?@ p.n.hel - =(p.n.hel i.q.tub) - ?&((gte i.q.tub -.p.n.hel) (lte i.q.tub +.p.n.hel)) - :: (q.n.hel [(lust i.q.tub p.tub) t.q.tub]) - (q.n.hel tub) - ?: (wor i.q.tub p.n.hel) - $(hel l.hel) - $(hel r.hel) -:: -++ slug :: - |* raq/_|*({a/* b/*} [a b]) - |* {bus/rule fel/rule} - ;~((comp raq) fel (stir +<+.raq raq ;~(pfix bus fel))) -:: -++ star :: 0 or more times - |* fel/rule - (stir `(list _(wonk *fel))`~ |*({a/* b/*} [a b]) fel) -:: -++ stir - ~/ %stir - |* {rud/* raq/_|*({a/* b/*} [a b]) fel/rule} - ~/ %fun - |= tub/nail - ^- (like _rud) - =+ vex=(fel tub) - ?~ q.vex - [p.vex [~ rud tub]] - =+ wag=$(tub q.u.q.vex) - ?> ?=(^ q.wag) - [(last p.vex p.wag) [~ (raq p.u.q.vex p.u.q.wag) q.u.q.wag]] -:: -++ stun :: parse several times - |* {lig/{@ @} fel/rule} - |= tub/nail - ^- (like (list _(wonk (fel)))) - ?: =(0 +.lig) - [p.tub [~ ~ tub]] - =+ vex=(fel tub) - ?~ q.vex - ?: =(0 -.lig) - [p.vex [~ ~ tub]] - vex - =+ ^= wag %= $ - -.lig ?:(=(0 -.lig) 0 (dec -.lig)) - +.lig ?:(=(0 +.lig) 0 (dec +.lig)) - tub q.u.q.vex - == - ?~ q.wag - wag - [p.wag [~ [p.u.q.vex p.u.q.wag] q.u.q.wag]] -:: -:::: 4g: parsing (outside caller) - :: -++ rash |*({naf/@ sab/rule} (scan (trip naf) sab)) :: -++ rose |* {los/tape sab/rule} - =+ vex=(sab [[1 1] los]) - =+ len=(lent los) - ?. =(+(len) q.p.vex) [%| p=(dec q.p.vex)] - ?~ q.vex - [%& p=~] - [%& p=[~ u=p.u.q.vex]] -++ rush |*({naf/@ sab/rule} (rust (trip naf) sab)) -++ rust |* {los/tape sab/rule} - =+ vex=((full sab) [[1 1] los]) - ?~(q.vex ~ [~ u=p.u.q.vex]) -++ scan |* {los/tape sab/rule} - =+ vex=((full sab) [[1 1] los]) - ?~ q.vex - ~_ (show [%m '{%d %d}'] p.p.vex q.p.vex ~) - ~_(leaf+"syntax error" !!) - p.u.q.vex -:: -:::: 4h: parsing (ascii glyphs) - :: -++ ace (just ' ') -++ bar (just '|') -++ bas (just '\\') -++ buc (just '$') -++ cab (just '_') -++ cen (just '%') -++ col (just ':') -++ com (just ',') -++ doq (just '"') -++ dot (just '.') -++ fas (just '/') -++ gal (just '<') -++ gar (just '>') -++ hax (just '#') -++ kel (just '{') -++ ker (just '}') -++ ket (just '^') -++ lus (just '+') -++ hep (just '-') -++ pel (just '(') -++ pam (just '&') -++ per (just ')') -++ pat (just '@') -++ sel (just '[') -++ sem (just ';') -++ ser (just ']') -++ sig (just '~') -++ soq (just '\'') -++ tar (just '*') -++ tec (just '`') -++ tis (just '=') -++ wut (just '?') -++ zap (just '!') -:: -:::: 4i: parsing (useful idioms) - :: -++ alf ;~(pose low hig) :: alphabetic -++ aln ;~(pose low hig nud) :: alphanumeric -++ alp ;~(pose low hig nud hep) :: alphanumeric and - -++ bet ;~(pose (cold 2 hep) (cold 3 lus)) :: axis syntax - + -++ bin (bass 2 (most gon but)) :: binary to atom -++ but (cook |=(a/@ (sub a '0')) (shim '0' '1')) :: binary digit -++ cit (cook |=(a/@ (sub a '0')) (shim '0' '7')) :: octal digit -++ dem (bass 10 (most gon dit)) :: decimal to atom -++ dit (cook |=(a/@ (sub a '0')) (shim '0' '9')) :: decimal digit -++ dog ;~(plug dot gay) :: . number separator -++ doh ;~(plug ;~(plug hep hep) gay) :: -- phon separator -++ dun (cold ~ ;~(plug hep hep)) :: -- (stop) to ~ -++ duz (cold ~ ;~(plug tis tis)) :: == (stet) to ~ -++ gah (mask [`@`10 ' ' ~]) :: newline or ace -++ gap (cold ~ ;~(plug gaq (star ;~(pose vul gah)))) :: plural space -++ gaq ;~ pose :: end of line - (just `@`10) - ;~(plug gah ;~(pose gah vul)) - vul - == -++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white -++ gay ;~(pose gap (easy ~)) :: -++ 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 - dit - (cook |=(a/char (sub a 87)) (shim 'a' 'f')) - (cook |=(a/char (sub a 55)) (shim 'A' 'F')) - == -++ iny :: indentation block - |* sef/rule - |= nail ^+ (sef) - =+ [har tap]=[p q]:+< - =+ lev=(fil 3 (dec q.har) ' ') - =+ eol=(just `@t`10) - =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap) - ;~(simu ;~(plug eol eol) eol) - ?~ q.roq roq - =+ vex=(sef har(q 1) p.u.q.roq) - =+ fur=p.vex(q (add (dec q.har) q.p.vex)) - ?~ q.vex vex(p fur) - =- vex(p fur, u.q -) - :+ &3.vex - &4.vex(q.p (add (dec q.har) q.p.&4.vex)) - =+ res=|4.vex - |- ?~ res |4.roq - ?. =(10 -.res) [-.res $(res +.res)] - (welp [`@t`10 (trip lev)] $(res +.res)) -:: -++ low (shim 'a' 'z') :: lowercase -++ mes %+ cook :: hexbyte - |=({a/@ b/@} (add (mul 16 a) b)) - ;~(plug hit hit) -++ nix (boss 256 (star ;~(pose aln cab))) :: -++ nud (shim '0' '9') :: numeric -++ prn ;~(less (just `@`127) (shim 32 256)) :: non-control -++ prz ;~(less (just `@`127) (shim 33 256)) :: non-trivial -++ qat ;~ pose :: chars in blockcord - prn - ;~(less ;~(plug (just `@`10) soz) (just `@`10)) - == -++ qit ;~ pose :: chars in a cord - ;~(less bas soq prn) - ;~(pfix bas ;~(pose bas soq mes)) :: escape chars - == -++ qut ;~ simu soq :: cord - ;~ pose - ;~ less soz - (ifix [soq soq] (boss 256 (more gon qit))) - == - =+ hed=;~(pose ;~(plug (plus ace) vul) (just '\0a')) - %- iny %+ ifix - :- ;~(plug soz hed) - ;~(plug (just '\0a') soz) - (boss 256 (star qat)) - == - == -++ soz ;~(plug soq soq soq) :: delimiting ''' -++ sym :: symbol - %+ cook - |=(a/tape (rap 3 ^-((list @) a))) - ;~(plug low (star ;~(pose nud low hep))) -:: -++ ven ;~ (comp |=({a/@ b/@} (peg a b))) :: +>- axis syntax - bet - =+ hom=`?`| - |= tub/nail - ^- (like @) - =+ vex=?:(hom (bet tub) (gul tub)) - ?~ q.vex - [p.tub [~ 1 tub]] - =+ wag=$(p.tub p.vex, hom !hom, tub q.u.q.vex) - ?> ?=(^ q.wag) - [p.wag [~ (peg p.u.q.vex p.u.q.wag) q.u.q.wag]] - == -++ vit :: base64 digit - ;~ pose - (cook |=(a/@ (sub a 65)) (shim 'A' 'Z')) - (cook |=(a/@ (sub a 71)) (shim 'a' 'z')) - (cook |=(a/@ (add a 4)) (shim '0' '9')) - (cold 62 (just '-')) - (cold 63 (just '+')) - == -++ vul %+ cold ~ :: comments - ;~ plug col col - (star prn) - (just `@`10) - == -:: -:::: 4j: parsing (bases and base digits) - :: -++ ab - |% - ++ bix (bass 16 (stun [2 2] six)) - ++ fem (sear |=(a/@ (cha:fa a)) aln) - ++ haf (bass 256 ;~(plug tep tiq (easy ~))) - ++ hef %+ sear |=(a/@ ?:(=(a 0) ~ (some a))) - %+ bass 256 - ;~(plug tip tiq (easy ~)) - ++ hif (bass 256 ;~(plug tip tiq (easy ~))) - ++ hof (bass 0x1.0000 ;~(plug hef (stun [1 3] ;~(pfix hep hif)))) - ++ huf (bass 0x1.0000 ;~(plug hef (stun [0 3] ;~(pfix hep hif)))) - ++ hyf (bass 0x1.0000 ;~(plug hif (stun [3 3] ;~(pfix hep hif)))) - ++ pev (bass 32 ;~(plug sev (stun [0 4] siv))) - ++ pew (bass 64 ;~(plug sew (stun [0 4] siw))) - ++ piv (bass 32 (stun [5 5] siv)) - ++ piw (bass 64 (stun [5 5] siw)) - ++ qeb (bass 2 ;~(plug seb (stun [0 3] sib))) - ++ qex (bass 16 ;~(plug sex (stun [0 3] hit))) - ++ qib (bass 2 (stun [4 4] sib)) - ++ qix (bass 16 (stun [4 4] six)) - ++ seb (cold 1 (just '1')) - ++ sed (cook |=(a/@ (sub a '0')) (shim '1' '9')) - ++ sev ;~(pose sed sov) - ++ sew ;~(pose sed sow) - ++ sex ;~(pose sed sox) - ++ sib (cook |=(a/@ (sub a '0')) (shim '0' '1')) - ++ sid (cook |=(a/@ (sub a '0')) (shim '0' '9')) - ++ siv ;~(pose sid sov) - ++ siw ;~(pose sid sow) - ++ six ;~(pose sid sox) - ++ sov (cook |=(a/@ (sub a 87)) (shim 'a' 'v')) - ++ sow ;~ pose - (cook |=(a/@ (sub a 87)) (shim 'a' 'z')) - (cook |=(a/@ (sub a 29)) (shim 'A' 'Z')) - (cold 62 (just '-')) - (cold 63 (just '~')) - == - ++ sox (cook |=(a/@ (sub a 87)) (shim 'a' 'f')) - ++ ted (bass 10 ;~(plug sed (stun [0 2] sid))) - ++ tep (sear |=(a/@ ?:(=(a 'doz') ~ (ins:po a))) til) - ++ tip (sear |=(a/@ (ins:po a)) til) - ++ tiq (sear |=(a/@ (ind:po a)) til) - ++ tid (bass 10 (stun [3 3] sid)) - ++ til (boss 256 (stun [3 3] low)) - ++ urs %+ cook - |=(a/tape (rap 3 ^-((list @) a))) - (star ;~(pose nud low hep dot sig cab)) - ++ urt %+ cook - |=(a/tape (rap 3 ^-((list @) a))) - (star ;~(pose nud low hep dot sig)) - ++ urx %+ cook - |=(a/tape (rap 3 ^-((list @) a))) - %- star - ;~ pose - nud - low - hep - cab - (cold ' ' dot) - (cook tuft (ifix [sig dot] hex)) - ;~(pfix sig ;~(pose sig dot)) - == - ++ voy ;~(pfix bas ;~(pose bas soq bix)) - -- -++ ag - |% - ++ ape |*(fel/rule ;~(pose (cold 0 (just '0')) fel)) - ++ bay (ape (bass 16 ;~(plug qeb:ab (star ;~(pfix dog qib:ab))))) - ++ bip =+ tod=(ape qex:ab) - (bass 0x1.0000 ;~(plug tod (stun [7 7] ;~(pfix dog tod)))) - ++ dem (ape (bass 1.000 ;~(plug ted:ab (star ;~(pfix dog tid:ab))))) - ++ dim (ape dip) - ++ dip (bass 10 ;~(plug sed:ab (star sid:ab))) - ++ dum (bass 10 (plus sid:ab)) - ++ fed %+ cook fend:ob - ;~ pose - %+ bass 0x1.0000.0000.0000.0000 :: oversized - ;~ plug - huf:ab - (plus ;~(pfix doh hyf:ab)) - == - hof:ab :: planet or moon - haf:ab :: star - tiq:ab :: galaxy - == - ++ fim (sear den:fa (bass 58 (plus fem:ab))) - ++ hex (ape (bass 0x1.0000 ;~(plug qex:ab (star ;~(pfix dog qix:ab))))) - ++ lip =+ tod=(ape ted:ab) - (bass 256 ;~(plug tod (stun [3 3] ;~(pfix dog tod)))) - ++ mot ;~ pose - ;~ pfix - (just '1') - (cook |=(a/@ (add 10 (sub a '0'))) (shim '0' '2')) - == - sed:ab - == - ++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab))))) - ++ vum (bass 32 (plus siv:ab)) - ++ wiz (ape (bass 0x4000.0000 ;~(plug pew:ab (star ;~(pfix dog piw:ab))))) - -- -++ mu - |_ {top/@ bot/@} - ++ zag [p=(end 4 1 (add top bot)) q=bot] - ++ zig [p=(end 4 1 (add top (sub 0x1.0000 bot))) q=bot] - ++ zug (mix (lsh 4 1 top) bot) - -- -++ ne - |_ tig/@ - ++ c (cut 3 [tig 1] key:fa) - ++ d (add tig '0') - ++ x ?:((gte tig 10) (add tig 87) d) - ++ v ?:((gte tig 10) (add tig 87) d) - ++ w ?:(=(tig 63) '~' ?:(=(tig 62) '-' ?:((gte tig 36) (add tig 29) x))) - -- -:: -:::: 4k: atom printing - :: -++ co !. - ~% %co ..co ~ - =< |_ lot/coin - ++ rear |=(rom/tape =>(.(rep rom) rend)) - ++ rent `@ta`(rap 3 rend) - ++ rend - ^- tape - ?: ?=($blob -.lot) - ['~' '0' ((v-co 1) (jam p.lot))] - ?: ?=($many -.lot) - :- '.' - |- ^- tape - ?~ p.lot - ['_' '_' rep] - ['_' (weld (trip (wack rent(lot i.p.lot))) $(p.lot t.p.lot))] - =+ [yed=(end 3 1 p.p.lot) hay=(cut 3 [1 1] p.p.lot)] - |- ^- tape - ?+ yed (z-co q.p.lot) - $c ['~' '-' (weld (rip 3 (wood (tuft q.p.lot))) rep)] - $d - ?+ hay (z-co q.p.lot) - $a - =+ yod=(yore q.p.lot) - => ^+(. .(rep ?~(f.t.yod rep ['.' (s-co f.t.yod)]))) - => ^+ . - %= . - rep - ?: &(=(~ f.t.yod) =(0 h.t.yod) =(0 m.t.yod) =(0 s.t.yod)) - rep - => .(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 ['-' rep])) - ['~' (a-co y.yod)] - :: - $r - =+ yug=(yell q.p.lot) - => ^+(. .(rep ?~(f.yug rep ['.' (s-co f.yug)]))) - :- '~' - ?: &(=(0 d.yug) =(0 m.yug) =(0 h.yug) =(0 s.yug)) - ['s' '0' rep] - => ^+(. ?:(=(0 s.yug) . .(rep ['.' 's' (a-co s.yug)]))) - => ^+(. ?:(=(0 m.yug) . .(rep ['.' 'm' (a-co m.yug)]))) - => ^+(. ?:(=(0 h.yug) . .(rep ['.' 'h' (a-co h.yug)]))) - => ^+(. ?:(=(0 d.yug) . .(rep ['.' 'd' (a-co d.yug)]))) - +.rep - == - :: - $f - ?: =(& q.p.lot) - ['.' 'y' rep] - ?:(=(| q.p.lot) ['.' 'n' rep] (z-co q.p.lot)) - :: - $n ['~' rep] - $i - ?+ hay (z-co q.p.lot) - $f ((ro-co [3 10 4] |=(a/@ ~(d ne a))) q.p.lot) - $s ((ro-co [4 16 8] |=(a/@ ~(x ne a))) q.p.lot) - == - :: - $p - =+ sxz=(feen:ob q.p.lot) - =+ dyx=(met 3 sxz) - :- '~' - ?: (lte dyx 1) - (weld (trip (tod:po sxz)) rep) - =+ dyy=(met 4 sxz) - =+ imp=*@ - |- ^- tape - ?: =(imp dyy) - rep - %= $ - sxz (rsh 4 1 sxz) - imp +(imp) - rep - =+ log=(end 4 1 sxz) - ;: weld - (trip (tos:po (rsh 3 1 log))) - (trip (tod:po (end 3 1 log))) - ?:(=((mod imp 4) 0) ?:(=(imp 0) "" "--") "-") - rep - == - == - :: - $r - ?+ hay (z-co q.p.lot) - $d ['.' '~' (r-co (rlyd q.p.lot))] - $h ['.' '~' '~' (r-co (rlyh q.p.lot))] - $q ['.' '~' '~' '~' (r-co (rlyq q.p.lot))] - $s ['.' (r-co (rlys q.p.lot))] - == - :: - $u - ?: ?=($c hay) - %+ welp ['0' 'c' (reap (pad:fa q.p.lot) '1')] - (c-co (enc:fa q.p.lot)) - =- (weld p.gam ?:(=(0 q.p.lot) `tape`['0' ~] q.gam)) - ^= gam ^- {p/tape q/tape} - ?+ hay [~ ((ox-co [10 3] |=(a/@ ~(d ne a))) q.p.lot)] - $b [['0' 'b' ~] ((ox-co [2 4] |=(a/@ ~(d ne a))) q.p.lot)] - $i [['0' 'i' ~] ((d-co 1) q.p.lot)] - $x [['0' 'x' ~] ((ox-co [16 4] |=(a/@ ~(x ne a))) q.p.lot)] - $v [['0' 'v' ~] ((ox-co [32 5] |=(a/@ ~(x ne a))) q.p.lot)] - $w [['0' 'w' ~] ((ox-co [64 5] |=(a/@ ~(w ne a))) q.p.lot)] - == - :: - $s - %+ weld - ?:((syn:si q.p.lot) "--" "-") - $(yed 'u', q.p.lot (abs:si q.p.lot)) - :: - $t - ?: =('a' hay) - ?: =('s' (cut 3 [2 1] p.p.lot)) - (weld (rip 3 q.p.lot) rep) - ['~' '.' (weld (rip 3 q.p.lot) rep)] - ['~' '~' (weld (rip 3 (wood q.p.lot)) rep)] - == - -- - =+ rep=*tape - =< |% - ++ a-co |=(dat/@ ((d-co 1) dat)) - ++ c-co (em-co [58 1] |=({? b/@ c/tape} [~(c ne b) c])) - ++ d-co |=(min/@ (em-co [10 min] |=({? b/@ c/tape} [~(d ne b) c]))) - ++ r-co - |= a/dn - ?: ?=({$i *} a) (weld ?:(s.a "inf" "-inf") rep) - ?: ?=({$n *} a) (weld "nan" rep) - =+ ^= e %+ ed-co [10 1] - |= {a/? b/@ c/tape} - ?: a [~(d ne b) '.' c] - [~(d ne b) c] - =+ ^= f - =>(.(rep ~) (e a.a)) - =. e.a (sum:si e.a (sun:si (dec +.f))) - =+ b=?:((syn:si e.a) "e" "e-") - => .(rep ?~(e.a rep (weld b ((d-co 1) (abs:si e.a))))) - => .(rep (weld -.f rep)) - ?:(s.a rep ['-' rep]) - :: - ++ s-co - |= esc/(list @) ^- tape - ?~ esc - rep - :- '.' - =>(.(rep $(esc t.esc)) ((x-co 4) i.esc)) - :: - ++ v-co |=(min/@ (em-co [32 min] |=({? b/@ c/tape} [~(v ne b) c]))) - ++ w-co |=(min/@ (em-co [64 min] |=({? b/@ c/tape} [~(w ne b) c]))) - ++ x-co |=(min/@ (em-co [16 min] |=({? b/@ c/tape} [~(x ne b) c]))) - ++ y-co |=(dat/@ ((d-co 2) dat)) - ++ z-co |=(dat/@ `tape`['0' 'x' ((x-co 1) dat)]) - -- - |% - ++ em-co - |= {{bas/@ min/@} par/$-({? @ tape} tape)} - |= hol/@ - ^- tape - ?: &(=(0 hol) =(0 min)) - rep - =+ [rad=(mod hol bas) dar=(div hol bas)] - %= $ - min ?:(=(0 min) 0 (dec min)) - hol dar - rep (par =(0 dar) rad rep) - == - :: - ++ ed-co - |= {{bas/@ min/@} par/$-({? @ tape} tape)} - =+ [fir=& cou=0] - |= hol/@ - ^- {tape @} - ?: &(=(0 hol) =(0 min)) - [rep cou] - =+ [rad=(mod hol bas) dar=(div hol bas)] - %= $ - min ?:(=(0 min) 0 (dec min)) - hol dar - rep (par &(=(0 dar) !fir) rad rep) - fir | - cou +(cou) - == - :: - ++ ox-co - |= {{bas/@ gop/@} dug/$-(@ @)} - %+ em-co - [|-(?:(=(0 gop) 1 (mul bas $(gop (dec gop))))) 0] - |= {top/? seg/@ res/tape} - %+ weld - ?:(top ~ `tape`['.' ~]) - %. seg - %+ em-co(rep res) - [bas ?:(top 0 gop)] - |=({? b/@ c/tape} [(dug b) c]) - :: - ++ ro-co - |= {{buz/@ bas/@ dop/@} dug/$-(@ @)} - |= hol/@ - ^- tape - ?: =(0 dop) - rep - => .(rep $(dop (dec dop))) - :- '.' - %- (em-co [bas 1] |=({? b/@ c/tape} [(dug b) c])) - [(cut buz [(dec dop) 1] hol)] - -- -:: -:::: 4l: atom parsing - :: -++ so - ~% %so + ~ - |% - ++ bisk - ~+ - ;~ pose - ;~ pfix (just '0') - ;~ pose - (stag %ub ;~(pfix (just 'b') bay:ag)) - (stag %uc ;~(pfix (just 'c') fim:ag)) - (stag %ui ;~(pfix (just 'i') dim:ag)) - (stag %ux ;~(pfix (just 'x') hex:ag)) - (stag %uv ;~(pfix (just 'v') viz:ag)) - (stag %uw ;~(pfix (just 'w') wiz:ag)) - == - == - (stag %ud dem:ag) - == - ++ crub - ~+ - ;~ pose - %+ cook - |=(det/date `dime`[%da (year det)]) - ;~ plug - %+ cook - |=({a/@ b/?} [b a]) - ;~(plug dim:ag ;~(pose (cold | hep) (easy &))) - ;~(pfix dot mot:ag) :: month - ;~(pfix dot dip:ag) :: day - ;~ pose - ;~ pfix - ;~(plug dot dot) - ;~ plug - dum:ag - ;~(pfix dot dum:ag) - ;~(pfix dot dum:ag) - ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~)) - == - == - (easy [0 0 0 ~]) - == - == - :: - %+ cook - |= {a/(list {p/?($d $h $m $s) q/@}) b/(list @)} - =+ rop=`tarp`[0 0 0 0 b] - |- ^- dime - ?~ a - [%dr (yule rop)] - ?- p.i.a - $d $(a t.a, d.rop (add q.i.a d.rop)) - $h $(a t.a, h.rop (add q.i.a h.rop)) - $m $(a t.a, m.rop (add q.i.a m.rop)) - $s $(a t.a, s.rop (add q.i.a s.rop)) - == - ;~ plug - %+ most - dot - ;~ pose - ;~(pfix (just 'd') (stag %d dim:ag)) - ;~(pfix (just 'h') (stag %h dim:ag)) - ;~(pfix (just 'm') (stag %m dim:ag)) - ;~(pfix (just 's') (stag %s dim:ag)) - == - ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~)) - == - :: - (stag %p fed:ag) - ;~(pfix dot (stag %ta urs:ab)) - ;~(pfix sig (stag %t urx:ab)) - ;~(pfix hep (stag %c (cook turf urx:ab))) - == - ++ nuck - ~/ %nuck |= a/nail %. a - %+ knee *coin |. ~+ - %- stew - ^. stet ^. limo - :~ :- ['a' 'z'] (cook |=(a/@ta [%$ %tas a]) sym) - :- ['0' '9'] (stag %$ bisk) - :- '-' (stag %$ tash) - :- '.' ;~(pfix dot perd) - :- '~' ;~(pfix sig ;~(pose twid (easy [%$ %n 0]))) - == - ++ nusk - ~+ - :(sear |=(a/@ta (rush a nuck)) wick urt:ab) - ++ perd - ~+ - ;~ pose - (stag %$ zust) - (stag %many (ifix [cab ;~(plug cab cab)] (more cab nusk))) - == - ++ royl - ~+ - =+ ^= moo - |= a/tape - :- (lent a) - (scan a (bass 10 (plus sid:ab))) - =+ ^= voy - %+ cook royl-cell - ;~ pose - ;~ plug - (easy %d) - ;~ pose (cold | hep) (easy &) == - ;~ plug dim:ag - ;~ pose - ;~(pfix dot (cook moo (plus (shim '0' '9')))) - (easy [0 0]) - == - ;~ pose - ;~ pfix - (just 'e') - ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag) - == - (easy [& 0]) - == - == - == - ;~ plug - (easy %i) - ;~ sfix - ;~ pose (cold | hep) (easy &) == - (jest 'inf') - == - == - ;~ plug - (easy %n) - (cold ~ (jest 'nan')) - == - == - ;~ pose - (stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy))) - (stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy))) - (stag %rd (cook ryld ;~(pfix sig voy))) - (stag %rs (cook ryls voy)) - == - :: - ++ royl-cell - |= rn - ^- dn - ?. ?=({$d *} +<) +< - =+ ^= h - (dif:si (new:si f.b i.b) (sun:si d.b)) - [%d a h (add (mul c.b (pow 10 d.b)) e.b)] - :: - ++ tash - ~+ - =+ ^= neg - |= {syn/? mol/dime} ^- dime - ?> =('u' (end 3 1 p.mol)) - [(cat 3 's' (rsh 3 1 p.mol)) (new:si syn q.mol)] - ;~ pfix hep - ;~ pose - (cook |=(a/dime (neg | a)) bisk) - ;~(pfix hep (cook |=(a/dime (neg & a)) bisk)) - == - == - :: - ++ twid - ~+ - ;~ pose - (cook |=(a/@ [%blob (cue a)]) ;~(pfix (just '0') vum:ag)) - (stag %$ crub) - == - :: - ++ zust - ~+ - ;~ pose - (stag %is bip:ag) - (stag %if lip:ag) - (stag %f ;~(pose (cold & (just 'y')) (cold | (just 'n')))) - royl - == - -- -:: -:::: 4m: formatting functions - :: -++ scot |=(mol/dime ~(rent co %$ mol)) -++ scow |=(mol/dime ~(rend co %$ mol)) -++ slat |=(mod/@tas |=(txt/@ta (slaw mod txt))) -++ slav |=({mod/@tas txt/@ta} (need (slaw mod txt))) -++ slaw - ~/ %slaw - |= {mod/@tas txt/@ta} - ^- (unit @) - =+ con=(slay txt) - ?.(&(?=({$~ $$ @ @} con) =(p.p.u.con mod)) ~ [~ q.p.u.con]) -:: -++ slay - |= txt/@ta ^- (unit coin) - =+ ^= vex - ?: (gth 0x7fff.ffff txt) :: XX petty cache - ~+ ((full nuck:so) [[1 1] (trip txt)]) - ((full nuck:so) [[1 1] (trip txt)]) - ?~ q.vex - ~ - [~ p.u.q.vex] -:: -++ smyt :: pretty print path - |= bon/path ^- tank - :+ %rose [['/' ~] ['/' ~] ~] - (turn bon |=(a/@ [%leaf (trip a)])) -:: -++ 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 fas (more fas urs:ab)) - |=(zep/@t `path`(rash zep fel)) -:: -:::: 4n: virtualization - :: -++ mack - |= {sub/* fol/*} - ^- (unit) - =+ ton=(mink [sub fol] |=({* *} ~)) - ?.(?=({$0 *} ton) ~ [~ p.ton]) -:: -++ mink - ~/ %mink - |= {{sub/* fol/*} gul/$-({* *} (unit (unit)))} - =+ tax=*(list {@ta *}) - |- ^- tone - ?@ fol - [%2 tax] - ?: ?=(^ -.fol) - =+ hed=$(fol -.fol) - ?: ?=($2 -.hed) - hed - =+ tal=$(fol +.fol) - ?- -.tal - $0 ?-(-.hed $0 [%0 p.hed p.tal], $1 hed) - $1 ?-(-.hed $0 tal, $1 [%1 (weld p.hed p.tal)]) - $2 tal - == - ?+ fol - [%2 tax] - :: - {$0 b/@} - ?: =(0 b.fol) [%2 tax] - ?: =(1 b.fol) [%0 sub] - ?: ?=(@ sub) [%2 tax] - =+ [now=(cap b.fol) lat=(mas b.fol)] - $(b.fol lat, sub ?:(=(2 now) -.sub +.sub)) - :: - {$1 b/*} - [%0 b.fol] - :: - {$2 b/{^ *}} - =+ ben=$(fol b.fol) - ?. ?=($0 -.ben) ben - ?>(?=(^ p.ben) $(sub -.p.ben, fol +.p.ben)) - ::?>(?=(^ p.ben) $([sub fol] p.ben) - :: - {$3 b/*} - =+ ben=$(fol b.fol) - ?. ?=($0 -.ben) ben - [%0 .?(p.ben)] - :: - {$4 b/*} - =+ ben=$(fol b.fol) - ?. ?=($0 -.ben) ben - ?. ?=(@ p.ben) [%2 tax] - [%0 .+(p.ben)] - :: - {$5 b/*} - =+ ben=$(fol b.fol) - ?. ?=($0 -.ben) ben - ?. ?=(^ p.ben) [%2 tax] - [%0 =(-.p.ben +.p.ben)] - :: - {$6 b/* c/* d/*} - $(fol =>(fol [2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b])) - :: - {$7 b/* c/*} $(fol =>(fol [2 b 1 c])) - {$8 b/* c/*} $(fol =>(fol [7 [[0 1] b] c])) - {$9 b/* c/*} $(fol =>(fol [7 c 0 b])) - {$10 @ c/*} $(fol c.fol) - {$10 {b/* c/*} d/*} - =+ ben=$(fol c.fol) - ?. ?=($0 -.ben) ben - ?: ?=(?($hunk $hand $lose $mean $spot) b.fol) - $(fol d.fol, tax [[b.fol p.ben] tax]) - $(fol d.fol) - :: - {$11 b/* c/*} - =+ ref=$(fol b.fol) - =+ ben=$(fol c.fol) - ?. ?=($0 -.ref) ref - ?. ?=($0 -.ben) ben - =+ val=(gul p.ref p.ben) - ?~(val [%1 p.ben ~] ?~(u.val [%2 [[%hunk (mush p.ben)] tax]] [%0 u.u.val])) - == -:: -++ mock - |= {{sub/* fol/*} gul/$-({* *} (unit (unit)))} - (mook (mink [sub fol] gul)) -:: -:: ++ moop -:: |= pon/(list {@ta *}) ^+ pon -:: ?~ pon ~ -:: :- i.pon -:: ?. ?=({$spot * ^} i.pon) -:: $(pon t.pon) -:: ?. ?=({{$spot * ^} *} t.pon) -:: $(pon t.pon) -:: => .(pon t.pon) -:: =+ sot=+.i.pon -:: |- ^- (list {@ta *}) -:: ?. ?=({{$spot * ^} *} t.pon) -:: [[%spot sot] ^$(pon t.pon)] -:: =+ sop=+.i.pon -:: ?: ?& =(-.sop -.sot) -:: (lor +<.sop +<.sot) -:: (lor +>.sot +>.sop) -:: == -:: $(sot sop, pon t.pon) -:: [[%spot sot] ^$(pon t.pon)] -:: -++ mook - |= ton/tone - ^- toon - ?. ?=({$2 *} ton) ton - :- %2 - :: =. p.ton (moop p.ton) - =+ yel=(lent p.ton) - =. p.ton - ?. (gth yel 256) p.ton - %+ weld - (scag 128 p.ton) - ^- (list {@ta *}) - :_ (slag (sub yel 128) p.ton) - :- %lose - %+ rap 3 - "[skipped {(scow %ud (sub yel 256))} frames]" - |- ^- (list tank) - ?~ p.ton ~ - =+ rep=$(p.ton t.p.ton) - ?+ -.i.p.ton rep - $hunk [(tank +.i.p.ton) rep] - $lose [[%leaf (rip 3 (@ +.i.p.ton))] rep] - $hand [[%leaf (scow %p (mug +.i.p.ton))] rep] - $mean :_ rep - ?@ +.i.p.ton [%leaf (rip 3 (@ +.i.p.ton))] - =+ mac=(mack +.i.p.ton +<.i.p.ton) - ?~(mac [%leaf "####"] (tank u.mac)) - $spot :_ rep - =+ sot=(spot +.i.p.ton) - :+ %rose [":" ~ ~] - :~ (smyt p.sot) - => [ud=|=(a/@u (scow %ud a)) q.sot] - leaf+"<[{(ud p.p)} {(ud q.p)}].[{(ud p.q)} {(ud q.q)}]>" - == == -:: -++ mush :: sane name to leaf - |= val/* - ^- tank - :+ %rose - [['/' ~] ['/' ~] ~] - (turn ((list @ta) val) |=(a/@ta [%leaf (trip a)])) -:: -++ mong - |= {{gat/* sam/*} gul/$-({* *} (unit (unit)))} - ^- toon - ?. &(?=(^ gat) ?=(^ +.gat)) - [%2 ~] - (mock [[-.gat [sam +>.gat]] -.gat] gul) -:: -++ mule :: typed virtual - ~/ %mule - |* taq/_|.(**) - =+ mud=(mute taq) - ?- -.mud - $& [%& p=$:taq] :: XX transition - $| [%| p=p.mud] - == -:: -++ mute :: untyped virtual - |= taq/_^?(|.(**)) - ^- (each * (list tank)) - =+ ton=(mock [taq 9 2 0 1] |=({* *} ~)) - ?- -.ton - $0 [%& p.ton] - $1 [%| (turn p.ton |=(a/* (smyt (path a))))] - $2 [%| p.ton] - == -:: -:::: 4o: molds and mold builders - :: -++ abel typo :: original sin: span -++ atom @ :: just an atom -++ aura @ta :: atom format -++ axis @ :: tree address -++ base :: base mold - $@ $? $noun :: any noun - $cell :: any cell - $bean :: loobean - $void :: no nouns - $null :: ~ == 0 - == :: - {$atom p/aura} :: atom -:: -++ bean ? :: 0=&=yes, 1=|=no -++ woof $@(@ {$~ p/twig}) :: simple embed -++ beet $@ @ :: advanced embed - $% {$a p/twig} :: take tape - {$b p/twig} :: take manx - {$c p/twig} :: take marl - {$d p/twig} :: take $-(marl marl) - {$e p/twig q/(list tuna)} :: element literal - == :: -++ chap (pair (list term) what) :: labeled help -++ chum $? lef/term :: jet name - {std/term kel/@} :: kelvin version - {ven/term pro/term kel/@} :: vendor and product - {ven/term pro/term ver/@ kel/@} :: all of the above - == :: -++ coil $: p/?($gold $ktbr $ktwt $ktpm) :: core span - q/span :: built with - r/chap :: docs - s/{p/?($~ ^) q/(map @ tomb)} :: arms - == :: -++ foot $% {$ash p/twig} :: dry arm, geometric - {$elm p/twig} :: wet arm, generic - == :: -++ limb $@ term :: wing element - $% {$& p/axis} :: by geometry - {$| p/@ud q/(unit term)} :: by name - == :: -++ line {p/{$leaf p/aura q/@} q/tile} :: %bccn case -++ metl ?($gold $ktbr $ktpm $ktwt) :: core variance -++ noun * :: any noun -++ null $~ :: null, nil, etc -++ onyx (list (pair span foot)) :: arm activation -++ opal :: limb match - $% {$& p/span} :: leg - {$| p/axis q/(set {p/span q/foot})} :: arm - == :: -++ pica (pair ? cord) :: & prose, | code -++ palo (pair vein opal) :: wing trace, match -++ pock (pair axis nock) :: changes -++ port (each palo (pair span nock)) :: successful match -++ root twig :: produce model -++ tiki :: test case - $% {$& p/(unit term) q/wing} :: simple wing - {$| p/(unit term) q/twig} :: named wing - == :: -++ tile $^ {p/tile q/tile} :: ordered pair - $% {$axil p/base} :: base span - {$bark p/toga q/tile} :: name - {$bckt p/tile q/tile} :: pair+tag - {$deet p/spot q/tile} :: set debug - {$fern p/{i/tile t/(list tile)}} :: plain selection - {$herb p/twig} :: assembly - {$kelp p/{i/line t/(list line)}} :: tag selection - {$leaf p/term q/@} :: constant atom - {$plow p/what q/tile} :: apply help - {$reed p/tile q/tile} :: atom+cell - {$weed p/twig} :: example - == :: -++ toga :: face control - $@ p/term :: two togas - $% {$0 $~} :: no toga - {$1 p/(pair what term) q/toga} :: deep toga - {$2 p/toga q/toga} :: cell toga - == :: -++ tomb (pair chap (map term (pair what foot))) :: core chapter -++ tuna :: tagflow - $% {$a p/twig} :: plain text - {$b p/twig} :: single tag - {$c p/twig} :: simple list - {$d p/twig} :: dynamic list - {$e p/twig q/(list tuna)} :: element - {$f p/(list tuna)} :: subflow - == :: -++ twig :: - $^ {p/twig q/twig} :: - $% :: - {$$ p/axis} :: simple leg - :: :: - {$base p/base} :: base - {$bunt p/root} :: mold default value - {$bust p/base} :: bunt base - {$dbug p/spot q/twig} :: debug info in trace - {$eror p/tape} :: assembly error - {$hand p/span q/nock} :: premade result - {$help p/what q/twig} :: annotate image - {$halo p/what q/root} :: annotate model - {$knit p/(list woof)} :: assemble string - {$leaf p/(pair term @)} :: symbol - {$limb p/term} :: pulls limb p - {$lost p/twig} :: not to be taken - {$rock p/term q/*} :: fixed constant - {$sand p/term q/*} :: unfixed constant - {$tell p/(list twig)} :: render as tape - {$tune p/(pair what $@(term tune))} :: minimal face - {$wing p/wing} :: pulls p - {$yell p/(list twig)} :: render as tank - :: :::::: molds - {$bcpt p/root q/root} :: $@ depth fork - {$bccb p/twig} :: $_ example - {$bccl p/(list root)} :: $: tuple - {$bccn p/(list root)} :: $% tagged fork - {$bchp p/root q/root} :: $- function - {$bckt p/root q/root} :: $^ pairhead fork - {$bcwt p/(list root)} :: $? untagged fork - {$bcts p/toga q/root} :: $= name - {$bcsm p/twig} :: $; assembly - :: :::::: cores - {$brcb p/chap q/root r/(map @ tomb)} :: |_ - {$brcl p/chap q/twig r/twig} :: |: - {$brcn p/chap q/(map @ tomb)} :: |% - {$brdt p/chap q/twig} :: |. - {$brkt p/chap q/twig r/(map @ tomb)} :: |^ - {$brhp p/chap q/twig} :: |- - {$brsg p/chap q/twig r/twig} :: |~ - {$brtr p/chap q/root r/twig} :: |* - {$brts p/chap q/root r/twig} :: |= - {$brwt p/chap q/twig} :: |? - :: :::::: tuples - {$clcb p/twig q/twig} :: :_ [q p] - {$clkt p/twig q/twig r/twig s/twig} :: :^ [p q r s] - {$clhp p/twig q/twig} :: :- [p q] - {$clls p/twig q/twig r/twig} :: :+ [p q r] - {$clsg p/(list twig)} :: :~ [p ~] - {$cltr p/(list twig)} :: :* p as a tuple - :: :::::: invocations - {$cncb p/wing q/(list (pair wing twig))} :: %_ - {$cndt p/twig q/twig} :: %. - {$cnhp p/twig q/(list twig)} :: %- - {$cntr p/wing q/twig r/(list (pair wing twig))} :: %* - {$cnkt p/twig q/twig r/twig s/twig} :: %^ - {$cnls p/twig q/twig r/twig} :: %+ - {$open p/wing q/twig r/(list twig)} :: %~ - {$make p/wing q/(list (pair wing twig))} :: %= - :: :::::: nock - {$dtkt p/root q/twig} :: .^ nock 11 - {$dtls p/twig} :: .+ nock 4 - {$dttr p/twig q/twig} :: .* nock 2 - {$dtts p/twig q/twig} :: .= nock 5 - {$dtwt p/twig} :: .? nock 3 - :: :::::: span conversion - {$ktbr p/twig} :: ^| - {$ktdt p/twig q/twig} :: ^. - {$ktls p/twig q/twig} :: ^+ - {$kthp p/root q/twig} :: ^- - {$ktpm p/twig} :: ^& - {$ktsg p/twig} :: ^~ - {$ktts p/toga q/twig} :: ^= - {$ktwt p/twig} :: ^? - :: :::::: hints - {$show p/twig q/twig} :: ~| sell on trace - {$lurk p/twig q/twig} :: ~_ tank on trace - {$fast p/chum q/twig r/tyre s/twig} :: ~% general jet hint - {$funk p/chum q/twig} :: ~/ function j-hint - {$thin p/$@(term {p/term q/twig}) q/twig} :: ~< backward hint - {$hint p/$@(term {p/term q/twig}) q/twig} :: ~> forward hint - {$poll p/term q/twig} :: ~$ profiler hit - {$memo p/@ q/twig} :: ~+ cache/memoize - {$dump p/@ud q/twig r/twig} :: ~& printf/priority - {$ddup p/twig q/twig} :: ~= don't duplicate - {$warn p/@ud q/twig r/twig s/twig} :: ~? tested printf - {$peep p/twig q/twig} :: ~! type on trace - :: :::::: miscellaneous - {$smcl p/twig q/(list twig)} :: ;: binary to nary - {$smfs p/twig} :: ;/ [%$ [%$ p ~] ~] - {$smsg p/twig q/(list twig)} :: ;~ kleisli arrow - {$smsm p/twig q/twig} :: ;; normalize - :: :::::: compositions - {$new p/root q/twig} :: =| push bunt - {$fix p/(list (pair wing twig)) q/twig} :: =: q with p changes - {$var p/toro q/twig r/twig} :: =/ typed variable - {$rev p/toro q/twig r/twig} :: =; =/(q p r) - {$set p/wing q/twig r/twig} :: =. r with p as q - {$huh p/wing q/twig r/twig s/twig} :: =? conditional =. - {$rap p/twig q/twig} :: =< =>(q p) - {$nip p/twig q/twig} :: =- =+(q p) - {$per p/twig q/twig} :: => q w/subject p - {$sip p/toro q/wing r/twig s/twig} :: =^ state machine - {$pin p/twig q/twig} :: =+ q w/[p subject] - {$tow p/(list twig)} :: =~ twig stack - {$aka p/(pair what term) q/twig r/twig} :: =* r w/alias p/q - {$use p/twig q/twig} :: =, overload p in q - :: :::::: conditionals - {$or p/(list twig)} :: ?| loobean or - {$case p/wing q/(list (pair root twig))} :: ?- pick case in q - {$if p/twig q/twig r/twig} :: ?: if/then/else - {$lest p/twig q/twig r/twig} :: ?. ?:(p r q) - {$ifcl p/wing q/twig r/twig} :: ?^ if p is a cell - {$deny p/twig q/twig} :: ?< ?:(p !! q) - {$sure p/twig q/twig} :: ?> ?:(p q !!) - {$deft p/wing q/twig r/(list (pair root twig))} :: ?+ ?- w/default - {$and p/(list twig)} :: ?& loobean and - {$ifat p/wing q/twig r/twig} :: ?@ if p is atom - {$ifno p/wing q/twig r/twig} :: ?~ if p is null - :: - {$fits p/root q/wing} :: ?= if q matches p - {$not p/twig} :: ?! loobean not - :: :::::: special - {$twig p/twig q/twig} :: !, - {$wrap p/twig} :: !> - {$spit p/twig q/twig} :: !; - {$code p/twig} :: != - {$need p/$@(p/@ {p/@ q/@}) q/twig} :: !? - {$fail $~} :: !! - == :: -++ toro (pair toga (unit root)) :: -++ twit twig :: last-gen twig -++ tyre (list {p/term q/twig}) :: -++ tyke (list (unit twig)) :: -:: :::::: virtual nock -++ nock $^ {p/nock q/nock} :: autocons - $% {$0 p/@} :: axis select - {$1 p/*} :: constant - {$2 p/nock q/nock} :: compose - {$3 p/nock} :: cell test - {$4 p/nock} :: increment - {$5 p/nock q/nock} :: equality test - {$6 p/nock q/nock r/nock} :: if, then, else - {$7 p/nock q/nock} :: serial compose - {$8 p/nock q/nock} :: push onto subject - {$9 p/@ q/nock} :: select arm and fire - {$10 p/$@(@ {p/@ q/nock}) q/nock} :: hint - {$11 p/nock q/nock} :: grab data from sky - == :: -++ span $@ $? $noun :: any nouns - $void :: no noun - == :: - $% {$atom p/term q/(unit @)} :: atom / constant - {$cell p/span q/span} :: ordered pair - {$core p/span q/coil} :: object - {$face p/{p/what q/$@(term tune)} q/span} :: namespace (new) - {$fork p/(set span)} :: union - {$help p/what q/span} :: documentation - {$hold p/span q/twig} :: lazy evaluation - == :: -++ tone $% {$0 p/*} :: success - {$1 p/(list)} :: blocks - {$2 p/(list {@ta *})} :: error ~_s - == :: -++ tune :: complex - $: p/(map term (pair what (unit twig))) :: aliases - q/(list twig) :: bridges - == :: -++ typo span :: old span -++ vase {p/span q/*} :: span-value pair -++ vise {p/typo q/*} :: old vase -++ vial ?($read $rite $both $free) :: co/contra/in/bi -++ vair ?($gold $ktbr $ktwt $ktpm) :: in/contra/bi/co -++ vein (list (unit axis)) :: search trace -++ sect (list pica) :: paragraph -++ whit :: - $: lab/(unit term) :: label - boy/(unit (pair cord (list sect))) :: body - def/(map term (pair cord (list sect))) :: definitions - use/(set term) :: defs used - == :: -++ what (unit (pair cord (list sect))) :: help slogan/sections -++ wing (list limb) :: search path -++ worm :: compiler cache - $: nes/(set ^) :: ++nest - pay/(map (pair span twig) span) :: ++play - mit/(map (pair span twig) (pair span nock)) :: ++mint - == :: --- -:: :: -:::: 5: layer five :: - :: :: - :: 5a: compiler utilities :: - :: 5b: macro expansion :: - :: 5c: compiler backend and prettyprinter :: - :: 5d: parser :: - :: 5e: caching compiler :: - :: 5f: molds and mold builders :: - :: 5g: profiling support (XX remove) :: - :: -~% %pen - + - == - %al al - %ap ap - %ut ut - == -|% -:: -:::: 5a: compiler utilities - :: -++ bool `span`(fork [%atom %f `0] [%atom %f `1] ~) :: make loobean -++ cell :: make %cell span - ~/ %cell - |= {hed/span tal/span} - ^- span - ?:(=(%void hed) %void ?:(=(%void tal) %void [%cell hed tal])) -:: -++ core :: make %core span - ~/ %core - |= {pac/span con/coil} - ^- span - ?:(=(%void pac) %void [%core pac con]) -:: -++ help - ~/ %help - |= {p/what q/span} - ^- span - ?: =(%void q) - %void - [%help p q] -:: -++ face :: make %face span - ~/ %face - |= {giz/{what $@(term tune)} der/span} - ^- span - ?: =(%void der) - %void - [%face giz der] -:: -++ fork :: make %fork span - ~/ %fork - |= yed/(list span) - =| lez/(set span) - |- ^- span - ?~ yed - ?~ lez %void - ?: ?=({* $~ $~} lez) n.lez - [%fork lez] - %= $ - yed t.yed - lez - ?: =(%void i.yed) lez - ?: ?=({$fork *} i.yed) (~(uni in lez) p.i.yed) - (~(put in lez) i.yed) - == -:: -++ cove :: extract [0 *] axis - |= nug/nock - ?- nug - {$0 *} p.nug - {$10 *} $(nug q.nug) - * ~_(leaf+"cove" !!) - == -++ comb :: combine two formulas - ~/ %comb - |= {mal/nock buz/nock} - ^- nock - ?: ?&(?=({$0 *} mal) !=(0 p.mal)) - ?: ?&(?=({$0 *} buz) !=(0 p.buz)) - [%0 (peg p.mal p.buz)] - ?: ?=({$2 {$0 *} {$0 *}} buz) - [%2 [%0 (peg p.mal p.p.buz)] [%0 (peg p.mal p.q.buz)]] - [%7 mal buz] - ?: ?=({^ {$0 $1}} mal) - [%8 p.mal buz] - ?: =([%0 %1] buz) - mal - [%7 mal buz] -:: -++ cond :: ?: compile - ~/ %cond - |= {pex/nock yom/nock woq/nock} - ^- nock - ?- pex - {$1 $0} yom - {$1 $1} woq - * [%6 pex yom woq] - == -:: -++ cons :: make formula cell - ~/ %clhp - |= {vur/nock sed/nock} - ^- nock - ?: ?=({{$0 *} {$0 *}} +<) - ?: ?&(=(+(p.vur) p.sed) =((div p.vur 2) (div p.sed 2))) - [%0 (div p.vur 2)] - [vur sed] - ?: ?=({{$1 *} {$1 *}} +<) - [%1 p.vur p.sed] - [vur sed] -:: -++ fitz :: odor compatibility - ~/ %fitz - |= {yaz/term wix/term} - =+ ^= fiz - |= mot/@ta ^- {p/@ q/@ta} - =+ len=(met 3 mot) - ?: =(0 len) - [0 %$] - =+ tyl=(rsh 3 (dec len) mot) - ?: &((gte tyl 'A') (lte tyl 'Z')) - [(sub tyl 64) (end 3 (dec len) mot)] - [0 mot] - =+ [yoz=(fiz yaz) wux=(fiz wix)] - ?& ?| =(0 p.yoz) - =(0 p.wux) - &(!=(0 p.wux) (lte p.wux p.yoz)) - == - |- ?| =(%$ p.yoz) - =(%$ p.wux) - ?& =((end 3 1 p.yoz) (end 3 1 p.wux)) - $(p.yoz (rsh 3 1 p.yoz), p.wux (rsh 3 1 p.wux)) - == - == - == -:: -++ flan :: loobean & - ~/ %flan - |= {bos/nock nif/nock} - ^- nock - ?- bos - {$1 $1} bos - {$1 $0} nif - * - ?- nif - {$1 $1} nif - {$1 $0} bos - * [%6 bos nif [%1 1]] - == - == -:: -++ flip :: loobean negation - ~/ %flip - |= dyr/nock - [%6 dyr [%1 1] [%1 0]] -:: -++ flor :: loobean | - ~/ %flor - |= {bos/nock nif/nock} - ^- nock - ?- bos - {$1 $1} nif - {$1 $0} bos - * - ?- nif - {$1 $1} bos - {$1 $0} nif - * [%6 bos [%1 0] nif] - == - == -:: -++ hike - ~/ %hike - |= {axe/axis pac/(list {p/axis q/nock})} - ^- nock - ?~ pac - [%0 axe] - =+ zet=(skim pac.$ |=({p/axis q/nock} [=(1 p)])) - ?~ zet - =+ tum=(skim pac.$ |=({p/axis q/nock} ?&(!=(1 p) =(2 (cap p))))) - =+ gam=(skim pac.$ |=({p/axis q/nock} ?&(!=(1 p) =(3 (cap p))))) - %+ cons - %= $ - axe (peg axe 2) - pac (turn tum |=({p/axis q/nock} [(mas p) q])) - == - %= $ - axe (peg axe 3) - pac (turn gam |=({p/axis q/nock} [(mas p) q])) - == - ?>(?=({* $~} zet) q.i.zet) -:: -++ jock - |= rad/? - |= lot/coin ^- twig - ?- -.lot - $~ - ?:(rad [%rock p.lot] [%sand p.lot]) - :: - $blob - ?: rad - [%rock %$ p.lot] - ?@(p.lot [%sand %$ p.lot] [$(p.lot -.p.lot) $(p.lot +.p.lot)]) - :: - $many - [%cltr (turn p.lot |=(a/coin ^$(lot a)))] - == -:: -++ look - ~/ %look - |= {cog/term dab/(map term (pair what foot))} - =+ axe=1 - |- ^- (unit {p/axis q/(pair what foot)}) - ?- dab - $~ ~ - :: - {* $~ $~} - ?:(=(cog p.n.dab) [~ axe q.n.dab] ~) - :: - {* $~ *} - ?: =(cog p.n.dab) - [~ (peg axe 2) q.n.dab] - ?: (gor cog p.n.dab) - ~ - $(axe (peg axe 3), dab r.dab) - :: - {* * $~} - ?: =(cog p.n.dab) - [~ (peg axe 2) q.n.dab] - ?: (gor cog p.n.dab) - $(axe (peg axe 3), dab l.dab) - ~ - :: - {* * *} - ?: =(cog p.n.dab) - [~ (peg axe 2) q.n.dab] - ?: (gor cog p.n.dab) - $(axe (peg axe 6), dab l.dab) - $(axe (peg axe 7), dab r.dab) - == -:: -++ loot - ~/ %loot - |= {cog/term dom/(map @ tomb)} - =+ axe=1 - |- ^- (unit {p/axis q/(pair what foot)}) - ?- dom - $~ ~ - :: - {* $~ $~} - %+ bind (look cog q.q.n.dom) - |=((pair axis (pair what foot)) [(peg axe p) q]) - :: - {* $~ *} - =+ yep=(look cog q.q.n.dom) - ?^ yep - [~ (peg (peg axe 2) p.u.yep) q.u.yep] - $(axe (peg axe 3), dom r.dom) - :: - {* * $~} - =+ yep=(look cog q.q.n.dom) - ?^ yep - [~ (peg (peg axe 2) p.u.yep) q.u.yep] - $(axe (peg axe 3), dom l.dom) - :: - {* * *} - =+ yep=(look cog q.q.n.dom) - ?^ yep - [~ (peg (peg axe 2) p.u.yep) q.u.yep] - =+ pey=$(axe (peg axe 6), dom l.dom) - ?^ pey pey - $(axe (peg axe 7), dom r.dom) - == -:: -:::: 5b: macro expansion - :: -++ ah :: tiki engine - |_ tik/tiki - ++ blue - |= gen/twig - ^- twig - ?. &(?=($| -.tik) ?=($~ p.tik)) gen - [%per [%$ 3] gen] - :: - ++ gray - |= gen/twig - ^- twig - ?- -.tik - $& ?~(p.tik gen [%aka [~ u.p.tik] [%wing q.tik] gen]) - $| [%pin ?~(p.tik q.tik [%ktts u.p.tik q.tik]) gen] - == - :: - ++ puce - ^- wing - ?- -.tik - $& ?~(p.tik q.tik [u.p.tik ~]) - $| [[%& 2] ~] - == - :: - ++ wthp |= opt/(list (pair root twig)) - %+ gray %case - [puce (turn opt |=({a/root b/twig} [a (blue b)]))] - ++ wtkt |=({sic/twig non/twig} (gray [%ifcl puce (blue sic) (blue non)])) - ++ wtls |= {gen/twig opt/(list (pair root twig))} - %+ gray %deft - [puce (blue gen) (turn opt |=({a/root b/twig} [a (blue b)]))] - ++ wtpt |=({sic/twig non/twig} (gray [%ifat puce (blue sic) (blue non)])) - ++ wtsg |=({sic/twig non/twig} (gray [%ifno puce (blue sic) (blue non)])) - ++ wtts |=(gen/twig (gray [%fits (blue gen) puce])) - -- -:: -++ al :: tile engine - ~% %al - +>+ - == - %bunt bunt - %whip whip - == - =+ :* nag=`*`& - gom=`axis`1 - wat=*what - == - |_ sec/tile - :::: - ++ hail - |= gen/twig - ^- twig - ?~(wat gen [%help wat gen]) - :: - ++ home |=(gen/twig ^-(twig ?:(=(1 gom) gen [%per [%$ gom] gen]))) - :::: - ++ bunt - |- ^- twig - ?- sec - {^ *} - %- hail - =. wat ~ - (hail [$(sec p.sec) $(sec q.sec)]) - :: - {$axil *} - %- hail - =. wat ~ - ?- p.sec - {$atom *} [%sand p.p.sec 0] - $noun [%dttr [%rock %$ 0] [[%rock %$ 0] [%rock %$ 1]]] - $cell =+(nec=$(sec [%axil %noun]) [nec nec]) - $bean [%dtts [%rock %$ 0] [%rock %$ 0]] - $void [%fail ~] - $null [%rock %n %$] - == - :: - {$bark *} - [%ktts p.sec $(sec q.sec)] - :: - {$bckt *} - %- hail - =. wat ~ - [%if [%bust %bean] $(sec p.sec) $(sec q.sec)] - :: - {$deet *} - [%dbug p.sec $(sec q.sec)] - :: - {$fern *} - %- hail - =. wat ~ - |- ^- twig - ?~ t.p.sec - ^$(sec i.p.sec) - [%if [%bust %bean] ^$(sec i.p.sec) $(p.sec t.p.sec)] - :: - {$herb *} - %- hail - =. wat ~ - =+ cys=~(boil ap p.sec) - ?: ?=($herb -.cys) - (home [%rap [%limb %$] p.sec]) - $(sec cys) - :: - {$kelp *} - %- hail - =. wat ~ - |- ^- twig - ?~ t.p.sec - ^$(sec i.p.sec) - [%if [%bust %bean] ^$(sec i.p.sec) $(p.sec t.p.sec)] - :: - {$leaf *} - (hail [%rock p.sec q.sec]) - :: - {$plow *} - ?> =(*what wat) - $(sec q.sec, wat p.sec) - :: - {$reed *} - %- hail - =. wat ~ - [%if [%bust %bean] $(sec p.sec) $(sec q.sec)] - :: - {$weed *} - (hail (home p.sec)) - == - ++ clam - ^- twig - [%brts [~ ~] [%base %noun] (whip(gom 7) 6)] - :: - ++ whip - |= axe/axis - =+ ^= tun - |= noy/$-(* twig) - ^- twig - ?@ nag - =+ luz=[%make [[%& 1] ~] [[[%& axe] ~] bunt(sec [%axil %cell])] ~] - ?: =(& nag) - [%per [%ifat [[%& axe] ~] luz [%$ 1]] (noy [& &])] - [%per luz (noy [& &])] - (noy nag) - ^- twig - ?- sec - {^ *} - %- hail - =. wat ~ - %- tun |= gon/* => .(nag gon) ^- twig - :- ^$(sec -.sec, nag -.nag, axe (peg axe 2)) - ^$(sec +.sec, nag +.nag, axe (peg axe 3)) - :: - {$axil *} - %- hail - =. wat ~ - ?- p.sec - {$atom *} - =+ buv=bunt - |- ^- twig - ?@ nag - ?:(=(& nag) [%ifat [[%& axe] ~] $(nag |) buv] [%ktls buv [%$ axe]]) - buv - :: - $noun - [%kthp [%base %noun] [%$ axe]] - :: - $cell - =+ buv=bunt - |- ^- twig - ?@ nag - ?:(=(& nag) [%ifat [[%& axe] ~] buv $(nag [& &])] buv) - [%ktls buv [%$ axe]] - :: - $bean - :^ %if - [%dtts [%rock %$ |] [%$ axe]] - [%rock %f |] - [%rock %f &] - :: - $void - bunt - :: - $null - bunt - == - :: - {$bark *} - [%ktts p.sec $(sec q.sec)] - :: - {$bckt *} - %- hail - =. wat ~ - %- tun |= gon/* => .(nag gon) ^- twig - ?@ -.nag - ?: =(& -.nag) - [%ifat [[%& (peg axe 2)] ~] ^$(sec q.sec) ^$(sec p.sec)] - ^$(sec q.sec) - ^$(sec p.sec) - :: - {$deet *} - [%dbug p.sec $(sec q.sec)] - :: - {$fern *} - %- hail - =. wat ~ - |- ^- twig - ?~ t.p.sec - ^$(sec i.p.sec) - :+ %pin - ^$(sec i.p.sec) - => .(axe (peg 3 axe), gom (peg 3 gom)) - :^ %if - [%dtts [%$ axe] [%$ 2]] - [%$ 2] - $(i.p.sec i.t.p.sec, t.p.sec t.t.p.sec) - :: - {$herb *} - %- hail - =. wat ~ - =+ cys=~(boil ap p.sec) - ?: ?=($herb -.cys) - [%cnhp (home p.sec) [%$ axe] ~] - $(sec cys) - :: - {$kelp *} - %- hail - =. wat ~ - %- tun |= gon/* => .(nag gon) - |- ^- twig - ?~ t.p.sec - :- [%rock +.p.i.p.sec] - ^^$(axe (peg axe 3), sec q.i.p.sec, nag &) - :^ %if - [%dtts [%$ (peg axe 2)] [%rock +.p.i.p.sec]] - :- [%rock +.p.i.p.sec] - ^^$(axe (peg axe 3), sec q.i.p.sec, nag &) - $(i.p.sec i.t.p.sec, t.p.sec t.t.p.sec) - :: - {$leaf *} - (hail [%rock p.sec q.sec]) - :: - {$plow *} - $(sec q.sec, wat p.sec) - :: - {$reed *} - %- hail - =. wat ~ - ?- nag - $& [%ifat [[%& axe] ~] $(sec p.sec, nag |) $(sec q.sec, nag [& &])] - $| $(sec p.sec) - ^ $(sec q.sec) - * !! - == - :: - {$weed *} - (hail (home p.sec)) - == - -- -:: -++ ap :: twig engine - ~% %ap - +> - == - %etch etch - %open open - %rake rake - == - |_ gen/twig - ++ etch - ~_ leaf+"etch" - |- ^- term - ?: ?=({$ktts *} gen) - ?>(?=(@ p.gen) p.gen) - =+ voq=~(open ap gen) - ?<(=(gen voq) $(gen voq)) - :: - ++ feck - |- ^- (unit term) - ?- gen - {$sand $tas @} [~ q.gen] - {$dbug *} $(gen q.gen) - * ~ - == - :: - ++ gi - =| whit - =* wit - - |% - ++ gray - ^- ? - | - :: on reflection, perhaps just obsessive linting - :: - :: ?| ?=(^ lab) - :: ?=(^ boy) - :: |- ^- ? - :: ?~ def | - :: |($(def l.def) $(def r.def) !(~(has in use) p.n.def)) - :: == - :: - ++ grad - |= $: gen/twig - wit/whit - aid/$-({? twig whit} {twig whit}) - == - ^- (unit (pair twig whit)) - =: ^gen gen - ^wit wit - == - ?: =([~ ~ ~ ~] wit) `[gen wit] - =< apex - |% - ++ apex - ^- (unit (pair twig whit)) - =^ one wit prim - =^ two wit senc(gen one) - ?: =(gen two) - ~ - `(aid & two wit) - :: - :: resolve body and label issues - :: - ++ prim - ^- (pair twig whit) - ?: ?=(^ -.gen) flam - ?+ -.gen flam - $halo flam - $base runk - $leaf runk - $bcpt runk - $bccb runk - $bccl runk - $bccn runk - $bchp runk - $bckt runk - $bcwt runk - $bcts flam - $bcsm runk - $brcb ((doof -.gen +>.gen) p.gen) - $brcl ((doof -.gen +>.gen) p.gen) - $brcn ((doof -.gen +>.gen) p.gen) - $brdt ((doof -.gen +>.gen) p.gen) - $brkt ((doof -.gen +>.gen) p.gen) - $brhp ((doof -.gen +>.gen) p.gen) - $brsg ((doof -.gen +>.gen) p.gen) - $brtr ((doof -.gen +>.gen) p.gen) - $brts ((doof -.gen +>.gen) p.gen) - $brwt ((doof -.gen +>.gen) p.gen) - == - :: - :: resolve variable issues - :: - ++ senc - ^- (pair twig whit) - ?: ?=(^ -.gen) flam - ?+ -.gen flam - $ktts ((helk -.gen +>.gen) p.gen) - $bcts ((helk -.gen +>.gen) p.gen) - $var ((hulp -.gen +>.gen) p.gen) - $rev ((hulp -.gen +>.gen) p.gen) - $sip ((hulp -.gen +>.gen) p.gen) - $aka ((humm -.gen +>.gen) p.gen) - == - :: - ++ flam [gen wit] - ++ grif - |= {cog/term wat/what} - ^- {what whit} - ?: =(~ def) - ?~ boy [wat wit] - [boy wit(boy ~)] - =+ yeb=(~(get by def) cog) - ?~ yeb [wat wit] - [`u.yeb wit(use (~(put in use) cog))] - :: - ++ doof - |* {pif/@tas suf/*} - |= pac/chap - ^- (pair twig whit) - :_ wit(lab ~, boy ~) - =- [pif - suf] - ^- chap - :- ?~(lab p.pac [u.lab ~]) - ?~(boy q.pac boy) - :: - ++ helk - |* {pif/@tas suf/*} - |= got/toga - ^- (pair twig whit) - =^ gef wit (tong got) - [[pif gef suf] wit] - :: - ++ hulp - |* {pif/@tas suf/*} - |= hot/toro - ^- (pair twig whit) - =^ tog wit (tong p.hot) - [[pif [tog q.hot] suf] wit] - :: - ++ humm - |* {pif/@tas suf/*} - |= {wat/what cog/term} - ^- (pair twig whit) - =^ taw wit (grif cog wat) - [[pif [taw cog] suf] wit] - :: - ++ runk - ^- (pair twig whit) - ?~ boy flam - [[%halo boy gen] wit(boy ~)] - :: - ++ tong - |= got/toga - ^- {toga whit} - ?@ got - =^ wat wit (grif got ~) - ?~ wat [got wit] - [[%1 [wat got] [%0 ~]] wit] - ?- -.got - $0 [got wit] - $1 =^ wat wit (grif q.p.got p.p.got) - =^ sub wit $(got q.got) - [[%1 [wat q.p.got] sub] wit] - $2 =^ one wit $(got p.got) - =^ two wit $(got q.got) - [[%2 one two] wit] - == - -- - :: - ++ graf - :: ^- (unit twig) - :: =^ nex wit ((walk whit) wit grad) - :: ?:(gray ~ `nex) - =^ nex wit ((walk whit) wit grad) - nex - -- - :: - :: not used at present; see comment at $csng in ++open -:::: -::++ hail -:: |= axe/axis -:: =| air/(list (pair wing twig)) -:: |- ^+ air -:: =+ hav=half -:: ?~ hav [[[[%| 0 ~] [%& axe] ~] gen] air] -:: $(gen p.u.hav, axe (peg axe 2), air $(gen q.u.hav, axe (peg axe 3))) -:::: -::++ half -:: |- ^- (unit (pair twig twig)) -:: ?+ gen ~ -:: {^ *} `[p.gen q.gen] -:: {$dbug *} $(gen q.gen) -:: {$clcb *} `[q.gen p.gen] -:: {$clhp *} `[p.gen q.gen] -:: {$clkt *} `[p.gen %clls q.gen r.gen s.gen] -:: {$clsg *} ?~(p.gen ~ `[i.p.gen %clsg t.p.gen]) -:: {$cltr *} ?~ p.gen ~ -:: ?~(t.p.gen $(gen i.p.gen) `[i.p.gen %cltr t.p.gen]) -:: == -:::: - ++ hock - |- ^- toga - ?- gen - {$make {@ $~} $~} i.p.gen - {$limb @} p.gen - {$wing {@ $~}} i.p.gen - {$dbug *} $(gen q.gen) - {@ *} =+(neg=open ?:(=(gen neg) [%0 ~] $(gen neg))) - {^ *} =+ toe=[$(gen p.gen) $(gen q.gen)] - ?:(=(toe [[%0 ~] [%0 ~]]) [%0 ~] [%2 toe]) - == - :: - ++ bile - =+ sec=boil - |- ^- (each line tile) - ?: ?=({$plow *} sec) - $(sec q.sec) - ?: ?=({$deet *} sec) - $(sec q.sec) - ?: ?=({{$deet *} *} sec) - $(p.sec q.p.sec) - ?: ?=({{$leaf *} *} sec) - [%& [%leaf p.p.sec q.p.sec] q.sec] - [%| sec] - :: - ++ boil - ^- tile - ?+ gen [%herb gen] - {$base *} [%axil p.gen] - {$dbug *} [%deet p.gen boil(gen q.gen)] - {$leaf *} [%leaf p.gen] - :: - {$bcpt *} [%reed boil(gen p.gen) boil(gen q.gen)] - {$bccb *} [%weed p.gen] - {$bccl *} - |- ^- tile - ?~ p.gen [%axil %null] - ?~ t.p.gen boil(gen i.p.gen) - [boil(gen i.p.gen) $(p.gen t.p.gen)] - :: - {$bccn *} - ?~ p.gen - [%axil %void] - ?~ t.p.gen - boil(gen i.p.gen) - =+ :* def=bile(gen i.p.gen) - ^= end ^- (list line) - ~_ leaf+"book-foul" - %+ turn `(list twig)`t.p.gen - |=(a/twig =+(bile(gen a) ?>(?=($& -<) ->))) - == - ?- -.def - $& [%kelp p.def end] - $| ?~(end p.def [%fern p.def [%kelp end] ~]) - == - :: - {$bckt *} [%bckt boil(gen p.gen) boil(gen q.gen)] - {$bchp *} [%weed [%brsg [~ ~] p.gen [%bunt [%per [%$ 7] q.gen]]]] - {$halo *} [%plow p.gen boil(gen q.gen)] - {$bcts *} [%bark p.gen boil(gen q.gen)] - {$bcwt *} =+ (turn p.gen |=(a/twig boil(gen a))) - ?~(- [%axil %void] [%fern -]) - {$bcsm *} [%herb p.gen] - == - :: - ++ open - ^- twig - ?- gen - {$~ *} [%make [[%& p.gen] ~] ~] - :: - {$base *} ~(clam al boil) - {$bust *} ~(bunt al %axil p.gen) - {$dbug *} q.gen - {$eror *} ~|(p.gen !!) - :: - {$knit *} :: - :+ %per [%ktts %v %$ 1] :: => v=. - :+ %brhp [~ ~] :: |- - :+ %ktls :: ^+ - :+ %brhp [~ ~] :: |- - :^ %if :: ?: - [%bust %bean] :: ? - [%bust %null] :: ~ - :- [%ktts %i [%sand 'tD' *@]] :: :- i=~~ - [%ktts %t [%limb %$]] :: t=$ - |- ^- twig :: - ?~ p.gen :: - [%bust %null] :: ~ - =+ res=$(p.gen t.p.gen) :: - ^- twig :: - ?@ i.p.gen :: - [[%sand 'tD' i.p.gen] res] :: [~~{i.p.gen} {res}] - :+ %pin :: - :- :+ %ktts :: ^= - %a :: a - :+ %ktls :: ^+ - [%limb %$] :: $ - [%per [%limb %v] p.i.p.gen] :: =>(v {p.i.p.gen}) - [%ktts %b res] :: b={res} - ^- twig :: - :+ %brhp [~ ~] :: |- - :^ %ifat :: ?@ - [%a ~] :: a - [%limb %b] :: b - :- [%rap [%$ 2] [%limb %a]] :: :- -.a - :+ %make :: %= - [%$ ~] :: $ - [[[%a ~] [%rap [%$ 3] [%limb %a]]] ~] :: a +.a - :: - {$leaf *} ~(clam al boil) - {$limb *} [%make [p.gen ~] ~] - {$tell *} [%cnhp [%limb %noah] [%wrap [%cltr p.gen]] ~] - {$wing *} [%make p.gen ~] - {$yell *} [%cnhp [%limb %cain] [%wrap [%cltr p.gen]] ~] - :: - {$bcpt *} ~(clam al boil) - {$bccb *} ~(clam al boil) - {$bccl *} ~(clam al boil) - {$bccn *} ~(clam al boil) - {$bchp *} ~(clam al boil) - {$bckt *} ~(clam al boil) - {$bcwt *} ~(clam al boil) - {$bcts *} ~(clam al boil) - {$halo *} ~(clam al boil) - {$bcsm *} p.gen - :: - {$brcb *} [%pin [%bunt q.gen] [%brcn p.gen r.gen]] - {$brcl *} [%pin [%ktsg q.gen] [%brdt p.gen r.gen]] - {$brdt *} :+ %brcn p.gen - =- [[0 [~ ~] -] ~ ~] - (~(put by *(map term (pair what foot))) %$ ~ [%ash q.gen]) - {$brkt *} :+ %per - :+ %brcn p.gen - =+ one=(~(got by r.gen) 0) - %+ ~(put by r.gen) 0 - one(q (~(put by q.one) %$ [~ [%ash q.gen]])) - [%limb %$] - {$brhp *} [%rap [%limb %$] [%brdt p.gen q.gen]] - {$brsg *} [%ktbr [%brts p.gen q.gen r.gen]] - {$brtr *} :+ %pin [%bunt q.gen] - :+ %brcn p.gen - =- [[0 [~ ~] -] ~ ~] - (~(put by *(map term (pair what foot))) %$ ~ [%elm r.gen]) - {$brts *} :^ %brcb p.gen q.gen - =- [[0 [~ ~] -] ~ ~] - (~(put by *(map term (pair what foot))) %$ ~ [%ash r.gen]) - {$brwt *} [%ktwt %brdt p.gen q.gen] - :: - {$clkt *} [p.gen q.gen r.gen s.gen] - {$clls *} [p.gen q.gen r.gen] - {$clcb *} [q.gen p.gen] - {$clhp *} [p.gen q.gen] - {$clsg *} - |- ^- twig - ?~ p.gen - [%rock %n ~] - [i.p.gen $(p.gen t.p.gen)] - :: - {$cltr *} - |- ^- twig - ?~ p.gen - [%fail ~] - ?~ t.p.gen - i.p.gen - [i.p.gen $(p.gen t.p.gen)] - :: - {$bunt *} [%ktsg ~(bunt al %herb p.gen)] - {$cncb *} [%ktls [%wing p.gen] %make p.gen q.gen] - {$cndt *} [%cnhp q.gen [p.gen ~]] - {$cnkt *} [%cnhp p.gen q.gen r.gen s.gen ~] - {$cnls *} [%cnhp p.gen q.gen r.gen ~] - {$cnhp *} [%open [%$ ~] p.gen q.gen] - {$open *} :: [%cntr p.gen q.gen (hail(gen [%cltr r.gen]) 6)] - :^ %cntr p.gen q.gen - :: - :: the use of ++hail is probably the right language design, but - :: it's impractically slow without validating %=. - :: -:: ?:(=(~ r.gen) ~ (hail(gen [%cltr r.gen]) 6)) - =+ axe=6 - |- ^- (list {wing twig}) - ?~ r.gen ~ - ?~ t.r.gen [[[[%| 0 ~] [%& axe] ~] i.r.gen] ~] - :- [[[%| 0 ~] [%& (peg axe 2)] ~] i.r.gen] - $(axe (peg axe 3), r.gen t.r.gen) - :: - {$cntr *} - ?: =(~ r.gen) - [%per q.gen [%wing p.gen]] - :+ %pin - q.gen - :+ %make - (weld p.gen `wing`[[%& 2] ~]) - (turn r.gen |=({p/wing q/twig} [p [%per [%$ 3] q]])) - :: - {$ktdt *} [%ktls [%cnhp p.gen q.gen ~] q.gen] - {$kthp *} [%ktls ~(bunt al [%herb p.gen]) q.gen] - {$show *} - :+ %hint - :- %mean - =+ fek=~(feck ap p.gen) - ?^ fek [%rock %tas u.fek] - [%brdt [~ ~] [%cnhp [%limb %cain] [%wrap [%per [%$ 3] p.gen]] ~]] - q.gen - :: - {$lurk *} [%hint [%mean [%brdt [~ ~] p.gen]] q.gen] - {$fast *} - :+ %thin - :- %fast - :- %clls - :+ [%rock %$ p.gen] - [%code q.gen] - :- %clsg - =+ nob=`(list twig)`~ - |- ^- (list twig) - ?~ r.gen - nob - [[[%rock %$ p.i.r.gen] [%code q.i.r.gen]] $(r.gen t.r.gen)] - s.gen - :: - {$funk *} [%fast p.gen [%$ 7] ~ q.gen] - {$thin *} [%rap [%hint p.gen [%$ 1]] q.gen] - {$poll *} [%hint [%live [%rock %$ p.gen]] q.gen] - {$memo *} [%hint [%memo %rock %$ p.gen] q.gen] - {$dump *} - :+ %hint - [%slog [%sand %$ p.gen] [%cnhp [%limb %cain] [%wrap q.gen] ~]] - r.gen - :: - {$ddup *} [%hint [%germ p.gen] q.gen] - {$warn *} - :+ %pin [%lest q.gen [%bust %null] [[%bust %null] r.gen]] - :^ %ifno [%& 2]~ - [%per [%$ 3] s.gen] - [%dump p.gen [%$ 5] [%per [%$ 3] s.gen]] - :: - {$smcl *} - ?- q.gen - $~ [%fail ~] - {* $~} i.q.gen - ^ - :+ %pin - p.gen - =+ yex=`(list twig)`q.gen - |- ^- twig - ?- yex - {* $~} [%per [%$ 3] i.yex] - {* ^} [%cnhp [%$ 2] [%per [%$ 3] i.yex] $(yex t.yex) ~] - $~ !! - == - == - :: - {$smfs *} =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~]) - {$smsg *} :: ;~ - |- ^- twig - ?- q.gen - $~ ~_(leaf+"open-smsg" !!) - ^ - :+ %per [%ktts %v %$ 1] :: => v=. - |- ^- twig :: - ?: ?=($~ t.q.gen) :: - [%per [%limb %v] i.q.gen] :: =>(v {i.q.gen}) - :+ %pin [%ktts %a $(q.gen t.q.gen)] :: =+ ^= a - :+ %pin :: {$(q.gen t.q.gen)} - [%ktts %b [%per [%limb %v] i.q.gen]] :: =+ ^= b - :+ %pin :: =>(v {i.q.gen}) - :+ %ktts %c :: =+ c=,.+6.b - :+ %rap :: - [%wing [%| 0 ~] [%& 6] ~] :: - [%limb %b] :: - :+ %brdt [~ ~] :: |. - :^ %cnls :: %+ - [%per [%limb %v] p.gen] :: =>(v {p.gen}) - [%cnhp [%limb %b] [%limb %c] ~] :: (b c) - :+ %make [%a ~] :: a(,.+6 c) - [[[[%| 0 ~] [%& 6] ~] [%limb %c]] ~] :: - == :: - :: - {$smsm *} :: ;; - :+ %per [%ktts %v %$ 1] :: => v=. - :+ %pin :+ %ktts %a :: =+ ^= a - [%per [%limb %v] p.gen] :: =>(v {p.gen}) - :+ %pin [%ktts %b [%per [%limb %v] q.gen]] :: =+ b==>(v {q.gen}) - :+ %pin :: =+ c=(a b) - [%ktts %c [%cnhp [%limb %a] [%limb %b] ~]] :: - :+ %sure :: ?>(=(`*`c `*`b) c) - :+ %dtts :: - [%kthp [%base %noun] [%limb %c]] :: - [%kthp [%base %noun] [%limb %b]] :: - [%limb %c] :: - :: - {$new *} - [%pin ~(bunt al %herb p.gen) q.gen] - :: - {$fix *} - [%per [%cncb [[%& 1] ~] p.gen] q.gen] - :: - {$var *} - ?~ q.p.gen - [%pin [%ktts p.p.gen q.gen] r.gen] - [%pin [%kthp [%bcts p.p.gen u.q.p.gen] q.gen] r.gen] - :: - {$rev *} [%var p.gen r.gen q.gen] - {$set *} - [%per [%cncb [[%& 1] ~] [[p.gen q.gen] ~]] r.gen] - {$huh *} :: =? - [%set p.gen [%if q.gen r.gen [%wing p.gen]] s.gen] - :: - {$sip *} :: =^ - =+ wuy=(weld q.gen `wing`[%v ~]) :: - :+ %per [%ktts %v %$ 1] :: => v=. - :+ %pin [%ktts %a %per [%limb %v] r.gen] :: =+ a==>(v \r.gen) - :^ %set wuy [%rap [%$ 3] [%limb %a]] - :+ %per :- ?~ q.p.gen - :+ %ktts p.p.gen - [%rap [%$ 2] [%limb %a]] - :+ %kthp - :+ %bcts p.p.gen - [%per [%limb %v] u.q.p.gen] - [%rap [%$ 2] [%limb %a]] - [%limb %v] - s.gen - :: - {$rap *} [%per q.gen p.gen] - {$pin *} [%per [p.gen [%$ 1]] q.gen] - {$nip *} [%pin q.gen p.gen] - {$tow *} - |- ^- twig - ?~ p.gen [%$ 1] - ?~ t.p.gen i.p.gen - [%per i.p.gen $(p.gen t.p.gen)] - :: - {$or *} - |- - ?~(p.gen [%rock %f 1] [%if i.p.gen [%rock %f 0] $(p.gen t.p.gen)]) - :: - {$lest *} [%if p.gen r.gen q.gen] - {$deny *} [%if p.gen [%fail ~] q.gen] - {$sure *} [%if p.gen q.gen [%fail ~]] - {$ifcl *} [%if [%fits [%base %atom %$] p.gen] r.gen q.gen] - :: - {$case *} - |- - ?~ q.gen - [%lost [%wing p.gen]] - :^ %if - [%fits p.i.q.gen p.gen] - q.i.q.gen - $(q.gen t.q.gen) - :: - {$deft *} - [%case p.gen (weld r.gen `_r.gen`[[[%base %noun] q.gen] ~])] - :: - {$and *} - |- - ?~(p.gen [%rock %f 0] [%if i.p.gen $(p.gen t.p.gen) [%rock %f 1]]) - :: - {$ifat *} [%if [%fits [%base %atom %$] p.gen] q.gen r.gen] - {$ifno *} [%if [%fits [%base %null] p.gen] q.gen r.gen] - {$not *} [%if p.gen [%rock %f 1] [%rock %f 0]] - {$wrap *} - [%cnhp [%limb %onan] [%spit [%bunt [%limb %abel]] p.gen] ~] - :: - {$need *} - ?: ?: ?=(@ p.gen) - (lte hoon p.gen) - &((lte hoon p.p.gen) (gte hoon q.p.gen)) - q.gen - ~_(leaf+"hoon-version" !!) - :: - * gen - == - :: - ++ rake ~>(%mean.[%leaf "rake-twig"] (need reek)) - ++ reek - ^- (unit wing) - ?+ gen ~ - {$~ *} `[[%& p.gen] ~] - {$limb *} `[p.gen ~] - {$wing *} `p.gen - {$make * $~} `p.gen - {$dbug *} reek(gen q.gen) - == - ++ rusk - ^- term - =+ wig=rake - ?. ?=({@ $~} wig) - ~>(%mean.[%leaf "rusk-twig"] !!) - i.wig - :: - ++ walk :: forward traverse - |* life/mold - |= $: vit/life - $= mac - $- $: twig - life - $-({? twig life} {twig life}) - == - (unit (pair twig life)) - == - ^- {twig life} - =/ use & - =< apex - |% - ++ apex - |- ^- {twig life} - =* aid |= {use/? gen/twig vit/life} - ^$(use use, gen gen, vit vit) - =/ gun ?:(use (mac gen vit aid) ~) - ?^ gun u.gun - ?: ?=(^ -.gen) - %.(gen dubs) - ?- -.gen - $$ (lead -.gen %.(+.gen noop)) - $base (lead -.gen %.(+.gen noop)) - $bunt (lead -.gen %.(+.gen expr)) - $bust (lead -.gen %.(+.gen noop)) - $dbug (lead -.gen %.(+.gen nexp)) - $hand (lead -.gen %.(+.gen noop)) - $knit (lead -.gen %.(+.gen (moto bark))) - $leaf (lead -.gen %.(+.gen noop)) - $limb (lead -.gen %.(+.gen noop)) - $lost (lead -.gen %.(+.gen expr)) - $rock (lead -.gen %.(+.gen noop)) - $sand (lead -.gen %.(+.gen noop)) - $tell (lead -.gen %.(+.gen moar)) - $tune (lead -.gen %.(+.gen tung)) - $wing (lead -.gen %.(+.gen noop)) - $yell (lead -.gen %.(+.gen moar)) - $bcpt (lead -.gen %.(+.gen dubs)) - $bccb (lead -.gen %.(+.gen expr)) - $bccl (lead -.gen %.(+.gen moar)) - $bccn (lead -.gen %.(+.gen moar)) - $bchp (lead -.gen %.(+.gen dubs)) - $bckt (lead -.gen %.(+.gen dubs)) - $bcwt (lead -.gen %.(+.gen moar)) - $bcts (lead -.gen %.(+.gen nexp)) - $bcsm (lead -.gen %.(+.gen expr)) - $brcb (lead -.gen %.(+.gen (trio noop expr arms))) - $brcb (lead -.gen %.(+.gen (trio noop expr arms))) - $brcl (lead -.gen %.(+.gen (twin noop dubs))) - $brcn (lead -.gen %.(+.gen (twin noop arms))) - $brdt (lead -.gen %.(+.gen (twin noop expr))) - $brkt (lead -.gen %.(+.gen (trio noop expr arms))) - $brhp (lead -.gen %.(+.gen (twin noop expr))) - $brsg (lead -.gen %.(+.gen (twin noop dubs))) - $brtr (lead -.gen %.(+.gen (twin noop dubs))) - $brts (lead -.gen %.(+.gen (twin noop dubs))) - $brwt (lead -.gen %.(+.gen (twin noop expr))) - $clcb (lead -.gen %.(+.gen dubs)) - $clkt (lead -.gen %.(+.gen (quad expr expr expr expr))) - $clhp (lead -.gen %.(+.gen dubs)) - $clls (lead -.gen %.(+.gen trey)) - $clsg (lead -.gen %.(+.gen moar)) - $cltr (lead -.gen %.(+.gen moar)) - $cncb (lead -.gen %.(+.gen (twin noop moan))) - $cndt (lead -.gen %.(+.gen dubs)) - $cnhp (lead -.gen %.(+.gen (twin expr moar))) - $cntr (lead -.gen %.(+.gen (trio noop expr moan))) - $cnkt (lead -.gen %.(+.gen (quad expr expr expr expr))) - $cnls (lead -.gen %.(+.gen trey)) - $open (lead -.gen %.(+.gen (trio noop expr moar))) - $make (lead -.gen %.(+.gen (twin noop moan))) - $dtkt (lead -.gen %.(+.gen dubs)) - $dtls (lead -.gen %.(+.gen expr)) - $dttr (lead -.gen %.(+.gen dubs)) - $dtts (lead -.gen %.(+.gen dubs)) - $dtwt (lead -.gen %.(+.gen expr)) - $ktbr (lead -.gen %.(+.gen expr)) - $ktdt (lead -.gen %.(+.gen dubs)) - $ktls (lead -.gen %.(+.gen dubs)) - $kthp (lead -.gen %.(+.gen dubs)) - $ktpm (lead -.gen %.(+.gen expr)) - $ktsg (lead -.gen %.(+.gen expr)) - $ktts (lead -.gen %.(+.gen nexp)) - $ktwt (lead -.gen %.(+.gen expr)) - $halo (lead -.gen %.(+.gen nexp)) - $help (lead -.gen %.(+.gen nexp)) - $show (lead -.gen %.(+.gen dubs)) - $lurk (lead -.gen %.(+.gen dubs)) - $crap (lead -.gen %.(+.gen (raid expr))) - $fast (lead -.gen %.(+.gen (quad noop expr moan expr))) - $funk (lead -.gen %.(+.gen nexp)) - $thin (lead -.gen %.(+.gen (twin toad expr))) - $hint (lead -.gen %.(+.gen (twin toad expr))) - $poll (lead -.gen %.(+.gen nexp)) - $memo (lead -.gen %.(+.gen nexp)) - $dump (lead -.gen %.(+.gen trip)) - $ddup (lead -.gen %.(+.gen dubs)) - $warn (lead -.gen %.(+.gen (quad noop expr expr expr))) - $peep (lead -.gen %.(+.gen dubs)) - $smcl (lead -.gen %.(+.gen (twin expr moar))) - $smfs (lead -.gen %.(+.gen expr)) - $smsg (lead -.gen %.(+.gen (twin expr moar))) - $smsm (lead -.gen %.(+.gen dubs)) - $new (lead -.gen %.(+.gen dubs)) - $fix (lead -.gen %.(+.gen (twin moan expr))) - $var (lead -.gen %.(+.gen (trio tora expr expr))) - $rev (lead -.gen %.(+.gen (trio tora expr expr))) - $set (lead -.gen %.(+.gen trip)) - $huh (lead -.gen %.(+.gen (quad noop expr expr expr))) - $rap (lead -.gen %.(+.gen dubs)) - $nip (lead -.gen %.(+.gen dubs)) - $per (lead -.gen %.(+.gen dubs)) - $sip (lead -.gen %.(+.gen (quad tora noop expr expr))) - $pin (lead -.gen %.(+.gen dubs)) - $tow (lead -.gen %.(+.gen moar)) - $aka (lead -.gen %.(+.gen trip)) - $use (lead -.gen %.(+.gen dubs)) - $or (lead -.gen %.(+.gen moar)) - $case (lead -.gen %.(+.gen (twin noop (moto dubs)))) - $if (lead -.gen %.(+.gen trey)) - $lest (lead -.gen %.(+.gen trey)) - $ifcl (lead -.gen %.(+.gen trip)) - $deny (lead -.gen %.(+.gen dubs)) - $sure (lead -.gen %.(+.gen dubs)) - $deft (lead -.gen %.(+.gen (trio noop expr (moto dubs)))) - $and (lead -.gen %.(+.gen moar)) - $ifat (lead -.gen %.(+.gen trip)) - $ifno (lead -.gen %.(+.gen trip)) - $fits (lead -.gen %.(+.gen (twin expr noop))) - $not (lead -.gen %.(+.gen expr)) - $twig (lead -.gen %.(+.gen dubs)) - $wrap (lead -.gen %.(+.gen expr)) - $spit (lead -.gen %.(+.gen dubs)) - $code (lead -.gen %.(+.gen expr)) - $need (lead -.gen %.(+.gen nexp)) - $fail (lead -.gen %.(+.gen noop)) - == - ++ arms - (raid (twin noop (raid (twin noop heel)))) - :: - ++ bark - |= wof/woof - ?-(wof @ [wof vit], ^ (lead ~ (expr p.wof))) - :: - ++ dubs - (twin expr expr) - :: - ++ expr - |= p/twig - ^$(gen p) - :: - ++ heel - |= bud/foot - ?- -.bud - $ash =^(nex vit ^$(gen p.bud) [[%ash nex] vit]) - $elm =^(nex vit ^$(gen p.bud) [[%elm nex] vit]) - == - :: - ++ lead - |* {sem/@tas out/{* life}} - [[sem -.out] +.out] - :: - ++ moan - (moto nexp) - :: - ++ moar - (moto expr) - :: - ++ moto - |* etc/$-(* {* life}) - |* bud/* - ^+ [bud vit] - ?: =(~ bud) [bud vit] - =^ heb vit (etc -.bud) - =^ mor vit $(bud +.bud) - [[heb mor] vit] - :: - ++ nexp - (twin noop expr) - :: - ++ noop - |* bud/* - [bud vit] - :: - ++ quad - |* $: one/$-(* {* life}) - two/$-(* {* life}) - tri/$-(* {* life}) - qua/$-(* {* life}) - == - |* bud/* - =^ yal vit (one -.bud) - =^ ves vit (two +<.bud) - =^ jot vit (tri +>-.bud) - =^ wip vit (qua +>+.bud) - [[yal ves jot wip] vit] - :: - ++ raid - |* etc/$-(* {* life}) - |* bud/* - ^+ [bud vit] - ?: =(~ bud) [bud vit] - =^ lef vit $(bud +<.bud) - =^ ryt vit $(bud +>.bud) - =^ top vit (etc ->.bud) - [[[-<.bud top] lef ryt] vit] - :: - ++ trey - (trio expr expr expr) - :: - ++ trio - |* $: one/$-(* {* life}) - two/$-(* {* life}) - tri/$-(* {* life}) - == - |* bud/* - =^ yal vit (one -.bud) - =^ ves vit (two +<.bud) - =^ jot vit (tri +>.bud) - [[yal ves jot] vit] - :: - ++ trip - (trio noop expr expr) - :: - ++ toad - |= bud/$@(term {p/term q/twig}) - ?@ bud [bud vit] - (lead p.bud (expr q.bud)) - :: - ++ tora - (twin noop twee) - :: - ++ tung - |= bud/{p/what q/$@(term tune)} - ?@ q.bud [bud vit] - (lead p.bud %.(q.bud (twin (raid (twin noop twee)) (moto expr)))) - :: - ++ twee - |= bud/(unit twig) - ?~ bud [~ vit] - (lead ~ (expr u.bud)) - :: - ++ twin - |* {one/$-(* {* life}) two/$-(* {* life})} - |* bud/* - =^ yal vit (one -.bud) - =^ ves vit (two +.bud) - [[yal ves] vit] - -- - -- -:: -:::: 5c: compiler backend and prettyprinter - :: -++ ut - ~% %ut - +>+ - == - %fan fan - %rib rib - %vet vet - %fab fab - %ktsg burn - %busk busk - %buss buss - %crop crop - %duck duck - %dune dune - %dunk dunk - %epla epla - %emin emin - %emul emul - %felt felt - %fine fine - %fire fire - %fish fish - %fond fond - %fund fund - %funk funk - %fuse fuse - %gain gain - %lose lose - %mint mint - %moot moot - %mull mull - %nest nest - %peel peel - %play play - %peek peek - %repo repo - %rest rest - %tack tack - %toss toss - %wrap wrap - == - =+ :* fan=*(set {span twig}) - rib=*(set {span span twig}) - vet=`?`& - fab=`?`& - == - =+ sut=`span`%noun - |% - ++ burn - =+ gil=*(set span) - |- ^- (unit) - ?- sut - {$atom *} q.sut - {$cell *} %+ biff $(sut p.sut) - |=(* (biff ^$(sut q.sut) |=(* `[+>+< +<]))) - {$core *} (biff $(sut p.sut) |=(* `[p.s.q.sut +<])) - {$face *} $(sut repo) - {$fork *} =+ yed=(~(tap in p.sut)) - |- ^- (unit) - ?~ yed ~ - =+ [dis=^$(sut i.yed) mor=$(yed t.yed)] - ?~ dis mor - ?~ mor dis - ?: =(.?(u.mor) .?(u.dis)) - ?:((gor u.mor u.dis) mor dis) - ?@(u.mor mor dis) - {$help *} $(sut repo) - {$hold *} ?: (~(has in gil) sut) - ~ - $(sut repo, gil (~(put in gil) sut)) - $noun ~ - $void ~ - == - :: - ++ busk - ~/ %busk - |= gen/twig - ^- span - [%face [~ ~ [gen ~]] sut] - :: - ++ buss - ~/ %buss - |= {{wat/what cog/term} gen/twig} - ^- span - [%face [wat [[cog ~ ~ gen] ~ ~] ~] sut] - :: - ++ conk - |= got/toga - ^- span - ?@ got [%face [~ got] sut] - ?- -.got - $0 sut - $1 [%face p.got $(got q.got)] - $2 ?> |(!vet (nest(sut [%cell %noun %noun]) & sut)) - :+ %cell - $(got p.got, sut (peek %both 2)) - $(got q.got, sut (peek %both 3)) - == - :: - ++ crop - ~/ %crop - |= ref/span - =+ bix=*(set {span span}) - =< dext - |% - ++ dext - ^- span - ~_ leaf+"crop" - :: ~_ (dunk 'dext: sut') - :: ~_ (dunk(sut ref) 'dext: ref') - ?: |(=(sut ref) =(%noun ref)) - %void - ?: =(%void ref) - sut - ?- sut - {$atom *} - ?+ ref sint - {$atom *} ?^ q.sut - ?^(q.ref ?:(=(q.ref q.sut) %void sut) %void) - ?^(q.ref sut %void) - {$cell *} sut - == - :: - {$cell *} - ?+ ref sint - {$atom *} sut - {$cell *} ?. (nest(sut p.ref) | p.sut) sut - (cell p.sut dext(sut q.sut, ref q.ref)) - == - :: - {$core *} ?:(?=(?({$atom *} {$cell *}) ref) sut sint) - {$face *} (face p.sut dext(sut q.sut)) - {$fork *} (fork (turn (~(tap in p.sut)) |=(span dext(sut +<)))) - {$help *} (help p.sut dext(sut q.sut)) - {$hold *} ?< (~(has in bix) [sut ref]) - dext(sut repo, bix (~(put in bix) [sut ref])) - $noun dext(sut repo) - $void %void - == - :: - ++ sint - ^- span - ?+ ref !! - {$core *} sut - {$face *} dext(ref repo(sut ref)) - {$fork *} =+ yed=(~(tap in p.ref)) - |- ^- span - ?~ yed sut - $(yed t.yed, sut dext(ref i.yed)) - {$hold *} dext(ref repo(sut ref)) - == - -- - :: - ++ cool - |= {pol/? hyp/wing ref/span} - ^- span - =+ fid=(find %both hyp) - ?- -.fid - $| sut - $& =< q - %+ take p.p.fid - |=(a/span ?:(pol (fuse(sut a) ref) (crop(sut a) ref))) - == - :: - ++ duck ^-(tank ~(duck us sut)) - ++ dune |.(duck) - ++ dunk - |= paz/term ^- tank - :+ %palm - [['.' ~] ['-' ~] ~ ~] - [[%leaf (mesc (trip paz))] duck ~] - :: - ++ elbo - |= {lop/palo rig/(list (pair wing twig))} - ^- span - ?: ?=($& -.q.lop) - |- ^- span - ?~ rig - p.q.lop - =+ zil=(play q.i.rig) - =+ dar=(tack(sut p.q.lop) p.i.rig zil) - %= $ - rig t.rig - p.q.lop q.dar - == - =+ hag=(~(tap in q.q.lop)) - %- fire - |- ^+ hag - ?~ rig - hag - =+ zil=(play q.i.rig) - =+ dix=(toss p.i.rig zil hag) - %= $ - rig t.rig - hag q.dix - == - :: - ++ ergo - |= {lop/palo rig/(list (pair wing twig))} - ^- (pair span nock) - =+ axe=(tend p.lop) - =| hej/(list (pair axis nock)) - ?: ?=($& -.q.lop) - =- [p.- (hike axe q.-)] - |- ^- (pair span (list (pair axis nock))) - ?~ rig - [p.q.lop hej] - =+ zil=(mint %noun q.i.rig) - =+ dar=(tack(sut p.q.lop) p.i.rig p.zil) - %= $ - rig t.rig - p.q.lop q.dar - hej [[p.dar q.zil] hej] - == - =+ hag=(~(tap in q.q.lop)) - =- [(fire p.-) [%9 p.q.lop (hike axe q.-)]] - |- ^- (pair (list (pair span foot)) (list (pair axis nock))) - ?~ rig - [hag hej] - =+ zil=(mint %noun q.i.rig) - =+ dix=(toss p.i.rig p.zil hag) - %= $ - rig t.rig - hag q.dix - hej [[p.dix q.zil] hej] - == - :: - ++ endo - |= {lop/(pair palo palo) dox/span rig/(list (pair wing twig))} - ^- (pair span span) - ?: ?=($& -.q.p.lop) - ?> ?=($& -.q.q.lop) - |- ^- (pair span span) - ?~ rig - [p.q.p.lop p.q.q.lop] - =+ zil=(mull %noun dox q.i.rig) - =+ ^= dar - :- p=(tack(sut p.q.p.lop) p.i.rig p.zil) - q=(tack(sut p.q.q.lop) p.i.rig q.zil) - ?> =(p.p.dar p.q.dar) - %= $ - rig t.rig - p.q.p.lop q.p.dar - p.q.q.lop q.q.dar - == - ?> ?=($| -.q.q.lop) - ?> =(p.q.p.lop p.q.q.lop) - =+ hag=[p=(~(tap in q.q.p.lop)) q=(~(tap in q.q.q.lop))] - =- [(fire p.-) (fire(vet |) q.-)] - |- ^- (pair (list (pair span foot)) (list (pair span foot))) - ?~ rig - hag - =+ zil=(mull %noun dox q.i.rig) - =+ ^= dix - :- p=(toss p.i.rig p.zil p.hag) - q=(toss p.i.rig q.zil q.hag) - ?> =(p.p.dix p.q.dix) - %= $ - rig t.rig - hag [q.p.dix q.q.dix] - == - :: - ++ ad - |% - ++ arc - |% - ++ deft :: generic - |% - ++ bath * :: leg match span - ++ claw * :: arm match span - ++ form |*({* *} p=+<-) :: attach build state - ++ skin |*(p/* p) :: reveal build state - ++ meat |*(p/* p) :: remove build state - -- - ++ make :: for mint - |% - ++ bath span :: leg match span - ++ claw onyx :: arm - ++ form |*({* *} [p=+<- q=+<+]) :: - ++ skin |*({p/* q/*} q) :: unwrap baggage - ++ meat |*({p/* q/*} p) :: unwrap filling - -- - -- - ++ def - =+ deft:arc - |% +- $ - => +< - |% - ++ pord |*(* (form +< *nock)) :: wrap mint formula - ++ rosh |*(* (form +< *(list pock))) :: wrap mint changes - ++ fleg _(pord *bath) :: legmatch + code - ++ fram _(pord *claw) :: armmatch + - ++ foat _(rosh *bath) :: leg with changes - ++ fult _(rosh *claw) :: arm with changes - -- -- - :: - ++ lib - |% - ++ deft - => (def deft:arc) - |% - ++ halp $-(twig fleg) - ++ vant - |% ++ trep $-({bath wing bath} {axis bath}) - ++ tasp $-({{axis bath} fleg foat} foat) - ++ tyle $-(foat foat) - -- - ++ vunt - |% ++ trep $-({claw wing bath} {axis claw}) - ++ tasp $-({{axis claw} fleg fult} fult) - ++ tyle $-(fult foat) - -- -- - :: - ++ make - => (def make:arc) - |% - ++ halp |~ a/twig - ^- fleg - (mint %noun a) - ++ vant - |% ++ trep |= {a/span b/wing c/span} - ^- {axis span} - (tack(sut a) b c) - ++ tasp |= {a/(pair axis span) b/fleg c/foat} - ^- foat - [q.a [[p.a (skin b)] (skin c)]] - ++ tyle |=(foat +<) - -- - ++ vunt - |% ++ trep |= {a/claw b/wing c/bath} - ^- (pair axis claw) - (toss b c a) - ++ tasp |~ {a/(pair axis claw) b/fleg c/fult} - ^- fult - [q.a [[p.a (skin b)] (skin c)]] - ++ tyle |~ fult - ^- foat - [(fire +<-) +<+] - -- -- -- - :: - ++ bin - =+ deft:lib - |% +- $ - => +< - |% - ++ rame - => vant |% - ++ clom bath - ++ chog fleg - ++ ceut foat - -- - ++ gelp - => vunt |% - ++ clom claw - ++ chog fram - ++ ceut fult - -- - ++ ecbo (ecco rame) - ++ eclo (ecco gelp) - ++ ecco - =+ rame - |% +- $ - => +< - |= {rum/clom rig/(list (pair wing twig))} - ^- foat - %- tyle - |- ^- ceut - ?~ rig (rosh rum) - =+ mor=$(rig t.rig) - =+ zil=(halp q.i.rig) - =+ dar=(trep (meat mor) p.i.rig (meat zil)) - (tasp dar zil mor) - -- -- -- -- - :: - ++ oc - =+ inc=(bin:ad) - |% +- $ - => inc - |% - ++ echo - |= {rum/bath rig/(list (pair wing twig))} - (ecbo rum rig) - :: - ++ ecmo - |= {hag/claw rig/(list (pair wing twig))} - (eclo hag rig) - -- -- - :: - ++ etco - |= {lop/palo rig/(list (pair wing twig))} - ^- (pair span nock) - =+ cin=(oc (bin:ad make:lib:ad)) - =. rig (flop rig) :: XX this unbreaks, void order in devulc - =+ axe=(tend p.lop) - ?: ?=($& -.q.lop) - =- [p.- (hike axe q.-)] - (echo:cin p.q.lop rig) - =- [p.- [%9 p.q.lop (hike axe q.-)]] - (ecmo:cin (~(tap in q.q.lop)) rig) - :: - ++ et - |_ {hyp/wing rig/(list (pair wing twig))} - :: - ++ play - ^- span - =+ lug=(find %read hyp) - ?: ?=($| -.lug) ~>(%mean.[%leaf "twig"] ?>(?=($~ rig) p.p.lug)) - (elbo p.lug rig) - :: - ++ mint - |= gol/span - ^- (pair span nock) - =+ lug=(find %read hyp) - ?: ?=($| -.lug) ~>(%mean.[%leaf "twig"] ?>(?=($~ rig) p.lug)) - =- ?>(?|(!vet (nest(sut gol) & p.-)) -) - (etco p.lug rig) - :: - ++ mull - |= {gol/span dox/span} - ^- {span span} - =+ lug=[p=(find %read hyp) q=(find(sut dox) %read hyp)] - ?: ?=($| -.p.lug) - ?> &(?=($| -.q.lug) ?=($~ rig)) - [p.p.p.lug p.p.q.lug] - ?> ?=($& -.q.lug) - =- ?>(?|(!vet (nest(sut gol) & p.-)) -) - (endo [p.p.lug p.q.lug] dox rig) - -- - :: - ++ epla - ~/ %epla - |= {hyp/wing rig/(list (pair wing twig))} - ^- span - ~(play et hyp rig) - :: - ++ emin - ~/ %emin - |= {gol/span hyp/wing rig/(list (pair wing twig))} - ^- (pair span nock) - (~(mint et hyp rig) gol) - :: - ++ emul - ~/ %emul - |= {gol/span dox/span hyp/wing rig/(list (pair wing twig))} - ^- (pair span span) - (~(mull et hyp rig) gol dox) - :: - ++ felt - ~/ %felt - |= lap/opal - ^- span - ?- -.lap - $& p.lap - $| %- fire - %+ turn (~(tap in q.lap)) - |= {a/span b/foot} - [a [%ash %$ 1]] - == - :: - ++ fond - ~/ %fond - |= {way/vial hyp/wing} - => |% - ++ pony :: raw match - $@ $~ :: void - %+ each :: natural/abnormal - (pair what palo) :: arm or leg - %+ each :: abnormal - @ud :: unmatched - (pair what (pair span nock)) :: synthetic - -- - ^- pony - ?~ hyp - [%& ~ ~ %& sut] - =+ mor=$(hyp t.hyp) - ?- -.mor - $| - ?- -.p.mor - $& mor - $| - =+ fex=(mint(sut p.q.p.p.mor) %noun [%wing i.hyp ~]) - [%| %| p.p.p.mor p.fex (comb q.q.p.p.mor q.fex)] - == - :: - $& - =. sut (felt q.q.p.mor) - => :_ + - :* axe=`axis`1 - lon=p.q.p.mor - heg=?^(i.hyp i.hyp [%| p=0 q=(some i.hyp)]) - == - ?: ?=($& -.heg) - [%& ~ [`p.heg lon] %& (peek way p.heg)] - =| gil/(set span) - =< $ - |% ++ here ?: =(0 p.heg) - [%& ~ [~ `axe lon] %& sut] - [%| %& (dec p.heg)] - ++ join |=({a/what b/what} ?~(a b a)) - ++ lose [%| %& p.heg] - ++ stop ?~(q.heg here lose) - ++ twin |= {hax/pony yor/pony} - ^- pony - ~_ leaf+"find-fork" - ?: =(hax yor) hax - ?~ hax yor - ?~ yor hax - ?: ?=($| -.hax) - ?> ?& ?=($| -.yor) - ?=($| -.p.hax) - ?=($| -.p.yor) - =(q.q.p.p.hax q.q.p.p.yor) - == - :^ %| - %| - (join p.p.p.hax p.p.p.yor) - [(fork p.q.p.p.hax p.q.p.p.yor ~) q.q.p.p.hax] - ?> ?=($& -.yor) - ?> =(p.q.p.hax p.q.p.yor) - :^ %& - (join p.p.hax p.p.yor) - p.q.p.hax - ?: &(?=($& -.q.q.p.hax) ?=($& -.q.q.p.yor)) - [%& (fork p.q.q.p.hax p.q.q.p.yor ~)] - ?> &(?=($| -.q.q.p.hax) ?=($| -.q.q.p.yor)) - ?> =(p.q.q.p.hax p.q.q.p.yor) - =+ wal=(~(uni in q.q.q.p.hax) q.q.q.p.yor) - [%| p.q.q.p.hax wal] - ++ $ - ^- pony - ?- sut - $void stop - $noun stop - {$atom *} stop - {$cell *} - ?~ q.heg here - =+ taf=$(axe (peg axe 2), sut p.sut) - ?~ taf ~ - ?: |(?=($& -.taf) ?=($| -.p.taf)) - taf - $(axe (peg axe 3), p.heg p.p.taf, sut q.sut) - :: - {$core *} - ?~ q.heg here - =^ zem p.heg - =+ zem=(loot u.q.heg q.s.q.sut) - ?~ zem [~ p.heg] - ?:(=(0 p.heg) [zem 0] [~ (dec p.heg)]) - ?^ zem - :^ %& - p.q.u.zem - [`axe lon] - [%| (peg 2 p.u.zem) [[sut(p.q %gold) q.q.u.zem] ~ ~]] - =+ pec=(peel way p.q.sut) - ?. sam.pec lose - ?: con.pec $(sut p.sut, axe (peg axe 3)) - $(sut (peek(sut p.sut) way 2), axe (peg axe 6)) - :: - {$help *} - $(sut repo) - :: - {$face *} - ?: ?=($~ q.heg) here(sut q.sut) - =* zot q.p.sut - ?@ zot - ?:(=(u.q.heg zot) here(sut q.sut) lose) - =< main - |% - ++ main - ^- pony - =+ tyr=(~(get by p.zot) u.q.heg) - ?~ tyr - next - ?~ q.u.tyr - $(sut q.sut, lon [~ lon], p.heg +(p.heg)) - ?. =(0 p.heg) - next(p.heg (dec p.heg)) - =+ tor=(fund way u.q.u.tyr) - ?- -.tor - $& [%& ~ (weld p.p.tor `vein`[~ `axe lon]) q.p.tor] - $| [%| %| p.u.tyr p.p.tor (comb [%0 axe] q.p.tor)] - == - ++ next - |- ^- pony - ?~ q.zot - ^$(sut q.sut, lon [~ lon]) - =+ tiv=(mint(sut q.sut) %noun i.q.zot) - =+ fid=^$(sut p.tiv, lon ~, axe 1, gil ~) - ?~ fid ~ - ?: ?=({$| $& *} fid) - $(q.zot t.q.zot, p.heg p.p.fid) - =+ ^- {wat/what vat/(pair span nock)} - ?- -.fid - $& [p.p.fid (fine %& q.p.fid)] - $| [p.p.p.fid (fine %| q.p.p.fid)] - == - [%| %| wat p.vat (comb (comb [%0 axe] q.tiv) q.vat)] - -- - :: - {$fork *} - =+ wiz=(turn (~(tap in p.sut)) |=(a/span ^$(sut a))) - ?~ wiz ~ - |- ^- pony - ?~ t.wiz i.wiz - (twin i.wiz $(wiz t.wiz)) - :: - {$hold *} - ?: (~(has in gil) sut) - ~ - $(gil (~(put in gil) sut), sut repo) - == - -- - == - :: - ++ find - ~/ %find - |= {way/vial hyp/wing} - ^- port - ~_ (show [%c %find] %l hyp) - =- ?@ - !! - ?- -< - $& [%& q.p.-] - $| ?- -.p.- - $| [%| q.p.p.-] - $& !! - == == - (fond way hyp) - :: - ++ fund - ~/ %fund - |= {way/vial gen/twig} - ^- port - =+ hup=~(reek ap gen) - ?~ hup - [%| (mint %noun gen)] - (find way u.hup) - :: - ++ fine - ~/ %fine - |= tor/port - ^- (pair span nock) - ?- -.tor - $| p.tor - $& =+ axe=(tend p.p.tor) - ?- -.q.p.tor - $& [`span`p.q.p.tor %0 axe] - $| [(fire (~(tap in q.q.p.tor))) [%9 p.q.p.tor %0 axe]] - == == - :: - ++ fire - |= hag/(list {p/span q/foot}) - ^- span - ?: ?=({{* {$elm $~ $1}} $~} hag) - p.i.hag - %- fork - %+ turn - hag.$ - |= {p/span q/foot} - :- %hold - ?. ?=({$core *} p) - ~_ (dunk %fire-span) - ~>(%mean.[%leaf "fire-core"] !!) - =+ dox=[%core q.q.p q.p] - ?: ?=($ash -.q) - :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-dry) - ?> ?|(!vet (nest(sut q.q.p) & p.p)) - [dox p.q] - ?> ?=($elm -.q) - :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-wet) - ?> ?| !vet - (~(has in rib) [sut dox p.q]) - !=(** (mull(sut p, rib (~(put in rib) sut dox p.q)) %noun dox p.q)) - == - [p p.q] - :: - ++ fish - ~/ %fish - |= axe/axis - =+ vot=*(set span) - |- ^- nock - ?- sut - $void [%1 1] - $noun [%1 0] - {$atom *} ?~ q.sut - (flip [%3 %0 axe]) - [%5 [%1 u.q.sut] [%0 axe]] - {$cell *} - %+ flan - [%3 %0 axe] - (flan $(sut p.sut, axe (peg axe 2)) $(sut q.sut, axe (peg axe 3))) - :: - {$core *} [%0 0] - {$face *} $(sut q.sut) - {$fork *} =+ yed=(~(tap in p.sut)) - |- ^- nock - ?~(yed [%1 1] (flor ^$(sut i.yed) $(yed t.yed))) - {$help *} $(sut q.sut) - {$hold *} - ?: (~(has in vot) sut) - [%0 0] - => %=(. vot (~(put in vot) sut)) - $(sut repo) - == - :: - ++ fuse - ~/ %fuse - |= ref/span - =+ bix=*(set {span span}) - |- ^- span - ?: ?|(=(sut ref) =(%noun ref)) - sut - ?- sut - {$atom *} - ?- ref - {$atom *} =+ foc=?:((fitz p.ref p.sut) p.sut p.ref) - ?^ q.sut - ?^ q.ref - ?: =(q.sut q.ref) - [%atom foc q.sut] - %void - [%atom foc q.sut] - [%atom foc q.ref] - {$cell *} %void - * $(sut ref, ref sut) - == - {$cell *} - ?- ref - {$cell *} (cell $(sut p.sut, ref p.ref) $(sut q.sut, ref q.ref)) - * $(sut ref, ref sut) - == - :: - {$core *} $(sut repo) - {$face *} (face p.sut $(sut q.sut)) - {$fork *} (fork (turn (~(tap in p.sut)) |=(span ^$(sut +<)))) - {$help *} (help p.sut $(sut q.sut)) - {$hold *} - ?: (~(has in bix) [sut ref]) - ~>(%mean.[%leaf "fuse-loop"] !!) - $(sut repo, bix (~(put in bix) [sut ref])) - :: - $noun ref - $void %void - == - :: - ++ gain - ~/ %gain - |= gen/twig ^- span - (chip & gen) - :: - ++ harp - |= dab/(map term (pair what foot)) - ^- ?($~ ^) - ?: ?=($~ dab) - ~ - =+ ^= vad - ?- -.q.q.n.dab - $ash q:(mint %noun p.q.q.n.dab) - $elm q:(mint(vet |) %noun p.q.q.n.dab) - == - ?- dab - {* $~ $~} vad - {* $~ *} [vad $(dab r.dab)] - {* * $~} [vad $(dab l.dab)] - {* * *} [vad $(dab l.dab) $(dab r.dab)] - == - :: - ++ hope - |= dom/(map @ tomb) - ^- ?($~ ^) - ?: ?=($~ dom) - ~ - =+ dov=(harp q.q.n.dom) - ?- dom - {* $~ $~} dov - {* $~ *} [dov $(dom r.dom)] - {* * $~} [dov $(dom l.dom)] - {* * *} [dov $(dom l.dom) $(dom r.dom)] - == - :: - ++ lose - ~/ %lose - |= gen/twig ^- span - (chip | gen) - :: - ++ chip - ~/ %chip - |= {how/? gen/twig} ^- span - ?: ?=({$fits *} gen) - (cool how q.gen (play ~(bunt al [%herb p.gen]))) - ?: ?&(how ?=({$and *} gen)) - |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) - ?: ?&(!how ?=({$or *} gen)) - |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen)))) - =+ neg=~(open ap gen) - ?:(=(neg gen) sut $(gen neg)) - :: - ++ mint - ~/ %mint - |= {gol/span gen/twig} - ^- {p/span q/nock} - ~& %pure-mint - |^ ^- {p/span q/nock} - ?: ?&(=(%void sut) !?=({$dbug *} gen)) - ?. |(!vet ?=({$lost *} gen) ?=({$fail *} gen)) - ~>(%mean.[%leaf "mint-vain"] !!) - [%void %0 0] - ?- gen - :: - {^ *} - =+ hed=$(gen p.gen, gol %noun) - =+ tal=$(gen q.gen, gol %noun) - [(nice (cell p.hed p.tal)) (cons q.hed q.tal)] - :: - {$brcn *} (grow %gold [%$ 1] p.gen q.gen) - :: - {$make *} (~(mint et p.gen q.gen) gol) - {$dtkt *} - =+ nef=$(gen [%bunt p.gen]) - [p.nef [%11 [%1 %151 p.nef] q:$(gen q.gen, gol %noun)]] - :: - {$dtls *} [(nice [%atom %$ ~]) [%4 q:$(gen p.gen, gol [%atom %$ ~])]] - {$sand *} [(nice (play gen)) [%1 q.gen]] - {$rock *} [(nice (play gen)) [%1 q.gen]] - :: - {$dttr *} - [(nice %noun) [%2 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]] - :: - {$dtts *} - =+ [one two]=[$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] - [(nice bool) [%5 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]] - :: - {$dtwt *} [(nice bool) [%3 q:$(gen p.gen, gol %noun)]] - {$hand *} [p.gen q.gen] - {$ktbr *} =+(vat=$(gen p.gen) [(wrap(sut p.vat) %ktbr) q.vat]) - :: - {$ktls *} - =+(hif=(nice (play p.gen)) [hif q:$(gen q.gen, gol hif)]) - :: - {$ktpm *} =+(vat=$(gen p.gen) [(wrap(sut p.vat) %ktpm) q.vat]) - {$ktsg *} - =+ nef=$(gen p.gen) - :- p.nef - =+ cag=burn - ?~ cag q.nef - =+ moc=(mink [u.cag q.nef] |=({* *} ~)) - ?:(?=($0 -.moc) [%1 p.moc] q.nef) - :: - {$ktts *} =+(vat=$(gen q.gen) [(conk(sut p.vat) p.gen) q.vat]) - {$tune *} [(face p.gen sut) [%0 %1]] - {$ktwt *} =+(vat=$(gen p.gen) [(wrap(sut p.vat) %ktwt) q.vat]) - :: - {$help *} - =+ hum=$(gen q.gen) - [(help p.gen p.hum) q.hum] - :: - {$peep *} ~_(duck(sut (play p.gen)) $(gen q.gen)) - {$hint *} - =+ hum=$(gen q.gen) - :: ?: &(huz !?=($|(@ [?(%fast %memo) ^]) p.gen)) - :: hum - :- p.hum - :+ %10 - ?- p.gen - @ p.gen - ^ [p.p.gen q:$(gen q.p.gen, gol %noun)] - == - q.hum - :: - {$per *} - =+ fid=$(gen p.gen, gol %noun) - =+ dov=$(sut p.fid, gen q.gen) - [p.dov (comb q.fid q.dov)] - :: - {$aka *} - $(gen r.gen, sut (buss p.gen q.gen)) - :: - {$use *} - $(gen q.gen, sut (busk p.gen)) - :: - {$if *} - =+ nor=$(gen p.gen, gol bool) - =+ fex=(gain p.gen) - =+ wux=(lose p.gen) - =+ ^= duy - ?: =(%void fex) - ?:(=(%void wux) [%0 0] [%1 1]) - ?:(=(%void wux) [%1 0] q.nor) - =+ hiq=$(sut fex, gen q.gen) - =+ ran=$(sut wux, gen r.gen) - [(fork p.hiq p.ran ~) (cond duy q.hiq q.ran)] - :: - {$fits *} - :- (nice bool) - =+ ref=(play ~(bunt al %herb p.gen)) - =+ fid=(find %read q.gen) - ~| [%test q.gen] - |- ^- nock - ?- -.fid - $& ?- -.q.p.fid - $& (fish(sut ref) (tend p.p.fid)) - $| $(fid [%| (fine fid)]) - == - $| [%7 q.p.fid (fish(sut ref) 1)] - == - :: - {$dbug *} - ~_ (show %o p.gen) - =+ hum=$(gen q.gen) - [p.hum [%10 [%spot %1 p.gen] q.hum]] - :: - {$twig *} [(nice (play p.gen)) [%1 q.gen]] :: XX validate! - {$lost *} - ?: vet - ~_ (dunk(sut (play p.gen)) 'lost') - ~>(%mean.[%leaf "mint-lost"] !!) - [%void [%0 0]] - :: - {$spit *} - =+ vos=$(gol %noun, gen q.gen) - =+ ref=p:$(gol %noun, gen p.gen) - ?> (~(nest ut p:!>(*span)) & ref) - [(nice (cell ref p.vos)) (cons [%1 p.vos] q.vos)] - :: - {$wrap *} - =+ vat=$(gen p.gen) - %= $ - gen - :- [%cnhp [%limb %onan] [%hand p:!>(*span) [%1 p.vat]] ~] - [%hand p.vat q.vat] - == - :: - {$code *} [(nice %noun) [%1 q:$(vet |, gen p.gen)]] - {$fail $~} [%void [%0 0]] - * - =+ doz=~(open ap gen) - ?: =(doz gen) - ~_ (show [%c 'hoon'] [%q gen]) - ~>(%mean.[%leaf "mint-open"] !!) - $(gen doz) - == - :: - ++ nice - |= typ/span - ~_ leaf+"mint-nice" - ?> ?|(!vet (nest(sut gol) & typ)) - typ - :: - ++ grow - |= {mel/vair ruf/twig wad/chap dom/(map @ tomb)} - ^- {p/span q/nock} - =+ dan=^$(gen ruf, gol %noun) - =+ toc=(core p.dan [%gold p.dan wad [~ dom]]) - =+ dez=(hope(sut toc) dom) - :- (nice (core p.dan mel p.dan wad [dez dom])) - (cons [%1 dez] q.dan) - -- - :: - ++ moot - =+ gil=*(set span) - |- ^- ? - ?- sut - {$atom *} | - {$cell *} |($(sut p.sut) $(sut q.sut)) - {$core *} $(sut p.sut) - {$face *} $(sut q.sut) - {$fork *} (lien (~(tap in p.sut)) |=(span ^$(sut +<))) - {$help *} $(sut q.sut) - {$hold *} |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo)) - $noun | - $void & - == - :: - ++ mull - ~/ %mull - |= {gol/span dox/span gen/twig} - |^ ^- {p/span q/span} - ?: =(%void sut) - ~>(%mean.[%leaf "mull-none"] !!) - ?- gen - :: - {^ *} - =+ hed=$(gen p.gen, gol %noun) - =+ tal=$(gen q.gen, gol %noun) - [(nice (cell p.hed p.tal)) (cell q.hed q.tal)] - :: - {$brcn *} (grow %gold [%$ 1] p.gen q.gen) - {$make *} (~(mull et p.gen q.gen) gol dox) - {$dtkt *} =+($(gen q.gen, gol %noun) $(gen [%bunt p.gen])) - {$dtls *} =+($(gen p.gen, gol [%atom %$ ~]) (beth [%atom %$ ~])) - {$sand *} (beth (play gen)) - {$rock *} (beth (play gen)) - :: - {$dttr *} - =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth %noun)) - :: - {$dtts *} - =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth bool)) - :: - {$dtwt *} =+($(gen p.gen, gol %noun) (beth bool)) :: XX =| - {$hand *} [p.gen p.gen] - {$ktbr *} - =+(vat=$(gen p.gen) [(wrap(sut p.vat) %ktbr) (wrap(sut q.vat) %ktbr)]) - :: - {$ktls *} - =+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)] - =+($(gen q.gen, gol p.hif) hif) - :: - {$ktpm *} - =+(vat=$(gen p.gen) [(wrap(sut p.vat) %ktpm) (wrap(sut q.vat) %ktpm)]) - :: - {$ktts *} - =+(vat=$(gen q.gen) [(conk(sut p.vat) p.gen) (conk(sut q.vat) p.gen)]) - :: - {$tune *} - [(face p.gen sut) (face p.gen dox)] - :: - {$ktwt *} - =+(vat=$(gen p.gen) [(wrap(sut p.vat) %ktwt) (wrap(sut q.vat) %ktwt)]) - :: - {$help *} - =+(vat=$(gen q.gen) [(help p.gen p.vat) (help p.gen q.vat)]) - :: - {$ktsg *} $(gen p.gen) - {$peep *} ~_(duck(sut (play p.gen)) $(gen q.gen)) - {$hint *} $(gen q.gen) - {$per *} - =+ lem=$(gen p.gen, gol %noun) - $(gen q.gen, sut p.lem, dox q.lem) - :: - {$aka *} - %= $ - gen r.gen - sut (buss p.gen q.gen) - dox (buss(sut dox) p.gen q.gen) - == - :: - {$if *} - =+ nor=$(gen p.gen, gol bool) - =+ ^= hiq ^- {p/span q/span} - =+ fex=[p=(gain p.gen) q=(gain(sut dox) p.gen)] - ?: =(%void p.fex) - :- %void - ?: =(%void q.fex) - %void - ~>(%mean.[%leaf "if-z"] (play(sut q.fex) q.gen)) - ?: =(%void q.fex) - ~>(%mean.[%leaf "mull-bonk-b"] !!) - $(sut p.fex, dox q.fex, gen q.gen) - =+ ^= ran ^- {p/span q/span} - =+ wux=[p=(lose p.gen) q=(lose(sut dox) p.gen)] - ?: =(%void p.wux) - :- %void - ?: =(%void q.wux) - %void - ~>(%mean.[%leaf "if-a"] (play(sut q.wux) r.gen)) - ?: =(%void q.wux) - ~>(%mean.[%leaf "mull-bonk-c"] !!) - $(sut p.wux, dox q.wux, gen r.gen) - [(nice (fork p.hiq p.ran ~)) (fork q.hiq q.ran ~)] - :: - {$fits *} - =+ nob=~(bunt al %herb p.gen) - =+ waz=[p=(play nob) q=(play(sut dox) nob)] - =+ ^= syx :- p=(cove q:(mint %noun [%wing q.gen])) - q=(cove q:(mint(sut dox) %noun [%wing q.gen])) - =+ pov=[p=(fish(sut p.waz) p.syx) q=(fish(sut q.waz) q.syx)] - ?. &(=(p.syx q.syx) =(p.pov q.pov)) - ~>(%mean.[%leaf "mull-bonk-a"] !!) - (beth bool) - :: - {$dbug *} ~_((show %o p.gen) $(gen q.gen)) - {$twig *} [(nice (play p.gen)) (play(sut dox) p.gen)] - {$lost *} - ?: vet - :: ~_ (dunk(sut (play p.gen)) 'also') - ~>(%mean.[%leaf "mull-skip"] !!) - (beth %void) - :: - {$code *} (beth %noun) - {$spit *} - =+ vos=$(gol %noun, gen q.gen) :: XX validate! - [(nice (cell (play p.gen) p.vos)) (cell (play(sut dox) p.gen) q.vos)] - :: - {$wrap *} - ?> =(sut dox) - =+(typ=(play gen) [typ typ]) - :: - {$fail *} (beth %void) - * - =+ doz=~(open ap gen) - ?: =(doz gen) - ~_ (show [%c 'hoon'] [%q gen]) - ~>(%mean.[%leaf "mull-open"] !!) - $(gen doz) - == - :: - ++ beth - |= typ/span - [(nice typ) typ] - :: - ++ nice - |= typ/span - :: ~_ (dunk(sut gol) 'need') - :: ~_ (dunk(sut typ) 'have') - ~_ leaf+"mull-nice" - ?> ?|(!vet (nest(sut gol) & typ)) - typ - :: - ++ grow - |= {mel/vair ruf/twig wad/chap dom/(map @ tomb)} - ~_ leaf+"mull-grow" - ^- {p/span q/span} - =+ dan=^$(gen ruf, gol %noun) - =+ ^= toc :- p=(core p.dan [%gold p.dan wad [~ dom]]) - q=(core q.dan [%gold q.dan wad [~ dom]]) - =+ (balk(sut p.toc, dox q.toc) dom) - :- (nice (core p.dan mel p.dan wad [[%0 0] dom])) - (core q.dan [mel q.dan wad [[%0 0] dom]]) - :: - ++ bake - |= dab/(map term (pair what foot)) - ^- * - ?: ?=($~ dab) - ~ - =+ ^= dov - ?- -.q.q.n.dab - $ash ^$(gol %noun, gen p.q.q.n.dab) - $elm ~ - == - ?- dab - {* $~ $~} dov - {* $~ *} [dov $(dab r.dab)] - {* * $~} [dov $(dab l.dab)] - {* * *} [dov $(dab l.dab) $(dab r.dab)] - == - :: - ++ balk - |= dom/(map @ tomb) - ^- * - ?: ?=($~ dom) - ~ - =+ dov=(bake q.q.n.dom) - ?- dom - {* $~ $~} dov - {* $~ *} [dov $(dom r.dom)] - {* * $~} [dov $(dom l.dom)] - {* * *} [dov $(dom l.dom) $(dom r.dom)] - == - -- - :: - ++ meet |=(ref/span &((nest | ref) (nest(sut ref) | sut))) - ++ mite |=(ref/span |((nest | ref) (nest(sut ref) & sut))) - ++ nest - ~/ %nest - |= {tel/? ref/span} - =| $: seg/(set span) :: degenerate sut - reg/(set span) :: degenerate ref - gil/(set {p/span q/span}) :: assume nest - == - =< dext - |% - ++ deem - |= {mel/vair ram/vair} - ^- ? - ?. |(=(mel ram) =(%ktwt mel) =(%gold ram)) | - ?: ?=($ktwt mel) & - ?: ?=($gold mel) meet - =+ vay=?-(mel $ktbr %rite, $ktpm %read) - dext(sut (peek vay 2), ref (peek(sut ref) vay 2)) - :: - ++ deep - |= $: dom/(map @ tomb) - vim/(map @ tomb) - == - ^- ? - ?: ?=($~ dom) =(vim ~) - ?: ?=($~ vim) | - ?& =(p.n.dom p.n.vim) - $(dom l.dom, vim l.vim) - $(dom r.dom, vim r.vim) - :: - =+ [dab hem]=[q.q.n.dom q.q.n.vim] - |- ^- ? - ?: ?=($~ dab) =(hem ~) - ?: ?=($~ hem) | - ?& =(p.n.dab p.n.hem) - $(dab l.dab, hem l.hem) - $(dab r.dab, hem r.hem) - ?- -.q.q.n.dab - $elm =(q.q.n.dab q.q.n.hem) - $ash ?& ?=($ash -.q.q.n.hem) - %= dext - sut (play p.q.q.n.dab) - ref (play(sut ref) p.q.q.n.hem) - == == == == == - :: - ++ dext - ^- ? - =- ?: - & - ?. tel | - :: ~_ (dunk %need) - :: ~_ (dunk(sut ref) %have) - ~>(%mean.[%leaf "nest-fail"] !!) - ?: =(sut ref) & - ?- sut - $void sint - $noun & - {$atom *} ?. ?=({$atom *} ref) sint - ?& (fitz p.sut p.ref) - |(?=($~ q.sut) =(q.sut q.ref)) - == - {$cell *} ?. ?=({$cell *} ref) sint - ?& dext(sut p.sut, ref p.ref, seg ~, reg ~) - dext(sut q.sut, ref q.ref, seg ~, reg ~) - == - {$core *} ?. ?=({$core *} ref) sint - ?: =(q.sut q.ref) dext(sut p.sut, ref p.ref) - ?& meet(sut q.q.sut, ref p.sut) - dext(sut q.q.ref, ref p.ref) - (deem(sut q.q.sut, ref q.q.ref) p.q.sut p.q.ref) - ?| (~(has in gil) [sut ref]) - %. [q.s.q.sut q.s.q.ref] - %= deep - gil (~(put in gil) [sut ref]) - sut sut(p q.q.sut, p.q %gold) - ref ref(p q.q.ref, p.q %gold) - == == - == - {$face *} dext(sut q.sut) - {$fork *} ?. ?=(?({$atom *} $noun {$cell *} {$core *}) ref) sint - (lien (~(tap in p.sut)) |=(span dext(tel |, sut +<))) - {$help *} dext(sut q.sut) - {$hold *} ?: (~(has in seg) sut) | - ?: (~(has in gil) [sut ref]) & - %= dext - sut repo - seg (~(put in seg) sut) - gil (~(put in gil) [sut ref]) - == == - :: - ++ meet &(dext dext(sut ref, ref sut)) - ++ sint - ^- ? - ?- ref - $noun | - $void & - {$atom *} | - {$cell *} | - {$core *} dext(ref repo(sut ref)) - {$face *} dext(ref q.ref) - {$fork *} (levy (~(tap in p.ref)) |=(span sint(ref +<))) - {$help *} dext(ref q.ref) - {$hold *} ?: (~(has in reg) ref) & - ?: (~(has in gil) [sut ref]) & - %= dext - ref repo(sut ref) - reg (~(put in reg) ref) - gil (~(put in gil) [sut ref]) - == == - -- - :: - ++ peek - ~/ %peek - |= {way/?($read $rite $both $free) axe/axis} - ^- span - ?: =(1 axe) - sut - =+ [now=(cap axe) lat=(mas axe)] - =+ gil=*(set span) - |- ^- span - ?- sut - {$atom *} %void - {$cell *} ?:(=(2 now) ^$(sut p.sut, axe lat) ^$(sut q.sut, axe lat)) - {$core *} - ?. =(3 now) %noun - =+ pec=(peel way p.q.sut) - %= ^$ - axe lat - sut - ?: =([& &] pec) p.sut - %+ cell - ?.(sam.pec %noun ^$(sut p.sut, axe 2)) - ?.(con.pec %noun ^$(sut p.sut, axe 3)) - == - :: - {$fork *} (fork (turn (~(tap in p.sut)) |=(span ^$(sut +<)))) - {$hold *} - ?: (~(has in gil) sut) - %void - $(gil (~(put in gil) sut), sut repo) - :: - $void %void - $noun %noun - * $(sut repo) - == - :: - ++ peel - |= {way/vial met/?($gold $ktbr $ktwt $ktpm)} - ^- {sam/? con/?} - ?: ?=($gold met) [& &] - ?- way - $both [| |] - $free [& &] - $read [?=($ktpm met) |] - $rite [?=($ktbr met) |] - == - :: - ++ play - ~/ %play - => .(vet |) - |= gen/twig - ^- span - ?- gen - {^ *} (cell $(gen p.gen) $(gen q.gen)) - {$brcn *} (core sut %gold sut p.gen [[%0 0] q.gen]) - {$make *} ~(play et p.gen q.gen) - {$dtkt *} $(gen [%bunt p.gen]) - {$dtls *} [%atom %$ ~] - {$rock *} |- ^- span - ?@ q.gen [%atom p.gen `q.gen] - [%cell $(q.gen -.q.gen) $(q.gen +.q.gen)] - {$sand *} |- ^- span - ?@ q.gen - ?: =(%n p.gen) ?>(=(0 q.gen) [%atom p.gen ~ q.gen]) - ?:(=(%f p.gen) ?>((lte q.gen 1) bool) [%atom p.gen ~]) - [%cell $(q.gen -.q.gen) $(q.gen +.q.gen)] - {$tune *} (face p.gen sut) - {$dttr *} %noun - {$dtts *} bool - {$dtwt *} bool - {$hand *} p.gen - {$ktbr *} (wrap(sut $(gen p.gen)) %ktbr) - {$ktls *} $(gen p.gen) - {$ktpm *} (wrap(sut $(gen p.gen)) %ktpm) - {$ktsg *} $(gen p.gen) - {$ktts *} (conk(sut $(gen q.gen)) p.gen) - {$ktwt *} (wrap(sut $(gen p.gen)) %ktwt) - {$help *} (help p.gen $(gen q.gen)) - {$peep *} ~_(duck(sut ^$(gen p.gen)) $(gen q.gen)) - {$hint *} $(gen q.gen) - {$per *} $(gen q.gen, sut $(gen p.gen)) - {$aka *} $(gen r.gen, sut (buss p.gen q.gen)) - {$if *} =+ [fex=(gain p.gen) wux=(lose p.gen)] - %- fork :~ - ?:(=(%void fex) %void $(sut fex, gen q.gen)) - ?:(=(%void wux) %void $(sut wux, gen r.gen)) - == - {$fits *} bool - {$dbug *} ~_((show %o p.gen) $(gen q.gen)) - {$twig *} (play p.gen) - {$wrap *} %= $ - gen - [%cnhp [%limb %onan] [%hand p:!>(*span) [%1 $(gen p.gen)]] ~] - == - {$lost *} %void - {$spit *} (cell $(gen p.gen) $(gen q.gen)) - {$code *} %noun - {$fail *} %void - * =+ doz=~(open ap gen) - ?: =(doz gen) - ~_ (show [%c 'hoon'] [%q gen]) - ~>(%mean.[%leaf "play-open"] !!) - $(gen doz) - == - :: - ++ repo - ^- span - ?- sut - {$core *} [%cell %noun p.sut] - {$face *} q.sut - {$help *} q.sut - {$hold *} (rest [[p.sut q.sut] ~]) - $noun (fork [%atom %$ ~] [%cell %noun %noun] ~) - * ~>(%mean.[%leaf "repo-fltt"] !!) - == - :: - ++ rest - ~/ %rest - |= leg/(list {p/span q/twig}) - ^- span - ?: (lien leg |=({p/span q/twig} (~(has in fan) [p q]))) - ~>(%mean.[%leaf "rest-loop"] !!) - => .(fan (~(gas in fan) leg)) - %- fork - %- %~ tap in - %- ~(gas in *(set span)) - (turn leg |=({p/span q/twig} (play(sut p) q))) - == - ~ - :: - ++ take - |= {vit/vein duz/$-(span span)} - ^- (pair axis span) - :- (tend vit) - =. vit (flop vit) - |- ^- span - ?~ vit (duz sut) - ?~ i.vit - |- ^- span - ?+ sut ^$(vit t.vit) - {$face *} (face p.sut ^$(vit t.vit, sut q.sut)) - {$fork *} (fork (turn (~(tap in p.sut)) |=(span ^$(sut +<)))) - {$hold *} $(sut repo) - == - =+ vil=*(set span) - |- ^- span - ?: =(1 u.i.vit) - ^$(vit t.vit) - =+ [now lat]=(cap u.i.vit)^(mas u.i.vit) - ?- sut - $noun $(sut [%cell %noun %noun]) - $void %void - {$atom *} %void - {$cell *} ?: =(2 now) - (cell $(sut p.sut, u.i.vit lat) q.sut) - (cell p.sut $(sut q.sut, u.i.vit lat)) - {$core *} ?: =(2 now) - $(sut repo) - (core $(sut p.sut, u.i.vit lat) q.sut) - {$face *} (face p.sut $(sut q.sut)) - {$fork *} (fork (turn (~(tap in p.sut)) |=(span ^$(sut +<)))) - {$help *} (help p.sut $(sut q.sut)) - {$hold *} ?: (~(has in vil) sut) - %void - $(sut repo, vil (~(put in vil) sut)) - == - :: - ++ tack - |= {hyp/wing mur/span} - ~_ (show [%c %tack] %l hyp) - =+ fid=(find %rite hyp) - ?> ?=($& -.fid) - (take p.p.fid |=(span mur)) - :: - ++ tend - |= vit/vein - ^- axis - ?~(vit 1 (peg $(vit t.vit) ?~(i.vit 1 u.i.vit))) - :: - ++ toss - ~/ %toss - |= {hyp/wing mur/span men/(list {p/span q/foot})} - ^- {p/axis q/(list {p/span q/foot})} - =- [(need p.wib) q.wib] - ^= wib - |- ^- {p/(unit axis) q/(list {p/span q/foot})} - ?~ men - [*(unit axis) ~] - =+ geq=(tack(sut p.i.men) hyp mur) - =+ mox=$(men t.men) - [(mate p.mox `_p.mox`[~ p.geq]) [[q.geq q.i.men] q.mox]] - :: - ++ wrap - ~/ %wrap - |= yoz/?($ktwt $ktbr $ktpm) - ~_ leaf+"wrap" - ^- span - ?+ sut sut - {$cell *} (cell $(sut p.sut) $(sut q.sut)) - {$core *} ?>(|(=(%gold p.q.sut) =(%ktwt yoz)) sut(p.q yoz)) - {$face *} (face p.sut $(sut q.sut)) - {$fork *} (fork (turn (~(tap in p.sut)) |=(span ^$(sut +<)))) - {$help *} (help p.sut $(sut q.sut)) - {$hold *} $(sut repo) - == - -- -++ us :: prettyprinter - => |% - ++ cape {p/(map @ud wine) q/wine} :: - ++ wine :: - $@ $? $noun :: - $path :: - $span :: - $void :: - $wall :: - $wool :: - $yarn :: - == :: - $% {$mato p/term} :: - {$core p/(list @ta) q/wine} :: - {$face p/term q/wine} :: - {$list p/term q/wine} :: - {$pear p/term q/@} :: - {$bcwt p/(list wine)} :: - {$plot p/(list wine)} :: - {$stop p/@ud} :: - {$tree p/term q/wine} :: - {$unit p/term q/wine} :: - == :: - -- - |_ sut/span - ++ dash - |= {mil/tape lim/char} ^- tape - :- lim - |- ^- tape - ?~ mil [lim ~] - ?: =(lim i.mil) ['\\' i.mil $(mil t.mil)] - ?: =('\\' i.mil) ['\\' i.mil $(mil t.mil)] - ?: (lte ' ' i.mil) [i.mil $(mil t.mil)] - ['\\' ~(x ne (rsh 2 1 i.mil)) ~(x ne (end 2 1 i.mil)) $(mil t.mil)] - :: - ++ deal |=(lum/* (dish dole lum)) - ++ dial - |= ham/cape - =+ gid=*(set @ud) - =< `tank`-:$ - |% - ++ many - |= haz/(list wine) - ^- {(list tank) (set @ud)} - ?~ haz [~ gid] - =^ mor gid $(haz t.haz) - =^ dis gid ^$(q.ham i.haz) - [[dis mor] gid] - :: - ++ $ - ^- {tank (set @ud)} - ?- q.ham - $noun :_(gid [%leaf '*' ~]) - $path :_(gid [%leaf '/' ~]) - $span :_(gid [%leaf '#' 't' ~]) - $void :_(gid [%leaf '#' '!' ~]) - $wool :_(gid [%leaf '*' '"' '"' ~]) - $wall :_(gid [%leaf '*' '\'' '\'' ~]) - $yarn :_(gid [%leaf '"' '"' ~]) - {$mato *} :_(gid [%leaf '@' (trip p.q.ham)]) - {$core *} - =^ cox gid $(q.ham q.q.ham) - :_ gid - :+ %rose - [[' ' ~] ['<' ~] ['>' ~]] - |- ^- (list tank) - ?~ p.q.ham [cox ~] - [[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)] - :: - {$face *} - =^ cox gid $(q.ham q.q.ham) - :_(gid [%palm [['/' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~]) - :: - {$list *} - =^ cox gid $(q.ham q.q.ham) - :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~]) - :: - {$bcwt *} - =^ coz gid (many p.q.ham) - :_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz]) - :: - {$plot *} - =^ coz gid (many p.q.ham) - :_(gid [%rose [[' ' ~] ['{' ~] ['}' ~]] coz]) - :: - {$pear *} - :_(gid [%leaf '$' ~(rend co [%$ p.q.ham q.q.ham])]) - :: - {$stop *} - =+ num=~(rend co [%$ %ud p.q.ham]) - ?: (~(has in gid) p.q.ham) - :_(gid [%leaf '#' num]) - =^ cox gid - %= $ - gid (~(put in gid) p.q.ham) - q.ham (~(got by p.ham) p.q.ham) - == - :_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~]) - :: - {$tree *} - =^ cox gid $(q.ham q.q.ham) - :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~]) - :: - {$unit *} - =^ cox gid $(q.ham q.q.ham) - :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~]) - == - -- - :: - ++ dish - |= {ham/cape lum/*} ^- tank - ~| [%dish-h ?@(q.ham q.ham -.q.ham)] - ~| [%lump lum] - ~| [%ham ham] - %- need - =| gil/(set {@ud *}) - |- ^- (unit tank) - ?- q.ham - $noun - %= $ - q.ham - ?: ?=(@ lum) - [%mato %$] - :- %plot - |- ^- (list wine) - [%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))] - == - :: - $path - :- ~ - :+ %rose - [['/' ~] ['/' ~] ~] - |- ^- (list tank) - ?~ lum ~ - ?@ lum !! - ?> ?=(@ -.lum) - [[%leaf (rip 3 -.lum)] $(lum +.lum)] - :: - $span - =+ tyr=|.((dial dole)) - =+ vol=tyr(sut lum) - =+ cis=((hard tank) .*(vol -:vol)) - :^ ~ %palm - [~ ~ ~ ~] - [[%leaf '#' 't' '/' ~] cis ~] - :: - $wall - :- ~ - :+ %rose - [[' ' ~] ['<' '|' ~] ['|' '>' ~]] - |- ^- (list tank) - ?~ lum ~ - ?@ lum !! - [[%leaf (trip ((hard @) -.lum))] $(lum +.lum)] - :: - $wool - :- ~ - :+ %rose - [[' ' ~] ['<' '<' ~] ['>' '>' ~]] - |- ^- (list tank) - ?~ lum ~ - ?@ lum !! - [(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)] - :: - $yarn - [~ %leaf (dash (tape lum) '"')] - :: - $void - ~ - :: - {$mato *} - ?. ?=(@ lum) - ~ - :+ ~ - %leaf - ?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig))) - ~(rend co [%$ p.q.ham lum]) - $$ ~(rend co [%$ %ud lum]) - $t (dash (rip 3 lum) '\'') - $tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])] - == - :: - {$core *} - :: XX needs rethinking for core metal - :: ?. ?=(^ lum) ~ - :: => .(lum `*`lum) - :: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok]) - :: ^= tok - :: |- ^- (unit (list tank)) - :: ?~ p.q.ham - :: =+ den=^$(q.ham q.q.ham) - :: ?~(den ~ [~ u.den ~]) - :: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum) - :: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]]) - [~ (dial ham)] - :: - {$face *} - =+ wal=$(q.ham q.q.ham) - ?~ wal - ~ - [~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~] - :: - {$list *} - ?: =(~ lum) - [~ %leaf '~' ~] - =- ?~ tok - ~ - [~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok] - ^= tok - |- ^- (unit (list tank)) - ?: ?=(@ lum) - ?.(=(~ lum) ~ [~ ~]) - =+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)] - ?. &(?=(^ for) ?=(^ aft)) - ~ - [~ u.for u.aft] - :: - {$bcwt *} - |- ^- (unit tank) - ?~ p.q.ham - ~ - =+ wal=^$(q.ham i.p.q.ham) - ?~ wal - $(p.q.ham t.p.q.ham) - wal - :: - {$plot *} - =- ?~ tok - ~ - [~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok] - ^= tok - |- ^- (unit (list tank)) - ?~ p.q.ham - ~ - ?: ?=({* $~} p.q.ham) - =+ wal=^$(q.ham i.p.q.ham) - ?~(wal ~ [~ [u.wal ~]]) - ?@ lum - ~ - =+ gim=^$(q.ham i.p.q.ham, lum -.lum) - ?~ gim - ~ - =+ myd=$(p.q.ham t.p.q.ham, lum +.lum) - ?~ myd - ~ - [~ u.gim u.myd] - :: - {$pear *} - ?. =(lum q.q.ham) - ~ - =. p.q.ham - (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig))) - =+ fox=$(q.ham [%mato p.q.ham]) - ?> ?=({$~ $leaf ^} fox) - ?: ?=(?($n $tas) p.q.ham) - fox - [~ %leaf '%' p.u.fox] - :: - {$stop *} - ?: (~(has in gil) [p.q.ham lum]) ~ - =+ kep=(~(get by p.ham) p.q.ham) - ?~ kep - ~|([%stop-loss p.q.ham] !!) - $(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep) - :: - {$tree *} - =- ?~ tok - ~ - [~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok] - ^= tok - =+ tuk=*(list tank) - |- ^- (unit (list tank)) - ?: =(~ lum) - [~ tuk] - ?. ?=({n/* l/* r/*} lum) - ~ - =+ rol=$(lum r.lum) - ?~ rol - ~ - =+ tim=^$(q.ham q.q.ham, lum n.lum) - ?~ tim - ~ - $(lum l.lum, tuk [u.tim u.rol]) - :: - {$unit *} - ?@ lum - ?.(=(~ lum) ~ [~ %leaf '~' ~]) - ?. =(~ -.lum) - ~ - =+ wal=$(q.ham q.q.ham, lum +.lum) - ?~ wal - ~ - [~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~] - == - :: - ++ doge - |= ham/cape - =- ?+ woz woz - {$list * {$mato $'ta'}} %path - {$list * {$mato $'t'}} %wall - {$list * {$mato $'tD'}} %yarn - {$list * $yarn} %wool - == - ^= woz - ^- wine - ?. ?=({$stop *} q.ham) - ?: ?& ?= {$bcwt {$pear $n $0} {$plot {$pear $n $0} {$face *} $~} $~} - q.ham - =(1 (met 3 p.i.t.p.i.t.p.q.ham)) - == - [%unit =<([p q] i.t.p.i.t.p.q.ham)] - q.ham - =+ may=(~(get by p.ham) p.q.ham) - ?~ may - q.ham - =+ nul=[%pear %n 0] - ?. ?& ?=({$bcwt *} u.may) - ?=({* * $~} p.u.may) - |(=(nul i.p.u.may) =(nul i.t.p.u.may)) - == - q.ham - =+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may) - ?: ?& ?=({$plot {$face *} {$face * $stop *} $~} din) - =(p.q.ham p.q.i.t.p.din) - =(1 (met 3 p.i.p.din)) - =(1 (met 3 p.i.t.p.din)) - == - :+ %list - (cat 3 p.i.p.din p.i.t.p.din) - q.i.p.din - ?: ?& ?= $: $plot - {$face *} - {$face * $stop *} - {{$face * $stop *} $~} - == - din - =(p.q.ham p.q.i.t.p.din) - =(p.q.ham p.q.i.t.t.p.din) - =(1 (met 3 p.i.p.din)) - =(1 (met 3 p.i.t.p.din)) - =(1 (met 3 p.i.t.t.p.din)) - == - :+ %tree - %^ cat - 3 - p.i.p.din - (cat 3 p.i.t.p.din p.i.t.t.p.din) - q.i.p.din - q.ham - :: - ++ dole - ^- cape - =+ gil=*(set span) - =+ dex=[p=*(map span @) q=*(map @ wine)] - =< [q.p q] - |- ^- {p/{p/(map span @) q/(map @ wine)} q/wine} - =- [p.tez (doge q.p.tez q.tez)] - ^= tez - ^- {p/{p/(map span @) q/(map @ wine)} q/wine} - ?: (~(meet ut sut) -:!>(*span)) - [dex %span] - ?- sut - $noun [dex sut] - $void [dex sut] - {$atom *} [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])] - {$cell *} - =+ hin=$(sut p.sut) - =+ yon=$(dex p.hin, sut q.sut) - :- p.yon - :- %plot - ?:(?=({$plot *} q.yon) [q.hin p.q.yon] [q.hin q.yon ~]) - :: - {$core *} - =+ yad=$(sut p.sut) - :- p.yad - =+ ^= doy ^- {p/(list @ta) q/wine} - ?: ?=({$core *} q.yad) - [p.q.yad q.q.yad] - [~ q.yad] - :- %core - :_ q.doy - :_ p.doy - %^ cat 3 - %~ rent co - :+ %$ %ud - |- ^- @ - ?- q.s.q.sut - $~ 0 - {* $~ $~} 1 - {* $~ *} +($(q.s.q.sut r.q.s.q.sut)) - {* * $~} +($(q.s.q.sut l.q.s.q.sut)) - {* * *} .+ %+ add - $(q.s.q.sut l.q.s.q.sut) - $(q.s.q.sut r.q.s.q.sut) - == == - %^ cat 3 - ?-(p.q.sut $gold '.', $ktbr '|', $ktwt '?', $ktpm '&') - =+ gum=(mug q.s.q.sut) - %+ can 3 - :~ [1 (add 'a' (mod gum 26))] - [1 (add 'a' (mod (div gum 26) 26))] - [1 (add 'a' (mod (div gum 676) 26))] - == - :: - {$help *} - $(sut q.sut) - :: - {$face *} - =+ yad=$(sut q.sut) - ?^(q.p.sut yad [p.yad [%face q.p.sut q.yad]]) - :: - {$fork *} - =+ yed=(~(tap in p.sut)) - =- [p [%bcwt q]] - |- ^- {p/{p/(map span @) q/(map @ wine)} q/(list wine)} - ?~ yed - [dex ~] - =+ mor=$(yed t.yed) - =+ dis=^$(dex p.mor, sut i.yed) - [p.dis q.dis q.mor] - :: - {$hold *} - =+ hey=(~(get by p.dex) sut) - ?^ hey - [dex [%stop u.hey]] - ?: (~(has in gil) sut) - =+ dyr=+(~(wyt by p.dex)) - [[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]] - =+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut)) - =+ rey=(~(get by p.p.rom) sut) - ?~ rey - rom - [[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]] - == - :: - ++ duck (dial dole) - -- -++ cain sell :: $-(vase tank) -++ noah text :: $-(vase tape) -++ onan seer :: $-(vise vase) -++ text :: tape pretty-print - |= vax/vase ^- tape - ~(ram re (sell vax)) -:: -++ seem |=(toy/typo `span`toy) :: promote typo -++ seer |=(vix/vise `vase`vix) :: promote vise -++ sell :: tank pretty-print - |= vax/vase ^- tank - ~| %sell - (~(deal us p.vax) q.vax) -:: -++ skol :: $-(span tank) for ~! - |= typ/span ^- tank - ~(duck ut typ) -:: -++ slam :: slam a gate - |= {gat/vase sam/vase} ^- vase - =+ :- ^= typ ^- span - [%cell p.gat p.sam] - ^= gen ^- twig - [%open [%$ ~] [%$ 2] [%$ 3] ~] - =+ gun=(~(mint ut typ) %noun gen) - [p.gun .*([q.gat q.sam] q.gun)] -:: -++ slab :: test if contains - |= {cog/@tas typ/span} - =(& -:(~(find ut typ) %free [cog ~])) -:: -++ slap - |= {vax/vase gen/twig} ^- vase :: untyped vase .* - =+ gun=(~(mint ut p.vax) %noun gen) - [p.gun .*(q.vax q.gun)] -:: -++ slew :: get axis in vase - |= {axe/@ vax/vase} ^- (unit vase) - ?. |- ^- ? - ?: =(1 axe) & - ?. ?=(^ q.vax) | - $(axe (mas axe), q.vax .*(q.vax [0 (cap axe)])) - ~ - `[(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])] -:: -++ slim :: identical to seer? - |= old/vise ^- vase - old -:: -++ slit :: span of slam - |= {gat/span sam/span} - ?> (~(nest ut (~(peek ut gat) %free 6)) & sam) - (~(play ut [%cell gat sam]) [%open [%$ ~] [%$ 2] [%$ 3] ~]) -:: -++ slob :: superficial arm - |= {cog/@tas typ/span} - ^- ? - ?+ typ | - {$hold *} $(typ ~(repo ut typ)) - {$core *} - |- ^- ? - ?~ q.s.q.typ | - ?| (~(has by q.q.n.q.s.q.typ) cog) - $(q.s.q.typ l.q.s.q.typ) - $(q.s.q.typ r.q.s.q.typ) - == - == -:: -++ sloe :: get arms in core - |= typ/span - ^- (list term) - ?+ typ ~ - {$hold *} $(typ ~(repo ut typ)) - {$core *} - (turn (~(tap by q.s.q.typ) ~) |=({a/term *} a)) - == -:: -++ slop :: cons two vases - |= {hed/vase tal/vase} - ^- vase - [[%cell p.hed p.tal] [q.hed q.tal]] -:: -++ slot :: got axis in vase - |= {axe/@ vax/vase} ^- vase - [(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])] -:: -++ slym :: slam w+o sample-span - |= {gat/vase sam/*} ^- vase - (slap gat(+<.q sam) [%limb %$]) -:: -++ spec :: reconstruct span - |= vax/vase - ^- vase - :_ q.vax - ?@ q.vax (~(fuse ut p.vax) [%atom %$ ~]) - ?@ -.q.vax - ^= typ - %- ~(play ut p.vax) - [%sure [%fits [%leaf %tas -.q.vax] [%& 2]~] [%$ 1]] - (~(fuse ut p.vax) [%cell %noun %noun]) -:: -:::: 5d: parser - :: -++ vang - |= {bug/? wer/path} - %*(. vast bug bug, wer wer) -:: -++ vast - =+ [bug=`?`| wer=*path] - |% - :: - ++ gash %+ cook - |= a/(list tyke) ^- tyke - ?~(a ~ (weld i.a $(a t.a))) - (more fas gasp) - ++ gasp ;~ pose - %+ cook - |=({a/tyke b/tyke c/tyke} :(weld a b c)) - ;~ plug - (cook |=(a/(list) (turn a |=(b/* ~))) (star tis)) - (cook |=(a/twig [[~ a] ~]) hasp) - (cook |=(a/(list) (turn a |=(b/* ~))) (star tis)) - == - (cook |=(a/(list) (turn a |=(b/* ~))) (plus tis)) - == - ++ glam ~+((glue ace)) - ++ hasp ;~ pose - (ifix [sel ser] wide) - (stag %cnhp (ifix [pel per] (most ace wide))) - (stag %sand (stag %t qut)) - %+ cook - |=(a/coin [%sand ?:(?=({$~ $tas *} a) %tas %ta) ~(rent co a)]) - nuck:so - == - ++ mota %+ cook - |=({a/tape b/tape} (rap 3 (weld a b))) - ;~(plug (star low) (star hig)) - ++ glom - |= {wit/whit taw/whit} - ^- whit - :* ?~(lab.wit lab.taw lab.wit) - ?~(boy.wit boy.taw boy.wit) - (~(uni by def.wit) def.taw) - (~(uni in use.wit) use.taw) - == - ++ docs - |% - :: above core - :: - ++ apex - %+ cook beer - ;~ plug - =/ ron (punt (into noel)) - (punt (ifix [ron ron] (into (step head)))) - ;~(pfix (punt (into null)) (punt body)) - (star fill) - == - :: backward line - :: - ++ apse - ;~ pose - %+ cook - |= a/(each (pair term cord) cord) - ^- whit - ?- -.a - $& [~ ~ [[p.p.a [q.p.a ~]] ~ ~] ~] - $| [~ `[p.a ~] ~ ~] - == - (exit (step (pick fine line))) - (easy *whit) - == - :: - :: - ++ beer - |= $: a/(unit term) - b/(unit (pair cord (list sect))) - c/(list (pair (pair term cord) (list sect))) - == - ^- whit - =/ d - |- ^- (map term (pair cord (list sect))) - ?~ c ~ - =/ e $(c t.c) - (~(put by e) p.p.i.c [q.p.i.c q.i.c]) - [a b d ~] - :: - :: - ++ body - ;~ sfix - ;~ pose - ;~ plug - (into ;~(pfix (punt ;~(plug (star ace) col gar)) (step line))) - (easy ~) - == - ;~ plug - (into (dubs line)) - (rant text) - == - == - (punt (into null)) - == - :: - :: null: blank line - :: line: prose line - :: code: code line - :: text: text line - :: fine: definition line - :: - ++ line (cook crip ;~(plug prz (star prn))) - ++ head ;~(pfix ;~(plug bar bar ace ace cen) sym) - ++ text (pick line code) - ++ code (cook crip (dubs (star prn))) - ++ null (star ace) - ++ noel ;~(pose (step ;~(sfix ;~(plug bar bar) (star ace))) null) - ++ fine ;~(plug sym (cook crip ;~(pfix ;~(plug col ace) (star prn)))) - :: - :: lean: line delimited - :: - ++ lean - |* gyf/rule - |* bod/rule - ;~(pfix ;~(plug col gyf) bod) - :: - :: step: indent - :: - ++ step - |* fel/rule - ;~(pfix ;~(plug ace ace) fel) - :: - :: dubs: double-indent - :: - ++ dubs - |* fel/rule - ;~(pfix ;~(plug ace ace ace ace) fel) - :: - :: into: :> to end of line, consuming following space. - :: - ++ into - |* bod/rule - ;~(sfix ((lean gar) bod) ;~(plug (just `@`10) (punt gap))) - :: - :: exit: :< to end of line, not consuming following space. - :: - ++ exit - |* bod/rule - ;~(pfix (star ace) ((lean gal) bod)) - :: - :: fill: full definition - :: - ++ fill - ;~ sfix - ;~(plug (into (step fine)) (rant (step text))) - (punt (into null)) - == - :: - :: rant: series of sections. - :: - ++ rant - |* sec/rule - %- star - ;~ pfix - (into null) - (plus (into (step sec))) - == - -- - :: - ++ plex - |= gen/twig ^- (unit path) - ?: ?=({$dbug *} gen) - $(gen q.gen) - ?. ?=({$clsg *} gen) ~ - %+ reel p.gen - |= {a/twig b/_`(unit path)`[~ u=/]} - ?~ b ~ - ?. ?=({$sand ?($ta $tas) @} a) ~ - `[q.a u.b] - :: - ++ pray - |= gen/twig ~| %pray ^- (unit twig) - ~& [%pray-disabled gen] - !! - :: - ++ prey - |= gun/(list twig) ^- (unit twig) - ?~ gun `[%$ 1] - =+ gup=(pray i.gun) - ?~ gup ~ - ?~ t.gun gup - (bind $(gun t.gun) |=(a/twig [%per u.gup a])) - :: - ++ phax - |= ruw/(list (list woof)) - =+ [yun=*(list twig) cah=*(list @)] - =+ wod=|=({a/tape b/(list twig)} ^+(b ?~(a b [[%smfs %knit (flop a)] b]))) - |- ^+ yun - ?~ ruw - (flop (wod cah yun)) - ?~ i.ruw $(ruw t.ruw) - ?@ i.i.ruw - $(i.ruw t.i.ruw, cah [i.i.ruw cah]) - $(i.ruw t.i.ruw, cah ~, yun [p.i.i.ruw (wod cah yun)]) - :: - ++ posh - |= {pre/(unit tyke) pof/(unit {p/@ud q/tyke})} - ^- (unit (list twig)) - =- ?^(- - ~&(%posh-fail -)) - =+ wom=(poof wer) - %+ biff - ?~ pre `u=wom - %+ bind (poon wom u.pre) - |= moz/(list twig) - ?~(pof moz (weld moz (slag (lent u.pre) wom))) - |= yez/(list twig) - ?~ pof `yez - =+ zey=(flop yez) - =+ [moz=(scag p.u.pof zey) gul=(slag p.u.pof zey)] - =+ zom=(poon (flop moz) q.u.pof) - ?~(zom ~ `(weld (flop gul) u.zom)) - :: - ++ poof |=(pax/path ^-((list twig) (turn pax |=(a/@ta [%sand %ta a])))) - ++ poon - |= {pag/(list twig) goo/tyke} - ^- (unit (list twig)) - ?~ goo `~ - %+ both - ?^(i.goo i.goo ?~(pag ~ `u=i.pag)) - $(goo t.goo, pag ?~(pag ~ t.pag)) - :: - ++ poor - %+ sear posh - ;~ plug - (stag ~ gash) - ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~)) - == - :: - ++ porc - ;~ plug - (cook |=(a/(list) (lent a)) (star cen)) - ;~(pfix fas gash) - == - :: - ++ rump - %+ sear - |= {a/wing b/(unit twig)} ^- (unit twig) - ?~(b [~ %wing a] ?.(?=({@ $~} a) ~ [~ [%rock %tas i.a] u.b])) - ;~(plug rope ;~(pose (stag ~ ;~(pfix lus wide)) (easy ~))) - :: - ++ rood - ;~ pfix fas - (stag %clsg poor) - == - :: - ++ rupl - %+ cook - |= {a/? b/(list twig) c/?} - ?: a - ?: c - [%clsg [%clsg b] ~] - [%clsg b] - ?: c - [%clsg [%cltr b] ~] - [%cltr b] - ;~ plug - ;~ pose - (cold | (just '[')) - (cold & (jest '~[')) - == - :: - ;~ pose - (ifix [ace gap] (most gap tall)) - (most ace wide) - == - :: - ;~ pose - (cold & (jest ']~')) - (cold | (just ']')) - == - == - :: - ++ sail :: xml template - |= tol/? =| lin/? - |% - ++ ape :: product twig - %+ cook - |= tum/tuna ^- twig - ?: ?=({$e *} tum) - [p.tum (sag q.tum)] - (sag tum ~) - amp - :: - ++ amp :: entry point - ;~(pfix sem ?:(tol bam bat)) - :: - ++ bam :: tall top - %+ knee *tuna |. ~+ - ;~ pose - (stag %f ;~(pfix (plus ace) (cook rab puv))) - (stag %e ;~(plug hag nal)) - (stag %e hul) - (stag %f nup) - ;~(pfix tis (stag %f nol)) - ;~(pfix hep (stag %a ;~(pfix gap tall))) - ;~(pfix lus (stag %b ;~(pfix gap tall))) - ;~(pfix tar (stag %c ;~(pfix gap tall))) - ;~(pfix cen (stag %d ;~(pfix gap tall))) - (easy [%f [%a [%knit 10 ~]] ~]) - == - :: - ++ bat :: wide outer top - %+ knee *tuna |. ~+ - ;~ pose - (stag %f nup) - (stag %f ped) - (stag %e ;~(plug hig lif)) - == - :: - ++ bet :: wide inner top - %+ knee *tuna |. ~+ - ;~ pose - bat - ;~(pfix hep (stag %a wide)) - ;~(pfix lus (stag %b wide)) - ;~(pfix tar (stag %c wide)) - ;~(pfix cen (stag %d wide)) - == - :: - ++ fry :: mane as twig - %+ cook - |= {a/@tas b/(unit @tas)} - ?~ b - [%rock %tas a] - [[%rock %tas a] [%rock %tas u.b]] - ;~(plug sym ;~(pose (stag ~ ;~(pfix cab sym)) (easy ~))) - :: - ++ hag :: script or style - %+ cook |=(a/twig a) - ;~ plug - (stag %rock (stag %tas ;~(pose (jest %script) (jest %style)))) - (stag %clsg jaw) - == - :: - ++ hig :: simple head - (cook |=({a/twig b/(list twig)} [a %clsg b]) hog) - :: - ++ hog :: tag head - %+ cook - |= hug - ^- {twig (list twig)} - =- [a (welp - ?~(c d [[[%rock %tas p.c] q.c] d]))] - =- (~(tap by -)) - %. |=(e/(list tank) [%knit ~(ram re %rose [" " `~] e)]) - =< ~(run by (reel b .)) - |= {e/{p/term q/term} f/(jar twig tank)} - (~(add ja f) [%rock %tas p.e] [%leaf (trip q.e)]) - ;~ plug - fry - =- (star ;~(plug - sym)) - ;~(pose (cold %class dot) (cold %id hax)) - =- ;~(pose ;~(plug - (stag %knit soil)) (easy ~)) - ;~(pose (cold %href fas) (cold %src pat)) - ;~ pose - %+ ifix [pel per] - %+ more ;~(plug com ace) - ;~(plug fry ;~(pfix ace wide)) - :: - (easy ~) - == - == - :: - ++ hoy :: tall attributes - %- star - ;~ pfix ;~(plug gap tis) - ;~(plug fry ;~(pfix gap tall)) - == - :: - ++ hug :: head shape - $: a/twig :: XX translation - b/(list {@tas @tas}) - c/$@($~ {p/@tas q/twig}) - d/(list twig) - == - :: - ++ hul :: tall preface - %+ cook - |= {a/{p/twig q/(list twig)} b/(list twig) c/(list tuna)} - ^- {twig (list tuna)} - [[p.a %clsg (weld q.a b)] c] - ;~(plug hog hoy nol) - :: - ++ jaw :: wide attributes - ;~ pose - %+ ifix [pel per] - %+ more ;~(plug com ace) - ;~(plug fry ;~(pfix ace wide)) - :: - (easy ~) - == - :: - ++ lif :: wide elements - %+ cook |=(a/(list tuna) a) - ;~(pose ;~(pfix col pep) (cold ~ sem) (easy ~)) - :: - ++ luf :: wide elements - %+ cook |=(a/(list tuna) a) - (star ;~(pfix ace bet)) - :: - ++ nal :: unescaped tall tail - %+ cook |=(a/(list tuna) a) - %+ ifix [gap ;~(plug gap duz)] - %+ most gap - ;~ pfix sem - ;~ pose - ;~ pfix ace - %+ cook - |= a/tape - [%a %knit (weld a `tape`[`@`10 ~])] - (star (shim 32 255)) - == - (easy [%a %knit `@`10 ~]) - == - == - :: - ++ nol :: tall tail - ?> tol - %+ cook |=(a/(list tuna) a) - ;~ pose - (cold ~ sem) - ;~(pfix col pep(tol |)) - ;~(pfix ;~(plug col ace) (cook rab(tol |) puv)) - (ifix [gap ;~(plug gap duz)] (most gap amp)) - == - :: - ++ nup :: wide quote - %+ cook |=(a/(list tuna) a) - ;~ pose - ;~(less (jest '"""') (ifix [doq doq] (cook rab puv))) - (iny (ifix [(jest '"""\0a') (jest '\0a"""')] (cook rab puv(lin |)))) - == - :: - ++ pab (ifix [kel ker] ;~(plug hig luf)) :: bracketed element - ++ ped :: wide flow - %+ cook |=(a/(list tuna) a) - (ifix [pel per] (more ace bet)) - :: - ++ pep :: wrapped tuna - %+ cook |=(a/(list tuna) a) - ;~ pose - ped - (ifix [pel per] (more ace bet)) - (cook |=(@t [%a %knit (trip +<)]~) qut) - ;~ plug - bat - (easy ~) - == - == - :: - ++ puv :: wide+tall flow - %+ cook |=(a/(list beet) a) - %- star - ;~ pose - ;~(pfix bas ;~(pose (mask "-+*%;\{") bas doq bix:ab)) - ;~(pfix hep (stag %a sump)) - ;~(pfix lus (stag %b sump)) - ;~(pfix tar (stag %c sump)) - ;~(pfix cen (stag %d sump)) - ;~(pfix sem (stag %e pab(tol |))) - ;~(less bas kel ?:(tol fail doq) prn) - ?:(lin fail ;~(less (jest '\0a"""') (just '\0a'))) - (stag %a sump) - == - :: - ++ rab :: beet to tuna - |= reb/(list beet) - ^- (list tuna) - =| {sim/(list @) tuz/(list tuna)} - |- ^- (list tuna) - ?~ reb - =. sim - ?. tol sim - [10 |-(?~(sim sim ?:(=(32 i.sim) $(sim t.sim) sim)))] - ?~(sim tuz [[%a %knit (flop sim)] tuz]) - ?@ i.reb - $(reb t.reb, sim [i.reb sim]) - =+ zut=$(reb t.reb, sim ~) - ?~ sim [i.reb zut] - [[%a %knit (flop sim)] i.reb zut] - :: - ++ sag :: tuna to twig - |= lut/(list tuna) - ^- twig - :- %cltr - |- ^- (list twig) - ?~ lut [[%rock %n ~] ~] - ?- -.i.lut - $a [[%smfs p.i.lut] $(lut t.lut)] - $b [p.i.lut $(lut t.lut)] - $c :_ ~ - :+ %cndt `twig`[p.i.lut [%cltr $(lut t.lut)]] - :+ %new [%base %cell] - :+ %brcn [~ ~] - ^- (map @ tomb) - =- [[0 [~ ~] -] ~ ~] - ^- (map term (pair what foot)) - :_ [~ ~] - =+ sug=[[%& 12] ~] - :^ %$ ~ %elm - :^ %ifno sug - [%make sug [[[[%& 1] ~] [%$ 13]] ~]] - [%make sug [[[[%& 3] ~] [%make [%$ ~] [[sug [%$ 25]] ~]]] ~]] - $d [[%cnhp p.i.lut [%cltr $(lut t.lut)] ~] ~] - $e [[p.i.lut ^$(lut [[%f q.i.lut] ~])] $(lut t.lut)] - $f $(lut (weld p.i.lut t.lut)) - == - -- - ++ scab - %+ cook - |= a/(list wing) ^- twig - :- %bcsm - |- ^- twig - ?~(a !! ?~(t.a [%wing i.a] [%rap [%wing i.a] $(a t.a)])) - (most col rope) - :: - ++ scad !: - %+ knee *root |. ~+ - %- stew - ^. stet ^. limo - :~ - :- '_' - ;~(pfix cab (stag %bccb wide)) - :- '$' - ;~ pose - ;~ pfix buc - ;~ pose - (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)) - == - == - (stag %bcsm rump) - == - :- '%' - ;~ pose - ;~ pfix cen - ;~ pose - (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)) - == - == - == - :- '(' - %+ stag %bcsm - %+ stag %cnhp - %+ ifix [pel per] - ;~(plug wide ;~(pose ;~(pfix ace (most ace wyde)) (easy ~))) - :- '{' - (stag %bccl (ifix [kel ker] (most ace wyde))) - :- '[' - (stag %bccl (ifix [sel ser] (most ace wyde))) - :- '*' - (cold [%base %noun] tar) - :- '@' - ;~(pfix pat (stag %base (stag %atom mota))) - :- '?' - ;~ pose - (stag %bcwt ;~(pfix wut (ifix [pel per] (most ace wyde)))) - (cold [%base %bean] wut) - == - :- '^' - ;~ pose - scab - (cold [%base %cell] ket) - == - :- '.' - scab - :- ['a' 'z'] - ;~ pose - (stag %bcts ;~(plug sym ;~(pfix ;~(pose fas tis) wyde))) - scab - == - == - :: - ++ scat !: - %+ knee *twig |. ~+ - %- stew - ^. stet ^. limo - :~ - :- ',' - ;~ pose - (stag %wing rope) - ;~(pfix com (stag %ktsg wide)) - == - :- '!' - ;~ pose - (stag %not ;~(pfix zap wide)) - (stag %fail (cold ~ ;~(plug zap zap))) - == - :- '_' - ;~(pfix cab (stag %bccb wide)) - :- '$' - ;~ pose - ;~ pfix buc - ;~ pose - (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)) - == - == - rump - == - :- '%' - ;~ pfix cen - ;~ pose - (stag %clsg (sear |~({a/@ud b/tyke} (posh ~ ~ a b)) porc)) - (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) - (stag %clsg (sear |=(a/(list) (posh ~ ~ (lent a) ~)) (star cen))) - == - == - :- '&' - ;~ pose - (cook |=(a/wing [%make a ~]) rope) - (stag %and ;~(pfix pam (ifix [pel per] (most ace wide)))) - ;~(plug (stag %rock (stag %f (cold & pam))) ;~(pfix lus wide)) - (stag %sand (stag %f (cold & pam))) - == - :- '\'' - (stag %sand (stag %t qut)) - :- '(' - (stag %cnhp (ifix [pel per] (most ace wide))) - :- '{' - (stag %bccl (ifix [kel ker] (most ace wide))) - :- '*' - ;~ pose - (stag %bunt ;~(pfix tar wide)) - (cold [%base %noun] tar) - == - :- '@' - ;~(pfix pat (stag %base (stag %atom mota))) - :- '+' - ;~ pose - (stag %dtls ;~(pfix lus (ifix [pel per] wide))) - :: - %+ cook - |= a/(list (list woof)) - :- %smfs - [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))] - (most dog ;~(pfix lus soil)) - :: - (cook |=(a/wing [%make a ~]) rope) - == - :- '-' - ;~ pose - (stag %sand tash:so) - :: - %+ cook - |= a/(list (list woof)) - [%clsg (phax a)] - (most dog ;~(pfix hep soil)) - :: - (cook |=(a/wing [%make a ~]) rope) - == - :- '.' - ;~ pose - (cook (jock |) ;~(pfix dot perd:so)) - (cook |=(a/wing [%make a ~]) rope) - == - :- ['0' '9'] - %+ cook - |= {a/dime b/(unit twig)} - ?~(b [%sand a] [[%rock a] u.b]) - ;~(plug bisk:so (punt ;~(pfix lus wide))) - :- ':' - ;~ pfix col - ;~ pose - (stag %smcl (ifix [pel per] (most ace wide))) - ;~(pfix fas (stag %smfs wide)) - == - == - :- '=' - (stag %dtts ;~(pfix tis (ifix [pel per] ;~(glam wide wide)))) - :- '?' - ;~ pose - (stag %bcwt ;~(pfix wut (ifix [pel per] (most ace wide)))) - (cold [%base %bean] wut) - == - :- '[' - rupl - :- '^' - ;~ pose - (stag %wing rope) - (cold [%base %cell] ket) - == - :- '`' - ;~ pfix tec - ;~ pose - %+ cook - |=({a/@ta b/twig} [%ktls [%sand a 0] [%ktls [%sand %$ 0] b]]) - ;~(pfix pat ;~(plug mota ;~(pfix tec wide))) - ;~ pfix tar - (stag %kthp (stag [%base %noun] ;~(pfix tec wide))) - == - (stag %kthp ;~(plug wide ;~(pfix tec wide))) - (stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tec wide)))) - (cook |=(a/twig [[%rock %n ~] a]) wide) - == - == - :- '"' - %+ cook - |= a/(list (list woof)) - [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))] - (most dog soil) - :- ['a' 'z'] - rump - :- '|' - ;~ pose - (cook |=(a/wing [%make a ~]) rope) - (stag %or ;~(pfix bar (ifix [pel per] (most ace wide)))) - ;~(plug (stag %rock (stag %f (cold | bar))) ;~(pfix lus wide)) - (stag %sand (stag %f (cold | bar))) - == - :- '~' - ;~ pose - rupl - :: - ;~ pfix sig - ;~ pose - (stag %clsg (ifix [sel ser] (most ace wide))) - :: - %+ stag %open - %+ ifix - [pel per] - ;~(glam rope wide (most ace wide)) - :: - (cook (jock |) twid:so) - (stag [%bust %null] ;~(pfix lus wide)) - (easy [%bust %null]) - == - == - == - :- '/' - rood - :- '<' - (ifix [gal gar] (stag %tell (most ace wide))) - :- '>' - (ifix [gar gal] (stag %yell (most ace wide))) - == - ++ soil - ;~ pose - ;~ less (jest '"""') - %+ ifix [doq doq] - %- star - ;~ pose - ;~(pfix bas ;~(pose bas doq kel bix:ab)) - ;~(less doq bas kel prn) - (stag ~ sump) - == - == - :: - %- iny %+ ifix - [(jest '"""\0a') (jest '\0a"""')] - %- star - ;~ pose - ;~(pfix bas ;~(pose bas kel bix:ab)) - ;~(less bas kel prn) - ;~(less (jest '\0a"""') (just `@`10)) - (stag ~ sump) - == - == - ++ sump (ifix [kel ker] (stag %cltr (most ace wide))) - ++ norm :: rune regular form - |= {rut/? tol/?} - =< ?: rut - %- stew - ^. stet ^. limo - :~ :- '$' - ;~ pfix buc - %- stew - ^. stet ^. limo - :~ ['@' (rune pat %bcpt exqb)] - ['_' (rune cab %bccb expa)] - [':' (rune col %bccl exqs)] - ['%' (rune cen %bccn exqs)] - ['^' (rune ket %bckt exqb)] - ['-' (rune hep %bchp exqb)] - ['=' (rune tis %bcts exqg)] - ['?' (rune wut %bcwt exqs)] - [';' (rune sem %bcsm expa)] - == - == - :- '%' - ;~ pfix cen - %- stew - ^. stet ^. limo - :~ ['^' (rune ket %cnkt exqy)] - ['+' (rune lus %cnls exqx)] - ['-' (rune hep %cnhp exqk)] - [':' (rune col %cnhp exqz)] - == - == - == - %- stew - ^. stet ^. limo - :~ :- '|' - ;~ pfix bar - %- stew - ^. stet ^. limo - :~ ['_' (runo cab %brcb [~ ~] exqr)] - ['%' (runo cen %brcn [~ ~] expe)] - [':' (runo col %brcl [~ ~] expb)] - ['.' (runo dot %brdt [~ ~] expa)] - ['-' (runo hep %brhp [~ ~] expa)] - ['^' (runo ket %brkt [~ ~] expx)] - ['~' (runo sig %brsg [~ ~] expb)] - ['*' (runo tar %brtr [~ ~] exqc)] - ['=' (runo tis %brts [~ ~] exqc)] - ['?' (runo wut %brwt [~ ~] expa)] - == - == - :- '$' - ;~ pfix buc - %- stew - ^. stet ^. limo - :~ ['@' (rune pat %bcpt expb)] - ['_' (rune cab %bccb expa)] - [':' (rune col %bccl exps)] - ['%' (rune cen %bccn exps)] - ['^' (rune ket %bckt expb)] - ['-' (rune hep %bchp expb)] - ['=' (rune tis %bcts expg)] - ['?' (rune wut %bcwt exps)] - [';' (rune sem %bcsm expa)] - == - == - :- '%' - ;~ pfix cen - %- stew - ^. stet ^. limo - :~ ['_' (rune cab %cncb exph)] - ['.' (rune dot %cndt expb)] - ['^' (rune ket %cnkt expd)] - ['+' (rune lus %cnls expc)] - ['-' (rune hep %cnhp expk)] - [':' (rune col %cnhp expi)] - ['~' (rune sig %open expu)] - ['*' (rune tar %cntr expm)] - ['=' (rune tis %make exph)] - == - == - :- ':' - ;~ pfix col - ;~ pose - %- stew - ^. stet ^. limo - :~ ['_' (rune cab %clcb expb)] - ['^' (rune ket %clkt expd)] - ['+' (rune lus %clls expc)] - ['-' (rune hep %clhp expb)] - ['~' (rune sig %clsg exps)] - ['*' (rune tar %cltr exps)] - == - :: - (worn %brcb [~ ~] expr) - (worn %brcn [~ ~] expe) - (worn %brcl [~ ~] expb) - (worn %brdt [~ ~] expa) - (worn %brhp [~ ~] expa) - (worn %brkt [~ ~] expx) - (worn %brsg [~ ~] expb) - (worn %brtr [~ ~] expb) - (worn %brts [~ ~] expb) - (worn %brwt [~ ~] expa) - :: - (word %bunt expa) - (word %bcpt expb) - (word %bccb expa) - (word %bccl exps) - (word %bccn exps) - (word %bckt expb) - (word %bchp expb) - (word %bcts expg) - (word %bcwt exps) - (word %bcsm expa) - :: - (word %cncb exph) - (word %cndt expb) - (word %cnkt expd) - (word %cnls expc) - (word %cnhp expk) - (word %open expu) - (word %cntr expm) - (word %make exph) - :: - (word %clcb expb) - (word %clkt expd) - (word %clls expc) - (word %clhp expb) - (word %clsg exps) - (word %cltr exps) - :: - (word %dtls expa) - (word %dttr expb) - (word %dtts expb) - (word %dtwt expa) - (word %dtkt exqn) - :: - (word %ktbr expa) - (word %ktdt expb) - (word %kthp expb) - (word %ktls expb) - (word %ktpm expa) - (word %ktsg expa) - (word %ktts expg) - (word %ktwt expa) - :: - (word %show expb) - (word %poll expf) - (word %lurk expb) - (word %fast hind) - (word %funk hine) - (word %thin hinb) - (word %hint hinb) - (word %memo hinc) - (word %dump hinf) - (word %warn hing) - (word %ddup expb) - (word %peep expb) - :: - (word %smcl expi) - (word %smfs expa) - (word %smsg expi) - (word %smsm expb) - :: - (word %new expb) - (word %set expq) - (word %huh expw) - (word %sip expt) - (word %fix expp) - (word %rap expb) - (word %var expo) - (word %rev expo) - (word %per expb) - (word %nip expb) - (word %aka expl) - (word %pin expb) - (word %tow expi) - (word %use expb) - :: - (word %or exps) - (word %if expc) - (word %lest expc) - (word %deny expb) - (word %sure expb) - ;~(pfix (jest %case) (toad tkhp)) - ;~(pfix (jest %ifcl) (toad tkkt)) - ;~(pfix (jest %fits) (toad tkts)) - ;~(pfix (jest %deft) (toad tkls)) - (word %and exps) - ;~(pfix (jest %ifat) (toad tkpt)) - ;~(pfix (jest %ifno) (toad tksg)) - (word %not expa) - :: - (word %twig expb) - (word %spit expb) - (word %wrap expa) - (word %code expa) - (word %need hinh) - moar - == - == - :- '.' - ;~ pfix dot - %- stew - ^. stet ^. limo - :~ ['+' (rune lus %dtls expa)] - ['*' (rune tar %dttr expb)] - ['=' (rune tis %dtts expb)] - ['?' (rune wut %dtwt expa)] - ['^' (rune ket %dtkt exqn)] - == - == - :- '^' - ;~ pfix ket - %- stew - ^. stet ^. limo - :~ ['|' (rune bar %ktbr expa)] - ['.' (rune dot %ktdt expb)] - ['-' (rune hep %kthp exqc)] - ['+' (rune lus %ktls expb)] - ['&' (rune pam %ktpm expa)] - ['~' (rune sig %ktsg expa)] - ['=' (rune tis %ktts expg)] - ['?' (rune wut %ktwt expa)] - == - == - :- '~' - ;~ pfix sig - %- stew - ^. stet ^. limo - :~ ['|' (rune bar %show expb)] - ['$' (rune buc %poll expg)] - ['_' (rune cab %lurk expb)] - ['%' (rune cen %fast hind)] - ['/' (rune fas %funk hine)] - ['<' (rune gal %thin hinb)] - ['>' (rune gar %hint hinb)] - ['+' (rune lus %memo hinc)] - ['&' (rune pam %dump hinf)] - ['?' (rune wut %warn hing)] - ['=' (rune tis %ddup expb)] - ['!' (rune zap %peep expb)] - == - == - :- ';' - ;~ pfix sem - %- stew - ^. stet ^. limo - :~ [':' (rune col %smcl expi)] - ['/' (rune fas %smfs expa)] - ['~' (rune sig %smsg expi)] - [';' (rune sem %smsm expb)] - == - == - :- '=' - ;~ pfix tis - %- stew - ^. stet ^. limo - :~ ['|' (rune bar %new exqc)] - ['.' (rune dot %set expq)] - ['?' (rune wut %huh expw)] - ['^' (rune ket %sip expt)] - [':' (rune col %fix expp)] - ['/' (rune fas %var expo)] - [';' (rune sem %rev expo)] - ['<' (rune gal %rap expb)] - ['>' (rune gar %per expb)] - ['-' (rune hep %nip expb)] - ['*' (rune tar %aka expl)] - [',' (rune com %use expb)] - ['+' (rune lus %pin expb)] - ['~' (rune sig %tow expi)] - == - == - :- '?' - ;~ pfix wut - %- stew - ^. stet ^. limo - :~ ['|' (rune bar %or exps)] - [':' (rune col %if expc)] - ['.' (rune dot %lest expc)] - ['<' (rune gal %deny expb)] - ['>' (rune gar %sure expb)] - ['-' ;~(pfix hep (toad tkhp))] - ['^' ;~(pfix ket (toad tkkt))] - ['=' ;~(pfix tis (toad tkts))] - ['+' ;~(pfix lus (toad tkls))] - ['&' (rune pam %and exps)] - ['@' ;~(pfix pat (toad tkpt))] - ['~' ;~(pfix sig (toad tksg))] - ['!' (rune zap %not expa)] - == - == - :- '!' - ;~ pfix zap - %- stew - ^. stet ^. limo - :~ [':' ;~(pfix col (toad expz))] - ['.' ;~(pfix dot (toad |.(loaf(bug |))))] - [',' (rune com %twig expb)] - [';' (rune sem %spit expb)] - ['>' (rune gar %wrap expa)] - ['=' (rune tis %code expa)] - ['?' (rune wut %need hinh)] - == - == - == - |% - ++ boog :: core arms - %+ knee [p=*term q=*(pair what foot)] |. ~+ - %+ cook - |= {a/whit b/term c/whit d/foot} - =+ e=(glom a c) - [b boy.e d] - ;~ plug - apex:docs - ;~ pfix lus - ;~ pose - %+ cook - |=({a/$ash b/term c/whit d/twig} [b c a d]) - ;~ plug - (cold %ash (just '+')) - ;~(pfix gap ;~(pose (cold %$ buc) sym)) - apse:docs - ;~(pfix gap loaf) - == - :: - %+ cook - |=({a/$elm b/term c/whit d/twig} [b c a d]) - ;~ plug - (cold %elm (just '-')) - ;~(pfix gap ;~(pose (cold %$ buc) sym)) - apse:docs - ;~(pfix gap loaf) - == - :: - %+ cook - |=({a/$ash b/term c/whit d/root} [b c a d]) - ;~ plug - (cold %ash (just '=')) - ;~(pfix gap sym) - apse:docs - ;~(pfix gap loan) - == - == - == - == - :: - ++ whap :: chapter - (most muck boog) - :: - ++ wisp :: core tail - ?. tol fail - %+ sear - |= a/(list (pair whit (list (pair term (pair what foot))))) - =| {b/(map @ tomb) c/@} - |- ^- (unit (map @ tomb)) - ?~ a `b - =/ d - =| e/(map term (pair what foot)) - |- ^- (unit (map term (pair what foot))) - ?~ q.i.a `e - ?: ?| (~(has by e) p.i.q.i.a) - |- ^- ? - ?: =(0 c) | - =. c (dec c) - |((~(has by q:(~(got by b) c)) p.i.q.i.a) $) - == - :: XX hokey, refactor this to produce %eror - :: - ~&(duplicate-arm+p.i.q.i.a ~) - $(q.i.a t.q.i.a, e (~(put by e) p.i.q.i.a q.i.q.i.a)) - ?~ d ~ - =* hap `chap`[?~(lab.p.i.a ~ [u.lab.p.i.a ~]) boy.p.i.a] - $(a t.a, b (~(put by b) c [hap u.d]), c +(c)) - ;~ pose - dun - ;~ sfix - ;~ pose - (most muck ;~(plug apex:docs ;~(pfix ;~(plug lus bar gap) whap))) - ;~(plug ;~(plug (easy *whit) whap) (easy ~)) - == - ;~(plug gap dun) - == - == - :: - ++ toad :: untrap parser exp - |* har/_expa - =+ dur=(ifix [pel per] $:har(tol |)) - ?:(tol ;~(pose ;~(pfix gap $:har(tol &)) dur) dur) - :: - ++ rune :: build rune - |* {dif/rule tuq/* har/_expa} - ;~(pfix dif (stag tuq (toad har))) - :: - ++ runo :: rune plus - |* {dif/rule hil/* tuq/* har/_expa} - ;~(pfix dif (stag hil (stag tuq (toad har)))) - :: - ++ word :: build keyword - |* {key/cord har/_expa} - ;~(pfix (jest key) (stag key (toad har))) - :: - ++ worn :: padded keyword - |* {key/cord tuq/* har/_expa} - ;~(pfix (jest key) (stag key (stag tuq (toad har)))) - :: - ++ moar :: :moar hack - %+ cook - |= {a/(list) b/(list (pair wing twig))} - ^- twig - [%make [[%| (lent a) `%$] ~] b] - ;~(pfix (jest %moar) ;~(plug (star (jest %r)) (toad |.((butt rick))))) - :: - ++ glop ~+((glue mash)) :: separated by space - ++ gunk ~+((glue muck)) :: separated list - ++ butt |* zor/rule :: closing == if tall - ?:(tol ;~(sfix zor ;~(plug gap duz)) zor) - ++ ulva |* zor/rule :: closing -- and tall - ?.(tol fail ;~(sfix zor ;~(plug gap dun))) - ++ hank (most muck loaf) :: gapped twigs - ++ hunk (most muck loan) :: gapped roots - ++ loaf ?:(tol tall wide) :: tall/wide twig - ++ loan ?:(tol till wyde) :: tall/wide root - ++ mash ?:(tol gap ;~(plug com ace)) :: list separator - ++ muck ?:(tol gap ace) :: general separator - ++ teak %+ knee *tiki |. ~+ :: wing or twig - =+ ^= gub - |= {a/term b/$%({$& p/wing} {$| p/twig})} - ^- tiki - ?-(-.b $& [%& [~ a] p.b], $| [%| [~ a] p.b]) - =+ ^= wyp - ;~ pose - %+ cook gub - ;~ plug - sym - ;~(pfix tis ;~(pose (stag %& rope) (stag %| wide))) - == - :: - (stag %& (stag ~ rope)) - (stag %| (stag ~ wide)) - == - ?. tol wyp - ;~ pose - wyp - :: - ;~ pfix - ;~(plug ket tis gap) - %+ cook gub - ;~ plug - sym - ;~(pfix gap ;~(pose (stag %& rope) (stag %| tall))) - == - == - :: - (stag %| (stag ~ tall)) - == - ++ rack (most mash ;~(gunk loaf loaf)) :: list [twig twig] - ++ ruck (most mash ;~(gunk loan loaf)) :: list [root twig] - ++ rick (most mash ;~(gunk rope loaf)) :: list [wing twig] - :: - :: twig contents - :: - ++ expa |.(loaf) :: one twig - ++ expb |.(;~(gunk loaf loaf)) :: two twigs - ++ expc |.(;~(gunk loaf loaf loaf)) :: three twigs - ++ expd |.(;~(gunk loaf loaf loaf loaf)) :: four twigs - ++ expe |.(wisp) :: core tail - ++ expf |.(;~(gunk ;~(pfix cen sym) loaf)) :: %term and twig - ++ expg |.(;~(gunk sym loaf)) :: term and twig - ++ exph |.((butt ;~(gunk rope rick))) :: wing, [tile twig]s - ++ expi |.((butt ;~(gunk loaf hank))) :: one or more twigs - ++ expk |.(;~(gunk loaf ;~(plug loaf (easy ~)))) :: list of two twigs - ++ expl |.(;~(gunk ;~(plug (easy ~) sym) loaf loaf)) :: term, two twigs - ++ expm |.((butt ;~(gunk rope loaf rick))) :: several [tile twig]s - ++ expo |.(;~(gunk wise loaf loaf)) :: =; - ++ expp |.(;~(gunk (butt rick) loaf)) :: [wing twig]s, twig - ++ expq |.(;~(gunk rope loaf loaf)) :: wing and two twigs - ++ expr |.(;~(gunk loaf wisp)) :: twig and core tail - ++ exps |.((butt hank)) :: closed gapped twigs - ++ expt |.(;~(gunk wise rope loaf loaf)) :: =^ - ++ expu |.(;~(gunk rope loaf (butt hank))) :: wing, twig, twigs - ++ expv |.((butt rick)) :: just changes - ++ expw |.(;~(gunk rope loaf loaf loaf)) :: wing and three twigs - ++ expx |. ;~ gunk loaf :: twig and core tail - %+ sear :: - |= a/(map @ tomb) :: - ^- (unit (map @ tomb)) :: - =* fir (~(got by a) 0) :: - ?: (~(has by q.fir) %$) :: %$ in first chapter - ~ :: - [~ u=a] :: - wisp :: - == :: - ++ expz |.(loaf(bug &)) :: twig with tracing - :: root contents - :: - ++ exqb |.(;~(gunk loan loan)) :: two roots - ++ exqc |.(;~(gunk loan loaf)) :: root then twig - ++ exqs |.((butt hunk)) :: closed gapped roots - ++ exqg |.(;~(gunk sym loan)) :: term and root - ++ exqk |.(;~(gunk loaf ;~(plug loan (easy ~)))) :: twig with one root - ++ exqr |.(;~(gunk loan wisp)) :: root and core tail - ++ exqn |.(;~(gunk loan (stag %cltr (butt hank)))):: autoconsed twigs - ++ exqw |.(;~(gunk loaf loan)) :: twig and root - ++ exqx |.(;~(gunk loaf loan loan)) :: twig, two roots - ++ exqy |.(;~(gunk loaf loan loan loan)) :: twig, three roots - ++ exqz |.(;~(gunk loaf (butt hunk))) :: twig, n roots - :: - :: tiki expansion for %wt runes - :: - ++ tkhp |. %+ cook |= {a/tiki b/(list (pair root twig))} - (~(wthp ah a) b) - (butt ;~(gunk teak ruck)) - ++ tkkt |. %+ cook |= {a/tiki b/twig c/twig} - (~(wtkt ah a) b c) - ;~(gunk teak loaf loaf) - ++ tkls |. %+ cook |= {a/tiki b/twig c/(list (pair root twig))} - (~(wtls ah a) b c) - (butt ;~(gunk teak loaf ruck)) - ++ tkpt |. %+ cook |= {a/tiki b/twig c/twig} - (~(wtpt ah a) b c) - ;~(gunk teak loaf loaf) - ++ tksg |. %+ cook |= {a/tiki b/twig c/twig} - (~(wtsg ah a) b c) - ;~(gunk teak loaf loaf) - ++ tkts |. %+ cook |= {a/root b/tiki} - (~(wtts ah b) a) - ;~(gunk loan teak) - :: - :: hint syntax - :: - ++ hinb |.(;~(gunk bont loaf)) :: hint and twig - ++ hinc |. :: optional =en, twig - ;~(pose ;~(gunk bony loaf) ;~(plug (easy ~) loaf)) - ++ hind |.(;~(gunk bonk loaf bonz loaf)) :: jet twig "bon"s twig - ++ hine |.(;~(gunk bonk loaf)) :: jet-hint and twig - ++ hinf |. :: 0-3 >s, two twigs - ;~ pose - ;~(gunk (cook lent (stun [1 3] gar)) loaf loaf) - (stag 0 ;~(gunk loaf loaf)) - == - ++ hing |. :: 0-3 >s, three twigs - ;~ pose - ;~(gunk (cook lent (stun [1 3] gar)) loaf loaf loaf) - (stag 0 ;~(gunk loaf loaf loaf)) - == - ++ bonk :: jet signature - ;~ pfix cen - ;~ pose - ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot ;~(pfix dot dem))))) - ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot dem)))) - ;~(plug sym ;~(pfix dot dem)) - sym - == - == - ++ hinh |. :: 1/2 numbers, twig - ;~ gunk - ;~ pose - dem - (ifix [sel ser] ;~(plug dem ;~(pfix ace dem))) - == - loaf - == - ++ bont ;~ (bend) :: term, optional twig - ;~(pfix cen sym) - ;~(pfix dot ;~(pose wide ;~(pfix muck loaf))) - == - ++ bony (cook |=(a/(list) (lent a)) (plus tis)) :: base 1 =en count - ++ bonz :: term-labelled twigs - ;~ pose - (cold ~ sig) - %+ ifix - ?:(tol [;~(plug duz gap) ;~(plug gap duz)] [pel per]) - (more mash ;~(gunk ;~(pfix cen sym) loaf)) - == - -- - :: - ++ lang :: lung sample - $: ros/twig - $= vil - $% {$tis p/twig} - {$col p/twig} - {$ket p/twig} - {$fas p/twig} - {$pel p/(list (pair wing twig))} - == - == - :: - ++ lung - ~+ - %- bend - |= lang - ^- (unit twig) - ?- -.vil - $col ?:(=([%base %bean] ros) ~ [~ %rap ros p.vil]) - $pel (bind ~(reek ap ros) |=(hyp/wing [%make hyp p.vil])) - $ket [~ ros p.vil] - $fas =+ tog=~(hock ap ros) - ?.(?=(@ tog) ~ [~ %bcts tog p.vil]) - $tis =+ tog=~(hock ap ros) - ?:(=([%0 ~] tog) ~ [~ %ktts tog p.vil]) - == - :: - ++ long - %+ knee *twig |. ~+ - ;~ lung - scat - ;~ pose - ;~(plug (cold %tis tis) wide) - ;~(plug (cold %col col) wide) - ;~(plug (cold %ket ket) wide) - ;~(plug (cold %fas fas) wide) - ;~ plug - (easy %pel) - (ifix [pel per] lobo) - == - == - == - :: - ++ lobo (most ;~(plug com ace) ;~(glam rope wide)) - ++ loon (most ;~(plug com ace) ;~(glam wide wide)) - ++ lute :: tall [] noun - ~+ - %+ stag %cltr - %+ ifix - [;~(plug sel gap) ;~(plug gap ser)] - (most gap tall) - :: - ++ rope :: wing form - %+ knee *wing - |. ~+ - %+ (slug |=({a/limb b/wing} [a b])) - dot - ;~ pose - (cold [%| 0 ~] com) - %+ cook - |=({a/(list) b/term} ?~(a b [%| (lent a) `b])) - ;~(plug (star ket) ;~(pose sym (cold %$ buc))) - :: - %+ cook - |=(a/axis [%& a]) - ;~ pose - ;~(pfix lus 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) - == - == - :: - ++ wise ;~(plug sym (punt ;~(pfix ;~(pose fas tis) wyde))) - ++ wrap - |* fel/rule - %+ cook - |= {a/whit b/twig c/whit} - ^- twig - ~(graf ~(gi ap b) (glom a c)) - :: - :: XX performance: this makes the parser about 50% slower. - :: because we double-parse most of the spaces in the file. - :: just so we can do a postfix doc-comment. - :: - :: the correct solution to this problem is to unify the - :: parsing of docs with the parsing of comments/spaces. - :: but at this point we're pretty much in parser rewrite. - :: - :: it should go without saying that ++vast needs a rewrite. - :: it dates to 2011. - :: - ;~ plug - apex:docs - fel - apse:docs - == - ++ tall %+ knee *twig :: full tall form - |.(~+((wart (wrap ;~(pose (norm | &) long lute ape:(sail &)))))) - ++ till %+ knee *root :: full tall form - |.(~+((wart (wrap ;~(pose (norm & &) scad))))) - ++ wide %+ knee *twig :: full wide form - |.(~+((wart ;~(pose (norm | |) long ape:(sail |))))) - ++ wyde %+ knee *root :: full wide form - |.(~+((wart ;~(pose (norm & |) scad)))) - ++ wart - |* zor/rule - %+ here - |= {a/pint b/twig} - ?:(bug [%dbug [wer a] b] b) - zor - -- -:: -++ vest - ~/ %vest - |= tub/nail - ~| %vest - ^- (like twig) - %. tub - %- full - (ifix [gay gay] tall:vast) -:: -++ vice - |= txt/@ta - ^- twig - (rash txt wide:vast) -:: -++ make :: compile cord to nock - |= txt/@ - q:(~(mint ut %noun) %noun (ream txt)) -:: -++ rain :: parse with % path - |= {bon/path txt/@} - ^- twig - =+ vaz=vast - ~| bon - (scan (trip txt) (full (ifix [gay gay] tall:vaz(wer bon)))) -:: -++ ream :: parse cord to twig - |= txt/@ - ^- twig - (rash txt vest) -:: -++ reck :: parse hoon file - |= bon/path - (rain bon .^(@t %cx (weld bon `path`[%hoon ~]))) -:: -++ ride :: end-to-end compiler - |= {typ/span txt/@} - ^- (pair span nock) - (~(mint ut typ) %noun (ream txt)) -:: -:::: 5e: caching compiler - :: -++ wa !: :: cached compile - |_ worm - ++ nell |=(ref/span (nest [%cell %noun %noun] ref)) :: nest in cell - ++ nest :: nest:ut - |= {sut/span ref/span} - ^- {? worm} - ?: (~(has in nes) [sut ref]) [& +>+<] - ?. (~(nest ut sut) | ref) - ~& %nest-failed - =+ foo=(skol ref) - =+ bar=(skol sut) - ~& %nets-need - ~> %slog.[0 bar] - ~& %nest-have - ~> %slog.[0 foo] - [| +>+<.$] - [& +>+<(nes (~(put in nes) [sut ref]))] - :: - ++ call :: call gate - |= {vax/vase nam/term som/(each vase ^)} - ^- {vase worm} - =^ duf +>+<.$ (open vax nam som) - (slap duf [%limb %$]) - :: - ++ open :: assemble door - |= {vax/vase nam/term som/(each vase ^)} - ^- {vase worm} - =* key [%cncb [[%& 2] ~] [[[%& 6] ~] [%$ 3]] ~] - =^ dor +>+<.$ (slap vax [%limb nam]) - =^ mes +>+<.$ (slot 6 dor) - =^ hip +>+<.$ - ?- -.som - $& (nest p.mes p.p.som) - $| (nets p.mes -.p.som) - == - ?> hip - [[p.dor q.dor(+6 +7.som)] +>+<.$] - :: - ++ neat :: type compliance - |= {typ/span som/(each vase ^)} - ^- worm - =^ hip +>+<.$ - ?- -.som - $& (nest typ p.p.som) - $| (nets typ -.p.som) - == - ?> hip - +>+<.$ - :: - ++ nets :: spanless nest - |= {sut/* ref/*} - ^- {? worm} - ?: (~(has in nes) [sut ref]) [& +>+<] - =+ gat=|=({a/span b/span} (~(nest ut a) | b)) - ?. (? .*(gat(+< [sut ref]) -.gat)) - ~& %nets-failed - =+ tag=`*`skol - =+ foo=(tank .*(tag(+< ref) -.tag)) - =+ bar=(tank .*(tag(+< sut) -.tag)) - ~& %nets-need - ~> %slog.[0 bar] - ~& %nets-have - ~> %slog.[0 foo] - [| +>+<.$] - [& +>+<.$(nes (~(put in nes) [sut ref]))] - :: - ++ play :: play:ut - |= {sut/span gen/twig} - ^- {span worm} - =+ old=(~(get by pay) [sut gen]) - ?^ old [u.old +>+<.$] - =+ new=(~(play ut sut) gen) - [new +>+<.$(pay (~(put by pay) [sut gen] new))] - :: - ++ mint :: mint:ut to noun - |= {sut/span gen/twig} - ^- {(pair span nock) worm} - =+ old=(~(get by mit) [sut gen]) - ?^ old [u.old +>+<.$] - =+ new=(~(mint ut sut) %noun gen) - [new +>+<.$(mit (~(put by mit) [sut gen] new))] - :: - ++ slap :: ++slap, cached - |= {vax/vase gen/twig} - ^- {vase worm} - =^ gun +>+< (mint p.vax gen) - [[p.gun .*(q.vax q.gun)] +>+<.$] - :: - ++ slot :: ++slot, cached - |= {axe/@ vax/vase} - ^- {vase worm} - =^ gun +>+< (mint p.vax [%$ axe]) - [[p.gun .*(q.vax [0 axe])] +>+<.$] - :: - ++ spec :: specialize vase - |= vax/vase - ^- {vase worm} - =+ ^= gen ^- twig - ?@ q.vax [%fits [%base [%atom %$]] [%& 1]~] - ?@ -.q.vax [%fits [%leaf %tas -.q.vax] [%& 2]~] - [%fits [%base %cell] [%& 1]~] - =^ typ +>+<.$ (play p.vax [%sure gen [%$ 1]]) - [[typ q.vax] +>+<.$] - :: - ++ spot :: slot then spec - |= {axe/@ vax/vase} - ^- {vase worm} - =^ xav +>+< (slot axe vax) - (spec xav) - :: - ++ stop :: spec then slot - |= {axe/@ vax/vase} - ^- {vase worm} - =^ xav +>+< (spec vax) - (slot axe xav) - -- -:: -:::: 5f: molds and mold builders - :: -++ arch {fil/(unit @uvI) dir/(map @ta $~)} :: fundamental node -++ ares (unit {p/term q/(list tank)}) :: possible error -++ arvo (wind {p/term q/mill} mill) :: arvo card -++ beam {{p/ship q/desk r/case} s/spur} :: global name -++ beak {p/ship q/desk r/case} :: path prefix -++ bone @ud :: opaque duct -++ case :: version - $% {$da p/@da} :: date - {$tas p/@tas} :: label - {$ud p/@ud} :: sequence - == :: -++ coop (unit ares) :: possible error -++ desk @tas :: ship desk case spur -++ cage (cask vase) :: global metadata -++ cask |*(a/$-(* *) (pair mark a)) :: global data -++ cuff :: permissions - $: p/(unit (set monk)) :: can be read by - q/(set monk) :: caused or created by - == :: -++ curd {p/@tas q/*} :: spanless card -++ dock (pair @p term) :: message target -++ duct (list wire) :: causal history -++ hypo |*(a/$-(* *) (pair span a)) :: span associated -++ hobo |* a/$-(* *) :: task wrapper - $? $% {$soft p/*} :: - == :: - a :: - == :: -++ json :: normal json value - $@ $~ :: null - $% {$a p/(list json)} :: array - {$b p/?} :: boolean - {$o p/(map @t json)} :: object - {$n p/@ta} :: number - {$s p/@t} :: string - == :: -++ kirk (unit (set monk)) :: audience -++ lens :: observation core - $_ ^? :: - |% ++ u *(unit (unit $~)) :: existence - ++ v *(unit (unit cage)) :: full history - ++ w *(unit (unit (unit cage))) :: latest diff - ++ x *(unit (unit cage)) :: data at path - ++ y *(unit (unit arch)) :: directory - ++ z *(unit (unit cage)) :: current subtree - -- :: -++ mane $@(@tas {@tas @tas}) :: XML name+space -++ manx {g/marx c/marl} :: XML node -++ marc :: structured mark - $@ mark :: plain mark - $% {$tabl p/(list (pair marc marc))} :: map - == :: -++ mark @tas :: content span -++ marl (list manx) :: XML node list -++ mars {t/{n/$$ a/{i/{n/$$ v/tape} t/$~}} c/$~} :: XML cdata -++ mart (list {n/mane v/tape}) :: XML attributes -++ marx {n/mane a/mart} :: XML tag -++ mash |=(* (mass +<)) :: producing mass -++ mass (pair cord (each noun (list mash))) :: memory usage -++ mill (each vase milt) :: vase+metavase -++ milt {p/* q/*} :: metavase -++ mime {p/mite q/octs} :: mimetyped data -++ mite (list @ta) :: mime type -++ monk (each ship {p/@tas q/@ta}) :: general identity -++ muse {p/@tas q/duct r/arvo} :: sourced move -++ move {p/duct q/arvo} :: arvo move -++ octs {p/@ud q/@t} :: octet-stream -++ ovum {p/wire q/curd} :: spanless ovum -++ pane (list {p/@tas q/vase}) :: kernel modules -++ pass @ :: public key -++ pone (list {p/@tas q/vise}) :: kernel modules old -++ ring @ :: private key -++ ship @p :: network identity -++ shop (each ship (list @ta)) :: urbit/dns identity -++ sink (trel bone ship path) :: subscription -++ sley $- {* (unit (set monk)) term beam} :: namespace function - (unit (unit cage)) :: -++ slyd $- {* (unit (set monk)) term beam} :: super advanced - (unit (unit (cask))) :: -++ slyt $-({* *} (unit (unit))) :: old namespace -++ sack {p/ship q/ship} :: incoming [our his] -++ scar :: opaque duct - $: p/@ud :: bone sequence - q/(map duct bone) :: by duct - r/(map bone duct) :: by bone - == :: -++ sock {p/ship q/ship} :: outgoing [our his] -++ spur path :: ship desk case spur -++ time @da :: galactic time -++ vile :: reflexive constants - $: typ/span :: -:!>(*span) - duc/span :: -:!>(*duct) - pah/span :: -:!>(*path) - mev/span :: -:!>([%meta *vase]) - == :: -++ wind :: new kernel action - |* {a/$-(* *) b/$-(* *)} :: forward+reverse - $% {$pass p/path q/a} :: advance - {$slip p/a} :: lateral - {$give p/b} :: retreat - == :: -++ wire path :: event pretext -:: -:::: 5g: profiling support (XX move) - :: -++ doss - $: mon/moan :: sample count - hit/(map term @ud) :: hit points - cut/(map path hump) :: cut points - == -++ moan :: sample metric - $: fun/@ud :: samples in C - noc/@ud :: samples in nock - glu/@ud :: samples in glue - mal/@ud :: samples in alloc - far/@ud :: samples in frag - coy/@ud :: samples in copy - euq/@ud :: samples in equal - == :: -:: -++ hump - $: mon/moan :: sample count - out/(map path @ud) :: calls out of - inn/(map path @ud) :: calls into - == -:: -++ pi-heck - |= {nam/@tas day/doss} - ^- doss - =+ lam=(~(get by hit.day) nam) - day(hit (~(put by hit.day) nam ?~(lam 1 +(u.lam)))) -:: -++ pi-noon !. :: sample trace - |= {mot/term paz/(list path) day/doss} - =| lax/(unit path) - |- ^- doss - ?~ paz day(mon (pi-mope mot mon.day)) - %= $ - paz t.paz - lax `i.paz - cut.day - %+ ~(put by cut.day) i.paz - ^- hump - =+ nax=`(unit path)`?~(t.paz ~ `i.t.paz) - =+ hup=`hump`=+(hup=(~(get by cut.day) i.paz) ?^(hup u.hup [*moan ~ ~])) - :+ (pi-mope mot mon.hup) - ?~ lax out.hup - =+ hag=(~(get by out.hup) u.lax) - (~(put by out.hup) u.lax ?~(hag 1 +(u.hag))) - ?~ nax inn.hup - =+ hag=(~(get by inn.hup) u.nax) - (~(put by inn.hup) u.nax ?~(hag 1 +(u.hag))) - == -++ pi-mope :: add sample - |= {mot/term mon/moan} - ?+ mot mon - $fun mon(fun +(fun.mon)) - $noc mon(noc +(noc.mon)) - $glu mon(glu +(glu.mon)) - $mal mon(mal +(mal.mon)) - $far mon(far +(far.mon)) - $coy mon(coy +(coy.mon)) - $euq mon(euq +(euq.mon)) - == -++ pi-moth :: count sample - |= mon/moan ^- @ud - :(add fun.mon noc.mon glu.mon mal.mon far.mon coy.mon euq.mon) -:: -++ pi-mumm :: print sample - |= mon/moan ^- tape - =+ tot=(pi-moth mon) - ;: welp - ^- tape - ?: =(0 noc.mon) ~ - (welp (scow %ud (div (mul 100 noc.mon) tot)) "n ") - :: - ^- tape - ?: =(0 fun.mon) ~ - (welp (scow %ud (div (mul 100 fun.mon) tot)) "c ") - :: - ^- tape - ?: =(0 glu.mon) ~ - (welp (scow %ud (div (mul 100 glu.mon) tot)) "g ") - :: - ^- tape - ?: =(0 mal.mon) ~ - (welp (scow %ud (div (mul 100 mal.mon) tot)) "m ") - :: - ^- tape - ?: =(0 far.mon) ~ - (welp (scow %ud (div (mul 100 far.mon) tot)) "f ") - :: - ^- tape - ?: =(0 coy.mon) ~ - (welp (scow %ud (div (mul 100 coy.mon) tot)) "y ") - :: - ^- tape - ?: =(0 euq.mon) ~ - (welp (scow %ud (div (mul 100 euq.mon) tot)) "e ") - == -:: -++ pi-tell :: produce dump - |= day/doss - ^- (list tape) - ?: =(day *doss) ~ - =+ tot=(pi-moth mon.day) - ;: welp - [(welp "events: " (pi-mumm mon.day)) ~] - :: - %+ turn - (~(tap by hit.day) ~) - |= {nam/term num/@ud} - :(welp (trip nam) ": " (scow %ud num)) - ["" ~] - :: - %- zing - ^- (list (list tape)) - %+ turn - %+ sort (~(tap by cut.day)) - |= {one/(pair path hump) two/(pair path hump)} - (gth (pi-moth mon.q.one) (pi-moth mon.q.two)) - |= {pax/path hup/hump} - =+ ott=(pi-moth mon.hup) - ;: welp - [(welp "label: " (spud pax)) ~] - [(welp "price: " (scow %ud (div (mul 100 ott) tot))) ~] - [(welp "shape: " (pi-mumm mon.hup)) ~] - :: - ?: =(~ out.hup) ~ - :- "into:" - %+ turn - %+ sort (~(tap by out.hup) ~) - |=({{* a/@ud} {* b/@ud}} (gth a b)) - |= {pax/path num/@ud} - ^- tape - :(welp " " (spud pax) ": " (scow %ud num)) - :: - ?: =(~ inn.hup) ~ - :- "from:" - %+ turn - %+ sort (~(tap by inn.hup) ~) - |=({{* a/@ud} {* b/@ud}} (gth a b)) - |= {pax/path num/@ud} - ^- tape - :(welp " " (spud pax) ": " (scow %ud num)) - :: - ["" ~] - ~ - == - == --- diff --git a/neo/lull.hoon b/neo/lull.hoon deleted file mode 100644 index 2e559f7f9..000000000 --- a/neo/lull.hoon +++ /dev/null @@ -1,1099 +0,0 @@ -!: :: /van/york -:: :: %reference/1 -:: %york: arvo models and metamodels. -:: -:: %york, like the library %zuse, is split into cores for -:: arvo's eight major vanes (kernel modules). these are: -:: -:: - %ames: networking (rhymes with "games") -:: - %behn: scheduling ("bane") -:: - %clay: revision control ("play") -:: - %dill: console ("pill") -:: - %eyre: web ("fair") -:: - %ford: build ("lord") -:: - %gall: application ("ball") -:: - %jael: security ("jail") -:: -:: any vane can use any of these models, of course. -:: -|% -:: :::: -:::: ++ames :: (1a) network - :: :::: -++ ames ^? - |% - :: :: - :::: ++able:ames :: (1a1) arvo moves - :: :::: - ++ able ^? - |% - ++ card :: out cards - $% {$went p/sack q/path r/@ud s/coop} :: response confirm - {$west p/sack q/path r/@ud s/*} :: network request - == :: - ++ gift :: out result <-$ - $% {$drop $~} :: drop packet - {$hear p/lane q/@} :: receive packet - {$east p/sock q/*} :: network response - {$init p/@p} :: report install - {$mass p/mass} :: memory usage - {$send p/lane q/@} :: transmit packet - {$waft p/ship q/path r/*} :: response message - {$wart p/sock q/@tas r/path s/*} :: network request - {$went p/ship q/cape} :: reaction message - {$woot p/ship q/path r/coop} :: e2e reaction message - == :: - ++ note :: out request $-> - $% {$c card} :: to %clay - {$e card} :: to %eyre - {$g card} :: to %gall - == :: - ++ task :: in request ->$ - $% :: {$born p/@p q/@pG r/?} :: ticket birth - {$barn $~} :: new unix process - {$crud p/@tas q/(list tank)} :: error with trace - {$cash p/@p q/buck} :: civil license - :: {$funk p/@p q/@p r/@} :: symtix from/to/key - {$hear p/lane q/@} :: receive packet - {$hole p/lane q/@} :: packet failed - {$junk p/@} :: entropy - {$kick p/@da} :: wake up - {$make p/(unit @t) q/@ud r/@ s/?} :: wild license - {$sith p/@p q/@uw r/?} :: imperial generator - {$wake $~} :: timer activate - {$want p/sock q/path r/*} :: send message - {$wegh $~} :: report memory - {$wont p/sock q/path r/*} :: e2e send message - == :: - -- ::able - :: - :::: :: (1a2) - :: - ++ acru $_ ^? :: asym cryptosuite - |% :: opaque object - ++ as ^? :: asym ops - |% ++ seal |~({a/pass b/@ c/@} *@) :: encrypt to a - ++ sign |~({a/@ b/@} *@) :: certify as us - ++ sure |~({a/@ b/@} *(unit @)) :: authenticate from us - ++ tear |~ {a/pass b/@} :: accept from a - *(unit {p/@ q/@}) :: - -- ::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/@ ^?(..nu)) :: from naked ring - ++ com |~(a/@ ^?(..nu)) :: from naked pass - -- ::nu :: - -- ::acru :: - ++ bait {p/skin q/@ud r/dove} :: fmt nrecvd spec - ++ boon :: fort output - $% {$beer p/ship} :: gained ownership - {$bier p/ship q/deyd} :: unsigned deyd - {$cake p/sock q/soap r/coop s/duct} :: e2e message result - {$coke p/sock q/soap r/cape s/duct} :: message result - {$mead p/lane q/rock} :: accept packet - {$milk p/sock q/soap r/*} :: accept message - {$mulk p/sock q/soap r/*} :: e2e pass message - {$ouzo p/lane q/rock} :: transmit packet - {$wine p/sock q/tape} :: notify user - == :: - ++ bray {p/life q/(unit life) r/ship s/@da} :: our parent us now - ++ buck {p/mace q/wyll} :: all security data - ++ cake {p/sock q/skin r/@} :: top level packet - ++ cape :: end-to-end result - $? $good :: delivered - $dead :: rejected - == :: - ++ clot :: symmetric record - $: yed/(unit {p/hand q/code}) :: outbound - heg/(map hand code) :: proposed - qim/(map hand code) :: inbound - == :: - ++ code @uvI :: symmetric key - ++ deyd {p/@ q/step r/?} :: sig stage fake? - ++ dore :: foreign contact - $: wod/road :: connection to - wyl/wyll :: inferred mirror - caq/clot :: symmetric key state - == :: - ++ dove {p/@ud q/(map @ud @)} :: count hash 13-blocks - ++ flap @uvH :: network packet id - ++ flow :: packet connection - $: rtt/@dr :: decaying avg rtt - wid/@ud :: logical wdow msgs - == :: - ++ gcos :: id description - $% {$czar $~} :: 8-bit ship - {$duke p/what} :: 32-bit ship - {$earl p/@t} :: 64-bit ship - {$king p/@t} :: 16-bit ship - {$pawn p/(unit @t)} :: 128-bit ship - == :: - ++ gens {p/lang q/gcos} :: general identity - ++ govt path :: country+postcode - ++ hand @uvH :: 128-bit hash - ++ lane :: packet route - $% {$if p/@da q/@ud r/@if} :: IP4/public UDP/addr - {$is p/@ud q/(unit lane) r/@is} :: IPv6 w+alternates - {$ix p/@da q/@ud r/@if} :: IPv4 provisional - == :: - ++ lang @ta :: IETF lang as code - ++ lice {p/ship q/buck} :: full license - ++ life @ud :: regime number - ++ mace (list {p/life q/ring}) :: private secrets - ++ meal :: payload - $% {$back p/cape q/flap r/@dr} :: acknowledgment - {$buck p/coop q/flap r/@dr} :: e2e ack - {$bond p/life q/path r/@ud s/*} :: message - {$bund p/life q/path r/@ud s/*} :: e2e message - {$carp p/@ q/@ud r/@ud s/flap t/@} :: skin+inx+cnt+hash - {$fore p/ship q/(unit lane) r/@} :: forwarded packet - == :: - ++ name {p/@t q/(unit @t) r/(unit @t) s/@t} :: first mid+nick last - ++ putt :: outgoing message - $: ski/snow :: sequence acked+sent - wyv/(list rock) :: packet list XX gear - == :: - ++ race :: inbound stream - $: did/@ud :: filled sequence - dod/? :: not processing - bum/(map @ud ares) :: nacks - mis/(map @ud {p/cape q/lane r/flap s/(unit)}) :: misordered - == :: - ++ rank ?($czar $king $duke $earl $pawn) :: ship width class - ++ rill :: outbound stream - $: sed/@ud :: sent - san/(map @ud duct) :: outstanding - == :: - ++ road :: secured oneway route - $: exp/@da :: expiration date - lun/(unit lane) :: route to friend - lew/wyll :: wyll of friend - == :: - ++ rock @uvO :: packet - ++ sect ?($black $blue $red $orange $white) :: banner - ++ shed :: packet flow - $: $: rtt/@dr :: smoothed rtt - rto/@dr :: retransmit timeout - rtn/(unit @da) :: next timeout - rue/(unit @da) :: last heard from - == :: - $: nus/@ud :: number sent - nif/@ud :: number live - nep/@ud :: next expected - caw/@ud :: logical window - cag/@ud :: congest thresh - == :: - $: diq/(map flap @ud) :: packets sent - pyz/(map soup @ud) :: message+unacked - puq/(qeu {p/@ud q/soul}) :: packet queue - == :: - == :: - ++ skin ?($none $open $fast $full) :: encoding stem - ++ snow {p/@ud q/@ud r/(set @ud)} :: window exceptions - ++ soap {p/{p/life q/life} q/path r/@ud} :: statement id - ++ soup {p/path q/@ud} :: new statement id - ++ soul :: packet in travel - $: gom/soup :: message identity - nux/@ud :: xmission count - liv/? :: deemed live - lys/@da :: last sent - pac/rock :: packet data - == :: - ++ step {p/bray q/gens r/pass} :: identity stage - ++ sufi :: domestic host - $: hoy/(list ship) :: hierarchy - val/wund :: private keys - law/wyll :: server wyll - seh/(map hand {p/ship q/@da}) :: key cache - hoc/(map ship dore) :: neighborhood - == :: - ++ tick @ud :: process id - ++ town :: all security state - $: lit/@ud :: imperial modulus - any/@ :: entropy - urb/(map ship sufi) :: all keys and routes - fak/? :: - == :: - ++ what :: logical identity - $% {$anon $~} :: anonymous - {$lady p/whom} :: female person () - {$lord p/whom} :: male person [] - {$punk p/sect q/@t} :: opaque handle "" - == :: - ++ whom {p/@ud q/govt r/sect s/name} :: year+govt+id - ++ wund (list {p/life q/ring r/acru}) :: mace in action - ++ wyll (list deyd) :: certificate - -- ::ames -:: :::: -:::: ++behn :: (1b) timekeeping - :: :::: -++ behn ^? - |% - :: :: - :::: ++able:behn :: (1b1) arvo moves - :: :::: - ++ able ^? - |% - ++ gift :: out result <-$ - $% {$mass p/mass} :: memory usage - {$wake $~} :: wakeup - == :: - ++ task :: in request ->$ - $% {$rest p/@da} :: cancel alarm - {$wait p/@da} :: set alarm - {$wake $~} :: timer activate - {$wegh $~} :: report memory - == :: - -- ::able - -- ::behn -:: :::: -:::: ++clay :: (1c) versioning - :: :::: -++ clay ^? - |% - :: :: - :::: ++able:clay :: (1c1) arvo moves - :: :::: - ++ able ^? - |% - ++ gift :: out result <-$ - $% {$dirk p/@tas} :: mark mount dirty - {$ergo p/@tas q/mode} :: version update - {$hill p/(list @tas)} :: mount points - {$mack p/(unit tang)} :: ack - {$mass p/mass} :: memory usage - {$mere p/(each (set path) (pair term tang))} :: merge result - {$note p/@tD q/tank} :: debug message - {$ogre p/@tas} :: delete mount point - {$writ p/riot} :: response - == :: - ++ task :: in request ->$ - $% {$boat $~} :: pier rebooted - {$drop p/@p q/desk} :: cancel pending merge - {$info p/@p q/desk r/nori} :: internal edit - {$init p/@p} :: report install - {$into p/desk q/? r/mode} :: external edit - {$merg p/@p q/desk r/@p s/desk t/case u/germ} :: merge desks - {$mont p/desk q/beam} :: mount to unix - {$dirk p/desk} :: mark mount dirty - {$ogre p/$@(desk beam)} :: delete mount point - {$warp p/sock q/riff} :: file request - {$wegh $~} :: report memory - {$went p/sack q/path r/@ud s/coop} :: response confirm - {$west p/sack q/path r/@ud s/*} :: network request - == :: - -- ::able - :: - :::: :: (1c2) - :: - ++ aeon @ud :: version number - ++ ankh :: fs node (new) - $: fil/(unit {p/lobe q/cage}) :: file - dir/(map @ta ankh) :: folders - == :: - ++ beam {{p/ship q/desk r/case} s/path} :: global name - ++ beak {p/ship q/desk r/case} :: path prefix - ++ blob :: fs blob - $% {$delta p/lobe q/{p/mark q/lobe} r/page} :: delta on q - {$direct p/lobe q/page} :: immediate - == :: - ++ care ?($d $u $v $w $x $y $z) :: clay submode - ++ case :: ship desk case spur - $% {$da p/@da} :: date - {$tas p/@tas} :: label - {$ud p/@ud} :: number - == :: - ++ coop (unit ares) :: e2e ack - ++ dome :: project state - $: ank/ankh :: state - let/@ud :: top id - hit/(map @ud tako) :: changes by id - lab/(map @tas @ud) :: labels - == :: - ++ germ :: merge style - $? $init :: new desk - $this :: ours with parents - $that :: hers with parents - $fine :: fast forward - $meet :: orthogonal files - $mate :: orthogonal changes - $meld :: force merge - == :: - ++ khan :: - $: fil/(unit (unit cage)) :: see ++khan-to-soba - dir/(unit (map @ta (unit khan))) :: - == :: - ++ lobe @uvI :: blob ref - ++ maki {p/@ta q/@ta r/@ta s/path} :: - ++ miso :: ankh delta - $% {$del $~} :: delete - {$ins p/cage} :: insert - {$dif p/cage} :: mutate from diff - {$mut p/cage} :: mutate from raw - == :: - ++ misu :: computed delta - $% {$del $~} :: delete - {$ins p/cage} :: insert - {$dif p/lobe q/cage} :: mutate from diff - == :: - ++ mizu {p/@u q/(map @ud tako) r/rang} :: new state - ++ moar {p/@ud q/@ud} :: normal change range - ++ moat {p/case q/case r/path} :: change range - ++ mode (list {path (unit mime)}) :: external files - ++ mood {p/care q/case r/path} :: request in desk - ++ nori :: repository action - $% {$& p/soba} :: delta - {$| p/@tas} :: label - == :: - ++ nuri :: repository action - $% {$& p/suba} :: delta - {$| p/@tas} :: label - == :: - ++ page (cask *) :: untyped cage - ++ plop blob :: unvalidated blob - ++ rang :: repository - $: hut/(map tako yaki) :: changes - lat/(map lobe blob) :: data - == :: - ++ rant :: response to request - $: p/{p/care q/case r/@tas} :: clade release book - q/path :: spur - r/cage :: data - == :: - ++ rave :: general request - $% {$sing p/mood} :: single request - {$next p/mood} :: await next version - {$many p/? q/moat} :: track range - == :: - ++ riff {p/desk q/(unit rave)} :: request+desist - ++ riot (unit rant) :: response+complete - ++ rump {p/care q/case r/@tas s/path} :: relative path - ++ saba {p/ship q/@tas r/moar s/dome} :: patch+merge - ++ soba (list {p/path q/miso}) :: delta - ++ suba (list {p/path q/misu}) :: delta - ++ tako @ :: yaki ref - ++ toro {p/@ta q/nori} :: general change - ++ unce :: change part - |* a/mold :: - $% {$& p/@ud} :: skip[copy] - {$| p/(list a) q/(list a)} :: p -> q[chunk] - == :: - ++ urge |*(a/mold (list (unce a))) :: list change - ++ yaki :: commit - $: p/(list tako) :: parents - q/(map path lobe) :: namespace - r/tako :: self-reference - t/@da :: date - == :: - -- ::clay -:: :::: -:::: ++dill :: (1d) console - :: :::: -++ dill ^? - |% - :: :: - :::: ++able:dill :: (1d1) arvo moves - :: :::: - ++ able ^? - |% - ++ gift :: out result <-$ - $% {$bbye $~} :: reset prompt - {$blit p/(list blit)} :: terminal output - {$burl p/@t} :: activate url - {$init p/@p} :: set owner - {$logo $~} :: logout - {$mass p/mass} :: memory usage - {$veer p/@ta q/path r/@t} :: install vane - {$vega p/path} :: old reboot - {$velo p/@t q/@t} :: reboot - {$verb $~} :: verbose mode - == :: - ++ task :: in request ->$ - $% {$belt p/belt} :: terminal input - {$blew p/blew} :: terminal config - {$boot p/*} :: weird %dill boot - {$crud p/@tas q/(list tank)} :: error with trace - {$flog p/flog} :: wrapped error - {$flow p/@tas q/(list gill:gall)} :: terminal config - {$hail $~} :: terminal refresh - {$heft $~} :: memory report - {$hook $~} :: this term hung up - {$harm $~} :: all terms hung up - {$init p/ship} :: after gall ready - {$tick p/@p q/@p} :: initial ticket - {$noop $~} :: no operation - {$talk p/tank} :: - {$text p/tape} :: - {$veer p/@ta q/path r/@t} :: install vane - {$vega p/path} :: old reboot - {$velo p/@t q/@t} :: reboot - {$verb $~} :: verbose mode - == :: - -- ::able - :: - :::: :: (1d2) - :: - ++ blew {p/@ud q/@ud} :: columns rows - ++ belt :: old belt - $% {$aro p/?($d $l $r $u)} :: arrow key - {$bac $~} :: true backspace - {$ctl p/@c} :: control-key - {$del $~} :: true delete - {$met p/@c} :: meta-key - {$ret $~} :: return - {$txt p/(list @c)} :: utf32 text - == :: - ++ blit :: old blit - $% {$bel $~} :: make a noise - {$clr $~} :: clear the screen - {$hop p/@ud} :: set cursor position - {$lin p/(list @c)} :: set current line - {$mor $~} :: newline - {$sag p/path q/*} :: save to jamfile - {$sav p/path q/@} :: save to file - {$url p/@t} :: activate url - == :: - ++ deco ?($~ $bl $br $un) :: text decoration - ++ dill-belt :: new belt - $% {$aro p/?($d $l $r $u)} :: arrow key - {$bac $~} :: true backspace - {$cru p/@tas q/(list tank)} :: echo error - {$ctl p/@} :: control-key - {$del $~} :: true delete - {$hey $~} :: refresh - {$met p/@} :: meta-key - {$ret $~} :: return - {$rez p/@ud q/@ud} :: resize, cols, rows - {$txt p/(list @c)} :: utf32 text - {$yow p/gill:gall} :: connect to app - == :: - ++ dill-blit :: new blit - $% {$bel $~} :: make a noise - {$clr $~} :: clear the screen - {$hop p/@ud} :: set cursor position - {$klr p/stub} :: styled text - {$mor p/(list dill-blit)} :: multiple blits - {$pom p/stub} :: styled prompt - {$pro p/(list @c)} :: show as cursor+line - {$qit $~} :: close console - {$out p/(list @c)} :: send output line - {$sag p/path q/*} :: save to jamfile - {$sav p/path q/@} :: save to file - {$url p/@t} :: activate url - == :: - ++ flog :: sent to %dill - $% {$crud p/@tas q/(list tank)} :: - {$heft $~} :: - {$text p/tape} :: - {$veer p/@ta q/path r/@t} :: install vane - {$vega p/path} :: old reboot - {$velo p/@t q/@t} :: reboot - {$verb $~} :: verbose mode - == :: - ++ stub (list (pair stye (list @c))) :: styled tuba - ++ stye (pair (set deco) (pair tint tint)) :: decos/bg/fg - ++ styl :: cascading stye - %+ pair (unit deco) :: - (pair (unit tint) (unit tint)) :: - :: :: - ++ styx (list $@(@t (pair styl styx))) :: styled text - ++ tint ?($~ $r $g $b $c $m $y $k $w) :: text color - -- ::dill -:: :::: -:::: ++eyre :: (1e) oldweb - :: :::: -++ eyre ^? - |% - :: :: - :::: ++able:eyre :: (1e1) arvo moves - :: :::: - ++ able ^? - |% - ++ gift :: out result <-$ - $% {$mass p/mass} :: memory usage - {$mack p/(unit tang)} :: message ack - {$sigh p/cage} :: marked http response - {$thou p/httr} :: raw http response - {$thus p/@ud q/(unit hiss)} :: http request+cancel - {$veer p/@ta q/path r/@t} :: drop-through - {$vega p/path} :: drop-through - {$velo p/@t q/@t} :: drop-through - {$mini-jael-gift *} - == :: - ++ task :: in request ->$ - $% {$born $~} :: new unix process - {$crud p/@tas q/(list tank)} :: XX rethink - {$hiss p/(unit user) q/mark r/cage} :: outbound user req - {$init p/@p} :: report install - {$serv p/$@(desk beam)} :: set serving root - {$them p/(unit hiss)} :: outbound request - {$they p/@ud q/httr} :: inbound response - {$chis p/? q/clip r/httq} :: IPC inbound request - {$this p/? q/clip r/httq} :: inbound request - {$thud $~} :: inbound cancel - {$wegh $~} :: report memory - {$went p/sack q/path r/@ud s/coop} :: response confirm - {$west p/sack q/{path @ud *}} :: network request - {$mini-jael-task *} - == :: - -- ::able - :: - :::: :: (1e2) - :: - ++ bale :: driver state - |* a/_* :: %jael keys type - $: {our/ship now/@da eny/@uvJ byk/beak} :: base info - {usr/user dom/(list @t)} :: req user, domain - key/a :: secrets from %jael - == :: - :: - ++ clip (each @if @is) :: client IP - ++ cred :: credential - $: hut/hart :: client host - aut/(jug @tas @t) :: client identities - orx/oryx :: CSRF secret - acl/(unit @t) :: accept-language - cip/(each @if @is) :: client IP - cum/(map @tas *) :: custom dirt - == :: - ++ epic :: FCGI parameters - $: qix/(map @t @t) :: query - ced/cred :: client credentials - bem/beam :: original path - but/path :: ending - == :: - ++ gram :: inter-ship message - $? {{$get $~} p/@uvH q/{? clip httq}} :: remote request - {{$got $~} p/@uvH q/httr} :: remote response - {{$gib $~} p/@uvH} :: remote cancel - == :: - ++ hart {p/? q/(unit @ud) r/host} :: http sec+port+host - ++ hate {p/purl q/@p r/moth} :: semi-cooked request - ++ heir {p/@ud q/mess r/(unit love)} :: status+headers+data - ++ hiss {p/purl q/moth} :: outbound request - ++ hole @t :: session identity - ++ hort {p/(unit @ud) q/host} :: http port+host - ++ host (each (list @t) @if) :: http host - ++ hoke %+ each {$localhost $~} :: local host - ?($.0.0.0.0 $.127.0.0.1) :: - ++ httq :: raw http request - $: p/meth :: method - q/@t :: unparsed url - r/(list {p/@t q/@t}) :: headers - s/(unit octs) :: body - == :: - ++ httr {p/@ud q/mess r/(unit octs)} :: raw http response - ++ httx :: encapsulated http - $: p/? :: https? - q/clip :: source IP - r/httq :: - == :: - ++ user knot :: username - ++ love :: http response - $% {$ham p/manx} :: html node - {$mid p/mite q/octs} :: mime-typed data - {$raw p/httr} :: raw http response - {$wan p/wain} :: text lines - {$zap p/@ud q/(list tank)} :: status+error - == :: - ++ math (map @t (list @t)) :: semiparsed headers - ++ mess (list {p/@t q/@t}) :: raw http headers - ++ meth :: http methods - $? $conn :: CONNECT - $delt :: DELETE - $get :: GET - $head :: HEAD - $opts :: OPTIONS - $post :: POST - $put :: PUT - $trac :: TRACE - == :: - ++ mite (list @ta) :: mime type - ++ moth {p/meth q/math r/(unit octs)} :: http operation - ++ octs {p/@ud q/@t} :: octet-stream - ++ oryx @t :: CSRF secret - ++ pork {p/(unit @ta) q/(list @t)} :: fully parsed url - ++ purf (pair purl (unit @t)) :: url with fragment - ++ purl {p/hart q/pork r/quay} :: parsed url - ++ quay (list {p/@t q/@t}) :: parsed url query - ++ quer |-($@($~ {p/@t q/@t t/$})) :: query tree - ++ quri :: request-uri - $% {$& p/purl} :: absolute - {$| p/pork q/quay} :: relative - == :: - ++ rout {p/(list host) q/path r/oryx s/path} :: http route (new) - ++ sec-move :: driver effect - $% {$send p/hiss} :: http out - {$show p/purl} :: direct user to url - {$give p/httr} :: respond immediately - {$redo $~} :: restart request qeu - == :: - -- ::eyre -:: :::: -:::: ++ford :: (1f) build - :: :::: -++ ford ^? - |% - :: :: - :::: ++able:ford :: (1f1) arvo moves - :: :::: - ++ able ^? - |% - ++ gift :: out result <-$ - $% {$made p/@uvH q/gage} :: computed result - {$mass p/mass} :: memory usage - {$news p/@uvH} :: fresh depends - == :: - ++ task :: in request ->$ - $% {$exec p/@p q/(unit bilk)} :: make / kill - {$wasp p/@p q/{@uvH ?}} :: depends ask / kill - {$wegh $~} :: report memory - {$wipe p/@p $~} :: clear cache - == :: - -- ::able - ++ bilk (pair beak silk) :: sourced request - ++ gage :: recursive cage+tang - $% {$& p/cage} :: success - {$| p/tang} :: error - {$tabl p/(list (pair gage gage))} :: table of results - == :: - ++ hood :: assembly plan - $: zus/@ud :: zuse kelvin - sur/(list hoof) :: structures - lib/(list hoof) :: libraries - fan/(list horn) :: resources - src/(list hoop) :: program - == :: - ++ hoof (trel ? term (unit (pair case ship))) :: resource reference - ++ hoop :: source in hood - $% {$& p/twig} :: direct twig - {$| p/beam} :: resource location - == :: - ++ hops :: XX late-bound path - $: pre/(unit tyke) :: - pof/(unit {p/@ud q/tyke}) :: - == :: - ++ horn :: resource tree - $% {$ape p/twig} :: /~ twig by hand - {$arg p/twig} :: /$ argument - {$alt p/(list horn)} :: /| options - {$dep p/horn} :: /# insert dephash - {$dub p/term q/horn} :: /= apply face - {$fan p/(list horn)} :: /. list - {$for p/(list (pair spur horn))} :: /, switch by path - {$hel p/horn} :: /% propagate args - {$lin p/(list mark) q/horn} :: /& translates - {$man p/(map knot horn)} :: /* hetero map - {$nap p/horn} :: /_ homo map - {$now p/horn} :: deprecated - {$nod p/term q/horn} :: /_ @ list by odor - {$saw p/twig q/horn} :: /; operate on - {$see p/hops q/horn} :: /: relative to - {$sic p/twig q/horn} :: /^ cast - {$toy p/? q/mark} :: /mark/ static/hook - == :: - ++ milk (trel ship desk silk) :: sourced silk - ++ silk :: construction layer - $^ {p/silk q/silk} :: cons - $% {$$ p/cage} :: literal - {$alts p/(list silk)} :: options - {$cntr p/mark q/coin r/beam} :: local synthesis - {$bunt p/mark} :: example of mark - {$call p/silk q/silk} :: slam - {$cast p/mark q/silk} :: translate - {$core p/beam} :: build program - {$diff p/silk q/silk} :: diff - {$dude p/(trap tank) q/silk} :: error wrap - {$file p/beam} :: from clay - {$flag p/(set $@(@uvH beam)) q/silk} :: add dependencies - {$join p/mark q/silk r/silk} :: merge - {$mash p/mark q/milk r/milk} :: annotate - {$mute p/silk q/(list (pair wing silk))} :: mutant - {$pact p/silk q/silk} :: patch - {$plan p/beam q/coin r/hood} :: structured assembly - {$reef $~} :: kernel reef - {$ride p/twig q/silk} :: silk thru twig - {$tabl p/(list (pair silk silk))} :: list - {$vale p/mark q/*} :: validate - {$volt p/(cask *)} :: unsafe add type - == :: - -- ::ford -:: :::: -:::: ++gall :: (1g) extensions - :: :::: -++ gall ^? - |% - :: :: - :::: ++able:gall :: (1g1) arvo moves - :: :::: - ++ able ^? - |% - ++ gift :: outgoing result - $% {$mass p/mass} :: memory usage - {$onto p/(each suss tang)} :: about agent - {$rend p/path q/*} :: network request - {$unto p/cuft} :: - {$mack p/(unit tang)} :: message ack - == :: - ++ task :: incoming request - $% {$conf p/dock q/culm} :: configure app - {$init p/ship} :: set owner - {$deal p/sock q/cush} :: full transmission - {$went p/sack q/path r/@ud s/coop} :: response confirm - {$west p/sack q/path r/@ud s/*} :: network request - {$wegh $~} :: report memory - == :: - -- ::able - ++ bitt (map bone (pair ship path)) :: incoming subs - ++ boat :: outgoing subs - %+ map (pair bone wire) :: - (trel bean ship path) :: - ++ bowl :: standard app state - $: $: our/ship :: host - src/ship :: guest - dap/term :: agent - == :: - $: wex/boat :: outgoing subs - sup/bitt :: incoming subs - == :: - $: ost/bone :: opaque cause - act/@ud :: change number - eny/@uvJ :: entropy - now/@da :: current time - byk/beak :: load source - == == :: - ++ club :: agent action - $% {$peel p/mark q/path} :: translated peer - {$peer p/path} :: subscribe - {$poke p/cage} :: apply - {$puff p/mark q/noun} :: unchecked poke - {$pull $~} :: unsubscribe - {$punk p/mark q/cage} :: translated poke - {$pump $~} :: pump yes+no - == :: - ++ cuft :: internal gift - $% {$coup p/(unit tang)} :: poke result - {$diff p/cage} :: subscription output - {$doff p/mark q/noun} :: untyped diff - {$quit $~} :: close subscription - {$reap p/(unit tang)} :: peer result - == :: - ++ culm :: config action - $% {$load p/scup} :: load+reload - :: {$kick $~} :: restart everything - :: {$stop $~} :: toggle suspend - :: {$wipe $~} :: destroy all state - == :: - ++ cush (pair term club) :: internal task - ++ dude term :: server identity - ++ gill (pair ship term) :: general contact - ++ scup (pair ship desk) :: autoupdate - ++ suss (trel dude @tas @da) :: config report - ++ well (pair desk term) :: - -- ::gall -:: :::: -:::: ++jael :: (1h) security - :: :::: -++ jael ^? - |% - :: :: - :::: ++able:jael :: (1h1) arvo moves - :: :::: - ++ able ^? - =, pki - =, rights - |% - :: %jael has two general kinds of task: changes - :: and change subscriptions. - :: - :: change tasks are designed to match high-level - :: operations - for instance, we have %ktsg, %mint, - :: and %move, not just a single delta operation. - :: more of these operations will probably be added, - :: and invariants enforced at transaction end. - :: - :: subscriptions are also user-focused - for instance, - :: %vein sends all the information needed to maintain - :: the secure channel, both rights and certificates. - :: the security-critical tasks (%veil, %vein, %vine) - :: should probably be bound to a whitelisted duct set. - :: (all secrets are redacted from %vest gifts.) - :: - :: %jael only talks to %ames and %behn. we send messages - :: through %ames and use %behn timers. - :: - ++ action :: balance change - %+ pair ship :: partner - %+ each bump :: &/liability change - bump :: |/asset change - :: :: - ++ balance :: balance sheet - %+ pair :: - (map ship safe) :: liabilities - (map ship safe) :: assets - :: :: - ++ change :: urbit change - $% $: $fact :: certificate change - rex/ship :: owner - vie/(unit (unit ship)) :: made/heard from - lyf/life :: deed added/modified - gan/growth :: info gained - == :: - $: $rite :: rights change - rex/ship :: issuer - pal/ship :: issued to - del/bump :: change - == == :: - :: :: - ++ channel :: secure channel - $: out/(unit (pair hand bill)) :: outbound key - inn/(map hand bill) :: inbound keys - cur/(unit life) :: their version - sax/(list ship) :: their ancestry - pub/will :: their public keys - == :: - ++ gift :: out result <-$ - $? {$veil p/channel} :: secure channel - {$vest p/tally} :: balance update - {$vein p/life q/(map life ring)} :: private keys - {$vine p/(list change)} :: all raw changes - == :: - ++ growth :: unit of learning - $% {$sign p/mind q/@} :: add/update signature - {$step p/cert} :: add whole deed - == :: - ++ note :: out request $-> - $% {$b $wait p/@da} :: wait until - {$x $mess p/ship q/path r/*} :: send message - == :: - ++ remote :: remote notification - %+ each safe :: &/addition - safe :: |/replacement - :: :: - ++ sign :: in result $<- - $% {$b $wake $~} :: wakeup - {$x $rest p/coop} :: message result - == :: - ++ tally :: balance update - %+ each balance :: complete - action :: change - :: - ++ task :: in request ->$ - $% {$ktsg p/ship q/safe} :: destroy rights - {$hail p/ship q/remote} :: remote update - {$init p/@pG q/arms} :: initialize urbit - {$meet p/(unit (unit ship)) q/farm} :: integrate pki from - {$mint p/ship q/safe} :: create rights - {$move p/ship q/ship r/safe} :: transfer from/to - {$next p/bull} :: update private key - {$nuke $~} :: cancel tracker from - {$veil p/ship} :: view secret channel - {$vein $~} :: view signing keys - {$vest $~} :: view public balance - {$vine $~} :: view secret history - {$jaelwomb p/task:womb} :: XX not factored in - {$west p/ship q/path r/*} :: remote request - == :: - ++ gilt gilt:womb - -- - :: - ++ womb ^? - :: types used to serve the lib/womb invite controller - |% - ++ ticket @G :: old 64-bit ticket - ++ passcode @uvH :: 128-bit passcode - ++ passhash @uwH :: passocde hash - ++ mail @t :: email address - ++ invite :: - $: who/mail :: owner email - pla/@ud :: planets to send - sta/@ud :: stars to send - == :: - :: :: - ++ reinvite {tid/passcode inv/invite} :: new from old - ++ task :: manage ship %fungi - $% {$claim aut/passcode her/@p tik/ticket} :: convert to %final - {$bonus tid/passcode pla/@ud sta/@ud} :: supplement passcode - {$invite tid/passcode inv/invite} :: alloc to passcode - {$reinvite aut/passcode reinvite} :: move to another - == :: - ++ scry :: - $% {$shop typ/?($star $planet) nth/@u} :: available ships - {$stats who/ship} :: ship details - {$balance aut/passcode} :: invite details - == :: - ++ balance {who/mail pla/@ud sta/@ud} :: XX same as invite? - ++ gilt :: - $% {$ships (list ship)} :: - {$womb-owner (unit mail)} :: - {$womb-balance (unit balance)} :: - == - -- - :: :: - :::: ++pki:jael :: (1h2) certificates - :: :::: - ++ pki ^? - |% - :: the urbit meta-certificate (++will) is a sequence - :: of certificates (++cert). each cert in a will - :: revokes and replaces the previous cert. the - :: version number of a ship is a ++life. - :: - :: the deed contains an ++arms, a definition - :: of cosmetic identity; a semi-trusted parent, - :: which signs the initial certificate and provides - :: routing services; and a dirty bit. if the dirty - :: bit is set, the new life of this ship may have - :: lost information that the old life had. - :: - ++ arms (map chip (pair @ta @t)) :: stated identity - ++ bull :: cert metadata - $: dad/ship :: parent - dob/? :: & clean, | dirty - nym/arms :: identity strings - == :: - ++ cert (tale deed) :: signed deed - ++ chip :: standard identity - $? $giv :: given name - $sur :: surname - $had :: fictitious name - $mid :: middle name - == :: - ++ deed :: certificate deed - $: doc/bull :: metadata - pub/pass :: public key - == :: - ++ farm (map ship will) :: pki dump set - ++ hand @uvH :: 128-bit hash - ++ life @ud :: ship version - ++ mind {who/ship lyf/life} :: key identifier - ++ name (pair @ta @t) :: ascii / unicode - ++ oath @ :: signature - ++ tale :: urbit-signed * - |* typ/mold :: payload mold - $: dat/typ :: data - syg/(map ship (pair life oath)) :: signatures - == :: - ++ will (map life cert) :: meta-certificate - -- :: pki - :: :: - :::: ++rights:jael :: (1h3) claims - :: :::: - ++ rights ^? - =, pki - |% - :: %jael tracks promises (++rite) from ship to ship. - :: a rite may be any right, badge, asset, secret, etc. - :: un-shared secret or private asset is stored as a - :: rite from self to self. - :: - :: each rite is really a class of rights, and often - :: has its own internal set or map structure. - :: - :: present kinds of rite: - :: - :: %apple: application secret for a web api. - :: %block: the promisee is banned. - :: %email: email tied to promissee's ship. - :: %final: ship/ticket pair, ready to launch. - :: %fungi: fungible, countable asset. - :: %guest: permission to adopt foreign child. - :: %hotel: block of unissued children. - :: %jewel: urbit private keys. - :: %login: user's login passcode. - :: %pword: password for a website/api. - :: %token: user access token for a web api. - :: %urban: symmetric key for urbit networking. - :: - :: %fungi keys can be anything, but don't reuse - :: currency codes. codes for urbit invitations: - :: %ugl == galaxy, %usr == star, %upl == planet - :: - :: you can think of [our her rite] as an rdf triple. - :: - ++ bill (pair @da @) :: expiring value - ++ bump :: rights change - $: mor/safe :: add rights - les/safe :: lose rights - == :: - ++ dorm (pair ship bloq) :: issuing group - ++ pile (tree (pair @ @)) :: efficient ship set - ++ rite :: urbit commitment - $% {$apple p/(map site @)} :: web api key - {$block $~} :: banned - {$email p/(set @t)} :: email addresses - {$final p/@pG} :: recognize by ticket - {$fungi p/(map term @ud)} :: fungibles - {$guest $~} :: refugee visa - {$hotel p/(map dorm pile)} :: reserved block - {$jewel p/(map life ring)} :: private keyring - {$login p/(set @pG)} :: login secret - {$pword p/(map site (map @t @t))} :: web passwd by user - {$token p/(map site (map @t @t))} :: app tokens by user - {$urban p/(map hand bill)} :: urbit symmetric keys - == :: - ++ site (list @ta) :: [%com %yahoo %www ~] - ++ safe (tree rite) :: rights set - -- :: rights - -- :: jael -:: :::: -:::: ++xmas :: (1i) new network - :: :::: -++ xmas ^? - :: :: - :::: ++able:xmas :: (1i1) arvo moves - :: :::: - |% - ++ able ^? - |% - ++ gift :: - $% {$east p/*} :: response message - {$home p/lane q/@} :: process forward - {$send p/lane q/@} :: send packet - {$rest p/coop} :: acknowledgment - == :: - ++ task :: in request ->$ - $% {$hear p/lane q/@} :: - {$mess p/ship q/path r/*} :: send message - {$wake $~} :: - == :: - ++ card :: out cards - $% {$west p/ship q/path r/*} :: network request - == :: - ++ sign :: in response $-< - $% {$g $rend p/path q/*} :: network request - {$g $mack p/(unit tang)} :: message ack - == :: - ++ note :: out request $-> - $% {$c $west p/ship q/path r/*} :: to %clay - {$e $west p/ship q/path r/*} :: to %eyre - {$g $west p/ship q/path r/*} :: to %gall - $: $j :: to %jael - $% {$line p/ship q/@da r/code} :: - {$link p/ship q/@da r/code} :: - {$meet p/farm:pki:jael} :: - {$veil p/ship} :: - {$west p/ship q/path r/*} :: to %gall - == == == :: - -- :: able - :: - :::: :: (1i2) - :: - ++ code @uvI :: symmetric key - ++ lane :: packet route - $% {$if p/@da q/@ud r/@if} :: IP4/public UDP/addr - {$is p/@ud q/(unit lane) r/@is} :: IPv6 w+alternates - {$ix p/@da q/@ud r/@if} :: IPv4 provisional - == :: - ++ life @ud :: regime number - -- ::xmas --- :: diff --git a/neo/van/ames.hoon b/neo/van/ames.hoon deleted file mode 100644 index 2d558b827..000000000 --- a/neo/van/ames.hoon +++ /dev/null @@ -1,2229 +0,0 @@ -:: :: :: -:::: /hoon/ames/arvo :::::: vane prelude - :: :: :: -|= pit/vase :: kernel vase -=> =~ :: -:: :: :: -:::: :::::: ames structures - :: :: :: -=, ames -=, crypto -|% :: -++ bait {p/skin q/@ud r/dove} :: fmt nrecvd spec -++ bath :: per friend - $: fon/(map bole lock) :: inbound locks - zam/scar :: outbound boles - sal/(map bole colt) :: outbound flows - == :: -++ bole bone :: inbound opaque -++ boon :: internal effect - $% {$acid $~} :: drop input - {$beer p/ship q/@uvG} :: gained ownership - {$coke p/sock q/duct r/path s/coop} :: forward ack - {$cola p/sock q/bole r/path s/coop} :: reverse ack - {$mead p/lane q/rock} :: forward to self - {$malt p/sock q/duct r/path s/*} :: response - {$milk p/sock q/bole r/path s/*} :: request - {$ouzo p/lane q/rock} :: transmit packet - {$wine p/sock q/tape} :: notify user - == :: -++ cake {p/sock q/skin r/@} :: top level packet -++ chan path :: channel -++ clot :: symmetric key state - $: yed/(unit {p/hand q/code}) :: outbound - heg/(map hand code) :: proposed - qim/(map hand code) :: inbound - == :: -++ clue :: live packet state - $: vig/? :: true iff virgin - tel/part :: block identity - fap/flap :: fragment hash - dat/rock :: fragment data - == :: -++ part (pair frag tick) :: fragment of packet -++ coal :: live packet state - $: out/@da :: sent date - lod/@da :: lost-by deadline - clu/clue :: packet to send - == :: -++ stat :: pump statistics - $: $: cur/@ud :: window q length - max/@ud :: max pax out - rey/@ud :: retry q length - == :: - $: rtt/@dr :: roundtrip estimate - las/@da :: last sent - lad/@da :: last deadline - == :: - == :: -++ mini :: pump data - $: saw/stat :: statistics - liv/(qeu coal) :: live packets - lop/(qeu clue) :: lost packets - == :: -++ colt :: outbound state - $: seq/tick :: next tick to fill - lac/tick :: acked tick until - cob/(map tick comb) :: live messages - myn/mini :: packet pump - == :: -++ comb :: live message - $: cup/(unit coop) :: final ack - cha/path :: channel - num/frag :: number of fragments - ack/frag :: number acked - cly/(list clue) :: left to send - == :: -++ corn :: flow by server - $: hen/duct :: admin channel - wab/(map ship bath) :: relationship - == :: -++ door :: foreign contact - $: wod/road :: connection to - wyl/wyll :: inferred mirror - caq/clot :: symmetric key state - == :: -++ dove {p/@ud q/(map @ud @)} :: count 13-blocks -++ flap @uvH :: network packet id -++ flea (pair bole tick) :: message id -++ frag @ud :: fragment number -++ fort :: formal state - $: $0 :: version - gad/duct :: client interface - hop/@da :: network boot date - ton/town :: security - zac/(map ship corn) :: flows by server - == :: -++ lock :: inbound sequencer - $: laq/tick :: acknowledged until - nys/(map tick bait) :: inbound partials - laz/(unit (trel flea flap lane)) :: awaiting app - exc/(map tick ares) :: negative acks - == :: -++ meal :: payload - $% {$back p/bone q/flap r/coop s/@dr} :: acknowledgment - {$bond p/flea q/path r/*} :: message - {$carp p/moan q/(pair @ud @)} :: fragment - {$fore p/ship q/(unit lane) r/@} :: forwarded packet - == :: -++ moan :: message invariant - $: {kos/bole liq/tick} :: flow identity - syn/@ :: skin number - cnt/@ :: number of packets - == :: -++ road :: secured oneway route - $: exp/@da :: expiration date - lun/(unit lane) :: route to friend - lew/wyll :: wyll of friend - == :: -++ skin ?($none $open $fast $full) :: encoding stem -++ sufi :: domestic host - $: hoy/(list ship) :: hierarchy - val/wund :: private keys - law/wyll :: server wyll - seh/(map hand {p/ship q/@da}) :: key cache - hoc/(map ship door) :: neighborhood - == :: -++ tick @ud :: message sequence no -++ town :: all security state - $: lit/@ud :: imperial modulus - any/@ :: entropy - urb/(map ship sufi) :: all keys and routes - fak/? :: - == :: -++ wund (list {p/life q/ring r/acru}) :: mace in action --- -:: :: :: -:::: :::::: arvo structures - :: :: :: -|% :: -++ flam |=(a/flap `@p`(mug a)) :: debug flap -++ msec |=(a/@dr `@ud`(div a (div ~s1 1.000))) :: debug @dr -++ move {p/duct q/(wind note-arvo gift:able)} :: local move --- -:: :: -:::: outbound cores :: - :: :: -|% -++ rail :: message rail - => |% :: - ++ gift :: - $% {$hear p/chan q/coop} :: message ack - {$send p/flap q/rock} :: release packet - == :: - ++ note :: - $% {$back p/flap q/coop r/@dr} :: raw ack - {$tell p/chan q/*} :: send message - {$wake $~} :: random wakeup - == :: - ++ rend $-({now/@da ham/meal} (list rock)) :: render message - -- :: - |= $: our/@p :: XX redundant - her/@p :: outgoing peer - red/rend :: message encoder - == :: - |= $: kos/bole :: this flow - sal/(map bole colt) :: flow table - == :: - =| fex/(list gift) :: effects - =+ ^- colt :: state - =+ (~(get by sal) kos) - ?^ - u.- - :* 0 :: seq/tick - 0 :: lac/tick - ~ :: cob/(map tick comb) - ^- mini - :* ^- stat - :* :* 0 :: cur/@ud - 2 :: max/@ud - 0 :: rey/@ud - == - :* ~s5 :: rtt/@dr - ~2010.1.1 :: las/@da - ~2010.1.1 :: lad/@da - == == - ~ - ~ - == == - =* cot - - =+ mup=(yawn:pump myn) - |% :: - ++ abed [fex cot] :: reveal - ++ abet :: resolve - ^+ [fex sal] - [(flop fex) (~(put by sal) kos `colt`cot)] - :: :: - ++ view :: inspect - |% :: - ++ bulk :: queue count - ^- @ud - |-(?~(cob 0 :(add 1 $(cob l.cob) $(cob r.cob)))) - :: :: - ++ wait :: next wakeup - ^- (unit @da) - wait:mup - -- - :: :: - ++ wish :: operate list - |= {now/@da day/(list note)} - ^+ +> - ?~(day +> $(day t.day, +> (work now i.day))) - :: - ++ work :: - |= {now/@da job/note} :: compute - ^+ +> - =< +>:wy-abet - |% :: - ++ wy-abet +:wy-able :: resolve - ++ wy-able wy-tire:wy-ably:wy-feed:wy-ably :: converge - ++ wy-ably :: drain - ^+ . - =^ fix myn abet:mup - =. mup (yawn:pump myn) - |- ^+ +>.$ - ?~ fix +>.$ - $(fix t.fix, +>.$ (wy-abut i.fix)) - :: :: - ++ wy-abut :: pump effect - |= fic/gift:pump - ^+ +> - ?- -.fic - $good - :: ~& [%ok her `@p`(mug p.fic) r.fic] - (wy-good q.fic s.fic) - :: - $send - :: ~& [%go her `@p`(mug p.fic) q.fic] - +>(fex [[%send p.fic r.fic] fex]) - == - :: :: - ++ wy-back :: hear an ack - |= {dam/flap cop/coop lag/@dr} - :: ~& [%wy-back (flam dam) cop lag] - +>(mup (work:mup now %back dam cop lag)) - :: - ++ wy-emit - |= fec/gift - +>(fex [fec fex]) - :: :: - ++ wy-feed :: feed pump - ^+ . - =^ cly . (wy-find want.mup) - :: ~& [%wy-feed want.mup (lent cly)] - +(mup (work:mup now %pack cly)) - :: :: - ++ wy-find :: collect packets - |= may/@ud - ^- {(list clue) _+>} - =- [(flop -<) ->] - =+ [inx=lac hav=*(list clue)] - |- ^- {(list clue) _+>.^$} - ?: |(=(0 may) =(inx seq)) [hav +>.^$] - =^ hey +>.^$ (wy-flow inx may hav) - $(inx +(inx), may p.hey, hav q.hey) - :: :: - ++ wy-flow :: collect by message - |= {tiq/tick may/@ud hav/(list clue)} - =+ mob=(~(got by cob) tiq) - |- ^- {(pair @ud (list clue)) _+>.^$} - ?: |(=(0 may) ?=($~ cly.mob)) - [[may hav] +>.^$(cob (~(put by cob) tiq mob))] - %= $ - may (dec may) - hav [i.cly.mob hav] - cly.mob t.cly.mob - == - :: :: - ++ wy-good :: handle ack - |= {paz/part cop/coop} - ^+ +> - =+ bum=(~(get by cob) q.paz) - ?: |(?=($~ bum) =(~ cly.u.bum)) - :: ~& [%wy-good-ignore paz ?=($~ cop)] - +>.$ - ?^ cop - :: - :: a failure; save this nack, clear the message - :: - ~& [%wy-good-fail q.paz] - %_ +>.$ - mup (work:mup now %cull q.paz) - cob (~(put by cob) q.paz u.bum(cly ~, cup `cop)) - == - ?> (lth ack.u.bum num.u.bum) - =. ack.u.bum +(ack.u.bum) - =. cup.u.bum ?.(=(ack.u.bum num.u.bum) ~ [~ ~]) - +>.$(cob (~(put by cob) q.paz u.bum)) - :: :: - ++ wy-tire :: report results - |- ^+ + - =+ zup=(~(get by cob) lac) - ?~ zup +.$ - ?~ cup.u.zup +.$ - ~& [?:(=(0 (end 0 1 kos)) %ta %ba) her kos lac] - %= $ - lac +(lac) - cob (~(del by cob) lac) - fex :_(fex [%hear [cha u.cup]:u.zup]) - == - :: :: - ++ wy-wake :: timeout - ^+ . - .(mup (work:mup now %wake ~)) - :: :: - ++ wy-tell :: send - |= {cha/chan val/*} - ^+ +> - =+ pex=(red now [%bond [(mix kos 1) seq] cha val]) - ~& [?:(=(0 (end 0 1 kos)) %tx %bx) her kos seq cha (lent pex)] - %_ +>.$ - seq +(seq) - cob - %+ ~(put by cob) - seq - ^- comb - :* ~ - cha - (lent pex) - 0 - =+ inx=0 - |- ?~ pex ~ - :_ $(pex +.pex, inx +(inx)) - [& [inx seq] (shaf %flap i.pex) i.pex] - == - == - -- - -- -++ pump :: packet pump - => |% :: - ++ gift :: effect - $% {$good p/flap q/part r/@dr s/coop} :: logical ack - {$send p/flap q/part r/rock} :: release packet - == :: - ++ note :: event - $% {$back p/flap q/coop r/@dr} :: raw ack - {$cull p/tick} :: cancel message - {$pack p/(list clue)} :: submit packets - {$wake $~} :: random wakeup - == :: - -- - |% - ++ yawn :: - |= myn/mini :: - ^+ zu - ~(. zu ~ myn) :: - :: - ++ zu :: state machine - |_ $: fex/(list gift) :: effects - mini :: state - == - :: :: - ++ abba :: a older than b - |= {a/part b/part} - |((lth q.a q.b) &(=(q.a q.b) (lth p.a p.b))) - :: :: - ++ abet :: resolve - ^- {(list gift:pump) mini} - :: =. . aver - [(flop fex) +<+] - :: :: - ++ aver :: verify - ?> (lte cur.saw max.saw) - ?> !=(0 max.saw) - ?. =(cur.saw (lent (~(tap to liv)))) - ~& [%aver-cur cur.saw (lent (~(tap to liv)))] - !! - ?> =(rey.saw (lent (~(tap to lop)))) - ?> =+ |= {a/coal b/coal} - &((lth out.a out.b) (lth lod.a lod.b)) - |- ?| ?=($~ liv) - ?& ?| ?=($~ r.liv) - ?& (+< n.r.liv n.liv) - $(liv r.liv) - == == - ?| ?=($~ l.liv) - ?& (+< n.liv n.l.liv) - $(liv l.liv) - == == - == - == - ?> =+ |= {a/part b/part} - |((lth q.a q.b) &(=(q.a q.b) (lth p.a p.b))) - |- ?| ?=($~ lop) - ?& ?| ?=($~ r.lop) - ?& (+< tel.n.r.lop tel.n.lop) - $(lop r.lop) - == == - ?| ?=($~ l.lop) - ?& (+< tel.n.lop tel.n.l.lop) - $(lop l.lop) - == == - == - == - . - :: :: - ++ back :: process raw ack - |= {now/@da dam/flap cop/coop lag/@dr} - ^+ +> - =- =/ rtt ?~(ack ~s0 (sub now out.u.ack)) - =. rtt ?:((gth rtt lag) (sub rtt lag) rtt) - (done:(lose(liv lov) ded) ack dam cop rtt) - |- ^- $: ack/(unit coal) - ded/(list coal) - lov/(qeu coal) - == - ?~ liv [~ ~ ~] - =+ ryt=$(liv r.liv) - ?^ ack.ryt - :: - :: found in front, no need to search back. - :: - [ack.ryt ded.ryt [n.liv l.liv lov.ryt]] - :: - :: lose unacked packets sent before an acked virgin. - :: - =+ ^- $: top/? - ack/(unit coal) - ded/(list coal) - lov/(qeu coal) - == - ?: =(dam fap.clu.n.liv) - [| `n.liv ~ l.liv] - [& $(liv l.liv)] - ?~ ack [~ ~ liv] - =. ded ?:(top [n.liv ded] ded) - =. ded ?:(vig.clu.u.ack (~(tap to r.liv) ded) ded) - =. lov ?:(top [n.liv lov ~] lov) - [ack ded lov] - :: :: - ++ clap :: ordered enqueue - :: - :: the `lop` queue isn't really a queue in case of - :: resent packets; packets from older messages - :: need to be sent first. unfortunately hoon.hoon - :: lacks a general sorted/balanced heap right now. - :: so we implement a balanced queue insert by hand. - :: - |= clu/clue - %_ +> - lop - |- ^+ lop - ?~ lop [clu ~ ~] - ?: ?| (abba tel.clu tel.n.lop) - ?& =(tel.clu tel.n.lop) - (lth fap.clu fap.n.lop) - == == - [n.lop l.lop $(lop r.lop)] - [n.lop $(lop l.lop) r.lop] - == - :: :: - ++ cull :: clear message - |= tiq/tick - %_ +> - liv - |- ^+ liv - ?~ liv ~ - =+ vil=[n.liv $(liv l.liv) $(liv r.liv)] - ?. =(tiq q.tel.clu.n.liv) vil - ~(nip to `(qeu coal)`vil) - :: - lop - |- ^+ lop - ?~ lop ~ - =+ pol=[n.lop $(lop l.lop) $(lop r.lop)] - ?: =(tiq q.tel.n.lop) pol - ~(nip to `(qeu clue)`pol) - == - :: :: - ++ done :: process cooked ack - |= {lyd/(unit coal) dam/flap cop/coop rtt/@dr} - ^+ +> - ?~ lyd +> - %_ +> - cur.saw (dec cur.saw) - fex [[%good dam tel.clu.u.lyd rtt cop] fex] - == - :: :: - ++ fire :: send a packet - |= {now/@da clu/clue} - ^+ +> - ?> (lth cur.saw max.saw) - =+ out=?:((lte now las.saw) +(las.saw) now) - =+ lod=(add now (mul 2 rtt.saw)) - =. lod ?:((gth lod lad.saw) lod +(lad.saw)) - :: ~& [%fire (flam fap.clu) `@da`out `@da`lod] - %= +>.$ - fex [[%send fap.clu tel.clu dat.clu] fex] - las.saw out - lad.saw lod - cur.saw +(cur.saw) - liv (~(put to liv) [out lod clu]) - == - :: :: - ++ flay :: time out packets - |= now/@da - ^+ +> - =- (lose(liv q.ole) p.ole) - ^= ole - =| ded/(list coal) - |- ^+ [p=ded q=liv] - ?~ liv [ded ~] - ?: (gte now lod.n.liv) - :: - :: everything in front of a dead packet is dead - :: - $(liv l.liv, ded (~(tap to r.liv) [n.liv ded])) - =+ ryt=$(liv r.liv) - [p.ryt [n.liv l.liv q.ryt]] - :: :: - ++ lose :: abandon packets - |= cud/(list coal) - ^+ +> - ?~ cud +> - =. +> (clap clu.i.cud) - %= $ - cud t.cud - cur.saw (dec cur.saw) - rey.saw +(rey.saw) - == - :: :: - ++ ship :: send packets - |= {now/@da cly/(list clue)} - ^+ +> - ?: (gte cur.saw max.saw) +> - ?: =(0 rey.saw) - ?~ cly +> - $(cly t.cly, +> (fire now i.cly)) - =^ clu lop ~(get to lop) - $(+> (fire(rey.saw (dec rey.saw)) now clu)) - :: :: - ++ wait :: next wakeup - ^- (unit @da) - =+ tup=`(unit coal)`~(top to liv) - ?~(tup ~ `lod.u.tup) - :: :: - ++ want :: window space - ^- @ud - ?: (gte cur.saw max.saw) 0 - =+ gap=(sub max.saw cur.saw) - ?: (gte rey.saw gap) 0 - (sub gap rey.saw) - :: - ++ work :: - |= {now/@da job/note} :: perform - ^+ +> - ?- -.job - $back (back now [p q r]:job) - $cull (cull p.job) - $pack (ship now p.job) - $wake (flay now) - == - -- - -- --- - :::::::::::::::::::::::::::::::::::::::::::::::::::::::: - :: section 4aA, identity logic :: - :: - |% - ++ grip :: extend wyll - |= {wet/wyll law/wyll} - ^- wyll - ?~ wet law - ?: =(wet law) law - ?^ t.wet - ?>((meld i.wet i.t.wet) [i.wet $(wet t.wet)]) - ?~ law - ?>((pier i.wet) [i.wet ~]) - ?~ q.p.q.i.wet - ?>((meld i.wet i.law) [i.wet law]) - =+ rul=(sein:title r.p.q.i.wet) - |- ^- wyll - ?: ?& =(rul r.p.q.i.law) - =(p.p.q.i.law u.q.p.q.i.wet) - == - ?>((meld i.wet i.law) [i.wet law]) - ?>(?=(^ t.law) $(law t.law)) - :: - ++ meld :: verify connect - |= {new/deyd old/deyd} - ^- $& - ?> (melt new old) - ?> .= (shaf %meld (sham q.new)) - (need (sure:as:(haul:suite r.q.old) *code p.new)) - %& - :: - ++ melt :: proper connect - |= {new/deyd old/deyd} - ^- ? - =+ rac=(clan:title r.p.q.new) - ?& =(r.new r.old) :: match fake - ?~ q.p.q.new - ?& =(r.p.q.old r.p.q.new) - &(!=(%earl rac) =(p.p.q.old (dec p.p.q.new))) - == - ?& &(!=(%pawn rac) !=(%czar rac)) - |(=(0 p.p.q.new) =(%earl rac)) - =(r.p.q.old (sein:title r.p.q.new)) - =(p.p.q.old u.q.p.q.new) - == - == - :: - ++ pare :: shorten against - |= {fou/wyll law/wyll} - :: ~& [%pare-fou fou] - :: ~& [%pare-law law] - ^- wyll - =+ [ouf=(flop fou) wal=(flop law)] - %- flop - |- ^- wyll - ?~ ouf wal - ?~ wal ~ - ?. =(i.wal i.ouf) ouf - $(wal t.wal, ouf t.ouf) - :: - ++ pier !: :: initial deyd - |= wed/deyd - ^- $& - ?> =+ rac=(clan:title r.p.q.wed) - =+ loy=(haul:suite r.q.wed) - ?: &(r.wed =(rac %czar)) %& - ?> =(0 p.p.q.wed) - ?> =(fig:ex:loy ?+(rac !! $czar (zeno r.p.q.wed), $pawn r.p.q.wed)) - ?> =((shaf %self (sham q.wed)) (need (sure:as:loy *code p.wed))) - %& - %& - :: - ++ real :: validate - |= {mac/mace law/wyll} - ?> ?& |- ^- ? - ?~ mac & - ?> ?& ?=(^ law) - (lth p.p.q.i.law 9) :: 9-lives rule - =(p.p.q.i.law p.i.mac) - =(r.q.i.law pub:ex:(weur:suite q.i.mac)) - == - $(mac t.mac, law t.law) - == - %& - :: - ++ rice :: mace at life - |= {mar/life mac/mace} - ^- (unit mace) - ?~ mac ~ - ?: =(mar p.i.mac) [~ mac] - ?: (gth mar p.i.mac) ~ - $(mac t.mac) - :: - ++ rick :: wyll at life - |= {mar/life lag/ship law/wyll} - ^- (unit wyll) - ?~ law ~ - ?: =(mar p.p.q.i.law) [~ law] - ?: (gth mar p.p.q.i.law) ~ - ?: |(?=($~ q.p.q.i.law) !=(lag r.p.q.i.law)) ~ - $(law t.law) - :: - ++ zeno :: imperial keyprint - |= zar/@pD - ^- @uvH ^- @ - %+ snag zar - ^- (list @uw) - :~ 0wN.Kdp5k.p5ncD.4Wsih.bFQFu :: 0, ~zod, urbit.org - 0w0 :: 1, ~nec, Curtis Yarvin - 0w0 :: 2, ~bud, Tlon Investor 1 - 0w0 :: 3, ~wes, Tlon Investor 2 - 0w0 :: 4, ~sev, Tlon Investor 2 - 0wt.cKYxs.Yb5VZ.boSwm.l0yYc :: 5, ~per, Tlon Investor 3 - 0w0 :: 6, ~sut, Tlon Investor 4 - 0w0 :: 7, ~let, Tlon Investor 4 - 0w0 :: 8, ~ful, Tlon Investor 4 - 0w0 :: 9, ~pen, Tlon Investor 4 - 0w0 :: 10, ~syt, Tlon Investor 4 - 0w0 :: 11, ~dur, Tlon Investor 4 - 0w0 :: 12, ~wep, Sam Putman - 0w0 :: 13, ~ser, Tlon Investor 5 - 0w3j.H0sty.jHa3F.JlD26.4LPwV :: 14, ~wyl, Zimran Ahmed - 0w3F.QdvV-.toAsR.hvUNk.fHjW6 :: 15, ~sun, Colin Smith - 0w0 :: 16, ~ryp, Tlon Investor 6 - 0w0 :: 17, ~syx, Tlon Investor 6 - 0w0 :: 18, ~dyr, Tlon Investor 6 - 0w0 :: 19, ~nup, Tlon Investor 6 - 0w0 :: 20, ~heb, Tlon Investor 6 - 0w0 :: 21, ~peg, Tlon Investor 6 - 0w0 :: 22, ~lup, Tlon Investor 6 - 0w0 :: 23, ~dep, Tlon Investor 6 - 0w0 :: 24, ~dys, Mike Gogulski - 0w0 :: 25, ~put, Tlon Investor 7 - 0w0 :: 26, ~lug, Tlon Investor 8 - 0w0 :: 27, ~hec, Tlon Investor 8 - 0w0 :: 28, ~ryt, Tlon Investor 8 - 0w0 :: 29, ~tyv, Tlon Investor 8 - 0w0 :: 30, ~syd, Jennifer Kollmer - 0wp.BgRGJ.kslnv.PLAqb.TRKbr :: 31, ~nex, Prakhar Goel - 0w0 :: 32, ~lun, Tlon Investor 9 - 0w0 :: 33, ~mep, Tlon Investor 9 - 0w0 :: 34, ~lut, Tlon Investor 9 - 0w0 :: 35, ~sep, Tlon Investor 9 - 0w0 :: 36, ~pes, Jennifer Kollmer - 0w2J.WSHlR.t5VHN.X8GKE.DB-yz :: 37, ~del, Kingdon Barrett - 0w1w.KF-J1.5I63F.khFyv.h0n4J :: 38, ~sul, John Burnham - 0w1A.OcPXS.oQi8K.g-E0d.zTRph :: 39, ~ped, Jeremy Wall - 0w2.Mr2Id.SX8xI.MAs-j.5Y-1W :: 40, ~tem, Tlon Investor 10 - 0w0 :: 41, ~led, Nick Caruso - 0w0 :: 42, ~tul, Susan Yarvin - 0w0 :: 43, ~met, Susan Yarvin - 0w0 :: 44, ~wen, Susan Yarvin - 0w0 :: 45, ~byn, Susan Yarvin - 0w0 :: 46, ~hex, James Torre - 0w0 :: 47, ~feb, urbit.org - 0wK.GoKEY.rMjfn.ZcvFQ.n4BmX :: 48, ~pyl, Michael Hartl - 0w0 :: 49, ~dul, Jennifer Kollmer - 0w0 :: 50, ~het, Jennifer Kollmer - 0w0 :: 51, ~mev, Herbert Yarvin - 0w0 :: 52, ~rut, Herbert Yarvin - 0w2L.M6-o5.DDTFL.R4sFL.7Zuay :: 53, ~tyl, Tlon Investor 11 - 0w0 :: 54, ~wyd, Curtis Yarvin - 0w0 :: 55, ~tep, Sibyl Kollmer - 0w0 :: 56, ~bes, Sibyl Kollmer - 0w0 :: 57, ~dex, Jared Hance - 0w0 :: 58, ~sef, Owen Rescher - 0w0 :: 59, ~wyc, Galen Wolfe-Pauly - 0w0 :: 60, ~bur, Galen Wolfe-Pauly - 0w0 :: 61, ~der, Galen Wolfe-Pauly - 0w0 :: 62, ~nep, Galen Wolfe-Pauly - 0w0 :: 63, ~pur, Herbert Yarvin - 0w30.VtXvV.S~xIV.iMCL~.j9zTC :: 64, ~rys, Charlie Cummings - 0w0 :: 65, ~reb, Herbert Yarvin - 0wp.LslIa.IFSM9.mIp-z.KBIBh :: 66, ~den, Michael Hartl - 0w0 :: 67, ~nut, Henry Yarvin - 0w0 :: 68, ~sub, Henry Yarvin - 0w0 :: 69, ~pet, Henry Yarvin - 0w0 :: 70, ~rul, Henry Yarvin - 0w0 :: 71, ~syn, Henry Ault - 0w0 :: 72, ~reg, Henry Ault - 0w0 :: 73, ~tyd, Henry Ault - 0w0 :: 74, ~sup, Henry Ault - 0w0 :: 75, ~sem, Michael Livshin - 0w0 :: 76, ~wyn, Anton Dyudin - 0w0 :: 77, ~rec, Anton Dyudin - 0w0 :: 78, ~meg, Anton Dyudin - 0w2L.tavpW.Lk4R-.elm7E.4KEqZ :: 79, ~net, Anthony Martinez - 0w0 :: 80, ~sec, Curtis Yarvin - 0w0 :: 81, ~mul, Curtis Yarvin - 0w1F.Tqroo.wyq2m.cBaTM.9MbG- :: 82, ~nym, Max Greer - 0w0 :: 83, ~tev, Sibyl Kollmer - 0w2x.~ldho.Oo7kE.QqNSx.XteFh :: 84, ~web, Ar Vicco - 0w0 :: 85, ~sum, Philip Monk - 0w0 :: 86, ~mut, Philip Monk - 0w0 :: 87, ~nyx, Philip Monk - 0w30.UUr19.iBPlD.wfyJD.2CWPv :: 88, ~rex, Tlon Investor 12 - 0w0 :: 89, ~teb, Sibyl Kollmer - 0w0 :: 90, ~fus, Tlon Corporation - 0w0 :: 91, ~hep, urbit.org - 0w0 :: 92, ~ben, urbit.org - 0w0 :: 93, ~mus, urbit.org - 0w0 :: 94, ~wyx, urbit.org - 0w0 :: 95, ~sym, urbit.org - 0w0 :: 96, ~sel, urbit.org - 0w0 :: 97, ~ruc, urbit.org - 0w0 :: 98, ~dec, urbit.org - 0w1L.NQ-5f.ABF9R.kVwVJ.zRfn2 :: 99, ~wex, Pax Dickinson - 0w0 :: 100, ~syr, urbit.org - 0w0 :: 101, ~wet, urbit.org - 0w0 :: 102, ~dyl, urbit.org - 0w0 :: 103, ~myn, urbit.org - 0w0 :: 104, ~mes, urbit.org - 0w0 :: 105, ~det, urbit.org - 0w0 :: 106, ~bet, urbit.org - 0w0 :: 107, ~bel, urbit.org - 0w0 :: 108, ~tux, Tlon Investor 13 - 0w1D.JV9n0.9z~YK.yAWyi.c9~Lu :: 109, ~tug, Philip Monk - 0w0 :: 110, ~myr, urbit.org - 0w0 :: 111, ~pel, urbit.org - 0w0 :: 112, ~syp, urbit.org - 0w0 :: 113, ~ter, urbit.org - 0w0 :: 114, ~meb, urbit.org - 0w0 :: 115, ~set, urbit.org - 0w0 :: 116, ~dut, urbit.org - 0w0 :: 117, ~deg, urbit.org - 0w0 :: 118, ~tex, urbit.org - 0w0 :: 119, ~sur, urbit.org - 0w0 :: 120, ~fel, urbit.org - 0w0 :: 121, ~tud, urbit.org - 0w0 :: 122, ~nux, urbit.org - 0w0 :: 123, ~rux, urbit.org - 0w0 :: 124, ~ren, urbit.org - 0w0 :: 125, ~wyt, urbit.org - 0w0 :: 126, ~nub, urbit.org - 0w0 :: 127, ~med, urbit.org - 0w20.GGLXx.aqxaQ.w4Iob.wdmmr :: 128, ~lyt, Arthur Breitman - 0w0 :: 129, ~dus, urbit.org - 0w0 :: 130, ~neb, urbit.org - 0w1U.uigq6.c~IqX.tKRX2.VrURf :: 131, ~rum, Joseph Blowsky - 0w0 :: 132, ~tyn, urbit.org - 0w0 :: 133, ~seg, urbit.org - 0w0 :: 134, ~lyx, urbit.org - 0w0 :: 135, ~pun, urbit.org - 0w0 :: 136, ~res, urbit.org - 0w0 :: 137, ~red, Alex Kravets - 0w3J.15iJA.0pbNk.mZXyh.A~uKb :: 138, ~fun, Aaron Beckerman - 0w0 :: 139, ~rev, urbit.org - 0w3m.Cqumo.ZC7-e.794A4.Bqhh8 :: 140, ~ref, Matt Brubeck - 0w0 :: 141, ~mec, urbit.org - 0w0 :: 142, ~ted, urbit.org - 0w2d.GLlYg.-MwtO.ZCPBE.OqGB9 :: 143, ~rus, Stephen Burnham - 0w0 :: 144, ~bex, urbit.org - 0w0 :: 145, ~leb, Justin LeBlanc - 0w0 :: 146, ~dux, urbit.org - 0w0 :: 147, ~ryn, urbit.org - 0w0 :: 148, ~num, Tlon - 0w0 :: 149, ~pyx, Katherine McFall - 0w2g.gLmg4.MtrHQ.A5VmH.WPk6G :: 150, ~ryg, Dan Haffey - 0w0 :: 151, ~ryx, Tlon - 0w0 :: 152, ~fep, Tlon - 0w2j.T1u2s.BfXjV.ldOGR.aiZrQ :: 153, ~tyr, Steve Dee - 0w0 :: 154, ~tus, Tlon - 0w0 :: 155, ~tyc, Tlon - 0w0 :: 156, ~leg, Tlon - 0w0 :: 157, ~nem, Tlon - 0w0 :: 158, ~fer, Tlon - 0w0 :: 159, ~mer, Tlon - 0w0 :: 160, ~ten, Tlon - 0w0 :: 161, ~lus, Tlon - 0w0 :: 162, ~nus, Tlon - 0w0 :: 163, ~syl, Tlon - 0w0 :: 164, ~tec, Tlon - 0w0 :: 165, ~mex, Tlon - 0w0 :: 166, ~pub, Tlon - 0w0 :: 167, ~rym, Tlon - 0w0 :: 168, ~tuc, Tlon - 0w0 :: 169, ~fyl, Tlon - 0w0 :: 170, ~lep, Tlon - 0w0 :: 171, ~deb, Tlon - 0w0 :: 172, ~ber, Tlon - 0w0 :: 173, ~mug, Tlon - 0w0 :: 174, ~hut, Tlon - 0w0 :: 175, ~tun, Tlon - 0w0 :: 176, ~byl, Tlon - 0w0 :: 177, ~sud, Tlon - 0w0 :: 178, ~pem, Tlon - 0w0 :: 179, ~dev, Tlon - 0w0 :: 180, ~lur, Tlon - 0w0 :: 181, ~def, Tlon - 0w0 :: 182, ~bus, Tlon - 0w0 :: 183, ~bep, Tlon - 0w0 :: 184, ~run, Tlon - 0w0 :: 185, ~mel, Tlon - 0w0 :: 186, ~pex, Tlon - 0w0 :: 187, ~dyt, Tlon - 0w0 :: 188, ~byt, Tlon - 0w0 :: 189, ~typ, Tlon - 0w0 :: 190, ~lev, Tlon - 0w0 :: 191, ~myl, Tlon - 0w0 :: 192, ~wed, Tlon - 0w0 :: 193, ~duc, Tlon - 0w0 :: 194, ~fur, Tlon - 0w0 :: 195, ~fex, Tlon - 0w0 :: 196, ~nul, Tlon - 0w0 :: 197, ~luc, Tlon - 0w0 :: 198, ~len, Tlon - 0w0 :: 199, ~ner, Tlon - 0wv.aixe9.7gG2w.7cJiy.i3Mg8 :: 200, ~lex, Michael Hartl - 0w0 :: 201, ~rup, Owen Rescher - 0w0 :: 202, ~ned, Tlon - 0w0 :: 203, ~lec, Tlon - 0w0 :: 204, ~ryd, Tlon - 0w1U.n361n.FC3jj.9cX26.V1Wif :: 205, ~lyd, Adam Bliss - 0w0 :: 206, ~fen, Tlon - 0w0 :: 207, ~wel, Tlon - 0w0 :: 208, ~nyd, Tlon - 0w0 :: 209, ~hus, Tlon - 0w0 :: 210, ~rel, Tlon - 0w0 :: 211, ~rud, Tlon - 0w0 :: 212, ~nes, Tlon - 0w16.~8NZV.VyMmf.4toMO.pui1R :: 213, ~hes, Tlon Investor 14 - 0w0 :: 214, ~fet, Tlon - 0w0 :: 215, ~des, Tlon - 0w0 :: 216, ~ret, Tlon - 0w0 :: 217, ~dun, Tlon - 0w0 :: 218, ~ler, Tlon - 0w10.w0AUz.QVdks.HCNvf.ja~TO :: 219, ~nyr, Ivan Matosevic - 0w0 :: 220, ~seb, Tlon - 0w0 :: 221, ~hul, Tlon - 0w0 :: 222, ~ryl, Tlon - 0w0 :: 223, ~lud, Tlon - 0w0 :: 224, ~rem, Tlon - 0w0 :: 225, ~lys, Tlon - 0w3C.YXlEl.pFbYV.9pYWI.d7cla :: 226, ~fyn, Stephen Burnham - 0w0 :: 227, ~wer, Tlon - 0w0 :: 228, ~ryc, Tlon - 0w0 :: 229, ~sug, Tlon - 0w0 :: 230, ~nys, Tlon - 0w0 :: 231, ~nyl, Tlon - 0w0 :: 232, ~lyn, Tlon - 0w0 :: 233, ~dyn, Tlon - 0w0 :: 234, ~dem, Tlon - 0w0 :: 235, ~lux, Tlon Investor 15 - 0w0 :: 236, ~fed, Tlon - 0w0 :: 237, ~sed, Tlon - 0w0 :: 238, ~bec, Tlon - 0w0 :: 239, ~mun, Tlon - 0w0 :: 240, ~lyr, Tlon - 0w0 :: 241, ~tes, Tlon - 0w0 :: 242, ~mud, Ian Rowan - 0w4.yybWD.F1BgE.ynzlF.47neH :: 243, ~nyt, Byrne Hobart - 0w0 :: 244, ~byr, Tlon - 0w0 :: 245, ~sen, Tlon - 0w0 :: 246, ~weg, Tlon - 0w28.bRVMq.Oi3tM.zOCNV.j00Yq :: 247, ~fyr, Anton Dyudin - 0w0 :: 248, ~mur, Tlon - 0w0 :: 249, ~tel, Tlon - 0w3D.onYhb.3wvaz.62Ct8.nt3iJ :: 250, ~rep, Raymond Pasco - 0w0 :: 251, ~teg, Tlon - 0w0 :: 252, ~pec, Tlon - 0w0 :: 253, ~nel, Tlon - 0w0 :: 254, ~nev, Tlon - 0wY.a0HAU.7Lbkf.6V514.OsJBv :: 255, ~fes, John Burnham - == - -- - :::::::::::::::::::::::::::::::::::::::::::::::::::::::: - :: section 4aB, packet format :: - :: - |% - ++ bite :: packet to cake - |= pac/rock ^- cake - =+ [mag=(end 5 1 pac) bod=(rsh 5 1 pac)] - =+ :* vez=(end 0 3 mag) :: protocol version - chk=(cut 0 [3 20] mag) :: checksum - wix=(bex +((cut 0 [23 2] mag))) :: width of receiver - vix=(bex +((cut 0 [25 2] mag))) :: width of sender - tay=(cut 0 [27 5] mag) :: message type - == - ?> =(7 vez) - ?> =(chk (end 0 20 (mug bod))) - :+ [(end 3 wix bod) (cut 3 [wix vix] bod)] - (kins tay) - (rsh 3 (add wix vix) bod) - :: - ++ kins |=(tay/@ (snag tay `(list skin)`[%none %open %fast %full ~])) - ++ ksin |=(sin/skin `@`?-(sin $none 0, $open 1, $fast 2, $full 3)) - ++ spit :: cake to packet - |= kec/cake ^- @ - =+ wim=(met 3 p.p.kec) - =+ dum=(met 3 q.p.kec) - =+ yax=?:((lte wim 2) 0 ?:((lte wim 4) 1 ?:((lte wim 8) 2 3))) - =+ qax=?:((lte dum 2) 0 ?:((lte dum 4) 1 ?:((lte dum 8) 2 3))) - =+ wix=(bex +(yax)) - =+ vix=(bex +(qax)) - =+ bod=:(mix p.p.kec (lsh 3 wix q.p.kec) (lsh 3 (add wix vix) r.kec)) - =+ tay=(ksin q.kec) - %+ mix - %+ can 0 - :~ [3 7] - [20 (mug bod)] - [2 yax] - [2 qax] - [5 tay] - == - (lsh 5 1 bod) - -- - :::::::::::::::::::::::::::::::::::::::::::::::::::::::: - :: section 4aC, PKI engine :: - :: - |% - ++ go :: go - |_ ton/town :: ames state - ++ as :: as:go - |_ {our/ship saf/sufi} :: per server - ++ born :: born:as:go - |= {now/@da her/@p tic/@pG ges/gens pub/pass} :: register user - ^- {(unit wyll) _+>} - ?. =(our (sein:title her)) [~ +>.$] - =+ nes=sen - =+ ryt=(end 6 1 (shaf %tick (mix her (shax sec:ex:q.nes)))) - ?. =(tic ryt) - ~& [%ames-wrong-ticket `@p`ryt] - [~ +>.$] - =+ rad=(~(get by hoc.saf) her) - ?^ rad - ?. ?=(^ lew.wod.u.rad) - $(hoc.saf (~(del by hoc.saf) her)) :: XX how can this be? - ?. =(pub r.q.i.lew.wod.u.rad) [~ +>.$] - [[~ lew.wod.u.rad] +>.$] - =+ syp=[[0 [~ p.nes] her now] ges pub] - =+ ded=[(sign:as:q.nes *code (shaf %meld (sham syp))) syp fak.ton] - =+ wil=[ded law.saf] - ?> =(wil (grip wil ~)) - :- [~ wil] - +>.$(hoc.saf (~(put by hoc.saf) her [[~31337.1.1 ~ wil] ~ *clot])) - :: - ++ lax :: lax:as:go - |_ {her/ship dur/door} :: security engine - ++ cluy :: cluy:lax:as:go - ^- {p/life q/gens r/acru} :: client crypto - ?~ lew.wod.dur !! - ?. =(fak.ton r.i.lew.wod.dur) ~|([%client-wrong-fake her] !!) - :+ p.p.q.i.lew.wod.dur - q.q.i.lew.wod.dur - (haul:suite r.q.i.lew.wod.dur) - :: - ++ clon - ^- life - ?~(lew.wod.dur 0 p.p.q.i.lew.wod.dur) - :: - ++ deng - |= law/wyll - %_(+> lew.wod.dur (grip law lew.wod.dur)) - :: - ++ griz :: griz:lax:as:go - |= now/@da :: generate key for - ^- {p/code q/_+>} - =+ key=(shas %enty (mix now any.ton)) - :- key - %= +>.$ - any.ton (shax (mix now any.ton)) - heg.caq.dur (~(put by heg.caq.dur) (shaf %hand key) key) - == - :: - ++ pode :: pode:lax:as:go - |= now/@da :: timeout route - ^+ +> - ?: (lth her 256) +>(lun.wod.dur [~ %if ~2000.1.1 0 (mix her .0.0.1.0)]) - +>(lun.wod.dur ~) - :: - ++ kuch :: kuch:lax:as:go - |= had/hand :: hear key tag - ^- (unit {code _+>}) - =+ wey=(~(get by heg.caq.dur) had) - ?^ wey - =+ key=u.wey - :+ ~ key - %= ..kuch - yed.caq.dur [~ had u.wey] - heg.caq.dur (~(del by heg.caq.dur) had) - qim.caq.dur (~(put by qim.caq.dur) had key) - == - =+ dyv=(~(get by qim.caq.dur) had) - ?~ dyv ~ - [~ u.dyv ..kuch] - :: - ++ wasc :: wasc:lax:as:go - |= key/code :: hear foreign code - ^+ +> - =+ had=(shaf %hand key) - %_ ..wasc - yed.caq.dur [~ had key] - qim.caq.dur (~(put by qim.caq.dur) had key) - == - :: - ++ wast :: wast:lax:as:go - |= ryn/lane :: set route - ^+ +> - %= +> - lun.wod.dur - ?: ?=({$ix *} ryn) - ?: ?| ?=($~ lun.wod.dur) - ?=({$ix *} u.lun.wod.dur) - ?& ?=({$if *} u.lun.wod.dur) - (gth p.ryn (add ~s10 p.u.lun.wod.dur)) - == - == - [~ ryn] - lun.wod.dur - [~ ryn] - == - :: - ++ wist :: wist:lax:as:go - |= $: now/@da :: route via - waz/(list @p) - ryn/(unit lane) - pac/rock - == - ^- (list boon) - ?: =(our her) [[%ouzo *lane pac] ~] - ?~ waz ~ - =+ dyr=?:(=(her i.waz) dur (gur i.waz)) - ?. ?& !=(our i.waz) - ?=(^ lun.wod.dyr) - == - :: ~& [%wist-skip i.waz lun.wod.dyr] - $(waz t.waz) - :_ ?: ?=($ix -.u.lun.wod.dyr) - $(waz t.waz) - ~ - :+ %ouzo u.lun.wod.dyr - ?: &(=(i.waz her) =(~ ryn)) pac - =+ mal=(jam `meal`[%fore her ryn pac]) - %- spit - ^- cake - :* [our i.waz] - ?~ yed.caq.dyr [%none mal] - :- %fast - %^ cat 7 - p.u.yed.caq.dyr - (en:crua q.u.yed.caq.dyr mal) - == - :: - ++ xeno :: xeno:lax:as:go - ^- (list ship) :: foreign canon - (saxo:title her) - :: - ++ xong :: xong:lax:as:go - ^- (list ship) :: route unto - =+ [fro=xen too=xeno] - =+ ^= oot ^- (list ship) - =| oot/(list ship) - |- ^+ oot - ?~ too ~ - ?: (lien fro |=(a/ship =(a i.too))) ~ - [i.too $(too t.too)] - :: ~& [%xong-to [our her] (weld oot ?>(?=(^ fro) t.fro))] - (weld oot ?>(?=(^ fro) t.fro)) - :: - ++ zuul :: zuul:lax:as:go - |= {now/@da ham/meal} :: encode message - ^- (list rock) - =< weft - |% - ++ wain :: message identity - ^- flea - ?+ -.ham [0 0] - $bond p.ham - $carp [kos liq]:p.ham - == - :: - ++ wasp :: null security - ^-({p/skin q/@} [%none (jam ham)]) - :: - ++ weft :: fragment message - ^- (list rock) - =+ gim=wisp - =+ wit=(met ?:(fak.ton 13 13) q.gim) - ?< =(0 wit) - ?: |(?=($back -.ham) =(1 wit)) - =+ yup=(spit [our her] p.gim q.gim) - [yup ~] - =+ ruv=(rip ?:(fak.ton 13 13) q.gim) - =+ inx=0 - |- ^- (list rock) - ?~ ruv ~ - =+ ^= vie - %+ spit - [our her] - wasp(ham [%carp [wain (ksin p.gim) wit] inx i.ruv]) - :- vie - $(ruv t.ruv, inx +(inx)) - :: - ++ wisp :: generate message - ^- {p/skin q/@} - ?: =(%carp -.ham) - wasp - ?: !=(~ yed.caq.dur) - ?> ?=(^ yed.caq.dur) - :- %fast - %^ cat 7 - p.u.yed.caq.dur - (en:r:cluy q.u.yed.caq.dur (jam ham)) - ?: &(=(~ lew.wod.dur) |(=(%back -.ham))) - wasp - =^ tuy +>.$ - ?:(=(~ lew.wod.dur) [*code +>.$] (griz now)) - =+ yig=sen - :: =+ bil=`wyll`(pare wyl.dur law.saf) :: XX not set - =+ bil=law.saf :: XX send whole wyll - =+ hom=(jam ham) - ?: =(~ lew.wod.dur) - :- %open - %^ jam - [~ `life`p.yig] - bil - (sign:as:q.yig tuy hom) - :- %full - =+ cay=cluy - %^ jam - [`life`p.cay `life`p.yig] - bil - (seal:as:q.yig pub:ex:r.cay tuy hom) - -- :: --zuul:lax:as:go - -- :: --lax:as:go - :: - ++ gur :: default door - |= her/ship - ^- door - =+ def=?.((lth her 256) ~ [~ %if ~2000.1.1 0 (mix her .0.0.1.0)]) - [[~2100.1.1 def ~] ~ *clot] - :: - ++ myx :: door by ship - |= her/ship - ^+ lax - =+ fod=(~(get by hoc.saf) her) - ~(. lax [her ?~(fod (gur her) u.fod)]) - :: - ++ nux :: install door - |= new/_lax - ^+ +> - +>(hoc.saf (~(put by hoc.saf) her.new dur.new)) - :: - ++ sen :: current crypto - ^- {p/life q/acru} - ?~(val.saf !! [p.i.val.saf r.i.val.saf]) - :: - ++ sev :: crypto by life - |= mar/life - ^- {p/? q/acru} - ?~ val.saf !! - ?: =(mar p.i.val.saf) - [& r.i.val.saf] - ?> (lth mar p.i.val.saf) - :- | - |- ^- acru - ?> ?=(^ t.val.saf) - ?: =(mar p.i.t.val.saf) - r.i.t.val.saf - $(t.val.saf t.t.val.saf) - :: - ++ sex :: export secrets - |- ^- mace - ?~ val.saf ~ - :- [p.i.val.saf sec:ex:r.i.val.saf] - $(val.saf t.val.saf) - :: - ++ xen :: canon - |- ^- (list ship) - (saxo:title our) - :: - ++ yew :: best wyll for - |= her/ship - ^- wyll - =+ gel=(~(get by hoc.saf) her) - ?^ gel - lew.wod.u.gel - ?:((lth her 256) ~ $(her (sein:title her))) - -- :: --as:go - :: - ++ ha !: :: adopt new license - |= {our/ship mac/mace wil/wyll} - ^- town - ?> !=(~ mac) - ?> ?=(^ wil) - :: ?> =(our r.p.q.i.wil) - ?> =(wil (grip wil ~)) - ?> (real mac wil) - %_ ton - fak r.i.wil - urb - %+ ~(put by urb.ton) - our - :* %- flop - |- ^- (list ship) - ?:((lth our 256) ~ =+(seg=(sein:title our) [seg $(our seg)])) - :: - (turn mac |=({p/life q/ring} [p q (weur:suite q)])) - wil - ~ - ~ - == - == - :: - ++ su :: install safe - |= new/_as - ^- town - ton(urb (~(put by urb.ton) our.new saf.new)) - :: - ++ ti :: expire by time - |= now/@da - ^- town - !! - :: - ++ us :: produce safe - |= our/ship - ^- (unit _as) - =+ goh=(~(get by urb.ton) our) - ?~ goh ~ - [~ ~(. as [our u.goh])] - -- :: --go - -- - :::::::::::::::::::::::::::::::::::::::::::::::::::::::: - :: section 4aG, protocol engine :: - :: - |% - ++ am :: am - |_ {now/@da fox/fort} :: protocol engine - ++ anon - |= wen/@da - ^- @tas - ?: =(wen now) %now - ?: (gth wen now) - (cat 3 (scot %ud (msec (sub wen now))) %ms) - (cat 3 '-' $(now wen, wen now)) - :: - ++ anun - |= wun/(unit @da) - ^- @tas - ?~(wun %no (anon u.wun)) - :: - ++ anos - |= one/@dr - ^- @tas - ?: =(`@`0 one) '0ms' - (cat 3 (scot %ud (msec one)) %ms) - :: - ++ anus - |= une/(unit @dr) - ^- @tas - ?~(une %no (anos u.une)) - :: - ++ boot :: boot:am - ^- fort :: restore from noun - %= fox - urb.ton - %- ~(gas by *(map ship sufi)) - %+ turn - (~(tap by urb.ton.fox) ~) - |= {p/ship q/sufi} ^- {p/ship q/sufi} - :- p - %= q - val - (turn val.q |=({p/life q/ring r/acru} [p q (weur:suite q)])) - == - == - ++ come :: come:am - |= {ges/(unit @t) wid/@ bur/@ fak/?} :: instantiate pawn - ^- {p/{p/ship q/@uvG} q/fort} - =+ loy=(bruw:suite wid bur) - =+ rig=sec:ex:loy - =+ our=`@p`fig:ex:loy - =+ syp=[[0 ~ our now] [%en %pawn ges] pub:ex:loy] - :- [our pac:ex:loy] - %_ fox - ton - %^ ~(ha go ton.fox) - our - `mace`[[0 rig] ~] - `wyll`[[(sign:as:loy *@ (shaf %self (sham syp))) syp fak] ~] - fak.ton - fak - == - :: - ++ czar !: :: czar:am - |= {her/ship ger/@uw fak/?} :: instantiate emperor - ^- {p/(list boon) q/fort} - ~& [%czar her] - :: - :: fake uses carrier # - :: - =+ loy=?:(fak (bruw:suite 2.048 her) (bruw:suite 2.048 ger)) - =+ fim==(fig:ex:loy (zeno her)) - ?: &(!fak !fim) !! :: not fake & bad fig - =+ mac=`mace`[[0 sec:ex:loy] ~] - =+ syp=`step`[`bray`[0 ~ her now] [%en %czar ~] pub:ex:loy] - =+ ded=`deyd`[(sign:as:loy *@ (shaf %self (sham syp))) syp fak] - =+ buq=`buck`[mac [ded ~]] - =: ton.fox (~(ha go ton.fox) her buq) - zac.fox (~(put by zac.fox) her *corn) - fak.ton.fox fak - == - [[[%beer her pac:ex:loy] ~] fox] - :: - ++ user :: instantiate citizen - |= {her/ship ger/@uw fak/?} - ^- {p/(list boon) q/fort} - =^ out fox (czar her ger fak) - ?: (lth her 256) - [out fox] - :: - :: `ger` is the ticket; make a key out of it (XX use scrypt); - :: install it as a symmetric key. - :: - =+ key=(shax ger) - =+ dad=(sein:title her) - ~& [%user-auth her `@p`ger `@p`(mug key)] - =+ gus=(need (~(us go ton.fox) her)) - =+ diz=(wasc:(myx:gus dad) key) - =. gus (nux:gus diz) - =. ton.fox (~(su go ton.fox) gus) - [out fox] - :: - ++ doze - %^ hunt lth `(add now ~s32) - |- ^- (unit @da) - ?~ zac.fox ~ - ;: (cury hunt lth) - $(zac.fox l.zac.fox) - $(zac.fox r.zac.fox) - doze:(um p.n.zac.fox) - == - :: - ++ gnaw :: gnaw:am - |= {ryn/lane pac/rock} :: process packet - ^- {p/(list boon) q/fort} - ?. =(7 (end 0 3 pac)) [~ fox] - =+ kec=(bite pac) - ?: (goop p.p.kec) [~ fox] - ?. (~(has by urb.ton.fox) q.p.kec) - [~ fox] - =< zork - =< abet - :: ~& [%in p.p.kec (flam (shaf %flap pac))] - %- chew:(ho:(um q.p.kec) p.p.kec) - [q.kec (shaf %flap pac) ryn r.kec] - :: - ++ goop :: blacklist - |= him/ship - | - :: - ++ have :: have:am - |= {our/ship buq/buck} :: acquire license - ^- {p/(list boon) q/fort} - =: ton.fox (~(ha go ton.fox) our buq) - zac.fox (~(put by zac.fox) our *corn) - == - [[[%beer our pac:ex:q:sen:(need (~(us go ton.fox) our))] ~] fox] - :: - ++ kick :: kick:am - |= hen/duct :: refresh net - =+ aks=(turn (~(tap by urb.ton.fox) ~) |=({p/ship q/sufi} p)) - |- ^- {p/(list boon) q/fort} - ?~ aks [~ fox] - =^ buz fox zork:(kick:(um i.aks) hen) - =^ biz fox $(aks t.aks) - [(weld p.buz p.biz) fox] - :: - ++ rack :: ruck:am - |= {soq/sock kos/bole cop/coop} :: new e2e ack - ^- {p/(list boon) q/fort} - zork:abet:(hike:(ho:(um p.soq) q.soq) kos cop) - :: - ++ wake :: wake:am - |= hen/duct :: harvest packets - =+ caz=zac.fox - |- ^- {p/(list boon) q/fort} - ?~ caz [~ fox] - =^ lef fox $(caz l.caz) - =^ ryt fox $(caz r.caz) - =^ bun fox zork:(wake:(um p.n.caz) hen) - :_(fox :(weld p.lef p.ryt p.bun)) - :: - ++ wise :: wise:am - |= {soq/sock hen/duct cha/path val/*} :: send request - ^- {p/(list boon) q/fort} - zork:abet:ve-abet:(ve-tell:(vend:(ho:(um p.soq) q.soq) hen) cha val) - :: - ++ wish :: wise:am - |= {soq/sock kos/bole cha/path val/*} :: return response - ^- {p/(list boon) q/fort} - zork:abet:ve-abet:(ve-tell:(vand:(ho:(um p.soq) q.soq) kos) cha val) - :: - :: - ++ um :: per server - |= our/ship - =+ gus=(need (~(us go ton.fox) our)) - =+ ^= weg ^- corn - =+ weg=(~(get by zac.fox) our) - ?^(weg u.weg *corn) - =| bin/(list boon) - |% - ++ doze :: doze:um:am - |- ^- (unit @da) :: wakeup time - ?~ wab.weg ~ - ;: (cury hunt lth) - $(wab.weg l.wab.weg) - $(wab.weg r.wab.weg) - doze:(ho p.n.wab.weg) - == - :: - ++ wake :: wake:um:am - |= hen/duct :: activate - =. +> (kick hen) - =+ baw=wab.weg - |- ^+ +>.^$ - ?~ baw +>.^$ - =. +>.^$ $(baw l.baw) - =. +>.^$ $(baw r.baw) - abet:thaw:(ho p.n.baw) - :: - ++ ho :: ho:um:am - |= her/ship :: per friend - =+ diz=(myx:gus her) - =+ bah=(~(get by wab.weg) her) - => .(bah `bath`?~(bah [~ [2 ~ ~] ~] u.bah)) - |% - ++ zest ~ - ++ abet :: abet:ho:um:am - %= +>.$ :: resolve - gus (nux:gus diz) - wab.weg (~(put by wab.weg) her bah) - == - :: - ++ back :: back:ho:um:am - |= {ost/bone dam/flap cop/coop lag/@dr} :: receive ack - ^+ +> - ?: =(`@`0 dam) +> :: dummy ack - ?. (~(has by sal.bah) ost) - ~& [%back-lost ost (flam dam)] - +> - ve-abet:(ve-back:(vand ost) dam cop lag) - :: - ++ busk :: busk:ho:um:am - |= {waz/(list ship) pex/(list rock)} :: send packets - %_ +> - bin - |- ^+ bin - ?~ pex bin - $(pex t.pex, bin (weld (flop (wist:diz now waz ~ i.pex)) bin)) - == - :: - ++ chew :: chew:ho:um:am - |= {sin/skin dam/flap ryn/lane msg/@} :: handle anything - ^+ +> - :: - :: ++chew - :: - =^ fud diz (grok sin ryn msg) - :: ~& [%chew sin -.fud `@p`(mug dam) ryn (met 3 msg)] - ?- -.fud - $back =. +>.$ ?. =(%full sin) +>.$ - :: here we send a dummy ack - :: to complete the key exchange and stop - :: the sender from using %full - :: (conk ~ dam) - :: (conk 0 `@`0 ~) - +>.$ - :: ~& [%chew-back p.fud (flam dam) (flam q.fud)] - (back +.fud) - $bond hi-abet:(hi-bond:(high p.fud dam ryn) q.fud r.fud) - $carp =< hi-abet - %- hi-carp:(high [kos liq]:p.fud dam ryn) - [(kins syn.p.fud) cnt.p.fud q.fud] - $fore (fore ryn +.fud) - == - :: - ++ conk :: conk:ho:um:am - |= {kos/bole dam/flap cop/coop} :: send acknowledge - ^+ +> - ?: =(0 kos) - :: don't ack an ack - ~& [%conk-acaq (flam dam)] - +> - =+ pex=(zuul:diz now [%back (mix 1 kos) dam cop ~s0]) - (busk xong:diz pex) - :: - ++ doze :: doze:ho:um:am - ^- (unit @da) :: wait until - =| wun/(unit @da) - |- ^- (unit @da) - ?~ sal.bah ~ - =. wun $(sal.bah l.sal.bah) - =. wun $(sal.bah r.sal.bah) - =+ nuw=ve-wait:(vond p.n.sal.bah q.n.sal.bah) - ?~(wun nuw ?~(nuw wun `(min u.nuw u.wun))) - :: - ++ fore :: fore:ho:um:am - |= {ryn/lane who/ship via/(unit lane) msg/@} :: forward packet - ^+ +> - =+ ^= lyn ^- lane - ?~ via ryn - ?. ?=($if -.u.via) u.via - [%ix +.u.via] - :: u.via - ?: =(our who) - +>.$(bin [[%mead lyn msg] bin]) - =+ zid=(myx:gus who) - +>.$(bin (weld (flop (wist:zid now xong:zid [~ lyn] msg)) bin)) - :: - ++ grok :: grok:ho:um:am - |= {sin/skin ryn/lane msg/@} :: decode message - ^+ [*meal diz] - :: - :: ++grok decodes a message blob to a ++meal. Decoding - :: affects the orb connection state, diz. - :: - =+ maw=|=(@ ((hard meal) (cue +<))) - =. diz ?:(=(%none sin) diz (wast:diz ryn)) - ?- sin - $none - :: ~& %chew-none - [(maw msg) diz] - :: - $fast - :: ~& %chew-fast - =+ [mag=`hand`(end 7 1 msg) bod=(rsh 7 1 msg)] - =+ dey=(kuch:diz mag) - ?~ dey - ~& [%bad-key her mag] - !! - =^ key diz u.dey - [(maw (dy:q:sen:gus key bod)) diz] - :: - $full - :: ~& %chew-full - =+ mex=((hard {p/{p/life q/life} q/wyll r/@}) (cue msg)) - =. diz (deng:diz q.mex) - =+ wug=cluy:diz - ?> =(q.p.mex p.wug) - =+ gey=(sev:gus p.p.mex) - =+ mes=(need (tear:as:q.gey pub:ex:r.wug r.mex)) - =. diz (wast:(wasc:diz p.mes) ryn) - [(maw q.mes) diz] - :: - $open - :: ~& %chew-open - =+ mex=((hard {p/{$~ q/life} q/wyll r/@}) (cue msg)) - =. diz (deng:diz q.mex) - =+ wug=cluy:diz - ?> =(q.p.mex p.wug) - =. diz (wast:diz ryn) - [(maw (need (sure:as:r.wug *code r.mex))) diz] - == - :: - ++ hike :: hike:ho:um:am - |= {kos/bole cop/coop} :: acknowledgment - ^+ +> - :: ~& [%hike [our her] kos cop] - =+ loc=(~(got by fon.bah) kos) - ?. &(?=(^ laz.loc) =(kos p.p.u.laz.loc)) - ~& [%hike-no-message kos laz.loc] - !! - :: ~& [?~(cop %ro %re) her kos q.p.u.laz.loc] - hi-abet:(~(hi-back hi [kos q.p.u.laz.loc] [& +.u.laz.loc] loc) cop) - :: - ++ high :: high:ho:um:am - |= {fel/flea dam/flap ryn/lane} :: external message - ^+ hi - ~(. hi fel [& dam ryn] (fall (~(get by fon.bah) p.fel) *lock)) - :: - ++ hi :: receiving core - |_ $: $: kos/bole :: sender - liq/tick :: index - == - $: tru/? :: authenticated - fap/flap :: critical flap - ryn/lane :: received from - == - lock - == - ++ hi-abet :: resolve - +>(fon.bah (~(put by fon.bah) kos +<+>)) - :: :: receive message - ++ hi-bond - |= {cha/path val/*} - ^+ +> - ?: (lth liq laq) - :: we already acked this msg; ack it again - :: ~& [%hi-bond-low [kos liq] laq] - hi-cong - ?: (gth liq laq) - :: later than the next msg; ignore - ~& [%hi-bond-high [kos liq] laq] - +> - ?: !=(~ laz) - :: this msg is already being processed; ignore - ~& [%hi-bond-wait [kos liq] laq] - +> - =. nys (~(del by nys) liq) - ?: =(0 (end 0 1 kos)) - ~& [%br her kos cha liq] - =. +>.$ (hi-back ~) - %= +>.$ - bin :_(bin [%malt [our her] (~(got by r.zam.bah) kos) cha val]) - == - ~& [%tr her kos cha liq] - %= +>.$ - bin :_(bin [%milk [our her] kos cha val]) - laz `[[kos liq] fap ryn] - == - :: - ++ hi-back :: app acknowledge - |= cop/coop - ^+ +> - (hi-cone(laq +(laq), laz ~) cop) - :: - ++ hi-carp :: receive fragment - |= {syn/skin cnt/@ud far/(pair @ud @)} - ^+ +> - :: ~& [%carp fap/`@p`(mug fap) syn/syn cnt/cnt far/p.far] - ?: (lth liq laq) - :: ~& [%hi-card-low liq laq] - hi-cong - ?: (gth liq laq) - :: ~& [%hi-card-high liq laq] - +> - =+ neb=`bait`(fall (~(get by nys) liq) [syn 0 [cnt ~]]) - ?> &(=(p.neb syn) (gth p.r.neb p.far) =(p.r.neb cnt)) - =+ doy=(~(get by q.r.neb) p.far) - ?^ doy (hi-conk ~) - =: q.r.neb (~(put by q.r.neb) p.far q.far) - q.neb +(q.neb) - == - ?. =(q.neb p.r.neb) - (hi-conk(nys (~(put by nys) liq neb)) ~) - =^ fud diz (grok syn ryn (hi-golf r.neb)) - =+ sec=?=(?($open $fast $full) syn) - =. tru |(tru sec) - ?: ?=($back -.fud) - ~& [%back-phat [kos p.fud] (flam q.fud) r.fud s.fud] - +>.$(+> (back +.fud)) - ?. &(tru ?=($bond -.fud) =([kos liq] p.fud)) - ~& [%ames-bad-bond tru -.fud [[kos liq] p.fud]] - !! - (hi-bond q.fud r.fud) - :: - ++ hi-cong (hi-conk (~(get by exc) liq)) :: accepted ack - ++ hi-conk :: stated ack - |=(cop/coop +>(+> (conk kos fap cop))) - :: - ++ hi-cone :: record ack - |= cop/coop - =. +>+> (conk kos fap cop) - ?~(cop +> +>(exc (~(put by exc) liq u.cop))) - :: - ++ hi-golf :: golf:hi:ho:um:am - |= duv/dove :: assemble fragments - =+ [nix=0 rax=*(list @)] - |- ^- @ - ?: =(p.duv nix) - (can ?:(fak.ton.fox 13 13) (turn (flop rax) |=(a/@ [1 a]))) - $(nix +(nix), rax [(need (~(get by q.duv) nix)) rax]) - -- - :: - ++ pong :: pong:ho:um:am - |= hen/duct :: test connection - ^+ +> - +> - :: (conk 0 `@`0 ~) - :: :: - ++ thaw :: activate by time - ^+ . - =+ lah=sal.bah - =^ sal + - |- ^+ [lah +>.$] - ?~ lah [~ +>.$] - =^ lef +>.$ $(lah l.lah) - =^ ryt +>.$ $(lah r.lah) - =^ nod +>.$ ve-abed:ve-wake:(vond n.lah) - [[nod lef ryt] +>.$] - +>(sal.bah sal) - :: - ++ ve :: outbound core - |_ $: kos/bole :: - mup/_zu:pump :: - colt :: - == :: - ++ ve-abed [[kos +<+>] +>]:ve-able :: raw resolve - ++ ve-abet :: resolve core - => ve-able - %= +> - sal.bah - (~(put by sal.bah) kos +<+>) - == - :: :: - ++ ve-able :: converge machine - ve-tire:ve-ably:ve-feed:ve-ably - :: :: - ++ ve-ably :: apply pump effects - ^+ . - =^ fex myn abet:mup - =. mup (yawn:pump myn) - |- ^+ +>.$ - ?~ fex +>.$ - %= $ - fex t.fex - +>.$ - ?- -.i.fex - $send - :: ~& [%go her `@p`(mug p.i.fex) q.i.fex] - +>.$(+> (busk xong:diz [r.i.fex ~])) - :: - $good - :: ~& [%ok her `@p`(mug p.i.fex) r.i.fex] - (ve-good q.i.fex s.i.fex) - == - == - :: :: - ++ ve-back :: hear an ack - |= {dam/flap cop/coop lag/@dr} - :: ~& [%ve-back (flam dam) cop lag] - +>(mup (work:mup now %back dam cop lag)) - :: :: - ++ ve-feed :: feed pump - ^+ . - =^ cly . (ve-find want.mup) - :: ~& [%ve-feed want.mup (lent cly)] - +(mup (work:mup now %pack cly)) - :: :: - ++ ve-find :: collect packets - |= may/@ud - ^- {(list clue) _+>} - =- [(flop -<) ->] - =+ [inx=lac hav=*(list clue)] - |- ^- {(list clue) _+>.^$} - ?: |(=(0 may) =(inx seq)) [hav +>.^$] - =^ hey +>.^$ (ve-flow inx may hav) - $(inx +(inx), may p.hey, hav q.hey) - :: :: - ++ ve-flow :: collect from msg - |= {tiq/tick may/@ud hav/(list clue)} - =+ mob=(~(got by cob) tiq) - |- ^- {(pair @ud (list clue)) _+>.^$} - ?: |(=(0 may) ?=($~ cly.mob)) - [[may hav] +>.^$(cob (~(put by cob) tiq mob))] - %= $ - may (dec may) - hav [i.cly.mob hav] - cly.mob t.cly.mob - == - :: :: - ++ ve-good :: handle ack - |= {paz/part cop/coop} - ^+ +> - =+ bum=(~(get by cob) q.paz) - ?: |(?=($~ bum) =(~ cly.u.bum)) - :: ~& [%ve-good-ignore paz ?=($~ cop)] - +>.$ - ?^ cop - :: - :: a failure; save this nack, clear the message - :: - ~& [%ve-good-fail q.paz] - %_ +>.$ - mup (work:mup now %cull q.paz) - cob (~(put by cob) q.paz u.bum(cly ~, cup `cop)) - == - ?> (lth ack.u.bum num.u.bum) - =. ack.u.bum +(ack.u.bum) - =. cup.u.bum ?.(=(ack.u.bum num.u.bum) ~ [~ ~]) - +>.$(cob (~(put by cob) q.paz u.bum)) - :: :: - ++ ve-tire :: report results - |- ^+ + - =+ zup=(~(get by cob) lac) - ?~ zup +.$ - ?~ cup.u.zup +.$ - ~& [?:(=(0 (end 0 1 kos)) %ta %ba) her kos lac] - %= $ - lac +(lac) - cob (~(del by cob) lac) - bin :_ bin - ?: =(1 (end 0 1 kos)) - [%cola [our her] kos [cha u.cup]:u.zup] - [%coke [our her] (~(got by r.zam.bah) kos) [cha u.cup]:u.zup] - == - :: :: - ++ ve-wait :: next wakeup - ^- (unit @da) - wait:mup - :: :: - ++ ve-wake :: timeout - ^+ . - .(mup (flay:mup now)) - :: :: - ++ ve-tell :: send - |= {cha/path val/*} - ^+ +> - =+ pex=(zuul:diz now [%bond [(mix kos 1) seq] cha val]) - ~& [?:(=(0 (end 0 1 kos)) %tx %bx) her kos seq cha (lent pex)] - %_ +>.$ - seq +(seq) - cob - %+ ~(put by cob) - seq - ^- comb - :* ~ - cha - (lent pex) - 0 - =+ inx=0 - |- ?~ pex ~ - :_ $(pex +.pex, inx +(inx)) - [& [inx seq] (shaf %flap i.pex) i.pex] - == - == - -- - :: :: - ++ vind :: default colt - ^- colt - :* 0 :: seq/tick - 0 :: lac/tick - ~ :: cob/(map tick comb) - ^- mini - :* ^- stat - :* :* 0 :: cur/@ud - 2 :: max/@ud - 0 :: rey/@ud - == - :* ~s5 :: rtt/@dr - ~2010.1.1 :: las/@da - ~2010.1.1 :: lad/@da - == == - ~ - ~ - == == - :: :: - ++ vond :: outgoing core - |= {kos/bole cot/colt} - ~(. ve kos (yawn:pump myn.cot) cot) - :: :: - ++ vand :: response core - |= kos/bole - (vond kos (fall (~(get by sal.bah) kos) vind)) - :: :: - ++ vend :: request core - |= hen/duct - ^+ ve - =+ ust=(~(get by q.zam.bah) hen) - ~& [%vend ust hen] - ?~ ust - %. [p.zam.bah vind] - %_ vond - p.zam.bah (add 2 p.zam.bah) - q.zam.bah (~(put by q.zam.bah) hen p.zam.bah) - r.zam.bah (~(put by r.zam.bah) p.zam.bah hen) - == - (vond u.ust (~(got by sal.bah) u.ust)) - -- :: --ho:um:am - :: - ++ kick :: kick:um:am - |= hen/duct :: test connection - ^+ +> - =+ hoy=hoy.saf.gus - |- ^+ +>.^$ - ?~ hoy - +>.^$ - $(hoy t.hoy, +>.^$ (pong i.hoy hen)) - :: - ++ pals :: pals:um:am - ^- (list @p) :: active neighbors - :: XX - ~ - :: - ++ pong :: pong:um:am - |= {her/ship hen/duct} :: test neighbor - ^+ +> - abet:(pong:(ho her) hen) - :: - ++ zork :: zork:um:am - ^- {p/(list boon) q/fort} :: resolve - :- (flop bin) - %_ fox - ton (~(su go ton.fox) gus) - zac (~(put by zac.fox) our.gus weg) - == - -- :: --um:am - -- :: --am - -- - . == - :::::::::::::::::::::::::::::::::::::::::::::::::::::::: - :: section 4aH, protocol vane :: - :: - =| $: fox/fort :: kernel state - == :: - |= {now/@da eny/@ ski/sley} :: current invocation - ^? :: opaque core - =< - |% :: vane interface - ++ call :: handle request - |= $: hen/duct - hic/(hypo (hobo task:able)) - == - => %= . :: XX temporary - q.hic - ^- task:able - ?: ?=($soft -.q.hic) - ((hard task:able) p.q.hic) - ?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic - ~& [%ames-call-flub (@tas `*`-.q.hic)] - ((hard task:able) q.hic) - == - ^- {p/(list move) q/_..^$} - =^ duy ..knob - (knob hen q.hic) - [duy ..^$] - :: - ++ doze - |= {now/@da hen/duct} - ^- (unit @da) - ^doze - :: - ++ load - |= old/fort - ^+ ..^$ - ~& %ames-reload - ..^$(fox old) - :: - ++ scry - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) - ?. ?=($& -.why) ~ - =* who p.why - ?~ tyl [~ ~] - =+ hun=(slaw %p i.tyl) - ?~ hun [~ ~] - ?. =(`@`0 ren) ~ - ?+ lot ~ - {$$ $ud @} - (perm who u.hun q.p.lot [syd t.tyl]) - :: - {$$ $da @} - ?. =(now q.p.lot) ~ - (temp who u.hun [syd t.tyl]) - == - :: - ++ stay fox - ++ take :: accept response - |= {tea/wire hen/duct hin/(hypo sign-arvo)} - ^- {p/(list move) q/_..^$} - =^ duy ..knap - (knap tea hen q.hin) - [duy ..^$] - -- - |% - ++ claw |=(our/ship ^-(duct hen:(need (~(get by zac.fox) our)))) - ++ clod - |= {soq/sock kos/bole cha/path hen/duct cad/card:able} - ^- {(list move) fort} - ?> ?=({@ *} cha) - =+ pax=[(scot %p p.soq) (scot %p q.soq) (scot %ud kos) ~] - =+ ^= did - ^- move - ?+ i.cha ~|([%bad-vane soq hen cha] !!) - $c [hen %pass pax `note-arvo`[%c cad]] - $e [hen %pass pax `note-arvo`[%e cad]] - $g [hen %pass pax `note-arvo`[%g cad]] - == - [[did ~] fox] - :: - ++ clop - |= {now/@da hen/duct bon/boon} - ^- {(list move) fort} - ?- -.bon - $acid :_(fox [[hen [%give %drop ~]] ~]) - $beer - :_ fox(zac (~(put by zac.fox) p.bon `corn`[hen ~])) - ~& [%beer p.bon] - :* [hen [%slip %c %init p.bon]] - [hen [%give %init p.bon]] - [hen [%slip %a %kick now]] - [hen [%slip %e %init p.bon]] - [hen [%slip %g %init p.bon]] - [hen [%slip %d %init p.bon]] :: must be after gall - ~ - == - :: - $cola (clod p.bon q.bon r.bon hen [%went p.bon +.r.bon q.bon s.bon]) - $coke :_(fox [[q.bon [%give %woot q.p.bon r.bon s.bon]] ~]) - $malt :_(fox [[q.bon [%give %waft q.p.bon r.bon s.bon]] ~]) - $mead :_(fox [[hen [%give %hear p.bon q.bon]] ~]) - $milk (clod p.bon q.bon r.bon hen [%west p.bon +.r.bon q.bon s.bon]) - $ouzo - :: ~& [%to (flam (shaf %flap q.bon))] - :_ fox - [[gad.fox [%give %send p.bon q.bon]] ~] - :: - $wine - :_ fox - =+ fom=~(rend co %$ %p q.p.bon) - :~ :- hen - :+ %slip %d - :+ %flog %text - ;: weld - "; " - fom - q.bon - == - == - == - :: - ++ doze - ^- (unit @da) - ~(doze am now fox) - :: - ++ knap - |= {tea/wire hen/duct sih/sign-arvo} - ^- {(list move) _+>} - ?. ?=({@ @ @ $~} tea) - ~& [%knap-tea tea] - !! - =+ [soq kos]=[[(slav %p i.tea) (slav %p i.t.tea)] (slav %ud i.t.t.tea)] - ?+ sih - ~|([%ames-sign -.sih (@tas +<.sih)] !!) - :: - {?($e $c $g) $rend *} - =^ bin fox (~(wish am [now fox]) soq kos p.+>.sih q.+>.sih) - (knit hen bin) - :: - {?($e $c $g) $mack *} - =^ bin fox - (~(rack am [now fox]) soq kos ?~(+>.sih ~ `[~ %lose u.p.+>.sih])) - (knit hen bin) - == - :: - ++ knit - |= {hen/duct bin/(list boon)} - ^- {(list move) _+>} - =| out/(list move) - |- ^+ [out +>.^$] - ?~ bin - [(flop out) +>.^$] - =^ toe fox (clop now hen i.bin) - $(bin t.bin, out (weld (flop toe) out)) - :: - ++ knob - |= {hen/duct kyz/task:able} - ^- {(list move) _+>} - ?: ?=($crud -.kyz) - [[[hen [%slip %d %flog kyz]] ~] +>] - =^ bin fox - ^- {(list boon) fort} - ?- -.kyz - $barn - [~ fox(gad hen)] - $cash - (~(have am [now fox]) p.kyz q.kyz) - :: - ?($want $wegh $west) - !! - :: - $hear - (~(gnaw am [now fox]) p.kyz q.kyz) - :: - $hole - ~& %ames-hole-disabled - [~ fox] - :: - $junk - [~ fox(any.ton (shax (mix any.ton.fox p.kyz)))] - :: - $kick - (~(kick am [now fox(hop p.kyz)]) hen) - :: - $make - =+ vun=(~(come am [now fox]) p.kyz (bex q.kyz) r.kyz s.kyz) - [[[%beer p.vun] ~] q.vun] - :: - $sith - (~(user am [now fox]) p.kyz q.kyz r.kyz) - :: - $wake - (~(wake am [now fox]) hen) - :: - $went - :: we don't send any responses as yet - !! - :: - $wont - (~(wise am [now fox]) p.kyz hen q.kyz r.kyz) - == - (knit hen bin) - :: - ++ perm - |= {our/ship his/ship mar/@ud tyl/path} - ^- (unit (unit cage)) - ?~ tyl ~ - ?: ?=({$name $~} tyl) - =+ wul=$(tyl [%wyll ~]) - :- ~ - :- ~ - :- %noun - !> - ?~ wul - (scot %p his) - (gnow:title his q.q.q:((hard deyd) -.u.wul)) - ?: ?=({$gcos $~} tyl) - =+ wul=$(tyl [%wyll ~]) - ?~(wul ~ ``[%noun !>(`gcos`q.q.q:((hard deyd) -.u.wul))]) - =+ gys=(~(us go ton.fox) our) - ?~ gys ~ - ?. =(our his) - ?: ?=({$wyll $~} tyl) - =+ fod=(~(get by hoc.saf.u.gys) his) - ?~ fod ~ - %+ bind (rick mar his lew.wod.u.fod) - |=(a/wyll `[%noun !>(a)]) - ?: ?=({$tick $~} tyl) - ?. =(our (sein:title his)) ~ - ``[%noun !>((end 6 1 (shaf %tick (mix his (shax sec:ex:q:sen:u.gys)))))] - ~ - ?: ?=({$buck $~} tyl) - =+ muc=(rice mar sex:u.gys) - =+ luw=(rick mar our law.saf.u.gys) - ?. &(?=(^ muc) ?=(^ luw)) ~ - ``[%noun !>(`buck`[u.muc u.luw])] - ?: ?=({$code $~} tyl) - ``[%noun !>((end 6 1 (shaf %pass (shax sec:ex:q:sen:u.gys))))] - ?: ?=({$wyll $~} tyl) - (bind (rick mar our law.saf.u.gys) |=(a/wyll `[%noun !>(a)])) - ~ - :: - ++ temp - |= {our/ship his/ship tyl/path} - ^- (unit (unit cage)) - ?: ?=({?($show $tell) *} tyl) - ?^ t.tyl [~ ~] - =+ gys=(~(us go ton.fox) our) - ?~ gys [~ ~] - =+ zet=zest:(ho:(~(um am [now fox]) our) his) - ``[%noun ?:(=(%show i.tyl) !>(>zet<) !>(zet))] - ?: ?=({$pals $~} tyl) - ?. =(our his) - ~ - ``[%noun !>(pals:(~(um am [now fox]) our))] - ?. ?=({$life $~} tyl) - =+ muc=$(tyl [%life ~]) - (perm our his ?~(muc 0 (@ud u.muc)) tyl) - =+ gys=(~(us go ton.fox) our) - ?~ gys ~ - ?. =(our his) - =+ fod=(~(get by hoc.saf.u.gys) his) - ?~ fod ~ - ?~ lew.wod.u.fod ~ - ``[%noun !>(`@ud`p.p.q.i.lew.wod.u.fod)] - ?~ val.saf.u.gys ~ - ``[%noun !>(`@ud`p.i.val.saf.u.gys)] - :: - ++ wegh - ^- mass - :- %ames - :- %| - :~ fox+[%& fox] - == - -- diff --git a/neo/van/behn.hoon b/neo/van/behn.hoon deleted file mode 100644 index 31999b6a6..000000000 --- a/neo/van/behn.hoon +++ /dev/null @@ -1,225 +0,0 @@ -!: :: %behn, just a timer -!? 164 -:::: -=, behn -|= pit/vase -=> =~ -|% -++ sqeu |* {a/_* b/_*} :: binary skew queno - $: r/@u :: rank+depth - k/a :: priority - n/b :: value - c/(broq a b) :: children - == :: -++ broq |* {a/_* b/_*} :: brodal skew qeu - (list (sqeu a b)) :: -++ move {p/duct q/(wind note gift:able)} :: local move -++ note $~ :: out request $-> -++ sign $~ :: in result $<- -++ clok (broq @da duct) :: stored timers --- -:: -|% -++ raze - |= tym/{p/clok q/clok} - ^+ tym - ?~ p.tym tym - ?~ q.tym tym - ?: (gth p:~(get up p.tym) p:~(get up q.tym)) :: killed nonexisting - ~& [%snooze-lost del=p:~(get up q.tym) top=p:~(get up p.tym)] - $(q.tym ~(pop up q.tym)) - ?: =(~(get up p.tym) ~(get up q.tym)) - $(tym [~(pop up p.tym) ~(pop up q.tym)]) - tym -:: -++ up :: priority queue - =+ [key=@da val=duct] - =+ cmp=lte :: lte=min, gte=max - => |% - ++ link - |= {p/(sqeu key val) q/(sqeu key val)} :: link eq rank - ^- (sqeu key val) - ?> =(r.p r.q) - ?: (cmp k.p k.q) - [r=+(r.p) k=k.p n=n.p c=[i=q t=c.p]] - [r=+(r.q) k=k.q n=n.q c=[i=p t=c.q]] - :: - ++ sink :: skew link - |= {p/(sqeu key val) q/(sqeu key val) r/(sqeu key val)} - ^- (sqeu key val) - ?: &((cmp k.q k.p) (cmp k.q k.r)) - [r=+(r.q) k=k.q n=n.q c=[i=p t=[i=r t=c.q]]] - ?: &((cmp k.r k.p) (cmp k.r k.q)) - [r=+(r.r) k=k.r n=n.r c=[i=p t=[i=q t=c.r]]] - [r=+(r.q) k=k.p n=n.p c=[i=q t=[i=r t=~]]] - :: - ++ sert :: internal ins op - |= {p/(sqeu key val) q/(broq key val)} - ^- (broq key val) - ?~ q [p ~] - ?> (lte r.p r.i.q) - ?: (lth r.p r.i.q) - [i=p t=q] - $(p (link p i.q), q t.q) - :: - ++ uniq :: remove init dup - |= q/(broq key val) - ?~ q ~ - (sert i.q t.q) - :: - ++ meek :: unique meld - |= {p/(broq key val) q/(broq key val)} - ^- (broq key val) - ?~ p q - ?~ q p - ?: (lth r.i.p r.i.q) - [i.p $(p t.p)] - ?: (lth r.i.q r.i.p) - [i.q $(q t.q)] - (sert (link i.p i.q) $(p t.p, q t.q)) - :: - ++ mini :: getmin - |= q/(broq key val) - ^- p/{(sqeu key val) (broq key val)} - ?~ q ~|(%fatal-mini-empty !!) - ?~ t.q [i=i.q t=~] - =+ [l r]=$(q t.q) - ?: (cmp k.i.q k.l) - [i.q t.q] - [l [i.q r]] - :: - ++ spit :: split - |= {p/(broq key val) q/(list {k/key n/val}) r/(broq key val)} - ^- {t/(broq key val) x/(list {k/key n/val})} - ?~ r - [t=p x=q] - ?: =(0 r.i.r) - $(q [[k=k.i.r n=n.i.r] q], r t.r) - $(p [i.r p], r t.r) - -- - |_ a/(broq key val) :: public interface - ++ put :: insert element - |= {k/key n/val} - ^+ a - ?~ a [i=[r=0 k=k n=n c=~] t=~] - ?~ t.a [i=[r=0 k=k n=n c=~] t=a] - ?: =(r.i.a r.i.t.a) - [i=(sink [r=0 k=k n=n c=~] i.a i.t.a) t=t.t.a] - [i=[r=0 k=k n=n c=~] t=a] - :: - ++ pop :: remove top - ^+ a - =+ ?~ a ~|(%empty-broq-pop !!) - [l r]=(mini a) - =+ [t x]=(spit ~ ~ c.l) - =. a r - =. a (uni t) - (gas x) - :: - ++ gas - |= b/(list {k/key n/val}) - ^+ a - (roll b |=({{k/key n/val} q/_a} (put(a q) k n))) - :: - ++ tap - ^- (list {k/key n/val}) - ?~ a ~ - [get tap(a pop)] - :: - ++ get :: retrieve top - ^- {p/key q/val} - ?~ a ~|(%empty-broq-peek !!) - ?~ t.a [k n]:i.a - =+ m=get(a t.a) - ?.((cmp k.i.a p.m) m [k n]:i.a) - :: - ++ uni :: merge - |= q/(broq key val) - ^+ a - (meek (uniq a) (uniq q)) - -- --- -. == -=| $: $0 :: - tym/{p/clok q/clok} :: positive+negative - == :: -|= {now/@da eny/@ ski/sley} :: current invocation -^? -|% :: poke+peek pattern -++ call :: handle request - |= $: hen/duct - hic/(hypo (hobo task:able)) - == - ^- {p/(list move) q/_..^$} - => %= . :: XX temporary - q.hic - ^- task:able - ?: ?=($soft -.q.hic) - :: ~& [%behn-call-soft (,@tas `*`-.p.q.hic)] - ((hard task:able) p.q.hic) - ?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic - ~& [%behn-call-flub (@tas `*`-.q.hic)] - ((hard task:able) q.hic) - == - =^ mof tym - ?- -.q.hic - $rest - =. q.tym (~(put up q.tym) p.q.hic hen) - =. tym (raze tym) - [~ tym] - :: - $wait - =. p.tym (~(put up p.tym) p.q.hic hen) - =. tym (raze tym) - [~ tym] - :: - $wake - |- ^+ [*(list move) tym] - =. tym (raze tym) - ?: =([~ ~] tym) [~ tym] :: XX TMI - ?: =(~ p.tym) - ~& %weird-wake [~ tym] - =+ nex=~(get up p.tym) - ?: (lte now p.nex) [~ tym] - =^ mof tym $(p.tym ~(pop up p.tym)) - [[`move`[q.nex %give %wake ~] mof] tym] - :: - $wegh - :_ tym :_ ~ - :^ hen %give %mass - :- %behn - :- %| - :~ tym+[%& tym] - == - == - [mof ..^$] -:: -++ doze - |= {now/@da hen/duct} - ^- (unit @da) - ?~ p.tym ~ - (some p:[~(get up p.tym)]) -:: -++ load - |= old/{$0 tym/{clok clok}} - ^+ ..^$ - ..^$(tym tym.old) -:: -++ scry - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) - ?. ?=($& -.why) ~ - =* who p.why - =+ ^= liz - |- ^- (list {@da duct}) - =. tym (raze tym) - ?~ p.tym ~ - [~(get up p.tym) $(p.tym ~(pop up p.tym))] - [~ ~ %tank !>(>liz<)] -:: -++ stay [%0 tym] -++ take :: process move - |= {tea/wire hen/duct hin/(hypo sign)} - ^+ [p=*(list move) q=..^$] - !! --- diff --git a/neo/van/clay.hoon b/neo/van/clay.hoon deleted file mode 100644 index 5306bc849..000000000 --- a/neo/van/clay.hoon +++ /dev/null @@ -1,3726 +0,0 @@ -:: -:: clay (4c), revision control -:: -:: This is split in three top-level sections: structure definitions, main -:: logic, and arvo interface. -:: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -:: -:: Here are the structures. `++raft` is the formal arvo state. It's also -:: worth noting that many of the clay-related structures are defined in zuse. -:: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -|= pit/vase -=, clay -=> |% -++ aeon @ud :: version number -:: -:: Recursive structure of a desk's data. -:: -:: We keep an ankh only for the current version of local desks. Everywhere -:: else we store it as (map path lobe). -:: -++ ankh :: expanded node - $: fil/(unit {p/lobe q/cage}) :: file - dir/(map @ta ankh) :: folders - == :: -:: -:: Part of ++mery, representing the set of changes between the mergebase and -:: one of the desks being merged. -:: -:: -- `new` is the set of files in the new desk and not in the mergebase. -:: -- `cal` is the set of changes in the new desk from the mergebase except -:: for any that are also in the other new desk. -:: -- `can` is the set of changes in the new desk from the mergebase and that -:: are also in the other new desk (potential conflicts). -:: -- `old` is the set of files in the mergebase and not in the new desk. -:: -++ cane - $: new/(map path lobe) - cal/(map path lobe) - can/(map path cage) - old/(map path $~) - == -:: -:: Type of request. -:: -:: %d produces a set of desks, %u checks for existence, %v produces a ++dome of -:: all desk data, %w with a time or label case gets the aeon at that case, %w -:: with a number case is not recommended, %x gets file contents, %y gets a -:: directory listing, and %z gets a recursive hash of the file contents and -:: children. -:: -:: ++ care ?($d $u $v $w $x $y $z) -:: -:: Keeps track of subscribers. -:: -:: A map of requests to a set of all the subscribers who should be notified -:: when the request is filled/updated. -:: -++ cult (jug rove duct) -:: -:: Domestic desk state. -:: -:: Includes subscriber list, dome (desk content), possible commit state (for -:: local changes), and possible merge state (for incoming merges). -:: -++ dojo - $: qyx/cult :: subscribers - dom/dome :: desk state - dok/(unit dork) :: commit state - mer/(unit mery) :: merge state - == -:: -:: Desk state. -:: -:: Includes a checked-out ankh with current content, most recent version, map -:: of all version numbers to commit hashes (commits are in hut.rang), and map -:: of labels to version numbers. -:: -++ dome - $: ank/ankh :: state - let/aeon :: top id - hit/(map aeon tako) :: versions by id - lab/(map @tas aeon) :: labels - == :: -:: -:: Commit state. -:: -:: -- `del` is the paths we're deleting. -:: -- `ink` is the insertions of hoon files (short-circuited for -:: bootstrapping). -:: -- `ins` is all the other insertions. -:: -- `dig` is all the %dif changes (i.e. we were given a diff to apply). -:: -- `dif` is the diffs in `dig` applied to their files. -:: -- `muc` is all the %mut changes (i.e. we were give a new version of a -:: file). -:: -- `muh` is the hashes of all the new content in `muc`. -:: -- `mut` is the diffs between `muc` and the original files. -:: -- `mim` is a cache of all new content that came with a mime mark. Often, -:: we need to convert to mime anyway to send to unix, so we just keep it -:: around. -:: -++ dork :: diff work - $: del/(list path) :: deletes - ink/(list (pair path cage)) :: hoon inserts - ins/(unit (list (pair path cage))) :: inserts - dig/(map path cage) :: store diffs - dif/(unit (list (trel path lobe cage))) :: changes - muc/(map path cage) :: store mutations - muh/(map path lobe) :: store hashes - mut/(unit (list (trel path lobe cage))) :: mutations - mim/(map path mime) :: mime cache - == :: -:: -:: Hash of a blob, for lookup in the object store (lat.ran) -:: -++ lobe @uvI :: blob ref -:: -:: Merge state. -:: -:: Merges are said to be from 'ali' to 'bob'. See ++me for more details. -:: -:: -- `sor` is the urbit and desk of ali. -:: -- `hen` is the duct that instigated the merge. -:: -- `gem` is the merge strategy. These are described in `++fetched-ali`. -:: -- `wat` is the current step of the merge process. -:: -- `cas` is the case in ali's desk that we're merging from. -:: -- `ali` is the commit from ali's desk. -:: -- `bob` is the commit from bob's desk. -:: -- `bas` is the commit from the mergebase. -:: -- `dal` is the set of changes from the mergebase to ali's desk. -:: -- `dob` is the set of changes from the mergebase to bob's desk. -:: Check ++cane for more details on these two -:: -- `bof` is the set of changes to the same files in ali and bob. Null for -:: a file means a conflict while a cage means the diffs have been merged. -:: -- `bop` is the result of patching the original files with the above merged -:: diffs. -:: -- `new` is the newly-created commit. -:: -- `ank` is the ankh for the new state. -:: -- `erg` is the sets of files that should be told to unix. True means to -:: write the file while false means to delete the file. -:: -- `gon` is the return value of the merge. On success we produce a set of -:: the paths that had conflicting changes. On failure we produce an error -:: code and message. -:: -++ mery :: merge state - $: sor/(pair ship desk) :: merge source - hen/duct :: formal source - gem/germ :: strategy - wat/wait :: waiting on - cas/case :: ali's case - ali/yaki :: ali's commit - bob/yaki :: bob's commit - bas/yaki :: mergebase - dal/cane :: diff(bas,ali) - dob/cane :: diff(bas,bob) - bof/(map path (unit cage)) :: conflict diffs - bop/(map path cage) :: conflict patches - new/yaki :: merge(dal,dob) - ank/ankh :: new state - erg/(map path ?) :: ergoable changes - gon/(each (set path) (pair term (list tank))) :: return value - == :: -:: -:: Like a ++mood, except with a cache of the state at the starting version. -:: -++ moot {p/case q/case r/path s/(map path lobe)} :: stored change range -:: -:: New desk data. -:: -:: Sent to other ships to update them about a particular desk. Includes a map -:: of all new aeons to hashes of their commits, the most recent aeon, and sets -:: of all new commits and data. -:: -++ nako :: subscription state - $: gar/(map aeon tako) :: new ids - let/aeon :: next id - lar/(set yaki) :: new commits - bar/(set plop) :: new content - == :: -:: -:: Formal vane state. -:: -:: -- `fat` is a collection of our domestic ships. -:: -- `hoy` is a collection of foreign ships where we know something about -:: their clay. -:: -- `ran` is the object store. -:: -- `mon` is a collection of mount points (mount point name to urbit -:: location). -:: -- `hez` is the unix duct that %ergo's should be sent to. -:: -++ raft :: filesystem - $: fat/(map ship room) :: domestic - hoy/(map ship rung) :: foreign - ran/rang :: hashes - mon/(map term beam) :: mount points - hez/(unit duct) :: sync duct - == :: -:: -:: Object store. -:: -:: Maps of commit hashes to commits and content hashes to content. -:: -++ rang :: - $: hut/(map tako yaki) :: - lat/(map lobe blob) :: - == :: -:: -:: Unvalidated response to a request. -:: -:: Like a ++rant, but with a page of data rather than a cage of it. -:: -++ rand :: unvalidated rant - $: p/{p/care q/case r/@tas} :: clade release book - q/path :: spur - r/page :: data - == :: -:: -:: Generic desk state. -:: -:: -- `lim` is the most recent date we're confident we have all the -:: information for. For local desks, this is always `now`. For foreign -:: desks, this is the last time we got a full update from the foreign -:: urbit. -:: -- `ref` is a possible request manager. For local desks, this is null. -:: For foreign desks, this keeps track of all pending foreign requests -:: plus a cache of the responses to previous requests. -:: -- `qyx` is the set of subscriptions, with listening ducts. These -:: subscriptions exist only until they've been filled. -:: -- `dom` is the actual state of the filetree. Since this is used almost -:: exclusively in `++ze`, we describe it there. -:: -- `dok` is a possible set of outstanding requests to ford to perform -:: various tasks on commit. This is null iff we're not in the middle of -:: a commit. -:: -- `mer` is the state of a possible pending merge. This is null iff -:: we're not in the middle of a merge. Since this is used almost -:: exclusively in `++me`, we describe it there. -:: -++ rede :: universal project - $: lim/@da :: complete to - ref/(unit rind) :: outgoing requests - qyx/cult :: subscribers - dom/dome :: revision state - dok/(unit dork) :: outstanding diffs - mer/(unit mery) :: outstanding merges - == :: -:: -:: Foreign request manager. -:: -:: When we send a request to a foreign ship, we keep track of it in here. This -:: includes a request counter, a map of request numbers to requests, a reverse -:: map of requesters to request numbers, a simple cache of common %sing -:: requests, and a possible nako if we've received data from the other ship and -:: are in the process of validating it. -:: -++ rind :: request manager - $: nix/@ud :: request index - bom/(map @ud {p/duct q/rave}) :: outstanding - fod/(map duct @ud) :: current requests - haw/(map mood (unit cage)) :: simple cache - nak/(unit nako) :: pending validation - == :: -:: -:: Domestic ship. -:: -:: `hun` is the duct to dill, and `dos` is a collection of our desks. -:: -++ room :: fs per ship - $: hun/duct :: terminal duct - dos/(map desk dojo) :: native desk - == :: -:: -:: Stored request. -:: -:: Like a ++rave but with caches of current versions for %next and %many. -:: Generally used when we store a request in our state somewhere. -:: -++ rove :: stored request - $% {$sing p/mood} :: single request - {$next p/mood q/(unit (each cage lobe))} :: next version - {$many p/? q/moot} :: change range - == :: -:: -:: Foreign desk data. -:: -++ rung rus/(map desk rede) :: neighbor desks -:: -:: Hash of a commit, for lookup in the object store (hut.ran) -:: -++ tako @ :: yaki ref -:: -:: Merge state. -:: -++ wait $? $null $ali $diff-ali $diff-bob :: what are we - $merge $build $checkout $ergo :: waiting for? - == :: -:: -:: Commit. -:: -:: List of parents, content, hash of self, and time commited. -:: -++ yaki :: snapshot - $: p/(list tako) :: parents - q/(map path lobe) :: fileset - r/tako :: - :: :: XX s? - t/@da :: date - == :: -:: -:: Unvalidated blob -:: -++ plop blob :: unvalidated blob --- => -|% -++ move {p/duct q/(wind note gift:able)} :: local move -++ gift :: out result <-$ - $% {$dirk p/@tas} :: mark mount dirty - {$ergo p/@tas q/mode} :: version update - {$hill p/(list @tas)} :: mount points - {$mack p/(unit tang)} :: ack - {$mass p/mass} :: memory usage - {$mere p/(each (set path) (pair term tang))} :: merge result - {$note p/@tD q/tank} :: debug message - {$ogre p/@tas} :: delete mount point - {$writ p/riot} :: response - == :: -++ note :: out request $-> - $% $: $a :: to %ames - $% {$wont p/sock q/path r/*} :: - == == :: - $: $c :: to %clay - $% {$info p/@p q/@tas r/nori} :: internal edit - {$merg p/@p q/@tas r/@p s/@tas t/case u/germ} :: merge desks - {$warp p/sock q/riff} :: - == == :: - $: $d :: - $% {$flog p/{$crud p/@tas q/(list tank)}} :: to %dill - == == :: - $: $f :: - $% {$exec p/@p q/(unit {beak silk:ford})} :: - == == :: - $: $t :: - $% {$wait p/@da} :: - {$rest p/@da} :: - == == == :: -++ riot (unit rant) :: response+complete -++ sign :: in result $<- - $? $: $a :: by %ames - $% {$woot p/ship q/coop} :: - == == :: - $: $c :: by %clay - $% {$note p/@tD q/tank} :: - {$mere p/(each (set path) (pair term tang))} - {$writ p/riot} :: - == == :: - $: $f :: - $% {$made p/@uvH q/gage:ford} :: - == == :: - $: $t :: - $% {$wake $~} :: timer activate - == == :: - $: @tas :: by any - $% {$crud p/@tas q/(list tank)} :: - == == == :: --- => -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -:: section 4cA, filesystem logic -:: -:: This core contains the main logic of clay. Besides `++ze`, this directly -:: contains the logic for commiting new revisions (local urbits), managing -:: and notifying subscribers (reactivity), and pulling and validating content -:: (remote urbits). -:: -:: The state includes: -:: -:: -- current time `now` -:: -- current duct `hen` -:: -- local urbit `our` -:: -- target urbit `her` -:: -- target desk `syd` -:: -- all vane state `++raft` (rarely used, except for the object store) -:: -:: For local desks, `our` == `her` is one of the urbits on our pier. For -:: foreign desks, `her` is the urbit the desk is on and `our` is the local -:: urbit that's managing the relationship with the foreign urbit. Don't mix -:: up those two, or there will be wailing and gnashing of teeth. -:: -:: While setting up `++de`, we check if the given `her` is a local urbit. If -:: so, we pull the room from `fat` in the raft and get the desk information -:: from `dos` in there. Otherwise, we get the rung from `hoy` and get the -:: desk information from `rus` in there. In either case, we normalize the -:: desk information to a `++rede`, which is all the desk-specific data that -:: we utilize in `++de`. Because it's effectively a part of the `++de` -:: state, let's look at what we've got: -:: -:: -- `lim` is the most recent date we're confident we have all the -:: information for. For local desks, this is always `now`. For foreign -:: desks, this is the last time we got a full update from the foreign -:: urbit. -:: -- `ref` is a possible request manager. For local desks, this is null. -:: For foreign desks, this keeps track of all pending foreign requests -:: plus a cache of the responses to previous requests. -:: -- `qyx` is the set of subscriptions, with listening ducts. These -:: subscriptions exist only until they've been filled. -:: -- `dom` is the actual state of the filetree. Since this is used almost -:: exclusively in `++ze`, we describe it there. -:: -- `dok` is a possible set of outstanding requests to ford to perform -:: various tasks on commit. This is null iff we're not in the middle of -:: a commit. -:: -- `mer` is the state of a possible pending merge. This is null iff -:: we're not in the middle of a merge. Since this is used almost -:: exclusively in `++me`, we describe it there. -:: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -|% -++ de :: per desk - |= {now/@da hen/duct raft} - |= {{our/@p her/@p} syd/desk} - =* ruf +>+<+> - =+ ^- {hun/(unit duct) rede} - =+ rom=(~(get by fat.ruf) her) - ?~ rom - :- ~ - %+ fall - (~(get by rus:(fall (~(get by hoy.ruf) her) *rung)) syd) - :* lim=~2000.1.1 - ref=[~ *rind] - qyx=~ - dom=*dome - dok=~ - mer=~ - == - :- `hun.u.rom - =+ jod=(fall (~(get by dos.u.rom) syd) *dojo) - :* lim=now - ref=~ - qyx=qyx.jod - dom=dom.jod - dok=dok.jod - mer=mer.jod - == - =* red -> - =| mow/(list move) - |% - ++ abet :: resolve - ^- {(list move) raft} - :_ =+ rom=(~(get by fat.ruf) her) - ?~ rom - =+ rug=(~(put by rus:(fall (~(get by hoy.ruf) her) *rung)) syd red) - ruf(hoy (~(put by hoy.ruf) her rug)) - =+ dos=(~(put by dos.u.rom) syd [qyx dom dok mer]) - ruf(fat (~(put by fat.ruf) her [(need hun) dos])) - (flop mow) - :: - :: Handle `%sing` requests - :: - ++ aver - |= mun/mood - ^- (unit (unit (each cage lobe))) - =+ ezy=?~(ref ~ (~(get by haw.u.ref) mun)) - ?^ ezy - `(bind u.ezy |=(a/cage [%& a])) - =+ nao=(case-to-aeon:ze q.mun) - :: ~& [%aver-mun nao [%from syd lim q.mun]] - ?~(nao ~ (read-at-aeon:ze u.nao mun)) - :: - ++ ford-fail |=(tan/tang ~|(%ford-fail (mean:error:userlib tan))) - :: - :: Takes either a result or a stack trace. If it's a stack trace, we crash; - :: else, we produce the result. - :: - ++ unwrap-tang - |* res/(each * tang) - ?:(?=($& -.res) p.res (mean:error:userlib p.res)) - :: - :: Parse a gage to a list of pairs of cages, crashing on error. - :: - :: Composition of ++gage-to-cages-or-error and ++unwrap-tang. Maybe same as - :: ++gage-to-success-cages? - :: - ++ gage-to-cages - |= gag/gage:ford - ^- (list (pair cage cage)) - (unwrap-tang (gage-to-cages-or-error gag)) - :: - :: Same as ++gage-to-cages-or-error except crashes on error. Maybe same as - :: ++gage-to-cages? - :: - ++ gage-to-success-cages - |= gag/gage:ford - ^- (list (pair cage cage)) - ?. ?=($tabl -.gag) - (ford-fail ?-(-.gag $| p.gag, $& [>%strange-gage p.p.gag<]~)) - %+ murn p.gag - |= {key/gage:ford val/gage:ford} - ^- (unit {cage cage}) - ?. ?=($& -.key) - (ford-fail ?-(-.key $| p.key, $tabl [>%strange-gage<]~)) - ?- -.val - $tabl (ford-fail >%strange-gage< ~) - $& (some [p.key p.val]) - $| =. p.val [(sell q.p.key) p.val] - ~> %slog.[0 %*(. >%ford-fail syd %her %why< |2.+> p.val)] - ~ - == - :: - :: Expects a single-level gage (i.e. a list of pairs of cages). If the - :: result is of a different form, or if some of the computations in the gage - :: failed, we produce a stack trace. Otherwise, we produce the list of pairs - :: of cages. - :: - ++ gage-to-cages-or-error - |= gag/gage:ford - ^- (each (list (pair cage cage)) tang) - ?: ?=($| -.gag) (mule |.(`$~`(ford-fail p.gag))) - ?. ?=($tabl -.gag) - (mule |.(`$~`(ford-fail >%strange-gage p.p.gag< ~))) - =< ?+(. [%& .] {@ *} .) - |- ^- ?((list {cage cage}) (each $~ tang)) - ?~ p.gag ~ - =* hed i.p.gag - ?- -.p.i.p.gag - $tabl (mule |.(`$~`(ford-fail >%strange-gage< ~))) - $| (mule |.(`$~`(ford-fail p.p.i.p.gag))) - $& ?- -.q.i.p.gag - $tabl (mule |.(`$~`(ford-fail >%strange-gage< ~))) - $| (mule |.(`$~`(ford-fail p.q.i.p.gag))) - $& =+ $(p.gag t.p.gag) - ?+(- [[p.p p.q]:i.p.gag -] {@ *} -) - == == - :: - :: Assumes the list of pairs of cages is actually a listified map of paths - :: to cages, and converts it to (map path cage) or a stack trace on error. - :: - ++ cages-to-map - |= tay/(list (pair cage cage)) - =| can/(map path cage) - |- ^- (each (map path cage) tang) - ?~ tay [%& can] - =* pax p.i.tay - ?. ?=($path p.pax) - (mule |.(`$~`~|([%expected-path got=p.pax] !!))) - $(tay t.tay, can (~(put by can) ((hard path) q.q.pax) q.i.tay)) - :: - :: Queue a move. - :: - ++ emit - |= mof/move - %_(+> mow [mof mow]) - :: - :: Queue a list of moves - :: - ++ emil - |= mof/(list move) - %_(+> mow (weld mof mow)) - :: - :: Produce either null or a result along a subscription. - :: - :: Producing null means subscription has been completed or cancelled. - :: - ++ balk - |= {hen/duct cay/(unit (each cage lobe)) mun/mood} - ^+ +> - ?~ cay (blub hen) - (blab hen mun u.cay) - :: - :: Set timer. - :: - ++ bait - |= {hen/duct tym/@da} - (emit hen %pass /tyme %t %wait tym) - :: - :: Cancel timer. - :: - ++ best - |= {hen/duct tym/@da} - (emit hen %pass /tyme %t %rest tym) - :: - :: Give subscription result. - :: - :: Result can be either a direct result (cage) or a lobe of a result. In - :: the latter case we fetch the data at the lobe and produce that. - :: - ++ blab - |= {hen/duct mun/mood dat/(each cage lobe)} - ^+ +> - ?: ?=($& -.dat) - (emit hen %give %writ ~ [p.mun q.mun syd] r.mun p.dat) - %- emit - :* hen %pass [%blab p.mun (scot q.mun) syd r.mun] - %f %exec our ~ [her syd q.mun] (lobe-to-silk:ze r.mun p.dat) - == - :: - :: Give next step in a subscription. - :: - ++ bleb - |= {hen/duct ins/@ud hip/(unit (pair aeon aeon))} - ^+ +> - %^ blab hen [%w [%ud ins] ~] - :- %& - ?~ hip - [%null [%atom %n ~] ~] - [%nako !>((make-nako:ze u.hip))] - :: - :: Tell subscriber that subscription is done. - :: - ++ blub - |= hen/duct - (emit hen %give %writ ~) - :: - :: Lifts a function so that a single result can be fanned out over a set of - :: subscriber ducts. - :: - :: Thus, `((duct-lift func) subs arg)` runs `(func sub arg)` for each `sub` - :: in `subs`. - :: - ++ duct-lift - |* send/_|=({duct *} ..duct-lift) - |= {a/(set duct) arg/_+<+.send} ^+ ..duct-lift - =+ all=(~(tap by a)) - |- ^+ ..duct-lift - ?~ all ..duct-lift - =. +>.send ..duct-lift - $(all t.all, duct-lift (send i.all arg)) - :: - ++ blub-all (duct-lift |=({a/duct $~} (blub a))) :: lifted ++blub - ++ blab-all (duct-lift blab) :: lifted ++blab - ++ balk-all (duct-lift balk) :: lifted ++balk - ++ bleb-all (duct-lift bleb) :: lifted ++bleb - :: - :: Sends a tank straight to dill for printing. - :: - ++ print-to-dill - |= {car/@tD tan/tank} - =+ bar=emit - =+ foo=+26.bar - =+ moo=,.+26.bar - (emit (need hun) %give %note car tan) - :: - :: Transfer a request to another ship's clay. - :: - ++ send-over-ames - |= {a/duct b/path c/ship d/{p/@ud q/riff}} - (emit a %pass b %a %wont [our c] [%c %question p.q.d (scot %ud p.d) ~] q.d) - :: - :: Create a request that cannot be filled immediately. - :: - :: If it's a local request, we just put in in `qyx`, setting a timer if it's - :: waiting for a particular time. If it's a foreign request, we add it to - :: our request manager (ref, which is a ++rind) and make the request to the - :: foreign ship. - :: - ++ duce :: produce request - |= rov/rove - ^+ +> - =. rov (dedupe rov) - =. qyx (~(put ju qyx) rov hen) - ?~ ref - (mabe rov |=(@da (bait hen +<))) - |- ^+ +>+.$ - =+ rav=(reve rov) - =+ ^= vaw ^- rave - ?. ?=({$sing $v *} rav) rav - [%many %| [%ud let.dom] `case`q.p.rav r.p.rav] - =+ inx=nix.u.ref - =. +>+.$ - =< ?>(?=(^ ref) .) - (send-over-ames hen [(scot %ud inx) ~] her inx syd ~ vaw) - %= +>+.$ - nix.u.ref +(nix.u.ref) - bom.u.ref (~(put by bom.u.ref) inx [hen vaw]) - fod.u.ref (~(put by fod.u.ref) hen inx) - == - :: - :: If a similar request exists, switch to the existing request. - :: - :: "Similar" requests are those %next and %many requests which are the same - :: up to starting case, but we're already after the starting case. This - :: stacks later requests for something onto the same request so that they - :: all get filled at once. - :: - ++ dedupe :: find existing alias - |= rov/rove ^- rove - =; ros/(list rove) ?+(ros rov {^ $~} i.ros) - ?- -.rov - $sing ~ - $next - ?~ (case-to-aeon:ze q.p.rov) ~ - %- ~(rep by qyx) - |= {{a/rove *} b/(list rove)} ^+ b - =- ?.(- b [a b]) - ?& ?=($next -.a) - =(p.a p.rov(q q.p.a)) - ?=(^ (case-to-aeon:ze q.p.a)) - == - :: - $many - ?~ (case-to-aeon:ze p.q.rov) ~ - %- ~(rep by qyx) - |= {{a/rove *} b/(list rove)} ^+ b - =- ?.(- b [a b]) - ?& ?=($many -.a) - =(a rov(p.q p.q.a)) - ?=(^ (case-to-aeon:ze p.q.a)) - == - == - :: - :: Takes a list of changed paths and finds those paths that are inside a - :: mount point (listed in `mon`). - :: - :: Output is a map of mount points to {length-of-mounted-path set-of-paths}. - :: - ++ must-ergo - |= can/(list path) - ^- (map term (pair @ud (set path))) - %- malt ^- (list (trel term @ud (set path))) - %+ murn (~(tap by mon)) - |= {nam/term bem/beam} - ^- (unit (trel term @ud (set path))) - =- ?~(- ~ `[nam (lent s.bem) (silt `(list path)`-)]) - %+ skim can - |= pax/path - &(=(p.bem her) =(q.bem syd) =((flop s.bem) (scag (lent s.bem) pax))) - :: - :: Initializes a new mount point. - :: - ++ mont - |= {pot/term bem/beam} - ^+ +> - =+ pax=s.bem - =+ cas=(need (case-to-aeon:ze r.bem)) - =+ can=(turn (~(tap by q:(aeon-to-yaki:ze cas))) head) - =+ mus=(skim can |=(paf/path =(pax (scag (lent pax) paf)))) - ?~ mus - +>.$ - %- emit - :* hen %pass [%ergoing (scot %p her) syd ~] %f - %exec our ~ [her syd %da now] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn `(list path)`mus - |= a/path - ^- (pair silk:ford silk:ford) - :- [%$ %path !>(a)] - :+ %kthp %mime - =+ (need (need (read-x:ze cas a))) - ?: ?=($& -<) - [%$ p.-] - (lobe-to-silk:ze a p.-) - == - :: - :: Cancel a request. - :: - :: For local requests, we just remove it from `qyx`. For foreign requests, - :: we remove it from `ref` and tell the foreign ship to cancel as well. - :: - ++ cancel-request :: release request - ^+ . - =^ ros/(list rove) qyx - :_ (~(run by qyx) |=(a/(set duct) (~(del in a) hen))) - %- ~(rep by qyx) - |= {{a/rove b/(set duct)} c/(list rove)} - ?.((~(has in b) hen) c [a c]) - ?~ ref - => .(ref `(unit rind)`ref) :: XX TMI - ?: =(~ ros) + :: XX handle? - |- ^+ +> - ?~ ros +> - $(ros t.ros, +> (mabe i.ros |=(@da (best hen +<)))) - ^+ ..cancel-request - =+ nux=(~(get by fod.u.ref) hen) - ?~ nux ..cancel-request - =: fod.u.ref (~(del by fod.u.ref) hen) - bom.u.ref (~(del by bom.u.ref) u.nux) - == - (send-over-ames hen [(scot %ud u.nux) ~] her u.nux syd ~) - :: - :: Handles a request. - :: - :: `%sing` requests are handled by ++aver. `%next` requests are handled by - :: running ++aver at the given case, and then subsequent cases until we find - :: a case where the two results aren't equivalent. If it hasn't happened - :: yet, we wait. `%many` requests are handled by producing as much as we can - :: and then waiting if the subscription range extends into the future. - :: - ++ start-request - |= rav/rave - ^+ +> - ?- -.rav - $sing - =+ ver=(aver p.rav) - ?~ ver - (duce rav) - ?~ u.ver - (blub hen) - (blab hen p.rav u.u.ver) - :: - $next - =+ ver=(aver p.rav) - ?~ ver - (duce [- p ~]:rav) - ?~ u.ver - (blub hen) - =+ yon=+((need (case-to-aeon:ze q.p.rav))) - |- ^+ +>.^$ - ?: (gth yon let.dom) - (duce -.rav p.rav u.ver) - =+ var=(aver p.rav(q [%ud yon])) - ?~ var - ~& [%oh-no rave=rav aeon=yon letdom=let.dom] - +>.^$ - ?~ u.var - (blab hen p.rav %& %null [%atom %n ~] ~) :: only her %x - ?: (equivalent-data:ze u.u.ver u.u.var) - $(yon +(yon)) - (blab hen p.rav u.u.var) - :: - $many - =+ nab=(case-to-aeon:ze p.q.rav) - ?~ nab - ?> =(~ (case-to-aeon:ze q.q.rav)) - (duce (rive rav)) - =+ huy=(case-to-aeon:ze q.q.rav) - ?: &(?=(^ huy) |((lth u.huy u.nab) &(=(0 u.huy) =(0 u.nab)))) - (blub hen) - =+ top=?~(huy let.dom u.huy) - =+ ear=(lobes-at-path:ze top r.q.rav) - =. +>.$ - (bleb hen u.nab ?:(p.rav ~ `[u.nab top])) - ?^ huy - (blub hen) - =+ ^= ptr ^- case - [%ud +(let.dom)] - (duce `rove`[%many p.rav ptr q.q.rav r.q.rav ear]) - == - :: - :: Print a summary of changes to dill. - :: - ++ print-changes - |= {wen/@da lem/nuri} - ^+ +> - =+ pre=`path`~[(scot %p her) syd (scot %ud let.dom)] - ?- -.lem - $| (print-to-dill '=' %leaf :(weld (trip p.lem) " " (spud pre))) - $& |- ^+ +>.^$ - ?~ p.lem +>.^$ - =. +>.^$ - %+ print-to-dill - ?-(-.q.i.p.lem $del '-', $ins '+', $dif ':') - :+ %rose ["/" "/" ~] - %+ turn (weld pre p.i.p.lem) - |= a/cord - ?: ((sane %ta) a) - [%leaf (trip a)] - [%leaf (dash:us (trip a) '\'')] - $(p.lem t.p.lem) - == - :: - :: This is the entry point to the commit flow. It deserves some - :: explaining, since it's rather long and convoluted. - :: - :: In short, ++edit takes a ++nori and turns it into a ++nuri, which is the - :: same thing except that every change is a misu instead of a miso. Thus, - :: insertions are converted to the correct mark, diffs are applied, and - :: mutations (change content by replacement) are diffed. It also fills out - :: the other fields in `++dork`. We run `++apply-edit` to create the final - :: nuri and execute the changes. - :: - :: We take a `++nori`, which is either a label-add request or a `++soba`, - :: which is a list of changes. If it's a label, it's easy and we just pass - :: it to `++execute-changes:ze`. - :: - :: If the given `++nori` is a list of file changes, then we our goal is to - :: convert the list of `++miso` changes to `++misu` changes. In other - :: words, turn the `++nori` into a `++nuri`. Then, we pass it to - :: `++execute-changes:ze`, which applies the changes to our state, and then - :: we check out the new revision. XX reword - :: - :: Anyhow, enough of high-level talk. It's time to get down to the - :: nitty-gritty. - :: - :: When we get a list of `++miso` changes, we split them into four types: - :: deletions, insertions, diffs (i.e. change from diff), and mutations - :: (i.e. change from new data). We do four different things with them. - :: - :: For deletions, we just fill in `del` in `++dork` with a list of the - :: deleted files. - :: - :: For insertions, we distinguish bewtween `%hoon` files and all other - :: files. For `%hoon` files, we just store them to `ink` in `++dork` so - :: that we add diff them directly. `%hoon` files have to be treated - :: specially to make the bootstrapping sequence work, since the mark - :: definitions are themselves `%hoon` files. - :: - :: For the other files, we make a `%tabl` compound ford request to convert - :: the data for the new file to the the mark indicated by the last knot in - :: the path. - :: - :: For diffs, we make a `%tabl` compound ford request to apply the diff to - :: the existing content. We also store the diffs in `dig` in `++dork`. - :: - :: For mutations, we make a `%tabl` compound ford request to convert the - :: given new data to the mark of the already-existing file. Later on in - :: `++take-castify` we'll create the ford request to actually perform the - :: diff. We also store the mutations in `muc` in `++dork`. I'm pretty - :: sure that's useless because who cares about the original data. - :: XX delete `muc`. - :: - :: Finally, for performance reasons we cache any of the data that came in - :: as a `%mime` cage. We do this because many commits come from unix, - :: where they're passed in as `%mime` and need to be turned back into it - :: for the ergo. We cache both `%hoon` and non-`%hoon` inserts and - :: mutations. - :: - :: At this point, the flow of control goes through the three ford requests - :: back to `++take-inserting`, `++take-diffing`, and `++take-castifying`, - :: which itself leads to `++take-mutating`. Once each of those has - :: completed, we end up at `++apply-edit`, where our unified story picks up - :: again. - :: - ++ edit :: apply changes - |= {wen/@da lem/nori} - ^+ +> - ?: ?=($| -.lem) - =^ hat +>.$ - (execute-changes:ze wen lem) - ?~ hat - +>.$ - wake:(print-changes:(checkout-ankh u.hat) wen lem) - ?. =(~ dok) - ~& %already-applying-changes +> - =+ del=(skim p.lem :(corl (cury test %del) head tail)) - =+ ins=(skim p.lem :(corl (cury test %ins) head tail)) - =+ dif=(skim p.lem :(corl (cury test %dif) head tail)) - =+ mut=(skim p.lem :(corl (cury test %mut) head tail)) - =^ ink ins - ^- {(list (pair path miso)) (list (pair path miso))} - %+ skid `(list (pair path miso))`ins - |= {pax/path mis/miso} - ?> ?=($ins -.mis) - ?& ?=({$hoon *} (flop pax)) - ?=($mime p.p.mis) - == - =. +>.$ - %- emil - ^- (list move) - :~ :* hen %pass - [%inserting (scot %p her) syd (scot %da wen) ~] - %f %exec our ~ [her syd %da wen] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn ins - |= {pax/path mis/miso} - ?> ?=($ins -.mis) - :- [%$ %path -:!>(*path) pax] - =+ =>((flop pax) ?~(. %$ i)) - [%kthp - [%$ p.mis]] - == - :* hen %pass - [%diffing (scot %p her) syd (scot %da wen) ~] - %f %exec our ~ [her syd %da wen] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn dif - |= {pax/path mis/miso} - ?> ?=($dif -.mis) - =+ (need (need (read-x:ze let.dom pax))) - ?> ?=($& -<) - :- [%$ %path -:!>(*path) pax] - [%pact [%$ p.-] [%$ p.mis]] - == - :* hen %pass - [%kthpifying (scot %p her) syd (scot %da wen) ~] - %f %exec our ~ [her syd %da wen] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn mut - |= {pax/path mis/miso} - ?> ?=($mut -.mis) - :- [%$ %path -:!>(*path) pax] - =+ (lobe-to-mark:ze (~(got by q:(aeon-to-yaki:ze let.dom)) pax)) - [%kthp - [%$ p.mis]] - == - == - %_ +>.$ - dok - :- ~ - :* (turn del |=({pax/path mis/miso} ?>(?=($del -.mis) pax))) - :: - %+ turn ink - |= {pax/path mis/miso} - ^- (pair path cage) - ?> ?=($ins -.mis) - =+ =>((flop pax) ?~(. %$ i)) - [pax - [%atom %t ~] ((hard @t) +>.q.q.p.mis)] - :: - ~ - :: - %- malt - (turn dif |=({pax/path mis/miso} ?>(?=($dif -.mis) [pax p.mis]))) - :: - ~ - :: - %- malt - (turn mut |=({pax/path mis/miso} ?>(?=($mut -.mis) [pax p.mis]))) - :: - ~ - :: - ~ - :: - %- molt ^- (list (pair path mime)) - ;: weld - ^- (list (pair path mime)) - %+ murn ins - |= {pax/path mis/miso} - ^- (unit (pair path mime)) - ?> ?=($ins -.mis) - ?. ?=($mime p.p.mis) - ~ - `[pax ((hard mime) q.q.p.mis)] - :: - ^- (list (pair path mime)) - %+ murn ink - |= {pax/path mis/miso} - ^- (unit (pair path mime)) - ?> ?=($ins -.mis) - ?> ?=($mime p.p.mis) - `[pax ((hard mime) q.q.p.mis)] - :: - ^- (list (pair path mime)) - %+ murn mut - |= {pax/path mis/miso} - ^- (unit (pair path mime)) - ?> ?=($mut -.mis) - ?. ?=($mime p.p.mis) - ~ - `[pax ((hard mime) q.q.p.mis)] - == - == - == - :: - :: Handle result of insertion. - :: - :: For commit flow overview, see ++edit. - :: - :: Insertions are cast to the correct mark, and here we put the result in - :: ins.dok. If dif and mut are full in dok (i.e. we've already processed - :: diffs and mutations), then we go ahead and run ++apply-edit. - :: - ++ take-inserting - |= {wen/@da res/gage:ford} - ^+ +> - ?~ dok - ~& %clay-take-inserting-unexpected-made +>.$ - ?. =(~ ins.u.dok) - ~& %clay-take-inserting-redundant-made +>.$ - =- =. ins.u.dok `- - ?: ?& ?=(^ dif.u.dok) - ?=(^ mut.u.dok) - == - (apply-edit wen) - +>.$ - ^- (list (pair path cage)) - %+ turn (gage-to-success-cages res) - |= {pax/cage cay/cage} - ?. ?=($path p.pax) - ~|(%clay-take-inserting-strange-path-mark !!) - [((hard path) q.q.pax) cay] - :: - :: Handle result of diffing. - :: - :: For commit flow overview, see ++edit. - :: - :: Diffs are applied to the original data, and here we put the result in - :: dif.dok. If ins and mut are full in dok (i.e. we've already processed - :: insertions and mutations), then we go ahead and run ++apply-edit. - :: - ++ take-diffing - |= {wen/@da res/gage:ford} - ^+ +> - ?~ dok - ~& %clay-take-diffing-unexpected-made +>.$ - ?. =(~ dif.u.dok) - ~& %clay-take-diffing-redundant-made +>.$ - =- =. dif.u.dok `- - ?: ?& ?=(^ ins.u.dok) - ?=(^ mut.u.dok) - == - (apply-edit wen) - +>.$ - ^- (list (trel path lobe cage)) - %+ turn (gage-to-cages res) - |= {pax/cage cay/cage} - ^- (pair path (pair lobe cage)) - ?. ?=($path p.pax) - ~|(%clay-take-diffing-strange-path-mark !!) - =+ paf=((hard path) q.q.pax) - [paf (page-to-lobe:ze [p q.q]:cay) (~(got by dig.u.dok) paf)] - :: - :: Handle result of casting mutations. - :: - :: For commit flow overview, see ++edit. - :: - :: The new content from a mutation is first casted to the correct mark, and - :: here we hash the correctly-marked content and put the result in muh.dok. - :: Then we diff the new content against the original content. The result of - :: this is handled in ++take-mutating. - :: - ++ take-castify - |= {wen/@da res/gage:ford} - ^+ +> - ?~ dok - ~& %clay-take-castifying-unexpected-made +>.$ - ?. =(~ muh.u.dok) - ~& %clay-take-castifying-redundant-made +>.$ - =+ ^- cat/(list (pair path cage)) - %+ turn (gage-to-cages res) - |= {pax/cage cay/cage} - ?. ?=($path p.pax) - ~|(%kthpify-bad-path-mark !!) - [((hard path) q.q.pax) cay] - =. muh.u.dok - %- malt - %+ turn cat - |= {pax/path cay/cage} - [pax (page-to-lobe:ze [p q.q]:cay)] - %- emit - :* hen %pass - [%mutating (scot %p her) syd (scot %da wen) ~] - %f %exec our ~ [her syd %da wen] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn cat - |= {pax/path cay/cage} - :- [%$ %path -:!>(*path) pax] - =+ (lobe-to-silk:ze pax (~(got by q:(aeon-to-yaki:ze let.dom)) pax)) - [%diff - [%$ cay]] - == - :: - :: Handle result of diffing mutations. - :: - :: For commit flow overview, see ++edit. - :: - :: We put the calculated diffs of the new content vs the old content (from - :: ++take-castify) in mut.dok. If ins and mut are full in dok (i.e. we've - :: already processed insertions and diffs), then we go ahead and run - :: ++apply-edit. - :: - ++ take-mutating - |= {wen/@da res/gage:ford} - ^+ +> - ?~ dok - ~& %clay-take-mutating-unexpected-made +>.$ - ?. =(~ mut.u.dok) - ~& %clay-take-mutating-redundant-made +>.$ - =- =. mut.u.dok `- - ?: ?& ?=(^ ins.u.dok) - ?=(^ dif.u.dok) - == - (apply-edit wen) - +>.$ - ^- (list (trel path lobe cage)) - %+ murn (gage-to-cages res) - |= {pax/cage cay/cage} - ^- (unit (pair path (pair lobe cage))) - ?. ?=($path p.pax) - ~|(%clay-take-mutating-strange-path-mark !!) - ?: ?=($null p.cay) - ~ - =+ paf=((hard path) q.q.pax) - `[paf (~(got by muh.u.dok) paf) cay] - :: - :: Now that dok is completely filled, we can apply the changes in the commit. - :: - :: We collect the relevant data from dok and run ++execute-changes to apply - :: them to our state. Then we run ++checkout-ankh to update our ankh (cache - :: of the content at the current aeon). - :: - ++ apply-edit - |= wen/@da - ^+ +> - :: XX we do the same in ++take-patch, which is confusing and smells foul. - :: Here we run ++execute-changes, but we throw away the state changes. The - :: call in ++take-patch is the one that matters, but we print out changes - :: here, and we also use that info to call ++checkout-ankh (which is what - :: leads to the ++take-patch call). - :: - :: I'm guessing this shouldn't call ++execute-changes at all but rather - :: generate the information it needs directly. - =+ ^- sim/(list (pair path misu)) - ?~ dok - ~|(%no-changes !!) - ?> ?=(^ ins.u.dok) - ?> ?=(^ dif.u.dok) - ?> ?=(^ mut.u.dok) - ;: weld - ^- (list (pair path misu)) - (turn del.u.dok |=(pax/path [pax %del ~])) - :: - ^- (list (pair path misu)) - (turn ink.u.dok |=({pax/path cay/cage} [pax %ins cay])) - :: - ^- (list (pair path misu)) - (turn u.ins.u.dok |=({pax/path cay/cage} [pax %ins cay])) - :: - ^- (list (pair path misu)) - (turn u.dif.u.dok |=({pax/path cal/{lobe cage}} [pax %dif cal])) - :: - ^- (list (pair path misu)) - (turn u.mut.u.dok |=({pax/path cal/{lobe cage}} [pax %dif cal])) - == - =+ hat=(execute-changes:ze wen %& sim) - ?~ dok ~& %no-changes !! - ?~ -.hat - ([print-changes(dok ~)]:.(+>.$ +.hat) wen %& sim) - (checkout-ankh(lat.ran lat.ran.+.hat) u.-.hat) - :: - :: Takes a map of paths to lobes and tells ford to convert to an ankh. - :: - :: Specifically, we tell ford to convert each lobe into a blob, then we call - :: ++take-patch to apply the result to our current ankh and update unix. - :: - ++ checkout-ankh - |= hat/(map path lobe) - ^+ +> - %- emit - :* hen %pass [%patching (scot %p her) syd ~] %f - %exec our :^ ~ [her syd %da now] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn (~(tap by hat)) - |= {a/path b/lobe} - ^- (pair silk:ford silk:ford) - :- [%$ %path-hash !>([a b])] - (lobe-to-silk:ze a b) - == - :: - :: Handle the result of the ford call in ++checkout-ankh. - :: - :: We apply the changes by calling ++execute-changes, then we convert the - :: result of the ford call from ++checkout-ankh into a map of paths to data - :: for the current aeon of this desk. We turn this into an ankh and store - :: it to our state. Finally, we choose which paths need to be synced to - :: unix, and convert the data at those paths to mime (except those paths - :: which were added originally as mime, because we still have that stored in - :: mim in dok). The result is handled in ++take-ergo. - :: - ++ take-patch - |= res/gage:ford - ^+ +> - :: ~& %taking-patch - ?: ?=($| -.res) - =. dok ~ - (print-to-dill '!' %rose [" " "" ""] leaf+"clay patch failed" p.res) - :: ~& %editing - =+ ^- sim/(list (pair path misu)) - ?~ dok - ~|(%no-changes !!) - ?> ?=(^ ins.u.dok) - ?> ?=(^ dif.u.dok) - ?> ?=(^ mut.u.dok) - ;: weld - ^- (list (pair path misu)) - (turn del.u.dok |=(pax/path [pax %del ~])) - :: - ^- (list (pair path misu)) - (turn ink.u.dok |=({pax/path cay/cage} [pax %ins cay])) - :: - ^- (list (pair path misu)) - (turn u.ins.u.dok |=({pax/path cay/cage} [pax %ins cay])) - :: - ^- (list (pair path misu)) - (turn u.dif.u.dok |=({pax/path cal/{lobe cage}} [pax %dif cal])) - :: - ^- (list (pair path misu)) - (turn u.mut.u.dok |=({pax/path cal/{lobe cage}} [pax %dif cal])) - == - =^ hat +>.$ (execute-changes:ze now %& sim) - :: XX do same in ++apply-edit - ?~ dok ~& %no-dok +>.$ - => - %= . - +>.$ - ?< ?=($~ hat) :: XX whut? - (print-changes now %& sim) - == - ?~ dok ~& %no-dok +>.$ - =+ ^- cat/(list (trel path lobe cage)) - %+ turn (gage-to-cages res) - |= {pax/cage cay/cage} - ?. ?=($path-hash p.pax) - ~|(%patch-bad-path-mark !!) - [-< -> +]:[((hard {path lobe}) q.q.pax) cay] - :: ~& %canned - :: ~& %checking-out - =. ank.dom (map-to-ankh:ze (malt cat)) - :: ~& %checked-out - :: ~& %waking - =. +>.$ =>(wake ?>(?=(^ dok) .)) - :: ~& %waked - ?~ hez +>.$(dok ~) - =+ mus=(must-ergo (turn sim head)) - ?: =(~ mus) - +>.$(dok ~) - =+ ^- sum/(set path) - =+ (turn (~(tap by mus)) (corl tail tail)) - %+ roll - - |= {pak/(set path) acc/(set path)} - (~(uni in acc) pak) - =+ can=(malt sim) - :: ~& %forming-ergo - :: =- ~& %formed-ergo - - %- emit(dok ~) - :* hen %pass [%ergoing (scot %p her) syd ~] %f - %exec our ~ [her syd %da now] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn (~(tap in sum)) - |= a/path - ^- (pair silk:ford silk:ford) - :- [%$ %path !>(a)] - =+ b=(~(got by can) a) - ?: ?=($del -.b) - [%$ %null !>(~)] - =+ (~(get by mim.u.dok) a) - ?^ - [%$ %mime !>(u.-)] - :+ %kthp %mime - =+ (need (need (read-x:ze let.dom a))) - ?: ?=($& -<) - [%$ p.-] - (lobe-to-silk:ze a p.-) - == - :: - :: Send new data to unix. - :: - :: Combine the paths in mim in dok and the result of the ford call in - :: ++take-patch to create a list of nodes that need to be sent to unix (in - :: an %ergo card) to keep unix up-to-date. Send this to unix. - :: - ++ take-ergo - |= res/gage:ford - ^+ +> - ?: ?=($| -.res) - (print-to-dill '!' %rose [" " "" ""] leaf+"clay ergo failed" p.res) - ?~ hez ~|(%no-sync-duct !!) - =+ ^- can/(map path (unit mime)) - %- malt ^- mode - %+ turn (gage-to-cages res) - |= {pax/cage mim/cage} - ?. ?=($path p.pax) - ~|(%ergo-bad-path-mark !!) - :- ((hard path) q.q.pax) - ?. ?=($mime p.mim) - ~ - `((hard mime) q.q.mim) - =+ mus=(must-ergo (turn (~(tap by can)) head)) - %- emil - %+ turn (~(tap by mus)) - |= {pot/term len/@ud pak/(set path)} - :* u.hez %give %ergo pot - %+ turn (~(tap in pak)) - |= pax/path - [(slag len pax) (~(got by can) pax)] - == - :: - :: Called when a foreign ship answers one of our requests. - :: - :: After updating ref (our request manager), we handle %x, %w, and %y - :: responses. For %x, we call ++validate-x to validate the type of the - :: response. For %y, we coerce the result to an arch. - :: - :: For %w, we check to see if it's a @ud response (e.g. for - :: cw+//~sampel-sipnym/desk/~time-or-label). If so, it's easy. Otherwise, - :: we look up our subscription request, then assert the response was a nako. - :: If this is the first update for a desk, we assume everything's well-typed - :: and call ++apply-foreign-update directly. Otherwise, we call - :: ++validate-plops to verify that the data we're getting is well typed. - :: - :: Be careful to call ++wake if/when necessary (i.e. when the state changes - :: enough that a subscription could be filled). Every case must call it - :: individually. - :: - ++ take-foreign-update :: external change - |= {inx/@ud rut/(unit rand)} - ^+ +> - ?> ?=(^ ref) - |- ^+ +>+.$ - =+ ruv=(~(get by bom.u.ref) inx) - ?~ ruv +>+.$ - => ?. |(?=($~ rut) ?=($sing -.q.u.ruv)) . - %_ . - bom.u.ref (~(del by bom.u.ref) inx) - fod.u.ref (~(del by fod.u.ref) p.u.ruv) - == - ?~ rut - =+ rav=`rave`q.u.ruv - =< ?>(?=(^ ref) .) - %_ wake - lim - ?.(&(?=($many -.rav) ?=($da -.q.q.rav)) lim `@da`p.q.q.rav) - :: - haw.u.ref - ?. ?=($sing -.rav) haw.u.ref - (~(put by haw.u.ref) p.rav ~) - == - ?- p.p.u.rut - $d - ~| %totally-temporary-error-please-replace-me - !! - $u - ~| %im-thinkin-its-prolly-a-bad-idea-to-request-rang-over-the-network - !! - :: - $v - ~| %weird-we-shouldnt-get-a-dome-request-over-the-network - !! - :: - $x - =< ?>(?=(^ ref) .) - (validate-x p.p.u.rut q.p.u.rut q.u.rut r.u.rut) - :: - $w - =. haw.u.ref - %+ ~(put by haw.u.ref) - [p.p.u.rut q.p.u.rut q.u.rut] - :+ ~ - p.r.u.rut - ?+ p.r.u.rut ~| %strange-w-over-nextwork !! - $aeon !>(((hard aeon) q.r.u.rut)) - $null [[%atom %n ~] ~] - $nako !>(~|([%harding [&1 &2 &3]:q.r.u.rut] ((hard nako) q.r.u.rut))) - == - ?. ?=($nako p.r.u.rut) [?>(?=(^ ref) .)]:wake - =+ rav=`rave`q.u.ruv - ?> ?=($many -.rav) - |- ^+ +>+.^$ - =+ nez=[%w [%ud let.dom] ~] - =+ nex=(~(get by haw.u.ref) nez) - ?~ nex +>+.^$ - ?~ u.nex +>+.^$ :: should never happen - =. nak.u.ref `((hard nako) q.q.u.u.nex) - =. +>+.^$ - ?: =(0 let.dom) - =< ?>(?=(^ ref) .) - %+ apply-foreign-update - ?.(?=($da -.q.q.rav) ~ `p.q.q.rav) - (need nak.u.ref) - =< ?>(?=(^ ref) .) - %^ validate-plops - [%ud let.dom] - ?.(?=($da -.q.q.rav) ~ `p.q.q.rav) - bar:(need nak.u.ref) - %= $ - haw.u.ref (~(del by haw.u.ref) nez) - == - :: - $y - =< ?>(?=(^ ref) .) - %_ wake - haw.u.ref - %+ ~(put by haw.u.ref) - [p.p.u.rut q.p.u.rut q.u.rut] - `[p.r.u.rut !>(((hard arch) q.r.u.rut))] - == - :: - $z - ~| %its-prolly-not-reasonable-to-request-ankh-over-the-network-sorry - !! - == - :: - :: Check that given data is actually of the mark it claims to be. - :: - :: Result is handled in ++take-foreign-x - :: - ++ validate-x - |= {car/care cas/case pax/path peg/page} - ^+ +> - %- emit - :* hen %pass - [%foreign-x (scot %p our) (scot %p her) syd car (scot cas) pax] - %f %exec our ~ [her syd cas] - (vale-page peg) - == - :: - :: Create a silk to validate a page. - :: - :: If the mark is %hoon, we short-circuit the validation for bootstrapping - :: purposes. - :: - ++ vale-page - |= a/page - ^- silk:ford - ?. ?=($hoon p.a) [%vale a] - ?. ?=(@t q.a) [%dude |.(>%weird-hoon<) %ride [%fail ~] %$ *cage] - [%$ p.a [%atom %t ~] q.a] - :: - :: Verify the foreign data is of the the mark it claims to be. - :: - :: This completes the receiving of %x foreign data. - :: - ++ take-foreign-x - |= {car/care cas/case pax/path res/gage:ford} - ^+ +> - ?> ?=(^ ref) - ?. ?=($& -.res) - ~| "validate foreign x failed" - =+ why=?-(-.res $| p.res, $tabl ~[>%bad-marc<]) - ~> %mean.|.(%*(. >[%plop-fail %why]< |1.+> why)) - !! - ?> ?=(@ p.p.res) - wake(haw.u.ref (~(put by haw.u.ref) [car cas pax] `p.res)) - :: - :: When we get a %w foreign update, store this in our state. - :: - :: We get the commits and blobs from the nako and add them to our object - :: store, then we update the map of aeons to commits and the latest aeon. - :: - :: We call ++wake at the end to update anyone whose subscription is fulfilled - :: by this state change. - :: - ++ apply-foreign-update :: apply subscription - |= $: lem/(unit @da) :: complete up to - gar/(map aeon tako) :: new ids - let/aeon :: next id - lar/(set yaki) :: new commits - bar/(set blob) :: new content - == - ^+ +> - =< wake - =+ ^- nut/(map tako yaki) - %- molt ^- (list (pair tako yaki)) - %+ turn (~(tap in lar)) - |= yak/yaki - [r.yak yak] - =+ ^- nat/(map lobe blob) - %- molt ^- (list (pair lobe blob)) - %+ turn (~(tap in bar)) - |= bol/blob - [p.bol bol] - ~| :* %bad-foreign-update - :* gar=gar - let=let - nut=(~(run by nut) $~) - nat=(~(run by nat) $~) - == - :* hitdom=hit.dom - letdom=let.dom - hutran=(~(run by hut.ran) $~) - latran=(~(run by lat.ran) $~) - == - == - =+ hit=(~(uni by hit.dom) gar) - =+ let=let - =+ hut=(~(uni by hut.ran) nut) - =+ lat=(~(uni by lat.ran) nat) - =+ ?: =(0 let) ~ - =+ yon=`aeon`1 :: sanity check - |- - ~| yon=yon - =+ tak=(~(got by hit) yon) - =+ yak=(~(got by hut) tak) - =+ %- ~(urn by q.yak) - |= {pax/path lob/lobe} - ~| [pax=path lob=lobe] - (~(got by lat) lob) - ?: =(let yon) - ~ - $(yon +(yon)) - %= +>.$ - lim (max (fall lem lim) lim) - hit.dom hit - let.dom (max let let.dom) - hut.ran hut - lat.ran lat - == - :: - :: Make sure that incoming data is of the correct type. - :: - :: This is a ford call to make sure that incoming data is of the mark it - :: claims to be. The result is handled in ++take-foreign-plops. - :: - ++ validate-plops - |= {cas/case lem/(unit @da) pop/(set plop)} - ^+ +> - =+ lum=(scot %da (fall lem *@da)) - %- emit - :* hen %pass - [%foreign-plops (scot %p our) (scot %p her) syd lum ~] - %f %exec our ~ [her syd cas] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn (~(tap in pop)) - |= a/plop - ?- -.a - $direct [[%$ %blob !>([%direct p.a *page])] (vale-page p.q.a q.q.a)] - $delta - [[%$ %blob !>([%delta p.a q.a *page])] (vale-page p.r.a q.r.a)] - == - == - :: - :: Verify that foreign plops validated correctly. If so, apply them to our - :: state. - :: - ++ take-foreign-plops - |= {lem/(unit @da) res/gage:ford} - ^+ +> - ?> ?=(^ ref) - ?> ?=(^ nak.u.ref) - =+ ^- lat/(list blob) - %+ turn ~|("validate foreign plops failed" (gage-to-cages res)) - |= {bob/cage cay/cage} - ?. ?=($blob p.bob) - ~| %plop-not-blob - !! - =+ bol=((hard blob) q.q.bob) - ?- -.bol - $delta [-.bol p.bol q.bol p.cay q.q.cay] - $direct [-.bol p.bol p.cay q.q.cay] - == - %^ apply-foreign-update - lem - gar.u.nak.u.ref - :+ let.u.nak.u.ref - lar.u.nak.u.ref - (silt lat) - :: - ++ mabe :: maybe fire function - |= {rov/rove fun/$-(@da _.)} - ^+ +>.$ - %+ fall - %+ bind - ^- (unit @da) - ?- -.rov - $sing - ?. ?=($da -.q.p.rov) ~ - `p.q.p.rov - :: - $next ~ - $many - %^ hunt lth - ?. ?=($da -.p.q.rov) ~ - ?.((lth now p.p.q.rov) ~ [~ p.p.q.rov]) - ?. ?=($da -.q.q.rov) ~ - (hunt gth [~ now] [~ p.q.q.rov]) - == - fun - +>.$ - :: - ++ reve - |= rov/rove - ^- rave - ?- -.rov - $sing rov - $next [- p]:rov - $many [%many p.rov p.q.rov q.q.rov r.q.rov] - == - :: - ++ rive - |= rav/{$many p/? q/moat} - ^- rove - [%many p.rav p.q.rav q.q.rav r.q.rav ~] - :: - :: Loop through open subscriptions and check if we can fill any of them. - :: - ++ wake :: update subscribers - ^+ . - =+ xiq=(~(tap by qyx)) - =| xaq/(list {p/rove q/(set duct)}) - |- ^+ ..wake - ?~ xiq - ..wake(qyx (~(gas by *cult) xaq)) - ?: =(~ q.i.xiq) $(xiq t.xiq, xaq xaq) :: drop forgotten - ?- -.p.i.xiq - $sing - =+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.p.i.xiq)) - ?^ cas - %= $ - xiq t.xiq - ..wake ?~ u.cas (blub-all q.i.xiq ~) - (blab-all q.i.xiq p.p.i.xiq %& u.u.cas) - == - =+ nao=(case-to-aeon:ze q.p.p.i.xiq) - ?~ nao $(xiq t.xiq, xaq [i.xiq xaq]) - :: ~& %reading-at-aeon - =+ vid=(read-at-aeon:ze u.nao p.p.i.xiq) - :: ~& %red-at-aeon - ?~ vid - :: ?: =(0 u.nao) - :: ~& [%oh-poor `path`[syd '0' r.p.p.i.xiq]] - :: $(xiq t.xiq) - :: ~& [%oh-well desk=syd mood=p.p.i.xiq aeon=u.nao] - $(xiq t.xiq, xaq [i.xiq xaq]) - $(xiq t.xiq, ..wake (balk-all q.i.xiq u.vid p.p.i.xiq)) - :: - $next - =* mun p.p.i.xiq - :: =* dat q.p.i.xiq XX can't fuse right now - ?~ q.p.i.xiq - =+ ver=(aver mun) - ?~ ver - $(xiq t.xiq, xaq [i.xiq xaq]) - ?~ u.ver - $(xiq t.xiq, ..wake (blub-all q.i.xiq ~)) - $(xiq t.xiq, xaq [i.xiq(q.p u.ver) xaq]) - =+ var=(aver mun(q [%ud let.dom])) - ?~ var - ~& [%oh-noes mood=mun letdom=let.dom] - $(xiq t.xiq) - ?~ u.var - $(xiq t.xiq, ..wake (blab-all q.i.xiq mun %& %null [%atom %n ~] ~)) - ?: (equivalent-data:ze u.q.p.i.xiq u.u.var) - $(xiq t.xiq, xaq [i.xiq xaq]) - $(xiq t.xiq, ..wake (blab-all q.i.xiq mun u.u.var)) - :: - $many - =+ mot=`moot`q.p.i.xiq - =+ nab=(case-to-aeon:ze p.mot) - ?~ nab - $(xiq t.xiq, xaq [i.xiq xaq]) - =+ huy=(case-to-aeon:ze q.mot) - ?~ huy - =. p.mot [%ud +(let.dom)] - %= $ - xiq t.xiq - xaq [i.xiq(q.p mot) xaq] - ..wake =+ ^= ear - (lobes-at-path:ze let.dom r.mot) - ?: =(s.mot ear) ..wake - (bleb-all q.i.xiq let.dom ?:(p.p.i.xiq ~ `[u.nab let.dom])) - == - %= $ - xiq t.xiq - ..wake =- (blub-all:- q.i.xiq ~) - =+ ^= ear - (lobes-at-path:ze u.huy r.mot) - ?: =(s.mot ear) (blub-all q.i.xiq ~) - (bleb-all q.i.xiq +(u.nab) ?:(p.p.i.xiq ~ `[u.nab u.huy])) - == - == - ++ drop-me - ^+ . - ?~ mer - . - %- emit(mer ~) ^- move :* - hen.u.mer %give %mere %| %user-interrupt - >sor.u.mer< >our< >cas.u.mer< >gem.u.mer< ~ - == - :: - :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - :: - :: This core has no additional state, and the distinction exists purely for - :: documentation. The overarching theme is that `++de` directly contains - :: logic for metadata about the desk, while `++ze` is composed primarily - :: of helper functions for manipulating the desk state (`++dome`) itself. - :: Functions include: - :: - :: -- converting between cases, commit hashes, commits, content hashes, - :: and content - :: -- creating commits and content and adding them to the tree - :: -- finding which data needs to be sent over the network to keep the - :: -- other urbit up-to-date - :: -- reading from the file tree through different `++care` options - :: -- the `++me` core for merging. - :: - :: The dome is composed of the following: - :: - :: -- `ank` is the ankh, which is the file data itself. An ankh is both - :: a possible file and a possible directory. An ankh has both: - :: -- `fil`, a possible file, stored as both a cage and its hash - :: -- `dir`, a map of @ta to more ankhs. - :: -- `let` is the number of the most recent revision. - :: -- `hit` is a map of revision numbers to commit hashes. - :: -- `lab` is a map of labels to revision numbers. - :: - :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - ++ ze - |% - :: These convert between aeon (version number), tako (commit hash), yaki - :: (commit data structure), lobe (content hash), and blob (content). - ++ aeon-to-tako ~(got by hit.dom) - ++ aeon-to-yaki (cork aeon-to-tako tako-to-yaki) - ++ lobe-to-blob ~(got by lat.ran) - ++ tako-to-yaki ~(got by hut.ran) - ++ lobe-to-mark - |= a/lobe - => (lobe-to-blob a) - ?- - - $delta p.q - $direct p.q - == - :: - :: Creates a silk to put a type on a page (which is a {mark noun}). - :: - ++ page-to-silk :: %hoon bootstrapping - |= a/page - ?. ?=($hoon p.a) [%volt a] - [%$ p.a [%atom %t ~] q.a] - :: - :: Creates a silk out of a lobe (content hash). - :: - ++ lobe-to-silk - |= {pax/path lob/lobe} - ^- silk:ford - =+ ^- hat/(map path lobe) - ?: =(let.dom 0) - ~ - q:(aeon-to-yaki let.dom) - =+ lol=`(unit lobe)`?.(=(~ ref) `0vsen.tinel (~(get by hat) pax)) - |- ^- silk:ford - ?: =([~ lob] lol) - =+ (need (need (read-x let.dom pax))) - ?> ?=($& -<) - [%$ p.-] - =+ bol=(~(got by lat.ran) lob) - ?- -.bol - $direct (page-to-silk q.bol) - $delta ~| delta+q.q.bol - [%pact $(lob q.q.bol) (page-to-silk r.bol)] - == - :: - :: Hashes a page to get a lobe. - :: - ++ page-to-lobe |=(page (shax (jam +<))) - :: - :: Checks whether two pieces of data (either cages or lobes) are the same. - :: - ++ equivalent-data - |= {one/(each cage lobe) two/(each cage lobe)} - ^- ? - ?: ?=($& -.one) - ?: ?=($& -.two) - =([p q.q]:p.one [p q.q]:p.two) - =(p.two (page-to-lobe [p q.q]:p.one)) - ?: ?=($& -.two) - =(p.one (page-to-lobe [p q.q]:p.two)) - =(p.one p.two) - :: - :: Make a direct blob out of a page. - :: - ++ make-direct-blob - |= p/page - ^- blob - [%direct (page-to-lobe p) p] - :: - :: Make a delta blob out of a lobe, mark, lobe of parent, and page of diff. - :: - ++ make-delta-blob - |= {p/lobe q/{p/mark q/lobe} r/page} - ^- blob - [%delta p q r] - :: - :: Make a commit out of a list of parents, content, and date. - :: - ++ make-yaki - |= {p/(list tako) q/(map path lobe) t/@da} - ^- yaki - =+ ^= has - %^ cat 7 (sham [%yaki (roll p add) q t]) - (sham [%tako (roll p add) q t]) - [p q has t] - :: - :: Reduce a case to an aeon (version number) - :: - :: We produce null if we can't yet reduce the case for whatever resaon - :: (usually either the time or aeon hasn't happened yet or the label hasn't - :: been created), we produce null. - :: - ++ case-to-aeon - |= lok/case :: act count through - ^- (unit aeon) - ?- -.lok - $da - ?: (gth p.lok lim) ~ - |- ^- (unit aeon) - ?: =(0 let.dom) [~ 0] :: avoid underflow - ?: %+ gte p.lok - =< t - ~| [%letdom let=let.dom hit=hit.dom hut=(~(run by hut.ran) $~)] - ~| [%getdom (~(get by hit.dom) let.dom)] - %- aeon-to-yaki - let.dom - [~ let.dom] - $(let.dom (dec let.dom)) - :: - $tas (~(get by lab.dom) p.lok) - $ud ?:((gth p.lok let.dom) ~ [~ p.lok]) - == - :: - :: Convert a map of paths to data into an ankh. - :: - ++ map-to-ankh - |= hat/(map path (pair lobe cage)) - ^- ankh - :: %- cosh - %+ roll (~(tap by hat) ~) - |= {{pat/path lob/lobe zar/cage} ank/ankh} - ^- ankh - :: %- cosh - ?~ pat - ank(fil [~ lob zar]) - =+ nak=(~(get by dir.ank) i.pat) - %= ank - dir %+ ~(put by dir.ank) i.pat - $(pat t.pat, ank (fall nak *ankh)) - == - :: - :: Applies a change list, creating the commit and applying it to the - :: current state. - :: - :: Also produces the new data from the commit for convenience. - :: - ++ execute-changes - |= {wen/@da lem/nuri} - ^- {(unit (map path lobe)) _..ze} - ?- -.lem - $& - =^ yak lat.ran (forge-yaki wen p.lem) :: create new commit - ?. ?| =(0 let.dom) - !=((lent p.yak) 1) - !=(q.yak q:(aeon-to-yaki let.dom)) - == - `..ze :: silently ignore - =: let.dom +(let.dom) - hit.dom (~(put by hit.dom) +(let.dom) r.yak) - hut.ran (~(put by hut.ran) r.yak yak) - == - [`q.yak ..ze] - :: +>.$(ank (map-to-ankh q.yak)) - $| - ?< (~(has by lab.dom) p.lem) - [~ ..ze(lab.dom (~(put by lab.dom) p.lem let.dom))] - == - :: - :: Create a commit out of a list of changes against the current state. - :: - :: First call ++apply-changes to apply the list of changes and get the new - :: state of the content. Then, call ++update-lat to add any new content to - :: the blob store. Finally, create the new yaki (commit) and produce both - :: it and the new lat (blob store). - :: - ++ forge-yaki - |= {wen/@da lem/suba} - =+ par=?:(=(0 let.dom) ~ [(aeon-to-tako let.dom) ~]) - =+ new=(apply-changes lem) - =+ gar=(update-lat new lat.ran) - :- (make-yaki par +.gar wen) :: from existing diff - -.gar :: fix lat - :: - :: Apply a list of changes against the current state and produce the new - :: state. - :: - ++ apply-changes :: apply-changes:ze - |= lar/(list {p/path q/misu}) :: store changes - ^- (map path blob) - =+ ^= hat :: current state - ?: =(let.dom 0) :: initial commit - ~ :: has nothing - =< q - %- aeon-to-yaki - let.dom - =- =+ sar=(silt (turn lar |=({p/path *} p))) :: changed paths - %+ roll (~(tap by hat) ~) :: find unchanged - =< .(bat bar) - |= {{pax/path gar/lobe} bat/(map path blob)} - ?: (~(has in sar) pax) :: has update - bat - %+ ~(put by bat) pax - ~| [pax gar (lent (~(tap by lat.ran)))] - (lobe-to-blob gar) :: use original - ^= bar ^- (map path blob) - %+ roll lar - |= {{pax/path mys/misu} bar/(map path blob)} - ^+ bar - ?- -.mys - $ins :: insert if not exist - ?: (~(has by bar) pax) !! :: - ?: (~(has by hat) pax) !! :: - %+ ~(put by bar) pax - %- make-direct-blob - ?: &(?=($mime -.p.mys) =([%hoon ~] (slag (dec (lent pax)) pax))) - `page`[%hoon +.+.q.q.p.mys] - [p q.q]:p.mys - :: - $del :: delete if exists - ?. |((~(has by hat) pax) (~(has by bar) pax)) !! - (~(del by bar) pax) - :: - $dif :: mutate, must exist - =+ ber=(~(get by bar) pax) :: XX typed - =+ her==>((flop pax) ?~(. %$ i)) - ?~ ber - =+ har=(~(get by hat) pax) - ?~ har !! - %+ ~(put by bar) pax - (make-delta-blob p.mys [(lobe-to-mark u.har) u.har] [p q.q]:q.mys) - :: XX check vase !evil - :: XX of course that's a problem, p.u.ber isn't in rang since it - :: was just created. We shouldn't be sending multiple - :: diffs - :: %+ ~(put by bar) pax - :: %^ make-delta-blob p.mys - :: [(lobe-to-mark p.u.ber) p.u.ber] - :: [p q.q]:q.mys - :: :: XX check vase !evil - ~|([%two-diffs-for-same-file syd pax] !!) - == - :: - :: Update the object store with new blobs. - :: - :: Besides new object store, converts the given (map path blob) to - :: (map path lobe). - :: - ++ update-lat :: update-lat:ze - |= {lag/(map path blob) sta/(map lobe blob)} :: fix lat - ^- {(map lobe blob) (map path lobe)} - %+ roll (~(tap by lag) ~) - =< .(lut sta) - |= {{pat/path bar/blob} {lut/(map lobe blob) gar/(map path lobe)}} - ?~ (~(has by lut) p.bar) - [lut (~(put by gar) pat p.bar)] - :- (~(put by lut) p.bar bar) - (~(put by gar) pat p.bar) - :: - :: Gets a map of the data at the given path and all children of it. - :: - ++ lobes-at-path - |= {yon/aeon pax/path} - ^- (map path lobe) - ?: =(0 yon) ~ - %- malt - %+ skim - %. ~ - %~ tap by - =< q - %- aeon-to-yaki - yon - == - |= {p/path q/lobe} - ?| ?=($~ pax) - ?& !?=($~ p) - =(-.pax -.p) - $(p +.p, pax +.pax) - == == - :: - :: Creates a nako of all the changes between a and b. - :: - ++ make-nako - |= {a/aeon b/aeon} - ^- nako - :+ ?> (lte b let.dom) - |- - ?: =(b let.dom) - hit.dom - $(hit.dom (~(del by hit.dom) let.dom), let.dom (dec let.dom)) - b - ?: =(0 b) - [~ ~] - (data-twixt-takos (~(get by hit.dom) a) (aeon-to-tako b)) - :: - :: Gets the data between two commit hashes, assuming the first is an - :: ancestor of the second. - :: - :: Get all the takos before `a`, then get all takos before `b` except the - :: ones we found before `a`. Then convert the takos to yakis and also get - :: all the data in all the yakis. - :: - ++ data-twixt-takos - |= {a/(unit tako) b/tako} - ^- {(set yaki) (set plop)} - =+ old=?~(a ~ (reachable-takos u.a)) - =+ ^- yal/(set tako) - %- silt - %+ skip - (~(tap in (reachable-takos b))) - |=(tak/tako (~(has in old) tak)) - :- (silt (turn (~(tap in yal)) tako-to-yaki)) - (silt (turn (~(tap in (new-lobes (new-lobes ~ old) yal))) lobe-to-blob)) - :: - :: Traverses parentage and finds all ancestor hashes - :: - ++ reachable-takos :: reachable - |= p/tako - ^- (set tako) - =+ y=(tako-to-yaki p) - %+ roll p.y - =< .(s (~(put in *(set tako)) p)) - |= {q/tako s/(set tako)} - ?: (~(has in s) q) :: already done - s :: hence skip - (~(uni in s) ^$(p q)) :: otherwise traverse - :: - :: Get all the lobes that are referenced in `a` except those that are - :: already in `b`. - :: - ++ new-lobes :: object hash set - |= {b/(set lobe) a/(set tako)} :: that aren't in b - ^- (set lobe) - %+ roll (~(tap in a) ~) - |= {tak/tako bar/(set lobe)} - ^- (set lobe) - =+ yak=(tako-to-yaki tak) - %+ roll (~(tap by q.yak) ~) - =< .(far bar) - |= {{path lob/lobe} far/(set lobe)} - ^- (set lobe) - ?~ (~(has in b) lob) :: don't need - far - =+ gar=(lobe-to-blob lob) - ?- -.gar - $direct (~(put in far) lob) - $delta (~(put in $(lob q.q.gar)) lob) - == - :: - :: Should be refactored, is only called form `++read`, and even then it - :: can't be called with `$v` as the care, so it's really just a crash. - :: - :: To be clear the refactoring should start at ++read-at-aeon and probably - :: eliminate ++read and ++query - :: - ++ query :: query:ze - |= ren/$?($u $v $x $y $z) :: endpoint query - ^- (unit cage) - ?- ren - $u !! :: [~ %null [%atom %n] ~] - $v [~ %dome !>(dom)] - $x !! :: ?~(q.ank.dom ~ [~ q.u.q.ank.dom]) - $y !! :: [~ %arch !>(as-arch)] - $z !! :: [~ %ankh !>(ank.dom)] - == - :: - :: See ++query. - :: - ++ read :: read:ze - |= mun/mood :: read at point - ^- (unit cage) - ?: ?=($d p.mun) - ~& %dead-d ~ - ?: ?=($v p.mun) - [~ %dome !>(dom)] :: dead code - ?: &(?=($w p.mun) !?=($ud -.q.mun)) - ?^(r.mun ~ [~ %aeon !>(let.dom)]) :: dead code - ?: ?=($w p.mun) - =+ ^= yak - %- aeon-to-yaki - let.dom - ?^(r.mun ~ !!) :: [~ %w !>([t.yak (forge-nori yak)])])-all - (query(ank.dom ank:(descend-path:(zu ank.dom) r.mun)) p.mun) :: dead code - :: - :: Checks for existence of a node at an aeon. - :: - :: This checks for existence of content at the node, and does *not* look - :: at any of its children. - :: - ++ read-u - |= {yon/aeon pax/path} - ^- (unit (unit (each {$null (hypo $~)} lobe))) - =+ tak=(~(get by hit.dom) yon) - ?~ tak - ~ - ``[%& %null [%atom %n ~] ~] - :: - :: Gets the dome (desk state) at a particular aeon. - :: - :: For past aeons, we don't give an actual ankh in the dome, but the rest - :: of the data is legit. - :: - ++ read-v - |= {yon/aeon pax/path} - ^- (unit (unit {$dome (hypo dome)})) - ?: (lth yon let.dom) - :* ~ ~ %dome -:!>(%dome) - ank=`[[%ank-in-old-v-not-implemented *ankh] ~ ~] - let=yon - hit=(molt (skim (~(tap by hit.dom)) |=({p/@ud *} (lte p yon)))) - lab=(molt (skim (~(tap by lab.dom)) |=({* p/@ud} (lte p yon)))) - == - ?: (gth yon let.dom) - ~ - ``[%dome -:!>(*dome) dom] - :: - :: Gets the data at a node. - :: - :: If it's in our ankh (current state cache), we can just produce the - :: result. Otherwise, we've got to look up the node at the aeon to get the - :: content hash, use that to find the blob, and use the blob to get the - :: data. We also special-case the hoon mark for bootstrapping purposes. - :: - ++ read-x - |= {yon/aeon pax/path} - ^- (unit (unit (each cage lobe))) - ?: =(0 yon) - [~ ~] - =+ tak=(~(get by hit.dom) yon) - ?~ tak - ~ - ?: &(?=($~ ref) =(yon let.dom)) - :- ~ - %+ bind - fil.ank:(descend-path:(zu ank.dom) pax) - |=(a/{p/lobe q/cage} [%& q.a]) - =+ yak=(tako-to-yaki u.tak) - =+ lob=(~(get by q.yak) pax) - ?~ lob - [~ ~] - =+ mar=(lobe-to-mark u.lob) - ?. ?=($hoon mar) - [~ ~ %| u.lob] - :^ ~ ~ %& - :+ mar [%atom %t ~] - |- ^- @t :: (urge cord) would be faster - =+ bol=(lobe-to-blob u.lob) - ?: ?=($direct -.bol) - ((hard @t) q.q.bol) - ?> ?=($delta -.bol) - =+ txt=$(u.lob q.q.bol) - ?> ?=($txt-diff p.r.bol) - =+ dif=((hard (urge cord)) q.r.bol) - =, format - =+ pac=(of-wain (lurk:differ (to-wain (cat 3 txt '\0a')) dif)) - (end 3 (dec (met 3 pac)) pac) - :: - :: Gets an arch (directory listing) at a node. - :: - ++ read-y - |= {yon/aeon pax/path} - ^- (unit (unit {$arch (hypo arch)})) - ?: =(0 yon) - ``[%arch -:!>(*arch) *arch] - =+ tak=(~(get by hit.dom) yon) - ?~ tak - ~ - =+ yak=(tako-to-yaki u.tak) - =+ len=(lent pax) - :^ ~ ~ %arch - :: ~& cy+pax - :- -:!>(*arch) - ^- arch - :- (~(get by q.yak) pax) - ^- (map knot $~) - %- molt ^- (list (pair knot $~)) - %+ turn - ^- (list (pair path lobe)) - %+ skim (~(tap by (~(del by q.yak) pax))) - |= {paf/path lob/lobe} - =(pax (scag len paf)) - |= {paf/path lob/lobe} - =+ pat=(slag len paf) - [?>(?=(^ pat) i.pat) ~] - :: - :: Gets a recursive hash of a node and all its children. - :: - ++ read-z - |= {yon/aeon pax/path} - ^- (unit (unit {$uvi (hypo @uvI)})) - ?: =(0 yon) - ``uvi+[-:!>(*@uvI) *@uvI] - =+ tak=(~(get by hit.dom) yon) - ?~ tak - ~ - =+ yak=(tako-to-yaki u.tak) - =+ len=(lent pax) - :: ~& read-z+[yon=yon qyt=~(wyt by q.yak) pax=pax] - =+ ^- descendants/(list (pair path lobe)) - :: ~& %turning - :: =- ~& %turned - - %+ turn - :: ~& %skimming - :: =- ~& %skimmed - - %+ skim (~(tap by (~(del by q.yak) pax))) - |= {paf/path lob/lobe} - =(pax (scag len paf)) - |= {paf/path lob/lobe} - [(slag len paf) lob] - =+ us=(~(get by q.yak) pax) - ^- (unit (unit {$uvi (hypo @uvI)})) - :^ ~ ~ %uvi - :- -:!>(*@uvI) - ?: &(?=($~ descendants) ?=($~ us)) - *@uvI - %+ roll - ^- (list (pair path lobe)) - [[~ ?~(us *lobe u.us)] descendants] - |=({{path lobe} @uvI} (shax (jam +<))) - :: - :: Get a value at an aeon. - :: - :: Value can be either null, meaning we don't have it yet, {null null}, - :: meaning we know it doesn't exist, or {null null (each cage lobe)}, - :: meaning we either have the value directly or a content hash of the - :: value. - :: - :: Should change last few lines to an explicit ++read-w. - :: - ++ read-at-aeon :: read-at-aeon:ze - |= {yon/aeon mun/mood} :: seek and read - ^- (unit (unit (each cage lobe))) - ?: &(?=($w p.mun) !?=($ud -.q.mun)) :: NB only her speed - ?^(r.mun [~ ~] [~ ~ %& %aeon !>(yon)]) - ?: ?=($d p.mun) - =+ rom=(~(get by fat.ruf) her) - ?~ rom - ~&(%null-rom-cd [~ ~]) - ?^ r.mun - ~&(%no-cd-path [~ ~]) - [~ ~ %& %noun !>(~(key by dos.u.rom))] - ?: ?=($u p.mun) - (read-u yon r.mun) - ?: ?=($v p.mun) - (bind (read-v yon r.mun) (lift |=(a/cage [%& a]))) - ?: ?=($x p.mun) - (read-x yon r.mun) - ?: ?=($y p.mun) - :: =- ~& :* %dude-someones-getting-curious - :: mun=mun - :: yon=yon - :: our=our - :: her=her - :: syd=syd - :: hep=- - :: == - :: - - (bind (read-y yon r.mun) (lift |=(a/cage [%& a]))) - ?: ?=($z p.mun) - (bind (read-z yon r.mun) (lift |=(a/cage [%& a]))) - %+ bind - (rewind yon) - |= a/(unit _+>.$) - ^- (unit (each cage lobe)) - ?~ a - ~ - `(unit (each cage lobe))`(bind (read:u.a mun) |=(a/cage [%& a])) - :: - :: Stubbed out, should be removed in the refactoring mentioned in ++query. - :: - ++ rewind :: rewind:ze - |= yon/aeon :: rewind to aeon - ^- (unit (unit _+>)) - ?: =(let.dom yon) ``+> - ?: (gth yon let.dom) !! :: don't have version - =+ hat=q:(aeon-to-yaki yon) - ?: (~(any by hat) |=(a/lobe ?=($delta [-:(lobe-to-blob a)]))) - ~ - ~ - ::=+ ^- (map path cage) - :: %- ~(run by hat) - :: |= a=lobe - :: =+ (lobe-to-blob a) - :: ?-(-.- %direct q.-, %delta !!) - ::`+>.$(ank.dom (map-to-ankh -), let.dom yon) - :: - :: Traverse an ankh. - :: - ++ zu :: filesystem - |= ank/ankh :: filesystem state - =| ram/path :: reverse path into - |% - ++ descend :: descend - |= lol/@ta - ^+ +> - =+ you=(~(get by dir.ank) lol) - +>.$(ram [lol ram], ank ?~(you [~ ~] u.you)) - :: - ++ descend-path :: descend recursively - |= way/path - ^+ +> - ?~(way +> $(way t.way, +> (descend i.way))) - -- - :: - :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - :: - :: This core is specific to any currently running merge. This is - :: basically a simple (DAG-shaped) state machine. We always say we're - :: merging from 'ali' to 'bob'. The basic steps, not all of which are - :: always needed, are: - :: - :: -- fetch ali's desk - :: -- diff ali's desk against the mergebase - :: -- diff bob's desk against the mergebase - :: -- merge the diffs - :: -- build the new state - :: -- "checkout" (apply to actual `++dome`) the new state - :: -- "ergo" (tell unix about) any changes - :: - :: The state filled in order through each step. See ++mery for a - :: description of the state. - :: - :: - :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - ++ me :: merge ali into bob - |= {ali/(pair ship desk) alh/(unit dome) new/?} :: from - =+ bob=`(pair ship desk)`[our syd] :: to - =+ ^- dat/(each mery term) - ?~ mer - ?: new - =+ *mery - [%& -(sor ali:+, hen hen:+, wat %null)] - [%| %not-actually-merging] - ?. new - ?: =(ali sor.u.mer) - [%& u.mer] - ~& :* %already-merging-from-somewhere-else - ali=ali - sor=sor.u.mer - gem=gem.u.mer - wat=wat.u.mer - cas=cas.u.mer - hen=hen - henmer=hen.u.mer - == - [%| %already-merging-from-somewhere-else] - ~& :* %already-merging-from-somewhere - ali=ali - sor=sor.u.mer - gem=gem.u.mer - wat=wat.u.mer - cas=cas.u.mer - hen=hen - henmer=hen.u.mer - == - [%| %already-merging-from-somewhere] - ?: ?=($| -.dat) - ~|(p.dat !!) - =+ dat=p.dat - =| don/? :: keep going - |% - :: - :: Resolve. If we're done, produce a result. - :: - ++ abet - ^+ ..me - ?: don - ..me(mer `dat) - =. mer ~ - => (emit hen.dat %give %mere gon.dat) - ..me - :: - :: Send a move. - :: - ++ emit - |= move - %_(+> ..ze (^emit +<)) - :: - :: Send a list of moves. - :: - ++ emil - |= (list move) - %_(+> ..ze (^emil +<)) - :: - :: Route responses from clay or ford. - :: - :: Check that the stage of the response is the same as the stage we think - :: we're in, and call the appropriate function for that stage. - :: - ++ route - |= {sat/term res/(each riot gage:ford)} - ^+ +>.$ - ?. =(sat wat.dat) - ~| :* %hold-your-horses-merge-out-of-order - sat=sat - wat=wat.dat - ali=ali - bob=bob - hepres=-.res - == - !! - ?+ +< ~|((crip <[%bad-stage sat ?~(-.res %riot %gage)]>) !!) - {$ali $& *} %.(p.res fetched-ali) - {$diff-ali $| *} %.(p.res diffed-ali) - {$diff-bob $| *} %.(p.res diffed-bob) - {$merge $| *} %.(p.res merged) - {$build $| *} %.(p.res built) - {$checkout $| *} %.(p.res checked-out) - {$ergo $| *} %.(p.res ergoed) - == - :: - :: Start a merge. - :: - :: Sets cas.dat, gem.dat, and bob.dat. Unless there's an error, leads - :: to ++fetch-ali. - :: - ++ start - |= {cas/case gem/germ} - ^+ +> - ?: &(=(0 let.dom) !?=(?($init $that) gem)) - (error:he %no-bob-desk ~) - =. cas.dat cas - =. gem.dat gem - ?: =(0 let.dom) - fetch-ali(gem.dat %init) - =+ (~(get by hit.dom) let.dom) - ?~ - - (error:he %no-bob--version ~) - =+ (~(get by hut.ran) u.-) - ?~ - - (error:he %no-bob-commit ~) - fetch-ali(bob.dat u.-) - :: - :: Tell clay to get the state at the requested case for ali's desk. - :: - ++ fetch-ali - ^+ . - %- emit(wat.dat %ali) - :* hen %pass - [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %ali ~] - %c %warp [p.bob p.ali] q.ali - `[%sing %v cas.dat /] - == - :: - :: Parse the state of ali's desk, and get the most recent commit. - :: - :: Sets ali.dat. - :: - ++ fetched-ali - |= rot/riot - ^+ +> - ?~ rot - (error:he %bad-fetch-ali ~) - =+ ^= dum - %- (hard {ank/* let/@ud hit/(map @ud tako) lab/(map @tas @ud)}) - q.q.r.u.rot - ?: =(0 let.dum) - (error:he %no-ali-desk ~) - =+ (~(get by hit.dum) let.dum) - ?~ - - (error:he %no-ali-version ~) - =+ (~(get by hut.ran) u.-) - ?~ - - (error:he %no-ali-commit ~) - =. ali.dat u.- - |- - ?- gem.dat - :: - :: If this is an %init merge, we set the ali's commit to be bob's, and - :: we checkout the new state. - :: - $init - =. new.dat ali.dat - =. hut.ran (~(put by hut.ran) r.new.dat new.dat) - =. erg.dat (~(run by q.ali.dat) |=(lobe %&)) - checkout - :: - :: If this is a %this merge, we check to see if ali's and bob's commits - :: are the same, in which case we're done. Otherwise, we check to see - :: if ali's commit is in the ancestry of bob's, in which case we're - :: done. Otherwise, we create a new commit with bob's data plus ali - :: and bob as parents. Then we checkout the new state. - :: - $this - ?: =(r.ali.dat r.bob.dat) done:he - ?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat) done:he - =. new.dat (make-yaki [r.ali.dat r.bob.dat ~] q.bob.dat now) - =. hut.ran (~(put by hut.ran) r.new.dat new.dat) - =. erg.dat ~ - checkout - :: - :: If this is a %that merge, we check to see if ali's and bob's commits - :: are the same, in which case we're done. Otherwise, we create a new - :: commit with ali's data plus ali and bob as parents. Then we - :: checkout the new state. - :: - $that - ?: =(r.ali.dat r.bob.dat) done:he - =. new.dat (make-yaki [r.ali.dat r.bob.dat ~] q.ali.dat now) - =. hut.ran (~(put by hut.ran) r.new.dat new.dat) - =. erg.dat - %- malt ^- (list {path ?}) - %+ murn (~(tap by (~(uni by q.bob.dat) q.ali.dat))) - |= {pax/path lob/lobe} - ^- (unit {path ?}) - =+ a=(~(get by q.ali.dat) pax) - =+ b=(~(get by q.bob.dat) pax) - ?: =(a b) - ~ - `[pax !=(~ a)] - checkout - :: - :: If this is a %fine merge, we check to see if ali's and bob's commits - :: are the same, in which case we're done. Otherwise, we check to see - :: if ali's commit is in the ancestry of bob's, in which case we're - :: done. Otherwise, we check to see if bob's commit is in the ancestry - :: of ali's. If not, this is not a fast-forward merge, so we error - :: out. If it is, we add ali's commit to bob's desk and checkout. - :: - $fine - ?: =(r.ali.dat r.bob.dat) - :: ~& [%fine-trivial ali= bob= r.ali.dat r.bob.dat] - done:he - ?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat) - :: ~& [%fine-mostly-trivial ali= bob=] - done:he - ?. (~(has in (reachable-takos r.ali.dat)) r.bob.dat) - :: ~& [%fine-not-so-trivial ali= bob=] - (error:he %bad-fine-merge ~) - :: ~& [%fine-lets-go ali= bob=] - =. new.dat ali.dat - =. erg.dat - %- malt ^- (list {path ?}) - %+ murn (~(tap by (~(uni by q.bob.dat) q.ali.dat))) - |= {pax/path lob/lobe} - ^- (unit {path ?}) - =+ a=(~(get by q.ali.dat) pax) - =+ b=(~(get by q.bob.dat) pax) - ?: =(a b) - ~ - `[pax !=(~ a)] - checkout - :: - :: If this is a %meet, %mate, or %meld merge, we may need to fetch - :: more data. If this merge is either trivial or a fast-forward, we - :: short-circuit to either ++done or the %fine case. - :: - :: Otherwise, we find the best common ancestor(s) with - :: ++find-merge-points. If there's no common ancestor, we error out. - :: Additionally, if there's more than one common ancestor (i.e. this - :: is a criss-cross merge), we error out. Something akin to git's - :: recursive merge should probably be used here, but it isn't. - :: - :: Once we have our single best common ancestor (merge base), we store - :: it in bas.dat. If this is a %mate or %meld merge, we need to diff - :: ali's commit against the merge base, so we pass control over to - :: ++diff-ali. - :: - :: Otherwise (i.e. this is a %meet merge), we create a list of all the - :: changes between the mege base and ali's commit and store it in - :: dal.dat, and we put a similar list for bob's commit in dob.dat. - :: Then we create bof, which is the a set of changes in both ali and - :: bob's commits. If this has any members, we have conflicts, which is - :: an error in a %meet merge, so we error out. - :: - :: Otherwise, we merge the merge base data with ali's data and bob's - :: data, which produces the data for the new commit, which we put in - :: new.dat. Then we checkout the new data. - :: - ?($meet $mate $meld) - ?: =(r.ali.dat r.bob.dat) - done:he - ?. (~(has by hut.ran) r.bob.dat) - (error:he %bad-bob-tako >r.bob.dat< ~) - ?: (~(has in (reachable-takos r.bob.dat)) r.ali.dat) - done:he - ?: (~(has in (reachable-takos r.ali.dat)) r.bob.dat) - $(gem.dat %fine) - =+ r=(find-merge-points:he ali.dat bob.dat) - ?~ r - (error:he %merge-no-merge-base ~) - ?. ?=({* $~ $~} r) - =+ (lent (~(tap in `(set yaki)`r))) - (error:he %merge-criss-cross >[-]< ~) - =. bas.dat n.r - ?: ?=(?($mate $meld) gem.dat) - diff-ali - =. new.dal.dat - %- molt - %+ skip (~(tap by q.ali.dat)) - |= {pax/path lob/lobe} - (~(has by q.bas.dat) pax) - =. cal.dal.dat - %- molt - %+ skip (~(tap by q.ali.dat)) - |= {pax/path lob/lobe} - =+ (~(get by q.bas.dat) pax) - |(=(~ -) =([~ lob] -)) - =. can.dal.dat - ~ - =. old.dal.dat - %- malt ^- (list {path $~}) - %+ murn (~(tap by q.bas.dat)) - |= {pax/path lob/lobe} - ^- (unit (pair path $~)) - ?. =(~ (~(get by q.ali.dat) pax)) - ~ - `[pax ~] - =. new.dob.dat - %- molt - %+ skip (~(tap by q.bob.dat)) - |= {pax/path lob/lobe} - (~(has by q.bas.dat) pax) - =. cal.dob.dat - %- molt - %+ skip (~(tap by q.bob.dat)) - |= {pax/path lob/lobe} - =+ (~(get by q.bas.dat) pax) - |(=(~ -) =([~ lob] -)) - =. can.dob.dat - ~ - =. old.dob.dat - %- malt ^- (list {path $~}) - %+ murn (~(tap by q.bas.dat)) - |= {pax/path lob/lobe} - ^- (unit (pair path $~)) - ?. =(~ (~(get by q.bob.dat) pax)) - ~ - `[pax ~] - =+ ^= bof - %- %~ int by - %- ~(uni by `(map path *)`new.dal.dat) - %- ~(uni by `(map path *)`cal.dal.dat) - %- ~(uni by `(map path *)`can.dal.dat) - `(map path *)`old.dal.dat - == - %- ~(uni by `(map path *)`new.dob.dat) - %- ~(uni by `(map path *)`cal.dob.dat) - %- ~(uni by `(map path *)`can.dob.dat) - `(map path *)`old.dob.dat - ?^ bof - (error:he %meet-conflict >(~(run by `(map path *)`bof) $~)< ~) - =+ ^- old/(map path lobe) - %+ roll (~(tap by (~(uni by old.dal.dat) old.dob.dat))) - =< .(old q.bas.dat) - |= {{pax/path $~} old/(map path lobe)} - (~(del by old) pax) - =+ ^= hat - %- ~(uni by old) - %- ~(uni by new.dal.dat) - %- ~(uni by new.dob.dat) - %- ~(uni by cal.dal.dat) - cal.dob.dat - =+ ^- del/(map path ?) - (~(run by (~(uni by old.dal.dat) old.dob.dat)) |=($~ %|)) - =. new.dat - (make-yaki [r.ali.dat r.bob.dat ~] hat now) - =. hut.ran (~(put by hut.ran) r.new.dat new.dat) - =. erg.dat %- ~(uni by del) - ^- (map path ?) - %. |=(lobe %&) - ~(run by (~(uni by new.dal.dat) cal.dal.dat)) - checkout - == - :: - :: Common code for ++diff-ali and ++diff-bob. - :: - :: Diffs a commit against a the mergebase. Result comes back in either - :: ++diffed-ali or ++diffed-ali. - :: - ++ diff-bas - |= {nam/term yak/yaki oth/(trel ship desk case) yuk/yaki} - ^+ +> - %- emit - :* hen %pass - =+ (cat 3 %diff- nam) - [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali - ~] - %f %exec p.bob ~ [p.oth q.oth r.oth] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ murn (~(tap by q.bas.dat)) - |= {pax/path lob/lobe} - ^- (unit (pair silk:ford silk:ford)) - =+ a=(~(get by q.yak) pax) - ?~ a - ~ - ?: =(lob u.a) - ~ - =+ (~(get by q.yuk) pax) - ?~ - - ~ - ?: =(u.a u.-) - ~ - :- ~ - :- [%$ %path !>(pax)] - [%diff (lobe-to-silk pax lob) (lobe-to-silk pax u.a)] - == - :: - :: Diff ali's commit against the mergebase. - :: - ++ diff-ali - ^+ . - (diff-bas(wat.dat %diff-ali) %ali ali.dat [p.ali q.ali cas.dat] bob.dat) - :: - :: Store the diff of ali's commit versus the mergebase in dal.dat and - :: call ++diff-bob. - :: - ++ diffed-ali - |= res/gage:ford - ^+ +> - =+ tay=(gage-to-cages-or-error res) - ?: ?=($| -.tay) - (error:he %diff-ali-bad-made leaf+"merge diff ali failed" p.tay) - =+ can=(cages-to-map p.tay) - ?: ?=($| -.can) - (error:he %diff-ali p.can) - ?: ?=($| -.gon.dat) - +>.$ - =. new.dal.dat - %- molt - %+ skip (~(tap by q.ali.dat)) - |= {pax/path lob/lobe} - (~(has by q.bas.dat) pax) - =. cal.dal.dat - %- molt ^- (list (pair path lobe)) - %+ murn (~(tap by q.bas.dat)) - |= {pax/path lob/lobe} - ^- (unit (pair path lobe)) - =+ a=(~(get by q.ali.dat) pax) - =+ b=(~(get by q.bob.dat) pax) - ?. ?& ?=(^ a) - !=([~ lob] a) - =([~ lob] b) - == - ~ - `[pax +.a] - =. can.dal.dat p.can - =. old.dal.dat - %- malt ^- (list {path $~}) - %+ murn (~(tap by q.bas.dat)) - |= {pax/path lob/lobe} - ?. =(~ (~(get by q.ali.dat) pax)) - ~ - (some pax ~) - diff-bob - :: - :: Diff bob's commit against the mergebase. - :: - ++ diff-bob - ^+ . - (diff-bas(wat.dat %diff-bob) %bob bob.dat [p.bob q.bob da+now] ali.dat) - :: - :: Store the diff of bob's commit versus the mergebase in dob.dat and - :: call ++merge. - :: - ++ diffed-bob - |= res/gage:ford - ^+ +> - =+ tay=(gage-to-cages-or-error res) - ?: ?=($| -.tay) - (error:he %diff-bob-bad-made leaf+"merge diff bob failed" p.tay) - =+ can=(cages-to-map p.tay) - ?: ?=($| -.can) - (error:he %diff-bob p.can) - ?: ?=($| -.gon.dat) - +>.$ - =. new.dob.dat - %- molt - %+ skip (~(tap by q.bob.dat)) - |= {pax/path lob/lobe} - (~(has by q.bas.dat) pax) - =. cal.dob.dat - %- molt ^- (list (pair path lobe)) - %+ murn (~(tap by q.bas.dat)) - |= {pax/path lob/lobe} - ^- (unit (pair path lobe)) - =+ a=(~(get by q.ali.dat) pax) - =+ b=(~(get by q.bob.dat) pax) - ?. ?& ?=(^ b) - !=([~ lob] b) - =([~ lob] a) - == - ~ - `[pax +.b] - =. can.dob.dat p.can - =. old.dob.dat - %- malt ^- (list {path $~}) - %+ murn (~(tap by q.bas.dat)) - |= {pax/path lob/lobe} - ?. =(~ (~(get by q.bob.dat) pax)) - ~ - (some pax ~) - merge - :: - :: Merge the conflicting diffs in can.dat.dat and can.dob.dat. - :: - :: Result is handled in ++merged. - :: - ++ merge - ^+ . - |- ^+ +.$ - ?+ gem.dat ~| [%merge-weird-gem gem.dat] !! - ?($mate $meld) - %- emit(wat.dat %merge) - :* hen %pass - [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %merge ~] - %f %exec p.bob ~ [p.bob q.bob da+now] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn (~(tap by (~(int by can.dal.dat) can.dob.dat))) - |= {pax/path *} - ^- (pair silk:ford silk:ford) - =+ cal=(~(got by can.dal.dat) pax) - =+ cob=(~(got by can.dob.dat) pax) - =+ ^= her - =+ (slag (dec (lent pax)) pax) - ?~(- %$ i.-) - :- [%$ %path !>(pax)] - [%join her [%$ cal] [%$ cob]] - == - == - :: - :: Put merged changes in bof.dat and call ++build. - :: - ++ merged - |= res/gage:ford - =+ tay=(gage-to-cages-or-error res) - ?: ?=($| -.tay) - (error:he %merge-bad-made leaf+"merging failed" p.tay) - =+ can=(cages-to-map p.tay) - ?: ?=($| -.can) - (error:he %merge p.can) - =+ bof=(~(run by p.can) (flit |=({a/mark ^} !?=($null a)))) - ?: ?=($| -.gon.dat) - +>.$ - =. bof.dat bof - build - :: - :: Apply the patches in bof.dat to get the new merged content. - :: - :: Result is handled in ++built - :: - ++ build - ^+ . - %- emit(wat.dat %build) - :* hen %pass - [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %build ~] - %f %exec p.bob ~ [p.bob q.bob da+now] %tabl - ^- (list (pair silk:ford silk:ford)) - %+ murn (~(tap by bof.dat)) - |= {pax/path cay/(unit cage)} - ^- (unit (pair silk:ford silk:ford)) - ?~ cay - ~ - :- ~ - :- [%$ %path !>(pax)] - =+ (~(get by q.bas.dat) pax) - ?~ - - ~| %mate-strange-diff-no-base - !! - [%pact (lobe-to-silk pax u.-) [%$ u.cay]] - == - :: - :: Create new commit. - :: - :: Gather all the changes between ali's and bob's commits and the - :: mergebase. This is similar to the %meet of ++fetched-ali, except - :: where they touch the same file, we use the merged versions we created - :: earlier (bop.dat). - :: - :: Sum all the changes into a new commit (new.dat), and checkout. - :: - ++ built - |= res/gage:ford - ^+ +> - =+ tay=(gage-to-cages-or-error res) - ?: ?=($| -.tay) - (error:he %build-bad-made leaf+"delta building failed" p.tay) - =+ bop=(cages-to-map p.tay) - ?: ?=($| -.bop) - (error:he %built p.bop) - ?: ?=($| -.gon.dat) - +>.$ - =. bop.dat p.bop - =+ ^- con/(map path *) :: 2-change conflict - %- molt - %+ skim (~(tap by bof.dat)) - |=({pax/path cay/(unit cage)} ?=($~ cay)) - =+ ^- cas/(map path lobe) :: conflict base - %- ~(urn by con) - |= {pax/path *} - (~(got by q.bas.dat) pax) - =. con :: change+del conflict - %- ~(uni by con) - %- malt ^- (list {path *}) - %+ skim (~(tap by old.dal.dat)) - |= {pax/path $~} - ?: (~(has by new.dob.dat) pax) - ~| %strange-add-and-del - !! - (~(has by can.dob.dat) pax) - =. con :: change+del conflict - %- ~(uni by con) - %- malt ^- (list {path *}) - %+ skim (~(tap by old.dob.dat)) - |= {pax/path $~} - ?: (~(has by new.dal.dat) pax) - ~| %strange-del-and-add - !! - (~(has by can.dal.dat) pax) - =. con :: add+add conflict - %- ~(uni by con) - %- malt ^- (list {path *}) - %+ skip (~(tap by (~(int by new.dal.dat) new.dob.dat))) - |= {pax/path *} - =((~(got by new.dal.dat) pax) (~(got by new.dob.dat) pax)) - ?: &(?=($mate gem.dat) ?=(^ con)) - =+ (turn (~(tap by `(map path *)`con)) |=({path *} >[+<-]<)) - (error:he %mate-conflict -) - =+ ^- old/(map path lobe) :: oldies but goodies - %+ roll (~(tap by (~(uni by old.dal.dat) old.dob.dat))) - =< .(old q.bas.dat) - |= {{pax/path $~} old/(map path lobe)} - (~(del by old) pax) - =+ ^- can/(map path cage) :: content changes - %- molt - ^- (list (pair path cage)) - %+ murn (~(tap by bof.dat)) - |= {pax/path cay/(unit cage)} - ^- (unit (pair path cage)) - ?~ cay - ~ - `[pax u.cay] - =^ hot lat.ran :: new content - ^- {(map path lobe) (map lobe blob)} - %+ roll (~(tap by can)) - =< .(lat lat.ran) - |= {{pax/path cay/cage} hat/(map path lobe) lat/(map lobe blob)} - =+ ^= bol - =+ (~(get by q.bas.dat) pax) - ?~ - - ~| %mate-strange-diff-no-base - !! - %^ make-delta-blob - (page-to-lobe [p q.q]:(~(got by bop.dat) pax)) - [(lobe-to-mark u.-) u.-] - [p q.q]:cay - [(~(put by hat) pax p.bol) (~(put by lat) p.bol bol)] - :: ~& old=(~(run by old) mug) - :: ~& newdal=(~(run by new.dal.dat) mug) - :: ~& newdob=(~(run by new.dob.dat) mug) - :: ~& caldal=(~(run by cal.dal.dat) mug) - :: ~& caldob=(~(run by cal.dob.dat) mug) - :: ~& hot=(~(run by hot) mug) - :: ~& cas=(~(run by cas) mug) - =+ ^- hat/(map path lobe) :: all the content - %- ~(uni by old) - %- ~(uni by new.dal.dat) - %- ~(uni by new.dob.dat) - %- ~(uni by cal.dal.dat) - %- ~(uni by cal.dob.dat) - %- ~(uni by hot) - cas - :: ~& > hat=(~(run by hat) mug) - =+ ^- del/(map path ?) - (~(run by (~(uni by old.dal.dat) old.dob.dat)) |=($~ %|)) - =. gon.dat [%& (silt (turn (~(tap by con)) head))] - =. new.dat - (make-yaki [r.ali.dat r.bob.dat ~] hat now) - =. hut.ran (~(put by hut.ran) r.new.dat new.dat) - =. erg.dat %- ~(uni by del) - ^- (map path ?) - %. |=(lobe %&) - %~ run by - %- ~(uni by new.dal.dat) - %- ~(uni by cal.dal.dat) - %- ~(uni by cas) - hot - == - checkout - :: - :: Convert new commit into actual data (i.e. blobs rather than lobes). - :: - :: Result is handled in ++checked-out. - :: - ++ checkout - ^+ . - =+ ^- val/beak - ?: ?=($init gem.dat) - [p.ali q.ali cas.dat] - [p.bob q.bob da+now] - %- emit(wat.dat %checkout) - :* hen %pass - [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %checkout ~] - %f %exec p.bob ~ val %tabl - ^- (list (pair silk:ford silk:ford)) - %+ murn (~(tap by q.new.dat)) - |= {pax/path lob/lobe} - ^- (unit (pair silk:ford silk:ford)) - ?: (~(has by bop.dat) pax) - ~ - `[[%$ %path !>(pax)] (merge-lobe-to-silk:he pax lob)] - == - :: - :: Apply the new commit to our state and, if we need to tell unix about - :: some of the changes, call ++ergo. - :: - ++ checked-out - |= res/gage:ford - ^+ +> - =+ tay=(gage-to-cages-or-error res) - ?: ?=($| -.tay) - (error:he %checkout-bad-made leaf+"merge checkout failed" p.tay) - =+ can=(cages-to-map p.tay) - ?: ?=($| -.can) - (error:he %checkout p.can) - ?: ?=($| -.gon.dat) - +>.$ - =. let.dom +(let.dom) - =. hit.dom (~(put by hit.dom) let.dom r.new.dat) - =. ank.dat - %- map-to-ankh:ze - %- ~(run by (~(uni by bop.dat) p.can)) - |=(cage [(page-to-lobe p q.q) +<]) - =. ank.dom ank.dat - => .(..wake wake) - ?~ hez done:he - =+ mus=(must-ergo (turn (~(tap by erg.dat)) head)) - ?: =(~ mus) done:he - ergo - :: - :: Cast all the content that we're going to tell unix about to %mime. - :: - :: Result is handled in ++ergoed. - :: - ++ ergo - ^+ . - =+ ^- sum/(set path) - =+ (must-ergo (turn (~(tap by erg.dat)) head)) - =+ (turn (~(tap by -)) (corl tail tail)) - %+ roll - - |= {pak/(set path) acc/(set path)} - (~(uni in acc) pak) - =+ zez=ze(ank.dom ank.dat) - =+ ^- val/beak - ?: ?=($init gem.dat) - [p.ali q.ali cas.dat] - [p.bob q.bob da+now] - %- emit(wat.dat %ergo) - :* hen %pass - [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %ergo ~] - %f %exec p.bob ~ val %tabl - ^- (list (pair silk:ford silk:ford)) - %+ turn (~(tap in sum)) - |= a/path - ^- (pair silk:ford silk:ford) - :- [%$ %path !>(a)] - =+ b=(~(got by erg.dat) a) - ?. b - [%$ %null !>(~)] - :+ %kthp %mime - (lobe-to-silk:zez a (~(got by q.new.dat) a)) - == - :: - :: Tell unix about the changes made by the merge. - :: - ++ ergoed - |= res/gage:ford - ^+ +> - =+ tay=(gage-to-cages-or-error res) - ?: ?=($| -.tay) - (error:he %ergo-bad-made leaf+"merge ergo failed" p.tay) - =+ =| nac/mode - |- ^- tan/$^(mode {p/term q/tang}) - ?~ p.tay nac - =* pax p.i.p.tay - ?. ?=($path p.pax) - [%ergo >[%expected-path got=p.pax]< ~] - =* mim q.i.p.tay - =+ mit=?.(?=($mime p.mim) ~ `((hard mime) q.q.mim)) - $(p.tay t.p.tay, nac :_(nac [((hard path) q.q.pax) mit])) - ?: ?=({@ *} tan) (error:he tan) - =+ `can/(map path (unit mime))`(malt tan) - ?~ hez - (error:he %ergo-no-hez ~) - ?: ?=($| -.gon.dat) - +>.$ - =+ mus=(must-ergo (turn (~(tap by erg.dat)) head)) - =< done:he - %- emil - %+ turn (~(tap by mus)) - |= {pot/term len/@ud pak/(set path)} - :* u.hez %give %ergo pot - %+ turn (~(tap in pak)) - |= pax/path - [(slag len pax) (~(got by can) pax)] - == - :: - :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - :: - :: This core is a small set of helper functions to assist in merging. - :: - :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - ++ he - |% - :: - :: Assert that we're goig to be returning something, and set don to - :: true, so that ++abet knows we're done. - :: - ++ done - ^+ ..he - ?< ?=($| -.gon.dat) - ..he(don |) - :: - :: Cancel the merge gracefully and produce an error. - :: - ++ error - |= {err/term tan/(list tank)} - ^+ ..he - ..he(don |, gon.dat [%| err >ali< >bob< >cas.dat< >gem.dat< tan]) - :: - :: Create a silk to turn a lobe into a blob. - :: - :: We short-circuit if we already have the content somewhere. - :: - ++ merge-lobe-to-silk - |= {pax/path lob/lobe} - ^- silk:ford - =+ hat=q.ali.dat - =+ hot=q.bob.dat - =+ ^= lal - %+ biff alh - |= had/dome - (~(get by q:(tako-to-yaki (~(got by hit.had) let.had))) pax) - =+ lol=(~(get by hot) pax) - |- ^- silk:ford - ?: =([~ lob] lol) - =+ (need (need (read-x let.dom pax))) - ?> ?=($& -<) - [%$ p.-] - ?: =([~ lob] lal) - [%$ +:(need fil.ank:(descend-path:(zu ank:(need alh)) pax))] - =+ bol=(~(got by lat.ran) lob) - ?- -.bol - $direct (page-to-silk q.bol) - $delta [%pact $(lob q.q.bol) (page-to-silk r.bol)] - == - :: - :: Find the most recent common ancestor(s). - :: - ++ find-merge-points - |= {p/yaki q/yaki} :: maybe need jet - ^- (set yaki) - %- reduce-merge-points - =+ r=(reachable-takos r.p) - |- ^- (set yaki) - ?: (~(has in r) r.q) (~(put in *(set yaki)) q) - %+ roll p.q - |= {t/tako s/(set yaki)} - ?: (~(has in r) t) - (~(put in s) (tako-to-yaki t)) :: found - (~(uni in s) ^$(q (tako-to-yaki t))) :: traverse - :: - :: Helper for ++find-merge-points. - :: - ++ reduce-merge-points - |= unk/(set yaki) :: maybe need jet - =| gud/(set yaki) - =+ ^= zar - ^- (map tako (set tako)) - %+ roll (~(tap in unk)) - |= {yak/yaki qar/(map tako (set tako))} - (~(put by qar) r.yak (reachable-takos r.yak)) - |- - ^- (set yaki) - ?~ unk gud - =+ bun=(~(del in `(set yaki)`unk) n.unk) - ?: %+ levy (~(tap by (~(uni in gud) bun)) ~) - |= yak/yaki - !(~(has in (~(got by zar) r.yak)) r.n.unk) - $(gud (~(put in gud) n.unk), unk bun) - $(unk bun) - -- - -- - -- - -- --- -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -:: section 4cA, filesystem vane -:: -:: This is the arvo interface vane. Our formal state is a `++raft`, which -:: has five components: -:: -:: -- `fat` is the state for all local desks. -:: -- `hoy` is the state for all foreign desks. -:: -- `ran` is the global, hash-addressed object store. -:: -- `mon` is the set of mount points in unix. -:: -- `hez` is the duct to the unix sync. -:: -:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: -=| :: instrument state - $: $1 :: vane version - ruf/raft :: revision tree - == :: -|= {now/@da eny/@ ski/sley} :: activate -^? :: opaque core -|% :: -++ call :: handle request - |= $: hen/duct - hic/(hypo (hobo task:able)) - == - => %= . :: XX temporary - q.hic - ^- task:able - ?: ?=($soft -.q.hic) - =+ - ~|([%bad-soft (@t -.p.q.hic)] ((soft task:able) p.q.hic)) - ?~ - - ~& [%bad-softing (@t -.p.q.hic)] !! - u.- - ?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic - ~& [%clay-call-flub (@tas `*`-.q.hic)] - ((hard task:able) q.hic) - == - ^+ [p=*(list move) q=..^$] - ?- -.q.hic - $boat - :_ ..^$ - [hen %give %hill (turn (~(tap by mon.ruf)) head)]~ - :: - $drop - =^ mos ruf - =+ den=((de now hen ruf) [. .]:p.q.hic q.q.hic) - abet:drop-me:den - [mos ..^$] - :: - $info - ?: =(%$ q.q.hic) - [~ ..^$] - =^ mos ruf - =+ den=((de now hen ruf) [. .]:p.q.hic q.q.hic) - abet:(edit:den now r.q.hic) - [mos ..^$] - :: - $init - :_ %_ ..^$ - fat.ruf - ?< (~(has by fat.ruf) p.q.hic) - (~(put by fat.ruf) p.q.hic [-(hun hen)]:[*room .]) - == - =+ [bos=(sein:title p.q.hic) can=(clan:title p.q.hic)] - %- zing ^- (list (list move)) - :~ ?: =(bos p.q.hic) ~ - [hen %pass /init-merge %c %merg p.q.hic %base bos %kids da+now %init]~ - :: - ~ - == - :: - $into - =. hez.ruf `hen - :_ ..^$ - =+ bem=(~(get by mon.ruf) p.q.hic) - ?: &(?=($~ bem) !=(%$ p.q.hic)) - ~|([%bad-mount-point-from-unix p.q.hic] !!) - =+ ^- bem/beam - ?^ bem - u.bem - [[?>(?=(^ fat.ruf) p.n.fat.ruf) %base %ud 1] ~] - =+ rom=(~(get by fat.ruf) p.bem) - ?~ rom - ~ - =+ dos=(~(get by dos.u.rom) q.bem) - ?~ dos - ~ - ?: =(0 let.dom.u.dos) - =+ cos=(mode-to-soba ~ s.bem q.q.hic r.q.hic) - =+ ^- {one/(list {path miso}) two/(list {path miso})} - %+ skid cos - |= {a/path b/miso} - ?& ?=($ins -.b) - ?=($mime p.p.b) - ?=({$hoon $~} (slag (dec (lent a)) a)) - == - :~ [hen %pass /one %c %info p.bem q.bem %& one] - [hen %pass /two %c %info p.bem q.bem %& two] - == - =+ yak=(~(got by hut.ran.ruf) (~(got by hit.dom.u.dos) let.dom.u.dos)) - =+ cos=(mode-to-soba q.yak (flop s.bem) q.q.hic r.q.hic) - [hen %pass /both %c %info p.bem q.bem %& cos]~ - :: - $merg :: direct state up - ?: =(%$ q.q.hic) - [~ ..^$] - =^ mos ruf - =+ den=((de now hen ruf) [. .]:p.q.hic q.q.hic) - abet:abet:(start:(me:ze:den [r.q.hic s.q.hic] ~ &) t.q.hic u.q.hic) - [mos ..^$] - :: - $mont - =. hez.ruf ?^(hez.ruf hez.ruf `[[%$ %sync ~] ~]) - =+ pot=(~(get by mon.ruf) p.q.hic) - ?^ pot - ~& [%already-mounted pot] - [~ ..^$] - =. mon.ruf - (~(put by mon.ruf) p.q.hic [p.q.q.hic q.q.q.hic r.q.q.hic] s.q.q.hic) - =+ yar=(~(get by fat.ruf) p.q.q.hic) - ?~ yar - [~ ..^$] - =+ dos=(~(get by dos.u.yar) q.q.q.hic) - ?~ dos - [~ ..^$] - =^ mos ruf - =+ den=((de now hen ruf) [. .]:p.q.q.hic q.q.q.hic) - abet:(mont:den p.q.hic q.q.hic) - [mos ..^$] - :: - $dirk - ?~ hez.ruf - ~& %no-sync-duct - [~ ..^$] - ?. (~(has by mon.ruf) p.q.hic) - ~& [%not-mounted p.q.hic] - [~ ..^$] - :- ~[[u.hez.ruf %give %dirk p.q.hic]] - ..^$ - :: - $ogre - ?~ hez.ruf - ~& %no-sync-duct - [~ ..^$] - ?@ p.q.hic - ?. (~(has by mon.ruf) p.q.hic) - ~& [%not-mounted p.q.hic] - [~ ..^$] - :_ ..^$(mon.ruf (~(del by mon.ruf) p.q.hic)) - [u.hez.ruf %give %ogre p.q.hic]~ - :_ %_ ..^$ - mon.ruf - %- molt - %+ skip (~(tap by mon.ruf)) - (corl (cury test p.q.hic) tail) - == - %+ turn - (skim (~(tap by mon.ruf)) (corl (cury test p.q.hic) tail)) - |= {pot/term bem/beam} - [u.hez.ruf %give %ogre pot] - :: - $warp - =^ mos ruf - =+ den=((de now hen ruf) p.q.hic p.q.q.hic) - :: =- ~? ?=([~ %sing %w *] q.q.q.hic) - :: :* %someones-warping - :: rav=u.q.q.q.hic - :: mos=-< - :: == - :: - - =< abet - ?~ q.q.q.hic - cancel-request:den - (start-request:den u.q.q.q.hic) - [mos ..^$] - :: - $went - :: this won't happen until we send responses. - !! - :: - $west - ?: ?=({$question *} q.q.hic) - =+ ryf=((hard riff) r.q.hic) - :_ ..^$ - :~ [hen %give %mack ~] - :- hen - :^ %pass [(scot %p p.p.q.hic) (scot %p q.p.q.hic) t.q.q.hic] - %c - [%warp [p.p.q.hic p.p.q.hic] ryf] - == - ?> ?=({$answer @ @ $~} q.q.hic) - =+ syd=(slav %tas i.t.q.q.hic) - =+ inx=(slav %ud i.t.t.q.q.hic) - =^ mos ruf - =+ den=((de now hen ruf) p.q.hic syd) - abet:(take-foreign-update:den inx ((hard (unit rand)) r.q.hic)) - [[[hen %give %mack ~] mos] ..^$] - :: - $wegh - :_ ..^$ :_ ~ - :^ hen %give %mass - :- %clay - :- %| - :~ domestic+[%& fat.ruf] - foreign+[%& hoy.ruf] - :- %object-store :- %| - :~ commits+[%& hut.ran.ruf] - blobs+[%& lat.ran.ruf] - == - == - == -:: -:: All timers are handled by `%behn` nowadays. -++ doze - |= {now/@da hen/duct} - ^- (unit @da) - ~ -:: -++ load - => |% - ++ cult-0 (map duct rove) - ++ dojo-0 (cork dojo |=(a/dojo a(qyx *cult-0))) - ++ rede-0 (cork rede |=(a/rede a(qyx *cult-0))) - ++ room-0 (cork room |=(a/room a(dos (~(run by dos.a) dojo-0)))) - ++ rung-0 (cork rung |=(a/rung a(rus (~(run by rus.a) rede-0)))) - ++ raft-0 - %+ cork raft - |=(a/raft a(fat (~(run by fat.a) room-0), hoy (~(run by hoy.a) rung-0))) - ++ axle $%({$0 ruf/raft-0} {$1 ruf/raft}) - -- - |= old/axle - ^+ ..^$ - ?- -.old - $1 ..^$(ruf ruf.old) - $0 =/ cul - |= a/cult-0 ^- cult - %- ~(gas ju *cult) - (turn (~(tap by a)) |=({p/duct q/rove} [q p])) - =/ rom - =+ doj=|=(a/dojo-0 a(qyx (cul qyx.a))) - |=(a/room-0 a(dos (~(run by dos.a) doj))) - =/ run - =+ red=|=(a/rede-0 a(qyx (cul qyx.a))) - |=(a/rung-0 a(rus (~(run by rus.a) red))) - =+ r=ruf.old - $(old [%1 r(fat (~(run by fat.r) rom), hoy (~(run by hoy.r) run))]) - == -:: -++ scry :: inspect - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) - ?. ?=($& -.why) ~ - =* his p.why - :: ~& scry+[ren `path`[(scot %p his) syd ~(rent co lot) tyl]] - :: =- ~& %scry-done - - =+ got=(~(has by fat.ruf) his) - =+ luk=?.(?=($$ -.lot) ~ ((soft case) p.lot)) - ?~ luk [~ ~] - ?: =(%$ ren) - [~ ~] - =+ run=((soft care) ren) - ?~ run [~ ~] - =+ den=((de now [/scryduct ~] ruf) [. .]:his syd) - =+ (aver:den u.run u.luk tyl) - ?~ - - - ?~ u.- - - ?: ?=($& -.u.u.-) ``p.u.u.- - ~ -:: -++ stay [%1 ruf] -++ take :: accept response - |= {tea/wire hen/duct hin/(hypo sign)} - ^+ [p=*(list move) q=..^$] - ?: ?=({$merge @ @ @ @ @ $~} tea) - ?> ?=(?($writ $made) +<.q.hin) - =+ our=(slav %p i.t.tea) - =* syd i.t.t.tea - =+ her=(slav %p i.t.t.t.tea) - =* sud i.t.t.t.t.tea - =* sat i.t.t.t.t.t.tea - =+ dat=?-(+<.q.hin $writ [%& p.q.hin], $made [%| q.q.hin]) - =+ ^- kan/(unit dome) - %+ biff (~(get by fat.ruf) her) - |= room - %+ bind (~(get by dos) sud) - |= dojo - dom - =^ mos ruf - =+ den=((de now hen ruf) [. .]:our syd) - abet:abet:(route:(me:ze:den [her sud] kan |) sat dat) - [mos ..^$] - ?: ?=({$blab care @ @ *} tea) - ?> ?=($made +<.q.hin) - ?. ?=($& -.q.q.hin) - ~| %blab-fail - ~> %mean.|.(?+(-.q.q.hin -.q.q.hin $| p.q.q.hin)) - !! :: interpolate ford fail into stack trace - :_ ..^$ :_ ~ - :* hen %give %writ ~ - ^- {care case @tas} - [i.t.tea ((hard case) +>:(slay i.t.t.tea)) i.t.t.t.tea] - :: - `path`t.t.t.t.tea - `cage`p.q.q.hin - == - ?- -.+.q.hin - $crud - [[[hen %slip %d %flog +.q.hin] ~] ..^$] - :: - $made - ?~ tea !! - ?+ -.tea !! - $inserting - ?> ?=({@ @ @ $~} t.tea) - =+ our=(slav %p i.t.tea) - =+ syd=(slav %tas i.t.t.tea) - =+ wen=(slav %da i.t.t.t.tea) - =^ mos ruf - =+ den=((de now hen ruf) [. .]:our syd) - abet:(take-inserting:den wen q.q.hin) - [mos ..^$] - :: - $diffing - ?> ?=({@ @ @ $~} t.tea) - =+ our=(slav %p i.t.tea) - =+ syd=(slav %tas i.t.t.tea) - =+ wen=(slav %da i.t.t.t.tea) - =^ mos ruf - =+ den=((de now hen ruf) [. .]:our syd) - abet:(take-diffing:den wen q.q.hin) - [mos ..^$] - :: - $kthpifying - ?> ?=({@ @ @ $~} t.tea) - =+ our=(slav %p i.t.tea) - =+ syd=(slav %tas i.t.t.tea) - =+ wen=(slav %da i.t.t.t.tea) - =^ mos ruf - =+ den=((de now hen ruf) [. .]:our syd) - abet:(take-castify:den wen q.q.hin) - [mos ..^$] - :: - $mutating - ?> ?=({@ @ @ $~} t.tea) - =+ our=(slav %p i.t.tea) - =+ syd=(slav %tas i.t.t.tea) - =+ wen=(slav %da i.t.t.t.tea) - =^ mos ruf - =+ den=((de now hen ruf) [. .]:our syd) - abet:(take-mutating:den wen q.q.hin) - [mos ..^$] - :: - $patching - ?> ?=({@ @ $~} t.tea) - =+ our=(slav %p i.t.tea) - =+ syd=(slav %tas i.t.t.tea) - =^ mos ruf - =+ den=((de now hen ruf) [. .]:our syd) - abet:(take-patch:den q.q.hin) - [mos ..^$] - :: - $ergoing - ?> ?=({@ @ $~} t.tea) - =+ our=(slav %p i.t.tea) - =+ syd=(slav %tas i.t.t.tea) - =^ mos ruf - =+ den=((de now hen ruf) [. .]:our syd) - abet:(take-ergo:den q.q.hin) - [mos ..^$] - :: - $foreign-plops - ?> ?=({@ @ @ @ $~} t.tea) - =+ our=(slav %p i.t.tea) - =+ her=(slav %p i.t.t.tea) - =* syd i.t.t.t.tea - =+ lem=(slav %da i.t.t.t.t.tea) - =^ mos ruf - =+ den=((de now hen ruf) [our her] syd) - abet:(take-foreign-plops:den ?~(lem ~ `lem) q.q.hin) - [mos ..^$] - :: - $foreign-x - ?> ?=({@ @ @ @ @ *} t.tea) - =+ our=(slav %p i.t.tea) - =+ her=(slav %p i.t.t.tea) - =+ syd=(slav %tas i.t.t.t.tea) - =+ car=((hard care) i.t.t.t.t.tea) - =+ ^- cas/case - =+ (slay i.t.t.t.t.t.tea) - ?> ?=({$~ $$ case} -) - ->+ - =* pax t.t.t.t.t.t.tea - =^ mos ruf - =+ den=((de now hen ruf) [our her] syd) - abet:(take-foreign-x:den car cas pax q.q.hin) - [mos ..^$] - == - :: - $mere - ?: ?=($& -.p.+.q.hin) - ~& 'initial merge succeeded' - [~ ..^$] - ~> %slog. - :^ 0 %rose [" " "[" "]"] - :^ leaf+"initial merge failed" - leaf+"my most sincere apologies" - >p.p.p.+.q.hin< - q.p.p.+.q.hin - [~ ..^$] - :: - $note [[hen %give +.q.hin]~ ..^$] - $wake - ~| %why-wakey !! - :: =+ dal=(turn (~(tap by fat.ruf) ~) |=([a=@p b=room] a)) - :: =| mos=(list move) - :: |- ^- [p=(list move) q=_..^^$] - :: ?~ dal [mos ..^^$] - :: =+ une=(un i.dal now hen ruf) - :: =^ som une wake:une - :: $(dal t.dal, ruf abet:une, mos (weld som mos)) - :: - $writ - ?> ?=({@ @ *} tea) - ~| i=i.tea - ~| it=i.t.tea - =+ our=(slav %p i.tea) - =+ him=(slav %p i.t.tea) - :_ ..^$ - :~ :* hen %pass /writ-wont %a - %wont [our him] [%c %answer t.t.tea] - (bind p.+.q.hin rant-to-rand) - == - == - :: - $woot - [~ ..^$] - :: ?~ r.q.hin [~ ..^$] - :: ~& [%clay-lost p.q.hin r.q.hin tea] - :: [~ ..^$] - == -:: -++ rant-to-rand - |= rant - ^- rand - [p q [p q.q]:r] -:: -++ mode-to-soba - |= {hat/(map path lobe) pax/path all/? mod/mode} - ^- soba - %+ weld - ^- (list (pair path miso)) - ?. all - ~ - =+ mad=(malt mod) - =+ len=(lent pax) - =+ ^- descendants/(list path) - %+ turn - %+ skim (~(tap by hat)) - |= {paf/path lob/lobe} - =(pax (scag len paf)) - |= {paf/path lob/lobe} - (slag len paf) - %+ murn - descendants - |= pat/path - ^- (unit (pair path {$del $~})) - ?: (~(has by mad) pat) - ~ - `[(weld pax pat) %del ~] - ^- (list (pair path miso)) - %+ murn mod - |= {pat/path mim/(unit mime)} - ^- (unit (pair path miso)) - =+ paf=(weld pax pat) - ?~ mim - =+ (~(get by hat) paf) - ?~ - - ~& [%deleting-already-gone pax pat] - ~ - `[paf %del ~] - =+ (~(get by hat) paf) - ?~ - - `[paf %ins %mime -:!>(*mime) u.mim] - `[paf %mut %mime -:!>(*mime) u.mim] --- diff --git a/neo/van/dill.hoon b/neo/van/dill.hoon deleted file mode 100644 index f7a9431b9..000000000 --- a/neo/van/dill.hoon +++ /dev/null @@ -1,537 +0,0 @@ -!: -:: dill (4d), terminal handling -:: -|= pit/vase -=, dill -=> |% :: interface tiles -++ gill (pair ship term) :: general contact --- :: -=> |% :: console protocol -++ all-axle ?(old-axle axle) :: -++ old-axle :: all dill state - $: $2 :: - ore/(unit ship) :: identity once set - hey/(unit duct) :: default duct - dug/(map duct axon) :: conversations - == :: -++ axle :: - $: $3 :: - ore/(unit ship) :: identity once set - hey/(unit duct) :: default duct - dug/(map duct axon) :: conversations - $= hef :: other weights - $: a/(unit mass) :: - b/(unit mass) :: - c/(unit mass) :: - e/(unit mass) :: - f/(unit mass) :: - g/(unit mass) :: - == :: - == :: -++ axon :: dill per duct - $: ram/term :: console program - tem/(unit (list dill-belt)) :: pending, reverse - wid/_80 :: terminal width - pos/@ud :: cursor position - see/(list @c) :: current line - == :: --- => :: -|% :: protocol outward -++ mess :: - $% {$dill-belt p/(hypo dill-belt)} :: - == :: -++ move {p/duct q/(wind note gift:able)} :: local move -++ note-ames :: weird ames move - $% {$make p/(unit @t) q/@ud r/@ s/?} :: - {$sith p/@p q/@uw r/?} :: - == :: -++ note-clay :: - $% {$merg p/@p q/@tas r/@p s/@tas t/case u/germ:clay}:: merge desks - {$warp p/sock q/riff:clay} :: wait for clay hack - == :: -++ note-dill :: note to self, odd - $% {$crud p/@tas q/(list tank)} :: - {$heft $~} :: - {$init p/ship} :: - {$text p/tape} :: - {$veer p/@ta q/path r/@t} :: install vane - {$vega p/path} :: reboot by path - {$velo p/@t q/@t} :: reboot by path - {$verb $~} :: verbose mode - == :: -++ note-gall :: - $% {$conf dock $load ship desk} :: - {$deal p/sock q/cush:gall} :: - == :: -++ note :: out request $-> - $? {?($a $b $c $e $f $g) $wegh $~} :: - $% {$a note-ames} :: - {$c note-clay} :: - {$d note-dill} :: - {$g note-gall} :: - == == :: -++ sign-ames :: - $% {$nice $~} :: - {$init p/ship} :: - == :: -++ sign-clay :: - $% {$mere p/(each (set path) (pair term tang))} :: - {$note p/@tD q/tank} :: - {$writ p/riot:clay} :: - == :: -++ sign-dill :: - $% {$blit p/(list blit)} :: - == :: -++ sign-gall :: - $% {$onto p/(each suss:gall tang)} :: - {$unto p/cuft:gall} :: - == :: -++ sign :: in result $<- - $? {?($a $b $c $e $f $g) $mass p/mass} :: - $% {$a sign-ames} :: - {$c sign-clay} :: - {$d sign-dill} :: - {$g sign-gall} :: - == == :: -:::::::: :: dill tiles --- -=| all/axle -|= {now/@da eny/@ ski/sley} :: current invocation -=> |% - ++ as :: per cause - |_ $: {moz/(list move) hen/duct our/ship} - axon - == - ++ abet :: resolve - ^- {(list move) axle} - [(flop moz) all(dug (~(put by dug.all) hen +<+))] - :: - ++ call :: receive input - |= kyz/task:able - ^+ +> - ?+ -.kyz ~& [%strange-kiss -.kyz] +> - $flow +> - $harm +> - $hail (send %hey ~) - $belt (send `dill-belt`p.kyz) - $text (from %out (tuba p.kyz)) - $crud :: (send `dill-belt`[%cru p.kyz q.kyz]) - (crud p.kyz q.kyz) - $blew (send %rez p.p.kyz q.p.kyz) - $heft heft - $tick =+ ^= ges ^- gens:ames - :- %en - =+ can=(clan:title p.kyz) - ?- can - $czar [%czar ~] - $duke [%duke %anon ~] - $earl [%earl (scot %p p.kyz)] - $king [%king (scot %p p.kyz)] - $pawn [%pawn ~] - == - =+ yen=(scot %p (shax :(mix %ticket eny now))) - =+ ^= beg ^- {his/@p tic/@p yen/@t ges/gens:ames} - [p.kyz q.kyz yen ges] - =+ cmd=[%hood %poke `cage`[%helm-begin !>(beg)]] - %= +>.$ - moz - :_(moz [hen %pass ~ %g %deal [our our] cmd]) - == - $veer (dump kyz) - $vega (dump kyz) - $velo (dump kyz) - $verb (dump kyz) - == - :: - ++ crud - |= {err/@tas tac/(list tank)} - =+ ^= wol ^- wall - :- (trip err) - (zing (turn (flop tac) |=(a/tank (~(win re a) [0 wid])))) - |- ^+ +>.^$ - ?~ wol +>.^$ - $(wol t.wol, +>.^$ (from %out (tuba i.wol))) - :: - ++ dump :: pass down to hey - |= git/gift:able - ?> ?=(^ hey.all) - +>(moz [[u.hey.all %give git] moz]) - :: - ++ done :: return gift - |= git/gift:able - +>(moz :_(moz [hen %give git])) - :: - ++ from :: receive belt - |= bit/dill-blit - ^+ +> - ?: ?=($mor -.bit) - |- ^+ +>.^$ - ?~ p.bit +>.^$ - $(p.bit t.p.bit, +>.^$ ^$(bit i.p.bit)) - ?: ?=($out -.bit) - %+ done %blit - :~ [%lin p.bit] - [%mor ~] - [%lin see] - [%hop pos] - == - ?: ?=($klr -.bit) - %+ done %blit - :~ [%lin (cvrt:ansi p.bit)] - [%mor ~] - [%lin see] - [%hop pos] - == - ?: ?=($pro -.bit) - (done(see p.bit) %blit [[%lin p.bit] [%hop pos] ~]) - ?: ?=($pom -.bit) - =. see (cvrt:ansi p.bit) - (done %blit [[%lin see] [%hop pos] ~]) - ?: ?=($hop -.bit) - (done(pos p.bit) %blit [bit ~]) - ?: ?=($qit -.bit) - (dump %logo ~) - (done %blit [bit ~]) - :: - ++ ansi - |% - ++ cvrt :: stub to (list @c) - |= a/stub :: with ANSI codes - ^- (list @c) - %- zing %+ turn a - |= a/(pair stye (list @c)) - ^- (list @c) - ;: weld - ?: =(0 ~(wyt in p.p.a)) ~ - `(list @c)`(zing (turn (~(tap in p.p.a)) ef)) - (bg p.q.p.a) - (fg q.q.p.a) - q.a - ?~(p.p.a ~ (ef ~)) - (bg ~) - (fg ~) - == - :: - ++ ef |=(a/^deco (scap (deco a))) :: ANSI effect - :: - ++ fg |=(a/^tint (scap (tint a))) :: ANSI foreground - :: - ++ bg :: ANSI background - |= a/^tint - %- scap - =>((tint a) [+(p) q]) :: (add 10 fg) - :: - ++ scap :: ANSI escape seq - |= a/$^((pair @ @) @) - %- (list @c) - :+ 27 '[' :: "\033[{a}m" - ?@(a :~(a 'm') :~(p.a q.a 'm')) - :: - ++ deco :: ANSI effects - |= a/^deco ^- @ - ?- a - $~ '0' - $br '1' - $un '4' - $bl '5' - == - :: - ++ tint :: ANSI colors (fg) - |= a/^tint - ^- (pair @ @) - :- '3' - ?- a - $k '0' - $r '1' - $g '2' - $y '3' - $b '4' - $m '5' - $c '6' - $w '7' - $~ '9' - == - -- - :: - ++ heft - %_ . - moz - :* [hen %pass /heft/ames %a %wegh ~] - [hen %pass /heft/behn %b %wegh ~] - [hen %pass /heft/clay %c %wegh ~] - [hen %pass /heft/eyre %e %wegh ~] - [hen %pass /heft/ford %f %wegh ~] - [hen %pass /heft/gall %g %wegh ~] - moz - == - == - :: - ++ init :: initialize - ~& [%dill-init our ram] - =+ myt=(flop (need tem)) - =+ can=(clan:title our) - =. tem ~ - =. moz :_(moz [hen %pass / %c %merg our %home our %base da+now %init]) - =. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]]) - =. +> ?: ?=(?($czar $pawn) can) +> - (sync %base (sein:title our) %kids) - =. +> ?: ?=(?($czar $pawn) can) - (sync %home our %base) - (init-sync %home our %base) - =. +> ?. ?=(?($duke $king $czar) can) +> - (sync %kids our %base) - =. +> autoload - =. +> peer - |- ^+ +>+ - ?~ myt +>+ - $(myt t.myt, +>+ (send i.myt)) - :: - ++ into :: preinitialize - |= gyl/(list gill) - %_ +> - tem `(turn gyl |=(a/gill [%yow a])) - moz - :_ moz - :* hen - %pass - / - %c - [%warp [our our] %base `[%sing %y [%ud 1] /]] - == - == - :: - ++ send :: send action - |= bet/dill-belt - ?^ tem - +>(tem `[bet u.tem]) - %_ +> - moz - :_ moz - [hen %pass ~ %g %deal [our our] ram %poke [%dill-belt -:!>(bet) bet]] - == - ++ peer - %_ . - moz - :_(moz [hen %pass ~ %g %deal [our our] ram %peer /drum]) - == - :: - ++ sync - |= syn/{desk ship desk} - %_ +>.$ - moz - :_ moz - :* hen %pass /sync %g %deal [our our] - ram %poke %hood-sync -:!>(syn) syn - == - == - :: - ++ init-sync - |= syn/{desk ship desk} - %_ +>.$ - moz - :_ moz - :* hen %pass /init-sync %g %deal [our our] - ram %poke %hood-init-sync -:!>(syn) syn - == - == - :: - ++ autoload - %_ . - moz - :_ moz - :* hen %pass /autoload %g %deal [our our] - ram %poke %kiln-start-autoload [%atom %n `~] ~ - == - == - :: - ++ pump :: send diff ack - %_ . - moz - :_(moz [hen %pass ~ %g %deal [our our] ram %pump ~]) - == - :: - ++ take :: receive - |= sih/sign - ^+ +> - ?- sih - {?($a $b $c $e $f $g) $mass *} - (wegt -.sih p.sih) - :: - {$a $nice *} - :: ~& [%take-nice-ames sih] - +> - :: - {$a $init *} - +>(moz :_(moz [hen %give +.sih])) - :: - {$c $mere *} - ?: ?=($& -.p.sih) - +>.$ - (mean:error:userlib >%dill-mere-fail< >p.p.p.sih< q.p.p.sih) - :: - {$g $onto *} - :: ~& [%take-gall-onto +>.sih] - ?- -.+>.sih - $| (crud %onto p.p.+>.sih) - $& (done %blit [%lin (tuba "{}")]~) - == - :: - {$g $unto *} - :: ~& [%take-gall-unto +>.sih] - ?- -.+>.sih - $coup ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih)) - $quit peer - $reap ?~ p.p.+>.sih - +>.$ - (dump:(crud %reap u.p.p.+>.sih) %logo ~) - $diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih)) - $doff !! - == - :: - {$c $note *} - (from %out (tuba p.sih ' ' ~(ram re q.sih))) - :: - {$c $writ *} - init - :: - {$d $blit *} - (done +.sih) - == - :: - ++ wegh - ^- mass - :- %dill - :- %| - :~ all+[%& [ore hey dug]:all] - == - :: - ++ wegt - |= {lal/?($a $b $c $e $f $g) mas/mass} - ^+ +> - =. hef.all - ?- lal - $a ~?(?=(^ a.hef.all) %double-mass-a hef.all(a `mas)) - $b ~?(?=(^ b.hef.all) %double-mass-b hef.all(b `mas)) - $c ~?(?=(^ c.hef.all) %double-mass-c hef.all(c `mas)) - $e ~?(?=(^ e.hef.all) %double-mass-e hef.all(e `mas)) - $f ~?(?=(^ f.hef.all) %double-mass-f hef.all(f `mas)) - $g ~?(?=(^ g.hef.all) %double-mass-g hef.all(g `mas)) - == - ?. ?& ?=(^ a.hef.all) - ?=(^ b.hef.all) - ?=(^ c.hef.all) - ?=(^ e.hef.all) - ?=(^ f.hef.all) - ?=(^ g.hef.all) - == - +>.$ - %+ done(hef.all [~ ~ ~ ~ ~ ~]) - %mass - => [hef.all d=wegh] - [%vanes %| ~[u.a u.c d u.e u.f u.g u.b]] - -- - :: - ++ ax :: make ++as - |= {hen/duct kyz/task:able} :: - ?~ ore.all ~ - =+ nux=(~(get by dug.all) hen) - ?^ nux - (some ~(. as [~ hen u.ore.all] u.nux)) - ?. ?=($flow -.kyz) ~ - %- some - %. q.kyz - %~ into as - :- [~ hen u.ore.all] - :* p.kyz - [~ ~] - 80 - 0 - (tuba "") - == == - -- -|% :: poke+peek pattern -++ call :: handle request - |= $: hen/duct - hic/(hypo (hobo task:able)) - == - ^+ [p=*(list move) q=..^$] - => %= . :: XX temporary - q.hic - ^- task:able - ?: ?=($soft -.q.hic) - :: ~& [%dill-call-soft (@tas `*`-.p.q.hic)] - ((hard task:able) p.q.hic) - ?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic - ~& [%dill-call-flub (@tas `*`-.q.hic)] - ((hard task:able) q.hic) - == - ?: ?=($boot -.q.hic) - :_(..^$ [hen %pass ~ (note %a p.q.hic)]~) - ?: ?=($flog -.q.hic) - :: ~& [%dill-flog +.q.hic] - ?: ?=({$crud $hax-init {$leaf *} $~} p.q.hic) - =+ him=(slav %p (crip p.i.q.p.q.hic)) - :_(..^$ ?~(hey.all ~ [u.hey.all %give %init him]~)) - ?: ?=({$crud $hax-heft $~} p.q.hic) - :_(..^$ ?~(hey.all ~ [u.hey.all %slip %d %heft ~]~)) - :_(..^$ ?~(hey.all ~ [u.hey.all %slip %d p.q.hic]~)) - =. hey.all ?^(hey.all hey.all `hen) - ?: ?=($init -.q.hic) - :: ~& [%cnhp-init hen] - ?: =(ore.all `p.q.hic) - [[hen %give q.hic]~ ..^$] - =: ore.all `p.q.hic - dug.all ~ - == - =^ moz all abet:(need (ax (need hey.all) [%flow %hood ~])) - ?: |((lth p.q.hic 256) (gte p.q.hic (bex 64))) [moz ..^$] :: XX HORRIBLE - [:_(moz [(need hey.all) %give %init p.q.hic]) ..^$] - =+ nus=(ax hen q.hic) - ?~ nus - ~& [%dill-no-flow q.hic] - [~ ..^$] - =^ moz all abet:(call:u.nus q.hic) - [moz ..^$] -:: -++ doze - |= {now/@da hen/duct} - ^- (unit @da) - ~ -:: -++ load :: trivial - |= old/all-axle - ?: ?=($2 -.old) - $(old [%3 ore hey dug ~ ~ ~ ~ ~ ~]:old) - ..^$(all old) - :: |= old=* :: diable - :: ..^$(ore.all `~zod) -:: -++ scry - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) - ?. ?=($& -.why) ~ - =* his p.why - [~ ~] -:: -++ stay all -:: -++ take :: process move - |= {tea/wire hen/duct hin/(hypo sign)} - ^+ [p=*(list move) q=..^$] - ?: =(~ ore.all) - ?: ?=({$a $init *} q.hin) - :: ~& [%take-init hen] - =. hey.all ?^(hey.all hey.all `hen) - [[[hen %give +.q.hin] ~] ..^$] - :: [~ ..^$] - ~& [%take-back q.hin] - [~ ..^$] - ?. (~(has by dug.all) hen) - ~& [%take-weird-sign q.hin] - ~& [%take-weird-hen hen] - [~ ..^$] - =+ our=?>(?=(^ ore.all) u.ore.all) - =^ moz all - abet:(~(take as [~ hen our] (~(got by dug.all) hen)) q.hin) - [moz ..^$] --- diff --git a/neo/van/eyre.hoon b/neo/van/eyre.hoon deleted file mode 100644 index 5cc9ac28f..000000000 --- a/neo/van/eyre.hoon +++ /dev/null @@ -1,2188 +0,0 @@ -!: :: %eyre, http servant -!? 164 -:::: -|= pit/vase -=, eyre -=, wired -=, unity -=, format -=, mimes:html -=, html -=> =~ -|% :: interfaces -++ move {p/duct q/(wind note gift:able)} :: local move -++ note :: out request $-> - $% $: $a :: to %ames - $% {$wont p/sock q/{path *}} :: - == == :: - $: $b :: to %behn - $% {$wait p/@da} :: - {$rest p/@da} :: - == == :: - $: $d :: to %dill - $% {$flog p/{$crud p/@tas q/(list tank)}} :: - == == :: - $: $e :: to self - $% {$thud $~} :: proxied death - {$this p/? q/clip r/httq} :: proxied request - {$meta vase} :: type check - {$mini-jael-task *} :: XX types - == == :: - $: $f :: to %ford - $% {$exec p/@p q/(unit {beak silk:ford})} :: - {$wasp p/@p q/@uvH r/?} :: - == == :: - $: $g :: to %gall - $% {$deal p/sock q/cush:gall} :: full transmission - == == == :: -++ sign :: in result $<- - $? $: $a :: by %ames - $% {$woot p/ship q/path r/coop} :: acknowledgment - {$went ship cape:ames} :: XX ignore - == == :: - $: $b :: by %behn - $% {$wake $~} :: timer activate - == == :: - $: $g :: by %gall - $% {$unto p/cuft:gall} :: within agent - == == :: - $: $e :: by self - $% {$thou p/httr} :: response for proxy - {$mini-jael-gift *} :: XX types - == == :: - $: $f :: by %ford - $% {$made p/@uvH q/gage:ford} :: - {$news p/@uvH} :: - == == :: - $: @tas :: by any - $% {$crud p/@tas q/(list tank)} :: - == == == :: -++ mini-jael-task - $% {$save-cookie ses/hole own/?} - {$kill-cookie ses/hole} - {$save-token ses/hole tok/ixor} - {$live-token ses/hole tok/ixor} - == -++ mini-jael-gift - $% {$cookie-ack him/@p} - {$token-ack $~} - {$token-beat $~} - {$token-dead $~} - == -++ mini-jael-scry - $% {$pass him/ship pas/@t} :: ? - {$cook ses/hole} :: (unit ship) - {$ixor ses/hole tok/ixor} :: ? - == -++ ixor @t :: oryx hash -++ mend ?($get $head) :: amend after building -++ whir $@ $~ :: wire subset - $% {$ac p/whir-ac} :: finish request - {$at p/cord:beak q/whir-ac} :: build request - {$ay p/knot:ship q/knot:@uvH $~} :: remote duct - {$hi p/knot q/mark $~} :: outbound HTTP - {$se p/whir-se q/{user (list @t)}} :: outbound to domain - {$si $~} :: response done - {$le $~} :: stateless lens req - {$of p/ixor q/$@($~ whir-of)} :: associated view - {$ow p/ixor $~} :: dying view - {$on $~} :: dependency - {$je p/whir-je} - == -++ whir-je - $% {$ses p/hole $~} - {$ire p/hole q/ixor $~} - {$liv p/hole q/ixor $~} - == -++ whir-ac {p/?($$ hole) q/mend r/$@($~ {p/@t $~})} :: auth? filter cookie? -++ whir-of {p/knot:ship q/term s/wire} :: path in dock -++ whir-se ?($core vi-arm) :: build/call -++ vi-arm - $? $filter-request :: ++out mod request - $filter-response :: ++res use result - $receive-auth-response :: ++bak auth response - $receive-auth-query-string :: ++in handle code - $out - $res - $bak - $in - == :: --- :: -|% :: models -++ bolo :: eyre state - $: $7 :: version - hov/(unit ship) :: master for remote - top/beam :: ford serve prefix - ged/duct :: client interface - ded/(set duct) :: killed requests - lyv/(map duct live) :: living requests - pox/(map @uvH duct) :: proxied sessions - ask/{p/@ud q/(map @ud {p/duct q/hiss})} :: outgoing by number - kes/(map duct @ud) :: outgoing by duct - ney/@uvI :: rolling entropy - liz/(jug @uvH (each duct ixor)) :: ford depsets - wix/(map ixor stem) :: open views - sec/(map {user (list @t)} driv) :: security drivers - jel/mini-jael-state - == :: -:: -++ je-per-ship - $: cok/(map hole die/@da) - tok/(map oryx {hen/duct ses/hole die/@da liv/(unit @da)}) - == -++ mini-jael-state - $: primary/(map ship je-per-ship) - secondary/(map hole ship) - == -++ driv :: driver state - %+ pair (unit $@($~ vase)) :: main core - {liv/? req/(qeu (trel duct mark vase:hiss))} :: waiting requests -:: -++ live :: in flight - $% {$exec p/whir} :: ford build - {$wasp p/(list @uvH)} :: ford deps - {$xeno p/ship} :: proxied request - {$poll p/ixor} :: session state - == -:: -++ stem :: client view - $: him/ship :: user - pol/(unit duct) :: long-poll - sus/(set {dock $json wire path}) :: subscriptions - eve/{p/@u q/(map @u even)} :: queued events - med/(qeu duct) :: waiting /~/to/ - == -++ even :: client event - $% {$news p/@uvH} - {$quit p/{dock path}} - {$rush p/{dock path} q/json} - == -:: -++ perk :: parsed request - $% {$auth p/perk-auth} - {$away $~} - {$oath p/knot q/(list @t)} - {$bugs p/?($as $to) $~} - {$beam p/beam} - {$deps p/?($put $delt) q/@uvH} - {$mess p/{dock mark wire s/json}} - {$poll p/{i/@uvH t/(list @uvH)}} - {$spur p/spur} - {$subs p/?($put $delt) q/{dock $json wire path}} - {$view p/ixor q/{$~ u/@ud}} - == -:: -++ perk-auth :: parsed auth - $% {$at p/pork} :: inject auth - {$del p/(unit ship)} - {$get him/ship rem/pork} - {$js $~} - {$json $~} - {$try him/ship paz/(unit cord)} - == -:: -++ pest :: result - $@ $~ - $% {$$ p/httr} :: direct response - {$red $~} :: parent redirect - {$bake p/mend q/mark r/coin s/beam} :: ford request - {$js p/@t} :: script - {$json p/json} :: data - {$html p/manx} :: successful page - {$htme p/manx} :: authentication fail - == --- :: -|% -++ eat-headers - |= hed/(list {p/@t q/@t}) ^- math - %+ roll hed - |= {a/{p/cord q/cord} b/math} - =. p.a (crip (cass (trip p.a))) - (~(add ja b) p.a q.a) -:: -++ fcgi :: credential caboose - |= {quy/quay ced/cred} ^- coin - :+ %many - [%blob ced] - |- ^- (list coin) - ?~ quy [%$ %n ~]~ - [[%$ %t p.i.quy] [%$ %t q.i.quy] $(quy t.quy)] -:: -++ gsig |=({a/dock b/path} [(scot %p p.a) q.a b]) -++ session-from-cookies - |= {nam/@t maf/math} - ^- (unit hole) - (from-cookies maf |=({k/@t v/@} &(=(nam k) !=('~' v)))) -:: -++ ship-from-cookies - |= maf/math ^- (unit ship) - (biff (from-cookies maf |=({k/@ @} =(%ship k))) (slat %p)) -:: -++ from-cookies - |= {maf/math fil/$-({@t @t} ?)} - =+ `cot/(list @t)`(~(get ju maf) 'cookie') - =+ `cok/quay`(zing `(list quay)`(murn cot (curr rush cock:de-purl))) - |- ^- (unit cord) - ?~ cok ~ - ?:((fil i.cok) [~ q.i.cok] $(cok t.cok)) -:: -++ pack :: light path encoding - |= {a/term b/path} ^- knot - %+ rap 3 :- (wack a) - (turn b |=(c/knot (cat 3 '_' (wack c)))) -:: -++ puck :: light path decoding - =+ fel=(most cab (sear wick urt:ab)) - |=(a/knot `(unit {p/term q/path})`(rush a fel)) -:: -++ wush - |= {wid/@u tan/tang} - ^- wall - (zing (turn tan |=(a/tank (wash 0^wid a)))) -:: -:: -++ add-cookies - |= {cug/(list @t) hit/httr} ^- httr - ?~ cug hit - =+ cuh=(turn `(list @t)`cug |=(a/@t set-cookie+a)) - hit(q (weld cuh q.hit)) -:: -++ add-json :: inject window.urb - |= {urb/json jaz/cord} ^- cord - =- (cat 3 (crip -) jaz) - """ - var _urb = {(en-json urb)}; - window.urb = window.urb || \{}; for(k in _urb) window.urb[k] = _urb[k]; - - """ -:: -++ ares-to-json - |= err/ares ^- json - =- (pairs:enjs fail+s+typ mess+(tape:enjs mez) ~) - ^- {typ/term mez/tape} - ?~ err [%fail "Unknown Error"] - [p.u.err (of-wall (wush 160 q.u.err))] -:: -++ resp :: mimed response - |= {sas/@uG mit/mite rez/@} ^- httr - :: (weld (turn cug |=(a=@t ['set-cookie' a])) - [sas ~[content-type+(en-mite mit)] [~ (as-octs rez)]] -:: -++ add-links :: x-urbit:// urls - |= a/wall ^- marl - ?. [x-urbit-links=&] [;/((of-wall a))]~ :: default disable - |- ^- marl - ?~ a ~ - =^ pax i.a :: parse path if any - ^- {(unit path) tape} - =/ vex (fel:stab [1 1] i.a) - ?~ q.vex [~ i.a] - [`p q.q]:u.q.vex - ?~ pax [;/("{i.a}\0a") $(a t.a)] - :- ;a/"x-urbit:{(spud u.pax)}":"{(spud u.pax)}" - [;/("{i.a}\0a") $(a t.a)] -:: -++ render-tang :: tanks to manx - |= {dep/@uvH tan/tang} - ;html - ;head - ;link(rel "stylesheet", href "/lib/base.css"); - ;title: server error - == - ;body:div#c.err:pre:code:"*{(add-links (wush 80 tan))}" - ;script@"/~/on/{}.js"; - == -:: -++ favi :: XX favicon - 0w3.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~LX-.~~HW-.L~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.Rdjk~.VWuDL.-3wUf.~zEWe.~Yj4N.f~Y~f.P~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~-~LX.~~lBp.m~~nR.Zv~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.RZvn~.GqCF~.Qt7h~.Ya2wH.~0000.~M000.fY000. - 3~0w8.2~Qx8.if~eP.IX~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~fP.Y~QB9.ivY00.03~k5.1g~Z~.vT~~~.~~~~~.~~~~~.~~~~~.FWuD~. - CpCp~.P8OcL.Y0003.~0000.~M000.fY000.3~000.0~M00.0fY00.03~00.00~Nk.l5v-W.KHH~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~-QJ.bj~00. - 00~M0.00fY0.003~6.hAp~S.FGqL-.6xEr~.oC9y~.NUu7L.Y0003.~0000.~M000.fY000.3~000. - 0~M00.0fY00.03~00.00~M0.00fY0.003~0.000~N.sn5~~.fPY~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~Z7.hQvYr.6NL~0.000~M.000fY.0003~.0000~. - M000f.Y0003.~0000.~M000.fY000.3~000.0~M00.0fYJb.iT~sT.dP~Vu.nB~ZZ.vnT~a.iAF~M. - 000fY.0003~.0000~.VGqCL.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~Y.D9OvY.B9in~.0000~.M000f.Y0003.~0000.~M000.fY000.3~000.0~M41. - 0vZ1g.k7~Ha.OI~~n.RZv~~.~~~~~.~~~~~.~~~~~.HW-L~.jAVe~.M000f.YNcj7.~YLbO.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.-byUL. - ZzoSf.~3MYf.~M000.fY000.3~000.0~MQd.3vZik.Bb~Kb.yU~~P.Y~f~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~IXeP.~ezEW.~WGGG.L~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~pSt.D~DFW.u~Uu7.x~-tD. - pT~RZ.vn~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~IXe. - P~-LH.W~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~0000.00000.00000.00000.00000.50000.00002.000g0.00400.000w0.000a0.00000. - 00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000. - 00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000. - 00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000. - 00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000. - 00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000. - 00000.00000.3~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.Rdjk~.~bOYL.~~~~~.~~~~~.~~TZ~.v-ZLr.T~r6N.I~Rtn.l~-rC. - VL~-~.LX~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.ZLrS~.OMIbf.Z2gAb.~JHqS.~V-vD.~Y-fz. - X~000.0~M00.0fY00.03~00.00~S1.wof~U.-fz~~.~~~~~.~~~~~.~~~~~.~~~~~.~DV-v.ZDpSv. - ~0000.~M000.fY000.3~000.0~Qp6.hL-FG.qD~LX.-~~Qt.7h~Yw.823~Y.LbO~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~LX-.~WCFG.vZtnl.T~rmR.J~Yf3.M~~~~.~~~~~.~~~~~.~~~~J.XuT~N. - Yv7~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~. - ~~~~~.~~~~~.~0000.00000.00000.00000.00000.1g000.00002.000g0.00200.000g0.000a0. - 001kU.001gE.02000.g0082.00000.C0005.a00w0.04001.0g008.00g00 -++ js :: static javascript - |% - ++ poll :: dependency long-poll - ''' - urb.tries = 0 - urb.call = function() { - urb.wreq = new XMLHttpRequest() - urb.wreq.open('GET', "/~/on.json?"+urb.deps.join('&'), true) - urb.wreq.addEventListener('load', function() { - // if(~~(this.status / 100) == 4) - // return document.write(this.responseText) - if(this.status === 200) { - var dep = JSON.parse(this.responseText) - urb.onupdate(dep) - urb.dewasp(dep) - } - urb.keep() - }) - urb.wreq.addEventListener('error', urb.keep) - urb.wreq.addEventListener('abort', urb.keep) - urb.wreq.send() - } - urb.keep = function() { - setTimeout(urb.call,1000*urb.tries) - urb.tries++ - } - urb.onupdate = function(){document.location.reload()} - urb.call() - urb.wasp = function(deh){ - if (!deh) return; - if (urb.deps.indexOf(deh) !== -1) return; - urb.deps.push(deh) - urb.wreq.abort() // trigger keep - } - urb.dewasp = function(deh){ - var index = urb.deps.indexOf(deh) - if (-1 !== index) { - urb.deps.splice(index,1) - urb.wreq.abort() // trigger keep - } - } - - ''' - :: - ++ auth-redir - 'document.location.pathname = "/~~"+document.location.pathname' - :: - ++ auth - ''' - var req = function(url,dat,cb){ - var xhr = new XMLHttpRequest() - xhr.open('POST', url, true) - dat.oryx = urb.oryx - xhr.send(JSON.stringify(dat)) - xhr.addEventListener('load', function(ev){ - if(this.status !== 200) - return err.innerHTML = ":( " + Date.now() + "\n" + xhr.responseText - else if(cb) return cb(xhr.responseText,ev) - }) - } - - urb.foreign = /^\/~\/am/.test(window.location.pathname) - urb.redirTo = function(url){ - document.title = "Redirecting" - var mount = document.getElementById("pass") || document.body - mount.outerHTML = "Redirecting to "+url+"" - document.location = url - } - urb.redir = function(ship){ - var location = new URL(document.location) - location.pathname = location.pathname.replace(/^\/~~|\/~\/as\/any/,'/~/as/~'+ship) - urb.redirTo(location) - } - if(urb.foreign && urb.auth.indexOf(urb.ship) !== -1){ - req("/~/auth.json?PUT", - {ship:urb.ship,code:null}, - function(){urb.redir()}) - } - urb.is_me = function(ship) { - return (urb.ship === ship) - } - urb.submit = function(ship,pass){ - if(!urb.is_me(ship)) - return urb.redir(ship) - req( - "/~/auth.json?PUT", - {ship:ship, code:pass}, - function(){ - document.location.reload() - }) - } - urb.away = function(){req("/~/auth.json?DELETE", {}, - function(){document.body.innerHTML = "" } - )} - ''' - -- -++ xml - |% - ++ exit - ;html - ;head:title:"Accepted" - ;body:"You may now close this window." - == - :: - ++ redir - |= url/tape - ;html - ;head:title:"Redirecting..." - ;body - ;p: Redirecting to ;{a/"{url}" "{url}"} - ;script: setTimeout(function()\{document.location = {(en-json (tape:enjs url))}}, 3000) - == - == - :: - ++ login-page - %+ titl 'Sign in - Urbit' - ;= ;div.container.top - ;div.row - ;div.col-md-4 - ;h1.sign: Sign in - == - ;div.col-md-8 - ;p.ship - ;label.sig: ~ - ;input#ship.mono(contenteditable "", placeholder "your-urbit"); - == - ;input#pass.mono(type "password", placeholder "passcode"); - ;h2.advice: Type +{;code:("+code")} in your dojo for your passcode. - ;pre:code#err; - == - == - == - ;script@"/~/at/~/auth.js"; - ;script:''' - $(function() { - $ship = $('#ship') - $pass = $('#pass') - $ship.on('keydown', function(e) { - if(e.keyCode === 13 || e.keyCode === 9) { - if(!urb.is_me($ship.val().toLowerCase())) - urb.redir($ship.val().toLowerCase()) - $pass.show() - $pass.focus() - e.preventDefault() - } - }) - $ship.on('focus', function(e) { - $pass.hide() - }) - $pass.on('keydown', function(e) { - if(e.keyCode === 13) { - urb.submit($ship.val().toLowerCase(),$pass.val()) - } - }) - if(window.ship) { - $ship.val(urb.ship) - $pass.focus() - } else { - $pass.hide() - } - }) - ''' - == - :: - ++ logout-page - %+ titl 'Log out' - ;= ;div.container.top - ;div.row - ;div.col-md-10 - ;h1.sign: Bye! - ;button#act(onclick "urb.away()"): Log out - ;pre:code#err; - ;script@"/~/at/~/auth.js"; - == - == - == - == - :: - ++ poke-test - %+ titl 'Poke' - ;= ;button(onclick "urb.testPoke('/~/to/hood/helm-hi.json')"): Hi anonymous - ;button(onclick "urb.testPoke('/~/as/own/~/to/hood/helm-hi.json')"): Hi - ;pre:code#err; - ;script@"/~/at/~/auth.js"; - ;script:''' - show = function(t){err.innerText = ":) " + Date.now() + "\n" + t} - urb.testPoke = function(url){ - req(url,{wire:"/",xyro:'test'}, show) - } - ''' - == - ++ titl - |= {a/cord b/marl} - ;html - ;head - ;meta(charset "utf-8"); - ;meta(name "viewport", content "width=device-width, ". - "height=device-height, initial-scale=1.0, user-scalable=0, ". - "minimum-scale=1.0, maximum-scale=1.0"); - ;title:"{(trip a)}" - ;script(type "text/javascript", src "//cdnjs.cloudflare.com/ajax/". - "libs/jquery/2.1.1/jquery.min.js"); - ;link(rel "stylesheet", href "/===/web/lib/css/fonts.css"); - ;link(rel "stylesheet", href "/===/web/lib/css/bootstrap.css"); - == - ;body:"*{b}" - == - -- --- -|% :: functions -++ ye :: per event - =| $: $: hen/duct :: event floor - $: now/@da :: event date - eny/@ :: unique entropy - our/ship :: current ship - sky/$-({* *} (unit)) :: system namespace - == :: - mow/(list move) :: pending actions - == :: - bolo :: all vane state - == :: - =* bol -> - ~% %eyre-y ..ship ~ - |% - ++ abet :: resolve moves - ^- {(list move) bolo} - [(flop mow) bol] - :: - ++ adit .(ney (mix eny ney)) :: flip entropy - :: - ++ anon `@p`(add our ^~((bex 64))) :: pseudo-sub - :: - :: - ++ je - |= him/ship - =+ (fall (~(get by primary.jel) him) *je-per-ship) - |% - ++ abet +>.$(primary.jel (~(put by primary.jel) him +<.abet)) - ++ wake - |= wir/whir-je ^+ ..je - =< abet - ?- -.wir - $ses (kill-cookie p.wir) - $ire (kill-token q.wir) - $liv (beat-token q.wir) - == - :: - ++ apex - |= kyz/mini-jael-task ^+ ..je - =< abet - ?- -.kyz - $save-cookie (save-cookie ses.kyz) - $kill-cookie (kill-cookie ses.kyz) - $save-token (save-token ses.kyz tok.kyz) - $live-token (live-token ses.kyz tok.kyz) - == - :: - ++ save-cookie - |= ses/hole - ?< (~(has by secondary.jel) ses) - =. secondary.jel (~(put by secondary.jel) ses him) - =/ die (add now ~d7) - =. +>.$ (reset-timer je+ses+/[ses] ~ `die) - %_ +>.$ - cok (~(put by cok) ses die) - ..je (jael-give [%cookie-ack him]) - == - :: - ++ live-cookie - |= ses/hole - =/ ole (~(got by cok) ses) - =/ die (add now ~d7) - =. +>.$ (reset-timer je+ses+/[ses] `die.ole `die) - %_ +>.$ - cok (~(put by cok) ses die) - secondary.jel (~(put by secondary.jel) ses him) - == - :: - ++ kill-cookie - |= ses/hole :: XX actively kill tokens? - =/ ole (~(got by cok) ses) - =. +>.$ (reset-timer je+ses+/[ses] `die.ole ~) - %_ +>.$ - cok (~(del by cok) ses) - secondary.jel (~(del by secondary.jel) ses) - == - :: - ++ save-token - |= {ses/hole ire/ixor} - =/ die (add now ~d7) - =. +>.$ (reset-timer je+ire+/[ses]/[ire] ~ `die) - %_ +>.$ - tok (~(put by tok) ire [hen ses die ~]) - ..je (jael-give [%token-ack ~]) - == - :: - ++ live-token - |= {ses/hole ire/ixor} - =/ ole (~(got by tok) ire) - ?. (~(has by cok) ses) ~&(expired-session+ses +>.$) :: XX - ?> =(ses ses.ole) :: XX caught beforehand? - =. +>.$ (live-cookie ses) - =+ [liv=`(add ~s30 now) die=(add ~d1 now)] - =. +>.$ (reset-timer je+liv+/[ses]/[ire] liv.ole liv) - =. +>.$ (reset-timer je+ire+/[ses]/[ire] `die.ole `die) - %_ +>.$ - tok (~(put by tok) ire [hen ses die liv]) - == - :: - ++ kill-token - |= ire/ixor - =/ ole (~(got by tok) ire) - =. +>.$ (reset-timer je+liv+/[ses.ole]/[ire] liv.ole ~) - =. +>.$ (reset-timer je+ire+/[ses.ole]/[ire] `die.ole ~) - %_ +>.$ - tok (~(del by tok) ire) - ..je (jael-give(hen hen.ole) [%token-dead ~]) - == - :: - ++ beat-token - |= ire/ixor - =/ ole (~(got by tok) ire) - %_ +>.$ - tok (~(put by tok) ire ole(liv ~)) - ..je (jael-give(hen hen.ole) [%token-beat ~]) - == - :: - :: - ++ jael-give - |=(mini-jael-gift %_(..je mow :_(mow [hen %give %mini-jael-gift +<]))) - :: - ++ reset-timer - |= {wir/whir ole/(unit time) new/(unit time)} - =. mow ?~(ole mow :_(mow [`/ %pass wir [%b %rest u.ole]])) - =. mow ?~(new mow :_(mow [`/ %pass wir [%b %wait u.new]])) - +>.$ - -- - :: - ++ scry-jael - |= a/mini-jael-scry - ^- $%({$bean ?} {$u-ship (unit ship)}) - ?- -.a - $pass - :- %bean - ?> =(our him.a) :: only own password known - =(|2.a load-secret) - :: - $cook - :- %u-ship - (~(get by secondary.jel) ses.a) - :: - $ixor - :- %bean - =/ loc (~(got by primary.jel) (~(got by secondary.jel) ses.a)) - =(ses.a ses:(~(got by tok.loc) tok.a)) - == - :: - :: - ++ apex :: accept request - |= kyz/task:able - ^+ +> - =. our ?~(hov our u.hov) :: XX - =. p.top our :: XX necessary? - ?- -.kyz - $mini-jael-task - =/ kyz-je ;;(mini-jael-task +.kyz) - =; him (apex:(je him) kyz-je) - ?- -.kyz-je - $save-cookie - ?: own.kyz-je our - `@p`(mix anon (lsh 5 1 (rsh 5 1 (shaf %ship ses.kyz-je)))) - :: - $kill-cookie (~(got by secondary.jel) ses.kyz-je) - $save-token (~(got by secondary.jel) ses.kyz-je) - $live-token (~(got by secondary.jel) ses.kyz-je) - == - :: - $born +>.$(ged hen) :: register external - $serv - =< ~&([%serving (en-beam top)] .) - ?^(p.kyz +>.$(top p.kyz) +>.$(q.top p.kyz)) - :: - $crud - +>.$(mow [[hen %slip %d %flog kyz] mow]) - :: - $init :: register ownership - =. our ?~(hov p.kyz (min u.hov p.kyz)) - +>.$(hov [~ our], top [[our %home ud+0] /web]) - :: - ?($chis $this) :: inbound request - %- emule |. ^+ ..apex - =* sec p.kyz :: ? :: https bit - =* heq r.kyz :: httq :: request content - =+ ryp=`quri`(rash q.heq zest:de-purl) - =+ maf=(eat-headers r.heq) - =+ ^= pul ^- purl - ?- -.ryp - $& ?>(=(sec p.p.p.ryp) p.ryp) - $| =+ hot=(~(get ja maf) %host) - ?> ?=({@ $~} hot) - [[sec (rash i.hot thor:de-purl)] p.ryp q.ryp] - == - =. p.p.pul |(p.p.pul ?=(hoke r.p.pul)) - ?: ?=($chis -.kyz) :: IPC escape hatch - ~(as-lens handle pul [q.+.kyz |] [p.heq maf s.heq]) - =+ her=(host-to-ship r.p.pul) - ?: |(?=($~ her) =(our u.her)) - ~(apex handle pul [q.+.kyz |] [p.heq maf s.heq]) - =+ han=(sham hen) - =. pox (~(put by pox) han hen) - (ames-gram u.her [%get ~] han +.kyz) - :: - $them :: outbound request - ?~ p.kyz - =+ sud=(need (~(get by kes) hen)) - %= +>.$ - mow :_(mow [ged [%give %thus sud ~]]) - q.ask (~(del by q.ask) sud) - kes (~(del by kes) hen) - == - :: ~& eyre-them+(en-purl p.u.p.kyz) - %= +>.$ - mow :_(mow [ged [%give %thus p.ask p.kyz]]) - p.ask +(p.ask) - q.ask (~(put by q.ask) p.ask hen u.p.kyz) - kes (~(put by kes) hen p.ask) - == - :: - $hiss :: outbound cage - ::?~ p.kyz :: XX cancel - :: =+ sud=(need (~(get by kes) hen)) - :: %= +>.$ - :: mow :_(mow [ged [%give %thus sud ~]]) - :: q.ask (~(del by q.ask) sud) - :: kes (~(del by kes) hen) - :: == - :: ~& eyre-them+(en-purl p.u.p.kyz) - =+ usr=?~(p.kyz '~' (scot %ta u.p.kyz)) - (back hi+/[usr]/[q.kyz] %hiss r.kyz) - :: - $they :: inbound response - =+ kas=(need (~(get by q.ask) p.kyz)) - :: ~& > eyre-they+[p.q.kyz (en-purl p.q.kas)] - %= +>.$ - mow :_(mow [p.kas [%give %thou q.kyz]]) - q.ask (~(del by q.ask) p.kas) - == - :: - $thud :: cancel request - ?. (~(has by lyv) hen) - ~& dead-request+hen - +>.$(ded (~(put in ded) hen)) :: uncaught requests - =+ lid=(~(got by lyv) hen) - :: ~& did-thud+[-.lid hen] - ?- -.lid - $exec - (pass-note p.lid %f [%exec our ~]) - :: - $poll - ?. (~(has by wix) p.lid) - +>.$ - poll-dead:(ire-ix p.lid) - :: - $xeno - =+ han=(sham hen) - =. pox (~(del by pox) han hen) - (ames-gram p.lid [%gib ~] han) - :: - $wasp - |- ^+ +>.^$ - ?~ p.lid +>.^$ - (del-deps:$(p.lid t.p.lid) i.p.lid %& hen) - == - :: - $went - :: this won't happen until we send responses. - !! - :: - $west :: remote request - =. mow :_(mow [hen %give %mack ~]) - =+ mez=((soft gram) q.kyz) - ?~ mez - ~& e+[%strange-west p.kyz] - ~|(%strange-west !!) - ?- -<.u.mez - $gib (pass-note ay+(dray p+uv+~ q.p.kyz p.u.mez) [%e %thud ~]) - $get (pass-note ay+(dray p+uv+~ q.p.kyz p.u.mez) [%e %this q.u.mez]) - $got - ?. (~(has by pox) p.u.mez) - ~& lost-gram-thou+p.kyz^p.u.mez - +>.$ - =: hen (~(got by pox) p.u.mez) - pox (~(del by pox) p.u.mez) - == - (give-thou q.u.mez) - == - :: - $wegh !! :: handled elsewhere - == - :: - ::++ axom :: old response - :: |= [tee=whir hon=honk] - :: ^+ +> - :: ?+ tee !! - :: ~ ?-(-.hon %nice (nice-json), %mean (mean-json 500 p.hon)) - :: [%of @ ^] (get-ack:(ire-ix p.tee) q.tee hon) - :: == - ++ axon :: accept response - |= {tee/whir sih/sign} - ^+ +> - =. our ?~(hov our u.hov) :: XX - ?: &(?=({?($of $ow) ^} tee) !(~(has by wix) p.tee)) - ~&(dead-ire+[`whir`tee ({term term $~} +.sih)] +>) - ?- &2.sih - $mini-jael-gift - =/ gif ;;(mini-jael-gift |2.sih) - ?: ?=($cookie-ack -.gif) - :: XX probably should wait for this instead of pulling ship out via scry - +>.$ - ?> ?=({$of @ $~} tee) - (get-jael:(ire-ix p.tee) gif) - :: - $crud +>.$(mow [[hen %slip %d %flog +.sih] mow]) - :: $dumb - :: =. +> ?+(tee +> [%of ^] pop-duct:(ire-ix p.tee)) - :: (emule |.(~|(gall-dumb+tee !!))) - :: - $woot +>.$ - $went - :: XX eyre sends no wests, so should get no wents - ::~& e+unexpected+sih - +>.$ - :: - :: - $thou - ?+ -.tee !! - $ay (ames-gram (slav %p p.tee) got+~ (slav %uv q.tee) |2.sih) - $hi (cast-thou q.tee httr+!>(p.sih)) - $se (get-thou:(dom-vi q.tee) p.tee p.sih) - == - :: - $unto :: app response - ?> ?=($%({$le $~} {$of @ ^}) tee) - =+ cuf=`cuft:gall`+>.sih - ?- -.cuf - ?($coup $reap) - =/ ack ?~(p.cuf ~ `[-.cuf u.p.cuf]) - ?: ?=($le -.tee) (~(get-ack lens ~) ack) - (get-ack:(ire-ix p.tee) q.tee ack) - :: - $doff !! - $diff - ?. ?=($json p.p.cuf) - :: ~> %slog.`%*(. >[%backing p.p.cuf %q-p-cuf]< &3.+> (sell q.p.cuf)) - (back tee %json p.cuf) - =/ jon ((hard json) q.q.p.cuf) - ?: ?=($le -.tee) (~(get-diff lens ~) jon) - (get-rush:(ire-ix p.tee) q.tee jon) - :: - $quit - ~& quit+tee - ?: ?=($le -.tee) ~(get-quit lens ~) - (get-quit:(ire-ix p.tee) q.tee) - == - :: - $wake - ?> ?=($je -.tee) - %.(p.tee wake:(je (~(got by secondary.jel) p.p.tee))) - :: - $news :: dependency updated - ?: ?=({$se *} tee) - (get-news:(dom-vi q.tee) p.sih) - ?. ?=({$on $~} tee) - ~&(e+lost+[tee hen] +>.$) - %+ roll (~(tap in (~(get ju liz) p.sih))) - =< .(con ..axon(liz (~(del by liz) p.sih))) - |= {sus/(each duct ixor) con/_..axon} - =. ..axon con - ?- -.sus - $& (give-json(hen p.sus) 200 ~ %s (scot %uv p.sih)) - $| (get-even:(ire-ix p.sus) +.sih) - == - :: - $made - ?< ?=($tabl -.q.sih) - =. our (need hov) :: XX - ?- tee - $@($~ {?($on $ay $ow $je) *}) ~|(e+ford+lost+tee !!) - {$of @ $~} ~|(e+ford+lost+tee !!) - {$si $~} (give-sigh q.sih) - {$se ^} (get-made:(dom-vi q.tee) p.tee [p q]:sih) - {$hi ^} - ?: ?=($| -.q.sih) - (give-sigh q.sih) :: XX crash? - =* cay p.q.sih - ?> ?=($hiss p.cay) - ?: =('~' p.tee) - (eyre-them tee q.cay) - =+ usr=(slav %ta p.tee) - =+ ((hard {pul/purl ^}) q.q.cay) - ?. ?=($& -.r.p.pul) - ~& [%auth-lost usr (head:en-purl p.pul)] - (eyre-them tee q.cay) - (get-req:(dom-vi usr (scag 2 p.r.p.pul)) q.tee q.cay) - :: -:: {$hi ^} -:: ?: ?=($| -.q.sih) -:: (give-sigh q.sih) :: XX crash? -:: =* cay p.q.sih -:: ?> ?=($hiss p.cay) -:: (eyre-them p.tee q.cay) - :: - {$le $~} - ?: ?=($| -.q.sih) - ((slog:error:userlib p.q.sih) +>.$) :: XX get-ack (some)? - %- ~(get-diff lens ~) - ?> ?=($json p.p.q.sih) :: XX others - ((hard json) q.q.p.q.sih) - :: - {$of @ ^} - ?: ?=($| -.q.sih) - ((slog:error:userlib p.q.sih) +>.$) :: XX get-even %mean - %+ get-rush:(ire-ix p.tee) q.tee - ?> ?=($json p.p.q.sih) :: XX others - ((hard json) q.q.p.q.sih) - :: - {$at ^} - %- emule |. ^+ ..apex - ?. ?=($& -.q.sih) - (fail 404 p.sih p.q.sih) - =^ cay ..ya :: inject stat-json - =* cay p.q.sih - ?~ p.q.tee [cay ..ya] - (add-auth p.q.tee cay) :: XX block on session save? - ?: ?=($red-quri p.cay) - =+ url=(apex:en-purl ((hard quri) q.q.cay)) - (give-thou 307 [location+(crip url)]~ ~) - :: (give-html:abet 200 ~ (redir:xml url)) - ?. ?=($mime p.cay) - =+ bek=(norm-beak -:(need (de-beam (need (puck p.tee))))) - (exec-live ac+q.tee bek [%flag [p.sih `~] %kthp %mime [%$ cay]]) - (give-mime q.tee p.sih cay) - :: - {$ac ^} - %- emule |. ^+ ..apex - ?. ?=($& -.q.sih) - (fail 404 p.sih p.q.sih) - =* cay p.q.sih - ?> ?=($mime p.cay) - (give-mime p.tee p.sih cay) - == - == - :: - ++ give-mime - |= {{ses/?($~ hole) men/mend dom/?($~ {p/@t $~})} dep/@uvH cay/cage} - ^+ +>.$ - ?> ?=($mime -.cay) - ~| q.q.cay - =+ cug=?~(dom ~ ?~(ses !! [(set-cookie p.dom cookie-prefix ses)]~)) - =+ ((hard {mit/mite rez/octs}) q.q.cay) - =+ dep=(crip "W/{(en-json %s (scot %uv dep))}") - =+ bod=?-(men $get `rez, $head ~) - =+ hit=[200 ~[etag+dep content-type+(en-mite mit)] bod] - (give-thou (add-cookies cug hit)) - :: - ++ add-auth - |= {ses/hole cay/cage} ^- {cage _..ya} - ?. ?=($js -.cay) - ~& e+at-lost+-.cay - [cay ..ya] - ?> ?=(@ q.q.cay) - =^ jon ..ya ~(stat-json ya ses) - [cay(q.q (add-json jon q.q.cay)) ..ya] - :: - ++ norm-beak |=(bek/beak ?+(r.bek bek {$ud $0} bek(r da+now))) - ++ emule - |= a/_|?(..emule) ^+ ..emule - ?: [unsafe=|] - (a) - =+ mul=(mule a) - ?~ -.mul p.mul - (fail 500 0v0 >%exit< p.mul) - :: - ++ ire-ix |=(ire/ixor ~(. ix ire (~(got by wix) ire))) - ++ dom-vi - |= {usr/knot dom/path} ^+ vi :: XX default to initialized user? - ~(. vi [usr dom] (fall (~(get by sec) usr dom) *driv)) - :: - ++ our-host `hart`[& ~ %& /org/urbit/(rsh 3 1 (scot %p our))] - :: [| [~ 8.443] `/localhost] :: XX testing - :: - ++ eyre-them - |= {tea/whir vax/vase} - (pass-note tea [%e %meta :(slop !>(%them) !>(~) vax)]) - :: - ++ ames-gram - |=({him/ship gam/gram} (pass-note ~ %a %wont [our him] [%e -.gam] +.gam)) - :: - ++ jael-note - |=({tea/whir kyz/mini-jael-task} (pass-note tea %e %mini-jael-task kyz)) - :: - ++ back :: %ford bounce - |= {tea/whir mar/mark cay/cage} - (execute tea (norm-beak -.top) [%kthp mar $+cay]) - :: - ++ cast-thou - |= {mar/mark cay/cage} - ?: ?=($httr mar) (give-sigh %& cay) - %^ execute si+~ (norm-beak -.top) - [%alts [%kthp mar $+cay] [%kthp %recoverable-error $+cay] ~] - :: - ++ del-deps - |= {a/@uvH b/(each duct ixor)} ^+ +>.$ - ?: =(`@`0 a) +>.$ - =. liz (~(del ju liz) a b) - :: ~& del-deps+[a (~(get ju liz) a)] - ?: (~(has by liz) a) +>.$ - =- -(hen hen.+) - (pass-note(hen `~) on+~ %f [%wasp our a |]) - :: - ++ new-deps - |= {a/@uvH b/(each duct ixor)} ^+ +>.$ - :: ~& new-deps+[a b] - ?: =(`@`~ a) +>.$ - =+ had=(~(has by liz) a) - =. liz (~(put ju liz) a b) - ?: had +>.$ - =- -(hen hen.+) - (pass-note(hen `~) on+~ %f [%wasp our a &]) - :: - ++ ford-req |=({bek/beak kas/silk:ford} [%f [%exec our `[bek kas]]]) - ++ exec-live - |= {tea/whir req/{beak silk:ford}} - =. lyv (~(put by lyv) hen [%exec tea]) - (execute tea req) - :: - ++ execute - |= {tea/whir bek/beak sil/silk:ford} - %+ pass-note tea - :^ %f %exec our - `[bek [%dude |.(leaf+"eyre: execute {}") sil]] - :: - ++ fail - |= {sas/@ud dep/@uvH mez/tang} - ^+ +> - :: (back ha+~ dep %tang !>(mez)) ::tang->urb chain may be source of failure - (give-html sas ~ (render-tang dep mez)) - :: - ++ give-html - |= {sas/@ud cug/(list @t) max/manx} - %- give-thou - %+ add-cookies cug - (resp sas text+/html (crip (en-xml max))) - :: - ++ give-json - |= {sas/@uG cug/(list @t) jon/json} - %- give-thou - %+ add-cookies cug - (resp sas application+/json (crip (en-json jon))) - :: - ++ give-thou :: done request - |= hit/httr - ?: (~(has in ded) hen) :: request closed - +>(ded (~(del in ded) hen)) - =. lyv (~(del by lyv) hen) - +>(mow :_(mow [hen %give %thou hit])) - :: - ++ give-sigh :: userspace done - |= res/(each cage tang) - =- +>.$(mow :_(mow [hen %give %sigh `cage`-])) - ?. ?=($| -.res) p.res - [%tang !>(p.res)] - :: - ++ mean-json |=({sas/@uG err/ares} (give-json sas ~ (ares-to-json err))) - ++ nice-json |=(* (give-json 200 ~ (frond:enjs %ok %b &))) - :: - ++ pass-note |=(noe/{whir note} %_(+> mow :_(mow [hen %pass noe]))) - ++ host-to-ship :: host to ship - |= hot/host - ^- (unit ship) - :: =+ gow=(~(get by dop) hot) :: XX trust - :: ?^ gow gow - ?. ?=($& -.hot) ~ - =+ dom=(flop p.hot) :: domain name - ?~ dom ~ - (rush i.dom fed:ag) - :: - ++ load-secret - ^- @ta - =+ pax=/(scot %p our)/code/(scot %da now)/(scot %p our) - %^ rsh 3 1 - (scot %p (@ (need (sky [151 %noun] %a pax)))) - :: - ++ cookie-prefix (rsh 3 1 (scot %p our)) - ++ set-cookie - |= {domain/@t key/@t val/@t} - %+ rap 3 :~ - key '=' val - :: '; HttpOnly' ?.(sec '' '; Secure') :: XX security - domain - '; Path=/; HttpOnly' - == - :: - :: - ++ handle - ~% %eyre-h ..ship ~ - |_ $: {hat/hart pok/pork quy/quay} :: purl parsed url - {cip/clip aut/?} :: client ip nonymous? - {mef/meth maf/math bod/(unit octs)} :: method+headers+body - == - ++ abet ..handle - ++ done . - ++ teba |*(a/$-(* ..handle) |*(b/* %_(done ..handle (a b)))) - ++ del-deps (teba ^del-deps) - ++ new-deps (teba ^new-deps) - ++ exec-live (teba ^exec-live) - ++ give-html (teba ^give-html) - ++ give-thou (teba ^give-thou) - ++ give-json (teba ^give-json) - ++ nice-json (teba ^nice-json) - ++ pass-note (teba ^pass-note) - :: - ++ fcgi-cred - ^- cred - =/ him - ?. aut anon - (need get-user:for-client) - %* . *cred - hut hat - orx 'not-yet-implemented' - acl - =+ lag=(~(get by maf) %accept-language) - ?~(lag ~ ?~(u.lag ~ [~ i.u.lag])) - :: - :: cip cip :: XX performance - aut (~(put ju ^+(aut:*cred ~)) %$ (scot %p him)) - == - :: - ++ apex - =< abet - ^+ done - =+ oar=(host-to-ship r.hat) - =. our ?~(oar our u.oar) :: XX - =+ pez=process - ?: ?=($| -.pez) p.pez - (resolve ~ p.pez) - :: - ++ as-lens - =< abet - :: (process-parsed [%mess [our %dojo] %lens-command /lens grab-json]) - ((teba ~(new lens ~)) grab-json) - :: - ++ resolve - |= {cug/(list @t) pez/pest} ^+ done - ?~ pez done - ?- -.pez - $~ (give-thou (add-cookies cug p.pez)) - $js $(pez [%$ (resp 200 text+/javascript p.pez)]) - $json (give-json 200 cug p.pez) - $html (give-html 200 cug p.pez) - $htme (give-html 401 cug p.pez) - $bake (resolve-bake ~ ~ +.pez) - :: - $red - =+ url=(en-purl hat pok(p [~ %html]) quy) - ?+ p.pok ~|(bad-redirect+[p.pok url] !!) - {$~ $js} - $(pez [%js auth-redir:js]) - {$~ $json} - =/ red - (pairs:enjs ok+b+| red+(tape:enjs url) ~) - $(pez [%json red]) - == - == - :: - ++ resolve-bake - |= {ses/(unit hole) dom/(unit @t) men/mend mar/mark arg/coin bem/beam} - =+ wir=[%at (pack [- +]:(en-beam -.bem ~)) (fall ses %$) men ?~(dom ~ [u.dom]~)] - =. -.bem (norm-beak -.bem) - =+ req=[%bake mar arg bem] - =+ red=[%bake %red-quri arg bem] - (exec-live wir -.bem `silk:ford`[%alts ~[req red]]) - :: - :: - ++ is-anon =([~ ''] (~(get by (molt quy)) 'anon')) - ++ check-oryx :: | if json with bad oryx - ^- ? - ?. &(?=({$~ $json} p.pok) ?=($post mef) ?=(^ bod) !is-anon) & - =+ oxe=grab-oryx - ?~ oxe | - =/ ses (session-from-cookies cookie-prefix maf) - ?~ ses ~&(%oryx-no-cookie &) :: XX security - ?~ ~(get-user ya u.ses) ~&(%oryx-bad-cookie |) - =/ ire (oryx-to-ixor u.oxe) - ?~ (~(get by wix) ire) ~&(bad-oryx+u.oxe &) :: XX security? - =+ (scry-jael %ixor u.ses ire) - ?> ?=($bean -<) - ?. -> - ~&(oryx-ses-mismatch+[orx=u.oxe u.ses] &) :: XX security - & - :: - ++ grab-json - ^- json - ?. ?=(?($post $put $delt) mef) - ~|(bad-method+mef !!) - ?~ bod - ~|(%no-body !!) - (need (de-json q.u.bod)) - :: - ++ grab-json-soft - ^- (unit json) - ?. ?=(?($post $put $delt) mef) - ~ - ?~(bod ~ (de-json q.u.bod)) - :: - ++ grab-oryx - ^- (unit oryx) - =+ oxe=(biff grab-json-soft =>(dejs-soft (ot oryx+so ~))) - ?^ oxe oxe - (~(get by (molt quy)) %oryx) - :: - :: - ++ parse - ^- (each perk httr) - |^ =+ hit=as-magic-filename - ?^ hit [%| u.hit] - =+ hem=as-aux-request - ?^ hem - ?. check-oryx - ~|(%bad-oryx ~|([grab-oryx ses:for-client] !!)) - [%& u.hem] - =+ bem=as-beam - ?^ bem [%& %beam u.bem] - ?: is-spur - [%& %spur (flop q.pok)] - ~|(strange-path+q.pok !!) - :: - ++ as-magic-filename - ^- (unit httr) - ?+ [(fall p.pok %$) q.pok] ~ - {?($ico $png) $favicon $~} - :- ~ - %^ resp 200 image+/png - favi - :: - {$txt $robots $~} - :- ~ - %^ resp 200 text+/plain - %- of-wain:format - :~ 'User-agent: *' - 'Disallow: ' - == - == - :: - ++ is-spur |(?~(q.pok & ((sane %ta) i.q.pok))) - ++ as-beam :: /~sipnym/desk/3/... - ^- (unit beam) - =+ =< tyk=(drop-list (turn q.pok .)) :: a path whose elements - |=(a/knot `(unit tyke)`(rush a gasp:vast)) :: are in /=foo==/=bar - ?~ tyk ~ :: syntax - =+ %- posh:(vang & (en-beam top)) :: that the base path - [[~ (zing u.tyk)] ~] :: can interpolate into - ?~ - ~ :: - =+ (plex:vast %clsg u) :: staticly, and make a - (biff - de-beam) :: valid beam - :: - ++ as-aux-request :: /~/... req parser - ^- (unit perk) - =. mef - ?. ?=($post mef) mef - ?+ (skim quy |=({a/@t b/@t} &(=('' b) =(a (crip (cuss (trip a))))))) - ~|(bad-quy+[req='"?PUT" or "?DELETE"' quy] !!) - $~ mef - {{$'DELETE' $~} $~} %delt - {{$'PUT' $~} $~} %put - == - |- - ?: ?=({$'~~' *} q.pok) :: auth shortcuts - $(q.pok ['~' %as %own t.q.pok]) - ?. ?=({$'~' @ *} q.pok) ~ - :- ~ ^- perk - =* pef i.t.q.pok - =+ but=t.t.q.pok :: XX =* - ?+ pef ~|(pfix-lost+`path`/~/[pef] !!) - $debug ((hard perk) [%bugs but]) - $away [%away ~] - $ac - ?~ but ~|(no-host+`path`/~/[pef] !!) - =+ `dom/host`~|(bad-host+i.but (rash i.but thos:de-purl)) - ?: ?=($| -.dom) ~|(auth-ip+dom !!) - =- [%oath - p.dom] - ~| bad-user+`path`t.but - ?> ?=({@ $in $~} t.but) - =+ in-quy=(rush i.t.but ;~(pfix cab fque:de-purl)) - ?~ in-quy - (slav %ta i.t.but) - =+ src=~|(no+u.in-quy (~(got by (malt quy)) u.in-quy)) - p:(need (puck src)) :: allow state=usr_other-data - :: - $at [%auth %at pok(q but)] - $as - :+ %auth %get - ~| bad-ship+?~(but ~ i.but) - ?~ but !! - :_ pok(q t.but) - ?+ i.but (slav %p i.but) - $anon anon - $own (fall (ship-from-cookies maf) our) - == - :: - $on - :- %poll - ?^ but [(raid but %uv ~)]~ - =+ dep=((hard (list {@ $~})) quy) - =< ?~(. !! .) - (turn dep |=({a/@tas $~} (slav %uv a))) - :: - $of - :+ %view ?>(?=({@ $~} but) i.but) - ?> ?=({{$poll @} $~} quy) :: XX eventsource - [~ (rash q.i.quy dem)] - :: - $to - =+ ^- dir/{p/ship q/term r/mark} - ~| bad-mess+but - ?+ but !! - {@ @ $~} [our (raid but %tas %tas ~)] - {@ @ @ $~} (raid but %p %tas %tas ~) - == - =; x/{wir/wire mez/json} - [%mess [p q]:dir r.dir wir.x mez.x] - =+ wir=(~(get by (molt quy)) 'wire') - ?^ wir [(stab u.wir) grab-json] :: XX distinguish - %.(grab-json =>(dejs (ot wire+(cu stab so) xyro+same ~))) - :: - $in - ~| expect+[%post 'application+json' /'@uv' '?PUT/DELETE'] - ?> &(?=(?($delt $put) mef) ?=($@($~ {$~ $json}) p.pok)) - [%deps mef (raid but %uv ~)] - :: - $is - ?~ but - ~|(no-app+but=but !!) - |- ^- perk - ?~ p.pok $(p.pok [~ %json]) - ?. ?=($json u.p.pok) - ~|(is+stub+u.p.pok !!) :: XX marks - ?: ((sane %tas) i.but) - $(but [(scot %p our) but]) - ?> ?=(?($delt $put) mef) - =+ :- hap=[(slav %p i.but) (slav %tas -.t.but)] - wir=%.(grab-json =>(dejs (ot wire+(cu stab so) ~))) - [%subs mef hap u.p.pok wir +.t.but] - :: - $auth - :- %auth - |- ^- perk-auth - ?+ p.pok !! - $~ $(p.pok [~ %json]) - {$~ $js} [%js ~] - {$~ $json} - ?+ mef ~|(bad-meth+mef !!) - $get [%json ~] - $put - ~| parsing+bod - :- %try - %.(grab-json =>(dejs (ot ship+(su fed:ag) code+(mu so) ~))) - :: - $delt - ~| parsing+bod - :- %del - %.(grab-json =>(dejs-soft (ot ship+(su fed:ag)))) - == == - == - -- - :: - :: process-payload handles the translation of a payload for post. - :: currently this involves treating the payload as a urlencoded - :: request. In the future it's possible the payload could be - :: a specific mark instead. - :: - ++ process-payload - ^- {quay meth} - ?+ mef [quy mef] - $post [`quay`(weld quy `quay`(rash q:(need bod) yquy:de-purl)) %get] - == - ++ process - ^- (each pest _done) - =+ pet=parse - ?: ?=($| -.pet) - [%& %$ p.pet] - (process-parsed p.pet) - :: - ++ process-parsed - |= hem/perk ^- (each pest _done) - ?- -.hem - $auth (process-auth p.hem) - $away [%& %html logout-page:xml] - ?($beam $spur) - =^ payload mef process-payload - =+ ext=(fall p.pok %urb) - =+ bem=?-(-.hem $beam p.hem, $spur [-.top (weld p.hem s.top)]) - ~| bad-beam+q.bem - ?< =([~ 0] (sky [151 %noun] %cw (en-beam bem(+ ~, r [%da now])))) - =+ men=?+(mef !! $get mef, $head mef) :: redact result - =+ arg=(fcgi payload fcgi-cred) - =+ [%bake men ext arg bem] - ?.(aut [%& `pest`-] [%| `_done`(resolve ~ -)]) - :: - $bugs - ?- p.hem - $as show-login-page - $to [%& %html poke-test:xml] - == - :: - $deps - =+ ire=need-ixor - ?> (~(has by wix) ire) :: XX made redundant by oryx checking - =< [%| (nice-json)] - ?- p.hem - $put (new-deps q.hem %| ire) - $delt (del-deps q.hem %| ire) - == - :: - $mess - :- %| - ?. is-anon - ((teba new-mess:for-view) p.hem(s [%json !>(`json`s.p.hem)])) - =^ orx ..ya new-view:for-client - =+ vew=(ire-ix (oryx-to-ixor orx)) - ((teba new-mess.vew) p.hem(s [%json !>(`json`s.p.hem)])) - :: - $oath - ?. (~(has by sec) [p q]:hem) - ~|(no-driver+[p q]:hem !!) - [%| %.(quy (teba get-quay:(dom-vi [p q]:hem)))] - :: - $poll - ?: ?=({$~ $js} p.pok) :: XX treat non-json cases? - =+ deps=[%a (turn `(list @uvH)`p.hem |=(a/@ s+(scot %uv a)))] - [%& %js (add-json (frond:enjs %deps deps) poll:js)] - =. lyv (~(put by lyv) hen %wasp p.hem) - |- - =. done (new-deps i.p.hem %& hen) - ?~ t.p.hem [%| done] - $(p.hem t.p.hem) - :: - $subs - ?- p.hem - $put [%| ((teba add-subs:for-view) q.hem)] - $delt [%| ((teba del-subs:for-view) q.hem)] - == - :: - $view - ~| lost-ixor+p.hem - [%| ((teba poll:(ire-ix p.hem)) u.q.hem ses:for-client)] - == - :: - ++ process-auth - |= ham/perk-auth ^- (each pest _done) - =+ yac=for-client - ?- -.ham - $js [%& %js auth:js] - $json =/ cug (set-cookie -):yac - =^ jon ya stat-json.yac :: XX block on session save? - [%| (give-json 200 cug jon)] - :: - $at - =. ..ya abet.yac - =+ pez=process(pok p.ham, aut |) - ?. ?=($& -.pez) ~|(no-inject+p.ham !!) - ?~ p.pez pez - ?+ -.p.pez ~&(bad-inject+p.pez !!) - $red pez - $bake - =. ya abet.yac - [%| (resolve-bake `ses.yac dom.yac +.p.pez)] - :: - $js - =/ cug (set-cookie -):yac - =^ jon ya stat-json.yac :: XX block on session save? - [%| (resolve cug p.pez(p (add-json jon p.p.pez)))] - == - :: - $del - =. ..ya abut:yac - =/ cug - :~ (set-cookie cookie-domain cookie-prefix '~') - (set-cookie cookie-domain %ship '~') - == - [%| (give-json 200 cug (frond:enjs %ok %b &))] - :: - $get - |- - ~| aute+ham - ?: |(=(anon him.ham) =(get-user.yac `him.ham)) - =+ pez=process(pok rem.ham, aut &) - ?: ?=($| -.pez) pez - [%| (resolve ~ p.pez)] - ?. =(our him.ham) - ~|(sso-disabled+[our him.ham] !!) - show-login-page - :: - $try - :- %| - ?. =(our him.ham) - ~|(stub-foreign+him.ham !!) - ?. ?| =(get-user.yac `him.ham) - ?~(paz.ham | (check-password him.ham u.paz.ham)) - == - ~|(%auth-fail !!) - =. yac (for-authed-client him.ham) - =/ cug (set-cookie -):yac - =^ jon ya stat-json.yac - (give-json 200 cug jon) :: XX wait for session save? - == - :: - ++ check-password - |= pas/{ship @t} ^- ? - =+ (scry-jael %pass pas) - ?> ?=($bean -<) - -> - :: - ++ show-login-page - ^- (each pest _done) - ?. ?=($@($~ {$~ $html}) p.pok) - [%& %red ~] - [%& %htme login-page:xml] - :: - ++ need-ixor (oryx-to-ixor (need grab-oryx)) - ++ for-view ^+(ix (fix-user:(ire-ix need-ixor) ses:for-client)) - :: - ++ random-session (rsh 3 1 (scot %p (end 6 1 ney))) - ++ for-authed-client - |= him/ship ^+ [dom=*(unit @t) ya] - ?> =(him our) :: XX SSO - (new-ya &) - :: - ++ for-client :: stateful per-session engine - ^+ [dom=*(unit @t) ya] - =+ pef=cookie-prefix - =+ lig=(session-from-cookies pef maf) - ?~ lig - (new-ya |) - ?~ ~(get-user ya u.lig) - ~& bad-cookie+u.lig - (new-ya |) - [~ ~(. ya u.lig)] - :: - - ++ cookie-domain - ^- cord - ?- r.hat - {$| @} (cat 3 '; Domain=' (rsh 3 1 (scot %if p.r.hat))) - {$& $org $urbit *} '; Domain=.urbit.org' - {$& @ @ *} =- (rap 3 "; Domain={-}{i.p.r.hat ~}") - (turn (flop `path`t.p.r.hat) |=(a/knot (cat 3 a '.'))) - {$& *} '' :: XX security? - == - :: - ++ new-ya |=(own/? [`cookie-domain %.(own ~(new ya random-session))]) - -- - :: - ++ oryx-to-ixor |=(a/oryx (rsh 3 1 (scot %p (end 6 1 (shas %ire a))))) - ++ ya :: session engine - ~% %eyre-y ..ship ~ - |_ ses/hole - ++ abet ..ya - ++ abut (jael-note / %kill-cookie ses) - ++ new |=(own/? +>(..ya (jael-note / %save-cookie ses own))) - :: - ++ set-cookie - |= domain/(unit @t) ^- (list @t) - ?~ domain ~ - [(^set-cookie u.domain cookie-prefix ses)]~ - :: - ++ new-view - ^+ [*oryx ..ya] - =+ orx=`@t`(rsh 3 1 (scot %p (shaf %orx eny))) - =+ ire=(oryx-to-ixor orx) - [orx %.(ses ~(init ix ire %*(. *stem him anon, p.eve 1)))] :: XX fix him on ack? - :: - ++ stat-json - ^+ [*json ..ya] - =^ orx ..ya new-view - :_ ..ya - =, enjs - %- pairs :~ - oryx+s+orx - ixor+s+(oryx-to-ixor orx) - sein+(ship (sein:title our)) - ship+(ship our) - user+(ship (fall get-user anon)) :: XX crash on unsaved session? - == - :: - ++ get-user - ^- (unit ship) - =+ (scry-jael %cook ses) - ?> ?=($u-ship -<) - -> - -- - :: - ++ ix - ~% %eyre-x ..ship ~ - =| {ire/ixor stem} - =* sem -> - |% - ++ done . - ++ abet ..ix(wix (~(put by wix) ire sem)) - ++ abut - =+ sub=(~(tap in sus)) - |- ^+ ..ix - ?^ sub $(sub t.sub, ..ix (pul-subs i.sub)) - ..ix(wix (~(del by wix) ire)) - :: - ++ teba |*(a/$-(* ..ix) |*(b/* %_(done ..ix (a b)))) - ++ give-json (teba ^give-json) - ++ pass-note (teba ^pass-note) - ++ hurl-note - |= {a/{dock path} b/note} ^+ ..ix - =: med (~(put to med) hen) - hen `~ - == - :: ~& > hurl+[&2.b ire a] - (pass-note:abet [%of ire (gsig a)] b) - :: - ++ init - |= ses/hole ^+ ..ix - (jael-note:abet of+/[ire] %save-token ses ire) - :: - ++ fix-user - |= ses/hole ^+ +> - ?. =(anon him) +> - +>(him (need ~(get-user ya ses))) :: XX set correct value on session create - :: - ++ add-even - |= a/even ^+ eve - [+(p.eve) (~(put by q.eve) p.eve a)] - :: - ++ new-mess - |= {a/dock b/mark c/wire d/cage} ^+ ..ix - (hurl-note [a c] [%g %deal [him -.a] +.a %punk b d]) - :: - ++ add-subs - |= {a/dock $json b/wire c/path} ^+ ..ix - ?: (~(has in sus) +<) ~|(duplicate+c !!) - =. sus (~(put in sus) +<) - (hurl-note [a b] [%g %deal [him -.a] +.a %peel %json c]) - :: - ++ pul-subs - |= {a/dock $json b/wire c/path} ^+ ..ix - =. sus (~(del in sus) +<) - (hurl-note [a b] [%g %deal [him -.a] +.a %pull ~]) - :: - ++ del-subs :: XX per path? - |= {a/dock $json b/wire c/path} ^+ ..ix - =. ..ix (pul-subs +<) - (nice-json:pop-duct:(ire-ix ire)) :: XX gall ack - :: - ++ get-rush - |= {a/whir-of b/json} ^+ ..ix - (get-even [%rush [[(slav %p p.a) q.a] s.a] (frond:enjs %json b)]) - :: - ++ get-quit - |= a/whir-of ^+ ..ix - (get-even [%quit [[(slav %p p.a) q.a] s.a]]) - :: - ++ get-ack - |= {a/whir-of b/(unit {term tang})} ^+ ..ix - ?: =(~ med) ~& resp-lost+ire ..ix - ?~ b (nice-json:pop-duct) - (mean-json:pop-duct 500 b) - :: - ++ get-even - |= ven/even ^+ ..ix - =+ num=p.eve - =. eve (add-even ven) - =< abet - ?~ pol done - =. hen u.pol - (give-even(pol ~) num ven) - :: - ++ give-even - |= {num/@u ven/even} ^+ done - =: q.eve (~(del by q.eve) (dec num)) :: TODO ponder a-2 - mow ?.(?=($rush -.ven) mow mow:(pass-took [- %mess +]:p.ven)) - == - %^ give-json 200 ~ - %^ pairs:enjs id+(numb:enjs num) type+[%s -.ven] - ?- -.ven - $news ~[from+[%s (scot %uv p.ven)]] - $quit ~[from+(subs-to-json p.ven)] - $rush ~[from+(subs-to-json p.ven) data+q.ven] - == - :: - ++ pass-took - |= a/{p/dock wire} - %+ pass-note(hen `~) - [%of ire (gsig a)] - [%g %deal [him -.p.a] +.p.a %pump ~] - :: - ++ pop-duct =^(ned med ~(get to med) abet(hen ned)) - ++ poll - |= {seq/@u ses/hole} ^+ ..ix - =< abet - =. ..ix (jael-note of+/[ire] %live-token ses ire) - ?: =(seq p.eve) - =. lyv (~(put by lyv) hen [%poll ire]) - done(pol `hen) - ?: (gth seq p.eve) ~|(seq-high+cur=p.eve !!) - =+ ven=~|(seq-low+cur=p.eve (~(got by q.eve) seq)) - (give-even seq ven) - :: - ++ poll-dead - ^+ ..ix - =< abet - ?. =(pol `hen) - done :: old long poll - done(pol ~) - :: - ++ subs-to-json - |= {a/dock b/path} - %- pairs:enjs :~ - ship+[%s (rsh 3 1 (scot %p p.a))] - appl+[%s q.a] - path+(tape:enjs (spud b)) - == - :: - ++ get-jael - =* jael-gift-token :: XX types - => (mini-jael-gift /token-ack) - ?>(?=(?($token-ack $token-dead $token-beat) -) _.) - |= a/jael-gift-token ^+ ..ix - ?- -.a - $token-ack abet - $token-dead abut :: notify? - $token-beat - ?~ pol abet :: recieved other response - ~? !=(hen u.pol) [%oryx-beat-weird-duct hen] - (give-json:abet(pol ~, hen u.pol) 200 ~ (frond:enjs %beat %b &)) - == - -- - ++ lens :: urb.py engine - =/ him our :: XX other uses? - |_ $~ :: XX stateful? - ++ abet ..lens - ++ new - |= jon/json ^+ ..lens - =. ..lens - %+ pass-note [%le ~] - [%g %deal [him our] %dojo %peel %lens-json /sole] - =. ..lens - %+ pass-note [%le ~] - [%g %deal [him our] %dojo %punk %lens-command %json !>(`json`jon)] - abet - :: - ++ get-ack - |= a/(unit (pair term tang)) ^+ ..lens - ?~ a - ..lens :: (give-json 200 ~ (frond:enjs %okey-dokey %b &)) - =+ tag=(flop `tang`[>[%eyre-lens-fail p.u.a]< q.u.a]) - %- (slog:error:userlib tag) - (give-json:abet 500 ~ (wall:enjs (wush 160 tag))) - :: - ++ get-diff - |= fec/json ^+ ..lens - ?~ fec ..lens :: nulled event we don't care about - =. ..lens - %+ pass-note [%le ~] - `note`[%g %deal [him our] %dojo %pull ~] - (give-json:abet 200 ~ fec) - :: - ++ get-quit (give-json:abet 500 ~ (frond:enjs %quit b+&)) - -- - ++ vi :: auth engine - ~% %eyre-v ..ship ~ - |_ $: {usr/user dom/path} - cor/(unit $@($~ vase)) - {liv/? req/(qeu {p/duct q/mark r/vase:hiss})} - == - ++ self . - ++ abet +>(sec (~(put by sec) +<- +<+)) - ++ execute - |=({a/whir-se b/{beak silk:ford}} (execute:abet se+[a usr dom] b)) - ++ dead-this |=(a/tang (fail:abet 500 0v0 a)) - ++ dead-hiss |=(a/tang pump(req ~(nap to req), ..vi (give-sigh %| a))) - ++ eyre-them |=({a/whir-se b/vase} (eyre-them:abet se+[a usr dom] b)) - ++ pass-note |=({a/whir-se b/note} (pass-note:abet se+[a usr dom] b)) - :: XX block reqs until correct core checked in? - ++ warn |=(a/tang ((slog:error:userlib (flop a)) abet)) - ++ with |*({a/vase b/$-(vase abet)} |=(c/vase (b (slam a c)))) - ++ root-beak `beak`[our %home da+now] - :: - :: Main - :: - ++ cor-type ?~(cor %void ?~(u.cor %void p.u.cor)) - ++ has-arm ~(has in (silt (sloe cor-type))) - ++ build - %^ execute %core root-beak - :::+ %dude [|.(+)]:>%mod-samp< - ^- silk:ford - :^ %mute core+[root-beak (flop %_(dom . sec+dom))] - [[%& 12]~ %$ bale+!>(*(bale @))] :: XX specify on type? - ?~ cor ~ - ?~ u.cor ~ - ?: (has-arm %discard-state) ~ - ?: (has-arm %update) - [[%& 13]~ ride+[limb+%update prep-cor]]~ - [[%& 13]~ %$ noun+(slot 13 u.cor)]~ - :: - ++ call - |= {arm/vi-arm sam/cage} - %^ execute arm root-beak - call+[ride+[limb+arm prep-cor] [%$ sam]] - :: - ++ prep-cor ^- silk:ford - ?~ cor ~|(%no-core !!) - ?~ u.cor ~|(%nil-driver !!) - :+ %$ %core - %_ u.cor - +12.q - =+ ^= ato - %- sky - [[151 %noun] %cx (en-beam root-beak [%atom (flop %_(dom . sec+dom))])] - =+ key=?~(ato '' ;;(@t u.ato)) :: XX jael - =. key - ?~ key '' - %- (bond |.(~&(bad-key+[dom key] ''))) - =+ (slaw %uw key) - ?~(- ~ (de:crua:crypto load-secret u)) :: XX clay permissions - `(bale)`[[our now (shas %bale eny) root-beak] [usr dom] key] - == - :: - ++ pump - ^+ abet - ?~ cor - build - ?. liv - ~& e+vi+pump-blocked+[dom ~(wyt in req)] - abet - =+ ole=~(top to req) - ?~ ole abet - :: process hiss - =. hen p.u.ole - ?~ u.cor (eyre-them %filter-request r.u.ole) :: don't process - (call %filter-request hiss+r.u.ole) - :: - ++ fin-httr - |= vax/vase - =^ ole req ~(get to req) - => .(ole `{p/duct q/mark *}`ole) :: XX types - =. ..vi (cast-thou(hen p.ole) q.ole httr+vax) :: error? - pump - :: - :: Interfaces - :: - ++ get-news _build - ++ get-quay |=(quy/quay (call %receive-auth-query-string quay+!>(quy))) - ++ get-req |=(a/{mark vase:hiss} pump(req (~(put to req) hen a))) - ++ get-thou - |= {wir/whir-se hit/httr} - =. liv & - ?+ wir !! - ?($receive-auth-query-string $in) (call %receive-auth-response httr+!>(hit)) - ?($filter-request $out) - ?. (has-arm %filter-response) (fin-httr !>(hit)) - (call %filter-response httr+!>(hit)) - == - :: - ++ get-made - |= {wir/whir-se dep/@uvH res/(each cage tang)} ^+ abet - ?: ?=($core wir) (made-core dep res) - %. res - ?- wir - ?($filter-request $out) made-filter-request - ?($filter-response $res) made-filter-response - ?($receive-auth-response $bak) made-receive-auth-response - ?($receive-auth-query-string $in) made-receive-auth-query-string - == - :: - ++ made-core - |= {dep/@uvH gag/(each cage tang)} - :: ~& got-update/dep - =. ..vi (pass-note %core [%f [%wasp our dep &]]) - ?~ -.gag pump(cor `q.p.gag) - ?: &(=(~ cor) =(%$ usr)) - =. cor `~ - pump ::(cor `~) :: userless %hiss defaults to "nop" driver - (warn p.gag) - :: - ++ made-filter-request - %+ on-ford-fail dead-hiss - %+ on-error warn |. - %- handle-moves :~ - give+do-give - send+(do-send %filter-request) - show+do-show - == - :: - ++ made-filter-response - %+ on-error dead-hiss |. - %- handle-moves :~ - give+do-give - send+(do-send %filter-request) - redo+_pump - == - :: - ++ made-receive-auth-query-string - %+ on-error dead-this |. - (handle-moves send+(do-send %receive-auth-query-string) ~) - :: - ++ made-receive-auth-response - %+ on-error dead-this |. - %- handle-moves :~ - give+do-give - send+(do-send %receive-auth-query-string) - redo+_pump(..vi (give-html 200 ~ exit:xml)) - == - :: - :: Result handling - :: - :: XX formal dill-blit %url via hood - ++ auth-print - |=({$show a/purl} (slog:error:userlib auth-tank leaf+(en-purl a) ~)) - ++ auth-tank - => =- ?~(usr - rose+["@" `~]^~[leaf+(trip usr) -]) - rose+["." `~]^(turn (flop dom) |=(a/cord leaf+(trip a))) - rose+[" " `~]^~[leaf+"To authenticate" . leaf+"visit:"] - :: - ++ do-give (with !>(|=({$give a/httr} a)) fin-httr) - ++ do-show (with !>(auth-print) _abet) - ++ do-send - |= wir/whir-se ^- $-(vase _abet) - |= res/vase - =. liv | :: block requests until a reponse is given - (eyre-them wir (slam !>(|=({$send a/hiss} a)) res)) - :: - ++ handle-moves - |= a/(list {p/term q/$-(vase _abet)}) - |= b/vase - ~> %nil. - ~| %bad-sec-move :: XX move ~| into ?> properly - ?>((~(nest ut p:!>(*sec-move)) %& p.b) ~) - =+ opt=|.((silt (turn a head))) - |- - ?~ a ~|(allowed=(opt) !!) - ?: =(p.i.a -.q.b) - (q.i.a (spec b)) - $(a t.a) - :: - ++ on-ford-fail - |= {err/$-(tang _abet) try/$-((each cage tang) _abet)} - |= a/(each cage tang) ^+ abet - ?-(-.a $| (err p.a), $& (try a)) - :: - ++ on-error - |= {err/$-(tang _abet) handle-move/_|.(|~(vase abet))} - |= a/(each cage tang) ^+ abet - =+ try=(possibly-stateful |=(b/_self (handle-move(+ b)))) :: XX types - ?: ?=($| -.a) (err p.a) - =- ?-(-.- $& p.-, $| (err p.-)) - (mule |.(~|(driver+dom ~|(bad-res+p.q.p.a (try q.p.a))))) - :: - ++ possibly-stateful - |= han/$-(_self $-(vase _abet)) :: XX |.(|+(vase abet)) - |= res/vase ^+ abet - ?: ?=({@ *} q.res) - =. p.res (~(fuse ut p.res) p:!>(*{@ *})) - ((han self) res) - ?. ?=({{@ *} *} q.res) - ~|(%misshapen-result !!) - =. p.res (~(fuse ut p.res) p:!>(*{{@ *} *})) - =+ [mow=(slot 2 res) roc=(slot 3 res)] - =- ((han self(cor (some roc))) mow):+ :: XX better stateless asserts - =+ typ=cor-type - ~| %core-mismatch - ?>((~(nest ut typ) & p.roc) ~) --- -- --- -. == -=| bolo -=* bol - -|= {now/@da eny/@ ski/sley} :: activate -^? :: opaque core -|% :: -++ call :: handle request - |= $: hen/duct - hic/(hypo (hobo task:able)) - == - => %= . :: XX temporary - q.hic - ^- task:able - ?: ?=($soft -.q.hic) - ((hard task:able) p.q.hic) - ?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic - ~& [%eyre-call-flub (@tas `*`-.q.hic)] - ((hard task:able) q.hic) - == - ^+ [p=*(list move) q=..^$] - ?: ?=($wegh -.q.hic) - :_ ..^$ :_ ~ - :^ hen %give %mass - :- %eyre - :- %| - :~ dependencies+[%& liz] views+[%& wix] - ducts+[%| ~[dead+[%& ded] proxy+[%& pox] outgoing+[%& ask]]] - misc+[%& bol] - == - =+ our=`@p`0x100 :: XX sentinel - =+ ska=(sloy:error:userlib ski) - =+ sky=|=({* *} `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a])))) - =. ney (shax :(mix (shax now) +(eny) ney)) :: XX!! shd not need - ^+ [p=*(list move) q=..^$] - =^ mos bol - abet:(apex:~(adit ye [hen [now eny our sky] ~] bol) q.hic) - [mos ..^$] -:: -++ doze :: require no timer - |= {now/@da hen/duct} - ^- (unit @da) - ~ -:: -++ load :: take previous state - =+ bolo-6={$6 _%*(+ *bolo lyv *(map duct ^), wix [*(map) *(map)])} - =+ driv-5=_=>(*driv [cor=p req=req.q]) - =+ bolo-5={$5 _=+(*bolo-6 +.-(sec (~(run by sec.-) driv-5)))} - =+ bolo-4={$4 _%*(+ *bolo-5 lyv *(map duct ^))} - =/ bolo _%*(. *bolo lyv **) - ::|= * %. (bolo +<) - |= old/?(bolo bolo-6 bolo-5 bolo-4) - ?- -.old - $7 ..^$(+>- old(lyv ~)) - $6 $(old [%7 +.old(lyv ~, wix ~)]) - $5 $(old [%6 +.old(sec (~(run by sec.old) |=(driv-5 [cor & req])))]) - $4 $(old [%5 +.old(lyv ~)]) :: minor leak - == -:: -++ scry - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) - ?. ?=($& -.why) ~ - =* who p.why - =+ our=(need hov) :: XX single home - =+ ska=(sloy:error:userlib ski) - =+ sky=|=({* *} `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a])))) - ?. ?=($$ ren) [~ ~] - ?. ?=($$ -.lot) [~ ~] - ?+ syd [~ ~] - $host - %- (lift (lift |=(a/hart [%hart !>(a)]))) - ^- (unit (unit hart)) - ?. =(our who) - ?. =([%da now] p.lot) [~ ~] - ~& [%e %scry-foreign-host who] - ~ :: XX add non-scry binding to $hat gram - =. p.lot ?.(=([%da now] p.lot) p.lot [%tas %real]) - ?+ p.lot [~ ~] - {$tas $fake} ``[& [~ 8.443] %& /localhost] :: XX from unix - {$tas $real} - ``~(our-host ye [`duct`~[/] [now eny our sky] ~] bol) - == - == -:: -++ stay `bolo`+>-.$ -++ take :: accept response - |= {tea/wire hen/duct hin/(hypo sign)} - ^+ [p=*(list move) q=..^$] - =+ our=`@p`0x100 :: XX sentinel - =+ ska=(sloy:error:userlib ski) - =+ sky=|=({* *} `(unit)`=+(a=(ska +<) ?~(a ~ ?~(u.a ~ [~ u.u.a])))) - =. ney (shax :(mix (shax now) +(eny) ney)) :: XX!! shd not need - ^+ [p=*(list move) q=..^$] - =+ tee=((soft whir) tea) - ?~ tee ~& [%e %lost -.q.hin hen] [~ ..^$] - =^ mos bol - =< abet - (axon:~(adit ye [hen [now eny our sky] ~] bol) u.tee q.hin) - [mos ..^$] --- diff --git a/neo/van/ford.hoon b/neo/van/ford.hoon deleted file mode 100644 index 9b701f452..000000000 --- a/neo/van/ford.hoon +++ /dev/null @@ -1,1988 +0,0 @@ -:::::: -:: :: %ford, new execution control -!? 164 -:::: -|= pit/vase -=, ford -=, format -=> =~ -:: structures -|% -++ heel path :: functional ending -++ move {p/duct q/(wind note gift:able)} :: local move -++ note :: out request $-> - $% $: $c :: to %clay - $% {$warp p/sock q/riff:clay} :: - == == :: - $: $f :: to %ford - $% {$exec p/@p q/(unit bilk:ford)} :: - == == :: - $: $g :: to %gall - $% {$deal p/sock q/cush:gall} :: - == == == :: -++ sign :: in result $<- - $% $: $c :: by %clay - $% {$writ p/riot:clay} :: - == == :: - $: $f :: by %ford - $% {$made p/@uvH q/gage:ford} :: - == == :: - $: $g :: by %gall - $% {$unto p/cuft:gall} :: - == == == :: --- :: -|% :: structures -++ axle :: all %ford state - $: $2 :: version for update - pol/(map ship baby) :: - == :: -++ baby :: state by ship - $: tad/{p/@ud q/(map @ud task)} :: tasks by number - dym/(map duct @ud) :: duct to task number - deh/(map @uvH deps) :: depends by hash - jav/(map * calx) :: cache - == :: -++ bolt :: gonadic edge - |* a/mold :: product clam - $: p/cafe :: cache - $= q :: - $% {$0 p/(set beam) q/a} :: depends+product - {$1 p/(set {van/vane ren/care:clay bem/beam tan/tang})} :: blocks - {$2 p/(set beam) q/tang} :: depends+error - == :: - == :: -:: :: -++ burg :: gonadic rule - |* {a/mold b/mold} :: from and to - $-({c/cafe d/a} (bolt b)) :: -:: :: -++ cafe :: live cache - $: p/(set calx) :: used - q/(map * calx) :: cache - r/(map @uvH deps) :: dependss - == :: -:: :: -++ calm :: cache metadata - $: laz/@da :: last accessed - dep/(set beam) :: dependencies - == :: -++ calx :: concrete cache line - $% {$hood p/calm q/(pair beam cage) r/hood} :: compile - {$bake p/calm q/(pair mark beam) r/(unit vase)} :: load - {$boil p/calm q/(trel coin beam beam) r/vase} :: execute - {$path p/calm q/beam r/(unit beam)} :: -to/ transformation - {$slit p/calm q/{p/span q/span} r/span} :: slam type - {$slim p/calm q/{p/span q/twig} r/(pair span nock)}:: mint - {$slap p/calm q/{p/vase q/twig} r/vase} :: compute - {$slam p/calm q/{p/vase q/vase} r/vase} :: compute - == :: -++ deps :: depend state - $% {$init p/(set beam)} :: given out - {$sent p/(set duct) q/(set beam)} :: listener exists - {$done $~} :: change seen - == :: -++ task :: problem in progress - $: nah/duct :: cause - {bek/beak kas/silk} :: problem - keg/(map (pair term beam) cage) :: block results - kig/(set (trel vane care:clay beam)) :: blocks - == :: -++ gagl (list (pair gage gage)) :: -++ vane ?($a $b $c $d $e $f $g) :: --- :: -|% :: -++ calf :: reduce calx - |* sem/* :: a spansystem hack - |= cax/calx - ?+ sem !! - $hood ?>(?=($hood -.cax) r.cax) - $bake ?>(?=($bake -.cax) r.cax) - $boil ?>(?=($boil -.cax) r.cax) - $path ?>(?=($path -.cax) r.cax) - $slap ?>(?=($slap -.cax) r.cax) - $slam ?>(?=($slam -.cax) r.cax) - $slim ?>(?=($slim -.cax) r.cax) - $slit ?>(?=($slit -.cax) r.cax) - == -:: -++ calk :: cache lookup - |= a/cafe :: - |= {b/@tas c/*} :: - ^- {(unit calx) cafe} :: - =+ d=(~(get by q.a) [b c]) :: - ?~ d [~ a] :: - [d a(p (~(put in p.a) u.d))] :: -:: :: -++ came :: - |= {a/cafe b/calx} :: cache install - ^- cafe :: - a(q (~(put by q.a) [-.b q.b] b)) :: -:: :: -++ faun (flux |=(a/vase [%& %noun a])) :: vase to gage -++ flay :: unwrap gage to cage - |= {a/cafe b/gage} ^- (bolt cage) - ?- -.b - $tabl (flaw a >%bad-marc< ~) - $| (flaw a p.b) - $& (fine a p.b) - == -:: -++ fret :: lift error - |= a/(bolt gage) ^- (bolt gage) - ?. ?=($2 -.q.a) a - [p.a [%0 p.q.a `gage`[%| q.q.a]]] -:: -++ fine |* {a/cafe b/*} :: bolt from data - [p=`cafe`a q=[%0 p=*(set beam) q=b]] :: -++ flaw |= {a/cafe b/tang} :: bolt from error - [p=a q=[%2 p=*(set beam) q=b]] :: -++ flag :: beam into deps - |* {a/beam b/(bolt)} :: - ?: ?=($1 -.q.b) b - =. p.q.b (~(put in p.q.b) a) - b -:: :: -++ flue |=(a/cafe (fine a ~)) :: cafe to empty -++ flux |* a/_* :: bolt lift (fmap) - |* {cafe _,.+<.a} - (fine +<- (a +<+)) -:: -++ lark :: filter arch names - |= {wox/$-(knot (unit @)) arc/arch} - ^- (map @ knot) - %- ~(gas by *(map @ knot)) - =| rac/(list (pair @ knot)) - |- ^+ rac - ?~ dir.arc rac - =. rac $(dir.arc l.dir.arc, rac $(dir.arc r.dir.arc)) - =+ gib=(wox p.n.dir.arc) - ?~(gib rac [[u.gib p.n.dir.arc] rac]) -:: -++ tack :: fold path to term - |= a/{i/term t/(list term)} ^- term - (rap 3 |-([i.a ?~(t.a ~ ['-' $(a t.a)])])) -:: -++ tear :: split term - =- |=(a/term `(list term)`(fall (rush a (most hep sym)) /[a])) - sym=(cook crip ;~(plug low (star ;~(pose low nud)))) -:: -++ za :: per event - =| $: $: our/ship :: computation owner - hen/duct :: event floor - $: now/@da :: event date - eny/@ :: unique entropy - ska/sley :: system namespace - == :: - mow/(list move) :: pending actions - == :: - bay/baby :: all owned state - == :: - |% - ++ abet :: resolve - ^- {(list move) baby} - [(flop mow) bay] - :: - ++ apax :: call - ^+ ..apax - =+ nym=(~(get by dym.bay) hen) - ?~ nym :: XX should never - ~& [%ford-mystery hen] - ..apax - =+ tas=(need (~(get by q.tad.bay) u.nym)) - amok:~(camo zo [u.nym tas]) - :: - ++ apex - |= kub/bilk - ^+ +> - =+ num=p.tad.bay - ?< (~(has by dym.bay) hen) - =: p.tad.bay +(p.tad.bay) - dym.bay (~(put by dym.bay) hen num) - == - ~(exec zo [num `task`[hen kub ~ ~]]) - :: - ++ axon :: take - |= {num/@ud {van/vane ren/care:clay bem/beam} sih/sign} - ^+ +> - ?: ?=({$unto $quit *} +.sih) - +>.$ - =+ tus=(~(get by q.tad.bay) num) - ?~ tus - ~& [%ford-lost van num] - +>.$ - ?- -.+.sih - $writ (~(resp zo [num u.tus]) [van ren bem] p.+.sih) - $made (~(resm zo [num u.tus]) [van ren bem] [p q]:+.sih) - $unto - ?+ -.p.+.sih ~|(ford-strange-unto+-.p.+.sih !!) - $diff (~(resd zo [num u.tus]) [van ren bem] p.p.+.sih) - $reap ?~ p.p.+.sih +>.$ - ((slog:error:userlib leaf+"ford-reap-fail" u.p.p.+.sih) +>.$) - == - == - :: - ++ axun :: take rev update - |= {tea/wire dep/@uvH bem/beam sih/sign} - ^+ +> - ?+ -.+.sih ~|(%bad-axun !!) - $writ - ?~ p.sih +>.$ - :: ~& writ+tea - =+ dap=(~(got by deh.bay) dep) - =- +>.$(mow mow, deh.bay ?~(dop deh.bay (~(put by deh.bay) dep dop))) - ^- {dop/$@($~ _dap) mow/_mow} - ?- -.dap - $done `mow :: writ redundant - $init ~|(never-subscribed+dep !!) - $sent - :- [%done ~] - ;: weld - (axap dep (~(del in q.dap) bem)) :: cancel outstanding - (turn (~(tap in p.dap)) |=(hen/duct [hen %give %news dep])) - mow - == == - == - :: - ++ axap :: unsubscribe beams - |= {dep/@uvH dap/(set beam)} - %+ turn (~(tap in dap)) - |= bem/beam - :^ hen %pass [(scot %p our) (scot %uv dep) (en-beam bem)] - [%c %warp [our p.bem] q.bem ~] - :: - ++ awap :: get next revision - ~% %ford-w ..ship ~ - |= {dep/@uvH ask/?} - ?: =(`@`0 dep) - ~&(dep-empty+hen +>.$) - ?: =(dep 0vtest) :: upstream testing - +>.$(mow ?.(ask mow :_(mow [hen %give %news dep]))) - =+ dap=(~(get by deh.bay) dep) - ?~ dap ~&(dep-missed+dep +>.$) :: XX ~| !! - ?- -.u.dap - $done +>.$(mow ?.(ask mow :_(mow [hen %give %news dep]))) - $sent - =. p.u.dap - ?: ask (~(put in p.u.dap) hen) - (~(del in p.u.dap) hen) - ?^ p.u.dap - +>.$(deh.bay (~(put by deh.bay) dep u.dap)) - =. mow (weld (axap dep q.u.dap) mow) - +>.$(deh.bay (~(put by deh.bay) dep [%init q.u.dap])) - :: - $init - ?. ask ~&(awap-kill-empty+dep +>.$) :: crash? - %_ +>.$ - deh.bay - (~(put by deh.bay) dep [%sent [hen ~ ~] p.u.dap]) - :: - mow - =< (welp :_(mow (turn (~(tap in p.u.dap)) .))) - |= bem/beam - :^ hen %pass [(scot %p our) (scot %uv dep) (en-beam bem)] - [%c [%warp [our p.bem] q.bem ~ [%next %z r.bem (flop s.bem)]]] - == == - :: - ++ zo - ~% %ford-z ..ship ~ - =| dyv/@ - |_ {num/@ud task} - ++ abet %_(..zo q.tad.bay (~(put by q.tad.bay) num +<+)) - ++ amok - %_ ..zo - q.tad.bay (~(del by q.tad.bay) num) - dym.bay (~(del by dym.bay) nah) - == - ++ camo :: stop requests - ^+ . - =+ kiz=(~(tap in kig)) - |- ^+ +> - ?~ kiz +> - $(kiz t.kiz, mow :_(mow [hen (cancel i.kiz)])) - :: - ++ cancel :: stop a request - |= {van/vane ren/care:clay bem/beam} - ^- (wind note gift:able) - ?+ van ~|(stub-cancel+van !!) - $c [%pass (camp-wire +<) van [%warp [our p.bem] q.bem ~]] - $g [%pass (camp-wire +<) van [%deal [our p.bem] q.bem [%pull ~]]] - == - ++ camp-wire :: encode block - |= {van/vane ren/care:clay bem/beam} ^- wire - [(scot %p our) (scot %ud num) van ren (en-beam bem)] - :: - ++ camp :: request a file - |= {van/vane ren/care:clay bem/beam} - ^+ +> - ~& >> [%camping van ren bem] - %_ +>.$ - kig (~(put in kig) +<) - mow - :_ mow - :- hen - ?+ van ~&(%camp-stub !!) - $g - :+ %pass (camp-wire +<) - =+ ^= tyl - ?. ?=($x ren) - s.bem - ?> ?=(^ s.bem) - t.s.bem - - [%g [%deal [our p.bem] q.bem [%peer %scry ren (flop tyl)]]] - :: - $c - :+ %pass (camp-wire +<) - [%c [%warp [our p.bem] q.bem [~ %sing ren r.bem (flop s.bem)]]] - == - == - :: - ++ clad :: hash dependencies - |* hoc/(bolt) ^+ [*@uvH hoc] - ?: ?=($1 -.q.hoc) [*@uvH hoc] - =^ dep r.p.hoc (daze [p.q r.p]:hoc) - [dep hoc] - :: - ++ clef :: cache a result - |* sem/* - |* {hoc/(bolt) fun/(burg)} - ?- -.q.hoc - $2 hoc - $1 hoc - $0 - =^ cux p.hoc ((calk p.hoc) sem q.q.hoc) - ?^ cux - [p=p.hoc q=[%0 p=dep.p.u.cux q=((calf sem) u.cux)]] - =+ nuf=(cope hoc fun) - ?- -.q.nuf - $2 nuf - $1 nuf - $0 - :: ~& :- %clef-new - :: ?+ sem `term`sem - :: $hood [%hood (en-beam &1.q.q.hoc)] - :: $bake [%bake `mark`&1.q.q.hoc (en-beam |2.q.q.hoc)] - :: == - :- p=(came p.nuf `calx`[sem `calm`[now p.q.nuf] q.q.hoc q.q.nuf]) - q=q.nuf - == - == - :: - ++ coax !. :: bolt across - |* {hoc/(bolt) fun/(burg)} - ?- -.q.hoc - $0 =+ nuf=$:fun(,.+<- p.hoc) - :- p=p.nuf - ^= q - ?- -.q.nuf - $0 [%0 p=(~(uni in p.q.hoc) p.q.nuf) q=[q.q.hoc q.q.nuf]] - $1 q.nuf - $2 q.nuf - == - $1 =+ nuf=$:fun(,.+<- p.hoc) - :- p=p.nuf - ^= q - ?- -.q.nuf - $0 q.hoc - $1 [%1 p=(~(uni in p.q.nuf) p.q.hoc)] - $2 q.nuf - == - $2 hoc - == - :: - ++ cool :: error caption - |* {cyt/$@(term (trap tank)) hoc/(bolt)} - ?. ?=($2 -.q.hoc) hoc - [p=p.hoc q=[%2 p=p.q.hoc q=[?^(cyt *cyt [>`@tas`cyt<]~) q.q.hoc]]] - :: - ++ cope :: bolt along - |* {hoc/(bolt) fun/(burg)} - ?- -.q.hoc - $1 hoc - $2 hoc - $0 =+ nuf=(fun p.hoc q.q.hoc) - :- p=p.nuf - ^= q - ?- -.q.nuf - $1 q.nuf - $2 [%2 p=(~(uni in `_p.q.nuf`p.q.hoc) p.q.nuf) q=q.q.nuf] - $0 [%0 p=(~(uni in `_p.q.nuf`p.q.hoc) p.q.nuf) q=q.q.nuf] - == == - :: - ++ coop :: bolt alter - |* {hoc/(bolt) fun/$-(cafe (bolt))} - ?- -.q.hoc - $1 hoc - $0 hoc - $2 =+ nuf=(fun p.hoc) - :- p=p.nuf - ^= q - ?- -.q.nuf - $1 q.nuf - $0 [%0 p=(~(uni in `_p.q.nuf`p.q.hoc) p.q.nuf) q=q.q.nuf] - $2 =. q.q.nuf (welp q.q.nuf q.q.hoc) - [%2 p=(~(uni in `_p.q.nuf`p.q.hoc) p.q.nuf) q=q.q.nuf] - == == - :: - ++ coup :: toon to bolt - |= cof/cafe - |* {ton/toon fun/gate} - :- p=cof - ^= q - ?- -.ton - $2 [%2 p=*(set beam) q=p.ton] - $0 [%0 p=*(set beam) q=(fun p.ton)] - $1 :: ~& [%coup-need ((list path) p.ton)] - =- ?- -.faw - $& :- %1 - ^= p - %- silt - %+ turn p.faw - |=(a/{vane care:clay beam} [-.a +<.a +>.a *tang]) - $| [%2 p=*(set beam) q=p.faw] - == - ^= faw - |- ^- (each (list (trel vane care:clay beam)) tang) - ?~ p.ton [%& ~] - =+ nex=$(p.ton t.p.ton) - =+ err=|=(a/tape [%| leaf+a ?:(?=($& -.nex) ~ p.nex)]) - =+ pax=(path i.p.ton) - ?~ pax (err "blocking empty") - =+ ren=((soft care:clay) (rsh 3 1 i.pax)) - ?~ ren - (err "blocking not care: {}") - =+ zis=(de-beam t.pax) - ?~ zis - (err "blocking not beam: {}") - ?: ?=($g (end 3 1 i.pax)) - ?- -.nex - $& [%& [%g u.ren u.zis] p.nex] - $| nex - == - ?: ?=($c (end 3 1 i.pax)) - ?- -.nex - $& [%& [%c u.ren u.zis] p.nex] - $| nex - == - (err "blocking bad vane") - == - :: - ++ cowl :: each to bolt - |= cof/cafe - |* {tod/(each * tang) fun/gate} - %+ (coup cof) - ?- -.tod - $& [%0 p=p.tod] - $| [%2 p=p.tod] - == - fun - :: - ++ tabl-run :: apply to all elems - |= fun/(burg cage gage) - |= {cof/cafe gag/gage} - ^- (bolt gage) - ?. ?=($tabl -.gag) - (cope (flay cof gag) fun) - %+ cope - |- ^- (bolt (list (pair gage gage))) - ?~ p.gag (fine cof ~) - %. [cof p.gag] - ;~ cope - ;~ coax - |=({cof/cafe {^ q/gage} t/gagl} (fret ^^$(cof cof, gag q))) - |=({cof/cafe ^ t/gagl} ^$(cof cof, p.gag t)) - == - (flux |=({v/gage t/gagl} [[p.i.p.gag v] t])) - == - (flux |=(rex/gagl [%tabl rex])) - :: - ++ some-in-map - |* fun/(burg knot (unit)) - =+ res=_(need [?+(-.q !! $0 q.q)]:*fun) - =+ marv=(map knot res) - |= {cof/cafe sud/(map knot $~)} ^- (bolt marv) - ?~ sud (flue cof) - %. [cof sud] - ;~ cope - ;~ coax - |=({cof/cafe _sud} ^$(cof cof, sud l)) - |=({cof/cafe _sud} ^$(cof cof, sud r)) - |= {cof/cafe {dir/@ta $~} ^} - %+ cope (fun cof dir) - (flux (lift |*(* [dir +<]))) - == - %- flux - |= {lam/marv ram/marv nod/(unit {knot res})} - ?^(nod [u.nod lam ram] (~(uni by lam) ram)) - == - ++ dash :: process cache - |= cof/cafe - ^+ +> - %_(+> jav.bay q.cof, deh.bay r.cof) - :: - ++ diff :: diff - |= {cof/cafe kas/silk kos/silk} - ^- (bolt gage) - %. [cof kas kos] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope (make cof p) flay)) - |=({cof/cafe p/silk q/silk} (cope (make cof q) flay)) - == - |= {cof/cafe cay/cage coy/cage} ^- (bolt gage) - ?. =(p.cay p.coy) - %+ flaw cof :_ ~ - leaf+"diff on data of different marks: {(trip p.cay)} {(trip p.coy)}" - ?: =(q.q.cay q.q.coy) - (fine cof [%& %null [%atom %n ~] ~]) - :: - %+ cope (fang cof p.cay) - |= {cof/cafe pro/vase} - ?. (slab %grad p.pro) - (flaw cof leaf+"no ++grad" ~) - =+ gar=(slap pro [%limb %grad]) - ?@ q.gar - =+ for=((sand %tas) q.gar) - ?~ for (flaw cof leaf+"bad mark ++grad" ~) - %+ make cof ^- silk - :+ %diff - [%kthp u.for [%$ cay]] - [%kthp u.for [%$ coy]] - ?. (slab %form p.gar) - (flaw cof leaf+"no ++form:grad" ~) - ?. (slab %diff p.gar) - (flaw cof leaf+"no ++diff:grad" ~) - %+ cope (keel cof pro [[%& 6]~ q.cay]~) - |= {cof/cafe pox/vase} - %+ cope - %^ maul cof - (slap (slap pox [%limb %grad]) [%limb %diff]) - q.coy - |= {cof/cafe dif/vase} - =+ for=((soft @tas) q:(slap gar [%limb %form])) - ?~ for - (flaw cof leaf+"bad ++form:grad" ~) - (fine cof [%& u.for dif]) - == - :: - ++ daze :: remember depends - |= {dep/(set beam) deh/(map @uvH deps)} - ^+ [*@uvH deh.bay] - =. dep - =< (silt (skip (~(tap in dep)) .)) - |= dap/beam ^- ? - ?~ s.dap | - =>(.(s.dap t.s.dap) |((~(has in dep) dap) $)) - ?~ dep [0v0 deh] - =+ hap=(sham dep) - ?: (~(has by deh) hap) - [hap deh] - [hap (~(put by deh) hap [%init dep])] - :: - ++ exec :: execute app - ^+ ..zo - ?: !=(~ kig) ..zo - =+ bot=(make-norm-bek [~ jav.bay deh.bay] kas) - =^ dep bot (clad bot) - =. ..exec (dash p.bot) - ?- -.q.bot - $0 amok:(expo [%made dep q.q.bot]) - $2 amok:(expo [%made dep %| q.q.bot]) - $1 =+ zuk=(~(tap by p.q.bot) ~) - =< abet - |- ^+ ..exec - ?~ zuk ..exec - $(zuk t.zuk, ..exec `_..exec`(camp van.i.zuk ren.i.zuk bem.i.zuk)) - == - :: - ++ expo :: return gift - |= gef/gift:able - %_(+> mow :_(mow [hen %give gef])) - :: - ++ fade :: compile to hood - ~/ %fade - |= {cof/cafe bem/beam} - :: ~& fade+(en-beam bem) - ^- (bolt hood) - %+ cool |.(leaf+"ford: fade {<[(en-beam bem)]>}") - %+ cope (liar cof %*(. bem s [%hoon s.bem])) - |= {cof/cafe cay/cage} - %+ (clef %hood) (fine cof bem(r [%ud 0]) cay) - ^- (burg (pair beam cage) hood) - ~% %hood-miss ..abet ~ - |= {cof/cafe bem/beam cay/cage} - ?. ?=(@ q.q.cay) - (flaw cof ~) - =+ vex=((full (fair bem)) [[1 1] (trip q.q.cay)]) - ?~ q.vex - (flaw cof [%leaf "syntax error: {} {}"] ~) - (fine cof p.u.q.vex) - :: - ++ fame :: beam with - as / - ~/ %fame - |= {cof/cafe bem/beam} - ^- (bolt beam) - =; une/(bolt (unit beam)) - %+ cope une - |= {cof/cafe bom/(unit beam)} ^- (bolt beam) - ?^ bom (fine cof u.bom) - (flaw cof leaf+"fame: no {<(en-beam bem)>}" ~) - %+ (clef %path) (fine cof bem) - |= {cof/cafe bem/beam} - =^ pax bem [(flop s.bem) bem(s ~)] - |^ opts - ++ opts :: search unless done - ^- (bolt (unit beam)) - ?^ pax (wide(pax t.pax) (tear i.pax)) - %+ cope (lima cof %hoon bem) - (flux |=(a/(unit vase) ?~(a ~ `bem))) - :: - ++ wide :: match segments - |= sub/(list term) ^- (bolt (unit beam)) - ?~ sub opts - ?~ t.sub opts(s.bem [i.sub s.bem]) - => .(sub `(list term)`sub) :: TMI - =- (cope - flat) - %^ lash cof bem - |= {cof/cafe dir/knot} ^- (bolt (unit beam)) - =+ sus=(tear dir) - ?. =(sus (scag (lent sus) sub)) - (flue cof) - %_ ^$ - cof cof - sub (slag (lent sus) sub) - s.bem [dir s.bem] - == - :: - ++ flat :: at most one - |= {cof/cafe opt/(map term beam)} ^- (bolt (unit beam)) - ?~ opt (flue cof) - ?: ?=({^ $~ $~} opt) (fine cof `q.n.opt) - =+ all=(~(run by `(map term beam)`opt) en-beam) - (flaw cof leaf+"fame: fork {}" ~) - -- - :: - ++ fang :: protocol door - |= {cof/cafe for/mark} ^- (bolt vase) - :: ~& fang+for - (lear cof bek /[for]/mar) - :: - ++ fair :: hood parsing rule - |= bem/beam - ?> ?=({$ud $0} r.bem) :: XX sentinel - =+ vez=(vang & (en-beam bem)) - =< hood - |% - ++ case - %+ sear - |= a/coin - ?. ?=({$$ ?($da $ud $tas) *} a) ~ - [~ u=(^case a)] - nuck:so - :: - ++ mota ;~(pfix pat mota:vez) :: atom odor - ++ hath (sear plex (stag %clsg poor)):vez :: hood path - ++ have (sear de-beam ;~(pfix fas hath)) :: hood beam - ++ hith :: static path - => vez - (sear plex (stag %clsg (more fas hasp))) - :: - ++ hive :: late-bound path - ;~ pfix fas - %+ cook |=(a/hops a) - => vez - ;~ plug - (stag ~ gash) - ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~)) - == - == - :: - ++ hood - %+ ifix [gay gay] - ;~ plug - ;~ pose - (ifix [;~(plug fas wut gap) gap] dem) - (easy zuse) - == - :: - ;~ pose - (ifix [;~(plug fas hep gap) gap] (most ;~(plug com gaw) hoof)) - (easy ~) - == - :: - ;~ pose - (ifix [;~(plug fas lus gap) gap] (most ;~(plug com gaw) hoof)) - (easy ~) - == - :: - (star ;~(sfix horn gap)) - (most gap hoop) - == - :: - ++ hoot - ;~ plug - sym - ;~ pose - %+ stag ~ - ;~(plug ;~(pfix fas case) ;~(pfix ;~(plug fas sig) fed:ag)) - (easy ~) - == - == - :: - ++ hoof - %+ cook |=(a/^hoof a) - ;~ pose - (stag %| ;~(pfix tar hoot)) - (stag %& hoot) - == - :: - ++ hoop - ;~ pose - (stag %| ;~(pfix ;~(plug fas fas gap) have)) - (stag %& tall:vez) - == - :: - ++ horn - =< apex - =| tol/? - |% - ++ apex - %+ knee *^horn |. ~+ - ;~ pfix fas - ;~ pose - (stag %ape ;~(pfix sig ape:read)) - (stag %arg ;~(pfix buc ape:read)) - (stag %alt ;~(pfix bar alt:read)) - (stag %dep ;~(pfix hax day:read)) - (stag %dub ;~(pfix tis dub:read)) - (stag %fan ;~(pfix dot fan:read)) - (stag %for ;~(pfix com for:read)) - (stag %hel ;~(pfix cen day:read)) - (stag %lin ;~(pfix pam lin:read)) - (stag %man ;~(pfix tar man:read)) - (stag %nap ;~(pfix cab day:read)) - (stag %nod ;~(pfix cab now:read)) - (stag %saw ;~(pfix sem saw:read)) - (stag %see ;~(pfix col see:read)) - (stag %sic ;~(pfix ket sic:read)) - (stag %toy ;~(sfix toy:read fas)) - == - == - :: - ++ rail - |* {wid/rule tal/rule} - ?. tol wid - ;~(pose wid tal) - :: - ++ read - |% ++ ape - %+ rail - (ifix [sel ser] (stag %cltr (most ace wide:vez))) - ;~(pfix gap tall:vez) - :: - ++ alt - %+ rail (ifix [pel per] (most ace day)) - ;~(sfix (star day) gap duz) - :: - ++ day - %+ rail - apex(tol |) - ;~(pfix gap apex) - :: - ++ dub - %+ rail - ;~(plug sym ;~(pfix tis day)) - ;~(pfix gap ;~(plug sym day)) - :: - ++ fan - %+ rail fail - ;~(sfix (star day) gap duz) - :: - ++ for - %+ rail fail - =- ;~(sfix (star -) gap duz) - ;~(pfix gap fas ;~(plug hith day)) - :: - ++ lin - %+ rail - ;~(plug (plus ;~(sfix sym pam)) day) - =+ (cook |=(a/term [a ~]) sym) - ;~(pfix gap ;~(plug - day)) - :: - ++ man - %+ rail fail - %+ cook ~(gas by *(map term ^horn)) - =< ;~(sfix (star (sear . day)) gap duz) - |= a/^horn ^- (unit {term ^horn}) - ?+(-.a ~ $dub `[p.a q.a]) - :: - ++ now - %+ rail ;~((glue cab) mota day) - ;~(pfix gap ;~(plug mota day)) - :: - ++ saw - %+ rail - ;~(plug ;~(sfix wide:vez sem) day) - ;~(pfix gap ;~(plug tall:vez day)) - :: - ++ see - %+ rail - ;~(plug ;~(sfix hive col) day) - ;~(pfix gap ;~(plug hive day)) - :: - ++ sic - %+ rail - ;~(plug ;~(sfix wide:vez ket) day) - ;~(pfix gap ;~(plug tall:vez day)) - :: - ++ toy ;~(plug ;~(pose (cold | zap) (easy &)) sym) - -- - :: - -- - -- - :: - ++ join - |= {cof/cafe for/mark kas/silk kos/silk} - ^- (bolt gage) - %. [cof kas kos] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope (make cof p) flay)) - |=({cof/cafe p/silk q/silk} (cope (make cof q) flay)) - == - |= {cof/cafe cay/cage coy/cage} ^- (bolt gage) - :: - %+ cope (fang cof for) - |= {cof/cafe pro/vase} - ?. (slab %grad p.pro) - (flaw cof leaf+"no ++grad" ~) - =+ gar=(slap pro [%limb %grad]) - ?@ q.gar - =+ too=((sand %tas) q.gar) - ?~ too (flaw cof leaf+"bad mark ++grad" ~) - (make cof %join u.too [%$ cay] [%$ coy]) - ?. (slab %form p.gar) - (flaw cof leaf+"no ++form:grad" ~) - =+ fom=((soft @tas) q:(slap gar [%limb %form])) - ?~ fom - (flaw cof leaf+"bad ++form:grad" ~) - ?. &(=(u.fom p.cay) =(u.fom p.coy)) - %+ flaw cof :_ :_ ~ - leaf+"join on data of bad marks: {(trip p.cay)} {(trip p.coy)}" - leaf+"expected mark {(trip u.fom)}" - ?: =(q.q.cay q.q.coy) - (fine cof [%& cay]) - ?. (slab %join p.gar) - (flaw cof leaf+"no ++join:grad" ~) - %+ cope - %^ maul cof - (slap (slap pro [%limb %grad]) [%limb %join]) - (slop q.cay q.coy) - |= {cof/cafe dif/vase} - ?@ q.dif - (fine cof [%& %null dif]) - (fine cof [%& u.fom (slot 3 dif)]) - == - :: - ++ mash - |= {cof/cafe for/mark mas/milk mos/milk} - ^- (bolt gage) - %. [cof r.mas r.mos] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope (make cof p) flay)) - |=({cof/cafe p/silk q/silk} (cope (make cof q) flay)) - == - |= {cof/cafe cay/cage coy/cage} ^- (bolt gage) - %+ cope (fang cof for) - |= {cof/cafe pro/vase} - ?. (slab %grad p.pro) - (flaw cof leaf+"no ++grad" ~) - =+ gar=(slap pro [%limb %grad]) - ?@ q.gar - =+ too=((sand %tas) q.gar) - ?~ too (flaw cof leaf+"bad mark ++grad" ~) - %+ make cof - `silk`[%mash u.too [p.mas q.mas [%$ cay]] [p.mos q.mos [%$ coy]]] - ?. (slab %form p.gar) - (flaw cof leaf+"no ++form:grad" ~) - =+ fom=((soft @tas) q:(slap gar [%limb %form])) - ?~ fom - (flaw cof leaf+"bad ++form:grad" ~) - ?. &(=(u.fom p.cay) =(u.fom p.coy)) - %+ flaw cof :_ :_ ~ - leaf+"mash on data of bad marks: {(trip p.cay)} {(trip p.coy)}" - leaf+"expected mark {(trip u.fom)}" - ?: =(q.q.cay q.q.coy) - (fine cof %& cay) - ?. (slab %mash p.gar) - (fine cof %& %null [%atom %n ~] ~) - %+ cope - %^ maul cof - (slap (slap pro [%limb %grad]) [%limb %mash]) - %+ slop - :(slop [[%atom %p ~] p.mas] [[%atom %tas ~] q.mas] q.cay) - :(slop [[%atom %p ~] p.mos] [[%atom %tas ~] q.mos] q.coy) - (flux |=(dif/vase [%& u.fom dif])) - == - :: - ++ kale :: mutate - |= {cof/cafe kas/silk muy/(list (pair wing silk))} - ^- (bolt gage) - %+ cope - |- ^- (bolt (list (pair wing vase))) - ?~ muy (flue cof) - %+ cope (cope (make cof q.i.muy) flay) - |= {cof/cafe cay/cage} - %+ cope ^$(muy t.muy) - |= {cof/cafe rex/(list (pair wing vase))} - (fine cof [[p.i.muy q.cay] rex]) - |= {cof/cafe yom/(list (pair wing vase))} - %+ cope (make cof kas) - %- tabl-run - |= {cof/cafe cay/cage} - %+ cope (keel cof q.cay yom) - (flux |=(vax/vase [%& p.cay vax])) - :: - ++ keel :: apply mutations - |= {cof/cafe suh/vase yom/(list (pair wing vase))} - ^- (bolt vase) - %+ cool - =< |. ^- tank - :+ %palm [" " ~ ~ ~] - ~[leaf+"ford: keel" rose+[" " ~ ~]^(murn yom +)] - |= {a/wing b/span *} ^- (unit tank) - =+ typ=(mule |.(p:(slap suh wing+a))) - ?: ?=($| -.typ) - (some (show [%c %pull] %l a)) - ?: (~(nest ut p.typ) | b) ~ - %^ some %palm ["." ~ ~ ~] - ~[(show [%c %mute] %l a) >[p.typ b]<] - %^ maim cof - %+ slop suh - |- ^- vase - ?~ yom [[%atom %n ~] ~] - (slop q.i.yom $(yom t.yom)) - ^- twig - :+ %cncb [%& 2]~ - =+ axe=3 - |- ^- (list (pair wing twig)) - ?~ yom ~ - :- [p.i.yom [%$ (peg axe 2)]] - $(yom t.yom, axe (peg axe 3)) - :: - ++ lads :: possible children - |= {cof/cafe bem/beam} - ^- (bolt (map knot $~)) - %^ lash cof bem - |= {cof/cafe dir/knot} - %+ cope (lend cof bem(s [dir s.bem])) - (flux |=(a/arch ?~(dir.a ~ (some ~)))) - :: - ++ laze :: find real or virtual - |= {cof/cafe bem/beam} - %^ lash cof bem - |= {cof/cafe for/mark} - ^- (bolt (unit $~)) - ?. ((sane %tas) for) (flue cof) - =. s.bem [for s.bem] - %+ cope (lend cof bem) - |= {cof/cafe arc/arch} - (fine cof (bind fil.arc $~)) - :: - ++ lace :: load file - |= {cof/cafe for/mark bem/beam} - ^- (bolt vase) - %+ cool |.(leaf+"ford: load {} {<(en-beam bem)>}") - =. s.bem [for s.bem] - %+ cope (liar cof bem) - |= {cof/cafe cay/cage} ^- (bolt vase) - ?. =(for p.cay) - (flaw cof leaf+"unexpected mark {}" ~) - (fine cof q.cay) - :: - ++ lake :: check+coerce - |= {fit/? for/mark} - |= {cof/cafe sam/vase} - ^- (bolt vase) - %+ cool |.(leaf+"ford: check {<[for bek `@p`(mug q.sam)]>}") - %+ cope (fang cof for) - |= {cof/cafe tux/vase} - =+ typ=p:(slot 6 tux) - =. typ ?+(-.typ typ $face q.typ) - ?: (~(nest ut typ) | p.sam) - (fine cof typ q.sam) - ?. fit (flaw cof [%leaf "ford: invalid type: {}"]~) - ?. (slob %grab p.tux) - (flaw cof [%leaf "ford: no grab: {<[for bek]>}"]~) - =+ gab=(slap tux [%limb %grab]) - ?. (slob %noun p.gab) - (flaw cof [%leaf "ford: no noun: {<[for bek]>}"]~) - %+ cope (maul cof (slap gab [%limb %noun]) [%noun q.sam]) - |= {cof/cafe pro/vase} - ?> (~(nest ut typ) | p.pro) - ?: =(q.pro q.sam) - (fine cof typ q.pro) - (flaw cof [%leaf "ford: invalid content: {<[for bek]>}"]~) - :: - ++ lamp :: normalize version - |= {cof/cafe bem/beam} - ^- (bolt beam) - ?: ?=($ud -.r.bem) (fine cof bem) - =+ von=(syve [151 %noun] ~ %cw bem(s ~)) - ?~ von [p=cof q=[%1 [%c %w bem ~] ~ ~]] - (fine cof bem(r [%ud ((hard @) +.+:(need u.von))])) - :: - ++ lane :: span infer - |= {cof/cafe typ/span gen/twig} - %+ (cowl cof) (mule |.((~(play ut typ) gen))) - |=(ref/span ref) - :: - ++ lash :: filter at beam - |* {cof/cafe bem/beam fun/(burg knot (unit))} - %+ cope (lend cof bem) - |=({cof/cafe arc/arch} ((some-in-map fun) cof dir.arc)) - :: - ++ lear :: load core - |= {cof/cafe bem/beam} ^- (bolt vase) - %+ cope (lamp cof bem) - |= {cof/cafe bem/beam} - (leap cof many+~ bem bem) - :: - ++ leap :: XX load with path - ~/ %leap - |= {cof/cafe arg/coin bem/beam bom/beam} - %+ cope (lamp cof bem) - |= {cof/cafe bem/beam} - %+ (clef %boil) (fine cof arg bem bom) - |= {cof/cafe arg/coin bem/beam bom/beam} - %+ cope (fame cof bem) - |= {cof/cafe bem/beam} - (cope (fade cof bem) abut:(meow bom arg)) - :: - ++ lend :: load arch - |= {cof/cafe bem/beam} - ^- (bolt arch) - =+ von=(syve [151 %noun] ~ %cy bem) - ?~ von [p=cof q=[%1 [%c %y bem ~] ~ ~]] - ?> ?=({$~ $arch ^} u.von) - =+ arc=((hard arch) q.q.u.u.von) - %+ cope (lamp cof bem) - |= {cof/cafe bem/beam} - (flag bem (fine cof arc)) - :: - ++ liar :: load cage - ~/ %liar - |= {cof/cafe bem/beam} - ^- (bolt cage) - ?: =([%ud 0] r.bem) - (flaw cof [leaf+"ford: no data: {<(en-beam bem(s ~))>}"]~) - =+ von=(syve [151 %noun] ~ %cx bem) - ?~ von - [p=cof q=[%1 [[%c %x bem ~] ~ ~]]] - ?~ u.von - (flaw cof leaf+"file not found" (smyt (en-beam bem)) ~) - (fine cof u.u.von) - :: - ++ lily - ~/ %lily - |= {cof/cafe for/mark} ^- (bolt (set @tas)) - %+ cope (coop (fang cof for) |=(cof/cafe (fine cof %void ~))) - %- flux - |= vax/vase ^- (set mark) - %- =- ~(gas in `(set mark)`-) - ?. (slob %bcsm p.vax) ~ - (silt (sloe p:(slap vax [%limb %bcsm]))) - ?. (slob %garb p.vax) ~ - =+ (slap vax [%limb %garb]) - (fall ((soft (list mark)) q) ~) - :: - ++ lima :: load at depth - ~/ %lima - |= {cof/cafe for/mark bem/beam} - %+ (clef %bake) (flag bem (fine cof for bem)) - |= {cof/cafe for/mark bem/beam} - ^- (bolt (unit vase)) - %+ cope (laze cof bem) - |= {cof/cafe mal/(map mark $~)} - ?: (~(has by mal) for) - (cope (lace cof for bem) (flux some)) - =+ opt=(silt (turn (~(tap by mal)) head)) :: XX asymptotics - %+ cope (lion cof for opt) - |= {cof/cafe wuy/(list @tas)} - ?~ wuy (flue cof) - %+ cope - (lace cof i.wuy bem) - |= {cof/cafe hoc/vase} - (cope (lope cof i.wuy t.wuy hoc) (flux some)) - :: - ++ lime :: load beam - |= {cof/cafe for/mark arg/coin bem/beam} - ^- (bolt vase) - %+ coop (leap cof arg [-.bem /[for]/ren] bem) - |= cof/cafe ^- (bolt vase) - %+ cope (lima cof for bem) - |= {cof/cafe vux/(unit vase)} - ?^ vux (fine cof u.vux) - (flaw cof leaf+"ford: no {} at {<(en-beam bem)>}" ~) - :: - ++ link :: translate - ~/ %link - |= {cof/cafe too/mark for/mark vax/vase} - =* link-jet . - :: ~$ link - ^- (bolt vase) - :: %+ cool |.(leaf+"ford: link {} {} {}") - ?: =(too for) (fine cof vax) - ?: |(=(%noun for) =(%$ for)) - ((lake & too) cof vax) - %+ cope (fang cof for) - |= {cof/cafe pro/vase} ^- (bolt vase) - ?: :: =< $ ~% %limb-grow link-jet ~ |. - &((slob %bcsm p.pro) (slob too p:(slap pro [%limb %bcsm]))) - :: ~$ link-grow - :: =< $ ~% %bcsm link-jet ~ |. - %+ cope (keel cof pro [[%& 6]~ vax]~) - |= {cof/cafe pox/vase} - (maim cof pox [%per [%limb %bcsm] [%limb too]]) - %+ cope (fang cof too) - ~% %grab link-jet ~ - |= {cof/cafe pro/vase} - =+ :: =< $ ~% %limb-grab + ~ |. - ^= zat ^- (unit vase) - ?. (slob %grab p.pro) ~ - =+ gab=(slap pro [%limb %grab]) - ?. (slob for p.gab) ~ - `(slap gab [%limb for]) - ?~ zat - :: ~$ link-miss - (flaw cof [%leaf "ford: no link: {<[for too]>}"]~) - :: ~$ link-grab - ~| [%link-maul for too] - (maul cof u.zat vax) - :: - ++ lion :: translation search - ~/ %lion - |= {cof/cafe too/mark fro/(set mark)} - =* lion-jet . - :: ~& lion+[too=too fro=fro] - :: =- =+ (cope - (flux |=(a/(list mark) ~&(lioned+a ~)))) - :: +< - ^- (bolt (list mark)) - =- %+ coop (gro cof too ~ ~) :: XX better grab layer - ~% %grab lion-jet ~ - |= cof/cafe - %+ cope (fang cof too) - |= {cof/cafe vax/vase} ^- (bolt (list mark)) - ?. (slob %grab p.vax) (flue cof) - %+ cope - (gro cof (silt (sloe p:(slap vax [%limb %grab])))) - (flux |=(a/path (welp a /[too]))) - ^= gro - |= {cof/cafe tag/(set mark)} - =| $: war/(map mark (list mark)) - pax/(list mark) - won/{p/mark q/(qeu mark)} - == - %. [cof fro] - |= {cof/cafe fro/(set mark)} ^- (bolt (list mark)) - ?: (~(has in tag) p.won) - (fine cof (flop pax)) - =+ for=(skip (~(tap by fro)) ~(has by war)) - =. for (sort for aor) :: XX useful? - =: q.won (~(gas to q.won) for) - war (~(gas by war) (turn for |=(mark [+< pax]))) - == - ?: =(~ q.won) - (flue cof) - =. won ~(get to q.won) - %+ cope (lily cof p.won) - ..$(pax [p.won (~(got by war) p.won)]) - :: - ++ lope :: translation pipe - |= {cof/cafe for/mark yaw/(list mark) vax/vase} - ^- (bolt vase) - ?~ yaw (fine cof vax) - %+ cope (link cof i.yaw for vax) - |= {cof/cafe yed/vase} - ^$(cof cof, for i.yaw, yaw t.yaw, vax yed) - :: - ++ mail :: cached mint - ~/ %mail - |= {cof/cafe sut/span gen/twig} - ^- (bolt (pair span nock)) - %+ (clef %slim) (fine cof sut gen) - |= {cof/cafe sut/span gen/twig} - =+ puz=(mule |.((~(mint ut sut) [%noun gen]))) - ?- -.puz - $| (flaw cof p.puz) - $& (fine cof p.puz) - == - :: - ++ maim :: slap - ~/ %maim - |= {cof/cafe vax/vase gen/twig} - ^- (bolt vase) - %+ cope (mail cof p.vax gen) - |= {cof/cafe typ/span fol/nock} - %+ (coup cof) (mock [q.vax fol] (sloy:error:userlib syve)) - |=(val/* `vase`[typ val]) - :: - ++ make-norm-bek :: normalize root beak - |= {cof/cafe kas/silk} - %+ cope (lamp cof bek ~) - |=({cof/cafe byk/beak *} (make(bek byk) cof kas)) - :: - ++ abbrev :: shorten coin - |=(a/coin ?-(-.a $$ a, $blob a(p (mug p.a)), $many a(p (turn p.a ..$)))) - :: - ++ make :: reduce silk - |= {cof/cafe kas/silk} - :: =+ ^= pre - :: ?+ -.kas `term`-.kas - :: ^ %cell - :: $bake [-.kas p.kas (en-beam r.kas) ~(rent co (abbrev q.kas))] - :: $core [-.kas (en-beam p.kas)] - :: == - :: ~? !=(%$ pre) [dyv `term`(cat 3 %make (fil 3 dyv ' ')) pre] - :: =- ~? !=(%$ pre) [dyv `term`(cat 3 %made (fil 3 dyv ' ')) pre] - - =. dyv +(dyv) - ^- (bolt gage) - ?- -.kas - ^ - %. [cof p.kas q.kas] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope ^$(cof cof, kas p.kas) flay)) - |=({cof/cafe p/silk q/silk} (cope ^$(cof cof, kas q.kas) flay)) - == :: XX merge %tabl - :: - |= {cof/cafe bor/cage heg/cage} ^- (bolt gage) - (faun cof (slop q.bor q.heg)) - == - :: - $$ (fine cof %& p.kas) - $alts - %. cof - |= cof/cafe ^- (bolt gage) - ?~ p.kas (flaw cof leaf+"ford: out of options" ~) - (coop ^$(cof cof, kas i.p.kas) ..$(p.kas t.p.kas)) - :: - $bake - ^- (bolt gage) - %+ cool - |.(leaf+"ford: bake {} {<(en-beam r.kas)>} {~(rend co q.kas)}") - %+ cope (lamp cof r.kas) - |= {cof/cafe bem/beam} - %+ cope (lime cof p.kas q.kas bem) - |= {cof/cafe vax/vase} - (fine cof `gage`[%& p.kas vax]) - :: - $bunt - %+ cool |.(leaf+"ford: bunt {}") - %+ cope (fang cof p.kas) - |= {cof/cafe tux/vase} - =+ [typ=p val=q]:(slot 6 tux) - =. typ ?+(-.typ typ $face q.typ) - (fine cof [%& p.kas [typ val]]) - :: - $cnhp - :: %+ cool |.(leaf+"ford: call {<`@p`(mug kas)>}") - %. [cof p.kas q.kas] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope ^$(cof cof, kas p) flay)) - |=({cof/cafe p/silk q/silk} ^$(cof cof, kas q)) - == - :: - |= {cof/cafe gat/cage sam/gage} - %. [cof sam] - %- tabl-run - |= {cof/cafe sam/cage} - (cope (maul cof q.gat q.sam) faun) - == - :: - $kthp - %+ cool |.(leaf+"ford: cast {}") - %+ cope $(kas q.kas) - %- tabl-run - |= {cof/cafe cay/cage} - :: ~$ make-cast - :: ~> %live. :: ~$(make-cast-{to}--{from} ~) - :: (rap 3 %make-cast- p.kas '--' p.cay ~) - ^- (bolt gage) - %+ cool |.(leaf+"ford: casting {} to {}") - %+ cope (lion cof p.kas p.cay `~) - |= {cof/cafe wuy/(list @tas)} - %+ cope - ?~ wuy - (link cof p.kas p.cay q.cay) - (lope cof i.wuy t.wuy q.cay) - (flux |=(vax/vase [%& p.kas vax])) - :: - $core - %+ cool |.(leaf+"ford: core {<(en-beam p.kas)>}") - :: code runtime behaviour is frequently affected by marks - :: TODO: track this more formally - %+ flag [bek /mar] - :: until /? is in use, any hoon may implicitly depend on arvo types - %+ flag [bek /arvo/hoon] - %+ flag [bek /arvo/zuse] - (cope (lear cof p.kas) (flux |=(a/vase [%& %core a]))) - :: - $diff - %+ cool |.(leaf+"ford: diff {<`@p`(mug p.kas)>} {<`@p`(mug q.kas)>}") - (diff cof p.kas q.kas) - :: - $dude (cool p.kas $(kas q.kas)) - $file - %+ cool |.(leaf+"ford: file {}") - %+ cope (liar cof p.kas) - (flux |=(cay/cage [%& cay])) - :: - $flag - =+ rez=$(kas q.kas) - ?: ?=($1 -.q.rez) rez - =- rez(p.q -) - |- ^- (set beam) - ?~ p.kas p.q.rez - =. p.q.rez $(p.kas l.p.kas) - =. p.q.rez $(p.kas r.p.kas) - ?^ n.p.kas - (~(put in p.q.rez) n.p.kas) - =+ dap=(~(get by deh.bay) n.p.kas) - ?~ dap ~&(flag-missed+n.p.kas p.q.rez) - %- ~(uni in p.q.rez) ^- (set beam) - ?-(-.u.dap $init p.u.dap, $sent q.u.dap, $done [[bek ~] ~ ~]) - :: XX revisit ^ during dependency review - $join - %+ cool - |. - leaf+"ford: join {} {<`@p`(mug q.kas)>} {<`@p`(mug r.kas)>}" - (join cof p.kas q.kas r.kas) - :: - $mash - %+ cool - |. - leaf+"ford: mash {} {<`@p`(mug q.kas)>} {<`@p`(mug r.kas)>}" - (mash cof p.kas q.kas r.kas) - :: - $mute (kale cof p.kas q.kas) - $pact - %+ cool |.(leaf+"ford: pact {<`@p`(mug p.kas)>} {<`@p`(mug q.kas)>}") - (pact cof p.kas q.kas) - :: - $plan (cope (abut:(meow p.kas q.kas) cof r.kas) faun) - $reef (faun cof pit) - $ride - %+ cool |.(leaf+"ford: build failed {}") - %+ cope $(kas q.kas) - %- tabl-run - |= {cof/cafe cay/cage} - %+ cope (maim cof q.cay p.kas) - |= {cof/cafe vax/vase} - (faun cof vax) - :: - $tabl - %+ cope - |- ^- (bolt (list (pair gage gage))) - ?~ p.kas (fine cof ~) - %. [cof p.kas] - ;~ cope - ;~ coax - |=({cof/cafe _p.kas} (fret ^^$(cof cof, kas p.i))) - |=({cof/cafe _p.kas} (fret ^^$(cof cof, kas q.i))) - |=({cof/cafe _p.kas} ^$(cof cof, p.kas t)) - == - (flux |=({k/gage v/gage t/(list {gage gage})} [[k v] t])) - == - (flux |=(rex/(list (pair gage gage)) [%tabl rex])) - :: - $vale - %+ cool |.(leaf+"ford: vale {} {<`@p`(mug q.kas)>}") - %+ cope ((lake & p.kas) cof [%noun q.kas]) - (flux |=(vax/vase `gage`[%& p.kas vax])) - :: - $volt - %+ cool |.(leaf+"ford: volt {}") - %+ cope $(kas [%bunt p.p.kas]) - %- tabl-run - |= {cof/cafe cay/cage} - ^- (bolt gage) - (fine cof [%& p.p.kas p.q.cay q.p.kas]) - == - :: - ++ malt :: cached slit - ~/ %slit - |= {cof/cafe gat/span sam/span} - ^- (bolt span) - %+ (clef %slit) (fine cof gat sam) - |= {cof/cafe gat/span sam/span} - %+ cool |.(%.(%have ~(dunk ut sam))) - %+ cool |.(%.(%want ~(dunk ut (~(peek ut gat) %free 6)))) - =+ top=(mule |.((slit gat sam))) - ?- -.top - $| (flaw cof p.top) - $& (fine cof p.top) - == - :: - ++ maul :: slam - ~/ %maul - |= {cof/cafe gat/vase sam/vase} - ^- (bolt vase) - %+ cope (malt cof p.gat p.sam) - |= {cof/cafe typ/span} - %+ (coup cof) (mong [q.gat q.sam] (sloy:error:userlib syve)) - |=(val/* `vase`[typ val]) - :: - ++ meow :: assemble - :: =+ dyv=0 - |= {how/beam arg/coin} - =| $: rop/(map term (pair hoof twig)) :: structures - bil/(map term (pair hoof twig)) :: libraries - boy/(list twig) :: body stack - lit/? :: drop arguments - == - ~% %meow ..meow ~ - |% - ++ able :: assemble preamble - ^- twig - :+ %per - ?: =(~ rop) - [%$ 1] - :+ %brcn [~ ~] - =- [[0 [~ ~] -] ~ ~] - (~(run by rop) |=({^ a/twig} [~ %ash a])) - ?: =(~ bil) - [%$ 1] - :+ %brcn [~ ~] - =- [[0 [~ ~] -] ~ ~] - (~(run by bil) |=({^ a/twig} [~ %ash a])) - :: - ++ abut :: generate - |= {cof/cafe hyd/hood} - ^- (bolt vase) - %+ cope (apex cof hyd) - |= {cof/cafe sel/_..abut} - =. ..abut sel - %+ cope (maim cof pit able) - |= {cof/cafe bax/vase} - %+ cope (chap cof bax [%fan fan.hyd]) - |= {cof/cafe mar/mark gox/vase} - %+ cope (maim cof (slop gox bax) [%tow (flop boy)]) - |= {cof/cafe fin/vase} - (fine cof fin) - :: ~> %slog.[0 ~(duck ut p.q.cay)] - :: - ++ apex :: build to body - |= {cof/cafe hyd/hood} - ^- (bolt _..apex) - %+ cope (body cof src.hyd) - ::=. dyv +(dyv) - ::~& [`term`(cat 3 %apex (fil 4 dyv ' ')) `path`(flop s.how) libs] - ::=- ~& [`term`(cat 3 %xepa (fil 4 dyv ' ')) `path`(flop s.how)] - - |= {cof/cafe sel/_..apex} - =. ..apex sel - %+ cope (neck cof lib.hyd) - |= {cof/cafe sel/_..apex} - =. ..apex sel(boy boy) - %+ cope (head cof sur.hyd) - |= {cof/cafe sel/_..apex} - (fine cof sel) - :: - ++ body :: produce functions - |= {cof/cafe src/(list hoop)} - ^- (bolt _..body) - ?~ src (fine cof ..body) - %+ cope (wilt cof i.src) - |= {cof/cafe sel/_..body} - ^$(src t.src, ..body sel, cof cof) - :: - :: ++ libs `(set term)`(silt (turn (~(tap by bil)) head.is)) - ++ chad :: atomic list - |= {cof/cafe bax/vase doe/term hon/horn} - ^- (bolt vase) - %+ cope (lash cof how (flux (slat doe))) - |= {cof/cafe yep/(map knot @)} - =+ ^= poy ^- (list (pair knot @)) - %+ sort (~(tap by yep) ~) - |=({{* a/@} {* b/@}} (lth a b)) - %+ cope - |- ^- (bolt (list (pair @ vase))) - ?~ poy (flue cof) - %+ cope $(poy t.poy) - |= {cof/cafe nex/(list (pair @ vase))} - %+ cope (chap(s.how [p.i.poy s.how]) cof bax hon) - (flux |=({mar/mark elt/vase} [[q.i.poy elt] nex])) - %- flux - |= yal/(list (pair @ vase)) ^- vase - ?~ yal [[%atom %n `~] 0] - (slop (slop [[%atom doe ~] p.i.yal] q.i.yal) $(yal t.yal)) - :: - ++ chai :: atomic map - |= {cof/cafe bax/vase hon/horn} - ^- (bolt vase) - %+ cope - %+ cope (lads cof how) - %- some-in-map - |= {cof/cafe dir/knot} - =+ nod=(chap(s.how [dir s.how]) cof bax hon) - ?: ?=($2 -.q.nod) - (flue cof) - (cope nod (flux some)) - %- flux - |= doy/(map @ cage) ^- vase - ?~ doy [[%atom %n `0] 0] - %+ slop - (slop [[%atom %ta ~] p.n.doy] q.q.n.doy) - (slop $(doy l.doy) $(doy r.doy)) - :: - ++ chap :: produce resources - |= {cof/cafe bax/vase hon/horn} - ^- (bolt cage) - ?- -.hon - $ape (cope (maim cof bax p.hon) (flux |=(a/vase [%noun a]))) - $arg - %+ cope (maim cof bax p.hon) - |= {cof/cafe gat/vase} - %+ cope (maim cof !>(~) ((jock |) arg)) - |= {cof/cafe val/vase} - %+ cope (maul cof gat (slop !>(how) val)) - (flux |=(a/vase noun+a)) - :: - $alt - %. cof - |= cof/cafe ^- (bolt cage) - ?~ p.hon (flaw cof leaf+"ford: out of options" ~) - (coop ^$(cof cof, hon i.p.hon) ..$(p.hon t.p.hon)) - :: - $dep - =+ [dep bot]=(clad $(hon p.hon)) :: XX review - %+ cope bot - %- flux - |= {mark vax/vase} - [%noun (slop [atom+['uvH' ~] dep] vax)] - :: - $dub - %+ cope $(hon q.hon) - %- flux - |= {mar/mark vax/vase} - [mar [%face [~ p.hon] p.vax] q.vax] - :: - $fan - %+ cope - %+ cope - |- ^- (bolt (list vase)) - ?~ p.hon (flue cof) - %+ cope ^$(cof cof, hon i.p.hon) - |= {cof/cafe mar/mark vax/vase} - %+ cope ^$(cof cof, p.hon t.p.hon) - (flux |=(tev/(list vase) [vax tev])) - |= {cof/cafe tev/(list vase)} - %+ fine cof - |- ^- vase - ?~ tev [[%atom %n `~] 0] - (slop i.tev $(tev t.tev)) - (flux |=(a/vase noun+a)) - :: - $for - =+ opt=|.(>(turn p.hon |=({a/path ^} a))<) - |- ^- (bolt cage) - ?~ p.hon (flaw cof leaf+"ford: no match" >(en-beam how)< *opt ~) - ?: =(p.i.p.hon (scag (lent p.i.p.hon) (flop s.how))) - ^$(hon q.i.p.hon) - $(p.hon t.p.hon) - :: - $hel $(hon p.hon, lit |) - $lin - %+ cope $(hon q.hon) - |= {cof/cafe cay/cage} ^- (bolt cage) - ?~ p.hon (fine cof cay) - %+ cope $(p.hon t.p.hon) - |= {cof/cafe cay/cage} - (cope (make cof %kthp i.p.hon $+cay) flay) - :: - $man - %+ cope - |- ^- (bolt vase) - ?~ p.hon (fine cof [[%atom %n `~] 0]) - %+ cope $(p.hon l.p.hon) - |= {cof/cafe lef/vase} - %+ cope ^$(cof cof, p.hon r.p.hon) - |= {cof/cafe rig/vase} - %+ cope ^^^$(cof cof, hon q.n.p.hon) - |= {cof/cafe mar/mark vax/vase} - %+ fine cof - %+ slop - (slop [[%atom %tas ~] p.n.p.hon] vax) - (slop lef rig) - (flux |=(a/vase noun+a)) - :: - $now - %+ cope (chad cof bax %da p.hon) - (flux |=(a/vase noun+a)) - :: - $nod - %+ cope (chad cof bax p.hon q.hon) - (flux |=(a/vase noun+a)) - :: - $nap - %+ cope (chai cof bax p.hon) - (flux |=(a/vase noun+a)) - :: - $saw - %+ cope $(hon q.hon) - |= {cof/cafe mar/mark sam/vase} - %+ cope (maim cof bax p.hon) - |= {cof/cafe gat/vase} - %+ cope (maul cof gat sam) - (flux |=(a/vase noun+a)) - :: - $see - =+ vez=(vang & (en-beam how)) - =+ tuz=(posh:vez p.hon) - ?~ tuz (flaw cof leaf+"bad tusk: {}" ~) - =+ pax=(plex:vez %clsg u.tuz) - ?~ pax (flaw cof leaf+"bad path: {}" ~) - =+ bem=(de-beam u.pax) - ?~ bem (flaw cof leaf+"bad beam: {}" ~) - $(hon q.hon, how u.bem) - :: - $sic - %+ cope $(hon q.hon) - |= {cof/cafe mar/mark vax/vase} - %+ cope (maim cof bax [%bunt p.hon]) - |= {cof/cafe tug/vase} - ?. (~(nest ut p.tug) | p.vax) - (flaw cof [%leaf "type error: {} {}"]~) - (fine cof [mar p.tug q.vax]) - :: - $toy - ?: p.hon - =? arg lit many+~ - (cope (make cof %bake q.hon arg how) flay) - %+ cool |.(leaf+"ford: hook {} {<(en-beam how)>}") - %+ cope (fade cof how) - |= {cof/cafe hyd/hood} - %+ cope (abut:(meow how arg) cof hyd) - ;~(cope (lake | q.hon) (flux |=(a/vase [q.hon a]))) - == - :: - ++ head :: consume structures - |= {cof/cafe bir/(list hoof)} - ^- (bolt _..head) - ?~ bir - (fine cof ..head) - =. boy - ?: p.i.bir boy - (welp boy [[%use [%limb q.i.bir] [%$ 1]] ~]) - =+ byf=(~(get by rop) q.i.bir) - ?^ byf - ?. =(+:`hoof`i.bir +:`hoof`p.u.byf) - (flaw cof [%leaf "structure mismatch: {<~[p.u.byf q.i.bir]>}"]~) - $(bir t.bir) - %+ cope (fame cof (hone %sur i.bir)) - |= {cof/cafe bem/beam} - %+ cope (fade cof bem) - |= {cof/cafe hyd/hood} - %+ cope (apex(how bem, boy ~) cof hyd) - |= {cof/cafe sel/_..head} - =. ..head - %= sel - boy boy - how how - rop %+ ~(put by (~(uni by rop) rop.sel)) - q.i.bir - [i.bir [%tow (flop boy.sel)]] - == - ^^^$(cof cof, bir t.bir) - :: - ++ hone :: plant hoof - |= {way/@tas huf/hoof} - ^- beam - ?~ r.huf - how(s ~[q.huf way]) - [[q.u.r.huf q.how p.u.r.huf] ~[q.huf way]] - :: - ++ neck :: consume libraries - |= {cof/cafe bir/(list hoof)} - ^- (bolt _..neck) - ?~ bir (fine cof ..neck) - =. boy - ?: p.i.bir boy -:: ~& ford+tscm+[q.i.bir boy] - (welp boy [[%use [%limb q.i.bir] [%$ 1]] ~]) - =+ byf=(~(get by bil) q.i.bir) - ?^ byf - ?. =(+:`hoof`i.bir +:`hoof`p.u.byf) - (flaw cof [%leaf "library mismatch: {<~[p.u.byf i.bir]>}"]~) - $(bir t.bir) - %+ cope (fame cof (hone %lib i.bir)) - |= {cof/cafe bem/beam} - %+ cope (fade cof bem) - |= {cof/cafe hyd/hood} - %+ cope (apex(how bem, boy ~) cof hyd) - |= {cof/cafe sel/_..neck} - =. ..neck - %= sel - how how - bil %+ ~(put by (~(uni by bil) bil.sel)) - q.i.bir - [i.bir [%tow (flop boy.sel)]] - == - ^^^$(cof cof, bir t.bir) - :: - ++ wilt :: process body entry - |= {cof/cafe hop/hoop} - ^- (bolt _..wilt) - ?- -.hop - $& (fine cof ..wilt(boy [p.hop boy])) - $| - =. r.p.hop ?:(?=({$ud $0} r.p.hop) r.how r.p.hop) - %+ cool |.(leaf+"ford: wilt {<[(en-beam p.hop)]>}") - %+ cope (lend cof p.hop) - |= {cof/cafe arc/arch} - ?: (~(has by dir.arc) %hoon) - %+ cope (fade cof p.hop) - |= {cof/cafe hyd/hood} - %+ cope (apex(boy ~) cof hyd) - (flux |=(sel/_..wilt sel(boy [[%tow boy.sel] boy]))) - =+ [all=(lark (slat %tas) arc) sel=..wilt] - %+ cope - |- ^- (bolt (pair (map term (pair what foot)) _..wilt)) - ?~ all (fine cof ~ ..wilt) - %+ cope $(all l.all) - |= {cof/cafe lef/(map term (pair what foot)) sel/_..wilt} - %+ cope ^$(all r.all, cof cof, sel sel) - |= {cof/cafe rig/(map term (pair what foot)) sel/_..wilt} - %+ cope - %= ^^^^$ - cof cof - ..wilt sel(boy ~) - s.p.hop [p.n.all s.p.hop] - == - |= {cof/cafe sel/_..wilt} - %+ fine cof - :_ sel - ^- (map term (pair what foot)) - [[p.n.all [~ %ash [%tow boy.sel]]] lef rig] - |= {cof/cafe mav/(map term (pair what foot)) sel/_..wilt} - ?~ mav - (flaw cof [%leaf "source missing: {<(en-beam p.hop)>}"]~) - (fine cof sel(boy [[%brcn [~ ~] [[0 [~ ~] mav] ~ ~]] boy])) - == - -- - :: - ++ pact-hoon :: .hoon special case - |= {a/@t b/(urge:clay cord)} ^- @t - ~| %lurk-hoon - =, format =, differ - (of-wain (lurk (to-wain a) b)) - :: - ++ pact :: patch - |= {cof/cafe kas/silk kos/silk} - ^- (bolt gage) - %. [cof kas kos] - ;~ cope - ;~ coax - |=({cof/cafe p/silk q/silk} (cope (make cof p) flay)) - |=({cof/cafe p/silk q/silk} (cope (make cof q) flay)) - == - |= {cof/cafe cay/cage coy/cage} ^- (bolt gage) - %+ cope (fang cof p.cay) - |= {cof/cafe pro/vase} - ?. (slab %grad p.pro) - (flaw cof leaf+"no ++grad" ~) - =+ gar=(slap pro [%limb %grad]) - ?@ q.gar - =+ for=((sand %tas) q.gar) - ?~ for (flaw cof leaf+"bad mark ++grad" ~) - (make cof `silk`[%kthp p.cay %pact [%kthp u.for %$ cay] %$ coy]) - ?. (slab %form p.gar) - (flaw cof leaf+"no ++form:grad" ~) - =+ for=((soft @tas) q:(slap gar [%limb %form])) - ?~ for - (flaw cof leaf+"bad ++form:grad" ~) - ?. =(u.for p.coy) - %+ flaw cof :_ ~ - =< leaf+"pact on data with wrong form: {-} {+<} {+>}" - [(trip p.cay) (trip u.for) (trip p.coy)] - ?. (slab %pact p.gar) - (flaw cof leaf+"no ++pact:grad" ~) - %+ cope (keel cof pro [[%& 6]~ q.cay]~) - |= {cof/cafe pox/vase} - %+ cope - %^ maul cof - (slap (slap pox [%limb %grad]) [%limb %pact]) - q.coy - (flux |=(pat/vase [%& p.cay pat])) - == - :: - ++ resp - |= {{van/vane ren/care:clay bem/beam} rot/riot:clay} - ^+ ..zo - ?> ?=($c van) - =. kig (~(del in kig) +<-.$) - ?~ rot - =^ dep deh.bay (daze ~ deh.bay) :: dependencies? - amok:(expo [%made dep %| (smyt ren (en-beam bem)) ~]) - =+ (cat 3 van ren) - exec(keg (~(put by keg) [- bem] r.u.rot)) - :: - ++ resd :: take %diff - |= {{van/vane ren/care:clay bem/beam} cag/cage} - ^+ ..zo - ?> ?=($g van) - ?: |(!?=($x ren) =(-.s.bem p.cag)) - =. kig (~(del in kig) +<-.$) - =. mow :_(mow [hen (cancel van ren bem)]) - =+ (cat 3 van ren) - exec(keg (~(put by keg) [- bem] cag)) - =. mow - :_ mow - :^ hen %pass (camp-wire van ren bem) - [%f %exec our ~ bek %kthp ((hard mark) -.s.bem) %$ cag] - ..zo - :: - ++ resm :: take %made - |= {{van/vane ren/care:clay bem/beam} dep/@uvH gag/gage} - ^+ ..zo - ?> ?=($g van) - =. kig (~(del in kig) +<-.$) - =. mow :_(mow [hen (cancel van ren bem)]) - ?: ?=($| -.gag) - amok:(expo [%made dep %| leaf+"ford-scry-made-fail" p.gag]) - ?: ?=($tabl -.gag) - amok:(expo [%made dep %| leaf+"ford-scry-made-strange" ~]) - =+ (cat 3 van ren) - exec(keg (~(put by keg) [- bem] p.gag)) - :: - ++ syve - ^- sley - |= {ref/* sec/(unit (set monk)) tem/term bem/beam} - ^- (unit (unit cage)) - ?> =(%151 -.ref) - %- %- lift |= (unit cage) :: ignore block - %+ biff +< - |= cay/cage ^- (unit cage) - ?. -:(nets:wa +.ref `span`p.q.cay) :: error if bad type - ~& :^ %ford-syve-lost `path`[tem (en-beam bem)] - want=;;(span +.ref) - have=p.q.cay - ~ - `cay - ^- (unit (unit cage)) - =+ (~(get by keg) tem bem) - ?^ - - (some -) - (ska +<.$) - -- - -- -:: --- -. == -=| axle -=* lex - -|= {now/@da eny/@ ski/sley} :: activate -^? :: opaque core -~% %ford-d ..ship ~ -|% :: -++ call :: request - |= {hen/duct hic/(hypo (hobo task:able))} - ^+ [p=*(list move) q=..^$] - => .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard task:able) p.q.hic))) - ?: ?=($wegh -.q.hic) - :_ ..^$ :_ ~ - :^ hen %give %mass - :- %ford - :- %| - %- |= a/(list (list mass)) ^- (list mass) :: XX single-home - =+ a2=a - ?~ a !! - ?~ i.a ~ - :_ $(a (turn a2 tail)) - :- p.i.i.a - ?~ -.q.i.i.a - [%& (turn (turn a2 head) |=(b/mass ?~(-.q.b p.q.b !!)))] - [%| $(a (turn (turn a2 head) |=(b/mass ?~(-.q.b !! p.q.b))))] - %+ turn (~(tap by pol)) - |= {@ baby} - :~ =< cache+[%| (turn `(list term)`/hood/bake/slit/slim/slap/slam .)] - =- |=(a/term [a %& (~(get ja dep) a)]) - =< `dep/(jar term *)`(~(rep by jav) .) - |=({{* a/{term *}} b/(jar term *)} (~(add ja b) -.a +.a)) - :: - =< depends+[%| (turn `(list term)`/init/sent/done .)] - =- |=(a/term [a %& (~(get ja dep) a)]) - =< `dep/(jar term *)`(~(rep by deh) .) - |=({{@ a/{term *}} b/(jar term *)} (~(add ja b) -.a +.a)) - :: - tasks+[%& dym tad] - == - =+ our=p.q.hic - =+ ^= bay ^- baby - =+ buy=(~(get by pol.lex) our) - ?~(buy *baby u.buy) - =^ mos bay - ?- -.q.hic - $wipe ~&(%ford-cache-wiped [~ bay(jav ~)]) - $wasp - abet:(~(awap za [our hen [now eny ski] ~] bay) q.q.hic) - $exec - ?~ q.q.hic - abet:~(apax za [our hen [now eny ski] ~] bay) - abet:(~(apex za [our hen [now eny ski] ~] bay) u.q.q.hic) - == - [mos ..^$(pol (~(put by pol) our bay))] -:: -++ doze - |= {now/@da hen/duct} - ^- (unit @da) - ~ -:: -++ load :: highly forgiving - :: |=(old/axle ..^$(+>- old)) - ::=. old - :: ?. ?=([%0 *] old) old :: remove at 1 - :: :- %1 - :: |- ^- * - :: ?~ +.old ~ - :: ?> ?=([n=[p=* q=[tad=* dym=* deh=* jav=*]] l=* r=*] +.old) - :: :- [p.n.+.old [tad.q.n.+.old dym.q.n.+.old deh.q.n.+.old ~]] - :: [$(+.old l.+.old) $(+.old r.+.old)] - |= old/* - =+ lox=((soft axle) old) - ^+ ..^$ - ?~ lox - ~& %ford-reset - ..^$ - ..^$(+>- u.lox) -:: -++ scry - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) - [~ ~] -:: -++ stay :: save w+o cache - `axle`+>-.$(pol (~(run by pol) |=(a/baby [tad.a dym.a deh.a ~]))) -:: -++ take :: response - |= {tea/wire hen/duct hin/(hypo sign)} - ^+ [p=*(list move) q=..^$] - ?> ?=({@ @ *} tea) - =+ our=(slav %p i.tea) - =+ bay=(~(got by pol.lex) our) - =^ mos bay - =+ dep=(slaw %uv i.t.tea) - ?^ dep - =+ bem=(need (de-beam t.t.tea)) - abet:(~(axun za [our hen [now eny ski] ~] bay) tea u.dep bem q.hin) - ?> ?=({@ @ ^} t.t.tea) - =+ :* num=(slav %ud i.t.tea) - van=((hard vane) i.t.t.tea) - ren=((hard care:clay) i.t.t.t.tea) - bem=(need (de-beam t.t.t.t.tea)) - == - abet:(~(axon za [our hen [now eny ski] ~] bay) num [van ren bem] q.hin) - [mos ..^$(pol (~(put by pol) our bay))] --- diff --git a/neo/van/gall.hoon b/neo/van/gall.hoon deleted file mode 100644 index cec2cf319..000000000 --- a/neo/van/gall.hoon +++ /dev/null @@ -1,1327 +0,0 @@ -:: :: %gall, agent execution -!? 163 -:::: -|= pit/vase -=> =~ -=, gall -|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: rest of arvo - :::::::::::::::::::::::::::::::::::::::::::::::::::::: -++ volt ?($low $high) :: voltage -++ torc $@(?($ktbr $gold) {$ktwt p/ship}) :: security control -++ roon :: reverse ames msg - $% {$d p/mark q/*} :: diff (diff) - {$x $~} :: - == :: -++ rook :: forward ames msg - $% {$m p/mark q/*} :: message - {$s p/path} :: subscribe - {$u $~} :: cancel+unsubscribe - == :: --- :: -|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: local arvo - :::::::::::::::::::::::::::::::::::::::::::::::::::::: -++ cote :: ++ap note - $% {$meta p/@tas q/vase} :: - {$send p/ship q/cush} :: - {$hiss p/(unit knot) q/mark r/cage} :: - == :: -++ cove (pair bone (wind cote cuft)) :: internal move -++ move {p/duct q/(wind note-arvo gift:able)} :: typed move --- :: -|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: %gall state - :::::::::::::::::::::::::::::::::::::::::::::::::::::: -++ axle-n ?(axle axle-1) :: upgrade path -++ axle-1 {$1 pol/(map ship mast-1)} :: -++ mast-1 :: - (cork mast |=(mast +<(bum (~(run by bum) seat-1)))) :: -++ seat-1 :: - (cork seat |=(seat +<+)) :: -++ axle :: all state - $: $2 :: state version - pol/(map ship mast) :: apps by ship - == :: -++ gest :: subscriber data - $: sup/bitt :: incoming subscribers - neb/boat :: outgoing subscribers - qel/(map bone @ud) :: queue meter - == :: -++ mast :: ship state - $: sys/duct :: system duct - sap/(map ship scar) :: foreign contacts - bum/(map dude seat) :: running agents - wub/(map dude sofa) :: waiting queue - == :: -++ ffuc :: new cuff - $: p/(unit (set ship)) :: disclosing to - q/ship :: attributed to - == :: -++ prey (pair volt ffuc) :: privilege -++ scar :: opaque input - $: p/@ud :: bone sequence - q/(map duct bone) :: by duct - r/(map bone duct) :: by bone - == :: -++ seat :: agent state - $: vel/worm :: cache - mom/duct :: control duct - liv/? :: unstopped - toc/torc :: privilege - tyc/stic :: statistics - ged/gest :: subscribers - hav/vase :: running state - byk/beak :: update control - pyl/(map bone mark) :: req'd translations - zam/scar :: opaque ducts - == :: -++ sofa :: queue for blocked - $: kys/(qeu (trel duct prey club)) :: queued tasks - == :: -++ stic :: statistics - $: act/@ud :: change number - eny/@uvJ :: entropy - lat/@da :: time - == :: --- :: - :::::::::::::::::::::::::::::::::::::::::::::::::::::: vane header - :::::::::::::::::::::::::::::::::::::::::::::::::::::: -. == -=| all/axle :: all vane state -|= $: now/@da :: urban time - eny/@uvJ :: entropy - ska/sley :: activate - == :: opaque core -~% %gall-top ..ship ~ -|% :::::::::::::::::::::::::::::::::::::::::::::::::::::: state machine - :::::::::::::::::::::::::::::::::::::::::::::::::::::: -++ mo - ~% %gall-mo +> ~ - |_ $: $: our/@p - hen/duct - moz/(list move) - == - mast - == - ++ mo-abed :: initialize - |= {our/@p hen/duct} - ^+ +> - %_ +> - our our - hen hen - +<+ (~(got by pol.all) our) - == - :: - ++ mo-abet :: resolve to - ^+ [*(list move) +>+] - :_ +>+(pol.all (~(put by pol.all) our +<+)) - %- flop - %+ turn moz - |= a/move - ?. ?=($pass -.q.a) a - [p.a %pass [(scot %p our) p.q.a] q.q.a] - :: - ++ mo-conf :: configure - |= {dap/dude lum/culm} - (mo-boot dap ?:((~(has by bum) dap) %old %new) p.p.lum q.p.lum da+now) - :: - ++ mo-pass :: standard pass - |= {pax/path noh/note-arvo} - %_(+> moz :_(moz [hen %pass pax noh])) - :: - ++ mo-give - |= git/gift:able - %_(+> moz :_(moz [hen %give git])) - :: - ++ mo-okay :: valid agent core - |= vax/vase - ^- ? - =+ bol=(slew 12 vax) - ?~ bol | - (~(nest ut p.u.bol) %| -:!>(*bowl)) - :: - ++ mo-boom :: complete new boot - |= {dap/dude byk/beak dep/@uvH gux/gage:ford} - ^+ +> - ?- -.gux - $tabl ~|(%made-tabl !!) - $| - =. +> (mo-bold byk dap dep) - =. +> (mo-give %onto %| p.gux) - +> - $& - ?> ?=(@ p.p.gux) - ?. (mo-okay q.p.gux) - (mo-give %onto %| [%leaf "{}: bogus core"]~) - =. +> (mo-bold byk dap dep) - =. +> (mo-born dap byk q.p.gux) - =+ old=+>.$ - =+ wag=(ap-prop:(ap-abed:ap dap [%high [~ our]]) ~) - ?^ -.wag - =. +>.$ old - (mo-give %onto %| u.-.wag) - =. +>.$ ap-abet:+.wag - (mo-give:(mo-claw dap) %onto %& dap %boot now) - == - :: - ++ mo-born :: new seat - |= {dap/dude byk/beak hav/vase} - =+ sat=*seat - %_ +>.$ - bum - %+ ~(put by bum) dap - %_ sat - mom hen - byk byk - hav hav - p.zam 1 - q.zam [[[~ ~] 0] ~ ~] - r.zam [[0 [~ ~]] ~ ~] - == - == - :: - ++ mo-boon :: complete old boot - |= {dap/dude byk/beak dep/@uvH gux/gage:ford} - ^+ +> - =+ sut=(~(get by bum) dap) - ?~ sut - ~& [%gall-old-boon dap] - +>.$ - =. bum (~(put by bum) dap u.sut(byk byk)) - =. +>.$ (mo-bold byk dap dep) - ?- -.gux - $tabl ~|(%made-tabl !!) - $| (mo-give %onto %| p.gux) - $& ?> ?=(@ p.p.gux) - ap-abet:(ap-peep:(ap-abed:ap dap [%high [~ our]]) q.p.gux) - == - :: - ++ mo-bold :: wait for dep - |= {byk/beak dap/dude dep/@uvH} - ^+ +> - %+ mo-pass [%sys %dep (scot %p p.byk) q.byk dap ~] - [%f %wasp our dep &] - :: - ++ mo-boot :: create ship - |= {dap/dude how/?($new $old) byk/beak} - ^+ +> - :: ~& [%mo-boot dap how byk] - %+ mo-pass [%sys how dap (scot %p p.byk) q.byk (scot r.byk) ~] - ^- note-arvo - [%f %exec our `[byk %core [byk [dap %app ~]]]] - :: - ++ mo-away :: foreign request - |= {him/ship caz/cush} :: - ^+ +> - :: ~& [%mo-away him caz] - ?: ?=($pump -.q.caz) - :: - :: you'd think this would send an ack for the diff - :: that caused this pump. it would, but we already - :: sent it when we got the diff in ++mo-cyst. then - :: we'd have to save the network duct and connect it - :: to this returning pump. - :: - +> - =+ ^= roc ^- rook - ?- -.q.caz - $peel !! - $poke [%m p.p.q.caz q.q.p.q.caz] - $pull [%u ~] - $puff !! - $punk !! - $peer [%s p.q.caz] - == - =+ ^= dak - ?+ -.q.caz !! - $poke %k - $pull %l - $peer %r - == - %+ mo-pass - [%sys %way ~] - `note-arvo`[%a %wont [our him] [%g dak p.caz ~] [42 roc]] - :: - ++ mo-baal :: error convert a - |= art/(unit ares) - ^- ares - ?~(art ~ ?~(u.art `[%blank ~] u.art)) - :: - ++ mo-baba :: error convert b - |= ars/ares - ^- (unit tang) - ?~ ars ~ - `[[%leaf (trip p.u.ars)] q.u.ars] - :: - ++ mo-awed :: foreign response - |= {him/ship why/?($peer $poke $pull) art/(unit ares)} - ^+ +> - :: ~& [%mo-awed him why art] - =+ tug=(mo-baba (mo-baal art)) - ?- why - $peer (mo-give %unto %reap tug) - $poke (mo-give %unto %coup tug) - $pull +>.$ - == - :: - ++ mo-come :: handle locally - |= {her/ship caz/cush} - ^+ +> - =+ pry=`prey`[%high [~ her]] - (mo-club p.caz pry q.caz) - :: - ++ mo-coup :: back from mo-away - |= {dap/dude him/ship cup/ares} - %^ mo-give %unto %coup - ?~ cup ~ - [~ `tang`[[%leaf (trip p.u.cup)] q.u.cup]] - :: - ++ mo-chew :: reverse build path - |= pax/path - ^- beak - ?> ?=({@ @ @ $~} pax) - [(slav %p i.pax) i.t.pax da+(slav %da i.t.t.pax)] - :: - ++ mo-cyst :: take in /sys - |= {pax/path sih/sign-arvo} - ^+ +> - ?+ -.pax !! - $dep :: update - ?> ?=({$f $news *} sih) - ?> ?=({@ @ @ $~} t.pax) - %^ mo-boot i.t.t.t.pax - ?:((~(has by bum) i.t.t.t.pax) %old %new) - [(slav %p i.t.pax) i.t.t.pax [%da now]] - :: - $new - ?> ?=({$f $made *} sih) - ?> ?=({@ @ @ @ $~} t.pax) - (mo-boom i.t.pax (mo-chew t.t.pax) +>.sih) - :: - $old :: reload old - ?> ?=({$f $made *} sih) - ?> ?=({@ @ @ @ $~} t.pax) - (mo-boon i.t.pax (mo-chew t.t.pax) +>.sih) - :: - $pel :: translated peer - ?> ?=({@ $~} t.pax) - =+ mar=i.t.pax - ?> ?=({$f $made *} sih) - ?- -.q.+.sih - $tabl ~|(%made-tabl !!) - $& (mo-give %unto %diff p.q.+>.sih) - $| =. p.q.+>.sih (turn p.q.+>.sih |=(a/tank rose+[~ "! " ~]^[a]~)) - ~> %slog.`%*(. >[%wh %y]< +> [>%mo-cyst-fail< (flop p.q.+>.sih)]) - (mo-give %unto %quit ~) :: XX better errors pls - == - :: - $red :: diff ack - ?> ?=({@ @ $~} t.pax) - ?> ?=({$a ?($waft $woot) *} sih) - =+ :* him=(slav %p i.t.pax) - dap=i.t.t.pax - == - => .(pax `path`[%req t.pax]) - ?- +<.sih - $waft - ~& %red-waft - =+ fay=((hard (unit (pair mark noun))) r.+>.sih) - (mo-give %unto ?~(fay [%quit ~] [%doff u.fay])) - :: - $woot - ?~ r.+>.sih - (mo-pass [%sys pax] %g %deal [him our] dap %pump ~) - ~& [%diff-bad-ack q.+>.sih] - =. +>.$ (mo-pass [%sys pax] %g %deal [him our] dap %pull ~) - (mo-give %rend [%g %r dap ~] ~) - == - :: - $req :: inbound request - ?> ?=({@ @ $~} t.pax) - =+ :* him=(slav %p i.t.pax) - dap=i.t.t.pax - == - ?: ?=({$f $made *} sih) - ?- -.q.+>.sih - $tabl ~|(%made-tabl !!) - $| (mo-give %mack `p.q.+>.sih) :: XX should crash - $& (mo-pass [%sys pax] %g %deal [him our] i.t.t.pax %poke p.q.+>.sih) - == - ?: ?=({$a $woot *} sih) +>.$ :: quit ack, boring - ?> ?=({$g $unto *} sih) - =+ cuf=`cuft`+>.sih - ?- -.cuf - $coup (mo-give %mack p.cuf) - $reap (mo-give %mack p.cuf) - $diff (mo-give %rend [%g %r dap ~] [~ p.p.cuf q.q.p.cuf]) - $doff (mo-give %rend [%g %r dap ~] [~ p.cuf q.cuf]) - $quit (mo-give %rend [%g %r dap ~] ~) - == - :: - $val :: inbound validate - ?> ?=({@ @ $~} t.pax) - =+ [him=(slav %p i.t.pax) dap=i.t.t.pax] - ?> ?=({$f $made *} sih) - ?- -.q.+>.sih - $tabl !! - $| (mo-give %unto %coup `p.q.+>.sih) :: XX invalid, crash - $& (mo-clip dap `prey`[%high ~ him] %poke p.q.sih) - == - :: - $way :: outbound request - ?> ?=({$a ?($waft $woot) *} sih) - ?- +<.sih - $waft - ?> ?=({$g $r @ $~} q.+>.sih) - =+ fay=((hard (unit (pair mark noun))) r.+>.sih) - (mo-give %unto ?~(fay [%quit ~] [%doff u.fay])) - :: - $woot - ?> ?=({$g @ @ $~} q.+>.sih) - %- mo-awed - :* p.+>.sih - ?+ i.t.q.+>.sih !! - $k %poke - $r %peer - $l %pull - == - r.+>.sih - == - == - == - :: - ++ mo-cook :: take in /use - |= {pax/path hin/(hypo sign-arvo)} - ^+ +> - ?. ?=({@ @ $?($inn $out $cay) *} pax) - ~& [%mo-cook-bad-pax pax] - !! - =+ dap=`@tas`i.pax - =+ pry=`prey`[%high [~ (slav %p i.t.pax)]] - =+ pap=(ap-abed:ap dap pry) - =+ vax=(slot 3 `vase`hin) - ?- i.t.t.pax - $inn ap-abet:(ap-pour:pap t.t.t.pax (slot 3 `vase`hin)) - $cay ?. ?=({$e $sigh *} q.hin) - ~& [%mo-cook-weird q.hin] - ~& [%mo-cook-weird-path pax] - +>.$ - ap-abet:(ap-purr:pap +<.q.hin t.t.t.pax +>.q.hin) - :: - $out ?: ?=({$f $made *} q.hin) - ?- -.q.+>.q.hin - $tabl ~|(%made-tabl !!) - $& ap-abet:(ap-pout:pap t.t.t.pax %diff +.q.+>.q.hin) - $| - =+ why=p.q.+>.q.hin - =. why (turn why |=(a/tank rose+[~ "! " ~]^[a]~)) - ~> %slog.`rose+[" " "[" "]"]^[>%mo-cook-fail< (flop why)] - ~& [him=q.q.pry our=our pax=pax] - :: - :: here we should crash because the right thing - :: for the client to do is to upgrade so that it - :: understands the server's mark, thus allowing - :: the message to proceed. but ames is not quite - :: ready for promiscuous crashes, so instead we - :: send a pull outward and a quit downward. - :: or not... outgoing dap (XXX) is not in the path. - :: =. +>.$ ap-abet:(ap-pout:pap t.t.t.pax %quit ~) - :: %+ mo-pass - :: [%use pax] - :: [%g %deal [q.q.pry our] XXX %pull ~] - !! - == - ?. ?=({$g $unto *} q.hin) - ~& [%mo-cook-weird q.hin] - ~& [%mo-cook-weird-path pax] - +>.$ - ?: ?=($doff +>-.q.hin) - %+ mo-pass - [%use pax] - [%f %exec our ~ byk.pap %vale +.p.q.hin] - ap-abet:(ap-pout:pap t.t.t.pax +>.q.hin) - == - :: - ++ mo-claw :: clear queue - |= dap/dude - ^+ +> - ?. (~(has by bum) dap) +> - =+ suf=(~(get by wub) dap) - ?~ suf +>.$ - |- ^+ +>.^$ - ?: =(~ kys.u.suf) - +>.^$(wub (~(del by wub) dap)) - =^ lep kys.u.suf [p q]:~(get to kys.u.suf) - $(moz :_(moz [p.lep %slip %g %deal [q.q.q.lep our] dap r.lep])) - :: $(+>.^$ (mo-clip(hen p.lep) dap q.lep r.lep)) - :: - ++ mo-beak :: build beak - |= dap/dude - =- ?.(=(p our) - -(r [%da now])) :: soft dependencies - ^- beak - byk:(~(got by bum) dap) - :: - ++ mo-peek - |= {dap/dude pry/prey ren/@tas tyl/path} - ^- (unit (unit cage)) - (ap-peek:(ap-abed:ap dap pry) ren tyl) - :: - ++ mo-clip :: apply club - |= {dap/dude pry/prey cub/club} - ?: ?=($puff -.cub) - %+ mo-pass - [%sys %val (scot %p q.q.pry) dap ~] - [%f %exec our ~ (mo-beak dap) %vale +.cub] - ?: ?=($punk -.cub) - %+ mo-pass - [%sys %val (scot %p q.q.pry) dap ~] - [%f %exec our ~ (mo-beak dap) %cast p.cub %$ q.cub] - ap-abet:(ap-club:(ap-abed:ap dap pry) cub) - :: - ++ mo-club :: local action - |= {dap/dude pry/prey cub/club} - ^+ +> - ?: |(!(~(has by bum) dap) (~(has by wub) dap)) - ~& >> [%mo-not-running dap -.cub] - :: ~& [%mo-club-qeu dap cub] - =+ syf=(fall (~(get by wub) dap) *sofa) - +>.$(wub (~(put by wub) dap syf(kys (~(put to kys.syf) [hen pry cub])))) - (mo-clip dap pry cub) - :: - ++ mo-gawk :: ames forward - |= {him/@p dap/dude num/@ud rok/rook} - =? +> ?=($u -.rok) (mo-give %mack ~) - %+ mo-pass - [%sys %req (scot %p him) dap ~] - ^- note-arvo - ?- -.rok - :: %m [%f %exec our ~ (mo-beak dap) %vale p.rok q.rok] - $m [%g %deal [him our] dap %puff p.rok q.rok] - $s [%g %deal [him our] dap %peer p.rok] - $u [%g %deal [him our] dap %pull ~] - == - :: - ++ mo-gawp :: response ack - |= {him/@p dap/dude cop/coop} - ^+ +> - %+ mo-pass - [%sys %req (scot %p him) dap ~] - ?~ cop - [%g %deal [him our] dap %pump ~] - [%g %deal [him our] dap %pull ~] - :: - ++ ap :: agent engine - ~% %gall-ap +> ~ - |_ $: $: dap/dude - pry/prey - ost/bone - zip/(list cove) - dub/(list (each suss tang)) - == - seat - == - :: - ++ ap-abed :: initialize - |= {dap/dude pry/prey} - ^+ +> - =: ^dap dap - ^pry pry - +>+<+ `seat`(~(got by bum) dap) - == - =+ unt=(~(get by q.zam) hen) - =: act.tyc +(act.tyc) - eny.tyc (shaz (mix (add dap act.tyc) eny)) - lat.tyc now - == - ?^ unt - +>.$(ost u.unt) - %= +>.$ - ost p.zam - p.zam +(p.zam) - q.zam (~(put by q.zam) hen p.zam) - r.zam (~(put by r.zam) p.zam hen) - == - :: - ++ ap-abet :: resolve - ^+ +> - => ap-abut - %_ +> - bum (~(put by bum) dap +<+) - moz :(weld (turn zip ap-aver) (turn dub ap-avid) moz) - == - :: - ++ ap-abut :: track queue - ^+ . - =+ [pyz=zip ful=*(set bone)] - |- ^+ +> - ?^ pyz - ?. ?=({$give $diff *} q.i.pyz) - $(pyz t.pyz) - =^ vad +> ap-fill(ost p.i.pyz) - $(pyz t.pyz, ful ?:(vad ful (~(put in ful) p.i.pyz))) - =+ ded=(~(tap in ful) ~) - |- ^+ +>.^$ - ?~ ded +>.^$ - => %*(. $(ded t.ded) ost i.ded) - =+ tib=(~(get by sup.ged) ost) - ?~ tib ~&([%ap-abut-bad-bone dap ost] ..ap-kill) - ap-kill(q.q.pry p.u.tib) - :: - ++ ap-aver :: cove to move - |= cov/cove - ^- move - :- (~(got by r.zam) p.cov) - ?- -.q.cov - $slip !! - $give - ?< =(0 p.cov) - ?. ?=($diff -.p.q.cov) - [%give %unto p.q.cov] - =+ cay=`cage`p.p.q.cov - =+ mar=(fall (~(get by pyl) p.cov) p.cay) - ?: =(mar p.cay) [%give %unto p.q.cov] - :+ %pass - [%sys %pel dap ~] - [%f %exec our ~ (mo-beak dap) %cast mar %$ cay] - :: - $pass - :+ %pass `path`[%use dap p.q.cov] - ?- -.q.q.cov - $hiss `note-arvo`[%e %hiss +.q.q.cov] - $send `note-arvo`[%g %deal [our p.q.q.cov] q.q.q.cov] - $meta `note-arvo`[`@tas`p.q.q.cov %meta `vase`q.q.q.cov] - == - == - :: - ++ ap-avid :: onto results - |=(a/(each suss tang) [hen %give %onto a]) - :: - ++ ap-call :: call into server - ~/ %ap-call - |= {cog/term arg/vase} - ^- {(unit tang) _+>} - =. +> ap-bowl - =^ arm +>.$ (ap-farm cog) - ?: ?=($| -.arm) [`p.arm +>.$] - =^ zem +>.$ (ap-slam cog p.arm arg) - ?: ?=($| -.zem) [`p.zem +>.$] - (ap-sake p.zem) - :: - ++ ap-peek - |= {ren/@tas tyl/path} - ^- (unit (unit cage)) - =+ ?. ?=($x ren) - [mar=%$ tyl=tyl] - =+ `path`(flop tyl) - ?> ?=(^ -) - [mar=i tyl=(flop t)] - =+ cug=(ap-find %peek ren tyl) - ?~ cug - ((slog:error:userlib leaf+"peek find fail" >tyl< >mar< ~) [~ ~]) - =. ..ap-bowl ap-bowl - =^ arm +>.$ (ap-farm q.u.cug) - ?: ?=($| -.arm) ((slog:error:userlib leaf+"peek farm fail" p.arm) [~ ~]) - =^ zem +>.$ (ap-slam q.u.cug p.arm !>((slag p.u.cug `path`[ren tyl]))) - ?: ?=($| -.zem) ((slog:error:userlib leaf+"peek slam fail" p.zem) [~ ~]) - ?+ q.p.zem ((slog:error:userlib leaf+"peek bad result" ~) [~ ~]) - $~ ~ - {$~ $~} [~ ~] - {$~ $~ ^} - =+ caz=(spec (slot 7 p.zem)) - ?. &(?=({p/@ *} q.caz) ((sane %tas) p.q.caz)) - ((slog:error:userlib leaf+"scry: malformed cage" ~) [~ ~]) - ?. =(mar p.q.caz) - [~ ~] - ``[p.q.caz (slot 3 caz)] - == - :: - ++ ap-club :: apply effect - |= cub/club - ^+ +> - ?- -.cub - $peel (ap-peel +.cub) - $poke (ap-poke +.cub) - $peer (ap-peer +.cub) - $puff !! - $punk !! - $pull ap-pull - $pump ap-fall - == - :: - ++ ap-diff :: pour a diff - |= {her/ship pax/path cag/cage} - =. q.cag (spec q.cag) - =+ cug=(ap-find [%diff p.cag +.pax]) - ?~ cug - %. [| her +.pax] - ap-pump:(ap-lame %diff (ap-suck "diff: no {<`path`[p.cag +.pax]>}")) - =+ ^= arg ^- vase - %- slop - ?: =(0 p.u.cug) - [!>(`path`+.pax) !>(cag)] - [!>((slag (dec p.u.cug) `path`+.pax)) q.cag] - =^ cam +>.$ (ap-call q.u.cug arg) - ?^ cam - (ap-pump:(ap-lame q.u.cug u.cam) | her pax) - (ap-pump & her pax) - :: - ++ ap-pump :: update subscription - |= {oak/? her/ship pax/path} - =+ way=[(scot %p her) %out pax] - ?: oak - (ap-pass way %send her -.pax %pump ~) - (ap-pass:(ap-give %quit ~) way %send her -.pax %pull ~) - :: - ++ ap-fall :: drop from queue - ^+ . - ?. (~(has by sup.ged) ost) . - =+ soy=(~(get by qel.ged) ost) - ?: |(?=($~ soy) =(0 u.soy)) - :: ~& [%ap-fill-under [our dap] q.q.pry ost] - + - =. u.soy (dec u.soy) - :: ~& [%ap-fill-sub [[our dap] q.q.pry ost] u.soy] - ?: =(0 u.soy) - +(qel.ged (~(del by qel.ged) ost)) - +(qel.ged (~(put by qel.ged) ost u.soy)) - :: - ++ ap-farm :: produce arm - ~/ %ap-farm - |= cog/term - ^- {(each vase tang) _+>} - =+ pyz=(mule |.((~(mint wa vel) p.hav [%limb cog]))) - ?: ?=($| -.pyz) - :_(+>.$ [%| +.pyz]) - :_ +>.$(vel `worm`+>.pyz) - =+ ton=(mock [q.hav q.+<.pyz] ap-sled) - ?- -.ton - $0 [%& p.+<.pyz p.ton] - $1 [%| (turn p.ton |=(a/* (smyt (path a))))] - $2 [%| p.ton] - == - :: - ++ ap-fill :: add to queue - ^- {? _.} - =+ suy=(fall (~(get by qel.ged) ost) 0) - ?: =(20 suy) - :: ~& [%ap-fill-full [our dap] q.q.pry ost] - [%| +] - :: ~? !=(20 suy) [%ap-fill-add [[our dap] q.q.pry ost] +(suy)] - [%& +(qel.ged (~(put by qel.ged) ost +(suy)))] - :: - ++ ap-find :: general arm - |= {cog/term pax/path} - =+ dep=0 - |- ^- (unit (pair @ud term)) - =+ ^= spu - ?~ pax ~ - $(pax t.pax, dep +(dep), cog (ap-hype cog i.pax)) - ?^ spu spu - ?.((ap-fond cog) ~ `[dep cog]) - :: - ++ ap-fond :: check for arm - |= cog/term - ^- ? - (slob cog p.hav) - :: - ++ ap-give :: return result - |= cit/cuft - ^+ +> - +>(zip :_(zip [ost %give cit])) - :: - ++ ap-bowl :: set up bowl - %_ . - +12.q.hav - ^- bowl - :* :* our :: host - q.q.pry :: guest - dap :: agent - == :: - :* wex=~ :: outgoing - sup=sup.ged :: incoming - == :: - :* ost=ost :: cause - act=act.tyc :: tick - eny=eny.tyc :: nonce - now=lat.tyc :: time - byk=byk :: source - == == :: - == - :: - ++ ap-hype :: hyphenate - |=({a/term b/term} `term`(cat 3 a (cat 3 '-' b))) - :: - ++ ap-move :: process each move - ~/ %ap-move - |= vax/vase - ^- {(each cove tang) _+>} - ?@ q.vax :_(+>.$ [%| (ap-suck "move: invalid move (atom)")]) - ?^ -.q.vax :_(+>.$ [%| (ap-suck "move: invalid move (bone)")]) - ?@ +.q.vax :_(+>.$ [%| (ap-suck "move: invalid move (card)")]) - =+ hun=(~(get by r.zam) -.q.vax) - ?. (~(has by r.zam) -.q.vax) - :_(+>.$ [%| (ap-suck "move: invalid card (bone {<-.q.vax>})")]) - =^ pec vel (~(spot wa vel) 3 vax) - =^ cav vel (~(slot wa vel) 3 pec) - ?+ +<.q.vax - (ap-move-pass -.q.vax +<.q.vax cav) - $diff (ap-move-diff -.q.vax cav) - $hiss (ap-move-hiss -.q.vax cav) - $peel (ap-move-peel -.q.vax cav) - $peer (ap-move-peer -.q.vax cav) - $pull (ap-move-pull -.q.vax cav) - $poke (ap-move-poke -.q.vax cav) - $send (ap-move-send -.q.vax cav) - $quit (ap-move-quit -.q.vax cav) - == - :: - ++ ap-move-quit :: give quit move - |= {sto/bone vax/vase} - ^- {(each cove tang) _+>} - :_ +> - ?^ q.vax [%| (ap-suck "quit: improper give")] - [%& `cove`[sto %give `cuft`[%quit ~]]] - :: - ++ ap-move-diff :: give diff move - |= {sto/bone vax/vase} - ^- {(each cove tang) _+>} - =^ pec vel (~(spec wa vel) vax) - ?. &(?=(^ q.pec) ?=(@ -.q.pec) ((sane %tas) -.q.pec)) - :_(+>.$ [%| (ap-suck "diff: improper give")]) - =^ tel vel (~(slot wa vel) 3 pec) - :_(+>.$ [%& sto %give %diff `cage`[-.q.pec tel]]) - :: - ++ ap-move-hiss :: pass %hiss - |= {sto/bone vax/vase} - ^- {(each cove tang) _+>} - ?. &(?=({p/* q/* r/@ s/{p/@ *}} q.vax) ((sane %tas) r.q.vax)) - =+ args="[%hiss wire (unit knot) mark cage]" - :_(+>.$ [%| (ap-suck "hiss: bad hiss ask.{args}")]) - =^ gaw vel (~(slot wa vel) 15 vax) - ?. &(?=({p/@ *} q.gaw) ((sane %tas) p.q.gaw)) - :_(+>.$ [%| (ap-suck "hiss: malformed cage")]) - =^ paw vel (~(stop wa vel) 3 gaw) - =+ usr=((soft (unit knot)) q.q.vax) - ?. &(?=(^ usr) ?~(u.usr & ((sane %ta) u.u.usr))) - :_(+>.$ [%| (ap-suck "hiss: malformed (unit knot)")]) - =+ pux=((soft path) p.q.vax) - ?. &(?=(^ pux) (levy u.pux (sane %ta))) - :_(+>.$ [%| (ap-suck "hiss: malformed path")]) - :_ +>.$ - :^ %& sto %pass - :- [(scot %p q.q.pry) %cay u.pux] - ~! *cote - =- ~! - `cote`- - [%hiss u.usr r.q.vax [p.q.gaw paw]] - :: - ++ ap-move-mess :: extract path, target - |= vax/vase - ^- {(each (trel path ship term) tang) _+>} - :_ +>.$ - ?. ?& ?=({p/* {q/@ r/@} s/*} q.vax) - (gte 1 (met 7 q.q.vax)) - == - [%| (ap-suck "mess: malformed target")] - =+ pux=((soft path) p.q.vax) - ?. &(?=(^ pux) (levy u.pux (sane %ta))) - [%| (ap-suck "mess: malformed path")] - [%& [(scot %p q.q.vax) %out r.q.vax u.pux] q.q.vax r.q.vax] - :: - ++ ap-move-pass :: pass general move - |= {sto/bone wut/* vax/vase} - ^- {(each cove tang) _+>} - ?. &(?=(@ wut) ((sane %tas) wut)) - :_(+>.$ [%| (ap-suck "pass: malformed card")]) - =+ pux=((soft path) -.q.vax) - ?. &(?=(^ pux) (levy u.pux (sane %ta))) - :_(+>.$ [%| (ap-suck "pass: malformed path")]) - =+ huj=(ap-vain wut) - ?~ huj :_(+>.$ [%| (ap-suck "move: unknown note {(trip wut)}")]) - =^ tel vel (~(slot wa vel) 3 vax) - :_ +>.$ - :^ %& sto %pass - :- [(scot %p q.q.pry) %inn u.pux] - [%meta u.huj (slop (ap-term %tas wut) tel)] - :: - ++ ap-move-poke :: pass %poke - |= {sto/bone vax/vase} - ^- {(each cove tang) _+>} - =^ yep +>.$ (ap-move-mess vax) - ?: ?=($| -.yep) :_(+>.$ yep) - =^ gaw vel (~(slot wa vel) 7 vax) - ?. &(?=({p/@ q/*} q.gaw) ((sane %tas) p.q.gaw)) - :_(+>.$ [%| (ap-suck "poke: malformed cage")]) - =^ paw vel (~(stop wa vel) 3 gaw) - :_ +>.$ - :^ %& sto %pass - :- p.p.yep - [%send q.p.yep r.p.yep %poke p.q.gaw paw] - :: - ++ ap-move-peel :: pass %peel - |= {sto/bone vax/vase} - ^- {(each cove tang) _+>} - =^ yep +>.$ (ap-move-mess vax) - :_ +>.$ - ?: ?=($| -.yep) yep - =+ mar=((soft mark) +>-.q.vax) - ?~ mar - [%| (ap-suck "peel: malformed mark")] - =+ pux=((soft path) +>+.q.vax) - ?. &(?=(^ pux) (levy u.pux (sane %ta))) - [%| (ap-suck "peel: malformed path")] - :^ %& sto %pass - :- p.p.yep - [%send q.p.yep r.p.yep %peel u.mar u.pux] - :: - ++ ap-move-peer :: pass %peer - |= {sto/bone vax/vase} - ^- {(each cove tang) _+>} - =^ yep +>.$ (ap-move-mess vax) - :_ +>.$ - ?: ?=($| -.yep) yep - =+ pux=((soft path) +>.q.vax) - ?. &(?=(^ pux) (levy u.pux (sane %ta))) - [%| (ap-suck "peer: malformed path")] - :^ %& sto %pass - :- p.p.yep - [%send q.p.yep r.p.yep %peer u.pux] - :: - ++ ap-move-pull :: pass %pull - |= {sto/bone vax/vase} - ^- {(each cove tang) _+>} - =^ yep +>.$ (ap-move-mess vax) - :_ +>.$ - ?: ?=($| -.yep) yep - ?. =(~ +>.q.vax) - [%| (ap-suck "pull: malformed card")] - :^ %& sto %pass - :- p.p.yep - [%send q.p.yep r.p.yep %pull ~] - :: - ++ ap-move-send :: pass gall action - |= {sto/bone vax/vase} - ^- {(each cove tang) _+>} - ?. ?& ?=({p/* {q/@ r/@} {s/@ t/*}} q.vax) - (gte 1 (met 7 q.q.vax)) - ((sane %tas) r.q.vax) - == - :_(+>.$ [%| (ap-suck "send: improper ask.[%send wire gill club]")]) - =+ pux=((soft path) p.q.vax) - ?. &(?=(^ pux) (levy u.pux (sane %ta))) - :_(+>.$ [%| (ap-suck "send: malformed path")]) - ?: ?=($poke s.q.vax) - =^ gav vel (~(spot wa vel) 7 vax) - ?> =(%poke -.q.gav) - ?. ?& ?=({p/@ q/*} t.q.vax) - ((sane %tas) p.t.q.vax) - == - :_(+>.$ [%| (ap-suck "send: malformed poke")]) - =^ vig vel (~(spot wa vel) 3 gav) - =^ geb vel (~(slot wa vel) 3 vig) - :_ +>.$ - :^ %& sto %pass - :- [(scot %p q.q.vax) %out r.q.vax u.pux] - ^- cote - :: ~& [%ap-move-send `path`[(scot %p q.q.vax) %out r.q.vax u.pux]] - [%send q.q.vax r.q.vax %poke p.t.q.vax geb] - :_ +>.$ - =+ cob=((soft club) [s t]:q.vax) - ?~ cob - [%| (ap-suck "send: malformed club")] - :^ %& sto %pass - :- [(scot %p q.q.vax) %out r.q.vax u.pux] - :: ~& [%ap-move-send `path`[(scot %p q.q.vax) %out r.q.vax u.pux]] - [%send q.q.vax r.q.vax u.cob] - :: - ++ ap-pass :: request action - |= {pax/path coh/cote} - ^+ +> - +>(zip :_(zip [ost %pass pax coh])) - :: - ++ ap-peep :: reinstall - |= vax/vase - ^+ +> - =+ pep=(ap-prep(hav vax) `hav) - ?~ -.pep - +.pep - (ap-lame %prep-failed u.-.pep) - :: - ++ ap-peel - |= {mar/mark pax/path} - =. pyl (~(put by pyl) ost mar) - (ap-peer pax) - :: - ++ ap-peer :: apply %peer - |= pax/path - ^+ +> - =. +> (ap-peon pax) - =+ cug=(ap-find %peer pax) - ?~ cug +>.$ - =+ old=zip - =. zip ~ - =^ cam +>.$ - %+ ap-call q.u.cug - !>(`path`(slag p.u.cug pax)) - =. zip (weld zip `(list cove)`[[ost %give %reap cam] old]) - ?^(cam ap-pule +>.$) - :: - ++ ap-peon :: add subscriber - |= pax/path - %_ +>.$ - sup.ged (~(put by sup.ged) ost [q.q.pry pax]) - == - :: - ++ ap-poke :: apply %poke - |= cag/cage - ^+ +> - =+ cug=(ap-find %poke p.cag ~) - ?~ cug - (ap-give %coup `(ap-suck "no poke arm for {(trip p.cag)}")) - :: ~& [%ap-poke dap p.cag cug] - =^ tur +>.$ - %+ ap-call q.u.cug - ?. =(0 p.u.cug) q.cag - (slop (ap-term %tas p.cag) q.cag) - (ap-give %coup tur) - :: - ++ ap-lame :: pour error - |= {wut/@tas why/tang} - ^+ +> - =+ cug=(ap-find /lame) - ?~ cug - =. why [>%ap-lame dap wut< (turn why |=(a/tank rose+[~ "! " ~]^[a]~))] - ~> %slog.`rose+[" " "[" "]"]^(flop why) - +>.$ - =^ cam +>.$ - %+ ap-call q.u.cug - !>([wut why]) - ?^ cam - =. why [>%ap-lame-lame< (turn u.cam |=(a/tank rose+[~ "! " ~]^[a]~))] - ~> %slog.`rose+[" " "[" "]"]^(welp (flop why) leaf+"." (flop u.cam)) - +>.$ - +>.$ - :: - ++ ap-pour :: generic take - |= {pax/path vax/vase} - ^+ +> - ?. &(?=({@ *} q.vax) ((sane %tas) -.q.vax)) - (ap-lame %pour (ap-suck "pour: malformed card")) - =+ cug=(ap-find [-.q.vax pax]) - ?~ cug - ?: =(-.q.vax %went) - +>.$ - (ap-lame -.q.vax (ap-suck "pour: no {(trip -.q.vax)}: {}")) - =^ tel vel (~(slot wa vel) 3 vax) - =^ cam +>.$ - %+ ap-call q.u.cug - %+ slop - !>(`path`(slag p.u.cug pax)) - tel - ?^ cam (ap-lame -.q.vax u.cam) - +>.$ - :: - ++ ap-purr :: unwrap take - |= {wha/term pax/path cag/cage} - ^+ +> - =+ cug=(ap-find [wha p.cag pax]) - ?~ cug - (ap-lame wha (ap-suck "{(trip wha)}: no {<`path`[p.cag pax]>}")) - =+ ^= arg ^- vase - %- slop - ?: =(0 p.u.cug) - [!>(`path`pax) !>(cag)] - [!>((slag (dec p.u.cug) `path`pax)) q.cag] - =^ cam +>.$ (ap-call q.u.cug arg) - ?^ cam (ap-lame q.u.cug u.cam) - +>.$ - :: - ++ ap-pout :: specific take - |= {pax/path cuf/cuft} - ^+ +> - ?- -.cuf - $coup (ap-take q.q.pry %coup +.pax `!>(p.cuf)) - $diff (ap-diff q.q.pry pax p.cuf) - $doff !! - $quit (ap-take q.q.pry %quit +.pax ~) - $reap (ap-take q.q.pry %reap +.pax `!>(p.cuf)) - == - :: - ++ ap-prep :: install - |= vux/(unit vase) - ^- {(unit tang) _+>} - =^ gac +>.$ (ap-prop vux) - :- gac - %= +>.$ - dub - :_(dub ?~(gac [%& dap ?~(vux %boot %dtls) now] [%| u.gac])) - == - :: - ++ ap-prop :: install - |= vux/(unit vase) - ^- {(unit tang) _+>} - ?. (ap-fond %prep) - ?~ vux - `+>.$ - =+ [new=p:(slot 13 hav) old=p:(slot 13 u.vux)] - ?. (~(nest ut p:(slot 13 hav)) %| p:(slot 13 u.vux)) - :_(+>.$ `(ap-suck "prep mismatch")) - `+>.$(+13.q.hav +13.q.u.vux) - =^ tur +>.$ - %+ ap-call %prep - ?~(vux !>(~) (slop !>(~) (slot 13 u.vux))) - ?~ tur - `+>.$ - :_(+>.$ `u.tur) - :: - ++ ap-pule :: silent delete - =+ wim=(~(get by sup.ged) ost) - ?~ wim + - %_ + - sup.ged (~(del by sup.ged) ost) - qel.ged (~(del by qel.ged) ost) - == - :: - ++ ap-pull :: load delete - =+ wim=(~(get by sup.ged) ost) - ?~ wim + :: ~&(%ap-pull-none +) - =: sup.ged (~(del by sup.ged) ost) - qel.ged (~(del by qel.ged) ost) - == - =+ cug=(ap-find %pull q.u.wim) - ?~ cug +> - =^ cam +> - %+ ap-call q.u.cug - !>((slag p.u.cug q.u.wim)) - ?^ cam (ap-lame q.u.cug u.cam) - +>+ - :: - ++ ap-kill :: queue kill - :: ~& [%ap-kill dap ost] - (ap-give:ap-pull %quit ~) - :: - ++ ap-take :: non-diff gall take - |= {her/ship cog/term pax/path vux/(unit vase)} - ^+ +> - =+ cug=(ap-find cog pax) - ?~ cug - :: ~& [%ap-take-none cog pax] - +>.$ - =^ cam +>.$ - %+ ap-call q.u.cug - =+ den=!>((slag p.u.cug pax)) - ?~(vux den (slop den u.vux)) - ?^ cam (ap-lame q.u.cug u.cam) - +>.$ - :: - ++ ap-safe :: process move list - |= vax/vase - ^- {(each (list cove) tang) _+>} - ?~ q.vax :_(+>.$ [%& ~]) - ?@ q.vax :_(+>.$ [%| (ap-suck "move: malformed list")]) - =^ hed vel (~(slot wa vel) 2 vax) - =^ sud +>.$ (ap-move hed) - ?: ?=($| -.sud) :_(+>.$ sud) - =^ tel vel (~(slot wa vel) 3 vax) - =^ res +>.$ $(vax tel) - :_ +>.$ - ?: ?=($| -.res) res - [%& p.sud p.res] - :: - ++ ap-sake :: handle result - |= vax/vase - ^- {(unit tang) _+>} - ?: ?=(@ q.vax) - [`(ap-suck "sake: invalid product (atom)") +>.$] - =^ hed vel (~(slot wa vel) 2 vax) - =^ muz +>.$ (ap-safe hed) - ?: ?=($| -.muz) [`p.muz +>.$] - =^ tel vel (~(slot wa vel) 3 vax) - =^ sav +>.$ (ap-save tel) - ?: ?=($| -.sav) [`p.sav +>.$] - :- ~ - %_ +>.$ - zip (weld (flop p.muz) zip) - hav p.sav - == - :: - ++ ap-save :: verify core - |= vax/vase - ^- {(each vase tang) _+>} - =^ gud vel (~(nest wa vel) p.hav p.vax) - :_ +>.$ - ?. gud - [%| (ap-suck "invalid core")] - [%& vax] - :: - ++ ap-slam :: virtual slam - ~/ %ap-slam - |= {cog/term gat/vase arg/vase} - ^- {(each vase tang) _+>} - =+ ^= wyz %- mule |. - (~(mint wa vel) [%cell p.gat p.arg] [%open [%$ ~] [%$ 2] [%$ 3] ~]) - ?: ?=($| -.wyz) - %- =+ sam=(~(peek ut p.gat) %free 6) - %- slog:error:userlib - :~ >%ap-slam-mismatch< - ~(duck ut p.arg) - ~(duck ut sam) - == - :_(+>.$ [%| (ap-suck "call: {}: type mismatch")]) - :_ +>.$(vel +>.wyz) - =+ [typ nok]=+<.wyz - =+ ton=(mock [[q.gat q.arg] nok] ap-sled) - ?- -.ton - $0 [%& typ p.ton] - $1 [%| (turn p.ton |=(a/* (smyt (path a))))] - $2 [%| p.ton] - == - :: - ++ ap-sled (sloy:error:userlib ska) :: namespace view - ++ ap-suck :: standard tang - |= msg/tape - ^- tang - [%leaf (weld "gall: {}: " msg)]~ - :: - ++ ap-term :: atomic vase - |= {a/@tas b/@} - ^- vase - [[%atom a `b] b] - :: - ++ ap-vain :: card to vane - |= sep/@tas - ^- (unit @tas) - ?+ sep ~& [%ap-vain sep] - ~ - $cash `%a - $conf `%g - $deal `%g - $exec `%f - $flog `%d - $funk `%a - $drop `%c - $info `%c - $merg `%c - $mont `%c - $dirk `%c - $ogre `%c - $serv `%e - $them `%e - $wait `%b - $want `%a - $wont `%a :: XX for begin; remove - $warp `%c - $wipe `%f :: XX cache clear - $jaelwomb `%j :: XX name/unpack - == - -- - -- -++ call :: request - ~% %gall-call +> ~ - |= {hen/duct hic/(hypo (hobo task:able))} - ^+ [p=*(list move) q=..^$] - => .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard task:able) p.q.hic))) - ?- -.q.hic - $conf - ?. (~(has by pol.all) p.p.q.hic) - ~& [%gall-not-ours p.p.q.hic] - [~ ..^$] - mo-abet:(mo-conf:(mo-abed:mo p.p.q.hic hen) q.p.q.hic q.q.hic) - :: - $deal - =< mo-abet - ?. (~(has by pol.all) q.p.q.hic) :: either to us - ?> (~(has by pol.all) p.p.q.hic) :: or from us - (mo-away:(mo-abed:mo p.p.q.hic hen) q.p.q.hic q.q.hic) - (mo-come:(mo-abed:mo q.p.q.hic hen) p.p.q.hic q.q.hic) - :: - $init - :: ~& [%gall-init p.q.hic] - [~ ..^$(pol.all (~(put by pol.all) p.q.hic [hen ~ ~ ~]))] - :: - $went - ?. (~(has by pol.all) p.p.q.hic) - ~& [%gall-not-ours p.q.hic] - [~ ..^$] - ?> ?=({?($k $l $r) @ $~} q.q.hic) - =+ dap=i.t.q.q.hic - =+ our=p.p.q.hic - =+ him=q.p.q.hic - =< mo-abet - (mo-gawp:(mo-abed:mo our hen) him dap s.q.hic) - :: - $west - ?. (~(has by pol.all) p.p.q.hic) - ~& [%gall-not-ours p.q.hic] - [~ ..^$] - ?> ?=({?($k $l $r) @ $~} q.q.hic) - =+ dap=i.t.q.q.hic - =+ our=p.p.q.hic - =+ him=q.p.q.hic - =+ mes=((hard {@ud rook}) s.q.hic) - =< mo-abet - (mo-gawk:(mo-abed:mo our hen) him dap mes) - :: - $wegh - :_ ..^$ :_ ~ - :^ hen %give %mass - :- %gall - :- %| - %+ turn (~(tap by pol.all)) :: XX single-home - |= {our/@ mast} ^- mass - :+ (scot %p our) %| - :~ [%foreign [%& sap]] - [%blocked [%| (sort (~(tap by (~(run by wub) |=(sofa [%& +<])))) aor)]] - [%active [%| (sort (~(tap by (~(run by bum) |=(seat [%& +<])))) aor)]] - == - == -:: -++ doze :: sleep until - |= {now/@da hen/duct} - ^- (unit @da) - ~ -:: -++ load :: recreate vane - |= old/axle-n - ^+ ..^$ - ?: ?=($2 -.old) ..^$(all old) - %= $ - old => |=(seat-1 `seat`[*worm +<]) - => |=(mast-1 +<(bum (~(run by bum) +>))) - old(- %2, pol (~(run by pol.old) .)) - == -:: -++ scry - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) - ?. ?=($& -.why) ~ - =* who p.why - ?: ?& =(%u ren) - =(~ tyl) - =([%$ %da now] lot) - (~(has by pol.all) who) - (~(has by bum:(~(got by pol.all) who)) syd) - == - ``[%null !>(~)] - ?. (~(has by pol.all) who) - ~ - ?. =([%$ %da now] lot) - ~ - ?. (~(has by bum:(~(got by pol.all) who)) syd) - [~ ~] - ?. ?=(^ tyl) - ~ - (mo-peek:(mo-abed:mo who *duct) syd high+`who ren tyl) -:: -++ stay :: save w+o cache - `axle`all -:: -++ take :: response - |= {tea/wire hen/duct hin/(hypo sign-arvo)} - ^+ [p=*(list move) q=..^$] - ~| [%gall-take tea] - ?> ?=({@ ?($sys $use) *} tea) - =+ our=(need (slaw %p i.tea)) - =+ mow=(mo-abed:mo our hen) - ?: ?=($sys i.t.tea) - mo-abet:(mo-cyst:mow t.t.tea q.hin) - ?> ?=($use i.t.tea) - mo-abet:(mo-cook:mow t.t.tea hin) --- diff --git a/neo/van/jael.hoon b/neo/van/jael.hoon deleted file mode 100644 index 66e977231..000000000 --- a/neo/van/jael.hoon +++ /dev/null @@ -1,2155 +0,0 @@ -:: :: /van/jael -:: :: %reference/0 -!? 150 -:: -:: -:: %jael: secrets and promises. -:: -:: todo: -:: -:: - communication with other vanes: -:: - actually use %behn for expiring secrets -:: - report %ames propagation errors to user -:: -:: - nice features: -:: - scry namespace -:: - task for converting invites to tickets -:: -=+ our=*@p -|= pit/vase -=, pki:jael -=, rights:jael -=, able:jael -=, title -=, crypto -=* womb womb:jael -=, jael -:: :::: -:::: # models :: data structures - :: :::: -:: the %jael state comes in two parts: absolute -:: and relative. -:: -:: ++state-absolute is objective -- defined without -:: reference to our ship. if you steal someone else's -:: private keys, we have a place to put them. when -:: others make promises to us, we store them in the -:: same structures we use to make promises to others. -:: -:: ++state-relative is subjective, denormalized and -:: derived. it consists of all the state we need to -:: manage subscriptions efficiently. -:: -=> |% -++ state :: all vane state - $: ver/$0 :: vane version - yen/(set duct) :: raw observers - urb/state-absolute :: all absolute state - sub/state-relative :: all relative state - == :: -++ state-relative :: urbit metadata - $: $= car :: secure channels - %+ map ship :: partner - $: yen/(set duct) :: trackers - det/channel :: channel state - == :: - $= rel :: neighborhood - $: dad/_our :: parent - cod/farm :: dependencies - pyr/(set ship) :: peers - kyz/(set ship) :: children - == :: - $= bal :: balance sheet - $: yen/(set duct) :: trackers - == :: - $= own :: vault - $: yen/(set duct) :: trackers - lyf/life :: version - jaw/(map life ring) :: private keys - == :: - == :: -++ state-absolute :: absolute urbit - $: pug/farm :: keys - pry/(map ship (map ship safe)) :: promises - == :: -:: :: -++ message :: p2p message - $% {$hail p/safe} :: reset rights - {$meet p/farm} :: propagate pki - == :: -++ card :: i/o action - (wind note gift) :: -:: :: -++ move :: output - {p/duct q/card} :: --- :: -:: :::: -:::: # data :: static data - :: :::: -=> |% -:: :: ++zeno -++ zeno :: boot fingerprints - :: - :: in ++zeno we hardcode the fingerprints of galaxies - :: and the identities of their owners. if the - :: fingerprint is 0, the galaxy can't be created. - :: - :: we'll probably move at least the identity data - :: into urbit as it becomes more stable, but keeping - :: it in the source makes it very resilient. - :: - |= who/ship - ^- @ - %+ snag who - ^- (list @uw) - :~ 0w0 :: 0, ~zod, urbit.org - 0w0 :: 1, ~nec, Curtis Yarvin - 0w0 :: 2, ~bud, Tlon Investor 1 - 0w0 :: 3, ~wes, Tlon Investor 2 - 0w0 :: 4, ~sev, Tlon Investor 2 - 0w0 :: 5, ~per, Tlon Investor 3 - 0w0 :: 6, ~sut, Tlon Investor 4 - 0w0 :: 7, ~let, Tlon Investor 4 - 0w0 :: 8, ~ful, Tlon Investor 4 - 0w0 :: 9, ~pen, Tlon Investor 4 - 0w0 :: 10, ~syt, Tlon Investor 4 - 0w0 :: 11, ~dur, Tlon Investor 4 - 0w0 :: 12, ~wep, Sam Putman - 0w0 :: 13, ~ser, Tlon Investor 5 - 0w0 :: 14, ~wyl, Zimran Ahmed - 0w0 :: 15, ~sun, Colin Smith - 0w0 :: 16, ~ryp, Tlon Investor 6 - 0w0 :: 17, ~syx, Tlon Investor 6 - 0w0 :: 18, ~dyr, Tlon Investor 6 - 0w0 :: 19, ~nup, Tlon Investor 6 - 0w0 :: 20, ~heb, Tlon Investor 6 - 0w0 :: 21, ~peg, Tlon Investor 6 - 0w0 :: 22, ~lup, Tlon Investor 6 - 0w0 :: 23, ~dep, Tlon Investor 6 - 0w0 :: 24, ~dys, Mike Gogulski - 0w0 :: 25, ~put, Tlon Investor 7 - 0w0 :: 26, ~lug, Tlon Investor 8 - 0w0 :: 27, ~hec, Tlon Investor 8 - 0w0 :: 28, ~ryt, Tlon Investor 8 - 0w0 :: 29, ~tyv, Tlon Investor 8 - 0w0 :: 30, ~syd, Jennifer Kollmer - 0w0 :: 31, ~nex, Prakhar Goel - 0w0 :: 32, ~lun, Tlon Investor 9 - 0w0 :: 33, ~mep, Tlon Investor 9 - 0w0 :: 34, ~lut, Tlon Investor 9 - 0w0 :: 35, ~sep, Tlon Investor 9 - 0w0 :: 36, ~pes, Jennifer Kollmer - 0w0 :: 37, ~del, Kingdon Barrett - 0w0 :: 38, ~sul, John Burnham - 0w0 :: 39, ~ped, Jeremy Wall - 0w0 :: 40, ~tem, Tlon Investor 10 - 0w0 :: 41, ~led, Nick Caruso - 0w0 :: 42, ~tul, Susan Yarvin - 0w0 :: 43, ~met, Susan Yarvin - 0w0 :: 44, ~wen, Susan Yarvin - 0w0 :: 45, ~byn, Susan Yarvin - 0w0 :: 46, ~hex, James Torre - 0w0 :: 47, ~feb, urbit.org - 0w0 :: 48, ~pyl, Michael Hartl - 0w0 :: 49, ~dul, Jennifer Kollmer - 0w0 :: 50, ~het, Jennifer Kollmer - 0w0 :: 51, ~mev, Herbert Yarvin - 0w0 :: 52, ~rut, Herbert Yarvin - 0w0 :: 53, ~tyl, Tlon Investor 11 - 0w0 :: 54, ~wyd, Curtis Yarvin - 0w0 :: 55, ~tep, Sibyl Kollmer - 0w0 :: 56, ~bes, Sibyl Kollmer - 0w0 :: 57, ~dex, Jared Hance - 0w0 :: 58, ~sef, Owen Rescher - 0w0 :: 59, ~wyc, Galen Wolfe-Pauly - 0w0 :: 60, ~bur, Galen Wolfe-Pauly - 0w0 :: 61, ~der, Galen Wolfe-Pauly - 0w0 :: 62, ~nep, Galen Wolfe-Pauly - 0w0 :: 63, ~pur, Herbert Yarvin - 0w0 :: 64, ~rys, Charlie Cummings - 0w0 :: 65, ~reb, Herbert Yarvin - 0w0 :: 66, ~den, Michael Hartl - 0w0 :: 67, ~nut, Henry Yarvin - 0w0 :: 68, ~sub, Henry Yarvin - 0w0 :: 69, ~pet, Henry Yarvin - 0w0 :: 70, ~rul, Henry Yarvin - 0w0 :: 71, ~syn, Henry Ault - 0w0 :: 72, ~reg, Henry Ault - 0w0 :: 73, ~tyd, Henry Ault - 0w0 :: 74, ~sup, Henry Ault - 0w0 :: 75, ~sem, Michael Livshin - 0w0 :: 76, ~wyn, Anton Dyudin - 0w0 :: 77, ~rec, Anton Dyudin - 0w0 :: 78, ~meg, Anton Dyudin - 0w0 :: 79, ~net, Anthony Martinez - 0w0 :: 80, ~sec, Curtis Yarvin - 0w0 :: 81, ~mul, Curtis Yarvin - 0w0 :: 82, ~nym, Max Greer - 0w0 :: 83, ~tev, Sibyl Kollmer - 0w0 :: 84, ~web, Ar Vicco - 0w0 :: 85, ~sum, Philip Monk - 0w0 :: 86, ~mut, Philip Monk - 0w0 :: 87, ~nyx, Philip Monk - 0w0 :: 88, ~rex, Tlon Investor 12 - 0w0 :: 89, ~teb, Sibyl Kollmer - 0w0 :: 90, ~fus, Tlon Corporation - 0w0 :: 91, ~hep, urbit.org - 0w0 :: 92, ~ben, urbit.org - 0w0 :: 93, ~mus, urbit.org - 0w0 :: 94, ~wyx, urbit.org - 0w0 :: 95, ~sym, urbit.org - 0w0 :: 96, ~sel, urbit.org - 0w0 :: 97, ~ruc, urbit.org - 0w0 :: 98, ~dec, urbit.org - 0w0 :: 99, ~wex, Pax Dickinson - 0w0 :: 100, ~syr, urbit.org - 0w0 :: 101, ~wet, urbit.org - 0w0 :: 102, ~dyl, urbit.org - 0w0 :: 103, ~myn, urbit.org - 0w0 :: 104, ~mes, urbit.org - 0w0 :: 105, ~det, urbit.org - 0w0 :: 106, ~bet, urbit.org - 0w0 :: 107, ~bel, urbit.org - 0w0 :: 108, ~tux, Tlon Investor 13 - 0w0 :: 109, ~tug, Philip Monk - 0w0 :: 110, ~myr, urbit.org - 0w0 :: 111, ~pel, urbit.org - 0w0 :: 112, ~syp, urbit.org - 0w0 :: 113, ~ter, urbit.org - 0w0 :: 114, ~meb, urbit.org - 0w0 :: 115, ~set, urbit.org - 0w0 :: 116, ~dut, urbit.org - 0w0 :: 117, ~deg, urbit.org - 0w0 :: 118, ~tex, urbit.org - 0w0 :: 119, ~sur, urbit.org - 0w0 :: 120, ~fel, urbit.org - 0w0 :: 121, ~tud, urbit.org - 0w0 :: 122, ~nux, urbit.org - 0w0 :: 123, ~rux, urbit.org - 0w0 :: 124, ~ren, urbit.org - 0w0 :: 125, ~wyt, urbit.org - 0w0 :: 126, ~nub, urbit.org - 0w0 :: 127, ~med, urbit.org - 0w0 :: 128, ~lyt, Arthur Breitman - 0w0 :: 129, ~dus, urbit.org - 0w0 :: 130, ~neb, urbit.org - 0w0 :: 131, ~rum, urbit.org - 0w0 :: 132, ~tyn, urbit.org - 0w0 :: 133, ~seg, urbit.org - 0w0 :: 134, ~lyx, urbit.org - 0w0 :: 135, ~pun, urbit.org - 0w0 :: 136, ~res, urbit.org - 0w0 :: 137, ~red, Alex Kravets - 0w0 :: 138, ~fun, Aaron Beckerman - 0w0 :: 139, ~rev, urbit.org - 0w0 :: 140, ~ref, Matt Brubeck - 0w0 :: 141, ~mec, urbit.org - 0w0 :: 142, ~ted, urbit.org - 0w0 :: 143, ~rus, Stephen Burnham - 0w0 :: 144, ~bex, urbit.org - 0w0 :: 145, ~leb, Justin LeBlanc - 0w0 :: 146, ~dux, urbit.org - 0w0 :: 147, ~ryn, urbit.org - 0w0 :: 148, ~num, Tlon - 0w0 :: 149, ~pyx, Katherine McFall - 0w0 :: 150, ~ryg, Dan Haffey - 0w0 :: 151, ~ryx, Tlon - 0w0 :: 152, ~fep, Tlon - 0w0 :: 153, ~tyr, Steve Dee - 0w0 :: 154, ~tus, Tlon - 0w0 :: 155, ~tyc, Tlon - 0w0 :: 156, ~leg, Tlon - 0w0 :: 157, ~nem, Tlon - 0w0 :: 158, ~fer, Tlon - 0w0 :: 159, ~mer, Tlon - 0w0 :: 160, ~ten, Tlon - 0w0 :: 161, ~lus, Tlon - 0w0 :: 162, ~nus, Tlon - 0w0 :: 163, ~syl, Tlon - 0w0 :: 164, ~tec, Tlon - 0w0 :: 165, ~mex, Tlon - 0w0 :: 166, ~pub, Tlon - 0w0 :: 167, ~rym, Tlon - 0w0 :: 168, ~tuc, Tlon - 0w0 :: 169, ~fyl, Tlon - 0w0 :: 170, ~lep, Tlon - 0w0 :: 171, ~deb, Tlon - 0w0 :: 172, ~ber, Tlon - 0w0 :: 173, ~mug, Tlon - 0w0 :: 174, ~hut, Tlon - 0w0 :: 175, ~tun, Tlon - 0w0 :: 176, ~byl, Tlon - 0w0 :: 177, ~sud, Tlon - 0w0 :: 178, ~pem, Tlon - 0w0 :: 179, ~dev, Tlon - 0w0 :: 180, ~lur, Tlon - 0w0 :: 181, ~def, Tlon - 0w0 :: 182, ~bus, Tlon - 0w0 :: 183, ~bep, Tlon - 0w0 :: 184, ~run, Tlon - 0w0 :: 185, ~mel, Tlon - 0w0 :: 186, ~pex, Tlon - 0w0 :: 187, ~dyt, Tlon - 0w0 :: 188, ~byt, Tlon - 0w0 :: 189, ~typ, Tlon - 0w0 :: 190, ~lev, Tlon - 0w0 :: 191, ~myl, Tlon - 0w0 :: 192, ~wed, Tlon - 0w0 :: 193, ~duc, Tlon - 0w0 :: 194, ~fur, Tlon - 0w0 :: 195, ~fex, Tlon - 0w0 :: 196, ~nul, Tlon - 0w0 :: 197, ~luc, Tlon - 0w0 :: 198, ~len, Tlon - 0w0 :: 199, ~ner, Tlon - 0w0 :: 200, ~lex, Michael Hartl - 0w0 :: 201, ~rup, Owen Rescher - 0w0 :: 202, ~ned, Tlon - 0w0 :: 203, ~lec, Tlon - 0w0 :: 204, ~ryd, Tlon - 0w0 :: 205, ~lyd, Adam Bliss - 0w0 :: 206, ~fen, Tlon - 0w0 :: 207, ~wel, Tlon - 0w0 :: 208, ~nyd, Tlon - 0w0 :: 209, ~hus, Tlon - 0w0 :: 210, ~rel, Tlon - 0w0 :: 211, ~rud, Tlon - 0w0 :: 212, ~nes, Tlon - 0w0 :: 213, ~hes, Tlon Investor 14 - 0w0 :: 214, ~fet, Tlon - 0w0 :: 215, ~des, Tlon - 0w0 :: 216, ~ret, Tlon - 0w0 :: 217, ~dun, Tlon - 0w0 :: 218, ~ler, Tlon - 0w0 :: 219, ~nyr, Ivan Matosevic - 0w0 :: 220, ~seb, Tlon - 0w0 :: 221, ~hul, Tlon - 0w0 :: 222, ~ryl, Tlon - 0w0 :: 223, ~lud, Tlon - 0w0 :: 224, ~rem, Tlon - 0w0 :: 225, ~lys, Tlon - 0w0 :: 226, ~fyn, Stephen Burnham - 0w0 :: 227, ~wer, Tlon - 0w0 :: 228, ~ryc, Tlon - 0w0 :: 229, ~sug, Tlon - 0w0 :: 230, ~nys, Tlon - 0w0 :: 231, ~nyl, Tlon - 0w0 :: 232, ~lyn, Tlon - 0w0 :: 233, ~dyn, Tlon - 0w0 :: 234, ~dem, Tlon - 0w0 :: 235, ~lux, Tlon Investor 15 - 0w0 :: 236, ~fed, Iceman - 0w0 :: 237, ~sed, Tlon - 0w0 :: 238, ~bec, Tlon - 0w0 :: 239, ~mun, Tlon - 0w0 :: 240, ~lyr, Tlon - 0w0 :: 241, ~tes, Tlon - 0w0 :: 242, ~mud, Ian Rowan - 0w0 :: 243, ~nyt, Byrne Hobart - 0w0 :: 244, ~byr, Tlon - 0w0 :: 245, ~sen, Tlon - 0w0 :: 246, ~weg, Tlon - 0w0 :: 247, ~fyr, Anton Dyudin - 0w0 :: 248, ~mur, Tlon - 0w0 :: 249, ~tel, Tlon - 0w0 :: 250, ~rep, Raymond Pasco - 0w0 :: 251, ~teg, Tlon - 0w0 :: 252, ~pec, Tlon - 0w0 :: 253, ~nel, Tlon - 0w0 :: 254, ~nev, Tlon - 0w0 :: 255, ~fes, John Burnham - == --- :: -:: :::: -:::: # light :: light cores - :: :::: -=> |% -:: :: ++py -:::: ## sparse/light :: sparse range - :: :::: -++ py - :: because when you're a star with 2^16 unissued - :: planets, a (set) is kind of lame... - :: - |_ a/pile - :: :: ++dif:py - ++ dif :: add/remove a->b - |= b/pile - ^- (pair pile pile) - [(sub(a b) a) (sub b)] - :: :: ++div:py - ++ div :: allocate - |= b/@ud - ^- (unit (pair pile pile)) - =< ?-(- $& [~ p], $| ~) - |- ^- (each (pair pile pile) @u) - ?: =(0 b) - [%& ~ a] - ?~ a [%| 0] - =/ al $(a l.a) - ?- -.al - $& [%& p.p.al a(l q.p.al)] - $| - =. b (^sub b p.al) - =/ top +((^sub q.n.a p.n.a)) - ?: =(b top) - [%& a(r ~) r.a] - ?: (lth b top) - :+ %& a(r ~, q.n (add p.n.a (dec b))) - =. p.n.a (add p.n.a b) - (uni(a r.a) [n.a ~ ~]) - =/ ar $(a r.a, b (^sub b top)) - ?- -.ar - $& [%& a(r p.p.ar) q.p.ar] - $| [%| :(add top p.al p.ar)] - == - == - :: - ++ gas :: ++gas:py - |= b/(list ship) ^- pile :: insert list - ?~ b a - $(b t.b, a (put i.b)) - :: :: ++gud:py - ++ gud :: validate - =| {bot/(unit ship) top/(unit ship)} - |- ^- ? - ?~ a & - ?& (lte p.n.a q.n.a) - ?~(top & (lth +(q.n.a) u.top)) - ?~(bot & (gth p.n.a +(u.bot))) - :: - ?~(l.a & (vor p.n.a p.n.l.a)) - $(a l.a, top `p.n.a) - :: - ?~(l.a & (vor p.n.a p.n.l.a)) - $(a r.a, bot `q.n.a) - == - :: :: ++int:py - ++ int :: intersection - |= b/pile ^- pile - ?~ a ~ - ?~ b ~ - ?. (vor p.n.a p.n.b) $(a b, b a) - ?: (gth p.n.a q.n.b) - (uni(a $(b r.b)) $(a l.a, r.b ~)) - ?: (lth q.n.a p.n.b) - (uni(a $(b l.b)) $(a r.a, l.b ~)) - ?: (gte p.n.a p.n.b) - ?: (lte q.n.a q.n.b) - [n.a $(a l.a, r.b ~) $(a r.a, l.b ~)] - [n.a(q q.n.b) $(a l.a, r.b ~) $(l.a ~, b r.b)] - %- uni(a $(r.a ~, b l.b)) - ?: (lte q.n.a q.n.b) - %- uni(a $(l.b ~, a r.a)) - [n.b(q q.n.a) ~ ~] - %- uni(a $(l.a ~, b r.b)) - [n.b ~ ~] - :: :: ++put:py - ++ put :: insert - |= b/@ ^- pile - (uni [b b] ~ ~) - :: :: ++sub:py - ++ sub :: subtract - |= b/pile ^- pile - ?~ b a - ?~ a a - ?: (gth p.n.a q.n.b) - $(b r.b, l.a $(a l.a, r.b ~)) - ?: (lth q.n.a p.n.b) - $(b l.b, r.a $(a r.a, l.b ~)) - %- uni(a $(a l.a, r.b ~)) - %- uni(a $(a r.a, l.b ~)) - ?: (gte p.n.a p.n.b) - ?: (lte q.n.a q.n.b) - ~ - $(b r.b, a [[+(q.n.b) q.n.a] ~ ~]) - ?: (lte q.n.a q.n.b) - $(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~]) - %- uni(a $(b r.b, a [[+(q.n.b) q.n.a] ~ ~])) - $(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~]) - :: - ++ tap - =| out/(list @u) - |- ^+ out - ?~ a out - $(a l.a, out (welp (gulf n.a) $(a r.a))) - :: :: ++uni:py - ++ uni :: merge two piles - |= b/pile - ^- pile - ?~ b a - ?~ a b - ?. (vor p.n.a p.n.b) $(a b, b a) - ?: (lth +(q.n.b) p.n.a) - $(b r.b, l.a $(a l.a, r.b ~)) - ?: (lth +(q.n.a) p.n.b) - $(b l.b, r.a $(a r.a, l.b ~)) - ?: =(n.a n.b) [n.a $(a l.a, b l.b) $(a r.a, b r.b)] - ?: (lth p.n.a p.n.b) - ?: (gth q.n.a q.n.b) - $(b l.b, a $(b r.b)) - $(b l.b, a $(b r.b, a $(b r.a, r.a ~, q.n.a q.n.b))) - ?: (gth q.n.a q.n.b) - $(a l.a, b $(a r.a, b $(a r.b, r.b ~, q.n.b q.n.a))) - $(a l.a, b $(a r.a)) - -- ::py -:: :: ++ry -:::: ## rights/light :: rights algebra - :: :::: -++ ry - :: - :: we need to be able to combine rights, and - :: track changes by taking differences between them. - :: - :: ++ry must always crash when you try to make it - :: do something that makes no sense. - :: - :: language compromises: the type system can't enforce - :: that lef and ryt match, hence the asserts. - :: - |_ $: :: lef: old right - :: ryt: new right - :: - lef/rite - ryt/rite - == - :: :: ++dif:ry - ++ dif :: r->l: {add remove} - ^- (pair (unit rite) (unit rite)) - |^ ?- -.lef - $apple ?>(?=($apple -.ryt) (table %apple p.lef p.ryt)) - $block ?>(?=($block -.ryt) [~ ~]) - $email ?>(?=($email -.ryt) (sable %email p.lef p.ryt)) - $final ?>(?=($final -.ryt) (cable %final p.lef p.ryt)) - $fungi ?>(?=($fungi -.ryt) (noble %fungi p.lef p.ryt)) - $guest ?>(?=($guest -.ryt) [~ ~]) - $hotel ?>(?=($hotel -.ryt) (bible %hotel p.lef p.ryt)) - $jewel ?>(?=($jewel -.ryt) (table %jewel p.lef p.ryt)) - $login ?>(?=($login -.ryt) (sable %login p.lef p.ryt)) - $pword ?>(?=($pword -.ryt) (ruble %pword p.lef p.ryt)) - $token ?>(?=($token -.ryt) (ruble %token p.lef p.ryt)) - $urban ?>(?=($urban -.ryt) (table %urban p.lef p.ryt)) - == - :: :: ++cable:dif:ry - ++ cable :: diff atom - |* {nut/@tas new/@ old/@} - ?: =(new old) [~ ~] - [`[nut new] `[nut old]] - :: :: ++bible:dif:ry - ++ bible :: diff pile - |* {nut/@tas new/(map dorm pile) old/(map dorm pile)} - =/ mor/_old - %- ~(rep by old) - |= {{cur/dorm fid/pile} acc/_^+(old ~)} - =. fid - (~(sub py fid) (fall (~(get by new) cur) ~)) - ?~ fid acc - (~(put by acc) cur fid) - :: - =/ les/_new - %- ~(rep by new) - |= {{cur/dorm fid/pile} acc/_^+(new ~)} - =. fid - (~(sub py fid) (fall (~(get by old) cur) ~)) - ?~ fid acc - (~(put by acc) cur fid) - :: - :- ?~(mor ~ `[nut mor]) - ?~(les ~ `[nut les]) - :: :: ++noble:dif:ry - ++ noble :: diff map of @ud - |* {nut/@tas new/(map * @ud) old/(map * @ud)} - ^- (pair (unit rite) (unit rite)) - =/ mor/_old - %- ~(rep by old) - |* {{cur/* fid/@ud} acc/_^+(old ~)} - => .(+< `_[[cur fid]=-.new acc=old]`+<) - =. fid - (^sub fid (max fid (fall (~(get by new) cur) 0))) - ?~ fid acc - (~(put by acc) cur fid) - :: - =/ les/_new - %- ~(rep by new) - |* {{cur/* fid/@ud} acc/_^+(new ~)} - => .(+< `_[[cur fid]=-.old acc=new]`+<) - =. fid - (^sub fid (max fid (fall (~(get by old) cur) 0))) - ?~ fid acc - (~(put by acc) cur fid) - :: - :- ?~(mor ~ `[nut mor]) - ?~(les ~ `[nut les]) - :: :: ++ruble:dif:ry - ++ ruble :: diff map of maps - |* {nut/@tas new/(map * (map)) old/(map * (map))} - =/ mor/_old - %- ~(rep by old) - |* {{cur/* fid/(map)} acc/_^+(old ~)} - => .(+< `_[[cur fid]=n.-.new acc=old]`+<) - =. fid - (~(dif by ,.fid) (fall (~(get by new) cur) ~)) - ?~ fid acc - (~(put by acc) cur fid) - :: - =/ les/_new - %- ~(rep by new) - |* {{cur/* fid/(map)} acc/_^+(new ~)} - => .(+< `_[[cur fid]=n.-.old acc=new]`+<) - =. fid - (~(dif by ,.fid) (fall (~(get by old) cur) ~)) - ?~ fid acc - (~(put by acc) cur fid) - :: - :- ?~(mor ~ `[nut mor]) - ?~(les ~ `[nut les]) - :: :: ++sable:dif:ry - ++ sable :: diff set - |* {nut/@tas new/(set) old/(set)} - =/ mor (~(dif in new) old) - =/ les (~(dif in old) new) - :- ?~(mor ~ `[nut mor]) - ?~(les ~ `[nut les]) - :: :: ++table:dif:ry - ++ table :: diff map - |* {nut/@tas new/(map) old/(map)} - ^- (pair (unit rite) (unit rite)) - =/ ped (~(dep by old) new) - :- ?~(p.ped ~ `[nut p.ped]) - ?~(q.ped ~ `[nut q.ped]) - -- ::dif - :: :: ++sub:ry - ++ sub :: l - r - ^- (unit rite) - =/ vid dif - ?>(?=($~ q.vid) p.vid) - :: :: ++add:ry - ++ uni :: lef new, ryt old - ^- rite - |^ ?- -.lef - $apple ?>(?=($apple -.ryt) [%apple (table p.lef p.ryt)]) - $block ?>(?=($block -.ryt) [%block ~]) - $email ?>(?=($email -.ryt) [%email (sable p.lef p.ryt)]) - $final ?>(?=($final -.ryt) [%final (cable p.lef p.ryt)]) - $fungi ?>(?=($fungi -.ryt) [%fungi (noble p.lef p.ryt)]) - $guest ?>(?=($guest -.ryt) [%guest ~]) - $hotel ?>(?=($hotel -.ryt) [%hotel (bible p.lef p.ryt)]) - $jewel ?>(?=($jewel -.ryt) [%jewel (table p.lef p.ryt)]) - $login ?>(?=($login -.ryt) [%login (sable p.lef p.ryt)]) - $pword ?>(?=($pword -.ryt) [%pword (ruble p.lef p.ryt)]) - $token ?>(?=($token -.ryt) [%token (ruble p.lef p.ryt)]) - $urban ?>(?=($urban -.ryt) [%urban (table p.lef p.ryt)]) - == - :: :: ++cable:uni:ry - ++ cable :: union atom - |= {new/@ old/@} - ?> =(new old) - new - :: :: ++bible:uni:ry - ++ bible :: union pile - |= {new/(map dorm pile) old/(map dorm pile)} - ^+ new - %- (~(uno by old) new) - |= (trel dorm pile pile) - (~(uni py q) r) - :: :: ++noble:uni:ry - ++ noble :: union map of @ud - |= {new/(map term @ud) old/(map term @ud)} - ^+ new - %- (~(uno by old) new) - |= (trel term @ud @ud) - (add q r) - :: :: ++ruble:uni:ry - ++ ruble :: union map of maps - |= {new/(map site (map @t @t)) old/(map site (map @t @t))} - ^+ new - %- (~(uno by old) new) - |= (trel site (map @t @t) (map @t @t)) - %- (~(uno by q) r) - |= (trel @t @t @t) - ?>(=(q r) r) - :: :: ++sable:uni:ry - ++ sable :: union set - |* {new/(set) old/(set)} - ^+ new - (~(uni in old) new) - :: :: ++table:uni:ry - ++ table :: union map - |* {new/(map) old/(map)} - ^+ new - %- (~(uno by old) new) - |= (trel _p.-<.new _q.->.new _q.->.new) - ?>(=(q r) r) - -- ::uni - -- ::ry -:: :: ++up -:::: ## wallet^light :: wallet algebra - :: :::: -++ up - :: a set of rites is stored as a tree (++safe), sorted - :: by ++gor on the stem, balanced by ++vor on the stem. - :: (this is essentially a ++map with stem as key, but - :: ++map doesn't know how to link stem and bulb types.) - :: the goal of the design is to make it easy to add new - :: kinds of rite without a state adapter. - :: - :: wallet operations always crash if impossible; - :: %jael has no concept of negative rights. - :: - :: performance issues: ++differ and ++splice, naive. - :: - :: external issues: much copy and paste from ++by. it - :: would be nice to resolve this somehow, but not urgent. - :: - :: language issues: if hoon had an equality test - :: that informed inference, ++expose could be - :: properly inferred, eliminating the ?>. - :: - |_ pig/safe - :: :: ++delete:up - ++ delete :: delete right - |= ryt/rite - ^- safe - ?~ pig - !! :: not found - ?. =(-.ryt -.n.pig) - ?: (gor -.ryt -.n.pig) - [n.pig $(pig l.pig) r.pig] - [n.pig l.pig $(pig r.pig)] - =/ dub ~(sub ry n.pig ryt) - ?^ dub [u.dub l.pig r.pig] - |- ^- safe - ?~ l.pig r.pig - ?~ r.pig l.pig - ?: (vor -.n.l.pig -.n.r.pig) - [n.l.pig l.l.pig $(l.pig r.l.pig)] - [n.r.pig $(r.pig l.r.pig) r.r.pig] - :: :: ++differ:up - ++ differ :: delta pig->gob - |= gob/safe - ^- bump - |^ [way way(pig gob, gob pig)] - ++ way - %- intern(pig ~) - %+ skip linear(pig gob) - |=(rite (~(has in pig) +<)) - -- - :: :: ++exists:up - ++ exists :: test presence - |= tag/@tas - !=(~ (expose tag)) - :: :: ++expose:up - ++ expose :: typed extract - |= tag/@tas - ^- (unit rite) - ?~ pig ~ - ?: =(tag -.n.pig) - [~ u=n.pig] - ?:((gor tag -.n.pig) $(pig l.pig) $(pig r.pig)) - :: :: ++insert:up - ++ insert :: insert item - |= ryt/rite - ^- safe - ?~ pig - [ryt ~ ~] - ?: =(-.ryt -.n.pig) - ?: =(+.ryt +.n.pig) - pig - [~(uni ry ryt n.pig) l.pig r.pig] - ?: (gor -.ryt -.n.pig) - =+ nex=$(pig l.pig) - =. l.pig nex - ?> ?=(^ l.pig) - ?: (vor -.n.pig -.n.l.pig) - [n.pig l.pig r.pig] - [n.l.pig l.l.pig [n.pig r.l.pig r.pig]] - =+ nex=$(pig r.pig) - =. r.pig nex - ?> ?=(^ r.pig) - ?: (vor -.n.pig -.n.r.pig) - [n.pig l.pig r.pig] - [n.r.pig [n.pig l.pig l.r.pig] r.r.pig] - :: :: ++intern:up - ++ intern :: insert list - |= lin/(list rite) - ^- safe - ?~ lin pig - =. pig $(lin t.lin) - (insert i.lin) - :: :: ++linear:up - ++ linear :: convert to list - =| lin/(list rite) - |- ^+ lin - ?~ pig ~ - $(pig r.pig, lin [n.pig $(pig l.pig)]) - :: :: ++redact:up - ++ redact :: conceal secrets - |- ^- safe - ?~ pig ~ - :_ [$(pig l.pig) $(pig r.pig)] - =* rys n.pig - ^- rite - ?+ -.rys rys - $apple - [%apple (~(run by p.rys) |=(@ (mug +<)))] - :: - $final - [%final (mug p.rys)] - :: - $login - [%login ~] - :: - $pword - :- %pword - %- ~(run by p.rys) - |= (map @ta @t) - (~(run by +<) |=(@t (fil 3 (met 3 +<) '*'))) - :: - $jewel - [%jewel (~(run by p.rys) |=(@ (mug +<)))] - :: - $token - :- %token - %- ~(run by p.rys) - |=((map @ta @) (~(run by +<) |=(@ (mug +<)))) - :: - $urban - [%urban (~(run by p.rys) |=({@da code:ames} [+<- (mug +<+)]))] - == - :: :: ++remove:up - ++ remove :: pig minus gob - |= gob/safe - ^- safe - =/ buv (~(tap by gob)) - |- ?~ buv pig - $(buv t.buv, pig (delete i.buv)) - :: :: ++splice:up - ++ splice :: pig plus gob - |= gob/safe - ^- safe - =/ buv (~(tap by gob)) - |- ?~ buv pig - $(buv t.buv, pig (insert i.buv)) - :: :: ++update:up - ++ update :: arbitrary change - |= del/bump - ^- safe - (splice(pig (remove les.del)) mor.del) - -- -:: :: ++we -:::: ## will^light :: will functions - :: :::: -++ we - |_ pub/will - :: :: ++collate:we - ++ collate :: sort by version - |= ord/$-({{life cert} {life cert}} ?) - ^- (list (pair life cert)) - (sort (~(tap by pub)) ord) - :: :: ++current:we - ++ current :: current number - ^- (unit life) - (bind instant |=((pair life cert) p)) - :: :: ++forward:we - ++ forward :: sort oldest first - (collate |=({{a/life *} {b/life *}} (lth a b))) - :: :: ++instant:we - ++ instant :: current cert - ^- (unit (pair life cert)) - =+ reverse - ?~(- ~ `i) - :: :: ++reverse:we - ++ reverse :: sort latest first - (collate |=({{a/life *} {b/life *}} (gth a b))) - -- --- -:: :::: -:::: # heavy :: heavy engines - :: :::: -=> |% -:: :: ++of -:::: ## main^heavy :: main engine - :: :::: -++ of - :: this core handles all top-level %jael semantics, - :: changing state and recording moves. - :: - :: logically we could nest the ++su and ++ur cores - :: within it, but we keep them separated for clarity. - :: the ++curd and ++cure arms complete relative and - :: absolute effects, respectively, at the top level. - :: - :: a general pattern here is that we use the ++ur core - :: to generate absolute effects (++change), then invoke - :: ++su to calculate the derived effect of these changes. - :: - :: arvo issues: should be merged with the top-level - :: vane interface when that gets cleaned up a bit. - :: - =| moz/(list move) - =| $: :: sys: system context - :: - $= sys - $: :: now: current time - :: eny: unique entropy - :: - now/@da - eny/@e - == - :: all vane state - :: - state - == - :: lex: all durable state - :: moz: pending actions - :: - =* lex -> - |% - :: :: ++abet:of - ++ abet :: resolve - [(flop moz) lex] - :: :: ++burb:of - ++ burb :: per ship - |= who/ship - ~(able ~(ex ur urb) who) - :: - ++ read-womb - =, wired :: XX ":eyre" - =, womb - |= pax/path ^- (unit scry:womb) - ?~ pax ~ - ?+ i.pax ~ - $balance - %+ bind (read t.pax /[%uv]) - |=(a/passcode [%balance a]) - :: - $stats - %+ bind (read t.pax /[%p]) - |=(a/ship [%stats a]) - :: - $shop - %+ biff (read t.pax /[%tas]/[%ud]) - |= {typ/term nth/@u} - ?. ?=(?($star $planet) typ) ~ - `[%shop typ nth] - == - :: :: ++scry:of - ++ scry :: read - |= {syd/@tas pax/path} ^- (unit gilt) - ?+ syd ~ - $womb (biff (read-womb pax) scry-womb:(burb our)) - == - :: :: ++call:of - ++ call :: invoke - |= $: :: hen: event cause - :: tac: event data - :: - hen/duct - tac/task - == - ^+ +> - ?- -.tac - :: - :: destroy promises - :: {$ktsg p/ship q/safe} - :: - $ktsg - (cure abet:abet:(deal:(burb our) p.tac [~ q.tac])) - :: - :: remote update - :: {$hail p/ship q/remote} - :: - $hail - (cure abet:abet:(hail:(burb p.tac) our q.tac)) - :: - :: initialize vane - :: {$init p/code q/arms} - :: - $init - (cure abet:abet:(make:(burb our) now.sys eny.sys p.tac q.tac)) - :: - :: create promises - :: {$mint p/ship q/safe} - :: - $mint - (cure abet:abet:(deal:(burb our) p.tac [q.tac ~])) - - :: - :: move promises - :: {$move p/ship q/ship r/safe} - :: - $move - =. +> (cure abet:abet:(deal:(burb our) p.tac [~ r.tac])) - =. +> (cure abet:abet:(deal:(burb our) q.tac [r.tac ~])) - +> - :: - :: public-key update - :: {$meet p/(unit (unit ship)) q/farm} - :: - $meet - (cure abet:(~(meet ur urb) p.tac q.tac)) - :: - :: cancel all trackers from duct - :: {$nuke $~} - :: - $nuke - %_ +> - yen (~(del in yen) hen) - yen.bal.sub (~(del in yen.bal.sub) hen) - yen.own.sub (~(del in yen.own.sub) hen) - car.sub %- ~(run by car.sub) - |= {yen/(set duct) det/channel} - [(~(del in yen) hen) det] - == - :: - :: extend our certificate with a new private key - :: {$next p/bull} - :: - $next - (cure abet:abet:(next:(burb our) eny.sys p.tac)) - :: - :: - :: extend our certificate with a new private key - :: {$jaelwomb p/task:womb} - :: - $jaelwomb - (cure abet:abet:(jaelwomb:(burb our) p.tac)) - :: - :: open secure channel - :: {$veil p/ship} - :: - $veil - (curd abet:(~(veil ~(feed su urb sub) hen) p.tac)) - :: - :: watch private keys - :: {$vein $~} - :: - $vein - (curd abet:~(vein ~(feed su urb sub) hen)) - :: - :: monitor assets - :: {$vest $~} - :: - $vest - (curd abet:~(vest ~(feed su urb sub) hen)) - :: - :: monitor all - :: {$vine $~} - :: - $vine - +>(yen (~(put in yen) hen)) - :: - :: authenticated remote request - :: {$west p/ship q/path r/*} - :: - $west - ?> =(~ q.tac) - =+ mes=((hard message) r.tac) - ?- -.mes - :: - :: reset remote rights - :: {$hail p/safe} - :: - $hail - (cure abet:abet:(hail:(burb p.tac) our [%| p.mes])) - :: - :: share certificates - :: {$meet p/farm} - :: - $meet - (cure abet:(~(meet ur urb) ``p.tac p.mes)) - == - == - :: :: ++curd:of - ++ curd :: relative moves - |= {moz/(list move) sub/state-relative} - +>(sub sub, moz (weld (flop moz) ^moz)) - :: :: ++cure:of - ++ cure :: absolute edits - |= {hab/(list change) urb/state-absolute} - ^+ +> - (curd(urb urb) abet:(~(apex su urb sub) hab)) - -- -:: :: ++su -:::: ## relative^heavy :: subjective engine - :: :::: -++ su - :: the ++su core handles all derived state, - :: subscriptions, and actions. - :: - :: ++feed:su registers subscriptions, and also - :: drives certificate propagation when a %veil - :: (secure channel) subscription is created. - :: - :: ++feel:su checks if a ++change should notify - :: any subscribers. - :: - :: ++fire:su generates outgoing network messages. - :: - :: ++form:su generates the actual report data. - :: - =| moz/(list move) - =| $: state-absolute - state-relative - == - :: moz: moves in reverse order - :: urb: absolute urbit state - :: sub: relative urbit state - :: - =* urb -< - =* sub -> - |% - :: :: ++abet:su - ++ abet :: resolve - [(flop moz) sub] - :: :: ++apex:su - ++ apex :: apply changes - |= hab/(list change) - ^+ +> - ?~ hab +> - %= $ - hab t.hab - +> - ?- -.i.hab - $rite (paid +.i.hab) - $fact (said +.i.hab) - == - == - :: :: ++exec:su - ++ exec :: mass gift - |= {yen/(set duct) cad/card} - =/ noy (~(tap in yen)) - |- ^+ ..exec - ?~ noy ..exec - $(noy t.noy, moz [[i.noy cad] moz]) - :: :: ++feed:su - ++ feed :: subscribe to view - |_ :: hen: subscription source - :: - hen/duct - :: :: ++veil:feed:su - ++ veil :: secure channel - |= who/ship - ^+ ..feed - :: - :: send initial pki sync as needed - :: - =. ..feed (open hen who) - =/ ruc (~(get by car) who) - =/ rec - ?~ ruc - [`yen/(set duct)`[hen ~ ~] det=(veil:form who)] - u.ruc(yen (~(put in yen.u.ruc) hen)) - %_ ..feed - moz [[hen %give %veil det.rec] moz] - car (~(put by car) who rec) - == - :: :: ++vein:feed:su - ++ vein :: private keys - %_ ..feed - moz [[hen %give %vein [lyf jaw]:own] moz] - yen.own (~(put in yen.own) hen) - == - :: :: ++vest:feed:su - ++ vest :: balance - %_ ..feed - moz [[hen %give %vest %& vest:form] moz] - yen.bal (~(put in yen.bal) hen) - == - -- - :: :: ++feel:su - ++ feel :: update tracker - |% - :: :: ++veal:feel:su - ++ veal :: kick subfarm - ^+ ..feel - =/ cod veal:form - ?:(=(cod.rel cod) ..feel ..feel(cod.rel cod)) - :: :: ++veil:feel:su - ++ veil :: kick secure channel - |= who/ship - ^+ ..feel - =/ ruc (~(get by car) who) - ?~ ruc ..feel - =/ det (veil:form who) - ?: =(det det.u.ruc) ..feel - =. car (~(put by car) who [yen.u.ruc det]) - (exec yen.u.ruc [%give %veil det]) - :: :: ++vein:feel:su - ++ vein :: kick private keys - ^+ ..feel - =/ yam vein:form - ?: =(yam +.own) ..feel - (exec(+.own yam) yen.own [%give %vein +.own]) - :: :: ++vest:feel:su - ++ vest :: kick balance - |= hug/action - ^+ ..feel - ?: =([~ ~] +.q.hug) ..feel - :: - :: notify all local listeners - :: - =. ..feel (exec yen.bal [%give %vest %| p.hug q.hug]) - :: - :: pig: purse report for partner - :: - ?. ?=($| -.q.hug) ..feel - =* pig (~(lawn ur urb) our p.hug) - %_ ..feel - moz :_ moz - [*duct %pass /vest/(scot %p p.hug) %x %mess p.hug /j %hail pig] - == - -- - :: :: ++fire:su - ++ fire :: propagate keys - |_ hec/farm - ++ home :: ++home:su - |= who/ship :: to ship - %_ ..fire - moz - :_ moz - [*duct %pass /meet/(scot %p who) %x %mess who /j [%meet hec]] - == - :: :: ++flow:su - ++ flow :: to set of ships - |= tar/(set ship) - =+ rot=(~(tap in (~(del in tar) our))) - |- ^+ ..fire - ?~ rot ..fire - $(rot t.rot, ..fire (home i.rot)) - :: :: ++spam:su - ++ spam :: to list of sets - |= {via/(unit ship) jax/(list (set ship))} - ^+ ..fire - =- (flow ?~(via - (~(del in -) u.via))) - |- ^- (set ship) - ?~(jax ~ (~(uni in i.jax) $(jax t.jax))) - -- - :: :: ++form:su - ++ form :: generate reports - |% - :: :: ++veal:form:su - ++ veal :: public dependencies - =| sea/(set ship) - =| out/farm - =/ mor `(set ship)`[our ~ ~] - |- ^- farm - ?: =(~ mor) out - :: - :: nex: all wills to add - :: - =/ nex - =/ rom (~(tap in mor)) - |- ^- farm - ?~ rom ~ - %+ ~(put by $(rom t.rom)) - i.rom - (~(got by pug.urb) i.rom) - :: - :: wit: all new ships in these wills - :: - =. sea (~(uni in sea) mor) - =/ wit - =| wit/(set ship) - =/ fem (~(tap by nex)) - |- ^+ wit - ?~ fem wit - =. wit $(fem t.fem) - =/ naw (~(tap by q.i.fem)) - |- ^+ wit - ?~ naw wit - =. wit $(naw t.naw) - =* dad dad.doc.dat.q.i.naw - ?: (~(has in sea) dad) wit - (~(put in wit) dad) - :: - :: repeat, flushing output - :: - $(mor wit, out (~(uni by out) nex)) - :: :: ++veil:form:su - ++ veil :: channel report - |= who/ship - ^- channel - :: - :: pub: will of who - :: exp: promises from our to who - :: imp: promises from who to our - :: out: symmetric key from our to who - :: inn: symmetric keys from who to our - :: - =/ pub - ^- will - =- ?~(- ~ u.-) - (~(get by pug.urb) who) - :: - =/ exp - ^- safe - =- ?~(- ~ u.-) - (~(get by (~(got by pry.urb) our)) who) - :: - =/ imp - ^- safe - =- ?~(- ~ u.-) - %. our - ~(get by (fall (~(get by pry.urb) who) *(map ship safe))) - :: - =* out - ^- (unit (pair hand bill)) - =+ (~(expose up exp) %urban) - ?~ - ~ - ?> ?=($urban -.u.-) - =* pam p.u.- - ?~ pam ~ - :: arbitrarily select root node of the map - :: - `n.pam - :: - =* inn - =+ (~(expose up imp) %urban) - ^- (map hand bill) - ?~ - ~ - ?> ?=($urban -.u.-) - p.u.- - :: - ^- channel - [out inn ~(current we pub) (~(dads ur urb) who) pub] - :: :: ++vein:form:su - ++ vein :: private key report - ^- (pair life (map life ring)) - (~(lean ur urb) our) - :: :: ++vest:form:su - ++ vest :: balance report - ^- balance - :- :: - :: raw: all our liabilities by ship - :: dud: delete liabilities to self - :: cul: mask secrets - :: - =* raw =-(?~(- ~ u.-) (~(get by pry.urb) our)) - =* dud (~(del by raw) our) - =* cul (~(run by dud) |=(safe ~(redact up +<))) - cul - :: - :: fub: all assets by ship - :: veg: all nontrivial assets, secrets masked - :: - =/ fub - ^- (list (pair ship (unit safe))) - %+ turn - (~(tap by pry.urb)) - |= (pair ship (map ship safe)) - [p (~(get by q) our)] - =* veg - |- ^- (list (pair ship safe)) - ?~ fub ~ - =+ $(fub t.fub) - ?~(q.i.fub - [[p.i.fub ~(redact up u.q.i.fub)] -]) - :: - (~(gas by *(map ship safe)) veg) - -- - :: :: ++open:su - ++ open :: make secure channel - |= $: hen/duct - who/ship - == - ^+ +> - :: - :: a one-time operation to create a secure channel - :: - ?: (~(has by car) who) +> - :: - :: initial propagation: ourself and dependencies, plus - :: all capital ships if meeting a child. - :: - =* hec ^- farm - ?. (~(has in kyz.rel) who) cod.rel - =- (~(uni by cod.rel) -) - %- ~(gas by *farm) - %+ skim (~(tap by pug.urb)) - |=({who/ship *} (lth who 65.536)) - :: - (~(home fire hec) who) - :: :: ++paid:su - ++ paid :: track asset change - |= $: :: rex: promise from - :: pal: promise to - :: del: change to existing - :: bur: changes to symmetric keys - :: - rex/ship - pal/ship - del/bump - == - ^+ +> - =* bur ?| (~(exists up mor.del) %urban) - (~(exists up les.del) %urban) - == - :: ignore empty delta; keep secrets out of metadata - :: - ?: =([~ ~] del) +> - =. del [~(redact up mor.del) ~(redact up les.del)] - ?. =(our pal) - :: - :: track promises we made to others - :: - ?. =(our rex) +> - :: - :: track liabilities - :: - =. +> (vest:feel pal %& del) - :: - :: track secure channels - :: - ?. bur +> - (veil:feel pal) - :: - :: track private keys - :: - =? +> (~(exists up mor.del) %jewel) - vein:feel - :: - :: track changes in secure channels - :: - ?. bur +> - (veil:feel rex) - :: :: ++said:su - ++ said :: track cert change - |= $: :: rex: ship whose will has changed - :: vie: change authorized by - :: lyf: modified/created version - :: gan: modification - :: - rex/ship - vie/(unit (unit ship)) - lyf/life - gan/growth - == - :: lip: this change as its own farm - :: - =/ lip ^- farm - =- [[rex -] ~ ~] - ^- will - =- [[lyf -] ~ ~] - ^- cert - ?- -.gan - :: - :: add a new certificate to this will - :: {$step p/cert} - :: - $step p.gan - :: - :: add a new signature to this certificate - :: {$sign p/mind q/@} - :: - $sign - :- dat:(~(got by (~(got by pug.urb) rex)) lyf) - =- [- ~ ~] - [who.p.gan lyf.p.gan q.gan] - == - :: - :: if our subfarm may have changed, reset it - :: - =? +>.$ |(=(our rex) (~(has by cod.rel) rex)) - veal:feel - :: - :: if a new deed, reset parent - :: - =? dad.rel &(=(our rex) ?=($step -.gan)) - dad.doc.dat.p.gan - :: - :: kick secure channels - :: - =. +>.$ (veil:feel rex) - :: - :: if we signed a will for someone else, send it home - :: - ?: &(=([~ ~] vie) !=(our rex)) - (~(home fire lip) rex) - :: - :: if first certificate, add to neighbor lists - :: - =? +>.$ &(?=($step -.gan) =(1 lyf)) - =? kyz.rel =(our dad.doc.dat.p.gan) - (~(put in kyz.rel) rex) - =? pyr.rel =((clan rex) (clan our)) - (~(put in pyr.rel) rex) - +>.$ - :: - :: propagate new data as appropriate - :: - %+ ~(spam fire lip) - ?~(vie ~ ?~(u.vie ~ `u.u.vie)) - ^- (list (set ship)) - :: - :: if our will has changed, send to parents and kids; - :: if a new deed has been added, also to pals - :: - ?: =(our rex) - :* [dad.rel ~ ~] - kyz.rel - ?.(=(%step -.gan) ~ [pyr.rel ~]) - == - :: - :: forward star and galaxy updates to parents and kids - :: - ?. (lth rex 65.536) - ~ - :* [dad.rel ~ ~] - kyz.rel - ~ - == - -- -:: :: ++ur -:::: ## absolute^heavy :: objective engine - :: :::: -++ ur - :: the ++ur core handles primary, absolute state. - :: it is the best reference for the semantics of - :: the urbit pki. - :: - =* our !! - :: - :: it is absolutely verboten to use [our] in ++ur. - :: - =| hab/(list change) - =| state-absolute - :: - :: hab: side effects, reversed - :: urb: all urbit state - :: - =* urb - - |% - :: :: ++abet:ur - ++ abet :: resolve - [(flop hab) `state-absolute`urb] - :: :: ++boss:ur - ++ boss :: parent - |= who/ship - ^- ship - -:(dads who) - :: - ++ dads :: ++dads:ur - |= who/ship :: lineage - ^- (list ship) - =/ ryg (~(get by pug) who) - ?~ ryg (saxo who) - =/ dad dad.doc.dat.q:(need ~(instant we u.ryg)) - [who ?:(=(who dad) ~ $(who dad))] - :: - ++ lawn :: ++lawn:ur - |= {rex/ship pal/ship} :: debts, rex to pal - ^- safe - (lawn:~(able ex rex) pal) - :: :: ++leak:ur - ++ leak :: private key - |= rex/ship - ^- (pair life ring) - =/ lyn lean:~(able ex rex) - [p.lyn (~(got by q.lyn) p.lyn)] - :: :: ++lean:ur - ++ lean :: private keys - |= rex/ship - ^- (pair life (map life ring)) - lean:~(able ex rex) - :: :: ++meet:ur - ++ meet :: calculate merge - |= $: :: vie: authenticated source - :: cod: transmitted certificates - :: - vie/(unit (unit ship)) - cod/farm - == - ^+ +> - =+ lec=(~(tap by cod)) - |- ^+ ..meet - ?~ lec ..meet - %= $ - lec t.lec - ..meet abet:(grow:~(able ex p.i.lec) vie cod q.i.lec) - == - :: :: ++ex:ur - ++ ex :: server engine - :: shy: private state - :: rug: domestic will - :: - =| $: shy/(map ship safe) - rug/will - == - =| :: rex: server ship - :: - rex/ship - |% - :: :: ++abet:ex:ur - ++ abet :: resolve - %_ ..ex - pry (~(put by pry) rex shy) - pug (~(put by pug) rex rug) - == - :: :: ++able:ex:ur - ++ able :: initialize - %_ . - shy (fall (~(get by pry) rex) *(map ship safe)) - rug (fall (~(get by pug) rex) *will) - == - :: :: ++deal:ex:ur - ++ deal :: alter rights - |= {pal/ship del/bump} - ^+ +> - =/ gob (fall (~(get by shy) pal) *safe) - =* hep (~(update up gob) del) - %_ +>.$ - shy (~(put by shy) pal hep) - hab [[%rite rex pal del] hab] - == - :: - ++ hail :: ++hail:ex:ur - |= {pal/ship rem/remote} :: report rights - ^+ +> - =/ gob (fall (~(get by shy) pal) *safe) - =/ yer ^- (pair bump safe) - ?- -.rem - $& [[p.rem ~] (~(splice up gob) p.rem)] - $| [(~(differ up gob) p.rem) p.rem] - == - %_ +>.$ - shy (~(put by shy) pal q.yer) - hab [[%rite rex pal p.yer] hab] - == - :: :: ++lean:ex:ur - ++ lean :: private keys - ^- (pair life (map life ring)) - :: - :: lyf: latest life of - :: lab: promises by rex - :: par: promises by rex, to rex - :: jel: %jewel rights - :: - =/ lyf `life`(need ~(current we (~(got by pug) rex))) - =* lab (~(got by pry) rex) - =* par (~(got by lab) rex) - =/ jel `rite`(need (~(expose up par) %jewel)) - ?> ?=($jewel -.jel) - [lyf p.jel] - :: :: ++lawn:ex:ur - ++ lawn :: liabilities to pal - |= pal/ship - ^- safe - =-(?~(- ~ u.-) (~(get by shy) pal)) - :: :: ++make:ex:ur - ++ make :: initialize urbit - |= $: :: now: date - :: eny: entropy - :: gen: bootstrap ticket - :: nym: self-description - :: - now/@da - eny/@e - gen/@pG - nym/arms - == - ^+ +> - :: - :: register generator as login secret - :: - =. +>.$ (deal rex [[[%login [gen ~ ~]] ~ ~] ~]) - :: - :: initialize hierarchical property - :: - =. +>.$ - =- (deal rex - ~) - ^- safe - %- intern:up - ^- (list rite) - =/ mir (clan rex) - ?+ mir ~ - $czar - :~ [%fungi [%usr 255] ~ ~] - [%hotel [[rex 3] [1 255] ~ ~] ~ ~] - == - $king - :~ [%fungi [%upl 65.535] ~ ~] - [%hotel [[rex 4] [1 65.535] ~ ~] ~ ~] - == - $duke - :~ [%hotel [[rex 5] [1 0xffff.ffff] ~ ~] ~ ~] - == - == - :: - :: create initial communication secrets - :: - :: key: generated key - :: bul: initial bull - :: - =/ key (ypt:scr (mix rex %jael-make) gen) - =* doc `bull`[(sein rex) & nym] - ?: (lth rex 256) - :: - :: create galaxy with generator as seed - :: - (next key doc) - :: - :: had: key handle - :: ryt: initial right - :: - =* had (shaf %hand key) - =* ryt `rite`[%urban [had (add ~m1 now) key] ~ ~] - :: - :: register initial symmetric key from ticket - :: - =. ..ex abet:(hail:~(able ex (sein rex)) rex %& [ryt ~ ~]) - :: - :: create initial private key and certificate - :: - (next (mix eny key) doc) - :: :: ++next:ex:ur - ++ next :: advance private key - |= {eny/@e doc/bull} - ^+ +> - :: loy: live keypair - :: rig: private key - :: ryt: private key as right - :: pub: public key - :: cet: unsigned certificate - :: wyl: initial will - :: hec: initial will as farm - :: - =/ loy (pit:nu:crub 512 eny) - =* rig sec:ex:loy - =* ryt `rite`[%jewel [1 rig] ~ ~] - =* pub pub:ex:loy - =* cet `cert`[[doc pub] ~] - =* wyl `will`[[1 cet] ~ ~] - =* hec `farm`[[rex wyl] ~ ~] - =. +>.$ (deal rex [[ryt ~ ~] ~]) - =. ..ex (meet [~ ~] hec) - +>.$ - :: - ++ as-hotel :: XX moveme - |= a/ship ^- (map {ship bloq} pile) - =/ b (xeb (xeb a)) - =- (my - ~) - :- [(sein a) b] - (put:py (rsh (dec b) 1 a)) - :: - ++ add-rite :: new promise - |=({pal/ship ryt/rite} (deal pal [ryt ~ ~] ~)) - :: - ++ mov-rite :: transfer promise - |= {{pal/ship par/ship} ryt/rite} - ^+ +> - =. deal (deal pal ~ [ryt ~ ~]) - (deal par [ryt ~ ~] ~) - :: - ++ del-rite :: dead promise - |=({pal/ship ryt/rite} (deal pal ~ [ryt ~ ~])) - :: - ++ jaelwomb :: manage ship %fungi - |= taz/task:womb - ^+ +> - ?- -.taz - :: - :: create passcode balance - :: {$invite tid/passcode inv/{who/mail pla/@ud sta/@ud}} - :: - $invite - =/ pas/@p (shaf %pass tid.taz) - =* inv inv.taz - ?< (~(has by shy) pas) - =. +>.$ (add-rite pas [%email (sy who.inv ~)]) - %+ mov-rite [rex pas] - [%fungi (my [%upl pla.inv] [%usr sta.inv] ~)] - :: - :: increase existing balance - :: {$reinvite aut/passcode pla/@ud sta/@ud} - :: - $bonus - =/ pas/@p (shaf %pass tid.taz) - ?> (~(has by shy) pas) - %+ mov-rite [rex pas] - [%fungi (my [%upl pla.taz] [%usr sta.taz] ~)] - :: - :: split passcode balance - :: {$reinvite aut/passcode tid/passcode inv/{who/mail pla/@ud sta/@ud}} - :: - $reinvite - =/ pas/@p (shaf %pass tid.taz) - =* inv inv.taz - ?< (~(has by shy) pas) - =. +>.$ (add-rite pas [%email (sy who.inv ~)]) - :: XX history - =/ ole/@p (shaf %pass aut.taz) - %+ mov-rite [ole pas] - [%fungi (my [%upl pla.inv] [%usr sta.inv] ~)] - :: - :: redeem ship invitation - :: {$claim aut/passcode her/@p tik/ticket} - :: - $claim - =/ pas/@p (shaf %pass aut.taz) - ?> =(rex (sein her.taz)) :: XX deal with foreign ships? - =/ len (xeb (xeb her.taz)) - =/ fun ?+((clan her.taz) !! $duke %upl, $king %usr) - =. +>.$ - (del-rite pas [%fungi (my [fun 1] ~)]) - =. +>.$ - (del-rite rex [%hotel (as-hotel her.taz)]) - =/ who (need %.(%email ~(expose up (lawn pas)))) - =. +>.$ (add-rite her.taz who) - (add-rite her.taz [%final tik.taz]) - == - :: :: div-at-most:ex:ur - ++ div-at-most :: skip n ships - |= {a/pile b/@u} ^- (pair pile pile) - (fall (~(div py a) b) [a *pile]) - :: :: scry-womb:ex:ur - ++ scry-womb :: read data - |= req/scry:womb ^- (unit gilt:womb) - ?- -.req - :: - :: ship details - :: {$stats who/ship} - :: - $stats - %+ some %womb-owner - %+ bind (~(get by shy) who.req) - |= a/safe ^- mail:womb - :: XX deal with multiple emails? - =+ (need (~(expose up a) %email)) - ?> ?=({$email {@ $~ $~}} -) - n.p.- - :: - :: invite details - :: {$balance aut/passcode} - :: - $balance - %+ some %womb-balance - %+ bind (~(get by shy) (shaf %pass aut.req)) - |= a/safe ^- balance:womb - =/ who :: XX deal with multiple emails? - =+ (need (~(expose up a) %email)) - ?> ?=({$email {@ $~ $~}} -) - n.p.- - =/ fun - =+ (fall (~(expose up a) %fungi) [%fungi p=~]) - ?> ?=($fungi -.-) - p.- - :+ who=who - pla=(fall (~(get by fun) %earl) 0) - sta=(fall (~(get by fun) %king) 0) - :: - :: available ships - :: {$shop typ/?($star $planet) nth/@u} - :: - $shop - =* ships-per-shop 3 - =* skip-ships (mul nth.req ships-per-shop) - :: - %+ some %ships ^- (list ship) - =/ hot - =+ (fall (~(expose up (lawn rex)) %hotel) [%hotel p=~]) - ?> ?=($hotel -.-) - p.- - =/ syz/bloq ?-(typ.req $star 3, $planet 4) - =/ pyl/pile (fall (~(get by hot) [rex syz]) ~) - =. pyl q:(div-at-most pyl skip-ships) - =/ got p:(div-at-most pyl ships-per-shop) - %+ turn ~(tap py got) - |=(a/@u `ship`(rep syz ~[rex a])) - == - :: :: grow:ex:ur - ++ grow :: merge wills - |= $: :: vie: data source - :: cod: merge context - :: gur: input will - :: - vie/(unit (unit ship)) - cod/farm - gur/will - == - ?: |(=(~ gur) =(gur rug)) ..grow - |^ ^+ ..grow - :: - :: wap: ascending list of new certs - :: pre: previous deed - :: - =/ wap ~(forward we gur) - ?~ wap ..grow - =/ pre - ^- (unit deed) - ?~ (dec p.i.wap) ~ - `dat:(~(got by rug) (dec p.i.wap)) - :: - :: merge each life - :: - |- ^+ ..grow - :: - :: hub: changes - :: lub: merged deed - :: - =+ [hub lub]=[p q]:(grow-mate p.i.wap q.i.wap pre) - ?~ t.wap ..grow - ?> =(p.i.t.wap +(p.i.wap)) - %= $ - wap t.wap - pre `dat.lub - rug (~(put by rug) p.i.wap lub) - hab (weld (flop hub) hab) - == - :: :: grow-lick/ex:ur - ++ grow-lick :: check signature - |= {pub/pass ash/@ val/@} - ^- ? - =+ ver=(sure:as:(com:nu:crub pub) *code:ames val) - ?~ ver | - =(ash u.ver) - :: :: grow-like/ex:ur - ++ grow-like :: verify signature - |= {myn/mind ash/@ val/@} - ^- ? - =: ..able able(rex who.myn) - gur (fall (~(get by cod) who.myn) *will) - == - (grow-lick (grow-look lyf.myn) ash val) - :: :: grow-look/ex:ur - ++ grow-look :: load public key - |= lyf/life - ^- @ - :: - :: cascade search over old and new, new first - :: - |^ %- (bond |.((need grow-look-find))) - grow-look-find(rug gur) - :: :: grow-look-find:ex:ur - ++ grow-look-find :: - ^- (unit @) - :: - :: crash if this life is revoked - :: - ?< (~(has by rug) +(lyf)) - %+ biff (~(get by rug) lyf) - |=(cert `pub.dat) - -- - :: :: grow-mate/ex:ur - ++ grow-mate :: merge lives - |= $: :: num: life we're merging - :: new: new deed - :: pre: previous deed - :: eld: old deed - :: - num/@ud - new/cert - pre/(unit deed) - == - =+ :* eld=`(unit cert)`(~(get by rug) num) - == - ^- (pair (list change) cert) - :: - :: enforce artificial scarcity in lives - :: - ?> (lte num 9) - :: - :: if no new information, do nothing - :: - ?: |(=(eld `new)) - ?> ?=(^ eld) - [~ u.eld] - :: - :: ash: hash of deed content - :: def: our default parent - :: dad: our declared parent - :: mir: our rank - :: - =/ ash (sham %urbit rex num dat.new) - =/ def (sein rex) - =* dad dad.doc.dat.new - =/ mir (clan rex) - ?> ?: |(=(num 1) =(%earl mir) =(%pawn mir)) - :: - :: first parent must be default; - :: comets and moons may not migrate - :: - =(def dad) - :: - :: all others may migrate to parent of same rank - :: - =((clan def) (clan dad)) - :: - :: if we have an old deed at this life, merge new signatures - :: - ?: ?=(^ eld) - :: - :: deed data must be identical - :: - ?> =(dat.new dat.u.eld) - :: - :: sow: all new signatures - :: - =+ sow=`(list (trel ship life @))`(~(tap by syg.new)) - |- ^- (pair (list change) cert) - ?~ sow [~ u.eld] - :: - :: mor: all further edits - :: och: old signature for this signer - :: - =+ mor=$(sow t.sow) - =+ och=(~(get by syg.q.mor) p.i.sow) - :: - :: ignore obsolete/equivalent signature - :: - ?. |(?=($~ och) (gth q.i.sow p.u.och)) - mor - :: - :: verify and merge added signature - :: - ?> (grow-like [p q]:i.sow ash r.i.sow) - :_ q.mor(syg (~(put by syg.q.mor) p.i.sow [q r]:i.sow)) - :_ p.mor - `change`[%fact rex vie num `growth`[%sign [[p q] r]:i.sow]] - :: - :: non-initial deeds must be signed by previous - :: - ?> ?| ?=($~ pre) - =+ laz=(~(got by syg.new) rex) - ?> =(p.laz (dec num)) - (grow-lick pub.u.pre ash q.laz) - == - :: - :: initial fingerprint for galaxy is hardcoded - :: - ?> ?| !=(%czar mir) - !=(~ pre) - ~| [%czar (shaf %zeno pub.dat.new) (zeno rex)] - =((shaf %zeno pub.dat.new) (zeno rex)) - == - :: - :: check the parent has signed, if necessary - :: - ?> ?| :: - :: no parent signature for existing, non-moon urbits - :: - ?& ?=(^ pre) - =(dad.doc.u.pre dad) - !=(%earl mir) - == - :: - :: no parent signature for initial galaxy - :: - ?& =(%czar mir) - =(~ pre) - == - :: - :: the deed is homemade or sent by owner - :: - &(?=(^ vie) |(?=($~ u.vie) =(u.u.vie rex))) - :: - :: check valid parent signature - :: - =+ par=(~(got by syg.new) dad) - (grow-like [dad p.par] ash q.par) - == - =- [[%fact rex p.- num %step q.-]~ q.-] - ^- (pair (unit (unit ship)) cert) - :: - :: the new deed is complete; report it - :: - ?: (~(has by syg.new) dad) - [vie new] - :: - :: the new deed needs a parent signature; try to add it - :: - :- [~ ~] - :: - :: pev: life and ring of parent - :: val: new signature - :: - =/ pev (leak dad) - =* val (sign:as:(nol:nu:crub q.pev) *@ ash) - new(syg (~(put by syg.new) dad [p.pev val])) - -- -- --- -- -:: :::: -:::: # vane :: interface - :: :::: -:: -:: lex: all durable %jael state -:: -=| lex/state -|= $: :: - :: now: current time - :: eny: unique entropy - :: ski: namespace resolver - :: - now/@da - eny/@e - ski/sley - == -|% -:: :: ++call -++ call :: request - |= $: :: hen: cause of this event - :: hic: event data - :: - hen/duct - hic/(hypo (hobo task)) - == - => .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard task) p.q.hic))) - ^- {p/(list move) q/_..^$} - =^ did lex abet:(~(call of [now eny] lex) hen q.hic) - [did ..^$] -:: :: ++doze -++ doze :: await - |= $: :: now: current time - :: hen: cause (XX why we need this?) - :: - now/@da - hen/duct - == - ^- (unit @da) - ~ -:: :: ++load -++ load :: upgrade - |= $: :: old: previous state - :: - old/state - == - ^+ ..^$ - ..^$(lex old) -:: :: ++scry -++ scry :: inspect - |= $: :: fur: event security - :: ren: access mode - :: why: owner - :: syd: desk (branch) - :: lot: case (version) - :: tyl: rest of path - :: - fur/(unit (set monk)) - ren/@tas - why/shop - syd/desk - lot/coin - tyl/spur - == - ^- (unit (unit cage)) - :: XX security - ?. =(lot [%$ %da now]) ~ - %- some - ?. =(%$ ren) ~ - %+ bind (~(scry of [now eny] lex) syd tyl) - |=(a/gilt [-.a (slot 3 (spec !>(a)))]) -:: :: ++stay -++ stay :: preserve - lex -:: :: ++take -++ take :: accept - |= $: :: tea: order - :: hen: cause - :: hin: result - :: - tea/wire - hen/duct - hin/(hypo sign-arvo) - == - ^- {p/(list move) q/_..^$} - [~ ..^$] --- diff --git a/neo/van/xmas.hoon b/neo/van/xmas.hoon deleted file mode 100644 index 2a1411941..000000000 --- a/neo/van/xmas.hoon +++ /dev/null @@ -1,1247 +0,0 @@ -:: :: :: -:::: /hoon/xmas/arvo :::::: vane prelude - !: :: :: -=+ our=~zod :: XX placeholder -|= pit/vase :: kernel vase -=> =~ :: -=, xmas -:: :: :: -:::: :::::: xmas structures - :: :: :: -:: -=* pipe channel:able:jael :: secure channel -=* gree farm:pki:jael :: pki information -|% :: -++ bait {p/skin q/@ud r/dove} :: fmt nrecvd spec -++ bath :: per friend - $: det/pipe :: secure channel - lun/(unit lane) :: latest route - zam/scar :: outbound boles - fon/(map bole lock) :: inbound locks - sal/(map bole colt) :: outbound flows - == :: -++ bole bone :: inbound opaque -++ cake {p/sock q/skin r/@} :: top level packet -++ chan path :: channel -++ clue :: live packet state - $: vig/? :: true iff virgin - tel/part :: block identity - fap/flap :: fragment hash - dat/rock :: fragment data - == :: -++ coal :: live packet state - $: out/@da :: sent date - lod/@da :: lost-by deadline - clu/clue :: packet to send - == :: -++ colt :: outbound state - $: seq/tick :: next tick to fill - lac/tick :: acked tick until - cob/(map tick comb) :: live messages - myn/mini :: packet pump - == :: -++ comb :: live message - $: cup/(unit coop) :: final ack - cha/path :: channel - num/frag :: number of fragments - ack/frag :: number acked - cly/(list clue) :: left to send - == :: -++ dove {p/@ud q/(map @ud @)} :: count 13-blocks -++ flap @uvH :: network packet id -++ flea (pair bole tick) :: message id -++ frag @ud :: fragment number -++ hand @uvH :: 128-bit hash -++ lock :: inbound sequencer - $: laq/tick :: acknowledged until - nys/(map tick bait) :: inbound partials - laz/(unit (trel tick flap lane)) :: awaiting app - exc/(map tick ares) :: negative acks - == :: -++ meal :: payload - $% {$back p/bone q/flap r/coop s/@dr} :: acknowledgment - {$bond p/flea q/chan r/*} :: message - {$carp p/moan q/(pair @ud @)} :: fragment - {$fore p/ship q/(unit lane) r/@} :: forwarded packet - == :: -++ mini :: pump data - $: saw/stat :: statistics - liv/(qeu coal) :: live packets - lop/(qeu clue) :: lost packets - == :: -++ moan :: message invariant - $: {kos/bole liq/tick} :: flow identity - syn/@ :: skin number - cnt/@ :: number of packets - == :: -++ mute :: awaiting channel - $: inn/(list (pair lane rock)) :: inbound packets - out/(list (trel duct chan *)) :: outbound messages - == :: -++ part (pair frag tick) :: fragment of packet -++ rock @uvO :: packet -++ silo :: global state - $: lyf/life :: current version - wyr/(map life ring) :: private keys - ech/(map ship mute) :: waiting partners - pol/(map ship bath) :: open partners - == :: -++ skin ?($none $open $fast $full) :: encoding stem -++ stat :: pump statistics - $: $: cur/@ud :: window q length - max/@ud :: max pax out - rey/@ud :: retry q length - == :: - $: rtt/@dr :: roundtrip estimate - las/@da :: last sent - lad/@da :: last deadline - == :: - == :: -++ tick @ud :: message sequence no --- :: -:: :: -:::: :::: arvo structures - :: :: -|% :: -++ flam |=(a/flap `@p`(mug a)) :: debug flap -++ msec |=(a/@dr `@ud`(div a (div ~s1 1.000))) :: debug @dr -++ move %+ pair :: local move - duct :: - (wind note:able:xmas gift:able:xmas) :: -:: :: -:::: loft :::: main transceiver - :: :: -++ loft :: - => |% :: - ++ gift :: output - $% {$east p/duct q/ship r/chan s/*} :: network response - {$home p/lane q/@} :: resend to self - {$line p/ship q/@da r/code} :: add outbound key - {$link p/ship q/@da r/code} :: add inbound key - {$meet p/gree} :: add public key(s) - {$rest p/duct q/coop} :: message result - {$send p/lane q/@} :: transmit packet - {$veil p/ship} :: cache channel - {$west p/ship q/bole r/chan s/*} :: outbound message - == :: - ++ task :: input - $% {$clue p/ship q/pipe} :: update channel - {$done p/ship q/bole r/coop} :: completion - {$hear p/lane q/@} :: incoming packet - {$mess p/ship q/duct r/chan s/*} :: forward message - {$rend p/ship q/bole r/chan s/*} :: backward message - {$wake $~} :: wakeup - == - -- - =| $: $: now/@da - eny/@ - == - silo - fex/(list gift) - == - =* syl ->- - |% :: - ++ abet [(flop fex) syl] :: resolve - ++ apex :: compute - |= job/task - ^+ +> - ?- -.job - $clue (dear p.job q.job) - $done abet:(done:(etre p.job) q.job r.job) - $hear - =+ kec=(bite q.job) - ?> =(our q.p.kec) - =+ buh=(~(get by pol) p.p.kec) - ?~ buh - ~& [%xmas-from p.p.kec] - =+ nut=(fall (~(get by ech) p.p.kec) *mute) - %_ +>.$ - fex [[%veil p.p.kec] fex] - ech (~(put by ech) p.p.kec nut(inn [+.job inn.nut])) - == - abet:(~(hear et p.p.kec u.buh) p.job (shaf %flap q.job) q.kec r.kec) - :: - $mess - =+ buh=(~(get by pol) p.job) - ?~ buh - ~& [%xmas-unto p.job] - =+ nut=(fall (~(get by ech) p.job) *mute) - %_ +>.$ - fex [[%veil p.job] fex] - ech (~(put by ech) p.job nut(out [+>.job out.nut])) - == - =/ etc ~(. et p.job u.buh) - =^ kos etc (blow:etc q.job) - abet:(mess:etc kos r.job s.job) - :: - $rend - abet:(mess:(etre p.job) q.job r.job s.job) - :: - $wake - |- ^+ +>.^$ - ?~ pol +>.^$ - =+ lef=$(pol l.pol) - =+ ryt=$(pol r.pol, fex fex.lef) - =+ top=~(to-wake et(fex fex.ryt) n.pol) - +>.^$(fex fex.top, pol [+<.top pol.lef pol.ryt]) - == - :: :: - ++ dear :: neighbor update - |= {who/@p det/pipe} - ^+ +> - =+ noz=(~(get by ech) who) - ?~ noz - :: - :: we're not waiting for this ship; we must have it - :: - =+ bah=(~(got by pol) who) - +>.$(pol (~(put by pol) who bah(det det))) - :: - :: new neighbor; run all waiting i/o - :: - =. pol (~(put by pol) who [det ~ [2 ~ ~] ~ ~]) - =+ [inn out]=[(flop inn.u.noz) (flop out.u.noz)] - =. +>.$ - |- ^+ +>.^$ - ?~ inn +>.^$ - $(inn t.inn, +>.^$ (apex `task`[%hear i.inn])) - |- ^+ +>.^$ - ?~ out +>.^$ - $(out t.out, +>.^$ (apex `task`[%mess who i.out])) - :: - ++ doze :: sleep until - |- ^- (unit @da) - ?~ pol ~ - ;: (cury hunt lth) - $(pol l.pol) - $(pol r.pol) - ~(to-wait et p.n.pol q.n.pol) - == - :: :: - ++ etre :: old neighbor - |= who/@p - ~(. et who (~(got by pol) who)) - :: :: - ++ et :: per neighbor - |_ $: who/ship - bah/bath - == - ++ abet +>(pol (~(put by pol) who bah)) :: resolve - ++ acme |=(fic/gift +>(fex [fic fex])) :: effect - ++ blow :: register duct - |= hen/duct - ^- {bole _+>} - =+ kus=(~(get by q.zam.bah) hen) - ?^ kus [u.kus +>.$] - :- p.zam.bah - %= +>.$ - p.zam.bah (add 2 p.zam.bah) - q.zam.bah (~(put by q.zam.bah) hen p.zam.bah) - r.zam.bah (~(put by r.zam.bah) p.zam.bah hen) - == - :: - ++ done - |= {kos/bole cop/coop} - ^+ +> - (in-task %done +<) - :: :: - ++ have :: receive message - |= {kos/bole cha/chan val/*} - ^+ +> - ?: =(0 (end 0 1 kos)) - =+ hen=(~(got by r.zam.bah) kos) - :: - :: if the bole is even, this is a backward flow, - :: like a subscription update; ack automatically. - :: - (acme:(in-task %done kos ~) %east hen who cha val) - :: - :: if the bole is odd, it's a forward flow. we - :: need to wait for the target to actively ack it. - :: - (acme %west who kos cha val) - :: - ++ hear :: - |= {lyn/lane dam/flap syn/skin msg/@} :: hear packet - ^+ +> - (in-task %hear +<) - :: :: - ++ mess :: send message - |= {kos/bole cha/chan val/*} - ^+ +> - (to-task kos %mess cha val) - :: :: - ++ sack :: send acknowledgment - |= {kos/bole dam/flap cop/coop} - =+ ^= yex - ((knit who lyf wyr det.bah) now eny [%back (mix kos 1) dam cop ~s0]) - =. +>.$ (to-gifs p.yex) - |- ^+ +>.^$ - ?~ q.yex +>.^$ - $(q.yex t.q.yex, +>.^$ (send ~ i.q.yex)) - :: :: - ++ send :: send packet - |= {urg/(unit lane) pac/rock} - ^+ +> - ?: =(our who) (acme [%send *lane pac]) - =+ zaw=sax.det.bah - |- ^+ +>.^$ - ?~ zaw +>.^$ - =+ ^= lun ^- (unit lane) - ?: (lth i.zaw 256) - :: - :: galaxies are mapped into reserved IP space, - :: which the interpreter maps into a DNS request. - :: - [~ %if ~2000.1.1 31.337 (mix i.zaw .0.0.1.0)] - ?: =(who i.zaw) lun.bah - =+ hab=(~(get by pol) i.zaw) - ?~(hab ~ lun.u.hab) - ?~ lun - $(zaw t.zaw) - =. pac ?: &(=(i.zaw who) =(~ urg)) - pac - :: - :: forwarded packets are not signed/encrypted, - :: because (a) we don't need to; (b) we don't - :: want to turn one packet into two. the wrapped - :: packet may exceed 8192 bits, but it's unlikely - :: to blow the MTU (IP MTU == 1500). - :: - (spit [our i.zaw] %none (jam `meal`[%fore who urg pac])) - =. +>.^$ (acme %send u.lun pac) - :: - :: stop if we have an %if (direct) address; - :: continue if we only have %ix (forwarded). - :: - ?:(?=($if -.u.lun) +>.^$ $(zaw t.zaw)) - :: - ++ in-gift - |= hox/gift:hose - ^+ +> - ?- -.hox - $fore - ?: =(our her.hox) - (acme %home org.hox pac.hox) - (send(who her.hox) [~ org.hox] pac.hox) - :: - $have (have +.hox) - $link (acme %link who exp.hox key.hox) - $meet (acme hox) - $rack (to-task kos.hox %back dam.hox cop.hox ~s0) - $rout +>(lun.bah `lyn.hox) - $sack (sack +.hox) - == - :: - ++ in-gifs - |= hoz/(list gift:hose) - ?~ hoz +> - $(hoz t.hoz, +> (in-gift i.hoz)) - :: - ++ to-gift - |= rax/gift:rail - ?- -.rax - $line (acme %line who ~2018.1.1 q.rax) - $mack (acme %rest (~(got by r.zam.bah) p.rax) q.rax) - $send (send ~ q.rax) - == - :: - ++ to-gifs - |= raz/(list gift:rail) - ?~ raz +> - $(raz t.raz, +> (to-gift i.raz)) - :: - ++ in-task - |= kyz/task:hose - ^+ +> - =^ hoz fon.bah abet:(~(apex hose [who wyr det.bah] ~ fon.bah) kyz) - (in-gifs hoz) - :: - ++ to-task - |= {kos/bole kyz/task:rail} - ^+ +> - =+ cot=((bond |.(zeal:rail)) (~(get by sal.bah) kos)) - =^ raz cot abet:(work:(to-rail kos cot) kyz) - (to-gifs raz) - :: - ++ to-rail - |= {kos/bole cot/colt} - ~(. rail [[who lyf wyr det.bah] [now eny] kos (yawn:pump myn.cot) ~] cot) - :: - ++ to-wait - |- ^- (unit @da) - ?~ sal.bah ~ - ;: (cury hunt lth) - $(sal.bah l.sal.bah) - $(sal.bah r.sal.bah) - wait:(to-rail p.n.sal.bah q.n.sal.bah) - == - :: - ++ to-wake - |- ^+ +.$ - ?~ sal.bah +.$ - =+ lef=$(sal.bah l.sal.bah) - =+ ryt=$(sal.bah r.sal.bah, fex fex.lef) - =+ top=(work:(to-rail(fex fex.ryt) p.n.sal.bah q.n.sal.bah) %wake ~) - +.$(fex fex.ryt, sal.bah [[kos cot]:top sal.bah.lef sal.bah.ryt]) - -- - -- - :: - :::: inbound cores - :: -:: :: -:::: bite :::: packet format - :: :: -++ bite :: packet to cake - |= pac/rock ^- cake - =+ [mag=(end 5 1 pac) bod=(rsh 5 1 pac)] - =+ :* vez=(end 0 3 mag) :: protocol version - chk=(cut 0 [3 20] mag) :: checksum - wix=(bex +((cut 0 [23 2] mag))) :: width of receiver - vix=(bex +((cut 0 [25 2] mag))) :: width of sender - tay=(cut 0 [27 5] mag) :: message type - == - ?> =(7 vez) - ?> =(chk (end 0 20 (mug bod))) - :+ [(end 3 wix bod) (cut 3 [wix vix] bod)] - (kins tay) - (rsh 3 (add wix vix) bod) -:: -++ kins |=(tay/@ (snag tay `(list skin)`[%none %open %fast %full ~])) -++ ksin |=(sin/skin `@`?-(sin $none 0, $open 1, $fast 2, $full 3)) -:: -++ spit :: cake to packet - |= kec/cake ^- @ - =+ wim=(met 3 p.p.kec) - =+ dum=(met 3 q.p.kec) - =+ yax=?:((lte wim 2) 0 ?:((lte wim 4) 1 ?:((lte wim 8) 2 3))) - =+ qax=?:((lte dum 2) 0 ?:((lte dum 4) 1 ?:((lte dum 8) 2 3))) - =+ wix=(bex +(yax)) - =+ vix=(bex +(qax)) - =+ bod=:(mix p.p.kec (lsh 3 wix q.p.kec) (lsh 3 (add wix vix) r.kec)) - =+ tay=(ksin q.kec) - %+ mix - %+ can 0 - :~ [3 7] - [20 (mug bod)] - [2 yax] - [2 qax] - [5 tay] - == - (lsh 5 1 bod) -:: :: -:::: nose :::: packet decoder - :: :: -++ nose !: - => |% - ++ gift :: side effect - $% {$link exp/@da key/code} :: learn symmetric key - {$meet doy/gree} :: learn public key(s) - == :: - -- - |= $: him/@p - wyr/(map life ring) - det/pipe - == - |= {syn/skin msg/@} - ^- (pair (list gift) {aut/? ham/meal}) - |^ ?- syn - $none [~ | (maul msg)] - $fast - =+ [mag=`hand`(end 7 1 msg) bod=(rsh 7 1 msg)] - =+ key=q:(~(got by inn.det) mag) - =+ clr=(need (de:crub:crypto key bod)) - [~ & (maul clr)] - :: - $full - =+ mex=((hard {p/{p/life q/life} q/gree r/@}) (cue msg)) - =+ rig=(~(got by wyr) p.p.mex) - =+ pas=(whom q.p.mex q.mex) - =+ [key out]=(need (tear:as:(nol:nu:crub:crypto rig) pas r.mex)) - :- :~ [%link ~2018.1.1 key] - [%meet q.mex] - == - [& (maul out)] - :: - $open - =+ mex=((hard {p/{$~ q/life} q/gree r/@}) (cue msg)) - =+ pas=(whom q.p.mex q.mex) - =+ out=(need (sure:as:(com:nu:crub:crypto pas) *code r.mex)) - [[%meet q.mex]~ & (maul r.mex)] - == - ++ maul |=(@ `meal`((hard meal) (cue +<))) :: unpack message - ++ whom :: select public key - |= {lyf/life gyr/gree} - ^- pass - :: - :: if we have the public key for this life, use it. - :: otherwise, use the key the sender sent, without - :: without checking its validity. invalid public-key - :: data will crash the packet when we install it. - :: - %- (bond |.(pub.dat:(~(got by (~(got by gyr) lyf)) him))) - (bind (~(get by pub.det) lyf) |=(cert:pki:jael pub.dat)) - -- -:: :: -:::: hose :: - :: :: -++ hose :: input decoder - => |% :: - ++ gift :: action - $% {$fore her/ship org/lane pac/rock} :: send forward - {$have kos/bole cha/chan val/*} :: report message - {$link exp/@da key/code} :: learn symmetric key - {$meet doy/gree} :: learn public key - {$rack kos/bole dam/flap cop/coop} :: report ack - {$rout lyn/lane} :: learn route - {$sack kos/bole dam/flap cop/coop} :: send ack - == :: - ++ task :: event - $% {$done kos/bole cop/coop} :: commit message - {$hear lyn/lane dam/flap syn/skin msg/@} :: raw packet - == :: - -- :: - =| $: $: him/ship :: - wyr/(map life ring) :: - det/pipe :: - == :: - fex/(list gift) :: - fon/(map bole lock) :: - == - |% :: - ++ abet [(flop fex) fon] :: resolve - ++ acme |=(fic/gift +>(fex [fic fex])) :: effect - ++ acts :: effects - |=(fix/(list gift) +>(fex (weld (flop fix) fex))) :: - :: :: - ++ apex :: input - |= job/task - ^+ +> - ?- -.job - $done - =+ loc=(~(got by fon) kos.job) - ?> ?=(^ laz.loc) - =< hy-abet - (~(hy-done hy [kos.job p.u.laz.loc] [& [q r]:u.laz.loc] loc) cop.job) - :: - $hear - =+ pet=((nose him wyr det) syn.job msg.job) - =. +>.$ (acts p.pet) - :: if packet is authenticated, use its routing info - =. +>.$ ?.(aut.q.pet +>.$ (acme %rout lyn.job)) - ?- -.ham.q.pet - $back - ~| %unsecured-back - ?>(aut.q.pet (acme %rack [p q r]:ham.q.pet)) - :: - $bond - =+ loc=((bond |.(*lock)) (~(get by fon) p.p.ham.q.pet)) - =< hy-abet - %. [q r]:ham.q.pet - ~(hy-bond hy p.ham.q.pet [aut.q.pet [dam lyn]:job] loc) - :: - $carp - =+ loc=((bond |.(*lock)) (~(get by fon) kos.p.ham.q.pet)) - =< hy-abet - %. [(kins syn.p.ham.q.pet) cnt.p.ham.q.pet q.ham.q.pet] - ~(hy-carp hy [kos liq]:p.ham.q.pet [aut.q.pet [dam lyn]:job] loc) - :: - $fore - (acme %fore p.ham.q.pet (born lyn.job q.ham.q.pet) r.ham.q.pet) - == - == - :: :: - ++ born :: set forward origin - |= {lyn/lane urg/(unit lane)} - ^- lane - :: a forwarded packet contains its origin address, - :: but only after the first hop. if the address - :: field is empty, we fill it in with the address - :: we received the packet from. but we replace - :: %if with %ix, to show that the ultimate receiver - :: may not be able to send back to the origin - :: (due to non-full-cone NAT). - ?~ urg lyn - ?. ?=($if -.u.urg) - u.urg - [%ix +.u.urg] - :: - ++ hy :: message assembler - =| $: $: kos/bole :: sender - liq/tick :: message number - == - $: aut/? :: authenticated - dam/flap :: critical flap - lyn/lane :: origin address - == - lock - == - =* loq ->+ - |% :: - ++ hy-abet ..hy(fon (~(put by fon) kos loq)) :: resolve - ++ hy-acme |=(fic/gift +>(+> (acme fic))) :: effect - ++ hy-acts |=(fix/(list gift) +>(+> (acts fix))) :: effects - ++ hy-bond :: full message - |= {cha/chan val/*} - ^+ +> - ?: (lth liq laq) - :: we already acked this msg; ack it again - :: ~& [%hi-bond-low [kos liq] laq] - hy-cong - ?: (gth liq laq) - :: later than the next msg; ignore - ~& [%hy-bond-after [kos liq] laq] - +> - ?: !=(~ laz) - :: this msg is already being processed; ignore - ~& [%hy-bond-during [kos liq] laq] - +> - :: report completed message - %. [%have kos cha val] - %= hy-acme - :: delete partial message - nys (~(del by nys) liq) - :: record message in application processing - laz `[liq dam lyn] - == - :: :: - ++ hy-done :: message completed - |= cop/coop - ^+ +> - (hy-cone(laq +(laq), laz ~) cop) - :: :: - ++ hy-carp :: process fragment - |= {syn/skin cnt/@ud far/(pair @ud @)} - ^+ +> - :: ~& [%carp fap/`@p`(mug fap) syn/syn cnt/cnt far/p.far] - ?: (lth liq laq) - :: fragment of a message we've already acknowledged - ack it again. - :: ~& [%hy-carp-late liq laq] - hy-cong - ?: (gth liq laq) - :: fragment of a message after the next we expect - drop it. - :: ~& [%hy-carp-early liq laq] - +> - :: neb: current incomplete message - =+ neb=`bait`(fall (~(get by nys) liq) [syn 0 [cnt ~]]) - :: all fragments must agree on the message parameters - ?> &(=(p.neb syn) (gth p.r.neb p.far) =(p.r.neb cnt)) - =+ doy=(~(get by q.r.neb) p.far) - ?^ doy - :: we've already heard this fragment - (hy-conk ~) - :: install fragment - =: q.r.neb (~(put by q.r.neb) p.far q.far) - q.neb +(q.neb) - == - ?. =(q.neb p.r.neb) - :: message not yet complete, reinstall incomplete - (hy-conk(nys (~(put by nys) liq neb)) ~) - :: decode complete message - =+ pet=((nose him wyr det) syn (hy-golf r.neb)) - :: record decoder effects - =. +>.$ (hy-acts p.pet) - =. aut |(aut aut.q.pet) - ?- -.ham.q.pet - $back ~|(%unsecured-back ?>(aut (hy-acme %rack kos [q r]:ham.q.pet))) - $carp ~|(%meta-carp !!) - $fore (hy-acme %fore p.ham.q.pet (born lyn q.ham.q.pet) r.ham.q.pet) - $bond ~| %bogus-assembly - ?> &(aut =([kos liq] p.ham.q.pet)) - (hy-bond [q r]:ham.q.pet) - == - :: - ++ hy-cong (hy-conk (~(get by exc) liq)) :: duplicate ack - ++ hy-conk :: ack current - |=(cop/coop (hy-acme %sack kos dam cop)) - ++ hy-cone :: record ack - |= cop/coop - => ?~(cop . .(exc (~(put by exc) liq u.cop))) - (hy-conk cop) - :: :: - ++ hy-golf :: assemble fragments - |= duv/dove - =+ [nix=0 rax=*(list @)] - |- ^- @ - ?: =(p.duv nix) - (can 13 (turn (flop rax) |=(a/@ [1 a]))) - $(nix +(nix), rax [(need (~(get by q.duv) nix)) rax]) - -- - -- -:: :: -:::: outbound cores :::: - :: :: -:: -:::: packet pump - :: -++ pump :: packet pump - => |% :: - ++ gift :: effect - $% {$good p/flap q/part r/@dr s/coop} :: logical ack - {$send p/flap q/part r/rock} :: release packet - == :: - ++ task :: event - $% {$back p/flap q/coop r/@dr} :: raw ack - {$cull p/tick} :: cancel message - {$pack p/(list clue)} :: submit packets - {$wake $~} :: random wakeup - == :: - -- - |% - ++ yawn :: - |= myn/mini :: - ^+ zu - ~(. zu ~ myn) :: - :: - ++ zu :: state machine - |_ $: fex/(list gift) :: effects - mini :: state - == - :: :: - ++ abba :: a older than b - |= {a/part b/part} - |((lth q.a q.b) &(=(q.a q.b) (lth p.a p.b))) - :: :: - ++ abet :: resolve - ^- {(list gift:pump) mini} - :: =. . aver - [(flop fex) +<+] - :: :: - ++ aver :: verify - ?> (lte cur.saw max.saw) - ?> !=(0 max.saw) - ?. =(cur.saw (lent (~(tap to liv)))) - ~& [%aver-cur cur.saw (lent (~(tap to liv)))] - !! - ?> =(rey.saw (lent (~(tap to lop)))) - ?> =+ |= {a/coal b/coal} - &((lth out.a out.b) (lth lod.a lod.b)) - |- ?| ?=($~ liv) - ?& ?| ?=($~ r.liv) - ?& (+< n.r.liv n.liv) - $(liv r.liv) - == == - ?| ?=($~ l.liv) - ?& (+< n.liv n.l.liv) - $(liv l.liv) - == == - == - == - ?> =+ |= {a/part b/part} - |((lth q.a q.b) &(=(q.a q.b) (lth p.a p.b))) - |- ?| ?=($~ lop) - ?& ?| ?=($~ r.lop) - ?& (+< tel.n.r.lop tel.n.lop) - $(lop r.lop) - == == - ?| ?=($~ l.lop) - ?& (+< tel.n.lop tel.n.l.lop) - $(lop l.lop) - == == - == - == - . - :: :: - ++ back :: process raw ack - |= {now/@da dam/flap cop/coop lag/@dr} - ^+ +> - =- =/ rtt ?~(ack ~s0 (sub now out.u.ack)) - =. rtt ?:((gth rtt lag) (sub rtt lag) rtt) - (done:(lose(liv lov) ded) ack dam cop rtt) - |- ^- $: ack/(unit coal) - ded/(list coal) - lov/(qeu coal) - == - ?~ liv [~ ~ ~] - =+ ryt=$(liv r.liv) - ?^ ack.ryt - :: - :: found in front, no need to search back. - :: - [ack.ryt ded.ryt [n.liv l.liv lov.ryt]] - :: - :: lose unacked packets sent before an acked virgin. - :: - =+ ^- $: top/? - ack/(unit coal) - ded/(list coal) - lov/(qeu coal) - == - ?: =(dam fap.clu.n.liv) - [| `n.liv ~ l.liv] - [& $(liv l.liv)] - ?~ ack [~ ~ liv] - =. ded ?:(top [n.liv ded] ded) - =. ded ?:(vig.clu.u.ack (~(tap to r.liv) ded) ded) - =. lov ?:(top [n.liv lov ~] lov) - [ack ded lov] - :: :: - ++ clap :: ordered enqueue - :: - :: the `lop` queue isn't really a queue in case of - :: resent packets; packets from older messages - :: need to be sent first. unfortunately hoon.hoon - :: lacks a general sorted/balanced heap right now. - :: so we implement a balanced queue insert by hand. - :: - |= clu/clue - %_ +> - lop - |- ^+ lop - ?~ lop [clu ~ ~] - ?: ?| (abba tel.clu tel.n.lop) - ?& =(tel.clu tel.n.lop) - (lth fap.clu fap.n.lop) - == == - [n.lop l.lop $(lop r.lop)] - [n.lop $(lop l.lop) r.lop] - == - :: :: - ++ cull :: clear message - |= tiq/tick - %_ +> - liv - |- ^+ liv - ?~ liv ~ - =+ vil=[n.liv $(liv l.liv) $(liv r.liv)] - ?. =(tiq q.tel.clu.n.liv) vil - ~(nip to `(qeu coal)`vil) - :: - lop - |- ^+ lop - ?~ lop ~ - =+ pol=[n.lop $(lop l.lop) $(lop r.lop)] - ?: =(tiq q.tel.n.lop) pol - ~(nip to `(qeu clue)`pol) - == - :: :: - ++ done :: process cooked ack - |= {lyd/(unit coal) dam/flap cop/coop rtt/@dr} - ^+ +> - ?~ lyd +> - %_ +> - cur.saw (dec cur.saw) - fex [[%good dam tel.clu.u.lyd rtt cop] fex] - == - :: :: - ++ fire :: send a packet - |= {now/@da clu/clue} - ^+ +> - ?> (lth cur.saw max.saw) - =+ out=?:((lte now las.saw) +(las.saw) now) - =+ lod=(add now (mul 2 rtt.saw)) - =. lod ?:((gth lod lad.saw) lod +(lad.saw)) - :: ~& [%fire (flam fap.clu) `@da`out `@da`lod] - %= +>.$ - fex [[%send fap.clu tel.clu dat.clu] fex] - las.saw out - lad.saw lod - cur.saw +(cur.saw) - liv (~(put to liv) [out lod clu]) - == - :: :: - ++ flay :: time out packets - |= now/@da - ^+ +> - =- (lose(liv q.ole) p.ole) - ^= ole - =| ded/(list coal) - |- ^+ [p=ded q=liv] - ?~ liv [ded ~] - ?: (gte now lod.n.liv) - :: - :: everything in front of a dead packet is dead - :: - $(liv l.liv, ded (~(tap to r.liv) [n.liv ded])) - =+ ryt=$(liv r.liv) - [p.ryt [n.liv l.liv q.ryt]] - :: :: - ++ lose :: abandon packets - |= cud/(list coal) - ^+ +> - ?~ cud +> - =. +> (clap clu.i.cud) - %= $ - cud t.cud - cur.saw (dec cur.saw) - rey.saw +(rey.saw) - == - :: :: - ++ ship :: send packets - |= {now/@da cly/(list clue)} - ^+ +> - ?: (gte cur.saw max.saw) +> - ?: =(0 rey.saw) - ?~ cly +> - $(cly t.cly, +> (fire now i.cly)) - =^ clu lop ~(get to lop) - $(+> (fire(rey.saw (dec rey.saw)) now clu)) - :: :: - ++ wait :: next wakeup - ^- (unit @da) - =+ tup=`(unit coal)`~(top to liv) - ?~(tup ~ `lod.u.tup) - :: :: - ++ want :: window space - ^- @ud - ?: (gte cur.saw max.saw) 0 - =+ gap=(sub max.saw cur.saw) - ?: (gte rey.saw gap) 0 - (sub gap rey.saw) - :: - ++ work :: - |= {now/@da job/task} :: perform - ^+ +> - ?- -.job - $back (back now [p q r]:job) - $cull (cull p.job) - $pack (ship now p.job) - $wake (flay now) - == - -- - -- -:: :: -:::: knit :::: message encoder - :: :: -++ knit - => |% - ++ gift :: side effect - $% {$line exp/@da key/code} :: set symmetric key - == :: - -- - |= {her/@p lyf/life wyr/(map life ring) det/pipe} - |= {now/@da eny/@ ham/meal} - =+ hom=(jam ham) - ^- (pair (list gift) (list rock)) - =< weft - |% - ++ wain :: message identity - ^- flea - ?+ -.ham [0 0] - $bond p.ham - $carp [kos liq]:p.ham - == - :: - ++ wasp ^-({p/skin q/@} [%none hom]) :: null security - ++ weft :: fragment message - ^- (pair (list gift) (list rock)) - =+ gum=wisp - :- p.gum - =+ wit=(met 13 q.q.gum) - ?: =(1 wit) - :: message fits in one packet, don't fragment - [(spit [our her] p.q.gum q.q.gum) ~] - =+ ruv=(rip 13 q.q.gum) - =+ inx=0 - |- ^- (list rock) - ?~ ruv ~ - :_ $(ruv t.ruv, inx +(inx)) - %+ spit - [our her] - wasp(ham [%carp [wain (ksin p.q.gum) wit] inx i.ruv]) - :: - ++ wisp :: generate message - ^- (pair (list gift) (pair skin @)) - ?: =(%carp -.ham) - [~ wasp] - ?^ out.det - :- ~ - :- %fast - %^ cat 7 - p.u.out.det - (en:crub:crypto q.q.u.out.det hom) - =+ cry=(nol:nu:crub:crypto (~(got by wyr) lyf)) - ?~ cur.det - :- ~ - :- %open - %^ jam - [~ lyf] - `gree`!! - (sign:as:cry *code hom) - =+ key=(shaz :(mix (mug ham) now eny)) - :- [%line ~2018.1.1 key]~ - :- %full - %^ jam - [u.cur.det lyf] - `gree`!! - (seal:as:cry pub.dat:(~(got by pub.det) u.cur.det) key hom) - -- -:: :: -:::: rail :::: message manager - :: :: -++ rail :: - => |% :: - ++ gift :: - $% {$line p/@da q/code} :: sent key - {$mack p/bole q/coop} :: message ack - {$send p/flap q/rock} :: release packet - == :: - ++ task :: - $% {$back p/flap q/coop r/@dr} :: raw ack - {$mess p/chan q/*} :: send message - {$wake $~} :: random wakeup - == :: - -- :: - =| $: $: $: her/ship - lyf/life - wyr/(map life ring) - det/pipe - == - $: now/@da - eny/@ - == - kos/bole - mup/_(yawn:pump) - fex/(list gift) - == - colt - == - =* cot -> - |% :: - ++ abet [(flop fex) `colt`cot] :: resolve - ++ view :: inspect - |% :: - ++ bulk :: queue count - ^- @ud - |-(?~(cob 0 :(add 1 $(cob l.cob) $(cob r.cob)))) - :: :: - ++ wait :: next wakeup - ^- (unit @da) - wait:mup - -- - :: - ++ work :: - |= job/task :: compute - ^+ +> - =< +>:wy-abet:wy-work - |% :: - ++ wy-abet +:wy-able :: resolve - ++ wy-able wy-tire:wy-ably:wy-feed:wy-ably :: converge - ++ wy-ably :: drain - ^+ . - =^ fix myn abet:mup - =. mup (yawn:pump myn) - |- ^+ +>.$ - ?~ fix +>.$ - $(fix t.fix, +>.$ (wy-abut i.fix)) - :: :: - ++ wy-abut :: pump effect - |= fic/gift:pump - ^+ +> - ?- -.fic - $good - ~& [%ok her `@p`(mug p.fic) r.fic] - (wy-good q.fic s.fic) - :: - $send - ~& [%go her `@p`(mug p.fic) q.fic] - +>(fex [[%send p.fic r.fic] fex]) - == - :: :: - ++ wy-back :: hear an ack - |= {dam/flap cop/coop lag/@dr} - ~& [%wy-back (flam dam) cop lag] - +>(mup (work:mup now %back dam cop lag)) - :: :: - ++ wy-feed :: feed pump - ^+ . - =^ cly . (wy-find want.mup) - ~& [%wy-feed want.mup (lent cly)] - +(mup (work:mup now %pack cly)) - :: :: - ++ wy-find :: collect packets - |= may/@ud - ^- {(list clue) _+>} - =- [(flop -<) ->] - =+ [inx=lac hav=*(list clue)] - |- ^- {(list clue) _+>.^$} - ?: |(=(0 may) =(inx seq)) [hav +>.^$] - =^ hey +>.^$ (wy-flow inx may hav) - $(inx +(inx), may p.hey, hav q.hey) - :: :: - ++ wy-flow :: collect by message - |= {tiq/tick may/@ud hav/(list clue)} - =+ mob=(~(got by cob) tiq) - |- ^- {(pair @ud (list clue)) _+>.^$} - ?: |(=(0 may) ?=($~ cly.mob)) - [[may hav] +>.^$(cob (~(put by cob) tiq mob))] - %= $ - may (dec may) - hav [i.cly.mob hav] - cly.mob t.cly.mob - == - :: :: - ++ wy-good :: message ack - |= {paz/part cop/coop} - ^+ +> - =+ bum=(~(get by cob) q.paz) - ?: |(?=($~ bum) =(~ cly.u.bum)) - ~& [%wy-good-ignore paz ?=($~ cop)] - +>.$ - ?^ cop - :: - :: a failure; save this nack, clear the message - :: - ~& [%wy-good-fail q.paz] - %_ +>.$ - mup (work:mup now %cull q.paz) - cob (~(put by cob) q.paz u.bum(cly ~, cup `cop)) - == - ?> (lth ack.u.bum num.u.bum) - =. ack.u.bum +(ack.u.bum) - =. cup.u.bum ?.(=(ack.u.bum num.u.bum) ~ [~ ~]) - +>.$(cob (~(put by cob) q.paz u.bum)) - :: :: - ++ wy-mess :: send - |= {cha/chan val/*} - ^+ +> - =+ yex=((knit her lyf wyr det) now eny [%bond [(mix kos 1) seq] cha val]) - =. fex (weld (flop p.yex) fex) - ~& [?:(=(0 (end 0 1 kos)) %tx %bx) her kos seq cha (lent fex)] - %_ +>.$ - seq +(seq) - cob - %+ ~(put by cob) - seq - ^- comb - :* ~ - cha - (lent q.yex) - 0 - =+ inx=0 - |- ?~ q.yex ~ - :_ $(q.yex +.q.yex, inx +(inx)) - [& [inx seq] (shaf %flap i.q.yex) i.q.yex] - == - == - :: :: - ++ wy-tire :: report results - |- ^+ + - =+ zup=(~(get by cob) lac) - ?~ zup +.$ - ?~ cup.u.zup +.$ - ~& [?:(=(0 (end 0 1 kos)) %ta %ba) her kos lac] - %= $ - lac +(lac) - cob (~(del by cob) lac) - fex :_(fex [%mack kos `coop`u.cup.u.zup]) - == - :: :: - ++ wy-wake :: timeout - ^+ . - .(mup (work:mup now %wake ~)) - :: - ++ wy-work - ^+ . - ?- -.job - $back (wy-back +.job) - $mess (wy-mess +.job) - $wake wy-wake - == - -- - :: :: - ++ zeal :: default state - ^- colt - :* 0 :: seq/tick - 0 :: lac/tick - ~ :: cob/(map tick comb) - ^- mini - :* ^- stat - :* :* 0 :: cur/@ud - 2 :: max/@ud - 0 :: rey/@ud - == - :* ~s5 :: rtt/@dr - ~2010.1.1 :: las/@da - ~2010.1.1 :: lad/@da - == == - ~ - ~ - == == - -- --- - . == -:: :: -:::: :::: kernel interface - :: :: -=| $: syl/silo :: kernel state - == :: -|= {now/@da eny/@ ski/sley} :: current invocation -=> |% - ++ love ~(. loft [now eny] syl ~) :: create loft - ++ lung :: gift to move - |= gax/gift:loft - ^- move - ?- -.gax - $east [p.gax %give [%east s.gax]] - $home [~ %give gax] - $link [~ %pass ~ %j gax] - $line [~ %pass ~ %j gax] - $meet [~ %pass ~ %j gax] - $rest [p.gax %give %rest q.gax] - $send [~ %give gax] - $veil [~ %pass /det/(scot %p p.gax) %j gax] - $west - =+ pax=/msg/(scot %p p.gax)/(scot %ud q.gax) - =+ cad=[%west p.gax +.r.gax s.gax] - =+ dat=?+(-.r.gax !! $c [%c cad], $e [%e cad], $g [%g cad]) - [~ %pass pax dat] - == - :: - ++ work - |= job/task:loft - ^- {(list move) q/_..^$} - =^ fex syl abet:(apex:love job) - [(turn fex lung) ..^$] - -- -|% :: vane interface -++ call :: handle request - |= $: hen/duct - hic/(hypo task:able:xmas) - == - ^- {p/(list move) q/_..^$} - %- work - ^- task:loft - ?- -.q.hic - $hear q.hic - $mess [%mess p.q.hic hen q.q.hic r.q.hic] - $wake q.hic - == -:: -++ doze - |= {now/@da hen/duct} - ^- (unit @da) - doze:love -:: -++ load - |= old/silo - ^+ ..^$ - ..^$(syl old) -:: -++ scry - |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} - ^- (unit (unit cage)) - ~ -:: -++ stay syl -++ take :: accept response - |= {tea/wire hen/duct hin/(hypo sign-arvo)} - ^- {p/(list move) q/_..^$} - %- work - ?+ -.tea !! - $msg - ?> ?=({@ @ $~} +.tea) - =+ [who kos]=[(slav %p i.t.tea) (slav %ud i.t.t.tea)] - ?> ?=(?($rend $mack) +<.q.hin) - ?- +<.q.hin - $rend [%rend who kos p.+.q.hin q.+.q.hin] - $mack [%done who kos ?~(p.+.q.hin ~ `coop`[~ `[%fail u.p.+.q.hin]])] - == - :: - $det - ?> ?=({@ $~} +.tea) - =+ who=(slav %p i.t.tea) - ?> ?=($veil +<.q.hin) - [%clue who p.+.q.hin] - == --- diff --git a/neo/zuse.hoon b/neo/zuse.hoon deleted file mode 100644 index 8a425d6d0..000000000 --- a/neo/zuse.hoon +++ /dev/null @@ -1,3562 +0,0 @@ -!: :: /van/zuse -:: :: %reference/1 -:: %zuse: arvo engines. -:: -:: %zuse, like the models %york, is split into cores for -:: arvo's eight major vanes (kernel modules). these are: -:: -:: - %ames: networking (rhymes with "games") -:: - %behn: scheduling ("bane") -:: - %clay: revision control ("play") -:: - %dill: console ("pill") -:: - %eyre: web ("fair") -:: - %ford: build ("lord") -:: - %gall: application ("ball") -:: - %jael: security ("jail") -:: -:: any vane can use any of these engines, of course. -:: -~% %zuse +> ~ -|% -:: :::: -:::: ++number :: (2a) number theory - :: :::: -++ number ^? - |% - :: :: ++fu:number - ++ fu :: modulo (mul p q) - |= a/{p/@ q/@} - =+ b=?:(=([0 0] a) 0 (~(inv fo p.a) (~(sit fo p.a) q.a))) - |% - :: :: ++dif:fu:number - ++ dif :: subtract - |= {c/{@ @} d/{@ @}} - [(~(dif fo p.a) -.c -.d) (~(dif fo q.a) +.c +.d)] - :: :: ++exp:fu:number - ++ exp :: exponent - |= {c/@ d/{@ @}} - :- (~(exp fo p.a) (mod c (dec p.a)) -.d) - (~(exp fo q.a) (mod c (dec q.a)) +.d) - :: :: ++out:fu:number - ++ out :: garner's formula - |= c/{@ @} - %+ add +.c - %+ mul q.a - %+ ~(pro fo p.a) b - (~(dif fo p.a) -.c (~(sit fo p.a) +.c)) - :: :: ++pro:fu:number - ++ pro :: multiply - |= {c/{@ @} d/{@ @}} - [(~(pro fo p.a) -.c -.d) (~(pro fo q.a) +.c +.d)] - :: :: ++sum:fu:number - ++ sum :: add - |= {c/{@ @} d/{@ @}} - [(~(sum fo p.a) -.c -.d) (~(sum fo q.a) +.c +.d)] - :: :: ++sit:fu:number - ++ sit :: represent - |= c/@ - [(mod c p.a) (mod c q.a)] - -- ::fu - :: :: ++pram:number - ++ pram :: rabin-miller - |= a/@ ^- ? - ?: ?| =(0 (end 0 1 a)) - =(1 a) - =+ b=1 - |- ^- ? - ?: =(512 b) - | - ?|(=+(c=+((mul 2 b)) &(!=(a c) =(a (mul c (div a c))))) $(b +(b))) - == - | - =+ ^= b - =+ [s=(dec a) t=0] - |- ^- {s/@ t/@} - ?: =(0 (end 0 1 s)) - $(s (rsh 0 1 s), t +(t)) - [s t] - ?> =((mul s.b (bex t.b)) (dec a)) - =+ c=0 - |- ^- ? - ?: =(c 64) - & - =+ d=(~(raw og (add c a)) (met 0 a)) - =+ e=(~(exp fo a) s.b d) - ?& ?| =(1 e) - =+ f=0 - |- ^- ? - ?: =(e (dec a)) - & - ?: =(f (dec t.b)) - | - $(e (~(pro fo a) e e), f +(f)) - == - $(c +(c)) - == - :: :: ++ramp:number - ++ ramp :: make r-m prime - |= {a/@ b/(list @) c/@} ^- @ux :: {bits snags seed} - => .(c (shas %ramp c)) - =+ d=*@ - |- - ?: =((mul 100 a) d) - ~|(%ar-ramp !!) - =+ e=(~(raw og c) a) - ?: &((levy b |=(f/@ !=(1 (mod e f)))) (pram e)) - e - $(c +(c), d (shax d)) - :: :: ++curt:number - ++ curt :: curve25519 - |= {a/@ b/@} - => %= . - + - => + - =+ =+ [p=486.662 q=(sub (bex 255) 19)] - =+ fq=~(. fo q) - [p=p q=q fq=fq] - |% - :: :: ++cla:curt:number - ++ cla :: - |= raw/@ - =+ low=(dis 248 (cut 3 [0 1] raw)) - =+ hih=(con 64 (dis 127 (cut 3 [31 1] raw))) - =+ mid=(cut 3 [1 30] raw) - (can 3 [[1 low] [30 mid] [1 hih] ~]) - :: :: ++sqr:curt:number - ++ sqr :: - |=(a/@ (mul a a)) - :: :: ++inv:curt:number - ++ inv :: - |=(a/@ (~(exp fo q) (sub q 2) a)) - :: :: ++cad:curt:number - ++ cad :: - |= {n/{x/@ z/@} m/{x/@ z/@} d/{x/@ z/@}} - =+ ^= xx - ;: mul 4 z.d - %- sqr %- abs:si - %+ dif:si - (sun:si (mul x.m x.n)) - (sun:si (mul z.m z.n)) - == - =+ ^= zz - ;: mul 4 x.d - %- sqr %- abs:si - %+ dif:si - (sun:si (mul x.m z.n)) - (sun:si (mul z.m x.n)) - == - [(sit.fq xx) (sit.fq zz)] - :: :: ++cub:curt:number - ++ cub :: - |= {x/@ z/@} - =+ ^= xx - %+ mul - %- sqr %- abs:si - (dif:si (sun:si x) (sun:si z)) - (sqr (add x z)) - =+ ^= zz - ;: mul 4 x z - :(add (sqr x) :(mul p x z) (sqr z)) - == - [(sit.fq xx) (sit.fq zz)] - -- :: - == - =+ one=[b 1] - =+ i=253 - =+ r=one - =+ s=(cub one) - |- - ?: =(i 0) - =+ x=(cub r) - (sit.fq (mul -.x (inv +.x))) - =+ m=(rsh 0 i a) - ?: =(0 (mod m 2)) - $(i (dec i), s (cad r s one), r (cub r)) - $(i (dec i), r (cad r s one), s (cub s)) - :: :: ++ga:number - ++ ga :: GF (bex p.a) - |= a/{p/@ q/@ r/@} :: dim poly gen - =+ si=(bex p.a) - =+ ma=(dec si) - => |% - :: :: ++dif:ga:number - ++ dif :: add and sub - |= {b/@ c/@} - ~| [%dif-ga a] - ?> &((lth b si) (lth c si)) - (mix b c) - :: :: ++dub:ga:number - ++ dub :: mul by x - |= b/@ - ~| [%dub-ga a] - ?> (lth b si) - ?: =(1 (cut 0 [(dec p.a) 1] b)) - (dif (sit q.a) (sit (lsh 0 1 b))) - (lsh 0 1 b) - :: :: ++pro:ga:number - ++ pro :: slow multiply - |= {b/@ c/@} - ?: =(0 b) - 0 - ?: =(1 (dis 1 b)) - (dif c $(b (rsh 0 1 b), c (dub c))) - $(b (rsh 0 1 b), c (dub c)) - :: :: ++toe:ga:number - ++ toe :: exp+log tables - =+ ^= nu - |= {b/@ c/@} - ^- (map @ @) - =+ d=*(map @ @) - |- - ?: =(0 c) - d - %= $ - c (dec c) - d (~(put by d) c b) - == - =+ [p=(nu 0 (bex p.a)) q=(nu ma ma)] - =+ [b=1 c=0] - |- ^- {p/(map @ @) q/(map @ @)} - ?: =(ma c) - [(~(put by p) c b) q] - %= $ - b (pro r.a b) - c +(c) - p (~(put by p) c b) - q (~(put by q) b c) - == - :: :: ++sit:ga:number - ++ sit :: reduce - |= b/@ - (mod b (bex p.a)) - -- :: - =+ toe - |% - :: :: ++fra:ga:number - ++ fra :: divide - |= {b/@ c/@} - (pro b (inv c)) - :: :: ++inv:ga:number - ++ inv :: invert - |= b/@ - ~| [%inv-ga a] - =+ c=(~(get by q) b) - ?~ c !! - =+ d=(~(get by p) (sub ma u.c)) - (need d) - :: :: ++pow:ga:number - ++ pow :: exponent - |= {b/@ c/@} - =+ [d=1 e=c f=0] - |- - ?: =(p.a f) - d - ?: =(1 (cut 0 [f 1] b)) - $(d (pro d e), e (pro e e), f +(f)) - $(e (pro e e), f +(f)) - :: :: ++pro:ga:number - ++ pro :: multiply - |= {b/@ c/@} - ~| [%pro-ga a] - =+ d=(~(get by q) b) - ?~ d 0 - =+ e=(~(get by q) c) - ?~ e 0 - =+ f=(~(get by p) (mod (add u.d u.e) ma)) - (need f) - -- ::ga - -- ::number -:: :::: -:::: ++crypto :: (2b) cryptography - :: :::: -++ crypto ^? - =, ames - =, number - |% - :: :: - :::: ++aes:crypto :: (2b1) aes, all sizes - :: :::: - ++ aes !. - ~% %aes ..ship ~ - |% - :: :: ++ahem:aes:crypto - ++ ahem :: kernel state - |= {nnk/@ nnb/@ nnr/@} - => - =+ => [gr=(ga 8 0x11b 3) few==>(fe .(a 5))] - [pro=pro.gr dif=dif.gr pow=pow.gr ror=ror.few] - => |% :: - ++ cipa $_ ^? :: AES params - |% - ++ co *{p/@ q/@ r/@ s/@} :: column coefficients - ++ ix |~(a/@ *@) :: key index - ++ ro *{p/@ q/@ r/@ s/@} :: row shifts - ++ su *@ :: s-box - -- ::cipa - -- :: - |% - :: :: ++pen:ahem:aes: - ++ pen :: encrypt - ^- cipa - |% - :: :: ++co:pen:ahem:aes: - ++ co :: column coefficients - [0x2 0x3 1 1] - :: :: ++ix:pen:ahem:aes: - ++ ix :: key index - |~(a/@ a) - :: :: ++ro:pen:ahem:aes: - ++ ro :: row shifts - [0 1 2 3] - :: :: ++su:pen:ahem:aes: - ++ su :: s-box - 0x16bb.54b0.0f2d.9941.6842.e6bf.0d89.a18c. - df28.55ce.e987.1e9b.948e.d969.1198.f8e1. - 9e1d.c186.b957.3561.0ef6.0348.66b5.3e70. - 8a8b.bd4b.1f74.dde8.c6b4.a61c.2e25.78ba. - 08ae.7a65.eaf4.566c.a94e.d58d.6d37.c8e7. - 79e4.9591.62ac.d3c2.5c24.0649.0a3a.32e0. - db0b.5ede.14b8.ee46.8890.2a22.dc4f.8160. - 7319.5d64.3d7e.a7c4.1744.975f.ec13.0ccd. - d2f3.ff10.21da.b6bc.f538.9d92.8f40.a351. - a89f.3c50.7f02.f945.8533.4d43.fbaa.efd0. - cf58.4c4a.39be.cb6a.5bb1.fc20.ed00.d153. - 842f.e329.b3d6.3b52.a05a.6e1b.1a2c.8309. - 75b2.27eb.e280.1207.9a05.9618.c323.c704. - 1531.d871.f1e5.a534.ccf7.3f36.2693.fdb7. - c072.a49c.afa2.d4ad.f047.59fa.7dc9.82ca. - 76ab.d7fe.2b67.0130.c56f.6bf2.7b77.7c63 - -- - :: :: ++pin:ahem:aes: - ++ pin :: decrypt - ^- cipa - |% - :: :: ++co:pin:ahem:aes: - ++ co :: column coefficients - [0xe 0xb 0xd 0x9] - :: :: ++ix:pin:ahem:aes: - ++ ix :: key index - |~(a/@ (sub nnr a)) - :: :: ++ro:pin:ahem:aes: - ++ ro :: row shifts - [0 3 2 1] - :: :: ++su:pin:ahem:aes: - ++ su :: s-box - 0x7d0c.2155.6314.69e1.26d6.77ba.7e04.2b17. - 6199.5383.3cbb.ebc8.b0f5.2aae.4d3b.e0a0. - ef9c.c993.9f7a.e52d.0d4a.b519.a97f.5160. - 5fec.8027.5910.12b1.31c7.0788.33a8.dd1f. - f45a.cd78.fec0.db9a.2079.d2c6.4b3e.56fc. - 1bbe.18aa.0e62.b76f.89c5.291d.711a.f147. - 6edf.751c.e837.f9e2.8535.ade7.2274.ac96. - 73e6.b4f0.cecf.f297.eadc.674f.4111.913a. - 6b8a.1301.03bd.afc1.020f.3fca.8f1e.2cd0. - 0645.b3b8.0558.e4f7.0ad3.bc8c.00ab.d890. - 849d.8da7.5746.155e.dab9.edfd.5048.706c. - 92b6.655d.cc5c.a4d4.1698.6886.64f6.f872. - 25d1.8b6d.49a2.5b76.b224.d928.66a1.2e08. - 4ec3.fa42.0b95.4cee.3d23.c2a6.3294.7b54. - cbe9.dec4.4443.8e34.87ff.2f9b.8239.e37c. - fbd7.f381.9ea3.40bf.38a5.3630.d56a.0952 - -- - :: :: ++mcol:ahem:aes: - ++ mcol :: - |= {a/(list @) b/{p/@ q/@ r/@ s/@}} - ^- (list @) - =+ c=[p=*@ q=*@ r=*@ s=*@] - |- ^- (list @) - ?~ a ~ - => .(p.c (cut 3 [0 1] i.a)) - => .(q.c (cut 3 [1 1] i.a)) - => .(r.c (cut 3 [2 1] i.a)) - => .(s.c (cut 3 [3 1] i.a)) - :_ $(a t.a) - %+ rep 3 - %+ turn - %- limo - :~ [[p.c p.b] [q.c q.b] [r.c r.b] [s.c s.b]] - [[p.c s.b] [q.c p.b] [r.c q.b] [s.c r.b]] - [[p.c r.b] [q.c s.b] [r.c p.b] [s.c q.b]] - [[p.c q.b] [q.c r.b] [r.c s.b] [s.c p.b]] - == - |= {a/{@ @} b/{@ @} c/{@ @} d/{@ @}} - :(dif (pro a) (pro b) (pro c) (pro d)) - :: :: ++pode:ahem:aes: - ++ pode :: explode to block - |= {a/bloq b/@ c/@} ^- (list @) - =+ d=(rip a c) - =+ m=(met a c) - |- - ?: =(m b) - d - $(m +(m), d (weld d (limo [0 ~]))) - :: :: ++sube:ahem:aes: - ++ sube :: s-box word - |= {a/@ b/@} ^- @ - (rep 3 (turn (pode 3 4 a) |=(c/@ (cut 3 [c 1] b)))) - -- :: - |% - :: :: ++be:ahem:aes:crypto - ++ be :: block cipher - |= {a/? b/@ c/@H} ^- @uxH - ~| %be-aesc - => %= . - + - => + - |% - :: :: ++ankh:be:ahem:aes: - ++ ankh :: - |= {a/cipa b/@ c/@} - (pode 5 nnb (cut 5 [(mul (ix.a b) nnb) nnb] c)) - :: :: ++sark:be:ahem:aes: - ++ sark :: - |= {c/(list @) d/(list @)} - ^- (list @) - ?~ c ~ - ?~ d !! - [(mix i.c i.d) $(c t.c, d t.d)] - :: :: ++srow:be:ahem:aes: - ++ srow :: - |= {a/cipa b/(list @)} ^- (list @) - =+ [c=0 d=~ e=ro.a] - |- - ?: =(c nnb) - d - :_ $(c +(c)) - %+ rep 3 - %+ turn - (limo [0 p.e] [1 q.e] [2 r.e] [3 s.e] ~) - |= {f/@ g/@} - (cut 3 [f 1] (snag (mod (add g c) nnb) b)) - :: :: ++subs:be:ahem:aes: - ++ subs :: - |= {a/cipa b/(list @)} ^- (list @) - ?~ b ~ - [(sube i.b su.a) $(b t.b)] - -- - == - =+ [d=?:(a pen pin) e=(pode 5 nnb c) f=1] - => .(e (sark e (ankh d 0 b))) - |- - ?. =(nnr f) - => .(e (subs d e)) - => .(e (srow d e)) - => .(e (mcol e co.d)) - => .(e (sark e (ankh d f b))) - $(f +(f)) - => .(e (subs d e)) - => .(e (srow d e)) - => .(e (sark e (ankh d nnr b))) - (rep 5 e) - :: :: ++ex:ahem:aes:crypto - ++ ex :: key expand - |= a/@I ^- @ - =+ [b=a c=0 d=su:pen i=nnk] - |- - ?: =(i (mul nnb +(nnr))) - b - => .(c (cut 5 [(dec i) 1] b)) - => ?: =(0 (mod i nnk)) - => .(c (ror 3 1 c)) - => .(c (sube c d)) - .(c (mix c (pow (dec (div i nnk)) 2))) - ?: &((gth nnk 6) =(4 (mod i nnk))) - .(c (sube c d)) - . - => .(c (mix c (cut 5 [(sub i nnk) 1] b))) - => .(b (can 5 [i b] [1 c] ~)) - $(i +(i)) - :: :: ++ix:ahem:aes:crypto - ++ ix :: key expand, inv - |= a/@ ^- @ - =+ [i=1 j=*@ b=*@ c=co:pin] - |- - ?: =(nnr i) - a - => .(b (cut 7 [i 1] a)) - => .(b (rep 5 (mcol (pode 5 4 b) c))) - => .(j (sub nnr i)) - %= $ - i +(i) - a - %+ can 7 - :~ [i (cut 7 [0 i] a)] - [1 b] - [j (cut 7 [+(i) j] a)] - == - == - -- - :: :: ++ecba:aes:crypto - ++ ecba :: AES-128 ECB - ~% %ecba +> ~ - |_ key/@H - :: :: ++en:ecba:aes:crypto - ++ en :: encrypt - ~/ %en - |= blk/@H ^- @uxH - =+ (ahem 4 4 10) - =: - key (~(net fe 7) key) - blk (~(net fe 7) blk) - == - %- ~(net fe 7) - (be & (ex key) blk) - :: :: ++de:ecba:aes:crypto - ++ de :: decrypt - ~/ %de - |= blk/@H ^- @uxH - =+ (ahem 4 4 10) - =: - key (~(net fe 7) key) - blk (~(net fe 7) blk) - == - %- ~(net fe 7) - (be | (ix (ex key)) blk) - -- ::ecba - :: :: ++ecbb:aes:crypto - ++ ecbb :: AES-192 ECB - ~% %ecbb +> ~ - |_ key/@I - :: :: ++en:ecbb:aes:crypto - ++ en :: encrypt - ~/ %en - |= blk/@H ^- @uxH - =+ (ahem 6 4 12) - =: - key (rsh 6 1 (~(net fe 8) key)) - blk (~(net fe 7) blk) - == - %- ~(net fe 7) - (be & (ex key) blk) - :: :: ++de:ecbb:aes:crypto - ++ de :: decrypt - ~/ %de - |= blk/@H ^- @uxH - =+ (ahem 6 4 12) - =: - key (rsh 6 1 (~(net fe 8) key)) - blk (~(net fe 7) blk) - == - %- ~(net fe 7) - (be | (ix (ex key)) blk) - -- ::ecbb - :: :: ++ecbc:aes:crypto - ++ ecbc :: AES-256 ECB - ~% %ecbc +> ~ - |_ key/@I - :: :: ++en:ecbc:aes:crypto - ++ en :: encrypt - ~/ %en - |= blk/@H ^- @uxH - =+ (ahem 8 4 14) - =: - key (~(net fe 8) key) - blk (~(net fe 7) blk) - == - %- ~(net fe 7) - (be & (ex key) blk) - :: :: ++de:ecbc:aes:crypto - ++ de :: decrypt - ~/ %de - |= blk/@H ^- @uxH - =+ (ahem 8 4 14) - =: - key (~(net fe 8) key) - blk (~(net fe 7) blk) - == - %- ~(net fe 7) - (be | (ix (ex key)) blk) - -- ::ecbc - :: :: ++cbca:aes:crypto - ++ cbca :: AES-128 CBC - ~% %cbca +> ~ - |_ {key/@H prv/@H} - :: :: ++en:cbca:aes:crypto - ++ en :: encrypt - ~/ %en - |= txt/@ ^- @ux - =+ pts=?:(=(txt 0) `(list @)`~[0] (flop (rip 7 txt))) - =| cts/(list @) - %+ rep 7 - :: logically, flop twice here - |- ^- (list @) - ?~ pts - cts - =+ cph=(~(en ecba key) (mix prv i.pts)) - %= $ - cts [cph cts] - pts t.pts - prv cph - == - :: :: ++de:cbca:aes:crypto - ++ de :: decrypt - ~/ %de - |= txt/@ ^- @ux - =+ cts=?:(=(txt 0) `(list @)`~[0] (flop (rip 7 txt))) - =| pts/(list @) - %+ rep 7 - :: logically, flop twice here - |- ^- (list @) - ?~ cts - pts - =+ pln=(mix prv (~(de ecba key) i.cts)) - %= $ - pts [pln pts] - cts t.cts - prv i.cts - == - -- ::cbca - :: :: ++cbcb:aes:crypto - ++ cbcb :: AES-192 CBC - ~% %cbcb +> ~ - |_ {key/@I prv/@H} - :: :: ++en:cbcb:aes:crypto - ++ en :: encrypt - ~/ %en - |= txt/@ ^- @ux - =+ pts=?:(=(txt 0) `(list @)`~[0] (flop (rip 7 txt))) - =| cts/(list @) - %+ rep 7 - :: logically, flop twice here - |- ^- (list @) - ?~ pts - cts - =+ cph=(~(en ecbb key) (mix prv i.pts)) - %= $ - cts [cph cts] - pts t.pts - prv cph - == - :: :: ++de:cbcb:aes:crypto - ++ de :: decrypt - ~/ %de - |= txt/@ ^- @ux - =+ cts=?:(=(txt 0) `(list @)`~[0] (flop (rip 7 txt))) - =| pts/(list @) - %+ rep 7 - :: logically, flop twice here - |- ^- (list @) - ?~ cts - pts - =+ pln=(mix prv (~(de ecbb key) i.cts)) - %= $ - pts [pln pts] - cts t.cts - prv i.cts - == - -- ::cbcb - :: :: ++cbcc:aes:crypto - ++ cbcc :: AES-256 CBC - ~% %cbcc +> ~ - |_ {key/@I prv/@H} - :: :: ++en:cbcc:aes:crypto - ++ en :: encrypt - ~/ %en - |= txt/@ ^- @ux - =+ pts=?:(=(txt 0) `(list @)`~[0] (flop (rip 7 txt))) - =| cts/(list @) - %+ rep 7 - :: logically, flop twice here - |- ^- (list @) - ?~ pts - cts - =+ cph=(~(en ecbc key) (mix prv i.pts)) - %= $ - cts [cph cts] - pts t.pts - prv cph - == - :: :: ++de:cbcc:aes:crypto - ++ de :: decrypt - ~/ %de - |= txt/@ ^- @ux - =+ cts=?:(=(txt 0) `(list @)`~[0] (flop (rip 7 txt))) - =| pts/(list @) - %+ rep 7 - :: logically, flop twice here - |- ^- (list @) - ?~ cts - pts - =+ pln=(mix prv (~(de ecbc key) i.cts)) - %= $ - pts [pln pts] - cts t.cts - prv i.cts - == - -- ::cbcc - :: :: ++inc:aes:crypto - ++ inc :: inc. low bloq - |= {mod/bloq ctr/@H} - ^- @uxH - =+ bqs=(rip mod ctr) - ?~ bqs 0x1 - %+ rep mod - [(~(sum fe mod) i.bqs 1) t.bqs] - :: :: ++ctra:aes:crypto - ++ ctra :: AES-128 CTR - ~% %ctra +> ~ - |_ {key/@H mod/bloq len/@ ctr/@H} - :: :: ++en:ctra:aes:crypto - ++ en :: encrypt - ~/ %en - |= txt/@ - ^- @ux - =/ encrypt ~(en ecba key) - =/ blocks (add (div len 16) ?:(=((^mod len 16) 0) 0 1)) - ?> (gte len (met 3 txt)) - %+ mix txt - %^ rsh 3 (sub (mul 16 blocks) len) - %+ rep 7 - %- flop - |- ^- (list @ux) - ?: =(blocks 0) ~ - :- (encrypt ctr) - $(ctr (inc mod ctr), blocks (dec blocks)) - :: :: ++de:ctra:aes:crypto - ++ de :: decrypt - en - -- ::ctra - :: :: ++ctrb:aes:crypto - ++ ctrb :: AES-192 CTR - ~% %ctrb +> ~ - |_ {key/@I mod/bloq len/@ ctr/@H} - :: :: ++en:ctrb:aes:crypto - ++ en - ~/ %en - |= txt/@ - ^- @ux - =/ encrypt ~(en ecbb key) - =/ blocks (add (div len 16) ?:(=((^mod len 16) 0) 0 1)) - ?> (gte len (met 3 txt)) - %+ mix txt - %^ rsh 3 (sub (mul 16 blocks) len) - %+ rep 7 - %- flop - |- ^- (list @ux) - ?: =(blocks 0) ~ - :- (encrypt ctr) - $(ctr (inc mod ctr), blocks (dec blocks)) - :: :: ++de:ctrb:aes:crypto - ++ de :: decrypt - en - -- ::ctrb - :: :: ++ctrc:aes:crypto - ++ ctrc :: AES-256 CTR - ~% %ctrc +> ~ - |_ {key/@I mod/bloq len/@ ctr/@H} - :: :: ++en:ctrc:aes:crypto - ++ en :: encrypt - ~/ %en - |= txt/@ - ^- @ux - =/ encrypt ~(en ecbc key) - =/ blocks (add (div len 16) ?:(=((^mod len 16) 0) 0 1)) - ?> (gte len (met 3 txt)) - %+ mix txt - %^ rsh 3 (sub (mul 16 blocks) len) - %+ rep 7 - %- flop - |- ^- (list @ux) - ?: =(blocks 0) ~ - :- (encrypt ctr) - $(ctr (inc mod ctr), blocks (dec blocks)) - :: :: ++de:ctrc:aes:crypto - ++ de :: decrypt - en - -- ::ctrc - :: :: ++doub:aes:crypto - ++ doub :: double 128-bit - |= :: string mod finite - :: - str/@H - :: - :: field (see spec) - :: - ^- @uxH - %- ~(sit fe 7) - ?. =((xeb str) 128) - (lsh 0 1 str) - (mix 0x87 (lsh 0 1 str)) - :: :: ++mpad:aes:crypto - ++ mpad :: - |= {oct/@ txt/@} - :: - :: pad message to multiple of 128 bits - :: by appending 1, then 0s - :: the spec is unclear, but it must be octet based - :: to match the test vectors - :: - ^- @ux - =+ pad=(mod oct 16) - ?: =(pad 0) 0x8000.0000.0000.0000.0000.0000.0000.0000 - (lsh 3 (sub 15 pad) (mix 0x80 (lsh 3 1 txt))) - :: :: ++suba:aes:crypto - ++ suba :: AES-128 subkeys - |= key/@H - =+ l=(~(en ecba key) 0) - =+ k1=(doub l) - =+ k2=(doub k1) - ^- {@ux @ux} - [k1 k2] - :: :: ++subb:aes:crypto - ++ subb :: AES-192 subkeys - |= key/@I - =+ l=(~(en ecbb key) 0) - =+ k1=(doub l) - =+ k2=(doub k1) - ^- {@ux @ux} - [k1 k2] - :: :: ++subc:aes:crypto - ++ subc :: AES-256 subkeys - |= key/@I - =+ l=(~(en ecbc key) 0) - =+ k1=(doub l) - =+ k2=(doub k1) - ^- {@ux @ux} - [k1 k2] - :: :: ++maca:aes:crypto - ++ maca :: AES-128 CMAC - ~/ %maca - |= {key/@H oct/(unit @) txt/@} - ^- @ux - =+ [sub=(suba key) len=?~(oct (met 3 txt) u.oct)] - =+ ^= pdt - ?: &(=((mod len 16) 0) !=(len 0)) - [& txt] - [| (mpad len txt)] - =+ ^= mac - %- ~(en cbca key 0) - %+ mix +.pdt - ?- -.pdt - $& -.sub - $| +.sub - == - :: spec says MSBs, LSBs match test vectors - :: - (~(sit fe 7) mac) - :: :: ++macb:aes:crypto - ++ macb :: AES-192 CMAC - ~/ %macb - |= {key/@I oct/(unit @) txt/@} - ^- @ux - =+ [sub=(subb key) len=?~(oct (met 3 txt) u.oct)] - =+ ^= pdt - ?: &(=((mod len 16) 0) !=(len 0)) - [& txt] - [| (mpad len txt)] - =+ ^= mac - %- ~(en cbcb key 0) - %+ mix +.pdt - ?- -.pdt - $& -.sub - $| +.sub - == - :: spec says MSBs, LSBs match test vectors - :: - (~(sit fe 7) mac) - :: :: ++macc:aes:crypto - ++ macc :: AES-256 CMAC - ~/ %macc - |= {key/@I oct/(unit @) txt/@} - ^- @ux - =+ [sub=(subc key) len=?~(oct (met 3 txt) u.oct)] - =+ ^= pdt - ?: &(=((mod len 16) 0) !=(len 0)) - [& txt] - [| (mpad len txt)] - =+ ^= mac - %- ~(en cbcc key 0) - %+ mix +.pdt - ?- -.pdt - $& -.sub - $| +.sub - == - :: spec says MSBs, LSBs match test vectors - :: - (~(sit fe 7) mac) - :: :: ++s2va:aes:crypto - ++ s2va :: AES-128 S2V - ~/ %s2va - |= {key/@H ads/(list @)} - =+ res=(maca key `16 0x0) - %^ maca key ~ - |- ^- @uxH - ?~ ads (maca key `16 0x1) - ?~ t.ads - ?: (gte (xeb i.ads) 128) - (mix i.ads res) - %+ mix - (doub res) - (mpad (met 3 i.ads) i.ads) - %= $ - res %+ mix - (doub res) - (maca key ~ i.ads) - ads t.ads - == - :: :: ++s2vb:aes:crypto - ++ s2vb :: AES-192 S2V - ~/ %s2vb - |= {key/@I ads/(list @)} - =+ res=(macb key `16 0x0) - %^ macb key ~ - |- ^- @uxH - ?~ ads (macb key `16 0x1) - ?~ t.ads - ?: (gte (xeb i.ads) 128) - (mix i.ads res) - %+ mix - (doub res) - (mpad (met 3 i.ads) i.ads) - %= $ - res %+ mix - (doub res) - (macb key ~ i.ads) - ads t.ads - == - :: :: ++s2vc:aes:crypto - ++ s2vc :: AES-256 S2V - ~/ %s2vc - |= {key/@I ads/(list @)} - =+ res=(macc key `16 0x0) - %^ macc key ~ - |- ^- @uxH - ?~ ads (macc key `16 0x1) - ?~ t.ads - ?: (gte (xeb i.ads) 128) - (mix i.ads res) - %+ mix - (doub res) - (mpad (met 3 i.ads) i.ads) - %= $ - res %+ mix - (doub res) - (macc key ~ i.ads) - ads t.ads - == - :: :: ++siva:aes:crypto - ++ siva :: AES-128 SIV - ~% %siva +> ~ - |_ {key/@I vec/(list @)} - :: :: ++en:siva:aes:crypto - ++ en :: encrypt - ~/ %en - |= txt/@ - ^- (trel @uxH @ud @ux) - =+ [k1=(rsh 7 1 key) k2=(end 7 1 key)] - =+ iv=(s2va k1 (weld vec (limo ~[txt]))) - =+ len=(met 3 txt) - =* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff) - :+ - iv - len - (~(en ctra k2 7 len hib) txt) - :: :: ++de:siva:aes:crypto - ++ de :: decrypt - ~/ %de - |= {iv/@H len/@ txt/@} - ^- (unit @ux) - =+ [k1=(rsh 7 1 key) k2=(end 7 1 key)] - =* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff) - =+ ^= pln - (~(de ctra k2 7 len hib) txt) - ?. =((s2va k1 (weld vec (limo ~[pln]))) iv) - ~ - `pln - -- ::siva - :: :: ++sivb:aes:crypto - ++ sivb :: AES-192 SIV - ~% %sivb +> ~ - |_ {key/@J vec/(list @)} - :: :: ++en:sivb:aes:crypto - ++ en :: encrypt - ~/ %en - |= txt/@ - ^- (trel @uxH @ud @ux) - =+ [k1=(rsh 5 3 key) k2=(end 5 3 key)] - =+ iv=(s2vb k1 (weld vec (limo ~[txt]))) - =* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff) - =+ len=(met 3 txt) - :+ iv - len - (~(en ctrb k2 7 len hib) txt) - :: :: ++de:sivb:aes:crypto - ++ de :: decrypt - ~/ %de - |= {iv/@H len/@ txt/@} - ^- (unit @ux) - =+ [k1=(rsh 5 3 key) k2=(end 5 3 key)] - =* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff) - =+ ^= pln - (~(de ctrb k2 7 len hib) txt) - ?. =((s2vb k1 (weld vec (limo ~[pln]))) iv) - ~ - `pln - -- ::sivb - :: :: ++sivc:aes:crypto - ++ sivc :: AES-256 SIV - ~% %sivc +> ~ - |_ {key/@J vec/(list @)} - :: :: ++en:sivc:aes:crypto - ++ en :: encrypt - ~/ %en - |= txt/@ - ^- (trel @uxH @ud @ux) - =+ [k1=(rsh 8 1 key) k2=(end 8 1 key)] - =+ iv=(s2vc k1 (weld vec (limo ~[txt]))) - =* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff) - =+ len=(met 3 txt) - :+ - iv - len - (~(en ctrc k2 7 len hib) txt) - :: :: ++de:sivc:aes:crypto - ++ de :: decrypt - ~/ %de - |= {iv/@H len/@ txt/@} - ^- (unit @ux) - =+ [k1=(rsh 8 1 key) k2=(end 8 1 key)] - =* hib (dis iv 0xffff.ffff.ffff.ffff.7fff.ffff.7fff.ffff) - =+ ^= pln - (~(de ctrc k2 7 len hib) txt) - ?. =((s2vc k1 (weld vec (limo ~[pln]))) iv) - ~ - `pln - -- ::sivc - -- - :: :: - :::: ++ed:crypto :: ed25519 - :: :::: - ++ ed - => - =+ =+ [b=256 q=(sub (bex 255) 19)] - =+ fq=~(. fo q) - =+ ^= l - %+ add - (bex 252) - 27.742.317.777.372.353.535.851.937.790.883.648.493 - =+ d=(dif.fq 0 (fra.fq 121.665 121.666)) - =+ ii=(exp.fq (div (dec q) 4) 2) - [b=b q=q fq=fq l=l d=d ii=ii] - ~% %coed +> ~ - |% - :: :: ++norm:ed:crypto - ++ norm :: - |=(x/@ ?:(=(0 (mod x 2)) x (sub q x))) - :: :: ++xrec:ed:crypto - ++ xrec :: recover x-coord - |= y/@ ^- @ - =+ ^= xx - %+ mul (dif.fq (mul y y) 1) - (inv.fq +(:(mul d y y))) - =+ x=(exp.fq (div (add 3 q) 8) xx) - ?: !=(0 (dif.fq (mul x x) (sit.fq xx))) - (norm (pro.fq x ii)) - (norm x) - :: :: ++ward:ed:crypto - ++ ward :: edwards multiply - |= {pp/{@ @} qq/{@ @}} ^- {@ @} - =+ dp=:(pro.fq d -.pp -.qq +.pp +.qq) - =+ ^= xt - %+ pro.fq - %+ sum.fq - (pro.fq -.pp +.qq) - (pro.fq -.qq +.pp) - (inv.fq (sum.fq 1 dp)) - =+ ^= yt - %+ pro.fq - %+ sum.fq - (pro.fq +.pp +.qq) - (pro.fq -.pp -.qq) - (inv.fq (dif.fq 1 dp)) - [xt yt] - :: :: ++scam:ed:crypto - ++ scam :: scalar multiply - |= {pp/{@ @} e/@} ^- {@ @} - ?: =(0 e) - [0 1] - =+ qq=$(e (div e 2)) - => .(qq (ward qq qq)) - ?: =(1 (dis 1 e)) - (ward qq pp) - qq - :: :: ++etch:ed:crypto - ++ etch :: encode point - |= pp/{@ @} ^- @ - (can 0 ~[[(sub b 1) +.pp] [1 (dis 1 -.pp)]]) - :: :: ++curv:ed:crypto - ++ curv :: point on curve? - |= {x/@ y/@} ^- ? - .= 0 - %+ dif.fq - %+ sum.fq - (pro.fq (sub q (sit.fq x)) x) - (pro.fq y y) - (sum.fq 1 :(pro.fq d x x y y)) - :: :: ++deco:ed:crypto - ++ deco :: decode point - |= s/@ ^- (unit {@ @}) - =+ y=(cut 0 [0 (dec b)] s) - =+ si=(cut 0 [(dec b) 1] s) - =+ x=(xrec y) - => .(x ?:(!=(si (dis 1 x)) (sub q x) x)) - =+ pp=[x y] - ?. (curv pp) - ~ - [~ pp] - :: :: ++bb:ed:crypto - ++ bb :: - =+ bby=(pro.fq 4 (inv.fq 5)) - [(xrec bby) bby] - -- :: - ~% %ed +> ~ - |% - :: :: ++puck:ed:crypto - ++ puck :: public key - ~/ %puck - |= sk/@I ^- @ - ?: (gth (met 3 sk) 32) !! - =+ h=(shal (rsh 0 3 b) sk) - =+ ^= a - %+ add - (bex (sub b 2)) - (lsh 0 3 (cut 0 [3 (sub b 5)] h)) - =+ aa=(scam bb a) - (etch aa) - :: :: ++suck:ed:crypto - ++ suck :: keypair from seed - |= se/@I ^- @uJ - =+ pu=(puck se) - (can 0 ~[[b se] [b pu]]) - :: :: ++shar:ed:crypto - ++ shar :: curve25519 secret - ~/ %shar - |= {pub/@ sek/@} - ^- @ux - =+ exp=(shal (rsh 0 3 b) (suck sek)) - =. exp (dis exp (can 0 ~[[3 0] [251 (fil 0 251 1)]])) - =. exp (con exp (lsh 3 31 0b100.0000)) - =+ prv=(end 8 1 exp) - =+ crv=(fra.fq (sum.fq 1 pub) (dif.fq 1 pub)) - (curt prv crv) - :: :: ++sign:ed:crypto - ++ sign :: certify - ~/ %sign - |= {m/@ se/@} ^- @ - =+ sk=(suck se) - =+ pk=(cut 0 [b b] sk) - =+ h=(shal (rsh 0 3 b) sk) - =+ ^= a - %+ add - (bex (sub b 2)) - (lsh 0 3 (cut 0 [3 (sub b 5)] h)) - =+ ^= r - =+ hm=(cut 0 [b b] h) - =+ ^= i - %+ can 0 - :~ [b hm] - [(met 0 m) m] - == - (shaz i) - =+ rr=(scam bb r) - =+ ^= ss - =+ er=(etch rr) - =+ ^= ha - %+ can 0 - :~ [b er] - [b pk] - [(met 0 m) m] - == - (~(sit fo l) (add r (mul (shaz ha) a))) - (can 0 ~[[b (etch rr)] [b ss]]) - :: :: ++veri:ed:crypto - ++ veri :: validate - ~/ %veri - |= {s/@ m/@ pk/@} ^- ? - ?: (gth (div b 4) (met 3 s)) | - ?: (gth (div b 8) (met 3 pk)) | - =+ cb=(rsh 0 3 b) - =+ rr=(deco (cut 0 [0 b] s)) - ?~ rr | - =+ aa=(deco pk) - ?~ aa | - =+ ss=(cut 0 [b b] s) - =+ ha=(can 3 ~[[cb (etch u.rr)] [cb pk] [(met 3 m) m]]) - =+ h=(shaz ha) - =((scam bb ss) (ward u.rr (scam u.aa h))) - -- ::ed - :: :: ++hmac:crypto - ++ hmac :: HMAC-SHA1 - |= {key/@ mes/@} - =+ ip=(fil 3 64 0x36) - =+ op=(fil 3 64 0x5c) - =+ ^= kex - ?: (gth (met 3 key) 64) - (lsh 3 44 (shan key)) - (lsh 3 (sub 64 (met 3 key)) (swp 3 key)) - =+ inn=(shan (swp 3 (cat 3 (swp 3 mes) (mix ip kex)))) - (shan (swp 3 (cat 3 inn (mix op kex)))) - :: :: - :::: ++scr:crypto :: (2b3) scrypt - :: :::: - ++ scr - ~% %scr +> ~ - |% - :: :: ++sal:scr:crypto - ++ sal :: salsa20 hash - |= {x/@ r/@} :: with r rounds - ?> =((mod r 2) 0) :: - =+ few==>(fe .(a 5)) - =+ ^= rot - |= {a/@ b/@} - (mix (end 5 1 (lsh 0 a b)) (rsh 0 (sub 32 a) b)) - =+ ^= lea - |= {a/@ b/@} - (net:few (sum:few (net:few a) (net:few b))) - => |% - :: :: ++qr:sal:scr:crypto - ++ qr :: quarterround - |= y/{@ @ @ @ $~} - =+ zb=(mix &2.y (rot 7 (sum:few &1.y &4.y))) - =+ zc=(mix &3.y (rot 9 (sum:few zb &1.y))) - =+ zd=(mix &4.y (rot 13 (sum:few zc zb))) - =+ za=(mix &1.y (rot 18 (sum:few zd zc))) - ~[za zb zc zd] - :: :: ++rr:sal:scr:crypto - ++ rr :: rowround - |= {y/(list @)} - =+ za=(qr ~[&1.y &2.y &3.y &4.y]) - =+ zb=(qr ~[&6.y &7.y &8.y &5.y]) - =+ zc=(qr ~[&11.y &12.y &9.y &10.y]) - =+ zd=(qr ~[&16.y &13.y &14.y &15.y]) - ^- (list @) :~ - &1.za &2.za &3.za &4.za - &4.zb &1.zb &2.zb &3.zb - &3.zc &4.zc &1.zc &2.zc - &2.zd &3.zd &4.zd &1.zd == - :: :: ++cr:sal:scr:crypto - ++ cr :: columnround - |= {x/(list @)} - =+ ya=(qr ~[&1.x &5.x &9.x &13.x]) - =+ yb=(qr ~[&6.x &10.x &14.x &2.x]) - =+ yc=(qr ~[&11.x &15.x &3.x &7.x]) - =+ yd=(qr ~[&16.x &4.x &8.x &12.x]) - ^- (list @) :~ - &1.ya &4.yb &3.yc &2.yd - &2.ya &1.yb &4.yc &3.yd - &3.ya &2.yb &1.yc &4.yd - &4.ya &3.yb &2.yc &1.yd == - :: :: ++dr:sal:scr:crypto - ++ dr :: doubleround - |= {x/(list @)} - (rr (cr x)) - :: :: ++al:sal:scr:crypto - ++ al :: add two lists - |= {a/(list @) b/(list @)} - |- ^- (list @) - ?~ a ~ ?~ b ~ - [i=(sum:few -.a -.b) t=$(a +.a, b +.b)] - -- :: - =+ xw=(rpp 5 16 x) - =+ ^= ow |- ^- (list @) - ?~ r xw - $(xw (dr xw), r (sub r 2)) - (rep 5 (al xw ow)) - :: :: ++rpp:scr:crypto - ++ rpp :: rip+filler blocks - |= {a/bloq b/@ c/@} - =+ q=(rip a c) - =+ w=(lent q) - ?. =(w b) - ?. (lth w b) (slag (sub w b) q) - ^+ q (weld q (reap (sub b (lent q)) 0)) - q - :: :: ++bls:scr:crypto - ++ bls :: split to sublists - |= {a/@ b/(list @)} - ?> =((mod (lent b) a) 0) - |- ^- (list (list @)) - ?~ b ~ - [i=(scag a `(list @)`b) t=$(b (slag a `(list @)`b))] - :: :: ++slb:scr:crypto - ++ slb :: - |= {a/(list (list @))} - |- ^- (list @) - ?~ a ~ - (weld `(list @)`-.a $(a +.a)) - :: :: ++sbm:scr:crypto - ++ sbm :: scryptBlockMix - |= {r/@ b/(list @)} - ?> =((lent b) (mul 2 r)) - =+ [x=(snag (dec (mul 2 r)) b) c=0] - =| {ya/(list @) yb/(list @)} - |- ^- (list @) - ?~ b (flop (weld yb ya)) - =. x (sal (mix x -.b) 8) - ?~ (mod c 2) - $(c +(c), b +.b, ya [i=x t=ya]) - $(c +(c), b +.b, yb [i=x t=yb]) - :: :: ++srm:scr:crypto - ++ srm :: scryptROMix - |= {r/@ b/(list @) n/@} - ?> ?& =((lent b) (mul 2 r)) - =(n (bex (dec (xeb n)))) - (lth n (bex (mul r 16))) - == - =+ [v=*(list (list @)) c=0] - =. v - |- ^- (list (list @)) - =+ w=(sbm r b) - ?: =(c n) (flop v) - $(c +(c), v [i=[b] t=v], b w) - =+ x=(sbm r (snag (dec n) v)) - |- ^- (list @) - ?: =(c n) x - =+ q=(snag (dec (mul r 2)) x) - =+ z=`(list @)`(snag (mod q n) v) - =+ ^= w |- ^- (list @) - ?~ x ~ ?~ z ~ - [i=(mix -.x -.z) t=$(x +.x, z +.z)] - $(x (sbm r w), c +(c)) - :: :: ++hmc:scr:crypto - ++ hmc :: HMAC-SHA-256 - |= {k/@ t/@} - (hml k (met 3 k) t (met 3 t)) - :: :: ++hml:scr:crypto - ++ hml :: w+length - |= {k/@ kl/@ t/@ tl/@} - => .(k (end 3 kl k), t (end 3 tl t)) - =+ b=64 - =? k (gth kl b) (shay kl k) - =+ ^= q %+ shay (add b tl) - (add (lsh 3 b t) (mix k (fil 3 b 0x36))) - %+ shay (add b 32) - (add (lsh 3 b q) (mix k (fil 3 b 0x5c))) - :: :: ++pbk:scr:crypto - ++ pbk :: PBKDF2-HMAC-SHA256 - ~/ %pbk - |= {p/@ s/@ c/@ d/@} - (pbl p (met 3 p) s (met 3 s) c d) - :: :: ++pbl:scr:crypto - ++ pbl :: w+length - ~/ %pbl - |= {p/@ pl/@ s/@ sl/@ c/@ d/@} - => .(p (end 3 pl p), s (end 3 sl s)) - =+ h=32 - :: - :: max key length 1GB - :: max iterations 2^28 - :: - ?> ?& (lte d (bex 30)) - (lte c (bex 28)) - !=(c 0) - == - =+ ^= l ?~ (mod d h) - (div d h) - +((div d h)) - =+ r=(sub d (mul h (dec l))) - =+ [t=0 j=1 k=1] - =. t |- ^- @ - ?: (gth j l) t - =+ u=(add s (lsh 3 sl (rep 3 (flop (rpp 3 4 j))))) - =+ f=0 =. f |- ^- @ - ?: (gth k c) f - =+ q=(hml p pl u ?:(=(k 1) (add sl 4) h)) - $(u q, f (mix f q), k +(k)) - $(t (add t (lsh 3 (mul (dec j) h) f)), j +(j)) - (end 3 d t) - :: :: ++hsh:scr:crypto - ++ hsh :: scrypt - ~/ %hsh - |= {p/@ s/@ n/@ r/@ z/@ d/@} - (hsl p (met 3 p) s (met 3 s) n r z d) - :: :: ++hsl:scr:crypto - ++ hsl :: w+length - ~/ %hsl - |= {p/@ pl/@ s/@ sl/@ n/@ r/@ z/@ d/@} - =| v/(list (list @)) - => .(p (end 3 pl p), s (end 3 sl s)) - =+ u=(mul (mul 128 r) z) - :: - :: n is power of 2; max 1GB memory - :: - ?> ?& =(n (bex (dec (xeb n)))) - !=(r 0) !=(z 0) - %+ lte - (mul (mul 128 r) (dec (add n z))) - (bex 30) - (lth pl (bex 31)) - (lth sl (bex 31)) - == - =+ ^= b =+ (rpp 3 u (pbl p pl s sl 1 u)) - %+ turn (bls (mul 128 r) -) - |=(a/(list @) (rpp 9 (mul 2 r) (rep 3 a))) - ?> =((lent b) z) - =+ ^= q - =+ |- ?~ b (flop v) - $(b +.b, v [i=(srm r -.b n) t=v]) - %+ turn `(list (list @))`- - |=(a/(list @) (rpp 3 (mul 128 r) (rep 9 a))) - (pbl p pl (rep 3 (slb q)) u 1 d) - :: :: ++ypt:scr:crypto - ++ ypt :: 256bit {salt pass} - |= {s/@ p/@} - ^- @ - (hsh p s 16.384 8 1 256) - -- ::scr - :: :: - :::: ++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 - ?~ sek ~| %pubkey-only !! - (jam [(sign:ed msg sgn.u.sek) msg]) - :: :: ++sure:as:crub: - ++ sure :: - |= {@ txt/@} - ^- (unit @ux) - =+ ((hard {sig/@ msg/@}) (cue txt)) - ?. (veri:ed sig msg sgn.pub) ~ - (some msg) - :: :: ++seal:as:crub: - ++ seal :: - |= {bpk/pass m1/@ m2/@} - ^- @ux - ?~ sek ~| %pubkey-only !! - ?> =('b' (end 3 1 bpk)) - =+ pk=(rsh 8 1 (rsh 3 1 bpk)) - =+ shar=(shax (shar:ed pk cry.u.sek)) - =+ msg=(jam m1 m2) - =+ smsg=(sign ~ msg) - (jam (~(en siva:aes shar ~) smsg)) - :: :: ++tear:as:crub: - ++ tear :: - |= {bpk/pass txt/@} - ^- (unit (pair @ux @ux)) - ?~ sek ~| %pubkey-only !! - ?> =('b' (end 3 1 bpk)) - =+ pk=(rsh 8 1 (rsh 3 1 bpk)) - =+ shar=(shax (shar:ed pk cry.u.sek)) - =+ ((hard {iv/@ len/@ cph/@}) (cue txt)) - =+ try=(~(de siva:aes shar ~) iv len cph) - ?~ try ~ - =+ veri=(sure:as:(com:nu:crub bpk) ~ u.try) - ?~ veri ~ - (some ((hard (pair @ux @ux)) (cue u.veri))) - -- ::as - :: :: ++de:crub:crypto - ++ de :: decrypt - |= {key/@J txt/@} - ^- (unit @ux) - =+ ((hard {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 sgn.^pub) - :: :: ++pac:ex:crub:crypto - ++ pac :: private fingerprint - ^- @uvG - ?~ sek ~| %pubkey-only !! - (end 6 1 (shaf %bcod sgn.u.sek)) - :: :: ++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 1 bits) s=(end 8 1 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 1 a) bod=(rsh 3 1 a)] - ~| %not-crub-seckey ?> =('B' mag) - =+ [c=(rsh 8 1 bod) s=(end 8 1 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 1 a) bod=(rsh 3 1 a)] - ~| %not-crub-pubkey ?> =('b' mag) - ..nu(pub [cry=(rsh 8 1 bod) sgn=(end 8 1 bod)], sek ~) - -- ::nu - -- ::crub - :: :: - :::: ++crua:crypto :: (2b5) suite B, RSA - :: :::: - ++ crua !: - ^- acru - =| {mos/@ pon/(unit {p/@ q/@ r/{p/@ q/@} s/_*fu})} - => |% - :: :: ++mx:crua:crypto - ++ mx :: bit length - (dec (met 0 mos)) - :: :: ++dap:crua:crypto - ++ dap :: OEAP decode - |= {wid/@ xar/@ dog/@} ^- {p/@ q/@} - =+ pav=(sub wid xar) - =+ qoy=(cut 0 [xar pav] dog) - =+ dez=(mix (end 0 xar dog) (shaw %pad-b xar qoy)) - [dez (mix qoy (shaw %pad-a pav dez))] - :: :: ++pad:crua:crypto - ++ pad :: OEAP encode - |= {wid/@ rax/{p/@ q/@} meg/@} ^- @ - =+ pav=(sub wid p.rax) - ?> (gte pav (met 0 meg)) - ^- @ - =+ qoy=(mix meg (shaw %pad-a pav q.rax)) - =+ dez=(mix q.rax (shaw %pad-b p.rax qoy)) - (can 0 [p.rax dez] [pav qoy] ~) - :: :: ++pull:crua:crypto - ++ pull :: - |=(a/@ (~(exp fo mos) 3 a)) - :: :: ++push:crua:crypto - ++ push :: - |=(a/@ (~(exp fo mos) 5 a)) - :: :: ++pump:crua:crypto - ++ pump :: - |= a/@ ^- @ - ?~ pon !! - (out.s.u.pon (exp.s.u.pon p.r.u.pon (sit.s.u.pon a))) - :: :: ++punt:crua:crypto - ++ punt :: - |= a/@ ^- @ - ?~ pon !! - (out.s.u.pon (exp.s.u.pon q.r.u.pon (sit.s.u.pon a))) - -- :: - |% - :: :: ++as:crua:crypto - ++ as :: - => |% - :: :: ++haul:as:crua: - ++ haul :: - |= a/pass - =+ [mag=(end 3 1 a) bod=(rsh 3 1 a)] - ?> =('a' mag) - ..as(mos bod, pon ~) - -- :: - ^? - |% - :: :: ++seal:as:crua: - ++ seal :: - |= {a/pass b/@ c/@} - ^- @ - => .(c (sign b c)) - =+ her=(haul a) - =+ det=(lte (add 256 (met 0 c)) mx.her) - =+ lip=?:(det c 0) - =- (add ?:(p.mav 0 1) (lsh 0 1 q.mav)) - ^= mav ^- {p/? q/@} - :- det - =+ dog=(pad mx.her [256 b] lip) - =+ hog=(push.her dog) - =+ ben=(en b c) - ?:(det hog (jam hog ben)) - :: :: ++sign:as:crua: - ++ sign :: - |= {a/@ b/@} ^- @ - =- (add ?:(p.mav 0 1) (lsh 0 1 q.mav)) - ^= mav ^- {p/? q/@} - =+ det=(lte (add 128 (met 0 b)) mx) - :- det - =+ hec=(shaf (mix %agis a) b) - =+ dog=(pad mx [128 hec] ?:(det b 0)) - =+ hog=(pump dog) - ?:(det hog (jam hog b)) - :: :: ++sure:as:crua: - ++ sure :: - |= {a/@ b/@} - ^- (unit @) - =+ [det==(0 (end 0 1 b)) bod=(rsh 0 1 b)] - =+ gox=?:(det [p=bod q=0] ((hard {p/@ q/@}) (cue bod))) - =+ dog=(pull p.gox) - =+ pig=(dap mx 128 dog) - =+ log=?:(det q.pig q.gox) - ?.(=(p.pig (shaf (mix %agis a) log)) ~ [~ log]) - :: :: ++tear:as:crua: - ++ tear :: - |= {a/pass b/@} - ^- (unit {p/@ q/@}) - =+ her=(haul a) - =+ [det==(0 (end 0 1 b)) bod=(rsh 0 1 b)] - =+ gox=?:(det [p=bod q=0] ((hard {p/@ q/@}) (cue bod))) - =+ dog=(punt p.gox) - =+ pig=(dap mx 256 dog) - =+ ^= cow - ^- (unit @) - ?: det - [~ q.pig] - (de p.pig q.gox) - ?~ cow ~ - => .(cow (sure:as.her p.pig u.cow)) - ?~ cow ~ - [~ p.pig u.cow] - -- ::as - :: :: ++de:crua:crypto - ++ de :: decrypt - |~ {key/@ cep/@} ^- (unit @) - =+ toh=(met 8 cep) - ?: (lth toh 2) - ~ - =+ adj=(dec toh) - =+ [hax=(end 8 1 cep) bod=(rsh 8 1 cep)] - =+ msg=(mix (~(raw og (mix hax key)) (mul 256 adj)) bod) - ?. =(hax (shax (mix key (shax (mix adj msg))))) - ~ - [~ msg] - :: :: ++dy:crua:crypto - ++ dy :: need decrypt - |~({a/@ b/@} (need (de a b))) - :: :: ++en:crua:crypto - ++ en :: encrypt - |~ {key/@ msg/@} ^- @ux - =+ len=(met 8 msg) - =+ adj=?:(=(0 len) 1 len) - =+ hax=(shax (mix key (shax (mix adj msg)))) - (rap 8 hax (mix msg (~(raw og (mix hax key)) (mul 256 adj))) ~) - :: :: ++ex:crua:crypto - ++ ex :: extract - ^? - |% - :: :: ++fig:ex:crua:crypto - ++ fig :: fingerprint - `@uvH`(shaf %afig mos) - :: :: ++pac:ex:crua:crypto - ++ pac :: private fingerprint - `@uvG`(end 6 1 (shaf %acod sec)) - :: :: ++pub:ex:crua:crypto - ++ pub :: public fingerprint - `pass`(cat 3 'a' mos) - :: :: ++sec:ex:crua:crypto - ++ sec :: private key - `ring`?~(pon !! (cat 3 'A' (jam p.u.pon q.u.pon))) - -- ::ex - :: :: ++nu:crua:crypto - ++ nu :: - => |% - :: :: ++elcm:nu:crua: - ++ elcm :: - |= {a/@ b/@} - (div (mul a b) d:(egcd a b)) - :: :: ++eldm:nu:crua: - ++ eldm :: - |= {a/@ b/@ c/@} - (~(inv fo (elcm (dec b) (dec c))) a) - :: :: ++ersa:nu:crua: - ++ ersa :: - |= {a/@ b/@} - [a b [(eldm 3 a b) (eldm 5 a b)] (fu a b)] - -- :: - ^? - |% - :: :: ++com:nu:crua:crypto - ++ com :: - |= a/@ - ^+ ^?(..nu) - ..nu(mos a, pon ~) - :: :: ++pit:nu:crua:crypto - ++ pit :: - |= {a/@ b/@} - =+ c=(rsh 0 1 a) - =+ [d=(ramp c [3 5 ~] b) e=(ramp c [3 5 ~] +(b))] - ^+ ^?(..nu) - ..nu(mos (mul d e), pon [~ (ersa d e)]) - :: :: ++nol:nu:crua:crypto - ++ nol :: - |= a/@ - ^+ ^?(..nu) - =+ b=((hard {p/@ q/@}) (cue a)) - ..nu(mos (mul p.b q.b), pon [~ (ersa p.b q.b)]) - -- ::nu - -- ::crua - :: :: - :::: ++test:crypto :: (2b6) test crypto - :: :::: - ++ test ^? - :: - :: XX: ++bruw, ++haul and ++weur are obsolete crua interfaces; - :: delete or restructure - |% - :: :: ++trua:test:crypto - ++ trua :: test crua - |= msg/@tas - ^- @ - =+ ali=(bruw:suite 1.024 (shax 'ali')) - =+ bob=(bruw:suite 1.024 (shax 'bob')) - =+ tef=(sign:as.ali [0 msg]) - =+ lov=(sure:as.ali [0 tef]) - ?. &(?=(^ lov) =(msg u.lov)) - ~|(%test-fail-sign !!) - =+ key=(shax (shax (shax msg))) - =+ sax=(seal:as.ali pub:ex.bob key msg) - =+ tin=(tear:as.bob pub:ex.ali sax) - ?. &(?=(^ tin) =(key p.u.tin) =(msg q.u.tin)) - ~|(%test-fail-seal !!) - msg - :: :: ++trub:test:crypto - ++ trub :: test crub - |= msg/@t - :: - :: make acru cores - :: - =/ ali (pit:nu:crub 512 (shaz 'Alice')) - =/ ali-pub (com:nu:crub pub:ex.ali) - =/ bob (pit:nu:crub 512 (shaz 'Robert')) - =/ bob-pub (com:nu:crub pub:ex.bob) - :: - :: alice signs and encrypts a symmetric key to bob - :: - =/ secret-key %- shaz - 'Let there be no duplicity when taking a stand against him.' - =/ signed-key (sign:as.ali ~ secret-key) - =/ crypted-key (seal:as.ali pub:ex.bob-pub ~ signed-key) - :: bob decrypts and verifies - =/ decrypt-key-attempt (tear:as.bob pub:ex.ali-pub crypted-key) - =/ decrypted-key ~| %decrypt-fail (need decrypt-key-attempt) - =/ verify-key-attempt (sure:as.ali-pub ~ q.decrypted-key) - =/ verified-key ~| %verify-fail (need verify-key-attempt) - :: bob encrypts with symmetric key - =/ crypted-msg (en.bob verified-key msg) - :: alice decrypts with same key - `@t`(dy.ali secret-key crypted-msg) - -- ::test - :: :: - :::: ++suite:crypto :: (2b7) generalized - :: :::: - ++ suite ^? - :: - :: XX: ++bruw, ++haul and ++weur are obsolete crua interfaces; - :: delete or restructure - |% - :: :: ++bruw:suite:crypto - ++ bruw :: create keypair - |= {width/@ seed/@} - ^- acru - (pit:nu:crua width seed) - :: :: ++haul:suite:crypto - ++ haul :: activate public key - |= a/pass - ^- acru - =+ [mag=(end 3 1 a) bod=(rsh 3 1 a)] - ?> =('a' mag) - (com:nu:crua bod) - :: :: ++weur:suite:crypto - ++ weur :: activate secret key - |= a/ring - ^- acru - =+ [mag=(end 3 1 a) bod=(rsh 3 1 a)] - ?> =('A' mag) - (nol:nu:crua bod) - -- ::suite - -- ::crypto -:: :::: -:::: ++unity :: (2c) unit promotion - :: :::: -++ unity ^? - |% - :: :: ++drop-list:unity - ++ drop-list :: collapse unit list - |* lut/(list (unit)) - ?. |- ^- ? - ?~(lut & ?~(i.lut | $(lut t.lut))) - ~ - %- some - |- - ?~ lut ~ - [i=u:+.i.lut t=$(lut t.lut)] - :: :: ++drop-map:unity - ++ drop-map :: collapse unit map - |* lum/(map term (unit)) - ?: (~(rep by lum) |=({{@ a/(unit)} b/_|} |(b ?=($~ a)))) - ~ - (some (~(run by lum) need)) - :: :: ++drop-pole:unity - ++ drop-pole :: unit tuple - |* a/(pole (unit)) - ?- a - {i/(unit) t/*} - ?~ t.a i.a - %+ both i.a - (drop-pole t.a) - == - -- -:: :::: -:::: ++format :: (2d) common formats - :: :::: -++ format ^? - |% - :: :: ++to-wain:format - ++ to-wain :: atom to line list - ~% %lore ..ship ~ - |= lub/@ - =| tez/(list @t) - |- ^+ tez - =+ ^= wor - =+ [meg=0 i=0] - |- ^- {meg/@ i/@ end/@f} - =+ gam=(cut 3 [i 1] lub) - ?: =(0 gam) - [meg i %.y] - ?: =(10 gam) - [meg i %.n] - $(meg (cat 3 meg gam), i +(i)) - ?: end.wor - (flop ^+(tez [meg.wor tez])) - ?: =(0 lub) (flop tez) - $(lub (rsh 3 +(i.wor) lub), tez [meg.wor tez]) - :: :: ++of-wain:format - ++ of-wain :: line list to atom - |= tez/(list @t) - =| {our/@ i/@ud} - |- ^- @ - ?~ tez - our - ?: =(%$ i.tez) - $(i +(i), tez t.tez, our (cat 3 our 10)) - ?: =(0 i) - $(i +(i), tez t.tez, our i.tez) - $(i +(i), tez t.tez, our (cat 3 (cat 3 our 10) i.tez)) - :: :: ++of-wall:format - ++ of-wall :: line list to tape - |= a/wall ^- tape - ?~(a ~ "{i.a}\0a{$(a t.a)}") - :: :: ++en-beam:format - ++ en-beam :: beam to path - |= bem/beam - ^- path - [(scot %p p.bem) q.bem (scot r.bem) (flop s.bem)] - :: :: ++de-beam:format - ++ de-beam :: parse path to beam - |= pax/path - ^- (unit beam) - ?. ?=({* * * *} pax) ~ - %+ biff (slaw %p i.pax) - |= who/ship - %+ biff (slaw %tas i.t.pax) - |= dex/desk - %+ biff (slay i.t.t.pax) - |= cis/coin - ?. ?=({$$ case} cis) ~ - `(unit beam)`[~ [who dex `case`p.cis] (flop t.t.t.pax)] - :: :: ++enjs:format - ++ enjs ^? :: json encoders - |% - :: :: ++frond:enjs:format - ++ frond :: object from k-v pair - |= {p/@t q/json} - ^- json - [%o [[p q] ~ ~]] - :: :: ++pairs:enjs:format - ++ pairs :: object from k-v list - |= a/(list {p/@t q/json}) - ^- json - [%o (~(gas by *(map @t json)) a)] - :: :: ++tape:enjs:format - ++ tape :: string from tape - |= a/^tape - ^- json - [%s (crip a)] - :: :: ++wall:enjs:format - ++ wall :: string from wall - |= a/^wall - ^- json - (tape (of-wall a)) - :: :: ++ship:enjs:format - ++ ship :: string from ship - |= a/^ship - ^- json - (tape (slag 1 (scow %p a))) - :: :: ++numb:enjs:format - ++ numb :: number from unsigned - |= a/@u - ^- json - :- %n - ?: =(0 a) '0' - %- crip - %- flop - |- ^- ^tape - ?:(=(0 a) ~ [(add '0' (mod a 10)) $(a (div a 10))]) - :: :: ++time:enjs:format - ++ time :: ms timestamp - |= a/^time - =- (numb (div (mul - 1.000) ~s1)) - (add (div ~s1 2.000) (sub a ~1970.1.1)) - -- ::enjs - :: :: ++dejs:format - ++ dejs :: json reparser - => |% ++ grub * :: result - ++ fist $-(json grub) :: reparser instance - -- :: - |% - :: :: ++ar:dejs:format - ++ ar :: array as list - |* wit/fist - |= jon/json ^- (list _(wit *json)) - ?> ?=({$a *} jon) - (turn p.jon wit) - :: :: ++at:dejs:format - ++ at :: array as tuple - |* wil/(pole fist) - |= jon/json - ?> ?=({$a *} jon) - ((at-raw wil) p.jon) - :: :: ++at-raw:dejs:format - ++ at-raw :: array as tuple - |* wil/(pole fist) - |= jol/(list json) - ?~ jol !! - ?- wil :: mint-vain on empty - :: {wit/* t/*} - {* t/*} - => .(wil [wit ~]=wil) - ?~ t.wil ?^(t.jol !! (wit.wil i.jol)) - [(wit.wil i.jol) ((at-raw t.wil) t.jol)] - == - :: :: ++bo:dejs:format - ++ bo :: boolean - |=(jon/json ?>(?=({$b *} jon) p.jon)) - :: :: ++bu:dejs:format - ++ bu :: boolean not - |=(jon/json ?>(?=({$b *} jon) !p.jon)) - :: :: ++ci:dejs:format - ++ ci :: maybe transform - |* {poq/gate wit/fist} - |= jon/json - (need (poq (wit jon))) - :: :: ++cu:dejs:format - ++ cu :: transform - |* {poq/gate wit/fist} - |= jon/json - (poq (wit jon)) - :: :: ++di:dejs:format - ++ di :: millisecond date - %+ cu - |= a/@u ^- @da - (add ~1970.1.1 (div (mul ~s1 a) 1.000)) - ni - :: :: ++mu:dejs:format - ++ mu :: true unit - |* wit/fist - |= jon/json - ?~(jon ~ (some (wit jon))) - :: :: ++ne:dejs:format - ++ ne :: number as real - |= jon/json - ^- (unit @rd) - :: please implement me, it's not that hard! - !! - :: :: ++ni:dejs:format - ++ ni :: number as integer - |= jon/json - ?> ?=({$n *} jon) - (rash p.jon dem) - :: :: ++no:dejs:format - ++ no :: number as cord - |=(jon/json ?>(?=({$n *} jon) p.jon)) - :: :: ++of:dejs:format - ++ of :: object as frond - |* wer/(pole {cord fist}) - |= jon/json - ?> ?=({$o {@ *} $~ $~} jon) - |- - ?- wer :: mint-vain on empty - :: {{key/@t wit/*} t/*} - {{key/@t *} t/*} - => .(wer [[~ wit] ~]=wer) - ?: =(key.wer p.n.p.jon) - [key.wer ~|(key+key.wer (wit.wer q.n.p.jon))] - ?~ t.wer ~|(bad-key+p.n.p.jon !!) - ((of t.wer) jon) - == - :: :: ++ot:dejs:format - ++ ot :: object as tuple - |* wer/(pole {cord fist}) - |= jon/json - ?> ?=({$o *} jon) - ((ot-raw wer) p.jon) - :: :: ++ot-raw:dejs:format - ++ ot-raw :: object as tuple - |* wer/(pole {cord fist}) - |= jom/(map @t json) - ?- wer :: mint-vain on empty - :: {{key/@t wit/*} t/*} - {{key/@t *} t/*} - => .(wer [[~ wit] ~]=wer) - =/ ten ~|(key+key.wer (wit.wer (~(got by jom) key.wer))) - ?~(t.wer ten [ten ((ot-raw t.wer) jom)]) - == - :: :: ++om:dejs:format - ++ om :: object as map - |* wit/fist - |= jon/json - ?> ?=({$o *} jon) - (~(run by p.jon) wit) - :: :: ++op:dejs:format - ++ op :: parse keys of map - |* {fel/rule wit/fist} - |= jon/json ^- (map _(wonk *fel) _*wit) - =/ jom ((om wit) jon) - %- malt - %+ turn (~(tap by jom)) - |* {a/cord b/*} - => .(+< [a b]=+<) - [(rash a fel) b] - :: :: ++pe:dejs:format - ++ pe :: prefix - |* {pre/* wit/fist} - (cu |*(* [pre +<]) wit) - :: :: ++sa:dejs:format - ++ sa :: string as tape - |=(jon/json ?>(?=({$s *} jon) (trip p.jon))) - :: :: ++so:dejs:format - ++ so :: string as cord - |=(jon/json ?>(?=({$s *} jon) p.jon)) - :: :: ++su:dejs:format - ++ su :: parse string - |* sab/rule - |= jon/json ^+ (wonk *sab) - ?> ?=({$s *} jon) - (rash p.jon sab) - :: :: ++ul:dejs:format - ++ ul :: null - |=(jon/json ?~(jon ~ !!)) - -- ::dejs - :: :: ++dejs-soft:format - ++ dejs-soft :: json reparse to unit - =, unity - => |% ++ grub (unit *) :: result - ++ fist $-(json grub) :: reparser instance - -- :: - |% - :: :: ++ar:dejs-soft: - ++ ar :: array as list - |* wit/fist - |= jon/json ^- (unit (list _(need (wit *json)))) - ?. ?=({$a *} jon) ~ - %- drop-list - |- - ?~ p.jon ~ - [i=(wit i.p.jon) t=$(p.jon t.p.jon)] - :: :: ++at:dejs-soft: - ++ at :: array as tuple - |* wil/(pole fist) - |= jon/json - ?. ?=({$a *} jon) ~ - ((at-raw wil) p.jon) - :: :: ++at-raw:dejs-soft: - ++ at-raw :: array as tuple - |* wil/(pole fist) - |= jol/(list json) - ?~ jol ~ - ?- wil :: mint-vain on empty - :: {wit/* t/*} - {* t/*} - => .(wil [wit ~]=wil) - ?~ t.wil ?^(t.jol ~ (wit.wil i.jol)) - %+ both (wit.wil i.jol) - ((at-raw t.wil) t.jol) - == - :: :: ++bo:dejs-soft: - ++ bo :: boolean - |=(jon/json ?.(?=({$b *} jon) ~ [~ u=p.jon])) - :: :: ++bu:dejs-soft: - ++ bu :: boolean not - |=(jon/json ?.(?=({$b *} jon) ~ [~ u=!p.jon])) - :: :: ++ci:dejs-soft: - ++ ci :: maybe transform - |* {poq/gate wit/fist} - |= jon/json - (biff (wit jon) poq) - :: :: ++cu:dejs-soft: - ++ cu :: transform - |* {poq/gate wit/fist} - |= jon/json - (bind (wit jon) poq) - :: :: ++di:dejs-soft: - ++ di :: millisecond date - %+ cu - |= a/@u ^- @da - (add ~1970.1.1 (div (mul ~s1 a) 1.000)) - ni - :: :: ++mu:dejs-soft: - ++ mu :: true unit - |* wit/fist - |= jon/json - ?~(jon (some ~) (bind (wit jon) some)) - :: :: ++ne:dejs-soft: - ++ ne :: number as real - |= jon/json - ^- (unit @rd) - :: please implement me, it's not that hard! - !! - :: :: ++ni:dejs-soft: - ++ ni :: number as integer - |= jon/json - ?. ?=({$n *} jon) ~ - (rush p.jon dem) - :: :: ++no:dejs-soft: - ++ no :: number as cord - |= jon/json - ?. ?=({$n *} jon) ~ - (some p.jon) - :: :: ++of:dejs-soft: - ++ of :: object as frond - |* wer/(pole {cord fist}) - |= jon/json - ?. ?=({$o {@ *} $~ $~} jon) ~ - |- - ?- wer :: mint-vain on empty - :: {{key/@t wit/*} t/*} - {{key/@t *} t/*} - => .(wer [[~ wit] ~]=wer) - ?: =(key.wer p.n.p.jon) - ((pe key.wer wit.wer) q.n.p.jon) - ?~ t.wer ~ - ((of t.wer) jon) - == - :: :: ++ot:dejs-soft: - ++ ot :: object as tuple - |* wer/(pole {cord fist}) - |= jon/json - ?. ?=({$o *} jon) ~ - ((ot-raw wer) p.jon) - :: :: ++ot-raw:dejs-soft: - ++ ot-raw :: object as tuple - |* wer/(pole {cord fist}) - |= jom/(map @t json) - ?- wer :: mint-vain on empty - :: {{key/@t wit/*} t/*} - {{key/@t *} t/*} - => .(wer [[~ wit] ~]=wer) - =/ ten (biff (~(get by jom) key.wer) wit.wer) - ?~ t.wer ten - (both ten ((ot-raw t.wer) jom)) - == - :: :: ++om:dejs-soft: - ++ om :: object as map - |* wit/fist - |= jon/json - ?. ?=({$o *} jon) ~ - (drop-map (~(run by p.jon) wit)) - :: :: ++op:dejs-soft: - ++ op :: parse keys of map - |* {fel/rule wit/fist} - |= jon/json ^- (unit (map _(wonk *fel) _*wit)) - =/ jom ((om wit) jon) - ?~ jom ~ - %- drop-map - %- malt - %+ turn (~(tap by jom)) - |* {a/cord b/*} - (both (rush a fel) (some b)) - :: :: ++pe:dejs-soft: - ++ pe :: prefix - |* {pre/* wit/fist} - (cu |*(* [pre +<]) wit) - :: :: ++sa:dejs-soft: - ++ sa :: string as tape - |= jon/json - ?.(?=({$s *} jon) ~ (some (trip p.jon))) - :: :: ++so:dejs-soft: - ++ so :: string as cord - |= jon/json - ?.(?=({$s *} jon) ~ (some p.jon)) - :: :: ++su:dejs-soft: - ++ su :: parse string - |* sab/rule - |= jon/json - ?. ?=({$s *} jon) ~ - (rush p.jon sab) - :: :: ++ul:dejs-soft: - ++ ul :: null - |=(jon/json ?~(jon (some ~) ~)) - -- ::dejs-soft - -- -:: :: -:::: ++differ :: (2d) hunt-mcilroy - :: :::: -++ differ ^? - =, clay - =, format - |% - :: :: ++berk:differ - ++ berk :: invert diff patch - |* bur/(urge) - |- ^+ bur - ?~ bur ~ - :_ $(bur t.bur) - ?- -.i.bur - $& i.bur - $| [%| q.i.bur p.i.bur] - == - :: :: ++loss:differ - ++ loss :: longest subsequence - ~% %loss ..ship ~ - |* {hel/(list) hev/(list)} - |- ^+ hev - =+ ^= sev - =+ [inx=0 sev=*(map _i.-.hev (list @ud))] - |- ^+ sev - ?~ hev sev - =+ guy=(~(get by sev) i.hev) - %= $ - hev t.hev - inx +(inx) - sev (~(put by sev) i.hev [inx ?~(guy ~ u.guy)]) - == - =| gox/{p/@ud q/(map @ud {p/@ud q/_hev})} - =< abet - =< main - |% - :: :: ++abet:loss:differ - ++ abet :: subsequence - ^+ hev - ?: =(0 p.gox) ~ - (flop q:(need (~(get by q.gox) (dec p.gox)))) - :: :: ++hink:loss:differ - ++ hink :: extend fits top - |= {inx/@ud goy/@ud} ^- ? - ?| =(p.gox inx) - (lth goy p:(need (~(get by q.gox) inx))) - == - :: :: ++lonk:loss:differ - ++ lonk :: extend fits bottom - |= {inx/@ud goy/@ud} ^- ? - ?| =(0 inx) - (gth goy p:(need (~(get by q.gox) (dec inx)))) - == - :: :: ++luna:loss:differ - ++ luna :: extend - |= {inx/@ud goy/@ud} - ^+ +> - %_ +>.$ - gox - :- ?:(=(inx p.gox) +(p.gox) p.gox) - %+ ~(put by q.gox) inx - :+ goy - (snag goy hev) - ?:(=(0 inx) ~ q:(need (~(get by q.gox) (dec inx)))) - == - :: :: ++merg:loss:differ - ++ merg :: merge all matches - |= gay/(list @ud) - ^+ +> - =+ ^= zes - =+ [inx=0 zes=*(list {p/@ud q/@ud})] - |- ^+ zes - ?: |(?=($~ gay) (gth inx p.gox)) zes - ?. (lonk inx i.gay) $(gay t.gay) - ?. (hink inx i.gay) $(inx +(inx)) - $(inx +(inx), gay t.gay, zes [[inx i.gay] zes]) - |- ^+ +>.^$ - ?~(zes +>.^$ $(zes t.zes, +>.^$ (luna i.zes))) - :: :: ++main:loss:differ - ++ main :: - =+ hol=hel - |- ^+ +> - ?~ hol +> - =+ guy=(~(get by sev) i.hol) - $(hol t.hol, +> (merg (flop `(list @ud)`?~(guy ~ u.guy)))) - -- :: - :: :: ++lurk:differ - ++ lurk :: apply list patch - |* {hel/(list) rug/(urge)} - ^+ hel - =+ war=`_hel`~ - |- ^+ hel - ?~ rug (flop war) - ?- -.i.rug - $& - %= $ - rug t.rug - hel (slag p.i.rug hel) - war (weld (flop (scag p.i.rug hel)) war) - == - :: - $| - %= $ - rug t.rug - hel =+ gur=(flop p.i.rug) - |- ^+ hel - ?~ gur hel - ?>(&(?=(^ hel) =(i.gur i.hel)) $(hel t.hel, gur t.gur)) - war (weld q.i.rug war) - == - == - :: :: ++lusk:differ - ++ lusk :: lcs to list patch - |* {hel/(list) hev/(list) lcs/(list)} - =+ ^= rag - ^- {$%({$& p/@ud} {$| p/_lcs q/_lcs})} - [%& 0] - => .(rag [p=rag q=*(list _rag)]) - =< abet =< main - |% - :: :: ++abet:lusk:differ - ++ abet :: - =? q.rag !=([& 0] p.rag) [p.rag q.rag] - (flop q.rag) - :: :: ++done:lusk:differ - ++ done :: - |= new/_p.rag - ^+ rag - ?- -.p.rag - $| ?- -.new - $| [[%| (weld p.new p.p.rag) (weld q.new q.p.rag)] q.rag] - $& [new [p.rag q.rag]] - == - $& ?- -.new - $| [new ?:(=(0 p.p.rag) q.rag [p.rag q.rag])] - $& [[%& (add p.p.rag p.new)] q.rag] - == - == - :: :: ++main:lusk:differ - ++ main :: - |- ^+ + - ?~ hel - ?~ hev - ?>(?=($~ lcs) +) - $(hev t.hev, rag (done %| ~ [i.hev ~])) - ?~ hev - $(hel t.hel, rag (done %| [i.hel ~] ~)) - ?~ lcs - +(rag (done %| (flop hel) (flop hev))) - ?: =(i.hel i.lcs) - ?: =(i.hev i.lcs) - $(lcs t.lcs, hel t.hel, hev t.hev, rag (done %& 1)) - $(hev t.hev, rag (done %| ~ [i.hev ~])) - ?: =(i.hev i.lcs) - $(hel t.hel, rag (done %| [i.hel ~] ~)) - $(hel t.hel, hev t.hev, rag (done %| [i.hel ~] [i.hev ~])) - -- :: - -- ::differ -:: :: -:::: ++html :: (2e) text encodings - :: :::: -++ html ^? :: XX rename to web-txt - =, eyre - |% - :: :: - :::: ++mimes:html :: (2e1) MIME - :: :::: - ++ mimes ^? - |% - :: :: ++as-octs:mimes:html - ++ as-octs :: atom to octstream - |= tam/@ ^- octs - [(met 3 tam) tam] - :: :: ++as-octt:mimes:html - ++ as-octt :: tape to octstream - |= tep/tape ^- octs - (as-octs (rap 3 tep)) - :: :: ++en-mite:mimes:html - ++ en-mite :: mime type to text - |= myn/mite - %- crip - |- ^- tape - ?~ myn ~ - ?: =(~ t.myn) (trip i.myn) - (weld (trip i.myn) `tape`['/' $(myn t.myn)]) - :: :: ++en-base64:mimes: - ++ en-base64 :: encode base64 - |= tig/@ - ^- tape - =+ poc=(~(dif fo 3) 0 (met 3 tig)) - =+ pad=(lsh 3 poc (swp 3 tig)) - =+ ^= cha - 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/' - =+ ^= sif - |- ^- tape - ?~ pad - ~ - =+ d=(end 0 6 pad) - [(cut 3 [d 1] cha) $(pad (rsh 0 6 pad))] - (weld (flop (slag poc sif)) (reap poc '=')) - :: :: ++de-base64:mimes: - ++ de-base64 :: decode base64 - =- |=(a/cord (rash a fel)) - =< fel=(cook |~(a/@ `@t`(swp 3 a)) (bass 64 .)) - =- (cook welp ;~(plug (plus siw) (stun 0^2 (cold %0 tis)))) - ^= siw - ;~ pose - (cook |=(a/@ (sub a 'A')) (shim 'A' 'Z')) - (cook |=(a/@ (sub a 'G')) (shim 'a' 'z')) - (cook |=(a/@ (add a 4)) (shim '0' '9')) - (cold 62 (just '+')) - (cold 63 (just '/')) - == - -- ::mimes - :: :: ++en-json:html - ++ en-json :: print json - |^ |=(val/json (apex val "")) - :: :: ++apex:en-json:html - ++ apex - |= {val/json rez/tape} - ^- tape - ?~ val (weld "null" rez) - ?- -.val - $a - :- '[' - =. rez [']' rez] - !. - ?~ p.val rez - |- - ?~ t.p.val ^$(val i.p.val) - ^$(val i.p.val, rez [',' $(p.val t.p.val)]) - :: - $b (weld ?:(p.val "true" "false") rez) - $n (weld (trip p.val) rez) - $s - :- '"' - =. rez ['"' rez] - =+ viz=(trip p.val) - !. - |- ^- tape - ?~ viz rez - =+ hed=(jesc i.viz) - ?: ?=({@ $~} hed) - [i.hed $(viz t.viz)] - (weld hed $(viz t.viz)) - :: - $o - :- '{' - =. rez ['}' rez] - =+ viz=(~(tap by p.val)) - ?~ viz rez - !. - |- ^+ rez - ?~ t.viz ^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)]) - =. rez [',' $(viz t.viz)] - ^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)]) - == - :: :: ++jesc:en-json:html - ++ jesc :: escaped - =+ utf=|=(a/@ ['\\' 'u' ((x-co 4):co a)]) - |= a/@ ^- tape - ?+ a ?:((gth a 0x1f) [a ~] (utf a)) - $10 "\\n" - $34 "\\\"" - $92 "\\\\" - == - -- ::en-json - :: :: ++de-json:html - ++ de-json :: parse JSON - =< |=(a/cord `(unit json)`(rush a apex)) - |% - :: :: ++abox:de-json:html - ++ abox :: array - %+ stag %a - (ifix [sel (wish ser)] (more (wish com) apex)) - :: :: ++apex:de-json:html - ++ apex :: any value - %+ knee *json |. ~+ - %+ ifix [spac spac] - ;~ pose - (cold ~ (jest 'null')) - (stag %b bool) - (stag %s stri) - (cook |=(s/tape [%n p=(rap 3 s)]) numb) - abox - obox - == - :: :: ++bool:de-json:html - ++ bool :: boolean - ;~ pose - (cold & (jest 'true')) - (cold | (jest 'false')) - == - :: :: ++digs:de-json:html - ++ digs :: digits - (star (shim '0' '9')) - :: :: ++esca:de-json:html - ++ esca :: escaped character - ;~ pfix bas - =* loo - =* lip - ^- (list (pair @t @)) - [b+8 t+9 n+10 f+12 r+13 ~] - =* wow `(map @t @)`(malt lip) - (sear ~(get by wow) low) - =* tuf ;~(pfix (just 'u') (cook tuft qix:ab)) - ;~(pose doq fas soq bas loo tuf) - == - :: :: ++expo:de-json:html - ++ expo :: exponent - ;~ (comp twel) - (piec (mask "eE")) - (mayb (piec (mask "+-"))) - digs - == - :: :: ++frac:de-json:html - ++ frac :: fraction - ;~(plug dot digs) - :: :: ++jcha:de-json:html - ++ jcha :: string character - ;~(pose ;~(less doq bas prn) esca) - :: :: ++mayb:de-json:html - ++ mayb :: optional - |*(bus/rule ;~(pose bus (easy ~))) - :: :: ++numb:de-json:html - ++ numb :: number - ;~ (comp twel) - (mayb (piec hep)) - ;~ pose - (piec (just '0')) - ;~(plug (shim '1' '9') digs) - == - (mayb frac) - (mayb expo) - == - :: :: ++obje:de-json:html - ++ obje :: object list - %+ ifix [(wish kel) (wish ker)] - (more (wish com) pear) - :: :: ++obox:de-json:html - ++ obox :: object - (stag %o (cook malt obje)) - :: :: ++pear:de-json:html - ++ pear :: key-value - ;~(plug ;~(sfix (wish stri) (wish col)) apex) - :: :: ++piec:de-json:html - ++ piec :: listify - |* bus/rule - (cook |=(a/@ [a ~]) bus) - :: :: ++stri:de-json:html - ++ stri :: string - (cook crip (ifix [doq doq] (star jcha))) - :: :: ++tops:de-json:html - ++ tops :: strict value - ;~(pose abox obox) - :: :: ++spac:de-json:html - ++ spac :: whitespace - (star (mask [`@`9 `@`10 `@`13 ' ' ~])) - :: :: ++twel:de-json:html - ++ twel :: tape weld - |=({a/tape b/tape} (weld a b)) - :: :: ++wish:de-json:html - ++ wish :: with whitespace - |*(sef/rule ;~(pfix spac sef)) - -- ::de-json - :: :: ++en-xml:html - ++ en-xml :: xml printer - =< |=(a/manx `tape`(apex a ~)) - |_ _[unq=`?`| cot=`?`|] - :: :: ++apex:en-xml:html - ++ apex :: top level - |= {mex/manx rez/tape} - ^- tape - ?: ?=({$$ {{$$ *} $~}} g.mex) - (escp v.i.a.g.mex rez) - =+ man=`mane`n.g.mex - =. unq |(unq =(%script man) =(%style man)) - =+ tam=(name man) - =+ att=`mart`a.g.mex - :- '<' - %+ welp tam - =- ?~(att rez [' ' (attr att rez)]) - ^- rez/tape - ?: &(?=($~ c.mex) |(cot (clot man))) - [' ' '/' '>' rez] - :- '>' - (many c.mex :(weld "" rez)) - :: :: ++attr:en-xml:html - ++ attr :: attributes to tape - |= {tat/mart rez/tape} - ^- tape - ?~ tat rez - =. rez $(tat t.tat) - ;: weld - (name n.i.tat) - "=\"" - (escp(unq |) v.i.tat '"' ?~(t.tat rez [' ' rez])) - == - :: :: ++escp:en-xml:html - ++ escp :: escape for xml - |= {tex/tape rez/tape} - ?: unq - (weld tex rez) - =+ xet=`tape`(flop tex) - !. - |- ^- tape - ?~ xet rez - %= $ - xet t.xet - rez ?- i.xet - $34 ['&' 'q' 'u' 'o' 't' ';' rez] - $38 ['&' 'a' 'm' 'p' ';' rez] - $39 ['&' '#' '3' '9' ';' rez] - $60 ['&' 'l' 't' ';' rez] - $62 ['&' 'g' 't' ';' rez] - * [i.xet rez] - == - == - :: :: ++many:en-xml:html - ++ many :: nodelist to tape - |= {lix/(list manx) rez/tape} - |- ^- tape - ?~ lix rez - (apex i.lix $(lix t.lix)) - :: :: ++name:en-xml:html - ++ name :: name to tape - |= man/mane ^- tape - ?@ man (trip man) - (weld (trip -.man) `tape`[':' (trip +.man)]) - :: :: ++clot:en-xml:html - ++ clot ~+ :: self-closing tags - %~ has in - %- silt ^- (list term) :~ - %area %base %br %col %command %embed %hr %img %inputt - %keygen %link %meta %param %source %track %wbr - == == - -- ::en-xml - :: :: ++de-xml:html - ++ de-xml :: xml parser - =< |=(a/cord (rush a apex)) - |_ ent/_`(map term @t)`[[%apos '\''] ~ ~] - :: :: ++apex:de-xml:html - ++ apex :: top level - =+ spa=;~(pose comt whit) - %+ knee *manx |. ~+ - %+ ifix [(star spa) (star spa)] - ;~ pose - %+ sear |=({a/marx b/marl c/mane} ?.(=(c n.a) ~ (some [a b]))) - ;~(plug head many tail) - empt - == - :: :: ++attr:de-xml:html - ++ attr :: attributes - %+ knee *mart |. ~+ - %- star - ;~ plug - ;~(pfix (plus whit) name) - ;~ pose - (ifix [;~(plug tis doq) doq] (star ;~(less doq escp))) - (ifix [;~(plug tis soq) soq] (star ;~(less soq escp))) - (easy ~) - == - == - :: :: ++chrd:de-xml:html - ++ chrd :: character data - %+ cook |=(a/tape ^-(mars ;/(a))) - (plus ;~(less doq ;~(pose (just `@`10) escp))) - :: :: ++comt:de-xml:html - ++ comt :: comments - =- (ifix [(jest '')] (star -)) - ;~ pose - ;~(less hep prn) - whit - ;~(less (jest '-->') hep) - == - :: :: ++escp:de-xml:html - ++ escp :: - ;~(pose ;~(less gal gar pam prn) enty) - :: :: ++enty:de-xml:html - ++ enty :: entity - %+ ifix pam^sem - ;~ pose - =+ def=^+(ent (my [%gt '>'] [%lt '<'] [%amp '&'] [%quot '"'] ~)) - %+ sear ~(get by (~(uni by def) ent)) - (cook crip ;~(plug alf (stun 1^31 aln))) - %+ cook |=(a/@c ?:((gth a 0x10.ffff) '�' (tuft a))) - =< ;~(pfix hax ;~(pose - +)) - :- (bass 10 (stun 1^8 dit)) - (bass 16 ;~(pfix (mask "xX") (stun 1^8 hit))) - == - :: :: ++empt:de-xml:html - ++ empt :: self-closing tag - %+ ifix [gal (jest '/>')] - ;~(plug ;~(plug name attr) (cold ~ (star whit))) - :: :: ++head:de-xml:html - ++ head :: opening tag - (ifix [gal gar] ;~(plug name attr)) - :: :: ++many:de-xml:html - ++ many :: contents - (more (star comt) ;~(pose apex chrd)) - :: :: ++name:de-xml:html - ++ name :: tag name - =+ ^= chx - %+ cook crip - ;~ plug - ;~(pose cab alf) - (star ;~(pose cab dot alp)) - == - ;~(pose ;~(plug ;~(sfix chx col) chx) chx) - :: :: ++tail:de-xml:html - ++ tail :: closing tag - (ifix [(jest ' |=(a/@ ((sand %tas) (crip (flop (trip a))))) - (;~(sfix (sear . sym) dot) [1^1 (flop (trip i.rax))]) - ?~ q.raf - [~ [i.rax ~]] - =+ `{ext/term {@ @} fyl/tape}`u.q.raf - :- `ext - ?:(=(~ fyl) ~ [(crip (flop fyl)) ~]) - :: :: ++apat:de-purl:html - ++ apat :: 2396 abs_path - %+ cook deft - (ifix [fas ;~(pose fas (easy ~))] (more fas smeg)) - :: :: ++aurf:de-purl:html - ++ aurf :: 2396 with fragment - %+ cook |~(a/purf a) - ;~(plug auri (punt ;~(pfix hax (cook crip (star pque))))) - :: :: ++auri:de-purl:html - ++ auri :: 2396 URL - %+ cook - |= a/purl - ?.(?=(hoke r.p.a) a a(p.p &)) - ;~ plug - ;~(plug htts thor) - ;~(plug ;~(pose apat (easy *pork)) yque) - == - :: :: ++auru:de-purl:html - ++ auru :: 2396 with maybe user - %+ cook - |= $: a/{p/? q/(unit user) r/{(unit @ud) host}} - b/{pork quay} - == - ^- (pair (unit user) purl) - [q.a [[p.a r.a] b]] - :: - ;~ plug - ;~(plug htts (punt ;~(sfix urt:ab pat)) thor) - ;~(plug ;~(pose apat (easy *pork)) yque) - == - :: :: ++htts:de-purl:html - ++ htts :: scheme - %+ sear ~(get by (malt `(list (pair term ?))`[http+| https+& ~])) - ;~(sfix scem ;~(plug col fas fas)) - :: :: ++cock:de-purl:html - ++ cock :: cookie - %+ most ;~(plug sem ace) - ;~(plug toke ;~(pfix tis tosk)) - :: :: ++dlab:de-purl:html - ++ dlab :: 2396 domainlabel - %+ sear - |= a/@ta - ?.(=('-' (rsh 3 (dec (met 3 a)) a)) [~ u=a] ~) - %+ cook |=(a/tape (crip (cass a))) - ;~(plug aln (star alp)) - :: :: ++fque:de-purl:html - ++ fque :: normal query field - (cook crip (plus pquo)) - :: :: ++fquu:de-purl:html - ++ fquu :: optional query field - (cook crip (star pquo)) - :: :: ++pcar:de-purl:html - ++ pcar :: 2396 path char - ;~(pose pure pesc psub col pat) - :: :: ++pcok:de-purl:html - ++ pcok :: cookie char - ;~(less bas sem com doq prn) - :: :: ++pesc:de-purl:html - ++ pesc :: 2396 escaped - ;~(pfix cen mes) - :: :: ++pold:de-purl:html - ++ pold :: - (cold ' ' (just '+')) - :: :: ++pque:de-purl:html - ++ pque :: 3986 query char - ;~(pose pcar fas wut) - :: :: ++pquo:de-purl:html - ++ pquo :: normal query char - ;~(pose pure pesc pold fas wut) - :: :: ++pure:de-purl:html - ++ pure :: 2396 unreserved - ;~(pose aln hep dot cab sig) - :: :: ++psub:de-purl:html - ++ psub :: 3986 sub-delims - ;~ pose - zap buc pam soq pel per - tar lus com sem tis - == - :: :: ++ptok:de-purl:html - ++ ptok :: 2616 token - ;~ pose - aln zap hax buc cen pam soq tar lus - hep dot ket cab tec bar sig - == - :: :: ++scem:de-purl:html - ++ scem :: 2396 scheme - %+ cook |=(a/tape (crip (cass a))) - ;~(plug alf (star ;~(pose aln lus hep dot))) - :: :: ++smeg:de-purl:html - ++ smeg :: 2396 segment - (cook crip (plus pcar)) - :: :: ++tock:de-purl:html - ++ tock :: 6265 raw value - (cook crip (plus pcok)) - :: :: ++tosk:de-purl:html - ++ tosk :: 6265 quoted value - ;~(pose tock (ifix [doq doq] tock)) - :: :: ++toke:de-purl:html - ++ toke :: 2616 token - (cook crip (plus ptok)) - :: :: ++thor:de-purl:html - ++ thor :: 2396 host+port - %+ cook |*({* *} [+<+ +<-]) - ;~ plug - thos - ;~((bend) (easy ~) ;~(pfix col dim:ag)) - == - :: :: ++thos:de-purl:html - ++ thos :: 2396 host, no local - ;~ plug - ;~ pose - %+ stag %& - %+ sear :: LL parser weak here - |= a/(list @t) - =+ b=(flop a) - ?> ?=(^ b) - =+ c=(end 3 1 i.b) - ?.(&((gte c 'a') (lte c 'z')) ~ [~ u=b]) - (most dot dlab) - :: - %+ stag %| - =+ tod=(ape:ag ted:ab) - %+ bass 256 - ;~(plug tod (stun [3 3] ;~(pfix dot tod))) - == - == - :: :: ++yque:de-purl:html - ++ yque :: query ending - ;~ pose - ;~(pfix wut yquy) - (easy ~) - == - :: :: ++yquy:de-purl:html - ++ yquy :: query - ;~ pose - :: proper query - :: - %+ more - ;~(pose pam sem) - ;~(plug fque ;~(pose ;~(pfix tis fquu) (easy ''))) - :: - :: funky query - :: - %+ cook - |=(a/tape [[%$ (crip a)] ~]) - (star pque) - == - :: :: ++zest:de-purl:html - ++ zest :: 2616 request-uri - ;~ pose - (stag %& (cook |=(a/purl a) auri)) - (stag %| ;~(plug apat yque)) - == - -- ::de-purl - :: MOVEME - :: :: ++fuel:html - ++ fuel :: parse urbit fcgi - |= {bem/beam ced/noun:cred quy/quer} - ^- epic - =+ qix=|-(`quay`?~(quy quy [[p q]:quy $(quy t.quy)])) - [(malt qix) ((hard cred) ced) bem /] - -- ::eyre -:: :: -:::: ++wired :: wire formatting - :: :::: -++ wired ^? - |% - :: :: ++dray:wired - ++ dray :: load tuple in path - :: - :: .= ~[p=~.ack q=~.~sarnel r=~..y] - :: (dray ~[p=%tas q=%p r=%f] %ack ~sarnel &) - :: - =- |* {a/{@tas (pole @tas)} b/*} ^- (paf a) - => .(b `(tup -.a +.a)`b) - ?~ +.a [(scot -.a b) ~] - [(scot -.a -.b) `(paf +.a)`(..$ +.a +.b)] - :- paf=|*(a/(pole) ?~(a $~ {(odo:raid -.a(. %ta)) (..$ +.a)})) - ^= tup - |* {a/@tas b/(pole @tas)} - =+ c=(odo:raid a) - ?~(b c {c (..$ -.b +.b)}) - :: :: ++raid:wired - ++ raid :: demand path odors - :: - :: .= [p=%ack q=~sarnel r=&] - :: (raid /ack/~sarnel+.y p=%tas q=%p r=%f ~) - :: - =- |* {a/path b/{@tas (pole @tas)}} - =* fog (odo -.b) - ?~ +.b `fog`(slav -.b -.a) - [`fog`(slav -.b -.a) (..$ +.a +.b)] - ^= odo - |* a/@tas - |= b/* - =< a(, (. b)) :: preserve face - ?+ a @ - $c @c $da @da $dr @dr $f @f $if @if $is @is $p @p - $u @u $uc @uc $ub @ub $ui @ui $ux @ux $uv @uv $uw @uw - $s @s $t @t $ta @ta $tas @tas - == - :: :: ++read:wired - ++ read :: parse odored path - =< |*({a/path b/{@tas (pole @tas)}} ((+> b) a)) - |* b/{@tas (pole @tas)} - |= a/path - ?~ a ~ - =+ hed=(slaw -.b i.a) - =* fog (odo:raid -.b) - ?~ +.b - ^- (unit fog) - ?^(+.a ~ hed) - ^- (unit {fog _(need *(..^$ +.b))}) - (both hed ((..^$ +.b) +.a)) - -- ::wired -:: :: -:::: ++title :: (2j) namespace - :: :::: -++ title ^? - |% - :: :: ++cite:title - ++ cite :: render ship - |= who/@p - ^- tape - =+ kind=(clan who) - =+ name=(scow %p who) - ?: =(%earl kind) - :(weld "~" (swag [15 6] name) "^" (swag [22 6] name)) - ?: =(%pawn kind) - :(weld (swag [0 7] name) "_" (swag [51 6] name)) - name - :: :: ++clan:title - ++ clan :: ship to rank - |= who/ship ^- rank:ames - =+ wid=(met 3 who) - ?: (lte wid 1) %czar - ?: =(2 wid) %king - ?: (lte wid 4) %duke - ?: (lte wid 8) %earl - ?> (lte wid 16) %pawn - :: :: ++glam:title - ++ glam :: galaxy name - |= zar/@pD ^- tape - (weld "galaxy " (scow %p zar)) - :: :: ++gnom:title - ++ gnom :: ship display name - |= {{our/@p now/@da} him/@p} ^- @t - =+ yow=(scot %p him) - =+ pax=[(scot %p our) %ktts (scot %da now) yow ~] - =+ woy=.^(@t %a pax) - ?: =(%$ woy) yow - (rap 3 yow ' ' woy ~) - :: :: ++gnow:title - ++ gnow :: full display name - |= {who/@p gos/gcos:ames} ^- @t - ?- -.gos - $czar (rap 3 '|' (rap 3 (glam who)) '|' ~) - $king (rap 3 '_' p.gos '_' ~) - $earl (rap 3 ':' p.gos ':' ~) - $pawn ?~(p.gos %$ (rap 3 '.' u.p.gos '.' ~)) - $duke - ?: ?=($anon -.p.gos) %$ - %+ rap 3 - ^- (list @) - ?- -.p.gos - $punk ~['"' q.p.gos '"'] - ?($lord $lady) - =+ ^= nad - =+ nam=`name:ames`s.p.p.gos - %+ rap 3 - :~ p.nam - ?~(q.nam 0 (cat 3 ' ' u.q.nam)) - ?~(r.nam 0 (rap 3 ' (' u.r.nam ')' ~)) - ' ' - s.nam - == - ?:(=(%lord -.p.gos) ~['[' nad ']'] ~['(' nad ')']) - == - == - :: :: ++saxo:title - ++ saxo :: autocanon - |= who/ship - ^- (list ship) - =+ dad=(sein who) - [who ?:(=(who dad) ~ $(who dad))] - :: :: ++sein:title - ++ sein :: autoboss - |= who/ship ^- ship - =+ mir=(clan who) - ?- mir - $czar ~zod - $king (end 3 1 who) - $duke (end 4 1 who) - $earl (end 5 1 who) - $pawn (end 4 1 who) - == - :: :: ++team:title - ++ team :: our / our moon - |= {our/@p him/@p} - ?| =(our him) - &(?=($earl (clan him)) =(our (sein him))) - == - -- ::title -:: :: -:::: ++userlib :: (2u) non-vane utils - :: :::: -++ userlib ^? - |% - :: :: - :::: ++chrono:userlib :: (2uB) time - :: :::: - ++ chrono ^? - |% - :: :: ++dawn:chrono: - ++ dawn :: Jan 1 weekday - |= yer/@ud - =+ yet=(sub yer 1) - %- mod :_ 7 - ;: add - 1 - (mul 5 (mod yet 4)) - (mul 4 (mod yet 100)) - (mul 6 (mod yet 400)) - == - :: :: ++daws:chrono: - ++ daws :: date weekday - |= yed/date - %- mod :_ 7 - %+ add - (dawn y.yed) - (sub (yawn [y.yed m.yed d.t.yed]) (yawn y.yed 1 1)) - :: :: ++deal:chrono: - ++ deal :: to leap sec time - |= yer/@da - =+ n=0 - =+ yud=(yore yer) - |- ^- date - ?: (gte yer (add (snag n lef:yu) ~s1)) - (yore (year yud(s.t (add n s.t.yud)))) - ?: &((gte yer (snag n lef:yu)) (lth yer (add (snag n lef:yu) ~s1))) - yud(s.t (add +(n) s.t.yud)) - ?: =(+(n) (lent lef:yu)) - (yore (year yud(s.t (add +(n) s.t.yud)))) - $(n +(n)) - :: :: ++lead:chrono: - ++ lead :: from leap sec time - |= ley/date - =+ ler=(year ley) - =+ n=0 - |- ^- @da - =+ led=(sub ler (mul n ~s1)) - ?: (gte ler (add (snag n les:yu) ~s1)) - led - ?: &((gte ler (snag n les:yu)) (lth ler (add (snag n les:yu) ~s1))) - ?: =(s.t.ley 60) - (sub led ~s1) - led - ?: =(+(n) (lent les:yu)) - (sub led ~s1) - $(n +(n)) - :: :: ++dust:chrono: - ++ dust :: print UTC format - |= yed/date - ^- tape - =+ wey=(daws yed) - =/ num (d-co:co 1) :: print as decimal without dots - =/ pik |=({n/@u t/wall} `tape`(scag 3 (snag n t))) - :: - "{(pik wey wik:yu)}, ". - "{(num d.t.yed)} {(pik (dec m.yed) mon:yu)} {(num y.yed)} ". - "{(num h.t.yed)}:{(num m.t.yed)}:{(num s.t.yed)} +0000" - :: :: ++stud:chrono: - ++ stud :: parse UTC format - =< |= a/cord - %+ biff (rush a (more sepa elem)) - |= b/(list _(wonk *elem)) ^- (unit date) - %- drop-pole:unity - ^+ =+ [*date u=unit] - *{(u _[a y]) (u _m) (u _d.t) (u _+.t) $~} - :~ - |-(?~(b ~ ?.(?=($y -.i.b) $(b t.b) `+.i.b))) - |-(?~(b ~ ?.(?=($m -.i.b) $(b t.b) `+.i.b))) - |-(?~(b ~ ?.(?=($d -.i.b) $(b t.b) `+.i.b))) - |-(?~(b ~ ?.(?=($t -.i.b) $(b t.b) `+.i.b))) - == - |% - :: :: ++snug:stud:chrono: - ++ snug :: position in list - |= a/(list tape) - |= b/tape - =+ [pos=1 len=(lent b)] - |- ^- (unit @u) - ?~ a ~ - ?: =(b (scag len i.a)) - `pos - $(pos +(pos), a t.a) - :: :: ++sepa:stud:chrono: - ++ sepa :: separator - ;~(pose ;~(plug com (star ace)) (plus ace)) - :: :: ++elem:stud:chrono: - ++ elem :: date element - ;~ pose - (stag %t t) (stag %y y) (stag %m m) (stag %d d) - (stag %w w) (stag %z z) - == - :: :: ++y:stud:chrono: - ++ y :: year - (stag %& (bass 10 (stun 3^4 dit))) - :: :: ++m:stud:chrono: - ++ m :: month - (sear (snug mon:yu) (plus alf)) - :: :: ++d:stud:chrono: - ++ d :: day - (bass 10 (stun 1^2 dit)) - :: :: ++t:stud:chrono: - ++ t :: hours:minutes:secs - %+ cook |=({h/@u @ m/@u @ s/@u} ~[h m s]) - ;~(plug d col d col d) - :: - :: XX day of week is currently unchecked, and - :: timezone outright ignored. - :: :: ++w:stud:chrono: - ++ w :: day of week - (sear (snug wik:yu) (plus alf)) - :: :: ++z:stud:chrono: - ++ z :: time zone - ;~(plug (mask "-+") dd dd) - :: :: ++dd:stud:chrono: - ++ dd :: two digits - (bass 10 (stun 2^2 dit)) - -- :: - :: :: ++unt:chrono:userlib - ++ unt :: Urbit to Unix time - |= a/@ - (div (sub a ~1970.1.1) ~s1) - :: :: ++yu:chrono:userlib - ++ yu :: UTC format constants - |% - :: :: ++mon:yu:chrono: - ++ mon :: months - ^- (list tape) - :~ "January" "February" "March" "April" "May" "June" "July" - "August" "September" "October" "November" "December" - == - :: :: ++wik:yu:chrono: - ++ wik :: weeks - ^- (list tape) - :~ "Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" - "Friday" "Saturday" - == - :: :: ++lef:yu:chrono: - ++ lef :: leapsecond dates - ^- (list @da) - :~ ~2015.6.30..23.59.59 ~2012.6.30..23.59.59 - ~2008.12.31..23.59.58 ~2005.12.31..23.59.57 - ~1998.12.31..23.59.56 ~1997.6.30..23.59.55 - ~1995.12.31..23.59.54 ~1994.6.30..23.59.53 - ~1993.6.30..23.59.52 ~1992.6.30..23.59.51 - ~1990.12.31..23.59.50 ~1989.12.31..23.59.49 - ~1987.12.31..23.59.48 ~1985.6.30..23.59.47 - ~1983.6.30..23.59.46 ~1982.6.30..23.59.45 - ~1981.6.30..23.59.44 ~1979.12.31..23.59.43 - ~1978.12.31..23.59.42 ~1977.12.31..23.59.41 - ~1976.12.31..23.59.40 ~1975.12.31..23.59.39 - ~1974.12.31..23.59.38 ~1973.12.31..23.59.37 - ~1972.12.31..23.59.36 ~1972.6.30..23.59.35 - == - :: :: ++les:yu:chrono: - ++ les :: leapsecond days - ^- (list @da) - :~ ~2015.7.1 ~2012.7.1 ~2009.1.1 ~2006.1.1 ~1999.1.1 ~1997.7.1 - ~1996.1.1 ~1994.7.1 ~1993.7.1 ~1992.7.1 ~1991.1.1 ~1990.1.1 - ~1988.1.1 ~1985.7.1 ~1983.7.1 ~1982.7.1 ~1981.7.1 ~1980.1.1 - ~1979.1.1 ~1978.1.1 ~1977.1.1 ~1976.1.1 ~1975.1.1 ~1974.1.1 - ~1973.1.1 ~1972.7.1 - == - -- ::yu - -- ::chrono - :: :: - :::: ++error:userlib :: error handling - :: :::: - ++ error ^? - |% - :: :: ++mean:error: - ++ mean :: deify stack trace - |=(a/tang (fear (flop a) |.(!!))) - :: :: ++fear:error: - ++ fear :: insert user mean - |* {a/tang _|?(**)} - ^+ (+<+) - => .(a `tang`a) - ?~ a (+<+) - ~_(i.a $(a t.a)) - :: :: ++slog:error: - ++ slog :: deify printf - :: pri: priority level - =| pri/@ - :: - :: .= ~&(%a 1) - :: - |= a/tang ^+ same - :: - :: ((slog ~[>%a<]) 1) - :: - ?~(a same ~>(%slog.[pri i.a] $(a t.a))) - :: :: ++sloy:error: - ++ sloy :: temporary hack - |= sod/slyd - ^- slyt - |= {ref/* raw/*} - =+ pux=((soft path) raw) - ?~ pux ~ - ?. ?=({@ @ @ @ *} u.pux) ~ - =+ :* hyr=(slay i.u.pux) - fal=(slay i.t.u.pux) - dyc=(slay i.t.t.u.pux) - ved=(slay i.t.t.t.u.pux) - tyl=t.t.t.t.u.pux - == - ?. ?=({$~ $$ $tas @} hyr) ~ - ?. ?=({$~ $$ $p @} fal) ~ - ?. ?=({$~ $$ $tas @} dyc) ~ - ?. ?=(^ ved) ~ - =+ ron=q.p.u.hyr - =+ bed=[[q.p.u.fal q.p.u.dyc (case p.u.ved)] (flop tyl)] - =+ bop=(sod ref ~ ron bed) - ?~ bop ~ - ?~ u.bop [~ ~] - [~ ~ +.q.u.u.bop] - -- - :: :: - :::: ++space:userlib :: (2uC) file utils - :: :::: - ++ space ^? - =, clay - |% - :: :: ++feel:space:userlib - ++ feel :: simple file write - |= {pax/path val/cage} - ^- miso - =+ dir=.^(arch %cy pax) - ?~ fil.dir [%ins val] - [%mut val] - :: :: ++file:space:userlib - ++ file :: simple file load - |= pax/path - ^- (unit) - =+ dir=.^(arch %cy pax) - ?~(fil.dir ~ [~ .^(* %cx pax)]) - :: :: ++foal:space:userlib - ++ foal :: high-level write - |= {pax/path val/cage} - ^- toro - ?> ?=({* * * *} pax) - [i.t.pax [%& [[[t.t.t.pax (feel pax val)] ~]]]] - :: :: ++fray:space:userlib - ++ fray :: high-level delete - |= pax/path - ^- toro - ?> ?=({* * * *} pax) - [i.t.pax [%& [[[t.t.t.pax [%del ~]] ~]]]] - :: :: ++furl:space:userlib - ++ furl :: unify changes - |= {one/toro two/toro} - ^- toro - ~| %furl - ?> ?& =(p.one p.two) :: same path - &(?=($& -.q.one) ?=($& -.q.two)) :: both deltas - == - [p.one [%& (weld p.q.one p.q.two)]] - -- ::space - :: :: - :::: ++unix:userlib :: (2uD) unix line-list - :: :::: - ++ unix ^? - |% - :: :: ++lune:unix:userlib - ++ lune :: cord by unix line - ~% %lune ..ship ~ - |= txt/@t - ?~ txt - ^- (list @t) ~ - =+ [byt=(rip 3 txt) len=(met 3 txt)] - =| {lin/(list @t) off/@} - ^- (list @t) - %- flop - |- ^+ lin - ?: =(off len) - ~| %noeol !! - ?: =((snag off byt) 10) - ?: =(+(off) len) - [(rep 3 (scag off byt)) lin] - %= $ - lin [(rep 3 (scag off byt)) lin] - byt (slag +(off) byt) - len (sub len +(off)) - off 0 - == - $(off +(off)) - :: :: ++nule:unix:userlib - ++ nule :: lines to unix cord - ~% %nule ..ship ~ - |= lin/(list @t) - ^- @t - %+ can 3 - %+ turn lin - |= t/@t - [+((met 3 t)) (cat 3 t 10)] - -- - :: :: - :::: ++scanf:userlib :: (2uF) exterpolation - :: :::: - ++ scanf - =< |* {tape (pole _;/(*{$^(rule tape)}))} :: formatted scan - => .(+< [a b]=+<) - (scan a (parsf b)) - |% - :: :: ++parsf:scanf: - ++ parsf :: make parser from: - |* a/(pole _;/(*{$^(rule tape)})) :: ;"chars{rule}chars" - =- (cook - (boil (norm a))) - |* (list) - ?~ +< ~ - ?~ t i - [i $(+< t)] - :: - :: .= (boil ~[[& dim] [| ", "] [& dim]]:ag) - :: ;~(plug dim ;~(pfix com ace ;~(plug dim (easy)))):ag - :: - :: :: ++boil:scanf:userlib - ++ boil :: - |* (list (each rule tape)) - ?~ +< (easy ~) - ?: ?=($| -.i) ;~(pfix (jest (crip p.i)) $(+< t)) - %+ cook |*({* *} [i t]=+<) - ;~(plug p.i $(+< t)) - :: - :: .= (norm [;"{n}, {n}"]:n=dim:ag) ~[[& dim] [| ", "] [& dim]]:ag - :: - :: :: ++norm:scanf:userlib - ++ norm :: - |* (pole _;/(*{$^(rule tape)})) - ?~ +< ~ - => .(+< [i=+<- t=+<+]) - :_ t=$(+< t) - =+ rul=->->.i - ^= i - ?~ rul [%| p=rul] - ?~ +.rul [%| p=rul] - ?@ &2.rul [%| p=;;(tape rul)] - [%& p=rul] - -- ::scanf - :: :: - :::: ++pubsub:userlib :: (2uG) application - :: :::: - ++ pubsub ^? - =, gall - |% - :: :: ++pale:pubsub: - ++ pale :: filter peers - |= {hid/bowl fun/$-(sink ?)} - (skim (~(tap by sup.hid)) fun) - :: :: ++prix:pubsub: - ++ prix :: filter gate - |= pax/path |= sink ^- ? - ?~ pax & ?~ r.+< | - &(=(i.pax i.r.+<) $(pax t.pax, r.+< t.r.+<)) - :: :: ++prey:pubsub: - ++ prey :: prefix - |=({pax/path hid/bowl} (pale hid (prix pax))) - -- ::pubsub - -- -:: -++ zuse %309 :: hoon+zuse kelvin -++ gift-arvo :: out result <-$ - $? gift:able:ames - gift:able:behn - gift:able:clay - gift:able:dill - gift:able:eyre - gift:able:ford - gift:able:gall - == -++ task-arvo :: in request ->$ - $? task:able:ames - task:able:clay - task:able:behn - task:able:dill - task:able:eyre - task:able:ford - task:able:gall - == -++ note-arvo :: out request $-> - $? {@tas $meta vase} - $% {$a task:able:ames} - {$b task:able:behn} - {$c task:able:clay} - {$d task:able:dill} - {$e task:able:eyre} - {$f task:able:ford} - {$g task:able:gall} - == == -++ sign-arvo :: in result $<- - $% {$a gift:able:ames} - {$b gift:able:behn} - {$c gift:able:clay} - {$d gift:able:dill} - {$e gift:able:eyre} - {$f gift:able:ford} - {$g gift:able:gall} - {$j gift:able:jael} - == -:: -++ unix-task :: input from unix - $% {$belt p/belt:dill} :: dill: keyboard - {$blew p/blew:dill} :: dill: configure - {$boat $~} :: clay: reboot - {$born $~} :: eyre: new process - {$hail $~} :: dill: refresh - {$hear p/lane:ames q/@} :: ames: input packet - {$hook $~} :: dill: hangup - {$into p/desk q/? r/mode:clay} :: clay: external edit - {$they p/@ud q/httr:eyre} :: eyre: in response - {$this p/? q/clip:eyre r/httq:eyre} :: eyre: in request - {$thud $~} :: eyre: in cancel - {$wake $~} :: behn: wakeup - == --- ::