@@ -1,14050 +0,0 @@
1−::
2−:::: /sys/hoon ::
3− :: ::
4−=< ride
5−=> %139 =>
6−:: ::
7−:::: 0: version stub ::
8− :: ::
9−~% %k.139 ~ ~ ::
10−|%
11−++ hoon-version +
12−-- =>
13−~% %one + ~
14−:: layer-1
15−::
16−:: basic mathematical operations
17−|%
18−:: unsigned arithmetic
19−+| %math
20−++ add
21− ~/ %add
22− :: unsigned addition
23− ::
24− :: a: augend
25− :: b: addend
26− |= [a=@ b=@]
27− :: sum
28− ^- @
29− ?: =(0 a) b
30− $(a (dec a), b +(b))
31−::
32−++ dec
33− ~/ %dec
34− :: unsigned decrement by one.
35− |= a=@
36− ~_ leaf+"decrement-underflow"
37− ?< =(0 a)
38− =+ b=0
39− :: decremented integer
40− |- ^- @
41− ?: =(a +(b)) b
42− $(b +(b))
43−::
44−++ div
45− ~/ %div
46− :: unsigned divide
47− ::
48− :: a: dividend
49− :: b: divisor
50− |: [a=`@`1 b=`@`1]
51− :: quotient
52− ^- @
53− -:(dvr a b)
54−::
55−++ dvr
56− ~/ %dvr
57− :: unsigned divide with remainder
58− ::
59− :: a: dividend
60− :: b: divisor
61− |: [a=`@`1 b=`@`1]
62− :: p: quotient
63− :: q: remainder
64− ^- [p=@ q=@]
65− ~_ leaf+"divide-by-zero"
66− ?< =(0 b)
67− =+ c=0
68− |-
69− ?: (lth a b) [c a]
70− $(a (sub a b), c +(c))
71−::
72−++ gte
73− ~/ %gte
74− :: unsigned greater than or equals
75− ::
76− :: returns whether {a >= b}.
77− ::
78− :: a: left hand operand (todo: name)
79− :: b: right hand operand
80− |= [a=@ b=@]
81− :: greater than or equal to?
82− ^- ?
83− !(lth a b)
84−::
85−++ gth
86− ~/ %gth
87− :: unsigned greater than
88− ::
89− :: returns whether {a > b}
90− ::
91− :: a: left hand operand (todo: name)
92− :: b: right hand operand
93− |= [a=@ b=@]
94− :: greater than?
95− ^- ?
96− !(lte a b)
97−::
98−++ lte
99− ~/ %lte
100− :: unsigned less than or equals
101− ::
102− :: returns whether {a >= b}.
103− ::
104− :: a: left hand operand (todo: name)
105− :: b: right hand operand
106− |= [a=@ b=@]
107− :: less than or equal to?
108− |(=(a b) (lth a b))
109−::
110−++ lth
111− ~/ %lth
112− :: unsigned less than
113− ::
114− :: a: left hand operand (todo: name)
115− :: b: right hand operand
116− |= [a=@ b=@]
117− :: less than?
118− ^- ?
119− ?& !=(a b)
120− |-
121− ?| =(0 a)
122− ?& !=(0 b)
123− $(a (dec a), b (dec b))
124− == == ==
125−::
126−++ max
127− ~/ %max
128− :: unsigned maximum
129− |= [a=@ b=@]
130− :: the maximum
131− ^- @
132− ?: (gth a b) a
133− b
134−::
135−++ min
136− ~/ %min
137− :: unsigned minimum
138− |= [a=@ b=@]
139− :: the minimum
140− ^- @
141− ?: (lth a b) a
142− b
143−::
144−++ mod
145− ~/ %mod
146− :: unsigned modulus
147− ::
148− :: a: dividend
149− :: b: divisor
150− |: [a=`@`1 b=`@`1]
151− :: the remainder
152− ^- @
153− +:(dvr a b)
154−::
155−++ mul
156− ~/ %mul
157− :: unsigned multiplication
158− ::
159− :: a: multiplicand
160− :: b: multiplier
161− |: [a=`@`1 b=`@`1]
162− :: product
163− ^- @
164− =+ c=0
165− |-
166− ?: =(0 a) c
167− $(a (dec a), c (add b c))
168−::
169−++ sub
170− ~/ %sub
171− :: unsigned subtraction
172− ::
173− :: a: minuend
174− :: b: subtrahend
175− |= [a=@ b=@]
176− ~_ leaf+"subtract-underflow"
177− :: difference
178− ^- @
179− ?: =(0 b) a
180− $(a (dec a), b (dec b))
181−::
182−:: tree addressing
183−+| %tree
184−++ cap
185− ~/ %cap
186− :: tree head
187− ::
188− :: tests whether an `a` is in the head or tail of a noun. produces %2 if it
189− :: is within the head, or %3 if it is within the tail.
190− |= a=@
191− ^- ?(%2 %3)
192− ?- a
193− %2 %2
194− %3 %3
195− ?(%0 %1) !!
196− * $(a (div a 2))
197− ==
198−::
199−++ mas
200− ~/ %mas
201− :: axis within head/tail
202− ::
203− :: computes the axis of `a` within either the head or tail of a noun
204− :: (depends whether `a` lies within the the head or tail).
205− |= a=@
206− ^- @
207− ?- a
208− ?(%2 %3) 1
209− ?(%0 %1) !!
210− * (add (mod a 2) (mul $(a (div a 2)) 2))
211− ==
212−::
213−++ peg
214− ~/ %peg
215− :: axis within axis
216− ::
217− :: computes the axis of {b} within axis {a}.
218− |= [a=@ b=@]
219− ?< =(0 a)
220− :: a composed axis
221− ^- @
222− ?- b
223− %1 a
224− %2 (mul a 2)
225− %3 +((mul a 2))
226− * (add (mod b 2) (mul $(b (div b 2)) 2))
227− ==
228−::
229−:: # %containers
230−::
231−:: the most basic of data types
232−+| %containers
233−::
234−+$ bite
235− :: atom slice specifier
236− ::
237− $@(bloq [=bloq =step])
238−::
239−+$ bloq
240− :: blocksize
241− ::
242− :: a blocksize is the power of 2 size of an atom. ie, 3 is a byte as 2^3 is
243− :: 8 bits.
244− @
245−::
246−++ each
247− |$ [this that]
248− :: either {a} or {b}, defaulting to {a}.
249− ::
250− :: mold generator: produces a discriminated fork between two types,
251− :: defaulting to {a}.
252− ::
253− $% [%| p=that]
254− [%& p=this]
255− ==
256−::
257−+$ gate
258− :: function
259− ::
260− :: a core with one arm, `$`--the empty name--which transforms a sample noun
261− :: into a product noun. If used dryly as a type, the subject must have a
262− :: sample type of `*`.
263− $-(* *)
264−::
265−++ list
266− |$ [item]
267− :: null-terminated list
268− ::
269− :: mold generator: produces a mold of a null-terminated list of the
270− :: homogeneous type {a}.
271− ::
272− $@(~ [i=item t=(list item)])
273−::
274−++ lone
275− |$ [item]
276− :: single item tuple
277− ::
278− :: mold generator: puts the face of `p` on the passed in mold.
279− ::
280− p=item
281−::
282−++ lest
283− |$ [item]
284− :: null-terminated non-empty list
285− ::
286− :: mold generator: produces a mold of a null-terminated list of the
287− :: homogeneous type {a} with at least one element.
288− [i=item t=(list item)]
289−::
290−+$ mold
291− :: normalizing gate
292− ::
293− :: a gate that accepts any noun, and validates its shape, producing the
294− :: input if it fits or a default value if it doesn't.
295− ::
296− :: examples: * @ud ,[p=time q=?(%a %b)]
297− $~(* $-(* *))
298−::
299−++ pair
300− |$ [head tail]
301− :: dual tuple
302− ::
303− :: mold generator: produces a tuple of the two types passed in.
304− ::
305− :: a: first type, labeled {p}
306− :: b: second type, labeled {q}
307− ::
308− [p=head q=tail]
309−::
310−++ pole
311− |$ [item]
312− :: faceless list
313− ::
314− :: like ++list, but without the faces {i} and {t}.
315− ::
316− $@(~ [item (pole item)])
317−::
318−++ qual
319− |$ [first second third fourth]
320− :: quadruple tuple
321− ::
322− :: mold generator: produces a tuple of the four types passed in.
323− ::
324− [p=first q=second r=third s=fourth]
325−::
326−++ quip
327− |$ [item state]
328− :: pair of list of first and second
329− ::
330− :: a common pattern in hoon code is to return a ++list of changes, along with
331− :: a new state.
332− ::
333− :: a: type of list item
334− :: b: type of returned state
335− ::
336− [(list item) state]
337−::
338−++ step
339− :: atom size or offset, in bloqs
340− ::
341− _`@u`1
342−::
343−++ trap
344− |$ [product]
345− :: a core with one arm `$`
346− ::
347− _|?($:product)
348−::
349−++ tree
350− |$ [node]
351− :: tree mold generator
352− ::
353− :: a `++tree` can be empty, or contain a node of a type and
354− :: left/right sub `++tree` of the same type. pretty-printed with `{}`.
355− ::
356− $@(~ [n=node l=(tree node) r=(tree node)])
357−::
358−++ trel
359− |$ [first second third]
360− :: triple tuple
361− ::
362− :: mold generator: produces a tuple of the three types passed in.
363− ::
364− [p=first q=second r=third]
365−::
366−++ unit
367− |$ [item]
368− :: maybe
369− ::
370− :: mold generator: either `~` or `[~ u=a]` where `a` is the
371− :: type that was passed in.
372− ::
373− $@(~ [~ u=item])
374−-- =>
375−::
376−~% %two + ~
377−:: layer-2
378−::
379−|%
380−:: 2a: unit logic
381−+| %unit-logc
382−::
383−++ biff :: apply
384− |* [a=(unit) b=$-(* (unit))]
385− ?~ a ~
386− (b u.a)
387−::
388−++ bind :: argue
389− |* [a=(unit) b=gate]
390− ?~ a ~
391− [~ u=(b u.a)]
392−::
393−++ bond :: replace
394− |* a=(trap)
395− |* b=(unit)
396− ?~ b $:a
397− u.b
398−::
399−++ both :: all the above
400− |* [a=(unit) b=(unit)]
401− ?~ a ~
402− ?~ b ~
403− [~ u=[u.a u.b]]
404−::
405−++ clap :: combine
406− |* [a=(unit) b=(unit) c=_=>(~ |=(^ +<-))]
407− ?~ a b
408− ?~ b a
409− [~ u=(c u.a u.b)]
410−::
411−++ clef :: compose
412− |* [a=(unit) b=(unit) c=_=>(~ |=(^ `+<-))]
413− ?~ a ~
414− ?~ b ~
415− (c u.a u.b)
416−::
417−++ drop :: enlist
418− |* a=(unit)
419− ?~ a ~
420− [i=u.a t=~]
421−::
422−++ fall :: default
423− |* [a=(unit) b=*]
424− ?~(a b u.a)
425−::
426−++ flit :: make filter
427− |* a=$-(* ?)
428− |* b=*
429− ?.((a b) ~ [~ u=b])
430−::
431−++ hunt :: first of units
432− |* [ord=$-(^ ?) a=(unit) b=(unit)]
433− ^- %- unit
434− $? _?>(?=(^ a) u.a)
435− _?>(?=(^ b) u.b)
436− ==
437− ?~ a b
438− ?~ b a
439− ?:((ord u.a u.b) a b)
440−::
441−++ lift :: lift mold (fmap)
442− |* a=mold :: flipped
443− |* b=(unit) :: curried
444− (bind b a) :: bind
445−::
446−++ mate :: choose
447− |* [a=(unit) b=(unit)]
448− ?~ b a
449− ?~ a b
450− ?.(=(u.a u.b) ~>(%mean.'mate' !!) a)
451−::
452−++ need :: demand
453− ~/ %need
454− |* a=(unit)
455− ?~ a ~>(%mean.'need' !!)
456− u.a
457−::
458−++ some :: lift (pure)
459− |* a=*
460− [~ u=a]
461−::
462−:: 2b: list logic
463−+| %list-logic
464−:: +snoc: append an element to the end of a list
465−::
466−++ snoc
467− |* [a=(list) b=*]
468− (weld a ^+(a [b]~))
469−::
470−:: +lure: List pURE
471−++ lure
472− |* a=*
473− [i=a t=~]
474−::
475−++ fand :: all indices
476− ~/ %fand
477− |= [nedl=(list) hstk=(list)]
478− =| i=@ud
479− =| fnd=(list @ud)
480− |- ^+ fnd
481− =+ [n=nedl h=hstk]
482− |-
483− ?: |(?=(~ n) ?=(~ h))
484− (flop fnd)
485− ?: =(i.n i.h)
486− ?~ t.n
487− ^$(i +(i), hstk +.hstk, fnd [i fnd])
488− $(n t.n, h t.h)
489− ^$(i +(i), hstk +.hstk)
490−::
491−++ find :: first index
492− ~/ %find
493− |= [nedl=(list) hstk=(list)]
494− =| i=@ud
495− |- ^- (unit @ud)
496− =+ [n=nedl h=hstk]
497− |-
498− ?: |(?=(~ n) ?=(~ h))
499− ~
500− ?: =(i.n i.h)
501− ?~ t.n
502− `i
503− $(n t.n, h t.h)
504− ^$(i +(i), hstk +.hstk)
505−::
506−++ flop :: reverse
507− ~/ %flop
508− |* a=(list)
509− => .(a (homo a))
510− ^+ a
511− =+ b=`_a`~
512− |-
513− ?~ a b
514− $(a t.a, b [i.a b])
515−::
516−++ gulf :: range inclusive
517− |= [a=@ b=@]
518− ?> (lte a b)
519− |- ^- (list @)
520− ?:(=(a +(b)) ~ [a $(a +(a))])
521−::
522−++ homo :: homogenize
523− |* a=(list)
524− ^+ =< $
525− |@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$])
526− --
527− a
528−:: +join: construct a new list, placing .sep between every pair in .lit
529−::
530−++ join
531− |* [sep=* lit=(list)]
532− =. sep `_?>(?=(^ lit) i.lit)`sep
533− ?~ lit ~
534− =| out=(list _?>(?=(^ lit) i.lit))
535− |- ^+ out
536− ?~ t.lit
537− (flop [i.lit out])
538− $(out [sep i.lit out], lit t.lit)
539−::
540−:: +bake: convert wet gate to dry gate by specifying argument mold
541−::
542−++ bake
543− |* [f=gate a=mold]
544− |= arg=a
545− (f arg)
546−::
547−++ lent :: length
548− ~/ %lent
549− |= a=(list)
550− ^- @
551− =+ b=0
552− |-
553− ?~ a b
554− $(a t.a, b +(b))
555−::
556−++ levy
557− ~/ %levy :: all of
558− |* [a=(list) b=$-(* ?)]
559− |- ^- ?
560− ?~ a &
561− ?. (b i.a) |
562− $(a t.a)
563−::
564−++ lien :: some of
565− ~/ %lien
566− |* [a=(list) b=$-(* ?)]
567− |- ^- ?
568− ?~ a |
569− ?: (b i.a) &
570− $(a t.a)
571−::
572−++ limo :: listify
573− |* a=*
574− ^+ =< $
575− |@ ++ $ ?~(a ~ ?:(*? [i=-.a t=$] $(a +.a)))
576− --
577− a
578−::
579−++ murn :: maybe transform
580− ~/ %murn
581− |* [a=(list) b=$-(* (unit))]
582− => .(a (homo a))
583− |- ^- (list _?>(?=(^ a) (need (b i.a))))
584− ?~ a ~
585− =/ c (b i.a)
586− ?~ c $(a t.a)
587− [+.c $(a t.a)]
588−::
589−++ oust :: remove
590− ~/ %oust
591− |* [[a=@ b=@] c=(list)]
592− (weld (scag +<-< c) (slag (add +<-< +<->) c))
593−::
594−++ reap :: replicate
595− ~/ %reap
596− |* [a=@ b=*]
597− |- ^- (list _b)
598− ?~ a ~
599− [b $(a (dec a))]
600−::
601−++ rear :: last item of list
602− ~/ %rear
603− |* a=(list)
604− ^- _?>(?=(^ a) i.a)
605− ?> ?=(^ a)
606− ?: =(~ t.a) i.a ::NOTE avoiding tmi
607− $(a t.a)
608−::
609−++ reel :: right fold
610− ~/ %reel
611− |* [a=(list) b=_=>(~ |=([* *] +<+))]
612− |- ^+ ,.+<+.b
613− ?~ a
614− +<+.b
615− (b i.a $(a t.a))
616−::
617−++ roll :: left fold
618− ~/ %roll
619− |* [a=(list) b=_=>(~ |=([* *] +<+))]
620− |- ^+ ,.+<+.b
621− ?~ a
622− +<+.b
623− $(a t.a, b b(+<+ (b i.a +<+.b)))
624−::
625−++ scag :: prefix
626− ~/ %scag
627− |* [a=@ b=(list)]
628− |- ^+ b
629− ?: |(?=(~ b) =(0 a)) ~
630− [i.b $(b t.b, a (dec a))]
631−::
632−++ skid :: separate
633− ~/ %skid
634− |* [a=(list) b=$-(* ?)]
635− |- ^+ [p=a q=a]
636− ?~ a [~ ~]
637− =+ c=$(a t.a)
638− ?:((b i.a) [[i.a p.c] q.c] [p.c [i.a q.c]])
639−::
640−++ skim :: only
641− ~/ %skim
642− |* [a=(list) b=$-(* ?)]
643− |-
644− ^+ a
645− ?~ a ~
646− ?:((b i.a) [i.a $(a t.a)] $(a t.a))
647−::
648−++ skip :: except
649− ~/ %skip
650− |* [a=(list) b=$-(* ?)]
651− |-
652− ^+ a
653− ?~ a ~
654− ?:((b i.a) $(a t.a) [i.a $(a t.a)])
655−::
656−++ slag :: suffix
657− ~/ %slag
658− |* [a=@ b=(list)]
659− |- ^+ b
660− ?: =(0 a) b
661− ?~ b ~
662− $(b t.b, a (dec a))
663−::
664−++ snag :: index
665− ~/ %snag
666− |* [a=@ b=(list)]
667− |- ^+ ?>(?=(^ b) i.b)
668− ?~ b
669− ~_ leaf+"snag-fail"
670− !!
671− ?: =(0 a) i.b
672− $(b t.b, a (dec a))
673−::
674−++ snip :: drop tail off list
675− ~/ %snip
676− |* a=(list)
677− ^+ a
678− ?~ a ~
679− ?: =(~ t.a) ~
680− [i.a $(a t.a)]
681−::
682−++ sort !. :: quicksort
683− ~/ %sort
684− |* [a=(list) b=$-([* *] ?)]
685− => .(a ^.(homo a))
686− |- ^+ a
687− ?~ a ~
688− =+ s=(skid t.a |:(c=i.a (b c i.a)))
689− %+ weld
690− $(a p.s)
691− ^+ t.a
692− [i.a $(a q.s)]
693−::
694−++ spin :: stateful turn
695− ::
696− :: a: list
697− :: b: state
698− :: c: gate from list-item and state to product and new state
699− ~/ %spin
700− |* [a=(list) b=* c=_|=(^ [** +<+])]
701− => .(c `$-([_?>(?=(^ a) i.a) _b] [_-:(c) _b])`c)
702− =/ acc=(list _-:(c)) ~
703− :: transformed list and updated state
704− |- ^- (pair _acc _b)
705− ?~ a
706− [(flop acc) b]
707− =^ res b (c i.a b)
708− $(acc [res acc], a t.a)
709−::
710−++ spun :: internal spin
711− ::
712− :: a: list
713− :: b: gate from list-item and state to product and new state
714− ~/ %spun
715− |* [a=(list) b=_|=(^ [** +<+])]
716− :: transformed list
717− p:(spin a +<+.b b)
718−::
719−++ swag :: slice
720− |* [[a=@ b=@] c=(list)]
721− (scag +<-> (slag +<-< c))
722−:: +turn: transform each value of list :a using the function :b
723−::
724−++ turn
725− ~/ %turn
726− |* [a=(list) b=gate]
727− => .(a (homo a))
728− ^- (list _?>(?=(^ a) (b i.a)))
729− |-
730− ?~ a ~
731− [i=(b i.a) t=$(a t.a)]
732−::
733−++ weld :: concatenate
734− ~/ %weld
735− |* [a=(list) b=(list)]
736− => .(a ^.(homo a), b ^.(homo b))
737− |- ^+ b
738− ?~ a b
739− [i.a $(a t.a)]
740−::
741−++ snap :: replace item
742− ~/ %snap
743− |* [a=(list) b=@ c=*]
744− ^+ a
745− (weld (scag b a) [c (slag +(b) a)])
746−::
747−++ into :: insert item
748− ~/ %into
749− |* [a=(list) b=@ c=*]
750− ^+ a
751− (weld (scag b a) [c (slag b a)])
752−::
753−++ welp :: faceless weld
754− ~/ %welp
755− |* [* *]
756− ?~ +<-
757− +<-(. +<+)
758− +<-(+ $(+<- +<->))
759−::
760−++ zing :: promote
761− ~/ %zing
762− |* *
763− ?~ +<
764− +<
765− (welp +<- $(+< +<+))
766−::
767−:: 2c: bit arithmetic
768−+| %bit-arithmetic
769−::
770−++ bex :: binary exponent
771− ~/ %bex
772− |= a=bloq
773− ^- @
774− ?: =(0 a) 1
775− (mul 2 $(a (dec a)))
776−::
777−++ can :: assemble
778− ~/ %can
779− |= [a=bloq b=(list [p=step q=@])]
780− ^- @
781− ?~ b 0
782− (add (end [a p.i.b] q.i.b) (lsh [a p.i.b] $(b t.b)))
783−::
784−++ cat :: concatenate
785− ~/ %cat
786− |= [a=bloq b=@ c=@]
787− (add (lsh [a (met a b)] c) b)
788−::
789−++ cut :: slice
790− ~/ %cut
791− |= [a=bloq [b=step c=step] d=@]
792− (end [a c] (rsh [a b] d))
793−::
794−++ end :: tail
795− ~/ %end
796− |= [a=bite b=@]
797− =/ [=bloq =step] ?^(a a [a *step])
798− (mod b (bex (mul (bex bloq) step)))
799−::
800−++ fil :: fill bloqstream
801− ~/ %fil
802− |= [a=bloq b=step c=@]
803− =| n=@ud
804− =. c (end a c)
805− =/ d c
806− |- ^- @
807− ?: =(n b)
808− (rsh a d)
809− $(d (add c (lsh a d)), n +(n))
810−::
811−++ lsh :: left-shift
812− ~/ %lsh
813− |= [a=bite b=@]
814− =/ [=bloq =step] ?^(a a [a *step])
815− (mul b (bex (mul (bex bloq) step)))
816−::
817−++ met :: measure
818− ~/ %met
819− |= [a=bloq b=@]
820− ^- @
821− =+ c=0
822− |-
823− ?: =(0 b) c
824− $(b (rsh a b), c +(c))
825−::
826−++ rap :: assemble variable
827− ~/ %rap
828− |= [a=bloq b=(list @)]
829− ^- @
830− ?~ b 0
831− (cat a i.b $(b t.b))
832−::
833−++ rep :: assemble fixed
834− ~/ %rep
835− |= [a=bite b=(list @)]
836− =/ [=bloq =step] ?^(a a [a *step])
837− =| i=@ud
838− |- ^- @
839− ?~ b 0
840− %+ add $(i +(i), b t.b)
841− (lsh [bloq (mul step i)] (end [bloq step] i.b))
842−::
843−++ rev
844− :: reverses block order, accounting for leading zeroes
845− ::
846− :: boz: block size
847− :: len: size of dat, in boz
848− :: dat: data to flip
849− ~/ %rev
850− |= [boz=bloq len=@ud dat=@]
851− ^- @
852− =. dat (end [boz len] dat)
853− %+ lsh
854− [boz (sub len (met boz dat))]
855− (swp boz dat)
856−::
857−++ rip :: disassemble
858− ~/ %rip
859− |= [a=bite b=@]
860− ^- (list @)
861− ?: =(0 b) ~
862− [(end a b) $(b (rsh a b))]
863−::
864−++ rsh :: right-shift
865− ~/ %rsh
866− |= [a=bite b=@]
867− =/ [=bloq =step] ?^(a a [a *step])
868− (div b (bex (mul (bex bloq) step)))
869−::
870−++ run :: +turn into atom
871− ~/ %run
872− |= [a=bite b=@ c=$-(@ @)]
873− (rep a (turn (rip a b) c))
874−::
875−++ rut :: +turn into list
876− ~/ %rut
877− |* [a=bite b=@ c=$-(@ *)]
878− (turn (rip a b) c)
879−::
880−++ sew :: stitch into
881− ~/ %sew
882− |= [a=bloq [b=step c=step d=@] e=@]
883− ^- @
884− %+ add
885− (can a b^e c^d ~)
886− =/ f [a (add b c)]
887− (lsh f (rsh f e))
888−::
889−++ swp :: naive rev bloq order
890− ~/ %swp
891− |= [a=bloq b=@]
892− (rep a (flop (rip a b)))
893−::
894−++ xeb :: binary logarithm
895− ~/ %xeb
896− |= a=@
897− ^- @
898− (met 0 a)
899−::
900−++ fe :: modulo bloq
901− |_ a=bloq
902− ++ dif :: difference
903− |=([b=@ c=@] (sit (sub (add out (sit b)) (sit c))))
904− ++ inv |=(b=@ (sub (dec out) (sit b))) :: inverse
905− ++ net |= b=@ ^- @ :: flip byte endianness
906− => .(b (sit b))
907− ?: (lte a 3)
908− b
909− =+ c=(dec a)
910− %+ con
911− (lsh c $(a c, b (cut c [0 1] b)))
912− $(a c, b (cut c [1 1] b))
913− ++ out (bex (bex a)) :: mod value
914− ++ rol |= [b=bloq c=@ d=@] ^- @ :: roll left
915− =+ e=(sit d)
916− =+ f=(bex (sub a b))
917− =+ g=(mod c f)
918− (sit (con (lsh [b g] e) (rsh [b (sub f g)] e)))
919− ++ ror |= [b=bloq c=@ d=@] ^- @ :: roll right
920− =+ e=(sit d)
921− =+ f=(bex (sub a b))
922− =+ g=(mod c f)
923− (sit (con (rsh [b g] e) (lsh [b (sub f g)] e)))
924− ++ sum |=([b=@ c=@] (sit (add b c))) :: wrapping add
925− ++ sit |=(b=@ (end a b)) :: enforce modulo
926− --
927−::
928−:: 2d: bit logic
929−+| %bit-logic
930−::
931−++ con :: binary or
932− ~/ %con
933− |= [a=@ b=@]
934− =+ [c=0 d=0]
935− |- ^- @
936− ?: ?&(=(0 a) =(0 b)) d
937− %= $
938− a (rsh 0 a)
939− b (rsh 0 b)
940− c +(c)
941− d %+ add d
942− %+ lsh [0 c]
943− ?& =(0 (end 0 a))
944− =(0 (end 0 b))
945− ==
946− ==
947−::
948−++ dis :: binary and
949− ~/ %dis
950− |= [a=@ b=@]
951− =| [c=@ d=@]
952− |- ^- @
953− ?: ?|(=(0 a) =(0 b)) d
954− %= $
955− a (rsh 0 a)
956− b (rsh 0 b)
957− c +(c)
958− d %+ add d
959− %+ lsh [0 c]
960− ?| =(0 (end 0 a))
961− =(0 (end 0 b))
962− ==
963− ==
964−::
965−++ mix :: binary xor
966− ~/ %mix
967− |= [a=@ b=@]
968− ^- @
969− =+ [c=0 d=0]
970− |-
971− ?: ?&(=(0 a) =(0 b)) d
972− %= $
973− a (rsh 0 a)
974− b (rsh 0 b)
975− c +(c)
976− d (add d (lsh [0 c] =((end 0 a) (end 0 b))))
977− ==
978−::
979−++ not |= [a=bloq b=@ c=@] :: binary not (sized)
980− (mix c (dec (bex (mul b (bex a)))))
981−::
982−:: 2e: insecure hashing
983−+| %insecure-hashing
984−::
985−++ muk :: standard murmur3
986− ~% %muk ..muk ~
987− =+ ~(. fe 5)
988− |= [syd=@ len=@ key=@]
989− =. syd (end 5 syd)
990− =/ pad (sub len (met 3 key))
991− =/ data (weld (rip 3 key) (reap pad 0))
992− =/ nblocks (div len 4) :: intentionally off-by-one
993− =/ h1 syd
994− =+ [c1=0xcc9e.2d51 c2=0x1b87.3593]
995− =/ blocks (rip 5 key)
996− =/ i nblocks
997− =. h1 =/ hi h1 |-
998− ?: =(0 i) hi
999− =/ k1 (snag (sub nblocks i) blocks) :: negative array index
1000− =. k1 (sit (mul k1 c1))
1001− =. k1 (rol 0 15 k1)
1002− =. k1 (sit (mul k1 c2))
1003− =. hi (mix hi k1)
1004− =. hi (rol 0 13 hi)
1005− =. hi (sum (sit (mul hi 5)) 0xe654.6b64)
1006− $(i (dec i))
1007− =/ tail (slag (mul 4 nblocks) data)
1008− =/ k1 0
1009− =/ tlen (dis len 3)
1010− =. h1
1011− ?+ tlen h1 :: fallthrough switch
1012− %3 =. k1 (mix k1 (lsh [0 16] (snag 2 tail)))
1013− =. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
1014− =. k1 (mix k1 (snag 0 tail))
1015− =. k1 (sit (mul k1 c1))
1016− =. k1 (rol 0 15 k1)
1017− =. k1 (sit (mul k1 c2))
1018− (mix h1 k1)
1019− %2 =. k1 (mix k1 (lsh [0 8] (snag 1 tail)))
1020− =. k1 (mix k1 (snag 0 tail))
1021− =. k1 (sit (mul k1 c1))
1022− =. k1 (rol 0 15 k1)
1023− =. k1 (sit (mul k1 c2))
1024− (mix h1 k1)
1025− %1 =. k1 (mix k1 (snag 0 tail))
1026− =. k1 (sit (mul k1 c1))
1027− =. k1 (rol 0 15 k1)
1028− =. k1 (sit (mul k1 c2))
1029− (mix h1 k1)
1030− ==
1031− =. h1 (mix h1 len)
1032− |^ (fmix32 h1)
1033− ++ fmix32
1034− |= h=@
1035− =. h (mix h (rsh [0 16] h))
1036− =. h (sit (mul h 0x85eb.ca6b))
1037− =. h (mix h (rsh [0 13] h))
1038− =. h (sit (mul h 0xc2b2.ae35))
1039− =. h (mix h (rsh [0 16] h))
1040− h
1041− --
1042−::
1043−++ mug :: mug with murmur3
1044− ~/ %mug
1045− |= a=*
1046− |^ ?@ a (mum 0xcafe.babe 0x7fff a)
1047− =/ b (cat 5 $(a -.a) $(a +.a))
1048− (mum 0xdead.beef 0xfffe b)
1049− ::
1050− ++ mum
1051− |= [syd=@uxF fal=@F key=@]
1052− =/ wyd (met 3 key)
1053− =| i=@ud
1054− |- ^- @F
1055− ?: =(8 i) fal
1056− =/ haz=@F (muk syd wyd key)
1057− =/ ham=@F (mix (rsh [0 31] haz) (end [0 31] haz))
1058− ?.(=(0 ham) ham $(i +(i), syd +(syd)))
1059− --
1060−:: ::
1061−:: 2f: noun ordering
1062−+| %noun-ordering
1063−::
1064−:: +aor: alphabetical order
1065−::
1066−:: Orders atoms before cells, and atoms in ascending LSB order.
1067−::
1068−++ aor
1069− ~/ %aor
1070− |= [a=* b=*]
1071− ^- ?
1072− ?: =(a b) &
1073− ?. ?=(@ a)
1074− ?: ?=(@ b) |
1075− ?: =(-.a -.b)
1076− $(a +.a, b +.b)
1077− $(a -.a, b -.b)
1078− ?. ?=(@ b) &
1079− |-
1080− =+ [c=(end 3 a) d=(end 3 b)]
1081− ?: =(c d)
1082− $(a (rsh 3 a), b (rsh 3 b))
1083− (lth c d)
1084−:: +dor: depth order
1085−::
1086−:: Orders in ascending tree depth.
1087−::
1088−++ dor
1089− ~/ %dor
1090− |= [a=* b=*]
1091− ^- ?
1092− ?: =(a b) &
1093− ?. ?=(@ a)
1094− ?: ?=(@ b) |
1095− ?: =(-.a -.b)
1096− $(a +.a, b +.b)
1097− $(a -.a, b -.b)
1098− ?. ?=(@ b) &
1099− (lth a b)
1100−:: +gor: mug order
1101−::
1102−:: Orders in ascending +mug hash order, collisions fall back to +dor.
1103−::
1104−++ gor
1105− ~/ %gor
1106− |= [a=* b=*]
1107− ^- ?
1108− =+ [c=(mug a) d=(mug b)]
1109− ?: =(c d)
1110− (dor a b)
1111− (lth c d)
1112−:: +mor: (more) mug order
1113−::
1114−:: Orders in ascending double +mug hash order, collisions fall back to +dor.
1115−::
1116−++ mor
1117− ~/ %mor
1118− |= [a=* b=*]
1119− ^- ?
1120− =+ [c=(mug (mug a)) d=(mug (mug b))]
1121− ?: =(c d)
1122− (dor a b)
1123− (lth c d)
1124−::
1125−:: 2g: unsigned powers
1126−+| %unsigned-powers
1127−::
1128−++ pow :: unsigned exponent
1129− ~/ %pow
1130− |= [a=@ b=@]
1131− ?: =(b 0) 1
1132− |- ?: =(b 1) a
1133− =+ c=$(b (div b 2))
1134− =+ d=(mul c c)
1135− ?~ (dis b 1) d (mul d a)
1136−::
1137−++ sqt :: unsigned sqrt/rem
1138− ~/ %sqt
1139− |= a=@ ^- [p=@ q=@]
1140− ?~ a [0 0]
1141− =+ [q=(div (dec (xeb a)) 2) r=0]
1142− =- [-.b (sub a +.b)]
1143− ^= b |-
1144− =+ s=(add r (bex q))
1145− =+ t=(mul s s)
1146− ?: =(q 0)
1147− ?:((lte t a) [s t] [r (mul r r)])
1148− ?: (lte t a)
1149− $(r s, q (dec q))
1150− $(q (dec q))
1151−::
1152−:: 2h: set logic
1153−+| %set-logic
1154−::
1155−++ in :: set engine
1156− ~/ %in
1157− =| a=(tree) :: (set)
1158− |@
1159− ++ all :: logical AND
1160− ~/ %all
1161− |* b=$-(* ?)
1162− |- ^- ?
1163− ?~ a
1164− &
1165− ?&((b n.a) $(a l.a) $(a r.a))
1166− ::
1167− ++ any :: logical OR
1168− ~/ %any
1169− |* b=$-(* ?)
1170− |- ^- ?
1171− ?~ a
1172− |
1173− ?|((b n.a) $(a l.a) $(a r.a))
1174− ::
1175− ++ apt :: check correctness
1176− =< $
1177− ~/ %apt
1178− =| [l=(unit) r=(unit)]
1179− |. ^- ?
1180− ?~ a &
1181− ?& ?~(l & &((gor n.a u.l) !=(n.a u.l)))
1182− ?~(r & &((gor u.r n.a) !=(u.r n.a)))
1183− ?~(l.a & ?&((mor n.a n.l.a) !=(n.a n.l.a) $(a l.a, l `n.a)))
1184− ?~(r.a & ?&((mor n.a n.r.a) !=(n.a n.r.a) $(a r.a, r `n.a)))
1185− ==
1186− ::
1187− ++ bif :: splits a by b
1188− ~/ %bif
1189− |* b=*
1190− ^+ [l=a r=a]
1191− =< +
1192− |- ^+ a
1193− ?~ a
1194− [b ~ ~]
1195− ?: =(b n.a)
1196− a
1197− ?: (gor b n.a)
1198− =+ c=$(a l.a)
1199− ?> ?=(^ c)
1200− c(r a(l r.c))
1201− =+ c=$(a r.a)
1202− ?> ?=(^ c)
1203− c(l a(r l.c))
1204− ::
1205− ++ del :: b without any a
1206− ~/ %del
1207− |* b=*
1208− |- ^+ a
1209− ?~ a
1210− ~
1211− ?. =(b n.a)
1212− ?: (gor b n.a)
1213− a(l $(a l.a))
1214− a(r $(a r.a))
1215− |- ^- [$?(~ _a)]
1216− ?~ l.a r.a
1217− ?~ r.a l.a
1218− ?: (mor n.l.a n.r.a)
1219− l.a(r $(l.a r.l.a))
1220− r.a(l $(r.a l.r.a))
1221− ::
1222− ++ dif :: difference
1223− ~/ %dif
1224− |* b=_a
1225− |- ^+ a
1226− ?~ b
1227− a
1228− =+ c=(bif n.b)
1229− ?> ?=(^ c)
1230− =+ d=$(a l.c, b l.b)
1231− =+ e=$(a r.c, b r.b)
1232− |- ^- [$?(~ _a)]
1233− ?~ d e
1234− ?~ e d
1235− ?: (mor n.d n.e)
1236− d(r $(d r.d))
1237− e(l $(e l.e))
1238− ::
1239− ++ dig :: axis of a in b
1240− |= b=*
1241− =+ c=1
1242− |- ^- (unit @)
1243− ?~ a ~
1244− ?: =(b n.a) [~ u=(peg c 2)]
1245− ?: (gor b n.a)
1246− $(a l.a, c (peg c 6))
1247− $(a r.a, c (peg c 7))
1248− ::
1249− ++ gas :: concatenate
1250− ~/ %gas
1251− |= b=(list _?>(?=(^ a) n.a))
1252− |- ^+ a
1253− ?~ b
1254− a
1255− $(b t.b, a (put i.b))
1256− :: +has: does :b exist in :a?
1257− ::
1258− ++ has
1259− ~/ %has
1260− |* b=*
1261− ^- ?
1262− :: wrap extracted item type in a unit because bunting fails
1263− ::
1264− :: If we used the real item type of _?^(a n.a !!) as the sample type,
1265− :: then hoon would bunt it to create the default sample for the gate.
1266− ::
1267− :: However, bunting that expression fails if :a is ~. If we wrap it
1268− :: in a unit, the bunted unit doesn't include the bunted item type.
1269− ::
1270− :: This way we can ensure type safety of :b without needing to perform
1271− :: this failing bunt. It's a hack.
1272− ::
1273− %. [~ b]
1274− |= b=(unit _?>(?=(^ a) n.a))
1275− => .(b ?>(?=(^ b) u.b))
1276− |- ^- ?
1277− ?~ a
1278− |
1279− ?: =(b n.a)
1280− &
1281− ?: (gor b n.a)
1282− $(a l.a)
1283− $(a r.a)
1284− ::
1285− ++ int :: intersection
1286− ~/ %int
1287− |* b=_a
1288− |- ^+ a
1289− ?~ b
1290− ~
1291− ?~ a
1292− ~
1293− ?. (mor n.a n.b)
1294− $(a b, b a)
1295− ?: =(n.b n.a)
1296− a(l $(a l.a, b l.b), r $(a r.a, b r.b))
1297− ?: (gor n.b n.a)
1298− %- uni(a $(a l.a, r.b ~)) $(b r.b)
1299− %- uni(a $(a r.a, l.b ~)) $(b l.b)
1300− ::
1301− ++ put :: puts b in a, sorted
1302− ~/ %put
1303− |* b=*
1304− |- ^+ a
1305− ?~ a
1306− [b ~ ~]
1307− ?: =(b n.a)
1308− a
1309− ?: (gor b n.a)
1310− =+ c=$(a l.a)
1311− ?> ?=(^ c)
1312− ?: (mor n.a n.c)
1313− a(l c)
1314− c(r a(l r.c))
1315− =+ c=$(a r.a)
1316− ?> ?=(^ c)
1317− ?: (mor n.a n.c)
1318− a(r c)
1319− c(l a(r l.c))
1320− ::
1321− ++ rep :: reduce to product
1322− ~/ %rep
1323− |* b=_=>(~ |=([* *] +<+))
1324− |-
1325− ?~ a +<+.b
1326− $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
1327− ::
1328− ++ run :: apply gate to values
1329− ~/ %run
1330− |* b=gate
1331− =+ c=`(set _?>(?=(^ a) (b n.a)))`~
1332− |- ?~ a c
1333− =. c (~(put in c) (b n.a))
1334− =. c $(a l.a, c c)
1335− $(a r.a, c c)
1336− ::
1337− ++ tap :: convert to list
1338− =< $
1339− ~/ %tap
1340− =+ b=`(list _?>(?=(^ a) n.a))`~
1341− |. ^+ b
1342− ?~ a
1343− b
1344− $(a r.a, b [n.a $(a l.a)])
1345− ::
1346− ++ uni :: union
1347− ~/ %uni
1348− |* b=_a
1349− ?: =(a b) a
1350− |- ^+ a
1351− ?~ b
1352− a
1353− ?~ a
1354− b
1355− ?: =(n.b n.a)
1356− b(l $(a l.a, b l.b), r $(a r.a, b r.b))
1357− ?: (mor n.a n.b)
1358− ?: (gor n.b n.a)
1359− $(l.a $(a l.a, r.b ~), b r.b)
1360− $(r.a $(a r.a, l.b ~), b l.b)
1361− ?: (gor n.a n.b)
1362− $(l.b $(b l.b, r.a ~), a r.a)
1363− $(r.b $(b r.b, l.a ~), a l.a)
1364− ::
1365− ++ wyt :: size of set
1366− =< $
1367− ~% %wyt + ~
1368− |. ^- @
1369− ?~(a 0 +((add $(a l.a) $(a r.a))))
1370− --
1371−::
1372−:: 2i: map logic
1373−+| %map-logic
1374−::
1375−++ by :: map engine
1376− ~/ %by
1377− =| a=(tree (pair)) :: (map)
1378− |@
1379− ++ all :: logical AND
1380− ~/ %all
1381− |* b=$-(* ?)
1382− |- ^- ?
1383− ?~ a
1384− &
1385− ?&((b q.n.a) $(a l.a) $(a r.a))
1386− ::
1387− ++ any :: logical OR
1388− ~/ %any
1389− |* b=$-(* ?)
1390− |- ^- ?
1391− ?~ a
1392− |
1393− ?|((b q.n.a) $(a l.a) $(a r.a))
1394− ::
1395− ++ bif :: splits a by b
1396− ~/ %bif
1397− |* [b=* c=*]
1398− ^+ [l=a r=a]
1399− =< +
1400− |- ^+ a
1401− ?~ a
1402− [[b c] ~ ~]
1403− ?: =(b p.n.a)
1404− ?: =(c q.n.a)
1405− a
1406− a(n [b c])
1407− ?: (gor b p.n.a)
1408− =+ d=$(a l.a)
1409− ?> ?=(^ d)
1410− d(r a(l r.d))
1411− =+ d=$(a r.a)
1412− ?> ?=(^ d)
1413− d(l a(r l.d))
1414− ::
1415− ++ del :: delete at key b
1416− ~/ %del
1417− |* b=*
1418− |- ^+ a
1419− ?~ a
1420− ~
1421− ?. =(b p.n.a)
1422− ?: (gor b p.n.a)
1423− a(l $(a l.a))
1424− a(r $(a r.a))
1425− |- ^- [$?(~ _a)]
1426− ?~ l.a r.a
1427− ?~ r.a l.a
1428− ?: (mor p.n.l.a p.n.r.a)
1429− l.a(r $(l.a r.l.a))
1430− r.a(l $(r.a l.r.a))
1431− ::
1432− ++ dif :: difference
1433− ~/ %dif
1434− |* b=_a
1435− |- ^+ a
1436− ?~ b
1437− a
1438− =+ c=(bif p.n.b q.n.b)
1439− ?> ?=(^ c)
1440− =+ d=$(a l.c, b l.b)
1441− =+ e=$(a r.c, b r.b)
1442− |- ^- [$?(~ _a)]
1443− ?~ d e
1444− ?~ e d
1445− ?: (mor p.n.d p.n.e)
1446− d(r $(d r.d))
1447− e(l $(e l.e))
1448− ::
1449− ++ dig :: axis of b key
1450− |= b=*
1451− =+ c=1
1452− |- ^- (unit @)
1453− ?~ a ~
1454− ?: =(b p.n.a) [~ u=(peg c 2)]
1455− ?: (gor b p.n.a)
1456− $(a l.a, c (peg c 6))
1457− $(a r.a, c (peg c 7))
1458− ::
1459− ++ apt :: check correctness
1460− =< $
1461− ~/ %apt
1462− =| [l=(unit) r=(unit)]
1463− |. ^- ?
1464− ?~ a &
1465− ?& ?~(l & &((gor p.n.a u.l) !=(p.n.a u.l)))
1466− ?~(r & &((gor u.r p.n.a) !=(u.r p.n.a)))
1467− ?~ l.a &
1468− &((mor p.n.a p.n.l.a) !=(p.n.a p.n.l.a) $(a l.a, l `p.n.a))
1469− ?~ r.a &
1470− &((mor p.n.a p.n.r.a) !=(p.n.a p.n.r.a) $(a r.a, r `p.n.a))
1471− ==
1472− ::
1473− ++ gas :: concatenate
1474− ~/ %gas
1475− |* b=(list [p=* q=*])
1476− => .(b `(list _?>(?=(^ a) n.a))`b)
1477− |- ^+ a
1478− ?~ b
1479− a
1480− $(b t.b, a (put p.i.b q.i.b))
1481− ::
1482− ++ get :: grab value by key
1483− ~/ %get
1484− |* b=*
1485− => .(b `_?>(?=(^ a) p.n.a)`b)
1486− |- ^- (unit _?>(?=(^ a) q.n.a))
1487− ?~ a
1488− ~
1489− ?: =(b p.n.a)
1490− (some q.n.a)
1491− ?: (gor b p.n.a)
1492− $(a l.a)
1493− $(a r.a)
1494− ::
1495− ++ got :: need value by key
1496− |* b=*
1497− (need (get b))
1498− ::
1499− ++ gut :: fall value by key
1500− |* [b=* c=*]
1501− (fall (get b) c)
1502− ::
1503− ++ has :: key existence check
1504− ~/ %has
1505− |* b=*
1506− !=(~ (get b))
1507− ::
1508− ++ int :: intersection
1509− ~/ %int
1510− |* b=_a
1511− |- ^+ a
1512− ?~ b
1513− ~
1514− ?~ a
1515− ~
1516− ?: (mor p.n.a p.n.b)
1517− ?: =(p.n.b p.n.a)
1518− b(l $(a l.a, b l.b), r $(a r.a, b r.b))
1519− ?: (gor p.n.b p.n.a)
1520− %- uni(a $(a l.a, r.b ~)) $(b r.b)
1521− %- uni(a $(a r.a, l.b ~)) $(b l.b)
1522− ?: =(p.n.a p.n.b)
1523− b(l $(b l.b, a l.a), r $(b r.b, a r.a))
1524− ?: (gor p.n.a p.n.b)
1525− %- uni(a $(b l.b, r.a ~)) $(a r.a)
1526− %- uni(a $(b r.b, l.a ~)) $(a l.a)
1527− ::
1528− ++ jab
1529− ~/ %jab
1530− |* [key=_?>(?=(^ a) p.n.a) fun=$-(_?>(?=(^ a) q.n.a) _?>(?=(^ a) q.n.a))]
1531− ^+ a
1532− ::
1533− ?~ a !!
1534− ::
1535− ?: =(key p.n.a)
1536− a(q.n (fun q.n.a))
1537− ::
1538− ?: (gor key p.n.a)
1539− a(l $(a l.a))
1540− ::
1541− a(r $(a r.a))
1542− ::
1543− ++ mar :: add with validation
1544− |* [b=* c=(unit *)]
1545− ?~ c
1546− (del b)
1547− (put b u.c)
1548− ::
1549− ++ put :: adds key-value pair
1550− ~/ %put
1551− |* [b=* c=*]
1552− |- ^+ a
1553− ?~ a
1554− [[b c] ~ ~]
1555− ?: =(b p.n.a)
1556− ?: =(c q.n.a)
1557− a
1558− a(n [b c])
1559− ?: (gor b p.n.a)
1560− =+ d=$(a l.a)
1561− ?> ?=(^ d)
1562− ?: (mor p.n.a p.n.d)
1563− a(l d)
1564− d(r a(l r.d))
1565− =+ d=$(a r.a)
1566− ?> ?=(^ d)
1567− ?: (mor p.n.a p.n.d)
1568− a(r d)
1569− d(l a(r l.d))
1570− ::
1571− ++ rep :: reduce to product
1572− ~/ %rep
1573− |* b=_=>(~ |=([* *] +<+))
1574− |-
1575− ?~ a +<+.b
1576− $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
1577− ::
1578− ++ rib :: transform + product
1579− |* [b=* c=gate]
1580− |- ^+ [b a]
1581− ?~ a [b ~]
1582− =+ d=(c n.a b)
1583− =. n.a +.d
1584− =+ e=$(a l.a, b -.d)
1585− =+ f=$(a r.a, b -.e)
1586− [-.f a(l +.e, r +.f)]
1587− ::
1588− ++ run :: apply gate to values
1589− ~/ %run
1590− |* b=gate
1591− |-
1592− ?~ a a
1593− [n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)]
1594− ::
1595− ++ rut :: apply gate to nodes
1596− |* b=gate
1597− |-
1598− ?~ a a
1599− [n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)]
1600− ::
1601− ++ tap :: listify pairs
1602− =< $
1603− ~/ %tap
1604− =+ b=`(list _?>(?=(^ a) n.a))`~
1605− |. ^+ b
1606− ?~ a
1607− b
1608− $(a r.a, b [n.a $(a l.a)])
1609− ::
1610− ++ uni :: union, merge
1611− ~/ %uni
1612− |* b=_a
1613− |- ^+ a
1614− ?~ b
1615− a
1616− ?~ a
1617− b
1618− ?: =(p.n.b p.n.a)
1619− b(l $(a l.a, b l.b), r $(a r.a, b r.b))
1620− ?: (mor p.n.a p.n.b)
1621− ?: (gor p.n.b p.n.a)
1622− $(l.a $(a l.a, r.b ~), b r.b)
1623− $(r.a $(a r.a, l.b ~), b l.b)
1624− ?: (gor p.n.a p.n.b)
1625− $(l.b $(b l.b, r.a ~), a r.a)
1626− $(r.b $(b r.b, l.a ~), a l.a)
1627− ::
1628− ++ uno :: general union
1629− |* b=_a
1630− |* meg=$-([* * *] *)
1631− |- ^+ a
1632− ?~ b
1633− a
1634− ?~ a
1635− b
1636− ?: =(p.n.b p.n.a)
1637− :+ [p.n.a `_?>(?=(^ a) q.n.a)`(meg p.n.a q.n.a q.n.b)]
1638− $(b l.b, a l.a)
1639− $(b r.b, a r.a)
1640− ?: (mor p.n.a p.n.b)
1641− ?: (gor p.n.b p.n.a)
1642− $(l.a $(a l.a, r.b ~), b r.b)
1643− $(r.a $(a r.a, l.b ~), b l.b)
1644− ?: (gor p.n.a p.n.b)
1645− $(l.b $(b l.b, r.a ~), a r.a)
1646− $(r.b $(b r.b, l.a ~), a l.a)
1647− ::
1648− ++ urn :: apply gate to nodes
1649− ~/ %urn
1650− |* b=$-([* *] *)
1651− |-
1652− ?~ a ~
1653− a(n n.a(q (b p.n.a q.n.a)), l $(a l.a), r $(a r.a))
1654− ::
1655− ++ wyt :: depth of map
1656− =< $
1657− ~% %wyt + ~
1658− |. ^- @
1659− ?~(a 0 +((add $(a l.a) $(a r.a))))
1660− ::
1661− ++ key :: set of keys
1662− =< $
1663− ~/ %key
1664− =+ b=`(set _?>(?=(^ a) p.n.a))`~
1665− |. ^+ b
1666− ?~ a b
1667− $(a r.a, b $(a l.a, b (~(put in b) p.n.a)))
1668− ::
1669− ++ val :: list of vals
1670− =+ b=`(list _?>(?=(^ a) q.n.a))`~
1671− |- ^+ b
1672− ?~ a b
1673− $(a r.a, b [q.n.a $(a l.a)])
1674− --
1675−::
1676−:: 2j: jar and jug logic
1677−+| %jar-and-jug-logic
1678−++ ja :: jar engine
1679− =| a=(tree (pair * (list))) :: (jar)
1680− |@
1681− ++ get :: gets list by key
1682− |* b=*
1683− =+ c=(~(get by a) b)
1684− ?~(c ~ u.c)
1685− ::
1686− ++ add :: adds key-list pair
1687− |* [b=* c=*]
1688− =+ d=(get b)
1689− (~(put by a) b [c d])
1690− --
1691−++ ju :: jug engine
1692− =| a=(tree (pair * (tree))) :: (jug)
1693− |@
1694− ++ del :: del key-set pair
1695− |* [b=* c=*]
1696− ^+ a
1697− =+ d=(get b)
1698− =+ e=(~(del in d) c)
1699− ?~ e
1700− (~(del by a) b)
1701− (~(put by a) b e)
1702− ::
1703− ++ gas :: concatenate
1704− |* b=(list [p=* q=*])
1705− => .(b `(list _?>(?=([[* ^] ^] a) [p=p q=n.q]:n.a))`b)
1706− |- ^+ a
1707− ?~ b
1708− a
1709− $(b t.b, a (put p.i.b q.i.b))
1710− ::
1711− ++ get :: gets set by key
1712− |* b=*
1713− =+ c=(~(get by a) b)
1714− ?~(c ~ u.c)
1715− ::
1716− ++ has :: existence check
1717− |* [b=* c=*]
1718− ^- ?
1719− (~(has in (get b)) c)
1720− ::
1721− ++ put :: add key-set pair
1722− |* [b=* c=*]
1723− ^+ a
1724− =+ d=(get b)
1725− (~(put by a) b (~(put in d) c))
1726− --
1727−::
1728−:: 2k: queue logic
1729−+| %queue-logic
1730−::
1731−++ to :: queue engine
1732− =| a=(tree) :: (qeu)
1733− |@
1734− ++ apt :: check correctness
1735− |- ^- ?
1736− ?~ a &
1737− ?& ?~(l.a & ?&((mor n.a n.l.a) $(a l.a)))
1738− ?~(r.a & ?&((mor n.a n.r.a) $(a r.a)))
1739− ==
1740− ::
1741− ++ bal
1742− |- ^+ a
1743− ?~ a ~
1744− ?. |(?=(~ l.a) (mor n.a n.l.a))
1745− $(a l.a(r $(a a(l r.l.a))))
1746− ?. |(?=(~ r.a) (mor n.a n.r.a))
1747− $(a r.a(l $(a a(r l.r.a))))
1748− a
1749− ::
1750− ++ dep :: max depth of queue
1751− |- ^- @
1752− ?~ a 0
1753− +((max $(a l.a) $(a r.a)))
1754− ::
1755− ++ gas :: insert list to que
1756− |= b=(list _?>(?=(^ a) n.a))
1757− |- ^+ a
1758− ?~(b a $(b t.b, a (put i.b)))
1759− ::
1760− ++ get :: head-rest pair
1761− |- ^+ ?>(?=(^ a) [p=n.a q=*(tree _n.a)])
1762− ?~ a
1763− !!
1764− ?~ r.a
1765− [n.a l.a]
1766− =+ b=$(a r.a)
1767− :- p.b
1768− ?: |(?=(~ q.b) (mor n.a n.q.b))
1769− a(r q.b)
1770− a(n n.q.b, l a(r l.q.b), r r.q.b)
1771− ::
1772− ++ nip :: removes root
1773− |- ^+ a
1774− ?~ a ~
1775− ?~ l.a r.a
1776− ?~ r.a l.a
1777− ?: (mor n.l.a n.r.a)
1778− l.a(r $(l.a r.l.a))
1779− r.a(l $(r.a l.r.a))
1780− ::
1781− ++ nap :: removes root
1782− ?> ?=(^ a)
1783− ?: =(~ l.a) r.a
1784− =+ b=get(a l.a)
1785− bal(n.a p.b, l.a q.b)
1786− ::
1787− ++ put :: insert new tail
1788− |* b=*
1789− |- ^+ a
1790− ?~ a
1791− [b ~ ~]
1792− bal(l.a $(a l.a))
1793− ::
1794− ++ tap :: adds list to end
1795− =+ b=`(list _?>(?=(^ a) n.a))`~
1796− |- ^+ b
1797− =+ 0 :: hack for jet match
1798− ?~ a
1799− b
1800− $(a r.a, b [n.a $(a l.a)])
1801− ::
1802− ++ top :: produces head
1803− |- ^- (unit _?>(?=(^ a) n.a))
1804− ?~ a ~
1805− ?~(r.a [~ n.a] $(a r.a))
1806− --
1807−::
1808−:: 2l: container from container
1809−+| %container-from-container
1810−::
1811−++ malt :: map from list
1812− |* a=(list)
1813− (molt `(list [p=_-<.a q=_->.a])`a)
1814−::
1815−++ molt :: map from pair list
1816− |* a=(list (pair)) :: ^- =,(i.-.a (map _p _q))
1817− (~(gas by `(tree [p=_p.i.-.a q=_q.i.-.a])`~) a)
1818−::
1819−++ silt :: set from list
1820− |* a=(list) :: ^- (set _i.-.a)
1821− =+ b=*(tree _?>(?=(^ a) i.a))
1822− (~(gas in b) a)
1823−::
1824−:: 2m: container from noun
1825−+| %container-from-noun
1826−::
1827−++ ly :: list from raw noun
1828− le:nl
1829−::
1830−++ my :: map from raw noun
1831− my:nl
1832−::
1833−++ sy :: set from raw noun
1834− si:nl
1835−::
1836−++ nl
1837− |%
1838− :: ::
1839− ++ le :: construct list
1840− |* a=(list)
1841− ^+ =< $
1842− |@ ++ $ ?:(*? ~ [i=(snag 0 a) t=$])
1843− --
1844− a
1845− :: ::
1846− ++ my :: construct map
1847− |* a=(list (pair))
1848− => .(a ^+((le a) a))
1849− (~(gas by `(map _p.i.-.a _q.i.-.a)`~) a)
1850− :: ::
1851− ++ si :: construct set
1852− |* a=(list)
1853− => .(a ^+((le a) a))
1854− (~(gas in `(set _i.-.a)`~) a)
1855− :: ::
1856− ++ snag :: index
1857− |* [a=@ b=(list)]
1858− ?~ b
1859− ~_ leaf+"snag-fail"
1860− !!
1861− ?: =(0 a) i.b
1862− $(b t.b, a (dec a))
1863− :: ::
1864− ++ weld :: concatenate
1865− |* [a=(list) b=(list)]
1866− => .(a ^+((le a) a), b ^+((le b) b))
1867− =+ 42
1868− |-
1869− ?~ a b
1870− [i=i.a t=$(a t.a)]
1871− --
1872−:: 2n: functional hacks
1873−+| %functional-hacks
1874−::
1875−++ aftr |*(a=$-(* *) |*(b=$-(* *) (pair b a))) :: pair after
1876−++ cork |*([a=$-(* *) b=$-(* *)] (corl b a)) :: compose forward
1877−++ corl :: compose backwards
1878− |* [a=$-(* *) b=$-(* *)]
1879− =< +:|.((a (b))) :: type check
1880− |* c=_+<.b
1881− (a (b c))
1882−::
1883−++ cury :: curry left
1884− |* [a=$-(^ *) b=*]
1885− |* c=_+<+.a
1886− (a b c)
1887−::
1888−++ curr :: curry right
1889− |* [a=$-(^ *) c=*]
1890− |* b=_+<+.a
1891− (a b c)
1892−::
1893−++ fore |*(a=$-(* *) |*(b=$-(* *) (pair a b))) :: pair before
1894−::
1895−++ head |*(^ ,:+<-) :: get head
1896−++ same |*(* +<) :: identity
1897−::
1898−++ succ |=(@ +(+<)) :: successor
1899−::
1900−++ tail |*(^ ,:+<+) :: get tail
1901−++ test |=(^ =(+<- +<+)) :: equality
1902−::
1903−++ lead |*(* |*(* [+>+< +<])) :: put head
1904−++ late |*(* |*(* [+< +>+<])) :: put tail
1905−::
1906−:: 2o: containers
1907−+| %containers
1908−++ jar |$ [key value] (map key (list value)) :: map of lists
1909−++ jug |$ [key value] (map key (set value)) :: map of sets
1910−::
1911−++ map
1912− |$ [key value] :: table
1913− $| (tree (pair key value))
1914− |=(a=(tree (pair)) ?:(=(~ a) & ~(apt by a)))
1915−::
1916−++ qeu
1917− |$ [item] :: queue
1918− $| (tree item)
1919− |=(a=(tree) ?:(=(~ a) & ~(apt to a)))
1920−::
1921−++ set
1922− |$ [item] :: set
1923− $| (tree item)
1924− |=(a=(tree) ?:(=(~ a) & ~(apt in a)))
1925−::
1926−:: 2p: serialization
1927−+| %serialization
1928−::
1929−++ cue :: unpack
1930− ~/ %cue
1931− |= a=@
1932− ^- *
1933− =+ b=0
1934− =+ m=`(map @ *)`~
1935− =< q
1936− |- ^- [p=@ q=* r=(map @ *)]
1937− ?: =(0 (cut 0 [b 1] a))
1938− =+ c=(rub +(b) a)
1939− [+(p.c) q.c (~(put by m) b q.c)]
1940− =+ c=(add 2 b)
1941− ?: =(0 (cut 0 [+(b) 1] a))
1942− =+ u=$(b c)
1943− =+ v=$(b (add p.u c), m r.u)
1944− =+ w=[q.u q.v]
1945− [(add 2 (add p.u p.v)) w (~(put by r.v) b w)]
1946− =+ d=(rub c a)
1947− [(add 2 p.d) (need (~(get by m) q.d)) m]
1948−::
1949−++ jam :: pack
1950− ~/ %jam
1951− |= a=*
1952− ^- @
1953− =+ b=0
1954− =+ m=`(map * @)`~
1955− =< q
1956− |- ^- [p=@ q=@ r=(map * @)]
1957− =+ c=(~(get by m) a)
1958− ?~ c
1959− => .(m (~(put by m) a b))
1960− ?: ?=(@ a)
1961− =+ d=(mat a)
1962− [(add 1 p.d) (lsh 0 q.d) m]
1963− => .(b (add 2 b))
1964− =+ d=$(a -.a)
1965− =+ e=$(a +.a, b (add b p.d), m r.d)
1966− [(add 2 (add p.d p.e)) (mix 1 (lsh [0 2] (cat 0 q.d q.e))) r.e]
1967− ?: ?&(?=(@ a) (lte (met 0 a) (met 0 u.c)))
1968− =+ d=(mat a)
1969− [(add 1 p.d) (lsh 0 q.d) m]
1970− =+ d=(mat u.c)
1971− [(add 2 p.d) (mix 3 (lsh [0 2] q.d)) m]
1972−::
1973−++ mat :: length-encode
1974− ~/ %mat
1975− |= a=@
1976− ^- [p=@ q=@]
1977− ?: =(0 a)
1978− [1 1]
1979− =+ b=(met 0 a)
1980− =+ c=(met 0 b)
1981− :- (add (add c c) b)
1982− (cat 0 (bex c) (mix (end [0 (dec c)] b) (lsh [0 (dec c)] a)))
1983−::
1984−++ rub :: length-decode
1985− ~/ %rub
1986− |= [a=@ b=@]
1987− ^- [p=@ q=@]
1988− =+ ^= c
1989− =+ [c=0 m=(met 0 b)]
1990− |- ?< (gth c m)
1991− ?. =(0 (cut 0 [(add a c) 1] b))
1992− c
1993− $(c +(c))
1994− ?: =(0 c)
1995− [1 0]
1996− =+ d=(add a +(c))
1997− =+ e=(add (bex (dec c)) (cut 0 [d (dec c)] b))
1998− [(add (add c c) e) (cut 0 [(add d (dec c)) e] b)]
1999−::
2000−++ fn :: float, infinity, or NaN
2001− ::
2002− :: s=sign, e=exponent, a=arithmetic form
2003− :: (-1)^s * a * 2^e
2004− $% [%f s=? e=@s a=@u]
2005− [%i s=?]
2006− [%n ~]
2007− ==
2008−::
2009−++ dn :: decimal float, infinity, or NaN
2010− ::
2011− :: (-1)^s * a * 10^e
2012− $% [%d s=? e=@s a=@u]
2013− [%i s=?]
2014− [%n ~]
2015− ==
2016−::
2017−++ rn :: parsed decimal float
2018− ::
2019− $% [%d a=? b=[c=@ [d=@ e=@] f=? i=@]]
2020− [%i a=?]
2021− [%n ~]
2022− ==
2023−::
2024−:: 2q: molds and mold builders
2025−+| %molds-and-mold-builders
2026−::
2027−+$ axis @ :: tree address
2028−+$ bean ? :: 0=&=yes, 1=|=no
2029−+$ flag ?
2030−+$ char @t :: UTF8 byte
2031−+$ cord @t :: UTF8, LSB first
2032−+$ byts [wid=@ud dat=@] :: bytes, MSB first
2033−+$ date [[a=? y=@ud] m=@ud t=tarp] :: parsed date
2034−+$ knot @ta :: ASCII text
2035−+$ noun * :: any noun
2036−+$ path (list knot) :: like unix path
2037−+$ pith (list iota) :: typed urbit path
2038−+$ stud :: standard name
2039− $@ mark=@tas :: auth=urbit
2040− $: auth=@tas :: standards authority
2041− type=path :: standard label
2042− == ::
2043−+$ tang (list tank) :: bottom-first error
2044−:: ::
2045−+$ iota :: typed path segment
2046− $~ [%n ~]
2047− $@ @tas
2048− $% [%ub @ub] [%uc @uc] [%ud @ud] [%ui @ui]
2049− [%ux @ux] [%uv @uv] [%uw @uw]
2050− [%sb @sb] [%sc @sc] [%sd @sd] [%si @si]
2051− [%sx @sx] [%sv @sv] [%sw @sw]
2052− [%da @da] [%dr @dr]
2053− [%f ?] [%n ~]
2054− [%if @if] [%is @is]
2055− [%t @t] [%ta @ta] :: @tas
2056− [%p @p] [%q @q]
2057− [%rs @rs] [%rd @rd] [%rh @rh] [%rq @rq]
2058− ==
2059−::
2060−:: $tank: formatted print tree
2061−::
2062−:: just a cord, or
2063−:: %leaf: just a tape
2064−:: %palm: backstep list
2065−:: flat-mid, open, flat-open, flat-close
2066−:: %rose: flat list
2067−:: flat-mid, open, close
2068−::
2069−+$ tank
2070− $~ leaf/~
2071− $@ cord
2072− $% [%leaf p=tape]
2073− [%palm p=(qual tape tape tape tape) q=(list tank)]
2074− [%rose p=(trel tape tape tape) q=(list tank)]
2075− ==
2076−::
2077−+$ tape (list @tD) :: utf8 string as list
2078−+$ tour (list @c) :: utf32 clusters
2079−+$ tarp [d=@ud h=@ud m=@ud s=@ud f=(list @ux)] :: parsed time
2080−+$ term @tas :: ascii symbol
2081−+$ wain (list cord) :: text lines
2082−+$ wall (list tape) :: text lines
2083−::
2084−-- =>
2085−:: ::
2086−~% %tri +
2087− ==
2088− %year year
2089− %yore yore
2090− %ob ob
2091− ==
2092−:: layer-3
2093−::
2094−|%
2095−:: 3a: signed and modular ints
2096−+| %signed-and-modular-ints
2097−::
2098−++ egcd :: schneier's egcd
2099− |= [a=@ b=@]
2100− =+ si
2101− =+ [c=(sun a) d=(sun b)]
2102− =+ [u=[c=(sun 1) d=--0] v=[c=--0 d=(sun 1)]]
2103− |- ^- [d=@ u=@s v=@s]
2104− ?: =(--0 c)
2105− [(abs d) d.u d.v]
2106− :: ?> ?& =(c (sum (pro (sun a) c.u) (pro (sun b) c.v)))
2107− :: =(d (sum (pro (sun a) d.u) (pro (sun b) d.v)))
2108− :: ==
2109− =+ q=(fra d c)
2110− %= $
2111− c (dif d (pro q c))
2112− d c
2113− u [(dif d.u (pro q c.u)) c.u]
2114− v [(dif d.v (pro q c.v)) c.v]
2115− ==
2116−::
2117−++ fo :: modulo prime
2118− ^|
2119− |_ a=@
2120− ++ dif
2121− |= [b=@ c=@]
2122− (sit (sub (add a b) (sit c)))
2123− ::
2124− ++ exp
2125− |= [b=@ c=@]
2126− ?: =(0 b)
2127− 1
2128− =+ d=$(b (rsh 0 b))
2129− =+ e=(pro d d)
2130− ?:(=(0 (end 0 b)) e (pro c e))
2131− ::
2132− ++ fra
2133− |= [b=@ c=@]
2134− (pro b (inv c))
2135− ::
2136− ++ inv
2137− |= b=@
2138− =+ c=(dul:si u:(egcd b a) a)
2139− c
2140− ::
2141− ++ pro
2142− |= [b=@ c=@]
2143− (sit (mul b c))
2144− ::
2145− ++ sit
2146− |= b=@
2147− (mod b a)
2148− ::
2149− ++ sum
2150− |= [b=@ c=@]
2151− (sit (add b c))
2152− --
2153−::
2154−++ si :: signed integer
2155− ^?
2156− |%
2157− ++ abs |=(a=@s (add (end 0 a) (rsh 0 a))) :: absolute value
2158− ++ dif |= [a=@s b=@s] :: subtraction
2159− (sum a (new !(syn b) (abs b)))
2160− ++ dul |= [a=@s b=@] :: modulus
2161− =+(c=(old a) ?:(-.c (mod +.c b) (sub b +.c)))
2162− ++ fra |= [a=@s b=@s] :: divide
2163− (new =(0 (mix (syn a) (syn b))) (div (abs a) (abs b)))
2164− ++ new |= [a=? b=@] :: [sign value] to @s
2165− `@s`?:(a (mul 2 b) ?:(=(0 b) 0 +((mul 2 (dec b)))))
2166− ++ old |=(a=@s [(syn a) (abs a)]) :: [sign value]
2167− ++ pro |= [a=@s b=@s] :: multiplication
2168− (new =(0 (mix (syn a) (syn b))) (mul (abs a) (abs b)))
2169− ++ rem |=([a=@s b=@s] (dif a (pro b (fra a b)))) :: remainder
2170− ++ sum |= [a=@s b=@s] :: addition
2171− =+ [c=(old a) d=(old b)]
2172− ?: -.c
2173− ?: -.d
2174− (new & (add +.c +.d))
2175− ?: (gte +.c +.d)
2176− (new & (sub +.c +.d))
2177− (new | (sub +.d +.c))
2178− ?: -.d
2179− ?: (gte +.c +.d)
2180− (new | (sub +.c +.d))
2181− (new & (sub +.d +.c))
2182− (new | (add +.c +.d))
2183− ++ sun |=(a=@u (mul 2 a)) :: @u to @s
2184− ++ syn |=(a=@s =(0 (end 0 a))) :: sign test
2185− ++ cmp |= [a=@s b=@s] :: compare
2186− ^- @s
2187− ?: =(a b)
2188− --0
2189− ?: (syn a)
2190− ?: (syn b)
2191− ?: (gth a b)
2192− --1
2193− -1
2194− --1
2195− ?: (syn b)
2196− -1
2197− ?: (gth a b)
2198− -1
2199− --1
2200− --
2201−::
2202−:: 3b: floating point
2203−+| %floating-point
2204−::
2205−++ fl :: arb. precision fp
2206− =/ [[p=@u v=@s w=@u] r=$?(%n %u %d %z %a) d=$?(%d %f %i)]
2207− [[113 -16.494 32.765] %n %d]
2208− :: p=precision: number of bits in arithmetic form; must be at least 2
2209− :: v=min exponent: minimum value of e
2210− :: w=width: max - min value of e, 0 is fixed point
2211− :: r=rounding mode: nearest (ties to even), up, down, to zero, away from zero
2212− :: d=behavior: return denormals, flush denormals to zero,
2213− :: infinite exponent range
2214− =>
2215− ~% %cofl +> ~
2216− :: cofl
2217− ::
2218− :: internal functions; mostly operating on [e=@s a=@u], in other words
2219− :: positive numbers. many of these error out if a=0.
2220− |%
2221− ++ rou
2222− |= [a=[e=@s a=@u]] ^- fn (rau a &)
2223− ::
2224− ++ rau
2225− |= [a=[e=@s a=@u] t=?] ^- fn
2226− ?- r
2227− %z (lug %fl a t) %d (lug %fl a t)
2228− %a (lug %ce a t) %u (lug %ce a t)
2229− %n (lug %ne a t)
2230− ==
2231− ::
2232− ++ add :: add; exact if e
2233− |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
2234− =+ q=(dif:si e.a e.b)
2235− |- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exp
2236− ?: e
2237− [%f & e.b (^add (lsh [0 (abs:si q)] a.a) a.b)]
2238− =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
2239− =+ ^= w %+ dif:si e.a %- sun:si :: expanded exp of a
2240− ?: (gth prc ma) (^sub prc ma) 0
2241− =+ ^= x %+ sum:si e.b (sun:si mb) :: highest exp for b
2242− ?: =((cmp:si w x) --1) :: don't need to add
2243− ?- r
2244− %z (lug %fl a &) %d (lug %fl a &)
2245− %a (lug %lg a &) %u (lug %lg a &)
2246− %n (lug %na a &)
2247− ==
2248− (rou [e.b (^add (lsh [0 (abs:si q)] a.a) a.b)])
2249− ::
2250− ++ sub :: subtract; exact if e
2251− |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
2252− =+ q=(dif:si e.a e.b)
2253− |- ?. (syn:si q)
2254− (fli $(b a, a b, q +(q), r swr))
2255− =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
2256− =+ ^= w %+ dif:si e.a %- sun:si
2257− ?: (gth prc ma) (^sub prc ma) 0
2258− =+ ^= x %+ sum:si e.b (sun:si +(mb))
2259− ?: &(!e =((cmp:si w x) --1))
2260− ?- r
2261− %z (lug %sm a &) %d (lug %sm a &)
2262− %a (lug %ce a &) %u (lug %ce a &)
2263− %n (lug %nt a &)
2264− ==
2265− =+ j=(lsh [0 (abs:si q)] a.a)
2266− |- ?. (gte j a.b)
2267− (fli $(a.b j, j a.b, r swr))
2268− =+ i=(^sub j a.b)
2269− ?~ i [%f & zer]
2270− ?: e [%f & e.b i] (rou [e.b i])
2271− ::
2272− ++ mul :: multiply
2273− |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn
2274− (rou (sum:si e.a e.b) (^mul a.a a.b))
2275− ::
2276− ++ div :: divide
2277− |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn
2278− =+ [ma=(met 0 a.a) mb=(met 0 a.b)]
2279− =+ v=(dif:si (sun:si ma) (sun:si +((^add mb prc))))
2280− =. a ?: (syn:si v) a
2281− a(e (sum:si v e.a), a (lsh [0 (abs:si v)] a.a))
2282− =+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)]
2283− (rau [j p.q] =(q.q 0))
2284− ::
2285− ++ sqt :: square root
2286− |= [a=[e=@s a=@u]] ^- fn
2287− =. a
2288− =+ [w=(met 0 a.a) x=(^mul +(prc) 2)]
2289− =+ ?:((^lth w x) (^sub x w) 0)
2290− =+ ?: =((dis - 1) (dis (abs:si e.a) 1)) -
2291− (^add - 1)
2292− a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a))
2293− =+ [y=(^sqt a.a) z=(fra:si e.a --2)]
2294− (rau [z p.y] =(q.y 0))
2295− ::
2296− ++ lth :: less-than
2297− |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
2298− ?: =(e.a e.b) (^lth a.a a.b)
2299− =+ c=(cmp:si (ibl a) (ibl b))
2300− ?: =(c -1) & ?: =(c --1) |
2301− ?: =((cmp:si e.a e.b) -1)
2302− (^lth (rsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
2303− (^lth (lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
2304− ::
2305− ++ equ :: equals
2306− |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
2307− ?. =((ibl a) (ibl b)) |
2308− ?: =((cmp:si e.a e.b) -1)
2309− =((lsh [0 (abs:si (dif:si e.a e.b))] a.b) a.a)
2310− =((lsh [0 (abs:si (dif:si e.a e.b))] a.a) a.b)
2311− ::
2312− :: integer binary logarithm: 2^ibl(a) <= |a| < 2^(ibl(a)+1)
2313− ++ ibl
2314− |= [a=[e=@s a=@u]] ^- @s
2315− (sum:si (sun:si (dec (met 0 a.a))) e.a)
2316− ::
2317− :: +uni
2318− ::
2319− :: change to a representation where a.a is odd
2320− :: every fn has a unique representation of this kind
2321− ++ uni
2322− |= [a=[e=@s a=@u]]
2323− |- ?: =((end 0 a.a) 1) a
2324− $(a.a (rsh 0 a.a), e.a (sum:si e.a --1))
2325− ::
2326− :: +xpd: expands to either full precision or to denormalized
2327− ++ xpd
2328− |= [a=[e=@s a=@u]]
2329− =+ ma=(met 0 a.a)
2330− ?: (gte ma prc) a
2331− =+ ?: =(den %i) (^sub prc ma)
2332− =+ ^= q
2333− =+ w=(dif:si e.a emn)
2334− ?: (syn:si w) (abs:si w) 0
2335− (min q (^sub prc ma))
2336− a(e (dif:si e.a (sun:si -)), a (lsh [0 -] a.a))
2337− ::
2338− :: +lug: central rounding mechanism
2339− ::
2340− :: can perform: floor, ceiling, smaller, larger,
2341− :: nearest (round ties to: even, away from 0, toward 0)
2342− :: s is sticky bit: represents a value less than ulp(a) = 2^(e.a)
2343− ::
2344− ++ lug
2345− ~/ %lug
2346− |= [t=$?(%fl %ce %sm %lg %ne %na %nt) a=[e=@s a=@u] s=?] ^- fn
2347− ?< =(a.a 0)
2348− =-
2349− ?. =(den %f) - :: flush denormals
2350− ?. ?=([%f *] -) -
2351− ?: =((met 0 ->+>) prc) - [%f & zer]
2352− ::
2353− =+ m=(met 0 a.a)
2354− ?> |(s (gth m prc)) :: require precision
2355− =+ ^= q %+ max
2356− ?: (gth m prc) (^sub m prc) 0 :: reduce precision
2357− %- abs:si ?: =(den %i) --0 :: enforce min. exp
2358− ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0
2359− =^ b a :- (end [0 q] a.a)
2360− a(e (sum:si e.a (sun:si q)), a (rsh [0 q] a.a))
2361− ::
2362− ?~ a.a
2363− ?< =(den %i)
2364− ?- t
2365− %fl [%f & zer]
2366− %sm [%f & zer]
2367− %ce [%f & spd]
2368− %lg [%f & spd]
2369− %ne ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
2370− [%f & ?:((^lth b (bex (dec q))) zer spd)]
2371− %nt ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
2372− [%f & ?:((^lth b (bex (dec q))) zer spd)]
2373− %na [%f & ?:((^lth b (bex (dec q))) zer spd)]
2374− ==
2375− ::
2376− =. a (xpd a)
2377− ::
2378− =. a
2379− ?- t
2380− %fl a
2381− %lg a(a +(a.a))
2382− %sm ?. &(=(b 0) s) a
2383− ?: &(=(e.a emn) !=(den %i)) a(a (dec a.a))
2384− =+ y=(dec (^mul a.a 2))
2385− ?. (lte (met 0 y) prc) a(a (dec a.a))
2386− [(dif:si e.a --1) y]
2387− %ce ?: &(=(b 0) s) a a(a +(a.a))
2388− %ne ?~ b a
2389− =+ y=(bex (dec q))
2390− ?: &(=(b y) s) :: round halfs to even
2391− ?~ (dis a.a 1) a a(a +(a.a))
2392− ?: (^lth b y) a a(a +(a.a))
2393− %na ?~ b a
2394− =+ y=(bex (dec q))
2395− ?: (^lth b y) a a(a +(a.a))
2396− %nt ?~ b a
2397− =+ y=(bex (dec q))
2398− ?: =(b y) ?: s a a(a +(a.a))
2399− ?: (^lth b y) a a(a +(a.a))
2400− ==
2401− ::
2402− =. a ?. =((met 0 a.a) +(prc)) a
2403− a(a (rsh 0 a.a), e (sum:si e.a --1))
2404− ?~ a.a [%f & zer]
2405− ::
2406− ?: =(den %i) [%f & a]
2407− ?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp
2408− ::
2409− ++ drg :: dragon4; get
2410− ~/ %drg :: printable decimal;
2411− |= [a=[e=@s a=@u]] ^- [@s @u] :: guaranteed accurate
2412− ?< =(a.a 0) :: for rounded floats
2413− =. a (xpd a)
2414− =+ r=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] a.a)
2415− =+ s=(lsh [0 ?.((syn:si e.a) (abs:si e.a) 0)] 1)
2416− =+ mn=(lsh [0 ?:((syn:si e.a) (abs:si e.a) 0)] 1)
2417− =+ mp=mn
2418− => ?.
2419− ?& =(a.a (bex (dec prc))) :: if next smallest
2420− |(!=(e.a emn) =(den %i)) :: float is half ULP,
2421− == :: tighten lower bound
2422− .
2423− %= .
2424− mp (lsh 0 mp)
2425− r (lsh 0 r)
2426− s (lsh 0 s)
2427− ==
2428− =+ [k=--0 q=(^div (^add s 9) 10)]
2429− |- ?: (^lth r q)
2430− %= $
2431− k (dif:si k --1)
2432− r (^mul r 10)
2433− mn (^mul mn 10)
2434− mp (^mul mp 10)
2435− ==
2436− |- ?: (gte (^add (^mul r 2) mp) (^mul s 2))
2437− $(s (^mul s 10), k (sum:si k --1))
2438− =+ [u=0 o=0]
2439− |- :: r/s+o = a*10^-k
2440− =+ v=(dvr (^mul r 10) s)
2441− => %= .
2442− k (dif:si k --1)
2443− u p.v
2444− r q.v
2445− mn (^mul mn 10)
2446− mp (^mul mp 10)
2447− ==
2448− =+ l=(^lth (^mul r 2) mn) :: in lower bound
2449− =+ ^= h :: in upper bound
2450− ?| (^lth (^mul s 2) mp)
2451− (gth (^mul r 2) (^sub (^mul s 2) mp))
2452− ==
2453− ?: &(!l !h)
2454− $(o (^add (^mul o 10) u))
2455− =+ q=&(h |(!l (gth (^mul r 2) s)))
2456− =. o (^add (^mul o 10) ?:(q +(u) u))
2457− [k o]
2458− ::
2459− ++ toj :: round to integer
2460− |= [a=[e=@s a=@u]] ^- fn
2461− ?. =((cmp:si e.a --0) -1) [%f & a]
2462− =+ x=(abs:si e.a)
2463− =+ y=(rsh [0 x] a.a)
2464− ?: |(=(r %d) =(r %z)) [%f & --0 y]
2465− =+ z=(end [0 x] a.a)
2466− ?: |(=(r %u) =(r %a)) [%f & --0 ?~(z y +(y))]
2467− =+ i=(bex (dec x))
2468− ?: &(=(z i) =((dis y 1) 0)) [%f & --0 y]
2469− ?: (^lth z i) [%f & --0 y] [%f & --0 +(y)]
2470− ::
2471− ++ ned :: require ?=([%f *] a)
2472− |= [a=fn] ^- [%f s=? e=@s a=@u]
2473− ?: ?=([%f *] a) a
2474− ~_ leaf+"need-float"
2475− !!
2476− ::
2477− ++ shf :: a * 2^b; no rounding
2478− |= [a=fn b=@s]
2479− ?: |(?=([%n *] a) ?=([%i *] a)) a
2480− a(e (sum:si e.a b))
2481− ::
2482− ++ fli :: flip sign
2483− |= [a=fn] ^- fn
2484− ?-(-.a %f a(s !s.a), %i a(s !s.a), %n a)
2485− ::
2486− ++ swr ?+(r r %d %u, %u %d) :: flipped rounding
2487− ++ prc ?>((gth p 1) p) :: force >= 2 precision
2488− ++ den d :: denorm+flush+inf exp
2489− ++ emn v :: minimum exponent
2490− ++ emx (sum:si emn (sun:si w)) :: maximum exponent
2491− ++ spd [e=emn a=1] :: smallest denormal
2492− ++ spn [e=emn a=(bex (dec prc))] :: smallest normal
2493− ++ lfn [e=emx a=(fil 0 prc 1)] :: largest
2494− ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is > than all
2495− ++ zer [e=--0 a=0]
2496− --
2497− |%
2498− ++ rou :: round
2499− |= [a=fn] ^- fn
2500− ?. ?=([%f *] a) a
2501− ?~ a.a [%f s.a zer]
2502− ?: s.a (^rou +>.a)
2503− =.(r swr (fli (^rou +>.a)))
2504− ::
2505− ++ syn :: get sign
2506− |= [a=fn] ^- ?
2507− ?-(-.a %f s.a, %i s.a, %n &)
2508− ::
2509− ++ abs :: absolute value
2510− |= [a=fn] ^- fn
2511− ?: ?=([%f *] a) [%f & e.a a.a]
2512− ?: ?=([%i *] a) [%i &] [%n ~]
2513− ::
2514− ++ add :: add
2515− |= [a=fn b=fn] ^- fn
2516− ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
2517− ?: |(?=([%i *] a) ?=([%i *] b))
2518− ?: &(?=([%i *] a) ?=([%i *] b))
2519− ?: =(a b) a [%n ~]
2520− ?: ?=([%i *] a) a b
2521− ?: |(=(a.a 0) =(a.b 0))
2522− ?. &(=(a.a 0) =(a.b 0)) %- rou ?~(a.a b a)
2523− [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
2524− %- |= [a=fn]
2525− ?. ?=([%f *] a) a
2526− ?. =(a.a 0) a
2527− [%f !=(r %d) zer]
2528− ?: =(s.a s.b)
2529− ?: s.a (^add +>.a +>.b |)
2530− =.(r swr (fli (^add +>.a +>.b |)))
2531− ?: s.a (^sub +>.a +>.b |)
2532− (^sub +>.b +>.a |)
2533− ::
2534− ++ ead :: exact add
2535− |= [a=fn b=fn] ^- fn
2536− ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
2537− ?: |(?=([%i *] a) ?=([%i *] b))
2538− ?: &(?=([%i *] a) ?=([%i *] b))
2539− ?: =(a b) a [%n ~]
2540− ?: ?=([%i *] a) a b
2541− ?: |(=(a.a 0) =(a.b 0))
2542− ?. &(=(a.a 0) =(a.b 0)) ?~(a.a b a)
2543− [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
2544− %- |= [a=fn]
2545− ?. ?=([%f *] a) a
2546− ?. =(a.a 0) a
2547− [%f !=(r %d) zer]
2548− ?: =(s.a s.b)
2549− ?: s.a (^add +>.a +>.b &)
2550− (fli (^add +>.a +>.b &))
2551− ?: s.a (^sub +>.a +>.b &)
2552− (^sub +>.b +>.a &)
2553− ::
2554− ++ sub :: subtract
2555− |= [a=fn b=fn] ^- fn (add a (fli b))
2556− ::
2557− ++ mul :: multiply
2558− |= [a=fn b=fn] ^- fn
2559− ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
2560− ?: ?=([%i *] a)
2561− ?: ?=([%i *] b)
2562− [%i =(s.a s.b)]
2563− ?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
2564− ?: ?=([%i *] b)
2565− ?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
2566− ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
2567− ?: =(s.a s.b) (^mul +>.a +>.b)
2568− =.(r swr (fli (^mul +>.a +>.b)))
2569− ::
2570− ++ emu :: exact multiply
2571− |= [a=fn b=fn] ^- fn
2572− ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
2573− ?: ?=([%i *] a)
2574− ?: ?=([%i *] b)
2575− [%i =(s.a s.b)]
2576− ?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
2577− ?: ?=([%i *] b)
2578− ?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
2579− ?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
2580− [%f =(s.a s.b) (sum:si e.a e.b) (^^mul a.a a.b)]
2581− ::
2582− ++ div :: divide
2583− |= [a=fn b=fn] ^- fn
2584− ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~]
2585− ?: ?=([%i *] a)
2586− ?: ?=([%i *] b) [%n ~] [%i =(s.a s.b)]
2587− ?: ?=([%i *] b) [%f =(s.a s.b) zer]
2588− ?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer]
2589− ?: =(a.b 0) [%i =(s.a s.b)]
2590− ?: =(s.a s.b) (^div +>.a +>.b)
2591− =.(r swr (fli (^div +>.a +>.b)))
2592− ::
2593− ++ fma :: fused multiply-add
2594− |= [a=fn b=fn c=fn] ^- fn :: (a * b) + c
2595− (add (emu a b) c)
2596− ::
2597− ++ sqt :: square root
2598− |= [a=fn] ^- fn
2599− ?: ?=([%n *] a) [%n ~]
2600− ?: ?=([%i *] a) ?:(s.a a [%n ~])
2601− ?~ a.a [%f s.a zer]
2602− ?: s.a (^sqt +>.a) [%n ~]
2603− ::
2604− ++ inv :: inverse
2605− |= [a=fn] ^- fn
2606− (div [%f & --0 1] a)
2607− ::
2608− ++ sun :: uns integer to float
2609− |= [a=@u] ^- fn
2610− (rou [%f & --0 a])
2611− ::
2612− ++ san :: sgn integer to float
2613− |= [a=@s] ^- fn
2614− =+ b=(old:si a)
2615− (rou [%f -.b --0 +.b])
2616− ::
2617− ++ lth :: less-than
2618− :: comparisons return ~ in the event of a NaN
2619− |= [a=fn b=fn] ^- (unit ?)
2620− ?: |(?=([%n *] a) ?=([%n *] b)) ~ :- ~
2621− ?: =(a b) |
2622− ?: ?=([%i *] a) !s.a ?: ?=([%i *] b) s.b
2623− ?: |(=(a.a 0) =(a.b 0))
2624− ?: &(=(a.a 0) =(a.b 0)) |
2625− ?: =(a.a 0) s.b !s.a
2626− ?: !=(s.a s.b) s.b
2627− ?: s.a (^lth +>.a +>.b) (^lth +>.b +>.a)
2628− ::
2629− ++ lte :: less-equal
2630− |= [a=fn b=fn] ^- (unit ?)
2631− %+ bind (lth b a) |= a=? !a
2632− ::
2633− ++ equ :: equal
2634− |= [a=fn b=fn] ^- (unit ?)
2635− ?: |(?=([%n *] a) ?=([%n *] b)) ~ :- ~
2636− ?: =(a b) &
2637− ?: |(?=([%i *] a) ?=([%i *] b)) |
2638− ?: |(=(a.a 0) =(a.b 0))
2639− ?: &(=(a.a 0) =(a.b 0)) & |
2640− ?: |(=(e.a e.b) !=(s.a s.b)) |
2641− (^equ +>.a +>.b)
2642− ::
2643− ++ gte :: greater-equal
2644− |= [a=fn b=fn] ^- (unit ?) (lte b a)
2645− ::
2646− ++ gth :: greater-than
2647− |= [a=fn b=fn] ^- (unit ?) (lth b a)
2648− ::
2649− ++ drg :: float to decimal
2650− |= [a=fn] ^- dn
2651− ?: ?=([%n *] a) [%n ~]
2652− ?: ?=([%i *] a) [%i s.a]
2653− ?~ a.a [%d s.a --0 0]
2654− [%d s.a (^drg +>.a)]
2655− ::
2656− ++ grd :: decimal to float
2657− |= [a=dn] ^- fn
2658− ?: ?=([%n *] a) [%n ~]
2659− ?: ?=([%i *] a) [%i s.a]
2660− => .(r %n)
2661− =+ q=(abs:si e.a)
2662− ?: (syn:si e.a)
2663− (mul [%f s.a --0 a.a] [%f & e.a (pow 5 q)])
2664− (div [%f s.a --0 a.a] [%f & (sun:si q) (pow 5 q)])
2665− ::
2666− ++ toi :: round to integer @s
2667− |= [a=fn] ^- (unit @s)
2668− =+ b=(toj a)
2669− ?. ?=([%f *] b) ~ :- ~
2670− =+ c=(^^mul (bex (abs:si e.b)) a.b)
2671− (new:si s.b c)
2672− ::
2673− ++ toj :: round to integer fn
2674− |= [a=fn] ^- fn
2675− ?. ?=([%f *] a) a
2676− ?~ a.a [%f s.a zer]
2677− ?: s.a (^toj +>.a)
2678− =.(r swr (fli (^toj +>.a)))
2679− --
2680−:: +ff
2681−::
2682−:: this core has no use outside of the functionality
2683−:: provided to ++rd, ++rs, ++rq, and ++rh
2684−::
2685−:: w=width: bits in exponent field
2686−:: p=precision: bits in fraction field
2687−:: b=bias: added to exponent when storing
2688−:: r=rounding mode: same as in ++fl
2689−++ ff :: ieee 754 format fp
2690− |_ [[w=@u p=@u b=@s] r=$?(%n %u %d %z %a)]
2691− ::
2692− ++ sb (bex (^add w p)) :: sign bit
2693− ++ me (dif:si (dif:si --1 b) (sun:si p)) :: minimum exponent
2694− ::
2695− ++ pa
2696− %*(. fl p +(p), v me, w (^sub (bex w) 3), d %d, r r)
2697− ::
2698− ++ sea :: @r to fn
2699− |= [a=@r] ^- fn
2700− =+ [f=(cut 0 [0 p] a) e=(cut 0 [p w] a)]
2701− =+ s=(sig a)
2702− ?: =(e 0)
2703− ?: =(f 0) [%f s --0 0] [%f s me f]
2704− ?: =(e (fil 0 w 1))
2705− ?: =(f 0) [%i s] [%n ~]
2706− =+ q=:(sum:si (sun:si e) me -1)
2707− =+ r=(^add f (bex p))
2708− [%f s q r]
2709− ::
2710− ++ bit |= [a=fn] (bif (rou:pa a)) :: fn to @r w+ rounding
2711− ::
2712− ++ bif :: fn to @r no rounding
2713− |= [a=fn] ^- @r
2714− ?: ?=([%i *] a)
2715− =+ q=(lsh [0 p] (fil 0 w 1))
2716− ?: s.a q (^add q sb)
2717− ?: ?=([%n *] a) (lsh [0 (dec p)] (fil 0 +(w) 1))
2718− ?~ a.a ?: s.a `@r`0 sb
2719− =+ ma=(met 0 a.a)
2720− ?. =(ma +(p))
2721− ?> =(e.a me)
2722− ?> (^lth ma +(p))
2723− ?: s.a `@r`a.a (^add a.a sb)
2724− =+ q=(sum:si (dif:si e.a me) --1)
2725− =+ r=(^add (lsh [0 p] (abs:si q)) (end [0 p] a.a))
2726− ?: s.a r (^add r sb)
2727− ::
2728− ++ sig :: get sign
2729− |= [a=@r] ^- ?
2730− =(0 (cut 0 [(^add p w) 1] a))
2731− ::
2732− ++ exp :: get exponent
2733− |= [a=@r] ^- @s
2734− (dif:si (sun:si (cut 0 [p w] a)) b)
2735− ::
2736− ++ add :: add
2737− |= [a=@r b=@r]
2738− (bif (add:pa (sea a) (sea b)))
2739− ::
2740− ++ sub :: subtract
2741− |= [a=@r b=@r]
2742− (bif (sub:pa (sea a) (sea b)))
2743− ::
2744− ++ mul :: multiply
2745− |= [a=@r b=@r]
2746− (bif (mul:pa (sea a) (sea b)))
2747− ::
2748− ++ div :: divide
2749− |= [a=@r b=@r]
2750− (bif (div:pa (sea a) (sea b)))
2751− ::
2752− ++ fma :: fused multiply-add
2753− |= [a=@r b=@r c=@r]
2754− (bif (fma:pa (sea a) (sea b) (sea c)))
2755− ::
2756− ++ sqt :: square root
2757− |= [a=@r]
2758− (bif (sqt:pa (sea a)))
2759− ::
2760− ++ lth :: less-than
2761− |= [a=@r b=@r] (fall (lth:pa (sea a) (sea b)) |)
2762− ++ lte :: less-equals
2763− |= [a=@r b=@r] (fall (lte:pa (sea a) (sea b)) |)
2764− ++ equ :: equals
2765− |= [a=@r b=@r] (fall (equ:pa (sea a) (sea b)) |)
2766− ++ gte :: greater-equals
2767− |= [a=@r b=@r] (fall (gte:pa (sea a) (sea b)) |)
2768− ++ gth :: greater-than
2769− |= [a=@r b=@r] (fall (gth:pa (sea a) (sea b)) |)
2770− ++ sun :: uns integer to @r
2771− |= [a=@u] (bit [%f & --0 a])
2772− ++ san :: signed integer to @r
2773− |= [a=@s] (bit [%f (syn:si a) --0 (abs:si a)])
2774− ++ toi :: round to integer
2775− |= [a=@r] (toi:pa (sea a))
2776− ++ drg :: @r to decimal float
2777− |= [a=@r] (drg:pa (sea a))
2778− ++ grd :: decimal float to @r
2779− |= [a=dn] (bif (grd:pa a))
2780− --
2781−::
2782−++ rlyd |= a=@rd ^- dn (drg:rd a) :: prep @rd for print
2783−++ rlys |= a=@rs ^- dn (drg:rs a) :: prep @rs for print
2784−++ rlyh |= a=@rh ^- dn (drg:rh a) :: prep @rh for print
2785−++ rlyq |= a=@rq ^- dn (drg:rq a) :: prep @rq for print
2786−++ ryld |= a=dn ^- @rd (grd:rd a) :: finish parsing @rd
2787−++ ryls |= a=dn ^- @rs (grd:rs a) :: finish parsing @rs
2788−++ rylh |= a=dn ^- @rh (grd:rh a) :: finish parsing @rh
2789−++ rylq |= a=dn ^- @rq (grd:rq a) :: finish parsing @rq
2790−::
2791−++ rd :: double precision fp
2792− ^|
2793− ~% %rd +> ~
2794− |_ r=$?(%n %u %d %z)
2795− :: round to nearest, round up, round down, round to zero
2796− ::
2797− ++ ma
2798− %*(. ff w 11, p 52, b --1.023, r r)
2799− ::
2800− ++ sea :: @rd to fn
2801− |= [a=@rd] (sea:ma a)
2802− ::
2803− ++ bit :: fn to @rd
2804− |= [a=fn] ^- @rd (bit:ma a)
2805− ::
2806− ++ add ~/ %add :: add
2807− |= [a=@rd b=@rd] ^- @rd
2808− ~_ leaf+"rd-fail"
2809− (add:ma a b)
2810− ::
2811− ++ sub ~/ %sub :: subtract
2812− |= [a=@rd b=@rd] ^- @rd
2813− ~_ leaf+"rd-fail"
2814− (sub:ma a b)
2815− ::
2816− ++ mul ~/ %mul :: multiply
2817− |= [a=@rd b=@rd] ^- @rd
2818− ~_ leaf+"rd-fail"
2819− (mul:ma a b)
2820− ::
2821− ++ div ~/ %div :: divide
2822− |= [a=@rd b=@rd] ^- @rd
2823− ~_ leaf+"rd-fail"
2824− (div:ma a b)
2825− ::
2826− ++ fma ~/ %fma :: fused multiply-add
2827− |= [a=@rd b=@rd c=@rd] ^- @rd
2828− ~_ leaf+"rd-fail"
2829− (fma:ma a b c)
2830− ::
2831− ++ sqt ~/ %sqt :: square root
2832− |= [a=@rd] ^- @rd ~_ leaf+"rd-fail"
2833− (sqt:ma a)
2834− ::
2835− ++ lth ~/ %lth :: less-than
2836− |= [a=@rd b=@rd]
2837− ~_ leaf+"rd-fail"
2838− (lth:ma a b)
2839− ::
2840− ++ lte ~/ %lte :: less-equals
2841− |= [a=@rd b=@rd]
2842− ~_ leaf+"rd-fail"
2843− (lte:ma a b)
2844− ::
2845− ++ equ ~/ %equ :: equals
2846− |= [a=@rd b=@rd]
2847− ~_ leaf+"rd-fail"
2848− (equ:ma a b)
2849− ::
2850− ++ gte ~/ %gte :: greater-equals
2851− |= [a=@rd b=@rd]
2852− ~_ leaf+"rd-fail"
2853− (gte:ma a b)
2854− ::
2855− ++ gth ~/ %gth :: greater-than
2856− |= [a=@rd b=@rd]
2857− ~_ leaf+"rd-fail"
2858− (gth:ma a b)
2859− ::
2860− ++ sun |= [a=@u] ^- @rd (sun:ma a) :: uns integer to @rd
2861− ++ san |= [a=@s] ^- @rd (san:ma a) :: sgn integer to @rd
2862− ++ sig |= [a=@rd] ^- ? (sig:ma a) :: get sign
2863− ++ exp |= [a=@rd] ^- @s (exp:ma a) :: get exponent
2864− ++ toi |= [a=@rd] ^- (unit @s) (toi:ma a) :: round to integer
2865− ++ drg |= [a=@rd] ^- dn (drg:ma a) :: @rd to decimal float
2866− ++ grd |= [a=dn] ^- @rd (grd:ma a) :: decimal float to @rd
2867− --
2868−::
2869−++ rs :: single precision fp
2870− ~% %rs +> ~
2871− ^|
2872− :: round to nearest, round up, round down, round to zero
2873− |_ r=$?(%n %u %d %z)
2874− ::
2875− ++ ma
2876− %*(. ff w 8, p 23, b --127, r r)
2877− ::
2878− ++ sea :: @rs to fn
2879− |= [a=@rs] (sea:ma a)
2880− ::
2881− ++ bit :: fn to @rs
2882− |= [a=fn] ^- @rs (bit:ma a)
2883− ::
2884− ++ add ~/ %add :: add
2885− |= [a=@rs b=@rs] ^- @rs
2886− ~_ leaf+"rs-fail"
2887− (add:ma a b)
2888− ::
2889− ++ sub ~/ %sub :: subtract
2890− |= [a=@rs b=@rs] ^- @rs
2891− ~_ leaf+"rs-fail"
2892− (sub:ma a b)
2893− ::
2894− ++ mul ~/ %mul :: multiply
2895− |= [a=@rs b=@rs] ^- @rs
2896− ~_ leaf+"rs-fail"
2897− (mul:ma a b)
2898− ::
2899− ++ div ~/ %div :: divide
2900− |= [a=@rs b=@rs] ^- @rs
2901− ~_ leaf+"rs-fail"
2902− (div:ma a b)
2903− ::
2904− ++ fma ~/ %fma :: fused multiply-add
2905− |= [a=@rs b=@rs c=@rs] ^- @rs
2906− ~_ leaf+"rs-fail"
2907− (fma:ma a b c)
2908− ::
2909− ++ sqt ~/ %sqt :: square root
2910− |= [a=@rs] ^- @rs
2911− ~_ leaf+"rs-fail"
2912− (sqt:ma a)
2913− ::
2914− ++ lth ~/ %lth :: less-than
2915− |= [a=@rs b=@rs]
2916− ~_ leaf+"rs-fail"
2917− (lth:ma a b)
2918− ::
2919− ++ lte ~/ %lte :: less-equals
2920− |= [a=@rs b=@rs]
2921− ~_ leaf+"rs-fail"
2922− (lte:ma a b)
2923− ::
2924− ++ equ ~/ %equ :: equals
2925− |= [a=@rs b=@rs]
2926− ~_ leaf+"rs-fail"
2927− (equ:ma a b)
2928− ::
2929− ++ gte ~/ %gte :: greater-equals
2930− |= [a=@rs b=@rs]
2931− ~_ leaf+"rs-fail"
2932− (gte:ma a b)
2933− ::
2934− ++ gth ~/ %gth :: greater-than
2935− |= [a=@rs b=@rs]
2936− ~_ leaf+"rs-fail"
2937− (gth:ma a b)
2938− ::
2939− ++ sun |= [a=@u] ^- @rs (sun:ma a) :: uns integer to @rs
2940− ++ san |= [a=@s] ^- @rs (san:ma a) :: sgn integer to @rs
2941− ++ sig |= [a=@rs] ^- ? (sig:ma a) :: get sign
2942− ++ exp |= [a=@rs] ^- @s (exp:ma a) :: get exponent
2943− ++ toi |= [a=@rs] ^- (unit @s) (toi:ma a) :: round to integer
2944− ++ drg |= [a=@rs] ^- dn (drg:ma a) :: @rs to decimal float
2945− ++ grd |= [a=dn] ^- @rs (grd:ma a) :: decimal float to @rs
2946− --
2947−::
2948−++ rq :: quad precision fp
2949− ~% %rq +> ~
2950− ^|
2951− :: round to nearest, round up, round down, round to zero
2952− |_ r=$?(%n %u %d %z)
2953− ::
2954− ++ ma
2955− %*(. ff w 15, p 112, b --16.383, r r)
2956− ::
2957− ++ sea :: @rq to fn
2958− |= [a=@rq] (sea:ma a)
2959− ::
2960− ++ bit :: fn to @rq
2961− |= [a=fn] ^- @rq (bit:ma a)
2962− ::
2963− ++ add ~/ %add :: add
2964− |= [a=@rq b=@rq] ^- @rq
2965− ~_ leaf+"rq-fail"
2966− (add:ma a b)
2967− ::
2968− ++ sub ~/ %sub :: subtract
2969− |= [a=@rq b=@rq] ^- @rq
2970− ~_ leaf+"rq-fail"
2971− (sub:ma a b)
2972− ::
2973− ++ mul ~/ %mul :: multiply
2974− |= [a=@rq b=@rq] ^- @rq
2975− ~_ leaf+"rq-fail"
2976− (mul:ma a b)
2977− ::
2978− ++ div ~/ %div :: divide
2979− |= [a=@rq b=@rq] ^- @rq
2980− ~_ leaf+"rq-fail"
2981− (div:ma a b)
2982− ::
2983− ++ fma ~/ %fma :: fused multiply-add
2984− |= [a=@rq b=@rq c=@rq] ^- @rq
2985− ~_ leaf+"rq-fail"
2986− (fma:ma a b c)
2987− ::
2988− ++ sqt ~/ %sqt :: square root
2989− |= [a=@rq] ^- @rq
2990− ~_ leaf+"rq-fail"
2991− (sqt:ma a)
2992− ::
2993− ++ lth ~/ %lth :: less-than
2994− |= [a=@rq b=@rq]
2995− ~_ leaf+"rq-fail"
2996− (lth:ma a b)
2997− ::
2998− ++ lte ~/ %lte :: less-equals
2999− |= [a=@rq b=@rq]
3000− ~_ leaf+"rq-fail"
3001− (lte:ma a b)
3002− ::
3003− ++ equ ~/ %equ :: equals
3004− |= [a=@rq b=@rq]
3005− ~_ leaf+"rq-fail"
3006− (equ:ma a b)
3007− ::
3008− ++ gte ~/ %gte :: greater-equals
3009− |= [a=@rq b=@rq]
3010− ~_ leaf+"rq-fail"
3011− (gte:ma a b)
3012− ::
3013− ++ gth ~/ %gth :: greater-than
3014− |= [a=@rq b=@rq]
3015− ~_ leaf+"rq-fail"
3016− (gth:ma a b)
3017− ::
3018− ++ sun |= [a=@u] ^- @rq (sun:ma a) :: uns integer to @rq
3019− ++ san |= [a=@s] ^- @rq (san:ma a) :: sgn integer to @rq
3020− ++ sig |= [a=@rq] ^- ? (sig:ma a) :: get sign
3021− ++ exp |= [a=@rq] ^- @s (exp:ma a) :: get exponent
3022− ++ toi |= [a=@rq] ^- (unit @s) (toi:ma a) :: round to integer
3023− ++ drg |= [a=@rq] ^- dn (drg:ma a) :: @rq to decimal float
3024− ++ grd |= [a=dn] ^- @rq (grd:ma a) :: decimal float to @rq
3025− --
3026−::
3027−++ rh :: half precision fp
3028− ~% %rh +> ~
3029− ^|
3030− :: round to nearest, round up, round down, round to zero
3031− |_ r=$?(%n %u %d %z)
3032− ::
3033− ++ ma
3034− %*(. ff w 5, p 10, b --15, r r)
3035− ::
3036− ++ sea :: @rh to fn
3037− |= [a=@rh] (sea:ma a)
3038− ::
3039− ++ bit :: fn to @rh
3040− |= [a=fn] ^- @rh (bit:ma a)
3041− ::
3042− ++ add ~/ %add :: add
3043− |= [a=@rh b=@rh] ^- @rh
3044− ~_ leaf+"rh-fail"
3045− (add:ma a b)
3046− ::
3047− ++ sub ~/ %sub :: subtract
3048− |= [a=@rh b=@rh] ^- @rh
3049− ~_ leaf+"rh-fail"
3050− (sub:ma a b)
3051− ::
3052− ++ mul ~/ %mul :: multiply
3053− |= [a=@rh b=@rh] ^- @rh
3054− ~_ leaf+"rh-fail"
3055− (mul:ma a b)
3056− ::
3057− ++ div ~/ %div :: divide
3058− |= [a=@rh b=@rh] ^- @rh
3059− ~_ leaf+"rh-fail"
3060− (div:ma a b)
3061− ::
3062− ++ fma ~/ %fma :: fused multiply-add
3063− |= [a=@rh b=@rh c=@rh] ^- @rh
3064− ~_ leaf+"rh-fail"
3065− (fma:ma a b c)
3066− ::
3067− ++ sqt ~/ %sqt :: square root
3068− |= [a=@rh] ^- @rh
3069− ~_ leaf+"rh-fail"
3070− (sqt:ma a)
3071− ::
3072− ++ lth ~/ %lth :: less-than
3073− |= [a=@rh b=@rh]
3074− ~_ leaf+"rh-fail"
3075− (lth:ma a b)
3076− ::
3077− ++ lte ~/ %lte :: less-equals
3078− |= [a=@rh b=@rh]
3079− ~_ leaf+"rh-fail"
3080− (lte:ma a b)
3081− ::
3082− ++ equ ~/ %equ :: equals
3083− |= [a=@rh b=@rh]
3084− ~_ leaf+"rh-fail"
3085− (equ:ma a b)
3086− ::
3087− ++ gte ~/ %gte :: greater-equals
3088− |= [a=@rh b=@rh]
3089− ~_ leaf+"rh-fail"
3090− (gte:ma a b)
3091− ::
3092− ++ gth ~/ %gth :: greater-than
3093− |= [a=@rh b=@rh]
3094− ~_ leaf+"rh-fail"
3095− (gth:ma a b)
3096− ::
3097− ++ tos :: @rh to @rs
3098− |= [a=@rh] (bit:rs (sea a))
3099− ::
3100− ++ fos :: @rs to @rh
3101− |= [a=@rs] (bit (sea:rs a))
3102− ::
3103− ++ sun |= [a=@u] ^- @rh (sun:ma a) :: uns integer to @rh
3104− ++ san |= [a=@s] ^- @rh (san:ma a) :: sgn integer to @rh
3105− ++ sig |= [a=@rh] ^- ? (sig:ma a) :: get sign
3106− ++ exp |= [a=@rh] ^- @s (exp:ma a) :: get exponent
3107− ++ toi |= [a=@rh] ^- (unit @s) (toi:ma a) :: round to integer
3108− ++ drg |= [a=@rh] ^- dn (drg:ma a) :: @rh to decimal float
3109− ++ grd |= [a=dn] ^- @rh (grd:ma a) :: decimal float to @rh
3110− --
3111−::
3112−:: 3c: urbit time
3113−+| %urbit-time
3114−::
3115−++ year :: date to @d
3116− |= det=date
3117− ^- @da
3118− =+ ^= yer
3119− ?: a.det
3120− (add 292.277.024.400 y.det)
3121− (sub 292.277.024.400 (dec y.det))
3122− =+ day=(yawn yer m.det d.t.det)
3123− (yule day h.t.det m.t.det s.t.det f.t.det)
3124−::
3125−++ yore :: @d to date
3126− |= now=@da
3127− ^- date
3128− =+ rip=(yell now)
3129− =+ ger=(yall d.rip)
3130− :- ?: (gth y.ger 292.277.024.400)
3131− [a=& y=(sub y.ger 292.277.024.400)]
3132− [a=| y=+((sub 292.277.024.400 y.ger))]
3133− [m.ger d.ger h.rip m.rip s.rip f.rip]
3134−::
3135−++ yell :: tarp from @d
3136− |= now=@d
3137− ^- tarp
3138− =+ sec=(rsh 6 now)
3139− =+ ^= fan
3140− =+ [muc=4 raw=(end 6 now)]
3141− |- ^- (list @ux)
3142− ?: |(=(0 raw) =(0 muc))
3143− ~
3144− => .(muc (dec muc))
3145− [(cut 4 [muc 1] raw) $(raw (end [4 muc] raw))]
3146− =+ day=(div sec day:yo)
3147− => .(sec (mod sec day:yo))
3148− =+ hor=(div sec hor:yo)
3149− => .(sec (mod sec hor:yo))
3150− =+ mit=(div sec mit:yo)
3151− => .(sec (mod sec mit:yo))
3152− [day hor mit sec fan]
3153−::
3154−++ yule :: time atom
3155− |= rip=tarp
3156− ^- @d
3157− =+ ^= sec ;: add
3158− (mul d.rip day:yo)
3159− (mul h.rip hor:yo)
3160− (mul m.rip mit:yo)
3161− s.rip
3162− ==
3163− =+ ^= fac =+ muc=4
3164− |- ^- @
3165− ?~ f.rip
3166− 0
3167− => .(muc (dec muc))
3168− (add (lsh [4 muc] i.f.rip) $(f.rip t.f.rip))
3169− (con (lsh 6 sec) fac)
3170−::
3171−++ yall :: day / to day of year
3172− |= day=@ud
3173− ^- [y=@ud m=@ud d=@ud]
3174− =+ [era=0 cet=0 lep=*?]
3175− => .(era (div day era:yo), day (mod day era:yo))
3176− => ^+ .
3177− ?: (lth day +(cet:yo))
3178− .(lep &, cet 0)
3179− => .(lep |, cet 1, day (sub day +(cet:yo)))
3180− .(cet (add cet (div day cet:yo)), day (mod day cet:yo))
3181− =+ yer=(add (mul 400 era) (mul 100 cet))
3182− |- ^- [y=@ud m=@ud d=@ud]
3183− =+ dis=?:(lep 366 365)
3184− ?. (lth day dis)
3185− =+ ner=+(yer)
3186− $(yer ner, day (sub day dis), lep =(0 (end [0 2] ner)))
3187− |- ^- [y=@ud m=@ud d=@ud]
3188− =+ [mot=0 cah=?:(lep moy:yo moh:yo)]
3189− |- ^- [y=@ud m=@ud d=@ud]
3190− =+ zis=(snag mot cah)
3191− ?: (lth day zis)
3192− [yer +(mot) +(day)]
3193− $(mot +(mot), day (sub day zis))
3194−::
3195−++ yawn :: days since Jesus
3196− |= [yer=@ud mot=@ud day=@ud]
3197− ^- @ud
3198− => .(mot (dec mot), day (dec day))
3199− => ^+ .
3200− %= .
3201− day
3202− =+ cah=?:((yelp yer) moy:yo moh:yo)
3203− |- ^- @ud
3204− ?: =(0 mot)
3205− day
3206− $(mot (dec mot), cah (slag 1 cah), day (add day (snag 0 cah)))
3207− ==
3208− |- ^- @ud
3209− ?. =(0 (mod yer 4))
3210− =+ ney=(dec yer)
3211− $(yer ney, day (add day ?:((yelp ney) 366 365)))
3212− ?. =(0 (mod yer 100))
3213− =+ nef=(sub yer 4)
3214− $(yer nef, day (add day ?:((yelp nef) 1.461 1.460)))
3215− ?. =(0 (mod yer 400))
3216− =+ nec=(sub yer 100)
3217− $(yer nec, day (add day ?:((yelp nec) 36.525 36.524)))
3218− (add day (mul (div yer 400) (add 1 (mul 4 36.524))))
3219−::
3220−++ yelp :: leap year
3221− |= yer=@ud ^- ?
3222− &(=(0 (mod yer 4)) |(!=(0 (mod yer 100)) =(0 (mod yer 400))))
3223−::
3224−++ yo :: time constants
3225− |% ++ cet 36.524 :: (add 24 (mul 100 365))
3226− ++ day 86.400 :: (mul 24 hor)
3227− ++ era 146.097 :: (add 1 (mul 4 cet))
3228− ++ hor 3.600 :: (mul 60 mit)
3229− ++ jes 106.751.991.084.417 :: (mul 730.692.561 era)
3230− ++ mit 60
3231− ++ moh `(list @ud)`[31 28 31 30 31 30 31 31 30 31 30 31 ~]
3232− ++ moy `(list @ud)`[31 29 31 30 31 30 31 31 30 31 30 31 ~]
3233− ++ qad 126.144.001 :: (add 1 (mul 4 yer))
3234− ++ yer 31.536.000 :: (mul 365 day)
3235− --
3236−::
3237−:: 3d: SHA hash family
3238−+| %sha-hash-family
3239−::
3240−++ shad |=(ruz=@ (shax (shax ruz))) :: double sha-256
3241−++ shaf :: half sha-256
3242− |= [sal=@ ruz=@]
3243− =+ haz=(shas sal ruz)
3244− (mix (end 7 haz) (rsh 7 haz))
3245−::
3246−++ sham :: 128bit noun hash
3247− |= yux=* ^- @uvH ^- @
3248− ?@ yux
3249− (shaf %mash yux)
3250− (shaf %sham (jam yux))
3251−::
3252−++ shas :: salted hash
3253− ~/ %shas
3254− |= [sal=@ ruz=@]
3255− (shax (mix sal (shax ruz)))
3256−::
3257−++ shax :: sha-256
3258− ~/ %shax
3259− |= ruz=@ ^- @
3260− (shay [(met 3 ruz) ruz])
3261−::
3262−++ shay :: sha-256 with length
3263− ~/ %shay
3264− |= [len=@u ruz=@] ^- @
3265− => .(ruz (cut 3 [0 len] ruz))
3266− =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
3267− =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
3268− =+ ral=(lsh [0 3] len)
3269− =+ ^= ful
3270− %+ can 0
3271− :~ [ral ruz]
3272− [8 128]
3273− [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
3274− [64 (~(net fe 6) ral)]
3275− ==
3276− =+ lex=(met 9 ful)
3277− =+ ^= kbx 0xc671.78f2.bef9.a3f7.a450.6ceb.90be.fffa.
3278− 8cc7.0208.84c8.7814.78a5.636f.748f.82ee.
3279− 682e.6ff3.5b9c.ca4f.4ed8.aa4a.391c.0cb3.
3280− 34b0.bcb5.2748.774c.1e37.6c08.19a4.c116.
3281− 106a.a070.f40e.3585.d699.0624.d192.e819.
3282− c76c.51a3.c24b.8b70.a81a.664b.a2bf.e8a1.
3283− 9272.2c85.81c2.c92e.766a.0abb.650a.7354.
3284− 5338.0d13.4d2c.6dfc.2e1b.2138.27b7.0a85.
3285− 1429.2967.06ca.6351.d5a7.9147.c6e0.0bf3.
3286− bf59.7fc7.b003.27c8.a831.c66d.983e.5152.
3287− 76f9.88da.5cb0.a9dc.4a74.84aa.2de9.2c6f.
3288− 240c.a1cc.0fc1.9dc6.efbe.4786.e49b.69c1.
3289− c19b.f174.9bdc.06a7.80de.b1fe.72be.5d74.
3290− 550c.7dc3.2431.85be.1283.5b01.d807.aa98.
3291− ab1c.5ed5.923f.82a4.59f1.11f1.3956.c25b.
3292− e9b5.dba5.b5c0.fbcf.7137.4491.428a.2f98
3293− =+ ^= hax 0x5be0.cd19.1f83.d9ab.9b05.688c.510e.527f.
3294− a54f.f53a.3c6e.f372.bb67.ae85.6a09.e667
3295− =+ i=0
3296− |- ^- @
3297− ?: =(i lex)
3298− (run 5 hax net)
3299− =+ ^= wox
3300− =+ dux=(cut 9 [i 1] ful)
3301− =+ wox=(run 5 dux net)
3302− =+ j=16
3303− |- ^- @
3304− ?: =(64 j)
3305− wox
3306− =+ :* l=(wac (sub j 15) wox)
3307− m=(wac (sub j 2) wox)
3308− n=(wac (sub j 16) wox)
3309− o=(wac (sub j 7) wox)
3310− ==
3311− =+ x=:(mix (ror 0 7 l) (ror 0 18 l) (rsh [0 3] l))
3312− =+ y=:(mix (ror 0 17 m) (ror 0 19 m) (rsh [0 10] m))
3313− =+ z=:(sum n x o y)
3314− $(wox (con (lsh [5 j] z) wox), j +(j))
3315− =+ j=0
3316− =+ :* a=(wac 0 hax)
3317− b=(wac 1 hax)
3318− c=(wac 2 hax)
3319− d=(wac 3 hax)
3320− e=(wac 4 hax)
3321− f=(wac 5 hax)
3322− g=(wac 6 hax)
3323− h=(wac 7 hax)
3324− ==
3325− |- ^- @
3326− ?: =(64 j)
3327− %= ^$
3328− i +(i)
3329− hax %+ rep 5
3330− :~ (sum a (wac 0 hax))
3331− (sum b (wac 1 hax))
3332− (sum c (wac 2 hax))
3333− (sum d (wac 3 hax))
3334− (sum e (wac 4 hax))
3335− (sum f (wac 5 hax))
3336− (sum g (wac 6 hax))
3337− (sum h (wac 7 hax))
3338− ==
3339− ==
3340− =+ l=:(mix (ror 0 2 a) (ror 0 13 a) (ror 0 22 a)) :: s0
3341− =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj
3342− =+ n=(sum l m) :: t2
3343− =+ o=:(mix (ror 0 6 e) (ror 0 11 e) (ror 0 25 e)) :: s1
3344− =+ p=(mix (dis e f) (dis (inv e) g)) :: ch
3345− =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1
3346− $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g)
3347−::
3348−++ shaw :: hash to nbits
3349− |= [sal=@ len=@ ruz=@]
3350− (~(raw og (shas sal (mix len ruz))) len)
3351−::
3352−++ shaz :: sha-512
3353− |= ruz=@ ^- @
3354− (shal [(met 3 ruz) ruz])
3355−::
3356−++ shal :: sha-512 with length
3357− ~/ %shal
3358− |= [len=@ ruz=@] ^- @
3359− => .(ruz (cut 3 [0 len] ruz))
3360− =+ [few==>(fe .(a 6)) wac=|=([a=@ b=@] (cut 6 [a 1] b))]
3361− =+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
3362− =+ ral=(lsh [0 3] len)
3363− =+ ^= ful
3364− %+ can 0
3365− :~ [ral ruz]
3366− [8 128]
3367− [(mod (sub 1.920 (mod (add 8 ral) 1.024)) 1.024) 0]
3368− [128 (~(net fe 7) ral)]
3369− ==
3370− =+ lex=(met 10 ful)
3371− =+ ^= kbx 0x6c44.198c.4a47.5817.5fcb.6fab.3ad6.faec.
3372− 597f.299c.fc65.7e2a.4cc5.d4be.cb3e.42b6.
3373− 431d.67c4.9c10.0d4c.3c9e.be0a.15c9.bebc.
3374− 32ca.ab7b.40c7.2493.28db.77f5.2304.7d84.
3375− 1b71.0b35.131c.471b.113f.9804.bef9.0dae.
3376− 0a63.7dc5.a2c8.98a6.06f0.67aa.7217.6fba.
3377− f57d.4f7f.ee6e.d178.eada.7dd6.cde0.eb1e.
3378− d186.b8c7.21c0.c207.ca27.3ece.ea26.619c.
3379− c671.78f2.e372.532b.bef9.a3f7.b2c6.7915.
3380− a450.6ceb.de82.bde9.90be.fffa.2363.1e28.
3381− 8cc7.0208.1a64.39ec.84c8.7814.a1f0.ab72.
3382− 78a5.636f.4317.2f60.748f.82ee.5def.b2fc.
3383− 682e.6ff3.d6b2.b8a3.5b9c.ca4f.7763.e373.
3384− 4ed8.aa4a.e341.8acb.391c.0cb3.c5c9.5a63.
3385− 34b0.bcb5.e19b.48a8.2748.774c.df8e.eb99.
3386− 1e37.6c08.5141.ab53.19a4.c116.b8d2.d0c8.
3387− 106a.a070.32bb.d1b8.f40e.3585.5771.202a.
3388− d699.0624.5565.a910.d192.e819.d6ef.5218.
3389− c76c.51a3.0654.be30.c24b.8b70.d0f8.9791.
3390− a81a.664b.bc42.3001.a2bf.e8a1.4cf1.0364.
3391− 9272.2c85.1482.353b.81c2.c92e.47ed.aee6.
3392− 766a.0abb.3c77.b2a8.650a.7354.8baf.63de.
3393− 5338.0d13.9d95.b3df.4d2c.6dfc.5ac4.2aed.
3394− 2e1b.2138.5c26.c926.27b7.0a85.46d2.2ffc.
3395− 1429.2967.0a0e.6e70.06ca.6351.e003.826f.
3396− d5a7.9147.930a.a725.c6e0.0bf3.3da8.8fc2.
3397− bf59.7fc7.beef.0ee4.b003.27c8.98fb.213f.
3398− a831.c66d.2db4.3210.983e.5152.ee66.dfab.
3399− 76f9.88da.8311.53b5.5cb0.a9dc.bd41.fbd4.
3400− 4a74.84aa.6ea6.e483.2de9.2c6f.592b.0275.
3401− 240c.a1cc.77ac.9c65.0fc1.9dc6.8b8c.d5b5.
3402− efbe.4786.384f.25e3.e49b.69c1.9ef1.4ad2.
3403− c19b.f174.cf69.2694.9bdc.06a7.25c7.1235.
3404− 80de.b1fe.3b16.96b1.72be.5d74.f27b.896f.
3405− 550c.7dc3.d5ff.b4e2.2431.85be.4ee4.b28c.
3406− 1283.5b01.4570.6fbe.d807.aa98.a303.0242.
3407− ab1c.5ed5.da6d.8118.923f.82a4.af19.4f9b.
3408− 59f1.11f1.b605.d019.3956.c25b.f348.b538.
3409− e9b5.dba5.8189.dbbc.b5c0.fbcf.ec4d.3b2f.
3410− 7137.4491.23ef.65cd.428a.2f98.d728.ae22
3411− =+ ^= hax 0x5be0.cd19.137e.2179.1f83.d9ab.fb41.bd6b.
3412− 9b05.688c.2b3e.6c1f.510e.527f.ade6.82d1.
3413− a54f.f53a.5f1d.36f1.3c6e.f372.fe94.f82b.
3414− bb67.ae85.84ca.a73b.6a09.e667.f3bc.c908
3415− =+ i=0
3416− |- ^- @
3417− ?: =(i lex)
3418− (run 6 hax net)
3419− =+ ^= wox
3420− =+ dux=(cut 10 [i 1] ful)
3421− =+ wox=(run 6 dux net)
3422− =+ j=16
3423− |- ^- @
3424− ?: =(80 j)
3425− wox
3426− =+ :* l=(wac (sub j 15) wox)
3427− m=(wac (sub j 2) wox)
3428− n=(wac (sub j 16) wox)
3429− o=(wac (sub j 7) wox)
3430− ==
3431− =+ x=:(mix (ror 0 1 l) (ror 0 8 l) (rsh [0 7] l))
3432− =+ y=:(mix (ror 0 19 m) (ror 0 61 m) (rsh [0 6] m))
3433− =+ z=:(sum n x o y)
3434− $(wox (con (lsh [6 j] z) wox), j +(j))
3435− =+ j=0
3436− =+ :* a=(wac 0 hax)
3437− b=(wac 1 hax)
3438− c=(wac 2 hax)
3439− d=(wac 3 hax)
3440− e=(wac 4 hax)
3441− f=(wac 5 hax)
3442− g=(wac 6 hax)
3443− h=(wac 7 hax)
3444− ==
3445− |- ^- @
3446− ?: =(80 j)
3447− %= ^$
3448− i +(i)
3449− hax %+ rep 6
3450− :~ (sum a (wac 0 hax))
3451− (sum b (wac 1 hax))
3452− (sum c (wac 2 hax))
3453− (sum d (wac 3 hax))
3454− (sum e (wac 4 hax))
3455− (sum f (wac 5 hax))
3456− (sum g (wac 6 hax))
3457− (sum h (wac 7 hax))
3458− ==
3459− ==
3460− =+ l=:(mix (ror 0 28 a) (ror 0 34 a) (ror 0 39 a)) :: S0
3461− =+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj
3462− =+ n=(sum l m) :: t2
3463− =+ o=:(mix (ror 0 14 e) (ror 0 18 e) (ror 0 41 e)) :: S1
3464− =+ p=(mix (dis e f) (dis (inv e) g)) :: ch
3465− =+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1
3466− $(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g)
3467−::
3468−++ shan :: sha-1 (deprecated)
3469− |= ruz=@
3470− =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
3471− =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
3472− =+ ral=(lsh [0 3] (met 3 ruz))
3473− =+ ^= ful
3474− %+ can 0
3475− :~ [ral ruz]
3476− [8 128]
3477− [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
3478− [64 (~(net fe 6) ral)]
3479− ==
3480− =+ lex=(met 9 ful)
3481− =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999
3482− =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301
3483− =+ i=0
3484− |-
3485− ?: =(i lex)
3486− (rep 5 (flop (rip 5 hax)))
3487− =+ ^= wox
3488− =+ dux=(cut 9 [i 1] ful)
3489− =+ wox=(rep 5 (turn (rip 5 dux) net))
3490− =+ j=16
3491− |- ^- @
3492− ?: =(80 j)
3493− wox
3494− =+ :* l=(wac (sub j 3) wox)
3495− m=(wac (sub j 8) wox)
3496− n=(wac (sub j 14) wox)
3497− o=(wac (sub j 16) wox)
3498− ==
3499− =+ z=(rol 0 1 :(mix l m n o))
3500− $(wox (con (lsh [5 j] z) wox), j +(j))
3501− =+ j=0
3502− =+ :* a=(wac 0 hax)
3503− b=(wac 1 hax)
3504− c=(wac 2 hax)
3505− d=(wac 3 hax)
3506− e=(wac 4 hax)
3507− ==
3508− |- ^- @
3509− ?: =(80 j)
3510− %= ^$
3511− i +(i)
3512− hax %+ rep 5
3513− :~
3514− (sum a (wac 0 hax))
3515− (sum b (wac 1 hax))
3516− (sum c (wac 2 hax))
3517− (sum d (wac 3 hax))
3518− (sum e (wac 4 hax))
3519− ==
3520− ==
3521− =+ fx=(con (dis b c) (dis (not 5 1 b) d))
3522− =+ fy=:(mix b c d)
3523− =+ fz=:(con (dis b c) (dis b d) (dis c d))
3524− =+ ^= tem
3525− ?: &((gte j 0) (lte j 19))
3526− :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox))
3527− ?: &((gte j 20) (lte j 39))
3528− :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox))
3529− ?: &((gte j 40) (lte j 59))
3530− :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox))
3531− :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox))
3532− $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d)
3533−::
3534−++ og :: shax-powered rng
3535− ~/ %og
3536− |_ a=@
3537− ++ rad :: random in range
3538− |= b=@ ^- @
3539− ~_ leaf+"rad-zero"
3540− ?< =(0 b)
3541− =+ c=(raw (met 0 b))
3542− ?:((lth c b) c $(a +(a)))
3543− ::
3544− ++ rads :: random continuation
3545− |= b=@
3546− =+ r=(rad b)
3547− [r +>.$(a (shas %og-s (mix a r)))]
3548− ::
3549− ++ raw :: random bits
3550− ~/ %raw
3551− |= b=@ ^- @
3552− %+ can
3553− 0
3554− =+ c=(shas %og-a (mix b a))
3555− |- ^- (list [@ @])
3556− ?: =(0 b)
3557− ~
3558− =+ d=(shas %og-b (mix b (mix a c)))
3559− ?: (lth b 256)
3560− [[b (end [0 b] d)] ~]
3561− [[256 d] $(c d, b (sub b 256))]
3562− ::
3563− ++ raws :: random bits
3564− |= b=@ :: continuation
3565− =+ r=(raw b)
3566− [r +>.$(a (shas %og-s (mix a r)))]
3567− --
3568−::
3569−++ sha :: correct byte-order
3570− ~% %sha ..sha ~
3571− => |%
3572− ++ flin |=(a=@ (swp 3 a)) :: flip input
3573− ++ flim |=(byts [wid (rev 3 wid dat)]) :: flip input w= length
3574− ++ flip |=(w=@u (cury (cury rev 3) w)) :: flip output of size
3575− ++ meet |=(a=@ [(met 3 a) a]) :: measure input size
3576− --
3577− |%
3578− ::
3579− :: use with @
3580− ::
3581− ++ sha-1 (cork meet sha-1l)
3582− ++ sha-256 :(cork flin shax (flip 32))
3583− ++ sha-512 :(cork flin shaz (flip 64))
3584− ::
3585− :: use with byts
3586− ::
3587− ++ sha-256l :(cork flim shay (flip 32))
3588− ++ sha-512l :(cork flim shal (flip 64))
3589− ::
3590− ++ sha-1l
3591− ~/ %sha1
3592− |= byts
3593− ^- @
3594− =+ [few==>(fe .(a 5)) wac=|=([a=@ b=@] (cut 5 [a 1] b))]
3595− =+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
3596− =+ ral=(lsh [0 3] wid)
3597− =+ ^= ful
3598− %+ can 0
3599− :~ [ral (rev 3 wid dat)]
3600− [8 128]
3601− [(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
3602− [64 (~(net fe 6) ral)]
3603− ==
3604− =+ lex=(met 9 ful)
3605− =+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999
3606− =+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301
3607− =+ i=0
3608− |-
3609− ?: =(i lex)
3610− (rep 5 (flop (rip 5 hax)))
3611− =+ ^= wox
3612− =+ dux=(cut 9 [i 1] ful)
3613− =+ wox=(rep 5 (turn (rip 5 dux) net))
3614− =+ j=16
3615− |- ^- @
3616− ?: =(80 j)
3617− wox
3618− =+ :* l=(wac (sub j 3) wox)
3619− m=(wac (sub j 8) wox)
3620− n=(wac (sub j 14) wox)
3621− o=(wac (sub j 16) wox)
3622− ==
3623− =+ z=(rol 0 1 :(mix l m n o))
3624− $(wox (con (lsh [5 j] z) wox), j +(j))
3625− =+ j=0
3626− =+ :* a=(wac 0 hax)
3627− b=(wac 1 hax)
3628− c=(wac 2 hax)
3629− d=(wac 3 hax)
3630− e=(wac 4 hax)
3631− ==
3632− |- ^- @
3633− ?: =(80 j)
3634− %= ^$
3635− i +(i)
3636− hax %+ rep 5
3637− :~
3638− (sum a (wac 0 hax))
3639− (sum b (wac 1 hax))
3640− (sum c (wac 2 hax))
3641− (sum d (wac 3 hax))
3642− (sum e (wac 4 hax))
3643− ==
3644− ==
3645− =+ fx=(con (dis b c) (dis (not 5 1 b) d))
3646− =+ fy=:(mix b c d)
3647− =+ fz=:(con (dis b c) (dis b d) (dis c d))
3648− =+ ^= tem
3649− ?: &((gte j 0) (lte j 19))
3650− :(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox))
3651− ?: &((gte j 20) (lte j 39))
3652− :(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox))
3653− ?: &((gte j 40) (lte j 59))
3654− :(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox))
3655− :(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox))
3656− $(j +(j), a tem, b a, c (rol 0 30 b), d c, e d)
3657− --
3658−:: 3f: scrambling
3659−+| %scrambling
3660−::
3661−++ un :: =(x (wred (wren x)))
3662− |%
3663− ++ wren :: conceal structure
3664− |= pyn=@ ^- @
3665− =+ len=(met 3 pyn)
3666− ?: =(0 len)
3667− 0
3668− => .(len (dec len))
3669− =+ mig=(zaft (xafo len (cut 3 [len 1] pyn)))
3670− %+ can 3
3671− %- flop ^- (list [@ @])
3672− :- [1 mig]
3673− |- ^- (list [@ @])
3674− ?: =(0 len)
3675− ~
3676− => .(len (dec len))
3677− =+ mog=(zyft :(mix mig (end 3 len) (cut 3 [len 1] pyn)))
3678− [[1 mog] $(mig mog)]
3679− ::
3680− ++ wred :: restore structure
3681− |= cry=@ ^- @
3682− =+ len=(met 3 cry)
3683− ?: =(0 len)
3684− 0
3685− => .(len (dec len))
3686− =+ mig=(cut 3 [len 1] cry)
3687− %+ can 3
3688− %- flop ^- (list [@ @])
3689− :- [1 (xaro len (zart mig))]
3690− |- ^- (list [@ @])
3691− ?: =(0 len)
3692− ~
3693− => .(len (dec len))
3694− =+ mog=(cut 3 [len 1] cry)
3695− [[1 :(mix mig (end 3 len) (zyrt mog))] $(mig mog)]
3696− ::
3697− ++ xafo |=([a=@ b=@] +((mod (add (dec b) a) 255)))
3698− ++ xaro |=([a=@ b=@] +((mod (add (dec b) (sub 255 (mod a 255))) 255)))
3699− ::
3700− ++ zaft :: forward 255-sbox
3701− |= a=@D
3702− =+ ^= b
3703− 0xcc.75bc.86c8.2fb1.9a42.f0b3.79a0.92ca.21f6.1e41.cde5.fcc0.
3704− 7e85.51ae.1005.c72d.1246.07e8.7c64.a914.8d69.d9f4.59c2.8038.
3705− 1f4a.dca2.6fdf.66f9.f561.a12e.5a16.f7b0.a39f.364e.cb70.7318.
3706− 1de1.ad31.63d1.abd4.db68.6a33.134d.a760.edee.5434.493a.e323.
3707− 930d.8f3d.3562.bb81.0b24.43cf.bea5.a6eb.52b4.0229.06b2.6704.
3708− 78c9.45ec.d75e.58af.c577.b7b9.c40e.017d.90c3.87f8.96fa.1153.
3709− 0372.7f30.1c32.ac83.ff17.c6e4.d36d.6b55.e2ce.8c71.8a5b.b6f3.
3710− 9d4b.eab5.8b3c.e7f2.a8fe.9574.5de0.bf20.3f15.9784.9939.5f9c.
3711− e609.564f.d8a4.b825.9819.94aa.2c08.8e4c.9b22.477a.2840.3ed6.
3712− 3750.6ef1.44dd.89ef.6576.d00a.fbda.9ed2.3b6c.7b0c.bde9.2ade.
3713− 5c88.c182.481a.1b0f.2bfd.d591.2726.57ba
3714− (cut 3 [(dec a) 1] b)
3715− ::
3716− ++ zart :: reverse 255-sbox
3717− |= a=@D
3718− =+ ^= b
3719− 0x68.4f07.ea1c.73c9.75c2.efc8.d559.5125.f621.a7a8.8591.5613.
3720− dd52.40eb.65a2.60b7.4bcb.1123.ceb0.1bd6.3c84.2906.b164.19b3.
3721− 1e95.5fec.ffbc.f187.fbe2.6680.7c77.d30e.e94a.9414.fd9a.017d.
3722− 3a7e.5a55.8ff5.8bf9.c181.e5b6.6ab2.35da.50aa.9293.3bc0.cdc6.
3723− f3bf.1a58.4130.f844.3846.744e.36a0.f205.789e.32d8.5e54.5c22.
3724− 0f76.fce7.4569.0d99.d26e.e879.dc16.2df4.887f.1ffe.4dba.6f5d.
3725− bbcc.2663.1762.aed7.af8a.ca20.dbb4.9bc7.a942.834c.105b.c4d4.
3726− 8202.3e61.a671.90e6.273d.bdab.3157.cfa4.0c2e.df86.2496.f7ed.
3727− 2b48.2a9d.5318.a343.d128.be9c.a5ad.6bb5.6dfa.c5e1.3408.128d.
3728− 2c04.0339.97a1.2ff0.49d0.eeb8.6c0a.0b37.b967.c347.d9ac.e072.
3729− e409.7b9f.1598.1d3f.33de.8ce3.8970.8e7a
3730− (cut 3 [(dec a) 1] b)
3731− ::
3732− ++ zyft :: forward 256-sbox
3733− |= a=@D
3734− =+ ^= b
3735− 0xbb49.b71f.b881.b402.17e4.6b86.69b5.1647.115f.dddb.7ca5.
3736− 8371.4bd5.19a9.b092.605d.0d9b.e030.a0cc.78ba.5706.4d2d.
3737− 986a.768c.f8e8.c4c7.2f1c.effe.3cae.01c0.253e.65d3.3872.
3738− ce0e.7a74.8ac6.daac.7e5c.6479.44ec.4143.3d20.4af0.ee6c.
3739− c828.deca.0377.249f.ffcd.7b4f.eb7d.66f2.8951.042e.595a.
3740− 8e13.f9c3.a79a.f788.6199.9391.7fab.6200.4ce5.0758.e2f1.
3741− 7594.c945.d218.4248.afa1.e61a.54fb.1482.bea4.96a2.3473.
3742− 63c2.e7cb.155b.120a.4ed7.bfd8.b31b.4008.f329.fca3.5380.
3743− 9556.0cb2.8722.2bea.e96e.3ac5.d1bc.10e3.2c52.a62a.b1d6.
3744− 35aa.d05e.f6a8.0f3b.31ed.559d.09ad.f585.6d21.fd1d.8d67.
3745− 370b.26f4.70c1.b923.4684.6fbd.cf8b.5036.0539.9cdc.d93f.
3746− 9068.1edf.8f33.b632.d427.97fa.9ee1
3747− (cut 3 [a 1] b)
3748− ::
3749− ++ zyrt :: reverse 256-sbox
3750− |= a=@D
3751− =+ ^= b
3752− 0x9fc8.2753.6e02.8fcf.8b35.2b20.5598.7caa.c9a9.30b0.9b48.
3753− 47ce.6371.80f6.407d.00dd.0aa5.ed10.ecb7.0f5a.5c3a.e605.
3754− c077.4337.17bd.9eda.62a4.79a7.ccb8.44cd.8e64.1ec4.5b6b.
3755− 1842.ffd8.1dfb.fd07.f2f9.594c.3be3.73c6.2cb6.8438.e434.
3756− 8d3d.ea6a.5268.72db.a001.2e11.de8c.88d3.0369.4f7a.87e2.
3757− 860d.0991.25d0.16b9.978a.4bf4.2a1a.e96c.fa50.85b5.9aeb.
3758− 9dbb.b2d9.a2d1.7bba.66be.e81f.1946.29a8.f5d2.f30c.2499.
3759− c1b3.6583.89e1.ee36.e0b4.6092.937e.d74e.2f6f.513e.9615.
3760− 9c5d.d581.e7ab.fe74.f01b.78b1.ae75.af57.0ec2.adc7.3245.
3761− 12bf.2314.3967.0806.31dc.cb94.d43f.493c.54a6.0421.c3a1.
3762− 1c4a.28ac.fc0b.26ca.5870.e576.f7f1.616d.905f.ef41.33bc.
3763− df4d.225e.2d56.7fd6.1395.a3f8.c582
3764− (cut 3 [a 1] b)
3765− --
3766−::
3767−++ ob
3768− ~% %ob ..ob
3769− ==
3770− %fein fein
3771− %fynd fynd
3772− ==
3773− |%
3774− ::
3775− :: +fein: conceal structure, v3.
3776− ::
3777− :: +fein conceals planet-sized atoms. The idea is that it should not be
3778− :: trivial to tell which planet a star has spawned under.
3779− ::
3780− ++ fein
3781− ~/ %fein
3782− |= pyn=@ ^- @
3783− ?: &((gte pyn 0x1.0000) (lte pyn 0xffff.ffff))
3784− (add 0x1.0000 (feis (sub pyn 0x1.0000)))
3785− ?: &((gte pyn 0x1.0000.0000) (lte pyn 0xffff.ffff.ffff.ffff))
3786− =/ lo (dis pyn 0xffff.ffff)
3787− =/ hi (dis pyn 0xffff.ffff.0000.0000)
3788− %+ con hi
3789− $(pyn lo)
3790− pyn
3791− ::
3792− :: +fynd: restore structure, v3.
3793− ::
3794− :: Restores obfuscated values that have been enciphered with +fein.
3795− ::
3796− ++ fynd
3797− ~/ %fynd
3798− |= cry=@ ^- @
3799− ?: &((gte cry 0x1.0000) (lte cry 0xffff.ffff))
3800− (add 0x1.0000 (tail (sub cry 0x1.0000)))
3801− ?: &((gte cry 0x1.0000.0000) (lte cry 0xffff.ffff.ffff.ffff))
3802− =/ lo (dis cry 0xffff.ffff)
3803− =/ hi (dis cry 0xffff.ffff.0000.0000)
3804− %+ con hi
3805− $(cry lo)
3806− cry
3807− :: +feis: a four-round generalised Feistel cipher over the domain
3808− :: [0, 2^32 - 2^16 - 1].
3809− ::
3810− :: See: Black & Rogaway (2002), Ciphers for arbitrary finite domains.
3811− ::
3812− ++ feis
3813− |= m=@
3814− ^- @
3815− (fee 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m)
3816− ::
3817− :: +tail: reverse +feis.
3818− ::
3819− ++ tail
3820− |= m=@
3821− ^- @
3822− (feen 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m)
3823− ::
3824− :: +fee: "Fe" in B&R (2002).
3825− ::
3826− :: A Feistel cipher given the following parameters:
3827− ::
3828− :: r: number of Feistel rounds
3829− :: a, b: parameters such that ab >= k
3830− :: k: value such that the domain of the cipher is [0, k - 1]
3831− :: prf: a gate denoting a family of pseudorandom functions indexed by
3832− :: its first argument and taking its second argument as input
3833− :: m: an input value in the domain [0, k - 1]
3834− ::
3835− ++ fee
3836− |= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@]
3837− ^- @
3838− =/ c (fe r a b prf m)
3839− ?: (lth c k)
3840− c
3841− (fe r a b prf c)
3842− ::
3843− :: +feen: "Fe^-1" in B&R (2002).
3844− ::
3845− :: Reverses a Feistel cipher constructed with parameters as described in
3846− :: +fee.
3847− ::
3848− ++ feen
3849− |= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@]
3850− ^- @
3851− =/ c (fen r a b prf m)
3852− ?: (lth c k)
3853− c
3854− (fen r a b prf c)
3855− ::
3856− :: +fe: "fe" in B&R (2002).
3857− ::
3858− :: An internal function to +fee.
3859− ::
3860− :: Note that this implementation differs slightly from the reference paper
3861− :: to support some legacy behaviour. See urbit/arvo#1105.
3862− ::
3863− ++ fe
3864− |= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@]
3865− =/ j 1
3866− =/ ell (mod m a)
3867− =/ arr (div m a)
3868− |- ^- @
3869− ::
3870− ?: (gth j r)
3871− ?. =((mod r 2) 0)
3872− (add (mul arr a) ell)
3873− ::
3874− :: Note that +fe differs from B&R (2002)'s "fe" below, as a previous
3875− :: implementation of this cipher contained a bug such that certain inputs
3876− :: could encipher to the same output.
3877− ::
3878− :: To correct these problem cases while also preserving the cipher's
3879− :: legacy behaviour on most inputs, we check for a problem case (which
3880− :: occurs when 'arr' is equal to 'a') and, if detected, use an alternate
3881− :: permutation instead.
3882− ::
3883− ?: =(arr a)
3884− (add (mul arr a) ell)
3885− (add (mul ell a) arr)
3886− ::
3887− =/ f (prf (sub j 1) arr)
3888− ::
3889− =/ tmp
3890− ?. =((mod j 2) 0)
3891− (mod (add f ell) a)
3892− (mod (add f ell) b)
3893− ::
3894− $(j +(j), ell arr, arr tmp)
3895− ::
3896− :: +fen: "fe^-1" in B&R (2002).
3897− ::
3898− :: Note that this implementation differs slightly from the reference paper
3899− :: to support some legacy behaviour. See urbit/arvo#1105.
3900− ::
3901− ++ fen
3902− |= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@]
3903− =/ j r
3904− ::
3905− =/ ahh
3906− ?. =((mod r 2) 0)
3907− (div m a)
3908− (mod m a)
3909− ::
3910− =/ ale
3911− ?. =((mod r 2) 0)
3912− (mod m a)
3913− (div m a)
3914− ::
3915− :: Similar to the comment in +fe, +fen differs from B&R (2002)'s "fe^-1"
3916− :: here in order to preserve the legacy cipher's behaviour on most inputs.
3917− ::
3918− :: Here problem cases can be identified by 'ahh' equating with 'a'; we
3919− :: correct those cases by swapping the values of 'ahh' and 'ale'.
3920− ::
3921− =/ ell
3922− ?: =(ale a)
3923− ahh
3924− ale
3925− ::
3926− =/ arr
3927− ?: =(ale a)
3928− ale
3929− ahh
3930− ::
3931− |- ^- @
3932− ?: (lth j 1)
3933− (add (mul arr a) ell)
3934− =/ f (prf (sub j 1) ell)
3935− ::
3936− :: Note that there is a slight deviation here to avoid dealing with
3937− :: negative values. We add 'a' or 'b' to arr as appropriate and reduce
3938− :: 'f' modulo the same number before performing subtraction.
3939− ::
3940− =/ tmp
3941− ?. =((mod j 2) 0)
3942− (mod (sub (add arr a) (mod f a)) a)
3943− (mod (sub (add arr b) (mod f b)) b)
3944− ::
3945− $(j (sub j 1), ell tmp, arr ell)
3946− ::
3947− :: +eff: a murmur3-based pseudorandom function. 'F' in B&R (2002).
3948− ::
3949− ++ eff
3950− |= [j=@ r=@]
3951− ^- @
3952− (muk (snag j raku) 2 r)
3953− ::
3954− :: +raku: seeds for eff.
3955− ::
3956− ++ raku
3957− ^- (list @ux)
3958− :~ 0xb76d.5eed
3959− 0xee28.1300
3960− 0x85bc.ae01
3961− 0x4b38.7af7
3962− ==
3963− ::
3964− --
3965−::
3966−:: 3g: molds and mold builders
3967−+| %molds-and-mold-builders
3968−::
3969−+$ coin $~ [%$ %ud 0] :: print format
3970− $% [%$ p=dime] ::
3971− [%blob p=*] ::
3972− [%many p=(list coin)] ::
3973− == ::
3974−+$ dime [p=@ta q=@] ::
3975−+$ edge [p=hair q=(unit [p=* q=nail])] :: parsing output
3976−+$ hair [p=@ud q=@ud] :: parsing trace
3977−++ like |* a=$-(* *) :: generic edge
3978− |: b=`*`[(hair) ~] ::
3979− :- p=(hair -.b) ::
3980− ^= q ::
3981− ?@ +.b ~ ::
3982− :- ~ ::
3983− u=[p=(a +>-.b) q=[p=(hair -.b) q=(tape +.b)]] ::
3984−+$ nail [p=hair q=tape] :: parsing input
3985−+$ pint [p=[p=@ q=@] q=[p=@ q=@]] :: line+column range
3986−+$ rule _|:($:nail $:edge) :: parsing rule
3987−+$ spot [p=path q=pint] :: range in file
3988−+$ tone $% [%0 product=*] :: success
3989− [%1 block=*] :: single block
3990− [%2 trace=(list [@ta *])] :: error report
3991− == ::
3992−+$ toon $% [%0 p=*] :: success
3993− [%1 p=*] :: block
3994− [%2 p=(list tank)] :: stack trace
3995− == ::
3996−++ wonk |* veq=_$:edge :: product from edge
3997− ?~(q.veq !! p.u.q.veq) ::
3998−-- =>
3999−::
4000−~% %qua
4001− +
4002− ==
4003− %mure mure
4004− %mute mute
4005− %show show
4006− ==
4007−:: layer-4
4008−::
4009−|%
4010−::
4011−:: 4a: exotic bases
4012−+| %exotic-bases
4013−::
4014−++ po :: phonetic base
4015− ~/ %po
4016− =+ :- ^= sis :: prefix syllables
4017− 'dozmarbinwansamlitsighidfidlissogdirwacsabwissib\
4018− /rigsoldopmodfoglidhopdardorlorhodfolrintogsilmir\
4019− /holpaslacrovlivdalsatlibtabhanticpidtorbolfosdot\
4020− /losdilforpilramtirwintadbicdifrocwidbisdasmidlop\
4021− /rilnardapmolsanlocnovsitnidtipsicropwitnatpanmin\
4022− /ritpodmottamtolsavposnapnopsomfinfonbanmorworsip\
4023− /ronnorbotwicsocwatdolmagpicdavbidbaltimtasmallig\
4024− /sivtagpadsaldivdactansidfabtarmonranniswolmispal\
4025− /lasdismaprabtobrollatlonnodnavfignomnibpagsopral\
4026− /bilhaddocridmocpacravripfaltodtiltinhapmicfanpat\
4027− /taclabmogsimsonpinlomrictapfirhasbosbatpochactid\
4028− /havsaplindibhosdabbitbarracparloddosbortochilmac\
4029− /tomdigfilfasmithobharmighinradmashalraglagfadtop\
4030− /mophabnilnosmilfopfamdatnoldinhatnacrisfotribhoc\
4031− /nimlarfitwalrapsarnalmoslandondanladdovrivbacpol\
4032− /laptalpitnambonrostonfodponsovnocsorlavmatmipfip'
4033− ^= dex :: suffix syllables
4034− 'zodnecbudwessevpersutletfulpensytdurwepserwylsun\
4035− /rypsyxdyrnuphebpeglupdepdysputlughecryttyvsydnex\
4036− /lunmeplutseppesdelsulpedtemledtulmetwenbynhexfeb\
4037− /pyldulhetmevruttylwydtepbesdexsefwycburderneppur\
4038− /rysrebdennutsubpetrulsynregtydsupsemwynrecmegnet\
4039− /secmulnymtevwebsummutnyxrextebfushepbenmuswyxsym\
4040− /selrucdecwexsyrwetdylmynmesdetbetbeltuxtugmyrpel\
4041− /syptermebsetdutdegtexsurfeltudnuxruxrenwytnubmed\
4042− /lytdusnebrumtynseglyxpunresredfunrevrefmectedrus\
4043− /bexlebduxrynnumpyxrygryxfeptyrtustyclegnemfermer\
4044− /tenlusnussyltecmexpubrymtucfyllepdebbermughuttun\
4045− /bylsudpemdevlurdefbusbeprunmelpexdytbyttyplevmyl\
4046− /wedducfurfexnulluclennerlexrupnedlecrydlydfenwel\
4047− /nydhusrelrudneshesfetdesretdunlernyrsebhulryllud\
4048− /remlysfynwerrycsugnysnyllyndyndemluxfedsedbecmun\
4049− /lyrtesmudnytbyrsenwegfyrmurtelreptegpecnelnevfes'
4050− |%
4051− ++ ins ~/ %ins :: parse prefix
4052− |= a=@tas
4053− =+ b=0
4054− |- ^- (unit @)
4055− ?:(=(256 b) ~ ?:(=(a (tos b)) [~ b] $(b +(b))))
4056− ++ ind ~/ %ind :: parse suffix
4057− |= a=@tas
4058− =+ b=0
4059− |- ^- (unit @)
4060− ?:(=(256 b) ~ ?:(=(a (tod b)) [~ b] $(b +(b))))
4061− ++ tos ~/ %tos :: fetch prefix
4062− |=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] sis)))
4063− ++ tod ~/ %tod :: fetch suffix
4064− |=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] dex)))
4065− --
4066−::
4067−++ fa :: base58check
4068− =+ key='123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz'
4069− =/ yek=@ux ~+
4070− =- yek:(roll (rip 3 key) -)
4071− =+ [a=*char b=*@ yek=`@ux`(fil 3 256 0xff)]
4072− |.
4073− [+(b) (mix yek (lsh [3 `@u`a] (~(inv fe 3) b)))]
4074− |%
4075− ++ cha |=(a=char `(unit @uF)`=+(b=(cut 3 [`@`a 1] yek) ?:(=(b 0xff) ~ `b)))
4076− ++ tok
4077− |= a=@ux ^- @ux
4078− =+ b=(pad a)
4079− =- (~(net fe 5) (end [3 4] (shay 32 -)))
4080− (shay (add b (met 3 a)) (lsh [3 b] (swp 3 a)))
4081− ::
4082− ++ pad |=(a=@ =+(b=(met 3 a) ?:((gte b 21) 0 (sub 21 b))))
4083− ++ enc |=(a=@ux `@ux`(mix (lsh [3 4] a) (tok a)))
4084− ++ den
4085− |= a=@ux ^- (unit @ux)
4086− =+ b=(rsh [3 4] a)
4087− ?. =((tok b) (end [3 4] a))
4088− ~
4089− `b
4090− --
4091−:: 4b: text processing
4092−+| %text-processing
4093−::
4094−++ at :: basic printing
4095− |_ a=@
4096− ++ r
4097− ?: ?& (gte (met 3 a) 2)
4098− |-
4099− ?: =(0 a)
4100− &
4101− =+ vis=(end 3 a)
4102− ?& ?|(=('-' vis) ?&((gte vis 'a') (lte vis 'z')))
4103− $(a (rsh 3 a))
4104− ==
4105− ==
4106− rtam
4107− ?: (lte (met 3 a) 2)
4108− rud
4109− rux
4110− ::
4111− ++ rf `tape`[?-(a %& '&', %| '|', * !!) ~]
4112− ++ rn `tape`[?>(=(0 a) '~') ~]
4113− ++ rt `tape`['\'' (weld (mesc (trip a)) `tape`['\'' ~])]
4114− ++ rta rt
4115− ++ rtam `tape`['%' (trip a)]
4116− ++ rub `tape`['0' 'b' (rum 2 ~ |=(b=@ (add '0' b)))]
4117− ++ rud (rum 10 ~ |=(b=@ (add '0' b)))
4118− ++ rum
4119− |= [b=@ c=tape d=$-(@ @)]
4120− ^- tape
4121− ?: =(0 a)
4122− [(d 0) c]
4123− =+ e=0
4124− |- ^- tape
4125− ?: =(0 a)
4126− c
4127− =+ f=&(!=(0 e) =(0 (mod e ?:(=(10 b) 3 4))))
4128− %= $
4129− a (div a b)
4130− c [(d (mod a b)) ?:(f [?:(=(10 b) ',' '-') c] c)]
4131− e +(e)
4132− ==
4133− ::
4134− ++ rup
4135− =+ b=(met 3 a)
4136− ^- tape
4137− :- '-'
4138− |- ^- tape
4139− ?: (gth (met 5 a) 1)
4140− %+ weld
4141− $(a (rsh 5 a), b (sub b 4))
4142− `tape`['-' '-' $(a (end 5 a), b 4)]
4143− ?: =(0 b)
4144− ['~' ~]
4145− ?: (lte b 1)
4146− (trip (tos:po a))
4147− |- ^- tape
4148− ?: =(2 b)
4149− =+ c=(rsh 3 a)
4150− =+ d=(end 3 a)
4151− (weld (trip (tod:po c)) (trip (tos:po (mix c d))))
4152− =+ c=(rsh [3 2] a)
4153− =+ d=(end [3 2] a)
4154− (weld ^$(a c, b (met 3 c)) `tape`['-' $(a (mix c d), b 2)])
4155− ::
4156− ++ ruv
4157− ^- tape
4158− :+ '0'
4159− 'v'
4160− %^ rum
4161− 64
4162− ~
4163− |= b=@
4164− ?: =(63 b)
4165− '+'
4166− ?: =(62 b)
4167− '-'
4168− ?:((lth b 26) (add 65 b) ?:((lth b 52) (add 71 b) (sub b 4)))
4169− ::
4170− ++ rux `tape`['0' 'x' (rum 16 ~ |=(b=@ (add b ?:((lth b 10) 48 87))))]
4171− --
4172−++ cass :: lowercase
4173− |= vib=tape
4174− ^- tape
4175− (turn vib |=(a=@ ?.(&((gte a 'A') (lte a 'Z')) a (add 32 a))))
4176−::
4177−++ cuss :: uppercase
4178− |= vib=tape
4179− ^- tape
4180− (turn vib |=(a=@ ?.(&((gte a 'a') (lte a 'z')) a (sub a 32))))
4181−::
4182−++ crip |=(a=tape `@t`(rap 3 a)) :: tape to cord
4183−::
4184−++ mesc :: ctrl code escape
4185− |= vib=tape
4186− ^- tape
4187− ?~ vib
4188− ~
4189− ?: =('\\' i.vib)
4190− ['\\' '\\' $(vib t.vib)]
4191− ?: ?|((gth i.vib 126) (lth i.vib 32) =(`@`39 i.vib))
4192− ['\\' (welp ~(rux at i.vib) '/' $(vib t.vib))]
4193− [i.vib $(vib t.vib)]
4194−::
4195−++ runt :: prepend repeatedly
4196− |= [[a=@ b=@] c=tape]
4197− ^- tape
4198− ?: =(0 a)
4199− c
4200− [b $(a (dec a))]
4201−::
4202−++ sand :: atom sanity
4203− |= a=@ta
4204− (flit (sane a))
4205−::
4206−++ sane :: atom sanity
4207− |= a=@ta
4208− |= b=@ ^- ?
4209− ?. =(%t (end 3 a))
4210− :: XX more and better sanity
4211− ::
4212− &
4213− =+ [inx=0 len=(met 3 b)]
4214− ?: =(%tas a)
4215− |- ^- ?
4216− ?: =(inx len) &
4217− =+ cur=(cut 3 [inx 1] b)
4218− ?& ?| &((gte cur 'a') (lte cur 'z'))
4219− &(=('-' cur) !=(0 inx) !=(len inx))
4220− &(&((gte cur '0') (lte cur '9')) !=(0 inx))
4221− ==
4222− $(inx +(inx))
4223− ==
4224− ?: =(%ta a)
4225− |- ^- ?
4226− ?: =(inx len) &
4227− =+ cur=(cut 3 [inx 1] b)
4228− ?& ?| &((gte cur 'a') (lte cur 'z'))
4229− &((gte cur '0') (lte cur '9'))
4230− |(=('-' cur) =('~' cur) =('_' cur) =('.' cur))
4231− ==
4232− $(inx +(inx))
4233− ==
4234− |- ^- ?
4235− ?: =(inx len) &
4236− =+ cur=(cut 3 [inx 1] b)
4237− ?: &((lth cur 32) !=(10 cur)) |
4238− =+ tef=(teff cur)
4239− ?& ?| =(1 tef)
4240− =+ i=1
4241− |- ^- ?
4242− ?| =(i tef)
4243− ?& (gte (cut 3 [(add i inx) 1] b) 128)
4244− $(i +(i))
4245− == == ==
4246− $(inx (add inx tef))
4247− ==
4248−::
4249−++ ruth :: biblical sanity
4250− |= [a=@ta b=*]
4251− ^- @
4252− ?^ b !!
4253− :: ?. ((sane a) b) !!
4254− b
4255−::
4256−++ trim :: tape split
4257− |= [a=@ b=tape]
4258− ^- [p=tape q=tape]
4259− ?~ b
4260− [~ ~]
4261− ?: =(0 a)
4262− [~ b]
4263− =+ c=$(a (dec a), b t.b)
4264− [[i.b p.c] q.c]
4265−::
4266−++ trip :: cord to tape
4267− ~/ %trip
4268− |= a=@ ^- tape
4269− ?: =(0 (met 3 a))
4270− ~
4271− [^-(@ta (end 3 a)) $(a (rsh 3 a))]
4272−::
4273−++ teff :: length utf8
4274− |= a=@t ^- @
4275− =+ b=(end 3 a)
4276− ?: =(0 b)
4277− ?>(=(`@`0 a) 0)
4278− ?> |((gte b 32) =(10 b))
4279− ?:((lte b 127) 1 ?:((lte b 223) 2 ?:((lte b 239) 3 4)))
4280−::
4281−++ taft :: utf8 to utf32
4282− |= a=@t
4283− ^- @c
4284− %+ rap 5
4285− |- ^- (list @c)
4286− =+ b=(teff a)
4287− ?: =(0 b) ~
4288− =+ ^= c
4289− %+ can 0
4290− %+ turn
4291− ^- (list [p=@ q=@])
4292− ?+ b !!
4293− %1 [[0 7] ~]
4294− %2 [[8 6] [0 5] ~]
4295− %3 [[16 6] [8 6] [0 4] ~]
4296− %4 [[24 6] [16 6] [8 6] [0 3] ~]
4297− ==
4298− |=([p=@ q=@] [q (cut 0 [p q] a)])
4299− ?> =((tuft c) (end [3 b] a))
4300− [c $(a (rsh [3 b] a))]
4301−::
4302−++ tuba :: utf8 to utf32 tape
4303− |= a=tape
4304− ^- (list @c)
4305− (rip 5 (taft (rap 3 a))) :: XX horrible
4306−::
4307−++ tufa :: utf32 to utf8 tape
4308− |= a=(list @c)
4309− ^- tape
4310− ?~ a ""
4311− (weld (rip 3 (tuft i.a)) $(a t.a))
4312−::
4313−++ tuft :: utf32 to utf8 text
4314− |= a=@c
4315− ^- @t
4316− %+ rap 3
4317− |- ^- (list @)
4318− ?: =(`@`0 a)
4319− ~
4320− =+ b=(end 5 a)
4321− =+ c=$(a (rsh 5 a))
4322− ?: (lte b 0x7f)
4323− [b c]
4324− ?: (lte b 0x7ff)
4325− :* (mix 0b1100.0000 (cut 0 [6 5] b))
4326− (mix 0b1000.0000 (end [0 6] b))
4327− c
4328− ==
4329− ?: (lte b 0xffff)
4330− :* (mix 0b1110.0000 (cut 0 [12 4] b))
4331− (mix 0b1000.0000 (cut 0 [6 6] b))
4332− (mix 0b1000.0000 (end [0 6] b))
4333− c
4334− ==
4335− :* (mix 0b1111.0000 (cut 0 [18 3] b))
4336− (mix 0b1000.0000 (cut 0 [12 6] b))
4337− (mix 0b1000.0000 (cut 0 [6 6] b))
4338− (mix 0b1000.0000 (end [0 6] b))
4339− c
4340− ==
4341−::
4342−++ wack :: knot escape
4343− |= a=@ta
4344− ^- @ta
4345− =+ b=(rip 3 a)
4346− %+ rap 3
4347− |- ^- tape
4348− ?~ b
4349− ~
4350− ?: =('~' i.b) ['~' '~' $(b t.b)]
4351− ?: =('_' i.b) ['~' '-' $(b t.b)]
4352− [i.b $(b t.b)]
4353−::
4354−++ wick :: knot unescape
4355− |= a=@
4356− ^- (unit @ta)
4357− =+ b=(rip 3 a)
4358− =- ?^(b ~ (some (rap 3 (flop c))))
4359− =| c=tape
4360− |- ^- [b=tape c=tape]
4361− ?~ b [~ c]
4362− ?. =('~' i.b)
4363− $(b t.b, c [i.b c])
4364− ?~ t.b [b ~]
4365− ?- i.t.b
4366− %'~' $(b t.t.b, c ['~' c])
4367− %'-' $(b t.t.b, c ['_' c])
4368− @ [b ~]
4369− ==
4370−::
4371−++ woad :: cord unescape
4372− |= a=@ta
4373− ^- @t
4374− %+ rap 3
4375− |- ^- (list @)
4376− ?: =(`@`0 a)
4377− ~
4378− =+ b=(end 3 a)
4379− =+ c=(rsh 3 a)
4380− ?: =('.' b)
4381− [' ' $(a c)]
4382− ?. =('~' b)
4383− [b $(a c)]
4384− => .(b (end 3 c), c (rsh 3 c))
4385− ?+ b =- (weld (rip 3 (tuft p.d)) $(a q.d))
4386− ^= d
4387− =+ d=0
4388− |- ^- [p=@ q=@]
4389− ?: =('.' b)
4390− [d c]
4391− ?< =(0 c)
4392− %= $
4393− b (end 3 c)
4394− c (rsh 3 c)
4395− d %+ add (mul 16 d)
4396− %+ sub b
4397− ?: &((gte b '0') (lte b '9')) 48
4398− ?>(&((gte b 'a') (lte b 'z')) 87)
4399− ==
4400− %'.' ['.' $(a c)]
4401− %'~' ['~' $(a c)]
4402− ==
4403−::
4404−++ wood :: cord escape
4405− |= a=@t
4406− ^- @ta
4407− %+ rap 3
4408− |- ^- (list @)
4409− ?: =(`@`0 a)
4410− ~
4411− =+ b=(teff a)
4412− =+ c=(taft (end [3 b] a))
4413− =+ d=$(a (rsh [3 b] a))
4414− ?: ?| &((gte c 'a') (lte c 'z'))
4415− &((gte c '0') (lte c '9'))
4416− =(`@`'-' c)
4417− ==
4418− [c d]
4419− ?+ c
4420− :- '~'
4421− =+ e=(met 2 c)
4422− |- ^- tape
4423− ?: =(0 e)
4424− ['.' d]
4425− =. e (dec e)
4426− =+ f=(rsh [2 e] c)
4427− [(add ?:((lte f 9) 48 87) f) $(c (end [2 e] c))]
4428− ::
4429− %' ' ['.' d]
4430− %'.' ['~' '.' d]
4431− %'~' ['~' '~' d]
4432− ==
4433−::
4434−:: 4c: tank printer
4435−+| %tank-printer
4436−::
4437−++ wash :: render tank at width
4438− |= [[tab=@ edg=@] tac=tank] ^- wall
4439− (~(win re tac) tab edg)
4440−::
4441−:: +re: tank renderer
4442−::
4443−++ re
4444− |_ tac=tank
4445− :: +ram: render a tank to one line (flat)
4446− ::
4447− ++ ram
4448− ^- tape
4449− ?@ tac
4450− (trip tac)
4451− ?- -.tac
4452− %leaf p.tac
4453− ::
4454− :: flat %palm rendered as %rose with welded openers
4455− ::
4456− %palm
4457− =* mid p.p.tac
4458− =* for (weld q.p.tac r.p.tac)
4459− =* end s.p.tac
4460− ram(tac [%rose [mid for end] q.tac])
4461− ::
4462− :: flat %rose rendered with open/mid/close
4463− ::
4464− %rose
4465− =* mid p.p.tac
4466− =* for q.p.tac
4467− =* end r.p.tac
4468− =* lit q.tac
4469− %+ weld
4470− for
4471− |- ^- tape
4472− ?~ lit
4473− end
4474− %+ weld
4475− ram(tac i.lit)
4476− =* voz $(lit t.lit)
4477− ?~(t.lit voz (weld mid voz))
4478− ==
4479− :: +win: render a tank to multiple lines (tall)
4480− ::
4481− :: indented by .tab, soft-wrapped at .edg
4482− ::
4483− ++ win
4484− |= [tab=@ud edg=@ud]
4485− :: output stack
4486− ::
4487− =| lug=wall
4488− |^ ^- wall
4489− ?@ tac
4490− (rig (trip tac))
4491− ?- -.tac
4492− %leaf (rig p.tac)
4493− ::
4494− %palm
4495− =/ hom ram
4496− ?: (lte (lent hom) (sub edg tab))
4497− (rig hom)
4498− ::
4499− =* for q.p.tac
4500− =* lit q.tac
4501− ?~ lit
4502− (rig for)
4503− ?~ t.lit
4504− =: tab (add 2 tab)
4505− lug $(tac i.lit)
4506− ==
4507− (rig for)
4508− ::
4509− => .(lit `(list tank)`lit)
4510− =/ lyn (mul 2 (lent lit))
4511− =. lug
4512− |- ^- wall
4513− ?~ lit
4514− lug
4515− =/ nyl (sub lyn 2)
4516− %= ^$
4517− tac i.lit
4518− tab (add tab nyl)
4519− lug $(lit t.lit, lyn nyl)
4520− ==
4521− (wig for)
4522− ::
4523− %rose
4524− =/ hom ram
4525− ?: (lte (lent hom) (sub edg tab))
4526− (rig hom)
4527− ::
4528− =* for q.p.tac
4529− =* end r.p.tac
4530− =* lit q.tac
4531− =. lug
4532− |- ^- wall
4533− ?~ lit
4534− ?~(end lug (rig end))
4535− %= ^$
4536− tac i.lit
4537− tab (mod (add 2 tab) (mul 2 (div edg 3)))
4538− lug $(lit t.lit)
4539− ==
4540− ?~(for lug (wig for))
4541− ==
4542− :: +rig: indent tape and cons with output stack
4543− ::
4544− ++ rig
4545− |= hom=tape
4546− ^- wall
4547− [(runt [tab ' '] hom) lug]
4548− :: +wig: indent tape and cons with output stack
4549− ::
4550− :: joined with the top line if whitespace/indentation allow
4551− ::
4552− ++ wig
4553− |= hom=tape
4554− ^- wall
4555− ?~ lug
4556− (rig hom)
4557− =/ wug :(add 1 tab (lent hom))
4558− ?. =+ mir=i.lug
4559− |- ^- ?
4560− ?~ mir |
4561− ?| =(0 wug)
4562− ?&(=(' ' i.mir) $(mir t.mir, wug (dec wug)))
4563− ==
4564− (rig hom) :: ^ XX regular form?
4565− :_ t.lug
4566− %+ runt [tab ' ']
4567− (weld hom `tape`[' ' (slag wug i.lug)])
4568− --
4569− --
4570−++ show :: XX deprecated!
4571− |= vem=*
4572− |^ ^- tank
4573− ?: ?=(@ vem)
4574− [%leaf (mesc (trip vem))]
4575− ?- vem
4576− [s=~ c=*]
4577− [%leaf '\'' (weld (mesc (tape +.vem)) `tape`['\'' ~])]
4578− ::
4579− [s=%a c=@] [%leaf (mesc (trip c.vem))]
4580− [s=%b c=*] (shop c.vem |=(a=@ ~(rub at a)))
4581− [s=[%c p=@] c=*]
4582− :+ %palm
4583− [['.' ~] ['-' ~] ~ ~]
4584− [[%leaf (mesc (trip p.s.vem))] $(vem c.vem) ~]
4585− ::
4586− [s=%d c=*] (shop c.vem |=(a=@ ~(rud at a)))
4587− [s=%k c=*] (tank c.vem)
4588− [s=%h c=*]
4589− :+ %rose
4590− [['/' ~] ['/' ~] ~]
4591− =+ yol=((list @ta) c.vem)
4592− (turn yol |=(a=@ta [%leaf (trip a)]))
4593− ::
4594− [s=%l c=*] (shol c.vem)
4595− [s=%o c=*]
4596− %= $
4597− vem
4598− :- [%m '%h::[%d %d].[%d %d]>']
4599− [-.c.vem +<-.c.vem +<+.c.vem +>-.c.vem +>+.c.vem ~]
4600− ==
4601− ::
4602− [s=%p c=*] (shop c.vem |=(a=@ ~(rup at a)))
4603− [s=%q c=*] (shop c.vem |=(a=@ ~(r at a)))
4604− [s=%r c=*] $(vem [[%r ' ' '{' '}'] c.vem])
4605− [s=%t c=*] (shop c.vem |=(a=@ ~(rt at a)))
4606− [s=%v c=*] (shop c.vem |=(a=@ ~(ruv at a)))
4607− [s=%x c=*] (shop c.vem |=(a=@ ~(rux at a)))
4608− [s=[%m p=@] c=*] (shep p.s.vem c.vem)
4609− [s=[%r p=@] c=*]
4610− $(vem [[%r ' ' (cut 3 [0 1] p.s.vem) (cut 3 [1 1] p.s.vem)] c.vem])
4611− ::
4612− [s=[%r p=@ q=@ r=@] c=*]
4613− :+ %rose
4614− :* p=(mesc (trip p.s.vem))
4615− q=(mesc (trip q.s.vem))
4616− r=(mesc (trip r.s.vem))
4617− ==
4618− |- ^- (list tank)
4619− ?@ c.vem
4620− ~
4621− [^$(vem -.c.vem) $(c.vem +.c.vem)]
4622− ::
4623− [s=%z c=*] $(vem [[%r %$ %$ %$] c.vem])
4624− * !!
4625− ==
4626− ++ shep
4627− |= [fom=@ gar=*]
4628− ^- tank
4629− =+ l=(met 3 fom)
4630− =+ i=0
4631− :- %leaf
4632− |- ^- tape
4633− ?: (gte i l)
4634− ~
4635− =+ c=(cut 3 [i 1] fom)
4636− ?. =(37 c)
4637− (weld (mesc [c ~]) $(i +(i)))
4638− =+ d=(cut 3 [+(i) 1] fom)
4639− ?. .?(gar)
4640− ['\\' '#' $(i (add 2 i))]
4641− (weld ~(ram re (show d -.gar)) $(i (add 2 i), gar +.gar))
4642− ::
4643− ++ shop
4644− |= [aug=* vel=$-(a=@ tape)]
4645− ^- tank
4646− ?: ?=(@ aug)
4647− [%leaf (vel aug)]
4648− :+ %rose
4649− [[' ' ~] ['[' ~] [']' ~]]
4650− => .(aug `*`aug)
4651− |- ^- (list tank)
4652− ?: ?=(@ aug)
4653− [^$ ~]
4654− [^$(aug -.aug) $(aug +.aug)]
4655− ::
4656− ++ shol
4657− |= lim=*
4658− :+ %rose
4659− [['.' ~] ~ ~]
4660− |- ^- (list tank)
4661− ?: ?=(@ lim) ~
4662− :_ $(lim +.lim)
4663− ?+ -.lim (show '#')
4664− ~ (show '$')
4665− c=@ (show c.lim)
4666− [%& %1] (show '.')
4667− [%& c=@]
4668− [%leaf '+' ~(rud at c.lim)]
4669− ::
4670− [%| @ ~] (show ',')
4671− [%| n=@ ~ c=@]
4672− [%leaf (weld (reap n.lim '^') ?~(c.lim "$" (trip c.lim)))]
4673− ==
4674− --
4675−::
4676−:: 4d: parsing (tracing)
4677−+| %parsing-tracing
4678−::
4679−++ last |= [zyc=hair naz=hair] :: farther trace
4680− ^- hair
4681− ?: =(p.zyc p.naz)
4682− ?:((gth q.zyc q.naz) zyc naz)
4683− ?:((gth p.zyc p.naz) zyc naz)
4684−::
4685−++ lust |= [weq=char naz=hair] :: detect newline
4686− ^- hair
4687− ?:(=(`@`10 weq) [+(p.naz) 1] [p.naz +(q.naz)])
4688−::
4689−:: 4e: parsing (combinators)
4690−+| %parsing-combinators
4691−::
4692−++ bend :: conditional comp
4693− ~/ %bend
4694− |* raq=_|*([a=* b=*] [~ u=[a b]])
4695− ~/ %fun
4696− |* [vex=edge sab=rule]
4697− ?~ q.vex
4698− vex
4699− =+ yit=(sab q.u.q.vex)
4700− =+ yur=(last p.vex p.yit)
4701− ?~ q.yit
4702− [p=yur q=q.vex]
4703− =+ vux=(raq p.u.q.vex p.u.q.yit)
4704− ?~ vux
4705− [p=yur q=q.vex]
4706− [p=yur q=[~ u=[p=u.vux q=q.u.q.yit]]]
4707−::
4708−++ comp
4709− ~/ %comp
4710− |* raq=_|*([a=* b=*] [a b]) :: arbitrary compose
4711− ~/ %fun
4712− |* [vex=edge sab=rule]
4713− ~! +<
4714− ?~ q.vex
4715− vex
4716− =+ yit=(sab q.u.q.vex)
4717− =+ yur=(last p.vex p.yit)
4718− ?~ q.yit
4719− [p=yur q=q.yit]
4720− [p=yur q=[~ u=[p=(raq p.u.q.vex p.u.q.yit) q=q.u.q.yit]]]
4721−::
4722−++ fail |=(tub=nail [p=p.tub q=~]) :: never parse
4723−++ glue :: add rule
4724− ~/ %glue
4725− |* bus=rule
4726− ~/ %fun
4727− |* [vex=edge sab=rule]
4728− (plug vex ;~(pfix bus sab))
4729−::
4730−++ less :: no first and second
4731− |* [vex=edge sab=rule]
4732− ?~ q.vex
4733− =+ roq=(sab)
4734− [p=(last p.vex p.roq) q=q.roq]
4735− (fail +<.sab)
4736−::
4737−++ pfix :: discard first rule
4738− ~/ %pfix
4739− |* sam=[vex=edge sab=rule]
4740− %. sam
4741− (comp |*([a=* b=*] b))
4742−::
4743−++ plug :: first then second
4744− ~/ %plug
4745− |* [vex=edge sab=rule]
4746− ?~ q.vex
4747− vex
4748− =+ yit=(sab q.u.q.vex)
4749− =+ yur=(last p.vex p.yit)
4750− ?~ q.yit
4751− [p=yur q=q.yit]
4752− [p=yur q=[~ u=[p=[p.u.q.vex p.u.q.yit] q=q.u.q.yit]]]
4753−::
4754−++ pose :: first or second
4755− ~/ %pose
4756− |* [vex=edge sab=rule]
4757− ?~ q.vex
4758− =+ roq=(sab)
4759− [p=(last p.vex p.roq) q=q.roq]
4760− vex
4761−::
4762−++ simu :: first and second
4763− |* [vex=edge sab=rule]
4764− ?~ q.vex
4765− vex
4766− =+ roq=(sab)
4767− roq
4768−::
4769−++ sfix :: discard second rule
4770− ~/ %sfix
4771− |* sam=[vex=edge sab=rule]
4772− %. sam
4773− (comp |*([a=* b=*] a))
4774−::
4775−:: 4f: parsing (rule builders)
4776−+| %parsing-rule-builders
4777−::
4778−++ bass :: leftmost base
4779− |* [wuc=@ tyd=rule]
4780− %+ cook
4781− |= waq=(list @)
4782− %+ roll
4783− waq
4784− =|([p=@ q=@] |.((add p (mul wuc q))))
4785− tyd
4786−::
4787−++ boss :: rightmost base
4788− |* [wuc=@ tyd=rule]
4789− %+ cook
4790− |= waq=(list @)
4791− %+ reel
4792− waq
4793− =|([p=@ q=@] |.((add p (mul wuc q))))
4794− tyd
4795−::
4796−++ cold :: replace w+ constant
4797− ~/ %cold
4798− |* [cus=* sef=rule]
4799− ~/ %fun
4800− |= tub=nail
4801− =+ vex=(sef tub)
4802− ?~ q.vex
4803− vex
4804− [p=p.vex q=[~ u=[p=cus q=q.u.q.vex]]]
4805−::
4806−++ cook :: apply gate
4807− ~/ %cook
4808− |* [poq=gate sef=rule]
4809− ~/ %fun
4810− |= tub=nail
4811− =+ vex=(sef tub)
4812− ?~ q.vex
4813− vex
4814− [p=p.vex q=[~ u=[p=(poq p.u.q.vex) q=q.u.q.vex]]]
4815−::
4816−++ easy :: always parse
4817− ~/ %easy
4818− |* huf=*
4819− ~/ %fun
4820− |= tub=nail
4821− ^- (like _huf)
4822− [p=p.tub q=[~ u=[p=huf q=tub]]]
4823−::
4824−++ fuss
4825− |= [sic=@t non=@t]
4826− ;~(pose (cold %& (jest sic)) (cold %| (jest non)))
4827−::
4828−++ full :: has to fully parse
4829− |* sef=rule
4830− |= tub=nail
4831− =+ vex=(sef tub)
4832− ?~(q.vex vex ?:(=(~ q.q.u.q.vex) vex [p=p.vex q=~]))
4833−::
4834−++ funk :: add to tape first
4835− |* [pre=tape sef=rule]
4836− |= tub=nail
4837− (sef p.tub (weld pre q.tub))
4838−::
4839−++ here :: place-based apply
4840− ~/ %here
4841− |* [hez=_|=([a=pint b=*] [a b]) sef=rule]
4842− ~/ %fun
4843− |= tub=nail
4844− =+ vex=(sef tub)
4845− ?~ q.vex
4846− vex
4847− [p=p.vex q=[~ u=[p=(hez [p.tub p.q.u.q.vex] p.u.q.vex) q=q.u.q.vex]]]
4848−::
4849−++ inde |* sef=rule :: indentation block
4850− |= nail ^+ (sef)
4851− =+ [har tap]=[p q]:+<
4852− =+ lev=(fil 3 (dec q.har) ' ')
4853− =+ eol=(just `@t`10)
4854− =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap)
4855− ;~(simu ;~(plug eol eol) eol)
4856− ?~ q.roq roq
4857− =+ vex=(sef har(q 1) p.u.q.roq)
4858− =+ fur=p.vex(q (add (dec q.har) q.p.vex))
4859− ?~ q.vex vex(p fur)
4860− =- vex(p fur, u.q -)
4861− :+ &3.vex
4862− &4.vex(q.p (add (dec q.har) q.p.&4.vex))
4863− =+ res=|4.vex
4864− |- ?~ res |4.roq
4865− ?. =(10 -.res) [-.res $(res +.res)]
4866− (welp [`@t`10 (trip lev)] $(res +.res))
4867−::
4868−++ ifix
4869− |* [fel=[rule rule] hof=rule]
4870− ~! +<
4871− ~! +<:-.fel
4872− ~! +<:+.fel
4873− ;~(pfix -.fel ;~(sfix hof +.fel))
4874−::
4875−++ jest :: match a cord
4876− |= daf=@t
4877− |= tub=nail
4878− =+ fad=daf
4879− |- ^- (like @t)
4880− ?: =(`@`0 daf)
4881− [p=p.tub q=[~ u=[p=fad q=tub]]]
4882− ?: |(?=(~ q.tub) !=((end 3 daf) i.q.tub))
4883− (fail tub)
4884− $(p.tub (lust i.q.tub p.tub), q.tub t.q.tub, daf (rsh 3 daf))
4885−::
4886−++ just :: XX redundant, jest
4887− ~/ %just :: match a char
4888− |= daf=char
4889− ~/ %fun
4890− |= tub=nail
4891− ^- (like char)
4892− ?~ q.tub
4893− (fail tub)
4894− ?. =(daf i.q.tub)
4895− (fail tub)
4896− (next tub)
4897−::
4898−++ knee :: callbacks
4899− |* [gar=* sef=_|.(*rule)]
4900− |= tub=nail
4901− ^- (like _gar)
4902− ((sef) tub)
4903−::
4904−++ mask :: match char in set
4905− ~/ %mask
4906− |= bud=(list char)
4907− ~/ %fun
4908− |= tub=nail
4909− ^- (like char)
4910− ?~ q.tub
4911− (fail tub)
4912− ?. (lien bud |=(a=char =(i.q.tub a)))
4913− (fail tub)
4914− (next tub)
4915−::
4916−++ more :: separated, *
4917− |* [bus=rule fel=rule]
4918− ;~(pose (most bus fel) (easy ~))
4919−::
4920−++ most :: separated, +
4921− |* [bus=rule fel=rule]
4922− ;~(plug fel (star ;~(pfix bus fel)))
4923−::
4924−++ next :: consume a char
4925− |= tub=nail
4926− ^- (like char)
4927− ?~ q.tub
4928− (fail tub)
4929− =+ zac=(lust i.q.tub p.tub)
4930− [zac [~ i.q.tub [zac t.q.tub]]]
4931−::
4932−++ perk :: parse cube fork
4933− |* a=(pole @tas)
4934− ?~ a fail
4935− ;~ pose
4936− (cold -.a (jest -.a))
4937− $(a +.a)
4938− ==
4939−::
4940−++ pick :: rule for ++each
4941− |* [a=rule b=rule]
4942− ;~ pose
4943− (stag %& a)
4944− (stag %| b)
4945− ==
4946−++ plus |*(fel=rule ;~(plug fel (star fel))) ::
4947−++ punt |*([a=rule] ;~(pose (stag ~ a) (easy ~))) ::
4948−++ sear :: conditional cook
4949− |* [pyq=$-(* (unit)) sef=rule]
4950− |= tub=nail
4951− =+ vex=(sef tub)
4952− ?~ q.vex
4953− vex
4954− =+ gey=(pyq p.u.q.vex)
4955− ?~ gey
4956− [p=p.vex q=~]
4957− [p=p.vex q=[~ u=[p=u.gey q=q.u.q.vex]]]
4958−::
4959−++ shim :: match char in range
4960− ~/ %shim
4961− |= [les=@ mos=@]
4962− ~/ %fun
4963− |= tub=nail
4964− ^- (like char)
4965− ?~ q.tub
4966− (fail tub)
4967− ?. ?&((gte i.q.tub les) (lte i.q.tub mos))
4968− (fail tub)
4969− (next tub)
4970−::
4971−++ stag :: add a label
4972− ~/ %stag
4973− |* [gob=* sef=rule]
4974− ~/ %fun
4975− |= tub=nail
4976− =+ vex=(sef tub)
4977− ?~ q.vex
4978− vex
4979− [p=p.vex q=[~ u=[p=[gob p.u.q.vex] q=q.u.q.vex]]]
4980−::
4981−++ stet ::
4982− |* leh=(list [?(@ [@ @]) rule])
4983− |-
4984− ?~ leh
4985− ~
4986− [i=[p=-.i.leh q=+.i.leh] t=$(leh t.leh)]
4987−::
4988−++ stew :: switch by first char
4989− ~/ %stew
4990− |* leh=(list [p=?(@ [@ @]) q=rule]) :: char+range keys
4991− =+ ^= wor :: range complete lth
4992− |= [ort=?(@ [@ @]) wan=?(@ [@ @])]
4993− ?@ ort
4994− ?@(wan (lth ort wan) (lth ort -.wan))
4995− ?@(wan (lth +.ort wan) (lth +.ort -.wan))
4996− =+ ^= hel :: build parser map
4997− =+ hel=`(tree _?>(?=(^ leh) i.leh))`~
4998− |- ^+ hel
4999− ?~ leh
5000− ~
5001− =+ yal=$(leh t.leh)
5002− |- ^+ hel
5003− ?~ yal
5004− [i.leh ~ ~]
5005− ?: (wor p.i.leh p.n.yal)
5006− =+ nuc=$(yal l.yal)
5007− ?> ?=(^ nuc)
5008− ?: (mor p.n.yal p.n.nuc)
5009− [n.yal nuc r.yal]
5010− [n.nuc l.nuc [n.yal r.nuc r.yal]]
5011− =+ nuc=$(yal r.yal)
5012− ?> ?=(^ nuc)
5013− ?: (mor p.n.yal p.n.nuc)
5014− [n.yal l.yal nuc]
5015− [n.nuc [n.yal l.yal l.nuc] r.nuc]
5016− ~% %fun ..^$ ~
5017− |= tub=nail
5018− ?~ q.tub
5019− (fail tub)
5020− |-
5021− ?~ hel
5022− (fail tub)
5023− ?: ?@ p.n.hel
5024− =(p.n.hel i.q.tub)
5025− ?&((gte i.q.tub -.p.n.hel) (lte i.q.tub +.p.n.hel))
5026− :: (q.n.hel [(lust i.q.tub p.tub) t.q.tub])
5027− (q.n.hel tub)
5028− ?: (wor i.q.tub p.n.hel)
5029− $(hel l.hel)
5030− $(hel r.hel)
5031−::
5032−++ slug ::
5033− |* raq=_=>(~ |*([a=* b=*] [a b]))
5034− |* [bus=rule fel=rule]
5035− ;~((comp raq) fel (stir +<+.raq raq ;~(pfix bus fel)))
5036−::
5037−++ star :: 0 or more times
5038− |* fel=rule
5039− (stir `(list _(wonk *fel))`~ |*([a=* b=*] [a b]) fel)
5040−::
5041−++ stir
5042− ~/ %stir
5043− |* [rud=* raq=_=>(~ |*([a=* b=*] [a b])) fel=rule]
5044− ~/ %fun
5045− |= tub=nail
5046− ^- (like _rud)
5047− ::
5048− :: lef: successful interim parse results (per .fel)
5049− :: wag: initial accumulator (.rud in .tub at farthest success)
5050− ::
5051− =+ ^= [lef wag]
5052− =| lef=(list _(fel tub))
5053− |- ^- [_lef (pair hair [~ u=(pair _rud nail)])]
5054− =+ vex=(fel tub)
5055− ?~ q.vex
5056− :- lef
5057− [p.vex [~ rud tub]]
5058− $(lef [vex lef], tub q.u.q.vex)
5059− ::
5060− :: fold .lef into .wag, combining results with .raq
5061− ::
5062− %+ roll lef
5063− |= _[vex=(fel tub) wag=wag] :: q.vex is always (some)
5064− ^+ wag
5065− :- (last p.vex p.wag)
5066− [~ (raq p.u.+.q.vex p.u.q.wag) q.u.q.wag]
5067−::
5068−++ stun :: parse several times
5069− ~/ %stun
5070− |* [lig=[@ @] fel=rule]
5071− |= tub=nail
5072− ^- (like (list _(wonk (fel))))
5073− ?: =(0 +.lig)
5074− [p.tub [~ ~ tub]]
5075− =+ vex=(fel tub)
5076− ?~ q.vex
5077− ?: =(0 -.lig)
5078− [p.vex [~ ~ tub]]
5079− vex
5080− =+ ^= wag %= $
5081− -.lig ?:(=(0 -.lig) 0 (dec -.lig))
5082− +.lig ?:(=(0 +.lig) 0 (dec +.lig))
5083− tub q.u.q.vex
5084− ==
5085− ?~ q.wag
5086− wag
5087− [p.wag [~ [p.u.q.vex p.u.q.wag] q.u.q.wag]]
5088−::
5089−:: 4g: parsing (outside caller)
5090−+| %parsing-outside-caller
5091−::
5092−++ rash |*([naf=@ sab=rule] (scan (trip naf) sab))
5093−++ rose |* [los=tape sab=rule]
5094− =+ vex=(sab [[1 1] los])
5095− =+ len=(lent los)
5096− ?. =(+(len) q.p.vex) [%| p=(dec q.p.vex)]
5097− ?~ q.vex
5098− [%& p=~]
5099− [%& p=[~ u=p.u.q.vex]]
5100−++ rush |*([naf=@ sab=rule] (rust (trip naf) sab))
5101−++ rust |* [los=tape sab=rule]
5102− =+ vex=((full sab) [[1 1] los])
5103− ?~(q.vex ~ [~ u=p.u.q.vex])
5104−++ scan |* [los=tape sab=rule]
5105− =+ vex=((full sab) [[1 1] los])
5106− ?~ q.vex
5107− ~_ (show [%m '{%d %d}'] p.p.vex q.p.vex ~)
5108− ~_(leaf+"syntax error" !!)
5109− p.u.q.vex
5110−::
5111−:: 4h: parsing (ascii glyphs)
5112−+| %parsing-ascii-glyphs
5113−::
5114−++ ace (just ' ') :: spACE
5115−++ bar (just '|') :: vertical BAR
5116−++ bas (just '\\') :: Back Slash (escaped)
5117−++ buc (just '$') :: dollars BUCks
5118−++ cab (just '_') :: CABoose
5119−++ cen (just '%') :: perCENt
5120−++ col (just ':') :: COLon
5121−++ com (just ',') :: COMma
5122−++ doq (just '"') :: Double Quote
5123−++ dot (just '.') :: dot dot dot ...
5124−++ fas (just '/') :: Forward Slash
5125−++ gal (just '<') :: Greater Left
5126−++ gar (just '>') :: Greater Right
5127−++ hax (just '#') :: Hash
5128−++ hep (just '-') :: HyPhen
5129−++ kel (just '{') :: Curly Left
5130−++ ker (just '}') :: Curly Right
5131−++ ket (just '^') :: CareT
5132−++ lus (just '+') :: pLUS
5133−++ mic (just ';') :: seMIColon
5134−++ pal (just '(') :: Paren Left
5135−++ pam (just '&') :: AMPersand pampersand
5136−++ par (just ')') :: Paren Right
5137−++ pat (just '@') :: AT pat
5138−++ sel (just '[') :: Square Left
5139−++ ser (just ']') :: Square Right
5140−++ sig (just '~') :: SIGnature squiggle
5141−++ soq (just '\'') :: Single Quote
5142−++ tar (just '*') :: sTAR
5143−++ tic (just '`') :: backTiCk
5144−++ tis (just '=') :: 'tis tis, it is
5145−++ wut (just '?') :: wut, what?
5146−++ zap (just '!') :: zap! bang! crash!!
5147−::
5148−:: 4i: parsing (useful idioms)
5149−+| %parsing-useful-idioms
5150−::
5151−++ alf ;~(pose low hig) :: alphabetic
5152−++ aln ;~(pose low hig nud) :: alphanumeric
5153−++ alp ;~(pose low hig nud hep) :: alphanumeric and -
5154−++ bet ;~(pose (cold 2 hep) (cold 3 lus)) :: axis syntax - +
5155−++ bin (bass 2 (most gon but)) :: binary to atom
5156−++ but (cook |=(a=@ (sub a '0')) (shim '0' '1')) :: binary digit
5157−++ cit (cook |=(a=@ (sub a '0')) (shim '0' '7')) :: octal digit
5158−++ dem (bass 10 (most gon dit)) :: decimal to atom
5159−++ dit (cook |=(a=@ (sub a '0')) (shim '0' '9')) :: decimal digit
5160−++ dog ;~(plug dot gay) :: . number separator
5161−++ dof ;~(plug hep gay) :: - @q separator
5162−++ doh ;~(plug ;~(plug hep hep) gay) :: -- phon separator
5163−++ dun (cold ~ ;~(plug hep hep)) :: -- (stop) to ~
5164−++ duz (cold ~ ;~(plug tis tis)) :: == (stet) to ~
5165−++ gah (mask [`@`10 ' ' ~]) :: newline or ace
5166−++ gap (cold ~ ;~(plug gaq (star ;~(pose vul gah)))) :: plural space
5167−++ gaq ;~ pose :: end of line
5168− (just `@`10)
5169− ;~(plug gah ;~(pose gah vul))
5170− vul
5171− ==
5172−++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white
5173−++ gay ;~(pose gap (easy ~)) ::
5174−++ gon ;~(pose ;~(plug bas gay fas) (easy ~)) :: long numbers \ /
5175−++ gul ;~(pose (cold 2 gal) (cold 3 gar)) :: axis syntax < >
5176−++ hex (bass 16 (most gon hit)) :: hex to atom
5177−++ hig (shim 'A' 'Z') :: uppercase
5178−++ hit ;~ pose :: hex digits
5179− dit
5180− (cook |=(a=char (sub a 87)) (shim 'a' 'f'))
5181− (cook |=(a=char (sub a 55)) (shim 'A' 'F'))
5182− ==
5183−++ iny :: indentation block
5184− |* sef=rule
5185− |= nail ^+ (sef)
5186− =+ [har tap]=[p q]:+<
5187− =+ lev=(fil 3 (dec q.har) ' ')
5188− =+ eol=(just `@t`10)
5189− =+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap)
5190− ;~(simu ;~(plug eol eol) eol)
5191− ?~ q.roq roq
5192− =+ vex=(sef har(q 1) p.u.q.roq)
5193− =+ fur=p.vex(q (add (dec q.har) q.p.vex))
5194− ?~ q.vex vex(p fur)
5195− =- vex(p fur, u.q -)
5196− :+ &3.vex
5197− &4.vex(q.p (add (dec q.har) q.p.&4.vex))
5198− =+ res=|4.vex
5199− |- ?~ res |4.roq
5200− ?. =(10 -.res) [-.res $(res +.res)]
5201− (welp [`@t`10 (trip lev)] $(res +.res))
5202−::
5203−++ low (shim 'a' 'z') :: lowercase
5204−++ mes %+ cook :: hexbyte
5205− |=([a=@ b=@] (add (mul 16 a) b))
5206− ;~(plug hit hit)
5207−++ nix (boss 256 (star ;~(pose aln cab))) ::
5208−++ nud (shim '0' '9') :: numeric
5209−++ prn ;~(less (just `@`127) (shim 32 256)) :: non-control
5210−++ qat ;~ pose :: chars in blockcord
5211− prn
5212− ;~(less ;~(plug (just `@`10) soz) (just `@`10))
5213− ==
5214−++ qit ;~ pose :: chars in a cord
5215− ;~(less bas soq prn)
5216− ;~(pfix bas ;~(pose bas soq mes)) :: escape chars
5217− ==
5218−++ qut ;~ simu soq :: cord
5219− ;~ pose
5220− ;~ less soz
5221− (ifix [soq soq] (boss 256 (more gon qit)))
5222− ==
5223− =+ hed=;~(pose ;~(plug (plus ace) vul) (just '\0a'))
5224− %- iny %+ ifix
5225− :- ;~(plug soz hed)
5226− ;~(plug (just '\0a') soz)
5227− (boss 256 (star qat))
5228− ==
5229− ==
5230−++ soz ;~(plug soq soq soq) :: delimiting '''
5231−++ sym :: symbol
5232− %+ cook
5233− |=(a=tape (rap 3 ^-((list @) a)))
5234− ;~(plug low (star ;~(pose nud low hep)))
5235−::
5236−++ mixed-case-symbol
5237− %+ cook
5238− |=(a=tape (rap 3 ^-((list @) a)))
5239− ;~(plug alf (star alp))
5240−::
5241−++ ven ;~ (comp |=([a=@ b=@] (peg a b))) :: +>- axis syntax
5242− bet
5243− =+ hom=`?`|
5244− |= tub=nail
5245− ^- (like @)
5246− =+ vex=?:(hom (bet tub) (gul tub))
5247− ?~ q.vex
5248− [p.tub [~ 1 tub]]
5249− =+ wag=$(p.tub p.vex, hom !hom, tub q.u.q.vex)
5250− ?> ?=(^ q.wag)
5251− [p.wag [~ (peg p.u.q.vex p.u.q.wag) q.u.q.wag]]
5252− ==
5253−++ vit :: base64 digit
5254− ;~ pose
5255− (cook |=(a=@ (sub a 65)) (shim 'A' 'Z'))
5256− (cook |=(a=@ (sub a 71)) (shim 'a' 'z'))
5257− (cook |=(a=@ (add a 4)) (shim '0' '9'))
5258− (cold 62 (just '-'))
5259− (cold 63 (just '+'))
5260− ==
5261−++ vul %+ cold ~ :: comments
5262− ;~ plug col col
5263− (star prn)
5264− (just `@`10)
5265− ==
5266−::
5267−:: 4j: parsing (bases and base digits)
5268−+| %parsing-bases-and-base-digits
5269−::
5270−++ ab
5271− |%
5272− ++ bix (bass 16 (stun [2 2] six))
5273− ++ fem (sear |=(a=@ (cha:fa a)) aln)
5274− ++ haf (bass 256 ;~(plug tep tiq (easy ~)))
5275− ++ hef %+ sear |=(a=@ ?:(=(a 0) ~ (some a)))
5276− %+ bass 256
5277− ;~(plug tip tiq (easy ~))
5278− ++ hif (bass 256 ;~(plug tip tiq (easy ~)))
5279− ++ hof (bass 0x1.0000 ;~(plug hef (stun [1 3] ;~(pfix hep hif))))
5280− ++ huf (bass 0x1.0000 ;~(plug hef (stun [0 3] ;~(pfix hep hif))))
5281− ++ hyf (bass 0x1.0000 ;~(plug hif (stun [3 3] ;~(pfix hep hif))))
5282− ++ pev (bass 32 ;~(plug sev (stun [0 4] siv)))
5283− ++ pew (bass 64 ;~(plug sew (stun [0 4] siw)))
5284− ++ piv (bass 32 (stun [5 5] siv))
5285− ++ piw (bass 64 (stun [5 5] siw))
5286− ++ qeb (bass 2 ;~(plug seb (stun [0 3] sib)))
5287− ++ qex (bass 16 ;~(plug sex (stun [0 3] hit)))
5288− ++ qib (bass 2 (stun [4 4] sib))
5289− ++ qix (bass 16 (stun [4 4] six))
5290− ++ seb (cold 1 (just '1'))
5291− ++ sed (cook |=(a=@ (sub a '0')) (shim '1' '9'))
5292− ++ sev ;~(pose sed sov)
5293− ++ sew ;~(pose sed sow)
5294− ++ sex ;~(pose sed sox)
5295− ++ sib (cook |=(a=@ (sub a '0')) (shim '0' '1'))
5296− ++ sid (cook |=(a=@ (sub a '0')) (shim '0' '9'))
5297− ++ siv ;~(pose sid sov)
5298− ++ siw ;~(pose sid sow)
5299− ++ six ;~(pose sid sox)
5300− ++ sov (cook |=(a=@ (sub a 87)) (shim 'a' 'v'))
5301− ++ sow ;~ pose
5302− (cook |=(a=@ (sub a 87)) (shim 'a' 'z'))
5303− (cook |=(a=@ (sub a 29)) (shim 'A' 'Z'))
5304− (cold 62 (just '-'))
5305− (cold 63 (just '~'))
5306− ==
5307− ++ sox (cook |=(a=@ (sub a 87)) (shim 'a' 'f'))
5308− ++ ted (bass 10 ;~(plug sed (stun [0 2] sid)))
5309− ++ tep (sear |=(a=@ ?:(=(a 'doz') ~ (ins:po a))) til)
5310− ++ tip (sear |=(a=@ (ins:po a)) til)
5311− ++ tiq (sear |=(a=@ (ind:po a)) til)
5312− ++ tid (bass 10 (stun [3 3] sid))
5313− ++ til (boss 256 (stun [3 3] low))
5314− ++ urs %+ cook
5315− |=(a=tape (rap 3 ^-((list @) a)))
5316− (star ;~(pose nud low hep dot sig cab))
5317− ++ urt %+ cook
5318− |=(a=tape (rap 3 ^-((list @) a)))
5319− (star ;~(pose nud low hep dot sig))
5320− ++ urx %+ cook
5321− |=(a=tape (rap 3 ^-((list @) a)))
5322− %- star
5323− ;~ pose
5324− nud
5325− low
5326− hep
5327− cab
5328− (cold ' ' dot)
5329− (cook tuft (ifix [sig dot] hex))
5330− ;~(pfix sig ;~(pose sig dot))
5331− ==
5332− ++ voy ;~(pfix bas ;~(pose bas soq bix))
5333− --
5334−++ ag
5335− |%
5336− ++ ape |*(fel=rule ;~(pose (cold `@`0 (just '0')) fel))
5337− ++ bay (ape (bass 16 ;~(plug qeb:ab (star ;~(pfix dog qib:ab)))))
5338− ++ bip =+ tod=(ape qex:ab)
5339− (bass 0x1.0000 ;~(plug tod (stun [7 7] ;~(pfix dog tod))))
5340− ++ dem (ape (bass 1.000 ;~(plug ted:ab (star ;~(pfix dog tid:ab)))))
5341− ++ dim (ape dip)
5342− ++ dip (bass 10 ;~(plug sed:ab (star sid:ab)))
5343− ++ dum (bass 10 (plus sid:ab))
5344− ++ fed %+ cook fynd:ob
5345− ;~ pose
5346− %+ bass 0x1.0000.0000.0000.0000 :: oversized
5347− ;~ plug
5348− huf:ab
5349− (plus ;~(pfix doh hyf:ab))
5350− ==
5351− hof:ab :: planet or moon
5352− haf:ab :: star
5353− tiq:ab :: galaxy
5354− ==
5355− ++ feq %+ cook |=(a=(list @) (rep 4 (flop a)))
5356− ;~ plug
5357− ;~(pose hif:ab tiq:ab)
5358− (star ;~(pfix dof hif:ab))
5359− ==
5360− ++ fim (sear den:fa (bass 58 (plus fem:ab)))
5361− ++ hex (ape (bass 0x1.0000 ;~(plug qex:ab (star ;~(pfix dog qix:ab)))))
5362− ++ lip =+ tod=(ape ted:ab)
5363− (bass 256 ;~(plug tod (stun [3 3] ;~(pfix dog tod))))
5364− ++ mot ;~ pose
5365− ;~ pfix
5366− (just '1')
5367− (cook |=(a=@ (add 10 (sub a '0'))) (shim '0' '2'))
5368− ==
5369− sed:ab
5370− ==
5371− ++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab)))))
5372− ++ vum (bass 32 (plus siv:ab))
5373− ++ wiz (ape (bass 0x4000.0000 ;~(plug pew:ab (star ;~(pfix dog piw:ab)))))
5374− --
5375−++ mu
5376− |_ [top=@ bot=@]
5377− ++ zag [p=(end 4 (add top bot)) q=bot]
5378− ++ zig [p=(end 4 (add top (sub 0x1.0000 bot))) q=bot]
5379− ++ zug (mix (lsh 4 top) bot)
5380− --
5381−++ ne
5382− |_ tig=@
5383− ++ c (cut 3 [tig 1] key:fa)
5384− ++ d (add tig '0')
5385− ++ x ?:((gte tig 10) (add tig 87) d)
5386− ++ v ?:((gte tig 10) (add tig 87) d)
5387− ++ w ?:(=(tig 63) '~' ?:(=(tig 62) '-' ?:((gte tig 36) (add tig 29) x)))
5388− --
5389−::
5390−:: 4k: atom printing
5391−+| %atom-printing
5392−::
5393−++ co
5394− !:
5395− ~% %co ..co ~
5396− =< |_ lot=coin
5397− ++ rear |=(rom=tape rend(rep rom))
5398− ++ rent ~+ `@ta`(rap 3 rend)
5399− ++ rend
5400− ^- tape
5401− ~+
5402− ?: ?=(%blob -.lot)
5403− ['~' '0' ((v-co 1) (jam p.lot))]
5404− ?: ?=(%many -.lot)
5405− :- '.'
5406− |- ^- tape
5407− ?~ p.lot
5408− ['_' '_' rep]
5409− ['_' (weld (trip (wack rent(lot i.p.lot))) $(p.lot t.p.lot))]
5410− =+ [yed=(end 3 p.p.lot) hay=(cut 3 [1 1] p.p.lot)]
5411− |- ^- tape
5412− ?+ yed (z-co q.p.lot)
5413− %c ['~' '-' (weld (rip 3 (wood (tuft q.p.lot))) rep)]
5414− %d
5415− ?+ hay (z-co q.p.lot)
5416− %a
5417− =+ yod=(yore q.p.lot)
5418− =? rep ?=(^ f.t.yod) ['.' (s-co f.t.yod)]
5419− =? rep !&(?=(~ f) =(0 h) =(0 m) =(0 s)):t.yod
5420− =. rep ['.' (y-co s.t.yod)]
5421− =. rep ['.' (y-co m.t.yod)]
5422− ['.' '.' (y-co h.t.yod)]
5423− =. rep ['.' (a-co d.t.yod)]
5424− =. rep ['.' (a-co m.yod)]
5425− =? rep !a.yod ['-' rep]
5426− ['~' (a-co y.yod)]
5427− ::
5428− %r
5429− =+ yug=(yell q.p.lot)
5430− =? rep ?=(^ f.yug) ['.' (s-co f.yug)]
5431− :- '~'
5432− ?: &(=(0 d.yug) =(0 m.yug) =(0 h.yug) =(0 s.yug))
5433− ['s' '0' rep]
5434− =? rep !=(0 s.yug) ['.' 's' (a-co s.yug)]
5435− =? rep !=(0 m.yug) ['.' 'm' (a-co m.yug)]
5436− =? rep !=(0 h.yug) ['.' 'h' (a-co h.yug)]
5437− =? rep !=(0 d.yug) ['.' 'd' (a-co d.yug)]
5438− +.rep
5439− ==
5440− ::
5441− %f
5442− ?: =(& q.p.lot)
5443− ['.' 'y' rep]
5444− ?:(=(| q.p.lot) ['.' 'n' rep] (z-co q.p.lot))
5445− ::
5446− %n ['~' rep]
5447− %i
5448− ?+ hay (z-co q.p.lot)
5449− %f ((ro-co [3 10 4] |=(a=@ ~(d ne a))) q.p.lot)
5450− %s ((ro-co [4 16 8] |=(a=@ ~(x ne a))) q.p.lot)
5451− ==
5452− ::
5453− %p
5454− =+ sxz=(fein:ob q.p.lot)
5455− =+ dyx=(met 3 sxz)
5456− :- '~'
5457− ?: (lte dyx 1)
5458− (weld (trip (tod:po sxz)) rep)
5459− =+ dyy=(met 4 sxz)
5460− =| imp=@ud
5461− |- ^- tape
5462− ?: =(imp dyy)
5463− rep
5464− %= $
5465− imp +(imp)
5466− rep =/ log (cut 4 [imp 1] sxz)
5467− ;: weld
5468− (trip (tos:po (rsh 3 log)))
5469− (trip (tod:po (end 3 log)))
5470− ?:(=((mod imp 4) 0) ?:(=(imp 0) "" "--") "-")
5471− rep
5472− == ==
5473− ::
5474− %q
5475− :+ '.' '~'
5476− =; res=(pair ? tape)
5477− (weld q.res rep)
5478− %+ roll
5479− =* val q.p.lot
5480− ?:(=(0 val) ~[0] (rip 3 val))
5481− |= [q=@ s=? r=tape]
5482− :- !s
5483− %+ weld
5484− (trip (?:(s tod:po tos:po) q))
5485− ?.(&(s !=(r "")) r ['-' r])
5486− ::
5487− %r
5488− ?+ hay (z-co q.p.lot)
5489− %d ['.' '~' (r-co (rlyd q.p.lot))]
5490− %h ['.' '~' '~' (r-co (rlyh q.p.lot))]
5491− %q ['.' '~' '~' '~' (r-co (rlyq q.p.lot))]
5492− %s ['.' (r-co (rlys q.p.lot))]
5493− ==
5494− ::
5495− %u
5496− ?: ?=(%c hay)
5497− %+ welp ['0' 'c' (reap (pad:fa q.p.lot) '1')]
5498− (c-co (enc:fa q.p.lot))
5499− ::
5500− =; gam=(pair tape tape)
5501− (weld p.gam ?:(=(0 q.p.lot) `tape`['0' ~] q.gam))
5502− ?+ hay [~ ((ox-co [10 3] |=(a=@ ~(d ne a))) q.p.lot)]
5503− %b [['0' 'b' ~] ((ox-co [2 4] |=(a=@ ~(d ne a))) q.p.lot)]
5504− %i [['0' 'i' ~] ((d-co 1) q.p.lot)]
5505− %x [['0' 'x' ~] ((ox-co [16 4] |=(a=@ ~(x ne a))) q.p.lot)]
5506− %v [['0' 'v' ~] ((ox-co [32 5] |=(a=@ ~(x ne a))) q.p.lot)]
5507− %w [['0' 'w' ~] ((ox-co [64 5] |=(a=@ ~(w ne a))) q.p.lot)]
5508− ==
5509− ::
5510− %s
5511− %+ weld
5512− ?:((syn:si q.p.lot) "--" "-")
5513− $(yed 'u', q.p.lot (abs:si q.p.lot))
5514− ::
5515− %t
5516− ?: =('a' hay)
5517− ?: =('s' (cut 3 [2 1] p.p.lot))
5518− (weld (rip 3 q.p.lot) rep)
5519− ['~' '.' (weld (rip 3 q.p.lot) rep)]
5520− ['~' '~' (weld (rip 3 (wood q.p.lot)) rep)]
5521− ==
5522− --
5523− =| rep=tape
5524− =< |%
5525− :: rendering idioms, output zero-padded to minimum lengths
5526− ::
5527− :: +a-co: decimal
5528− :: +c-co: base58check
5529− :: +d-co: decimal, takes minimum output digits
5530− :: +r-co: floating point
5531− :: +s-co: list of '.'-prefixed base16, 4 digit minimum
5532− :: +v-co: base32, takes minimum output digits
5533− :: +w-co: base64, takes minimum output digits
5534− :: +x-co: base16, takes minimum output digits
5535− :: +y-co: decimal, 2 digit minimum
5536− :: +z-co: '0x'-prefixed base16
5537− ::
5538− ++ a-co |=(dat=@ ((d-co 1) dat))
5539− ++ c-co (em-co [58 1] |=([? b=@ c=tape] [~(c ne b) c]))
5540− ++ d-co |=(min=@ (em-co [10 min] |=([? b=@ c=tape] [~(d ne b) c])))
5541− ::
5542− ++ r-co
5543− |= a=dn
5544− ?: ?=([%i *] a) (weld ?:(s.a "inf" "-inf") rep)
5545− ?: ?=([%n *] a) (weld "nan" rep)
5546− =; rep ?:(s.a rep ['-' rep])
5547− =/ f ((d-co 1) a.a)
5548− =^ e e.a
5549− =/ e=@s (sun:si (lent f))
5550− =/ sci :(sum:si e.a e -1)
5551− ?: (syn:si (dif:si e.a --3)) [--1 sci] :: 12000 -> 12e3 e>+2
5552− ?: !(syn:si (dif:si sci -2)) [--1 sci] :: 0.001 -> 1e-3 e<-2
5553− [(sum:si sci --1) --0] :: 1.234e2 -> '.'@3 -> 123 .4
5554− =? rep !=(--0 e.a)
5555− :(weld ?:((syn:si e.a) "e" "e-") ((d-co 1) (abs:si e.a)))
5556− (weld (ed-co e f) rep)
5557− ::
5558− ++ s-co
5559− |= esc=(list @) ^- tape
5560− ?~ esc rep
5561− ['.' =>(.(rep $(esc t.esc)) ((x-co 4) i.esc))]
5562− ::
5563− ++ v-co |=(min=@ (em-co [32 min] |=([? b=@ c=tape] [~(v ne b) c])))
5564− ++ w-co |=(min=@ (em-co [64 min] |=([? b=@ c=tape] [~(w ne b) c])))
5565− ++ x-co |=(min=@ (em-co [16 min] |=([? b=@ c=tape] [~(x ne b) c])))
5566− ++ y-co |=(dat=@ ((d-co 2) dat))
5567− ++ z-co |=(dat=@ `tape`['0' 'x' ((x-co 1) dat)])
5568− --
5569− |%
5570− :: +em-co: format in numeric base
5571− ::
5572− :: in .bas, format .min digits of .hol with .par
5573− ::
5574− :: - .hol is processed least-significant digit first
5575− :: - all available digits in .hol will be processed, but
5576− :: .min digits can exceed the number available in .hol
5577− :: - .par handles all accumulated output on each call,
5578− :: and can edit it, prepend or append digits, &c
5579− :: - until .hol is exhausted, .par's sample is [| digit output],
5580− :: subsequently, it's [& 0 output]
5581− ::
5582− ++ em-co
5583− |= [[bas=@ min=@] par=$-([? @ tape] tape)]
5584− |= hol=@
5585− ^- tape
5586− ?: &(=(0 hol) =(0 min))
5587− rep
5588− =/ [dar=@ rad=@] (dvr hol bas)
5589− %= $
5590− min ?:(=(0 min) 0 (dec min))
5591− hol dar
5592− rep (par =(0 dar) rad rep)
5593− ==
5594− ::
5595− :: +ed-co: format in numeric base, with output length
5596− ::
5597− :: - like +em-co, but .par's sample will be [| digit output]
5598− :: on the first call, regardless of the available digits in .hol
5599− :: - used only for @r* floats
5600− ::
5601− ++ ed-co
5602− |= [exp=@s int=tape] ^- tape
5603− =/ [pos=? dig=@u] [=(--1 (cmp:si exp --0)) (abs:si exp)]
5604− ?. pos
5605− (into (weld (reap +(dig) '0') int) 1 '.')
5606− =/ len (lent int)
5607− ?: (lth dig len) (into int dig '.')
5608− (weld int (reap (sub dig len) '0'))
5609− ::
5610− :: +ox-co: format '.'-separated digit sequences in numeric base
5611− ::
5612− :: in .bas, format each digit of .hol with .dug,
5613− :: with '.' separators every .gop digits.
5614− ::
5615− :: - .hol is processed least-significant digit first
5616− :: - .dug handles individual digits, output is prepended
5617− :: - every segment but the last is zero-padded to .gop
5618− ::
5619− ++ ox-co
5620− |= [[bas=@ gop=@] dug=$-(@ @)]
5621− %+ em-co
5622− [(pow bas gop) 0]
5623− |= [top=? seg=@ res=tape]
5624− %+ weld
5625− ?:(top ~ `tape`['.' ~])
5626− %. seg
5627− %+ em-co(rep res)
5628− [bas ?:(top 0 gop)]
5629− |=([? b=@ c=tape] [(dug b) c])
5630− ::
5631− :: +ro-co: format '.'-prefixed bloqs in numeric base
5632− ::
5633− :: in .bas, for .buz bloqs 0 to .dop, format at least one
5634− :: digit of .hol, prefixed with '.'
5635− ::
5636− :: - used only for @i* addresses
5637− ::
5638− ++ ro-co
5639− |= [[buz=@ bas=@ dop=@] dug=$-(@ @)]
5640− |= hol=@
5641− ^- tape
5642− ?: =(0 dop)
5643− rep
5644− :- '.'
5645− =/ pod (dec dop)
5646− %. (cut buz [pod 1] hol)
5647− %+ em-co(rep $(dop pod))
5648− [bas 1]
5649− |=([? b=@ c=tape] [(dug b) c])
5650− --
5651−::
5652−:: 4l: atom parsing
5653−+| %atom-parsing
5654−::
5655−++ so
5656− ~% %so + ~
5657− |%
5658− ++ bisk
5659− ~+
5660− ;~ pose
5661− ;~ pfix (just '0')
5662− ;~ pose
5663− (stag %ub ;~(pfix (just 'b') bay:ag))
5664− (stag %uc ;~(pfix (just 'c') fim:ag))
5665− (stag %ui ;~(pfix (just 'i') dim:ag))
5666− (stag %ux ;~(pfix (just 'x') hex:ag))
5667− (stag %uv ;~(pfix (just 'v') viz:ag))
5668− (stag %uw ;~(pfix (just 'w') wiz:ag))
5669− ==
5670− ==
5671− (stag %ud dem:ag)
5672− ==
5673− ++ crub
5674− ~+
5675− ;~ pose
5676− (cook |=(det=date `dime`[%da (year det)]) when)
5677− ::
5678− %+ cook
5679− |= [a=(list [p=?(%d %h %m %s) q=@]) b=(list @)]
5680− =+ rop=`tarp`[0 0 0 0 b]
5681− |- ^- dime
5682− ?~ a
5683− [%dr (yule rop)]
5684− ?- p.i.a
5685− %d $(a t.a, d.rop (add q.i.a d.rop))
5686− %h $(a t.a, h.rop (add q.i.a h.rop))
5687− %m $(a t.a, m.rop (add q.i.a m.rop))
5688− %s $(a t.a, s.rop (add q.i.a s.rop))
5689− ==
5690− ;~ plug
5691− %+ most
5692− dot
5693− ;~ pose
5694− ;~(pfix (just 'd') (stag %d dim:ag))
5695− ;~(pfix (just 'h') (stag %h dim:ag))
5696− ;~(pfix (just 'm') (stag %m dim:ag))
5697− ;~(pfix (just 's') (stag %s dim:ag))
5698− ==
5699− ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
5700− ==
5701− ::
5702− (stag %p fed:ag)
5703− ;~(pfix dot (stag %ta urs:ab))
5704− ;~(pfix sig (stag %t urx:ab))
5705− ;~(pfix hep (stag %c (cook taft urx:ab)))
5706− ==
5707− ++ nuck
5708− ~/ %nuck |= a=nail %. a
5709− %+ knee *coin |. ~+
5710− %- stew
5711− ^. stet ^. limo
5712− :~ :- ['a' 'z'] (cook |=(a=@ta [%$ %tas a]) sym)
5713− :- ['0' '9'] (stag %$ bisk)
5714− :- '-' (stag %$ tash)
5715− :- '.' ;~(pfix dot perd)
5716− :- '~' ;~(pfix sig ;~(pose twid (easy [%$ %n 0])))
5717− ==
5718− ++ nusk
5719− ~+
5720− :(sear |=(a=@ta (rush a nuck)) wick urt:ab)
5721− ++ perd
5722− ~+
5723− ;~ pose
5724− (stag %$ zust)
5725− (stag %many (ifix [cab ;~(plug cab cab)] (more cab nusk)))
5726− ==
5727− ++ royl
5728− ~+
5729− ;~ pose
5730− (stag %rh royl-rh)
5731− (stag %rq royl-rq)
5732− (stag %rd royl-rd)
5733− (stag %rs royl-rs)
5734− ==
5735− ::
5736− ++ royl-rh (cook rylh ;~(pfix ;~(plug sig sig) (cook royl-cell royl-rn)))
5737− ++ royl-rq (cook rylq ;~(pfix ;~(plug sig sig sig) (cook royl-cell royl-rn)))
5738− ++ royl-rd (cook ryld ;~(pfix sig (cook royl-cell royl-rn)))
5739− ++ royl-rs (cook ryls (cook royl-cell royl-rn))
5740− ::
5741− ++ royl-rn
5742− =/ moo
5743− |= a=tape
5744− :- (lent a)
5745− (scan a (bass 10 (plus sid:ab)))
5746− ;~ pose
5747− ;~ plug
5748− (easy %d)
5749− ;~(pose (cold | hep) (easy &))
5750− ;~ plug dim:ag
5751− ;~ pose
5752− ;~(pfix dot (cook moo (plus (shim '0' '9'))))
5753− (easy [0 0])
5754− ==
5755− ;~ pose
5756− ;~ pfix
5757− (just 'e')
5758− ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag)
5759− ==
5760− (easy [& 0])
5761− ==
5762− ==
5763− ==
5764− ::
5765− ;~ plug
5766− (easy %i)
5767− ;~ sfix
5768− ;~(pose (cold | hep) (easy &))
5769− (jest 'inf')
5770− ==
5771− ==
5772− ::
5773− ;~ plug
5774− (easy %n)
5775− (cold ~ (jest 'nan'))
5776− ==
5777− ==
5778− ::
5779− ++ royl-cell
5780− |= rn
5781− ^- dn
5782− ?. ?=([%d *] +<) +<
5783− =+ ^= h
5784− (dif:si (new:si f.b i.b) (sun:si d.b))
5785− [%d a h (add (mul c.b (pow 10 d.b)) e.b)]
5786− ::
5787− ++ tash
5788− ~+
5789− =+ ^= neg
5790− |= [syn=? mol=dime] ^- dime
5791− ?> =('u' (end 3 p.mol))
5792− [(cat 3 's' (rsh 3 p.mol)) (new:si syn q.mol)]
5793− ;~ pfix hep
5794− ;~ pose
5795− (cook |=(a=dime (neg | a)) bisk)
5796− ;~(pfix hep (cook |=(a=dime (neg & a)) bisk))
5797− ==
5798− ==
5799− ::
5800− ++ twid
5801− ~+
5802− ;~ pose
5803− %+ stag %blob
5804− %+ sear |=(a=@ (mole |.((cue a))))
5805− ;~(pfix (just '0') vum:ag)
5806− ::
5807− (stag %$ crub)
5808− ==
5809− ::
5810− ++ when
5811− ~+
5812− ;~ plug
5813− %+ cook
5814− |=([a=@ b=?] [b a])
5815− ;~(plug dim:ag ;~(pose (cold | hep) (easy &)))
5816− ;~(pfix dot mot:ag) :: month
5817− ;~(pfix dot dip:ag) :: day
5818− ;~ pose
5819− ;~ pfix
5820− ;~(plug dot dot)
5821− ;~ plug
5822− dum:ag
5823− ;~(pfix dot dum:ag)
5824− ;~(pfix dot dum:ag)
5825− ;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
5826− ==
5827− ==
5828− (easy [0 0 0 ~])
5829− ==
5830− ==
5831− ::
5832− ++ zust
5833− ~+
5834− ;~ pose
5835− (stag %is bip:ag)
5836− (stag %if lip:ag)
5837− royl
5838− (stag %f ;~(pose (cold & (just 'y')) (cold | (just 'n'))))
5839− (stag %q ;~(pfix sig feq:ag))
5840− ==
5841− --
5842−::
5843−:: 4m: formatting functions
5844−+| %formatting-functions
5845−++ scot
5846− ~/ %scot
5847− |=(mol=dime ~(rent co %$ mol))
5848−++ scow
5849− ~/ %scow
5850− |=(mol=dime ~(rend co %$ mol))
5851−++ slat |=(mod=@tas |=(txt=@ta (slaw mod txt)))
5852−++ slav |=([mod=@tas txt=@ta] (need (slaw mod txt)))
5853−++ slaw
5854− ~/ %slaw
5855− |= [mod=@tas txt=@ta]
5856− ^- (unit @)
5857− ?+ mod
5858− :: slow fallback case to the full slay
5859− ::
5860− =+ con=(slay txt)
5861− ?.(&(?=([~ %$ @ @] con) =(p.p.u.con mod)) ~ [~ q.p.u.con])
5862− ::
5863− %da
5864− (rush txt ;~(pfix sig (cook year when:so)))
5865− ::
5866− %p
5867− (rush txt ;~(pfix sig fed:ag))
5868− ::
5869− %ud
5870− (rush txt dem:ag)
5871− ::
5872− %ux
5873− (rush txt ;~(pfix (jest '0x') hex:ag))
5874− ::
5875− %uv
5876− (rush txt ;~(pfix (jest '0v') viz:ag))
5877− ::
5878− %ta
5879− (rush txt ;~(pfix ;~(plug sig dot) urs:ab))
5880− ::
5881− %tas
5882− (rush txt sym)
5883− ==
5884−::
5885−++ slay
5886− |= txt=@ta ^- (unit coin)
5887− =+ ^= vex
5888− ?: (gth 0x7fff.ffff txt) :: XX petty cache
5889− ~+ ((full nuck:so) [[1 1] (trip txt)])
5890− ((full nuck:so) [[1 1] (trip txt)])
5891− ?~ q.vex
5892− ~
5893− [~ p.u.q.vex]
5894−::
5895−++ smyt :: pretty print path
5896− |= bon=path ^- tank
5897− :+ %rose [['/' ~] ['/' ~] ~]
5898− (turn bon |=(a=@ [%leaf (trip a)]))
5899−::
5900−++ spat |=(pax=path (crip (spud pax))) :: render path to cord
5901−++ spud |=(pax=path ~(ram re (smyt pax))) :: render path to tape
5902−++ stab |=(zep=@t `path`(rash zep stap)) :: parse cord to path
5903−++ stap :: path parser
5904− %+ sear
5905− |= p=path
5906− ^- (unit path)
5907− ?: ?=([~ ~] p) `~
5908− ?. =(~ (rear p)) `p
5909− ~
5910− ;~(pfix fas (most fas urs:ab))
5911−::
5912−++ stip :: typed path parser
5913− =< swot
5914− |%
5915− ++ swot |=(n=nail (;~(pfix fas (more fas spot)) n))
5916− ::
5917− ++ spot
5918− %+ sear (soft iota)
5919− %- stew
5920− ^. stet ^. limo
5921− :~ :- 'a'^'z' (stag %tas sym)
5922− :- '$' (cold [%tas %$] buc)
5923− :- '0'^'9' bisk:so
5924− :- '-' tash:so
5925− :- '.' zust:so
5926− :- '~' ;~(pfix sig ;~(pose crub:so (easy [%n ~])))
5927− :- '\'' (stag %t qut)
5928− ==
5929− --
5930−::
5931−++ pout
5932− |= =pith
5933− ^- path
5934− %+ turn pith
5935− |= i=iota
5936− ?@(i i (scot i))
5937−::
5938−++ pave
5939− |= =path
5940− ^- pith
5941− %+ turn path
5942− |= i=@ta
5943− (fall (rush i spot:stip) [%ta i])
5944−::
5945−:: 4n: virtualization
5946−+| %virtualization
5947−::
5948−:: +mack: untyped, scry-less, unitary virtualization
5949−::
5950−++ mack
5951− |= [sub=* fol=*]
5952− ^- (unit)
5953− =/ ton (mink [sub fol] |~(^ ~))
5954− ?.(?=(%0 -.ton) ~ `product.ton)
5955−:: +mink: raw virtual nock
5956−::
5957−++ mink !.
5958− ~/ %mink
5959− |= $: [subject=* formula=*]
5960− scry=$-(^ (unit (unit)))
5961− ==
5962− =| trace=(list [@ta *])
5963− |^ ^- tone
5964− ?+ formula [%2 trace]
5965− [^ *]
5966− =/ head $(formula -.formula)
5967− ?. ?=(%0 -.head) head
5968− =/ tail $(formula +.formula)
5969− ?. ?=(%0 -.tail) tail
5970− [%0 product.head product.tail]
5971− ::
5972− [%0 axis=@]
5973− =/ part (frag axis.formula subject)
5974− ?~ part [%2 trace]
5975− [%0 u.part]
5976− ::
5977− [%1 constant=*]
5978− [%0 constant.formula]
5979− ::
5980− [%2 subject=* formula=*]
5981− =/ subject $(formula subject.formula)
5982− ?. ?=(%0 -.subject) subject
5983− =/ formula $(formula formula.formula)
5984− ?. ?=(%0 -.formula) formula
5985− %= $
5986− subject product.subject
5987− formula product.formula
5988− ==
5989− ::
5990− [%3 argument=*]
5991− =/ argument $(formula argument.formula)
5992− ?. ?=(%0 -.argument) argument
5993− [%0 .?(product.argument)]
5994− ::
5995− [%4 argument=*]
5996− =/ argument $(formula argument.formula)
5997− ?. ?=(%0 -.argument) argument
5998− ?^ product.argument [%2 trace]
5999− [%0 .+(product.argument)]
6000− ::
6001− [%5 a=* b=*]
6002− =/ a $(formula a.formula)
6003− ?. ?=(%0 -.a) a
6004− =/ b $(formula b.formula)
6005− ?. ?=(%0 -.b) b
6006− [%0 =(product.a product.b)]
6007− ::
6008− [%6 test=* yes=* no=*]
6009− =/ result $(formula test.formula)
6010− ?. ?=(%0 -.result) result
6011− ?+ product.result
6012− [%2 trace]
6013− %& $(formula yes.formula)
6014− %| $(formula no.formula)
6015− ==
6016− ::
6017− [%7 subject=* next=*]
6018− =/ subject $(formula subject.formula)
6019− ?. ?=(%0 -.subject) subject
6020− %= $
6021− subject product.subject
6022− formula next.formula
6023− ==
6024− ::
6025− [%8 head=* next=*]
6026− =/ head $(formula head.formula)
6027− ?. ?=(%0 -.head) head
6028− %= $
6029− subject [product.head subject]
6030− formula next.formula
6031− ==
6032− ::
6033− [%9 axis=@ core=*]
6034− =/ core $(formula core.formula)
6035− ?. ?=(%0 -.core) core
6036− =/ arm (frag axis.formula product.core)
6037− ?~ arm [%2 trace]
6038− %= $
6039− subject product.core
6040− formula u.arm
6041− ==
6042− ::
6043− [%10 [axis=@ value=*] target=*]
6044− ?: =(0 axis.formula) [%2 trace]
6045− =/ target $(formula target.formula)
6046− ?. ?=(%0 -.target) target
6047− =/ value $(formula value.formula)
6048− ?. ?=(%0 -.value) value
6049− =/ mutant=(unit *)
6050− (edit axis.formula product.target product.value)
6051− ?~ mutant [%2 trace]
6052− [%0 u.mutant]
6053− ::
6054− [%11 tag=@ next=*]
6055− =/ next $(formula next.formula)
6056− ?. ?=(%0 -.next) next
6057− :- %0
6058− .* subject
6059− [11 tag.formula 1 product.next]
6060− ::
6061− [%11 [tag=@ clue=*] next=*]
6062− =/ clue $(formula clue.formula)
6063− ?. ?=(%0 -.clue) clue
6064− =/ next
6065− =? trace
6066− ?=(?(%hunk %hand %lose %mean %spot) tag.formula)
6067− [[tag.formula product.clue] trace]
6068− $(formula next.formula)
6069− ?. ?=(%0 -.next) next
6070− :- %0
6071− .* subject
6072− [11 [tag.formula 1 product.clue] 1 product.next]
6073− ::
6074− [%12 ref=* path=*]
6075− =/ ref $(formula ref.formula)
6076− ?. ?=(%0 -.ref) ref
6077− =/ path $(formula path.formula)
6078− ?. ?=(%0 -.path) path
6079− =/ result (scry product.ref product.path)
6080− ?~ result
6081− [%1 product.path]
6082− ?~ u.result
6083− [%2 [%hunk product.ref product.path] trace]
6084− [%0 u.u.result]
6085− ==
6086− ::
6087− ++ frag
6088− |= [axis=@ noun=*]
6089− ^- (unit)
6090− ?: =(0 axis) ~
6091− |- ^- (unit)
6092− ?: =(1 axis) `noun
6093− ?@ noun ~
6094− =/ pick (cap axis)
6095− %= $
6096− axis (mas axis)
6097− noun ?-(pick %2 -.noun, %3 +.noun)
6098− ==
6099− ::
6100− ++ edit
6101− |= [axis=@ target=* value=*]
6102− ^- (unit)
6103− ?: =(1 axis) `value
6104− ?@ target ~
6105− =/ pick (cap axis)
6106− =/ mutant
6107− %= $
6108− axis (mas axis)
6109− target ?-(pick %2 -.target, %3 +.target)
6110− ==
6111− ?~ mutant ~
6112− ?- pick
6113− %2 `[u.mutant +.target]
6114− %3 `[-.target u.mutant]
6115− ==
6116− --
6117−:: +mock: virtual nock
6118−::
6119−++ mock
6120− |= [[sub=* fol=*] gul=$-(^ (unit (unit)))]
6121− (mook (mink [sub fol] gul))
6122−:: +mook: convert %tone to %toon, rendering stack frames
6123−::
6124−++ mook
6125− |= ton=tone
6126− ^- toon
6127− ?. ?=([%2 *] ton)
6128− ton
6129− |^ [%2 (turn skip rend)]
6130− ::
6131− ++ skip
6132− ^+ trace.ton
6133− =/ yel (lent trace.ton)
6134− ?. (gth yel 1.024) trace.ton
6135− %+ weld
6136− (scag 512 trace.ton)
6137− ^+ trace.ton
6138− :_ (slag (sub yel 512) trace.ton)
6139− :- %lose
6140− (crip "[skipped {(scow %ud (sub yel 1.024))} frames]")
6141− ::
6142− :: +rend: raw stack frame to tank
6143− ::
6144− :: $% [%hunk ref=* path] :: failed scry ([~ ~])
6145− :: [%lose cord] :: skipped frames
6146− :: [%hand *] :: mug any
6147− :: [%mean $@(cord (trap tank))] :: ~_ et al
6148− :: [%spot spot] :: source location
6149− :: ==
6150− ::
6151− ++ rend
6152− |= [tag=@ta dat=*]
6153− ^- tank
6154− ?+ tag
6155− ::
6156− leaf+"mook.{(rip 3 tag)}"
6157− ::
6158− %hunk
6159− ?@ dat leaf+"mook.hunk"
6160− =/ sof=(unit path) ((soft path) +.dat)
6161− ?~ sof leaf+"mook.hunk"
6162− (smyt u.sof)
6163− ::
6164− %lose
6165− ?^ dat leaf+"mook.lose"
6166− leaf+(rip 3 dat)
6167− ::
6168− %hand
6169− leaf+(scow %p (mug dat))
6170− ::
6171− %mean
6172− ?@ dat leaf+(rip 3 dat)
6173− =/ mac (mack dat -.dat)
6174− ?~ mac leaf+"####"
6175− =/ sof ((soft tank) u.mac)
6176− ?~ sof leaf+"mook.mean"
6177− u.sof
6178− ::
6179− %spot
6180− =/ sof=(unit spot) ((soft spot) dat)
6181− ?~ sof leaf+"mook.spot"
6182− :+ %rose [":" ~ ~]
6183− :~ (smyt p.u.sof)
6184− =* l p.q.u.sof
6185− =* r q.q.u.sof
6186− =/ ud |=(a=@u (scow %ud a))
6187− leaf+"<[{(ud p.l)} {(ud q.l)}].[{(ud p.r)} {(ud q.r)}]>"
6188− ==
6189− ==
6190− --
6191−:: +mole: typed unitary virtual
6192−::
6193−++ mole
6194− ~/ %mole
6195− |* tap=(trap)
6196− ^- (unit _$:tap)
6197− =/ mur (mure tap)
6198− ?~(mur ~ `$:tap)
6199−:: +mong: virtual slam
6200−::
6201−++ mong
6202− |= [[gat=* sam=*] gul=$-(^ (unit (unit)))]
6203− ^- toon
6204− ?. ?=([* ^] gat) [%2 ~]
6205− (mock [gat(+< sam) %9 2 %0 1] gul)
6206−:: +mule: typed virtual
6207−::
6208−++ mule
6209− ~/ %mule
6210− |* tap=(trap)
6211− =/ mud (mute tap)
6212− ?- -.mud
6213− %& [%& p=$:tap]
6214− %| [%| p=p.mud]
6215− ==
6216−:: +mure: untyped unitary virtual
6217−::
6218−++ mure
6219− |= tap=(trap)
6220− ^- (unit)
6221− =/ ton (mink [tap %9 2 %0 1] |=(a=^ ``.*(a [%12 [%0 2] %0 3])))
6222− ?.(?=(%0 -.ton) ~ `product.ton)
6223−:: +mute: untyped virtual
6224−::
6225−++ mute
6226− |= tap=(trap)
6227− ^- (each * (list tank))
6228− =/ ton (mock [tap %9 2 %0 1] |=(a=^ ``.*(a [%12 [%0 2] %0 3])))
6229− ?- -.ton
6230− %0 [%& p.ton]
6231− ::
6232− %1 =/ sof=(unit path) ((soft path) p.ton)
6233− [%| ?~(sof leaf+"mute.hunk" (smyt u.sof)) ~]
6234− ::
6235− %2 [%| p.ton]
6236− ==
6237−:: +slum: slam a gate on a sample using raw nock, untyped
6238−::
6239−++ slum
6240− ~/ %slum
6241− |= sub=[gat=* sam=*]
6242− .*(sub [%9 2 %10 [6 %0 3] %0 2])
6243−:: +soft: virtual clam
6244−::
6245−++ soft
6246− |* han=$-(* *)
6247− |=(fud=* (mole |.((han fud))))
6248−::
6249−:: 4o: molds and mold builders
6250−+| %molds-and-mold-builders
6251−::
6252−+$ abel typo :: original sin: type
6253−+$ alas (list (pair term hoon)) :: alias list
6254−+$ atom @ :: just an atom
6255−+$ aura @ta :: atom format
6256−+$ base :: base mold
6257− $@ $? %noun :: any noun
6258− %cell :: any cell
6259− %flag :: loobean
6260− %null :: ~ == 0
6261− %void :: empty set
6262− == ::
6263− [%atom p=aura] :: atom
6264−::
6265−+$ woof $@(@ [~ p=hoon]) :: simple embed
6266−+$ chum $? lef=term :: jet name
6267− [std=term kel=@] :: kelvin version
6268− [ven=term pro=term kel=@] :: vendor and product
6269− [ven=term pro=term ver=@ kel=@] :: all of the above
6270− == ::
6271−+$ coil $: p=garb :: name, wet=dry, vary
6272− q=type :: context
6273− r=(pair seminoun (map term tome)) :: chapters
6274− == ::
6275−+$ garb (trel (unit term) poly vair) :: core
6276−+$ poly ?(%wet %dry) :: polarity
6277−+$ foot $% [%dry p=hoon] :: dry arm, geometric
6278− [%wet p=hoon] :: wet arm, generic
6279− == ::
6280−+$ link :: lexical segment
6281− $% [%chat p=term] :: |chapter
6282− [%cone p=aura q=atom] :: %constant
6283− [%frag p=term] :: .face
6284− [%funk p=term] :: +arm
6285− [%plan p=term] :: $spec
6286− == ::
6287−+$ cuff (list link) :: parsed lex segments
6288−+$ crib [summary=cord details=(list sect)] ::
6289−+$ help [=cuff =crib] :: documentation
6290−+$ limb $@ term :: wing element
6291− $% [%& p=axis] :: by geometry
6292− [%| p=@ud q=(unit term)] :: by name
6293− == ::
6294− :: XX more and better sanity
6295− ::
6296−+$ null ~ :: null, nil, etc
6297−+$ onyx (list (pair type foot)) :: arm activation
6298−+$ opal :: limb match
6299− $% [%& p=type] :: leg
6300− [%| p=axis q=(set [p=type q=foot])] :: arm
6301− == ::
6302−+$ pica (pair ? cord) :: & prose, | code
6303−+$ palo (pair vein opal) :: wing trace, match
6304−+$ pock (pair axis nock) :: changes
6305−+$ port (each palo (pair type nock)) :: successful match
6306−+$ spec :: structure definition
6307− $~ [%base %null] ::
6308− $% [%base p=base] :: base type
6309− [%dbug p=spot q=spec] :: set debug
6310− [%gist p=[%help p=help] q=spec] :: formal comment
6311− [%leaf p=term q=@] :: constant atom
6312− [%like p=wing q=(list wing)] :: reference
6313− [%loop p=term] :: hygienic reference
6314− [%made p=(pair term (list term)) q=spec] :: annotate synthetic
6315− [%make p=hoon q=(list spec)] :: composed spec
6316− [%name p=term q=spec] :: annotate simple
6317− [%over p=wing q=spec] :: relative to subject
6318− :: ::
6319− [%bcgr p=spec q=spec] :: $>, filter: require
6320− [%bcbc p=spec q=(map term spec)] :: $$, recursion
6321− [%bcbr p=spec q=hoon] :: $|, verify
6322− [%bccb p=hoon] :: $_, example
6323− [%bccl p=[i=spec t=(list spec)]] :: $:, tuple
6324− [%bccn p=[i=spec t=(list spec)]] :: $%, head pick
6325− [%bcdt p=spec q=(map term spec)] :: $., read-write core
6326− [%bcgl p=spec q=spec] :: $<, filter: exclude
6327− [%bchp p=spec q=spec] :: $-, function core
6328− [%bckt p=spec q=spec] :: $^, cons pick
6329− [%bcls p=stud q=spec] :: $+, standard
6330− [%bcfs p=spec q=(map term spec)] :: $/, write-only core
6331− [%bcmc p=hoon] :: $;, manual
6332− [%bcpm p=spec q=hoon] :: $&, repair
6333− [%bcsg p=hoon q=spec] :: $~, default
6334− [%bctc p=spec q=(map term spec)] :: $`, read-only core
6335− [%bcts p=skin q=spec] :: $=, name
6336− [%bcpt p=spec q=spec] :: $@, atom pick
6337− [%bcwt p=[i=spec t=(list spec)]] :: $?, full pick
6338− [%bczp p=spec q=(map term spec)] :: $!, opaque core
6339− == ::
6340−+$ tent :: model builder
6341− $% [%| p=wing q=tent r=(list spec)] :: ~(p q r...)
6342− [%& p=(list wing)] :: a.b:c.d
6343− == ::
6344−+$ tiki :: test case
6345− $% [%& p=(unit term) q=wing] :: simple wing
6346− [%| p=(unit term) q=hoon] :: named wing
6347− == ::
6348−+$ skin :: texture
6349− $@ =term :: name/~[term %none]
6350− $% [%base =base] :: base match
6351− [%cell =skin =skin] :: pair
6352− [%dbug =spot =skin] :: trace
6353− [%leaf =aura =atom] :: atomic constant
6354− [%help =help =skin] :: describe
6355− [%name =term =skin] :: apply label
6356− [%over =wing =skin] :: relative to
6357− [%spec =spec =skin] :: cast to
6358− [%wash depth=@ud] :: strip faces
6359− == ::
6360−+$ tome (pair what (map term hoon)) :: core chapter
6361−+$ tope :: topographic type
6362− $@ $? %& :: cell or atom
6363− %| :: atom
6364− == ::
6365− (pair tope tope) :: cell
6366−++ hoot :: hoon tools
6367− |%
6368− +$ beer $@(char [~ p=hoon]) :: simple embed
6369− +$ mane $@(@tas [@tas @tas]) :: XML name+space
6370− +$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node
6371− +$ marl (list tuna) :: dynamic XML nodes
6372− +$ mart (list [n=mane v=(list beer)]) :: dynamic XML attrs
6373− +$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag
6374− +$ mare (each manx marl) :: node or nodes
6375− +$ maru (each tuna marl) :: interp or nodes
6376− +$ tuna :: maybe interpolation
6377− $~ [[%$ ~] ~]
6378− $^ manx
6379− $: ?(%tape %manx %marl %call)
6380− p=hoon
6381− ==
6382− -- ::
6383−+$ hoon :: hoon AST
6384− $~ [%zpzp ~] ::
6385− $^ [p=hoon q=hoon] ::
6386− $% ::
6387− [%$ p=axis] :: simple leg
6388− :: ::
6389− [%base p=base] :: base spec
6390− [%bust p=base] :: bunt base
6391− [%dbug p=spot q=hoon] :: debug info in trace
6392− [%eror p=tape] :: assembly error
6393− [%hand p=type q=nock] :: premade result
6394− [%note p=note q=hoon] :: annotate
6395− [%fits p=hoon q=wing] :: underlying ?=
6396− [%knit p=(list woof)] :: assemble string
6397− [%leaf p=(pair term @)] :: symbol spec
6398− [%limb p=term] :: take limb
6399− [%lost p=hoon] :: not to be taken
6400− [%rock p=term q=*] :: fixed constant
6401− [%sand p=term q=*] :: unfixed constant
6402− [%tell p=(list hoon)] :: render as tape
6403− [%tune p=$@(term tune)] :: minimal face
6404− [%wing p=wing] :: take wing
6405− [%yell p=(list hoon)] :: render as tank
6406− [%xray p=manx:hoot] :: ;foo; templating
6407− :: :::::: cores
6408− [%brbc sample=(lest term) body=spec] :: |$
6409− [%brcb p=spec q=alas r=(map term tome)] :: |_
6410− [%brcl p=hoon q=hoon] :: |:
6411− [%brcn p=(unit term) q=(map term tome)] :: |%
6412− [%brdt p=hoon] :: |.
6413− [%brkt p=hoon q=(map term tome)] :: |^
6414− [%brhp p=hoon] :: |-
6415− [%brsg p=spec q=hoon] :: |~
6416− [%brtr p=spec q=hoon] :: |*
6417− [%brts p=spec q=hoon] :: |=
6418− [%brpt p=(unit term) q=(map term tome)] :: |@
6419− [%brwt p=hoon] :: |?
6420− :: :::::: tuples
6421− [%clcb p=hoon q=hoon] :: :_ [q p]
6422− [%clkt p=hoon q=hoon r=hoon s=hoon] :: :^ [p q r s]
6423− [%clhp p=hoon q=hoon] :: :- [p q]
6424− [%clls p=hoon q=hoon r=hoon] :: :+ [p q r]
6425− [%clsg p=(list hoon)] :: :~ [p ~]
6426− [%cltr p=(list hoon)] :: :* p as a tuple
6427− :: :::::: invocations
6428− [%cncb p=wing q=(list (pair wing hoon))] :: %_
6429− [%cndt p=hoon q=hoon] :: %.
6430− [%cnhp p=hoon q=hoon] :: %-
6431− [%cncl p=hoon q=(list hoon)] :: %:
6432− [%cntr p=wing q=hoon r=(list (pair wing hoon))] :: %*
6433− [%cnkt p=hoon q=hoon r=hoon s=hoon] :: %^
6434− [%cnls p=hoon q=hoon r=hoon] :: %+
6435− [%cnsg p=wing q=hoon r=(list hoon)] :: %~
6436− [%cnts p=wing q=(list (pair wing hoon))] :: %=
6437− :: :::::: nock
6438− [%dtkt p=spec q=hoon] :: .^ nock 11
6439− [%dtls p=hoon] :: .+ nock 4
6440− [%dttr p=hoon q=hoon] :: .* nock 2
6441− [%dtts p=hoon q=hoon] :: .= nock 5
6442− [%dtwt p=hoon] :: .? nock 3
6443− :: :::::: type conversion
6444− [%ktbr p=hoon] :: ^| contravariant
6445− [%ktdt p=hoon q=hoon] :: ^. self-cast
6446− [%ktls p=hoon q=hoon] :: ^+ expression cast
6447− [%kthp p=spec q=hoon] :: ^- structure cast
6448− [%ktpm p=hoon] :: ^& covariant
6449− [%ktsg p=hoon] :: ^~ constant
6450− [%ktts p=skin q=hoon] :: ^= label
6451− [%ktwt p=hoon] :: ^? bivariant
6452− [%kttr p=spec] :: ^* example
6453− [%ktcl p=spec] :: ^: filter
6454− :: :::::: hints
6455− [%sgbr p=hoon q=hoon] :: ~| sell on trace
6456− [%sgcb p=hoon q=hoon] :: ~_ tank on trace
6457− [%sgcn p=chum q=hoon r=tyre s=hoon] :: ~% general jet hint
6458− [%sgfs p=chum q=hoon] :: ~/ function j-hint
6459− [%sggl p=$@(term [p=term q=hoon]) q=hoon] :: ~< backward hint
6460− [%sggr p=$@(term [p=term q=hoon]) q=hoon] :: ~> forward hint
6461− [%sgbc p=term q=hoon] :: ~$ profiler hit
6462− [%sgls p=@ q=hoon] :: ~+ cache=memoize
6463− [%sgpm p=@ud q=hoon r=hoon] :: ~& printf=priority
6464− [%sgts p=hoon q=hoon] :: ~= don't duplicate
6465− [%sgwt p=@ud q=hoon r=hoon s=hoon] :: ~? tested printf
6466− [%sgzp p=hoon q=hoon] :: ~! type on trace
6467− :: :::::: miscellaneous
6468− [%mcts p=marl:hoot] :: ;= list templating
6469− [%mccl p=hoon q=(list hoon)] :: ;: binary to nary
6470− [%mcfs p=hoon] :: ;/ [%$ [%$ p ~] ~]
6471− [%mcgl p=spec q=hoon r=hoon s=hoon] :: ;< bind
6472− [%mcsg p=hoon q=(list hoon)] :: ;~ kleisli arrow
6473− [%mcmc p=spec q=hoon] :: ;; normalize
6474− :: :::::: compositions
6475− [%tsbr p=spec q=hoon] :: =| push bunt
6476− [%tscl p=(list (pair wing hoon)) q=hoon] :: =: q w= p changes
6477− [%tsfs p=skin q=hoon r=hoon] :: =/ typed variable
6478− [%tsmc p=skin q=hoon r=hoon] :: =; =/(q p r)
6479− [%tsdt p=wing q=hoon r=hoon] :: =. r with p as q
6480− [%tswt p=wing q=hoon r=hoon s=hoon] :: =? conditional =.
6481− [%tsgl p=hoon q=hoon] :: =< =>(q p)
6482− [%tshp p=hoon q=hoon] :: =- =+(q p)
6483− [%tsgr p=hoon q=hoon] :: => q w=subject p
6484− [%tskt p=skin q=wing r=hoon s=hoon] :: =^ state machine
6485− [%tsls p=hoon q=hoon] :: =+ q w=[p subject]
6486− [%tssg p=(list hoon)] :: =~ hoon stack
6487− [%tstr p=(pair term (unit spec)) q=hoon r=hoon] :: =* new style
6488− [%tscm p=hoon q=hoon] :: =, overload p in q
6489− :: :::::: conditionals
6490− [%wtbr p=(list hoon)] :: ?| loobean or
6491− [%wthp p=wing q=(list (pair spec hoon))] :: ?- pick case in q
6492− [%wtcl p=hoon q=hoon r=hoon] :: ?: if=then=else
6493− [%wtdt p=hoon q=hoon r=hoon] :: ?. ?:(p r q)
6494− [%wtkt p=wing q=hoon r=hoon] :: ?^ if p is a cell
6495− [%wtgl p=hoon q=hoon] :: ?< ?:(p !! q)
6496− [%wtgr p=hoon q=hoon] :: ?> ?:(p q !!)
6497− [%wtls p=wing q=hoon r=(list (pair spec hoon))] :: ?+ ?- w=default
6498− [%wtpm p=(list hoon)] :: ?& loobean and
6499− [%wtpt p=wing q=hoon r=hoon] :: ?@ if p is atom
6500− [%wtsg p=wing q=hoon r=hoon] :: ?~ if p is null
6501− [%wthx p=skin q=wing] :: ?# if q matches p
6502− [%wtts p=spec q=wing] :: ?= if q matches p
6503− [%wtzp p=hoon] :: ?! loobean not
6504− :: :::::: special
6505− [%zpcm p=hoon q=hoon] :: !,
6506− [%zpgr p=hoon] :: !>
6507− [%zpgl p=spec q=hoon] :: !<
6508− [%zpmc p=hoon q=hoon] :: !;
6509− [%zpts p=hoon] :: !=
6510− [%zppt p=(list wing) q=hoon r=hoon] :: !@
6511− [%zpwt p=$@(p=@ [p=@ q=@]) q=hoon] :: !?
6512− [%zpzp ~] :: !!
6513− == ::
6514−+$ tyre (list [p=term q=hoon]) ::
6515−+$ tyke (list (unit hoon)) ::
6516−:: :::::: virtual nock
6517−+$ nock $^ [p=nock q=nock] :: autocons
6518− $% [%1 p=*] :: constant
6519− [%2 p=nock q=nock] :: compose
6520− [%3 p=nock] :: cell test
6521− [%4 p=nock] :: increment
6522− [%5 p=nock q=nock] :: equality test
6523− [%6 p=nock q=nock r=nock] :: if, then, else
6524− [%7 p=nock q=nock] :: serial compose
6525− [%8 p=nock q=nock] :: push onto subject
6526− [%9 p=@ q=nock] :: select arm and fire
6527− [%10 p=[p=@ q=nock] q=nock] :: edit
6528− [%11 p=$@(@ [p=@ q=nock]) q=nock] :: hint
6529− [%12 p=nock q=nock] :: grab data from sky
6530− [%0 p=@] :: axis select
6531− == ::
6532−+$ note :: type annotation
6533− $% [%help p=help] :: documentation
6534− [%know p=stud] :: global standard
6535− [%made p=term q=(unit (list wing))] :: structure
6536− == ::
6537−+$ type $~ %noun ::
6538− $@ $? %noun :: any nouns
6539− %void :: no noun
6540− == ::
6541− $% [%atom p=term q=(unit @)] :: atom / constant
6542− [%cell p=type q=type] :: ordered pair
6543− [%core p=type q=coil] :: object
6544− [%face p=$@(term tune) q=type] :: namespace
6545− [%fork p=(set type)] :: union
6546− [%hint p=(pair type note) q=type] :: annotation
6547− [%hold p=type q=hoon] :: lazy evaluation
6548− == ::
6549−+$ tony :: ++tone done right
6550− $% [%0 p=tine q=*] :: success
6551− [%1 p=(set)] :: blocks
6552− [%2 p=(list [@ta *])] :: error ~_s
6553− == ::
6554−+$ tine :: partial noun
6555− $@ ~ :: open
6556− $% [%& p=tine q=tine] :: half-blocked
6557− [%| p=(set)] :: fully blocked
6558− == ::
6559−+$ tool $@(term tune) :: type decoration
6560−+$ tune :: complex
6561− $~ [~ ~] ::
6562− $: p=(map term (unit hoon)) :: aliases
6563− q=(list hoon) :: bridges
6564− == ::
6565−+$ typo type :: old type
6566−+$ vase [p=type q=*] :: type-value pair
6567−+$ vise [p=typo q=*] :: old vase
6568−+$ vial ?(%read %rite %both %free) :: co/contra/in/bi
6569−+$ vair ?(%gold %iron %lead %zinc) :: in/contra/bi/co
6570−+$ vein (list (unit axis)) :: search trace
6571−+$ sect (list pica) :: paragraph
6572−+$ whit :: prefix docs parse
6573− $: bat=(map cuff (pair cord (list sect))) :: batch comment
6574− == ::
6575−+$ whiz cord :: postfix doc parse
6576−+$ what (unit (pair cord (list sect))) :: help slogan/section
6577−+$ wing (list limb) :: search path
6578−::
6579−:: +block: abstract identity of resource awaited
6580−::
6581−+$ block
6582− path
6583−::
6584−:: +result: internal interpreter result
6585−::
6586−+$ result
6587− $@(~ seminoun)
6588−::
6589−:: +thunk: fragment constructor
6590−::
6591−+$ thunk
6592− $-(@ud (unit noun))
6593−::
6594−:: +seminoun:
6595−::
6596−+$ seminoun
6597− :: partial noun; blocked subtrees are ~
6598− ::
6599− $~ [[%full / ~ ~] ~]
6600− [mask=stencil data=noun]
6601−::
6602−:: +stencil: noun knowledge map
6603−::
6604−+$ stencil
6605− $% ::
6606− :: %half: noun has partial block substructure
6607− ::
6608− [%half left=stencil rite=stencil]
6609− ::
6610− :: %full: noun is either fully complete, or fully blocked
6611− ::
6612− [%full blocks=(set block)]
6613− ::
6614− :: %lazy: noun can be generated from virtual subtree
6615− ::
6616− [%lazy fragment=axis resolve=thunk]
6617− ==
6618−::
6619−+$ output
6620− :: ~: interpreter stopped
6621− ::
6622− %- unit
6623− $% ::
6624− :: %done: output is complete
6625− ::
6626− [%done p=noun]
6627− ::
6628− :: %wait: output is waiting for resources
6629− ::
6630− [%wait p=(list block)]
6631− ==
6632−:: profiling
6633−+$ doss
6634− $: mon=moan :: sample count
6635− hit=(map term @ud) :: hit points
6636− cut=(map path hump) :: cut points
6637− ==
6638−+$ moan :: sample metric
6639− $: fun=@ud :: samples in C
6640− noc=@ud :: samples in nock
6641− glu=@ud :: samples in glue
6642− mal=@ud :: samples in alloc
6643− far=@ud :: samples in frag
6644− coy=@ud :: samples in copy
6645− euq=@ud :: samples in equal
6646− == ::
6647−::
6648−+$ hump
6649− $: mon=moan :: sample count
6650− out=(map path @ud) :: calls out of
6651− inn=(map path @ud) :: calls into
6652− ==
6653−--
6654−::
6655−~% %pen
6656− +
6657− ==
6658− %ap ap
6659− %ut ut
6660− ==
6661−:: layer-5
6662−::
6663−|%
6664−::
6665−:: 5aa: new partial nock interpreter
6666−+| %new-partial-nock-interpreter
6667−::
6668−++ musk !. :: nock with block set
6669− |%
6670− ++ abet
6671− :: simplify raw result
6672− ::
6673− |= $: :: noy: raw result
6674− ::
6675− noy=result
6676− ==
6677− ^- output
6678− :: propagate stop
6679− ::
6680− ?~ noy ~
6681− :- ~
6682− :: merge all blocking sets
6683− ::
6684− =/ blocks (squash mask.noy)
6685− ?: =(~ blocks)
6686− :: no blocks, data is complete
6687− ::
6688− done/data.noy
6689− :: reduce block set to block list
6690− ::
6691− wait/~(tap in blocks)
6692− ::
6693− ++ araw
6694− :: execute nock on partial subject
6695− ::
6696− |= $: :: bus: subject, a partial noun
6697− :: fol: formula, a complete noun
6698− ::
6699− bus=seminoun
6700− fol=noun
6701− ==
6702− :: interpreter loop
6703− ::
6704− |- ^- result
6705− ?@ fol
6706− :: bad formula, stop
6707− ::
6708− ~
6709− ?: ?=(^ -.fol)
6710− :: hed: interpret head
6711− ::
6712− =+ hed=$(fol -.fol)
6713− :: propagate stop
6714− ::
6715− ?~ hed ~
6716− :: tal: interpret tail
6717− ::
6718− =+ tal=$(fol +.fol)
6719− :: propagate stop
6720− ::
6721− ?~ tal ~
6722− :: combine
6723− ::
6724− (combine hed tal)
6725− ?+ fol
6726− :: bad formula; stop
6727− ::
6728− ~
6729− :: 0; fragment
6730− ::
6731− [%0 b=@]
6732− :: if bad axis, stop
6733− ::
6734− ?: =(0 b.fol) ~
6735− :: reduce to fragment
6736− ::
6737− (fragment b.fol bus)
6738− ::
6739− :: 1; constant
6740− ::
6741− [%1 b=*]
6742− :: constant is complete
6743− ::
6744− [full/~ b.fol]
6745− ::
6746− :: 2; recursion
6747− ::
6748− [%2 b=* c=*]
6749− :: require complete formula
6750− ::
6751− %+ require
6752− :: compute formula with current subject
6753− ::
6754− $(fol c.fol)
6755− |= :: ryf: next formula
6756− ::
6757− ryf=noun
6758− :: lub: next subject
6759− ::
6760− =+ lub=^$(fol b.fol)
6761− :: propagate stop
6762− ::
6763− ?~ lub ~
6764− :: recurse
6765− ::
6766− ^$(fol ryf, bus lub)
6767− ::
6768− :: 3; probe
6769− ::
6770− [%3 b=*]
6771− %+ require
6772− $(fol b.fol)
6773− |= :: fig: probe input
6774− ::
6775− fig=noun
6776− :: yes if cell, no if atom
6777− ::
6778− [full/~ .?(fig)]
6779− ::
6780− :: 4; increment
6781− ::
6782− [%4 b=*]
6783− %+ require
6784− $(fol b.fol)
6785− |= :: fig: increment input
6786− ::
6787− fig=noun
6788− :: stop for cells, increment for atoms
6789− ::
6790− ?^(fig ~ [full/~ +(fig)])
6791− ::
6792− :: 5; compare
6793− ::
6794− [%5 b=* c=*]
6795− %+ require
6796− $(fol b.fol)
6797− |= :: hed: left input
6798− ::
6799− hed=noun
6800− %+ require
6801− ^$(fol c.fol)
6802− |= :: tal: right input
6803− ::
6804− tal=noun
6805− [full/~ =(hed tal)]
6806− ::
6807− :: 6; if-then-else
6808− ::
6809− [%6 b=* c=* d=*]
6810− :: semantic expansion
6811− ::
6812− %+ require
6813− $(fol b.fol)
6814− |= :: fig: boolean
6815− ::
6816− fig=noun
6817− :: apply proper booleans
6818− ::
6819− ?: =(& fig) ^$(fol c.fol)
6820− ?: =(| fig) ^$(fol d.fol)
6821− :: stop on bad test
6822− ::
6823− ~
6824− ::
6825− :: 7; composition
6826− ::
6827− [%7 b=* c=*]
6828− :: one: input
6829− ::
6830− =+ one=$(fol b.fol)
6831− :: propagate stop
6832− ::
6833− ?~ one ~
6834− :: complete composition
6835− ::
6836− $(fol c.fol, bus one)
6837− ::
6838− :: 8; introduction
6839− ::
6840− [%8 b=* c=*]
6841− :: one: input
6842− ::
6843− =+ one=$(fol b.fol)
6844− :: propagate stop
6845− ::
6846− ?~ one ~
6847− :: complete introduction
6848− ::
6849− $(fol c.fol, bus (combine one bus))
6850− ::
6851− :: 9; invocation
6852− ::
6853− [%9 b=* c=*]
6854− :: semantic expansion
6855− ::
6856− ?^ b.fol ~
6857− :: one: core
6858− ::
6859− =+ one=$(fol c.fol)
6860− :: propagate stop
6861− ::
6862− ?~ one ~
6863− :: if core is constant
6864− ::
6865− ?: ?=([[%full ~] *] one)
6866− :: then call virtual nock directly
6867− ::
6868− =+ (mack data.one [%9 b.fol %0 1])
6869− :: propagate stop
6870− ::
6871− ?~ - ~
6872− :: produce result
6873− ::
6874− [[%full ~] u.-]
6875− :: else complete call
6876− ::
6877− %+ require
6878− :: retrieve formula
6879− ::
6880− (fragment b.fol one)
6881− :: continue
6882− ::
6883− |=(noun ^$(bus one, fol +<))
6884− ::
6885− :: 10; edit
6886− ::
6887− [%10 [b=@ c=*] d=*]
6888− :: tar: target of edit
6889− ::
6890− =+ tar=$(fol d.fol)
6891− :: propagate stop
6892− ::
6893− ?~ tar ~
6894− :: inn: inner value
6895− ::
6896− =+ inn=$(fol c.fol)
6897− :: propagate stop
6898− ::
6899− ?~ inn ~
6900− (mutate b.fol inn tar)
6901− ::
6902− :: 11; static hint
6903− ::
6904− [%11 @ c=*]
6905− :: ignore hint
6906− ::
6907− $(fol c.fol)
6908− ::
6909− :: 11; dynamic hint
6910− ::
6911− [%11 [b=* c=*] d=*]
6912− :: noy: dynamic hint
6913− ::
6914− =+ noy=$(fol c.fol)
6915− :: propagate stop
6916− ::
6917− ?~ noy ~
6918− :: if hint is a fully computed trace
6919− ::
6920− ?: &(?=(%spot b.fol) ?=([[%full ~] *] noy))
6921− :: compute within trace
6922− ::
6923− ~_((show %o +.noy) $(fol d.fol))
6924− :: else ignore hint
6925− ::
6926− $(fol d.fol)
6927− ==
6928− ::
6929− ++ apex
6930− :: execute nock on partial subject
6931− ::
6932− |= $: :: bus: subject, a partial noun
6933− :: fol: formula, a complete noun
6934− ::
6935− bus=seminoun
6936− fol=noun
6937− ==
6938− ~+
6939− ^- output
6940− :: simplify result
6941− ::
6942− (abet (araw bus fol))
6943− ::
6944− ++ combine
6945− :: combine a pair of seminouns
6946− ::
6947− |= $: :: hed: head of pair
6948− :: tal: tail of pair
6949− ::
6950− hed=seminoun
6951− tal=seminoun
6952− ==
6953− ^- seminoun
6954− ?. ?& &(?=(%full -.mask.hed) ?=(%full -.mask.tal))
6955− =(=(~ blocks.mask.hed) =(~ blocks.mask.tal))
6956− ==
6957− :: default merge
6958− ::
6959− [half/[mask.hed mask.tal] [data.hed data.tal]]
6960− :: both sides total
6961− ::
6962− ?: =(~ blocks.mask.hed)
6963− :: both sides are complete
6964− ::
6965− [full/~ data.hed data.tal]
6966− :: both sides are blocked
6967− ::
6968− [full/(~(uni in blocks.mask.hed) blocks.mask.tal) ~]
6969− ::
6970− ++ complete
6971− :: complete any laziness
6972− ::
6973− |= bus=seminoun
6974− ^- seminoun
6975− ?- -.mask.bus
6976− %full bus
6977− %lazy :: fragment 1 is the whole thing
6978− ::
6979− ?: =(1 fragment.mask.bus)
6980− :: blocked; we can't get fragment 1 while compiling it
6981− ::
6982− [[%full [~ ~ ~]] ~]
6983− :: execute thunk
6984− ::
6985− =+ (resolve.mask.bus fragment.mask.bus)
6986− :: if product is nil
6987− ::
6988− ?~ -
6989− :: then blocked
6990− ::
6991− [[%full [~ ~ ~]] ~]
6992− :: else use value
6993− ::
6994− [[%full ~] u.-]
6995− %half :: recursive descent
6996− ::
6997− %+ combine
6998− $(bus [left.mask.bus -.data.bus])
6999− $(bus [rite.mask.bus +.data.bus])
7000− ==
7001− ::
7002− ++ fragment
7003− :: seek to an axis in a seminoun
7004− ::
7005− |= $: :: axe: tree address of subtree
7006− :: bus: partial noun
7007− ::
7008− axe=axis
7009− bus=seminoun
7010− ==
7011− ^- result
7012− :: 1 is the root
7013− ::
7014− ?: =(1 axe) bus
7015− :: now: top of axis (2 or 3)
7016− :: lat: rest of axis
7017− ::
7018− =+ [now=(cap axe) lat=(mas axe)]
7019− ?- -.mask.bus
7020− %lazy :: propagate laziness
7021− ::
7022− bus(fragment.mask (peg fragment.mask.bus axe))
7023− ::
7024− %full :: if fully blocked, produce self
7025− ::
7026− ?^ blocks.mask.bus bus
7027− :: descending into atom, stop
7028− ::
7029− ?@ data.bus ~
7030− :: descend into complete cell
7031− ::
7032− $(axe lat, bus [full/~ ?:(=(2 now) -.data.bus +.data.bus)])
7033− ::
7034− %half :: descend into partial cell
7035− ::
7036− %= $
7037− axe lat
7038− bus ?: =(2 now)
7039− [left.mask.bus -.data.bus]
7040− [rite.mask.bus +.data.bus]
7041− == ==
7042− ::
7043− ++ mutate
7044− :: change a single axis in a seminoun
7045− ::
7046− |= $: :: axe: axis within big to change
7047− :: lit: (little) seminoun to insert within big at axe
7048− :: big: seminoun to mutate
7049− ::
7050− axe=@
7051− lit=seminoun
7052− big=seminoun
7053− ==
7054− ^- result
7055− :: stop on zero axis
7056− ::
7057− ?~ axe ~
7058− :: edit root of big means discard it
7059− ::
7060− ?: =(1 axe) lit
7061− :: decompose axis into path of head-tail
7062− ::
7063− |- ^- result
7064− ?: =(2 axe)
7065− :: mutate head of cell
7066− ::
7067− =+ tal=(fragment 3 big)
7068− :: propagate stop
7069− ::
7070− ?~ tal ~
7071− (combine lit tal)
7072− ?: =(3 axe)
7073− :: mutate tail of cell
7074− ::
7075− =+ hed=(fragment 2 big)
7076− :: propagate stop
7077− ::
7078− ?~ hed ~
7079− (combine hed lit)
7080− :: deeper axis: keep one side of big and
7081− :: recurse into the other with smaller axe
7082− ::
7083− =+ mor=(mas axe)
7084− =+ hed=(fragment 2 big)
7085− :: propagate stop
7086− ::
7087− ?~ hed ~
7088− =+ tal=(fragment 3 big)
7089− :: propagate stop
7090− ::
7091− ?~ tal ~
7092− ?: =(2 (cap axe))
7093− :: recurse into the head
7094− ::
7095− =+ mut=$(big hed, axe mor)
7096− :: propagate stop
7097− ::
7098− ?~ mut ~
7099− (combine mut tal)
7100− :: recurse into the tail
7101− ::
7102− =+ mut=$(big tal, axe mor)
7103− :: propagate stop
7104− ::
7105− ?~ mut ~
7106− (combine hed mut)
7107− ::
7108− ++ require
7109− :: require complete intermediate step
7110− ::
7111− |= $: noy=result
7112− yen=$-(* result)
7113− ==
7114− ^- result
7115− :: propagate stop
7116− ::
7117− ?~ noy ~
7118− :: suppress laziness
7119− ::
7120− =/ bus=seminoun (complete noy)
7121− ?< ?=(%lazy -.mask.bus)
7122− :: if partial block, squash blocks and stop
7123− ::
7124− ?: ?=(%half -.mask.bus) [full/(squash mask.bus) ~]
7125− :: if full block, propagate block
7126− ::
7127− ?: ?=(^ blocks.mask.bus) [mask.bus ~]
7128− :: otherwise use complete noun
7129− ::
7130− (yen data.bus)
7131− ::
7132− ++ squash
7133− :: convert stencil to block set
7134− ::
7135− |= tyn=stencil
7136− ^- (set block)
7137− ?- -.tyn
7138− %lazy $(tyn -:(complete tyn ~))
7139− %full blocks.tyn
7140− %half (~(uni in $(tyn left.tyn)) $(tyn rite.tyn))
7141− ==
7142− --
7143−::
7144−:: 5a: compiler utilities
7145−+| %compiler-utilities
7146−::
7147−++ bool `type`(fork [%atom %f `0] [%atom %f `1] ~) :: make loobean
7148−++ cell :: make %cell type
7149− ~/ %cell
7150− |= [hed=type tal=type]
7151− ^- type
7152− ?:(=(%void hed) %void ?:(=(%void tal) %void [%cell hed tal]))
7153−::
7154−++ core :: make %core type
7155− ~/ %core
7156− |= [pac=type con=coil]
7157− ^- type
7158− ?:(=(%void pac) %void [%core pac con])
7159−::
7160−++ hint
7161− |= [p=(pair type note) q=type]
7162− ^- type
7163− ?: =(%void q) %void
7164− ?: =(%noun q) %noun
7165− [%hint p q]
7166−::
7167−++ face :: make %face type
7168− ~/ %face
7169− |= [giz=$@(term tune) der=type]
7170− ^- type
7171− ?: =(%void der)
7172− %void
7173− [%face giz der]
7174−::
7175−++ fork :: make %fork type
7176− ~/ %fork
7177− |= yed=(list type)
7178− =| lez=(set type)
7179− |- ^- type
7180− ?~ yed
7181− ?~ lez %void
7182− ?: ?=([* ~ ~] lez) n.lez
7183− [%fork lez]
7184− %= $
7185− yed t.yed
7186− lez
7187− ?: =(%void i.yed) lez
7188− ?: ?=([%fork *] i.yed) (~(uni in lez) p.i.yed)
7189− (~(put in lez) i.yed)
7190− ==
7191−::
7192−++ cove :: extract [0 *] axis
7193− |= nug=nock
7194− ?- nug
7195− [%0 *] p.nug
7196− [%11 *] $(nug q.nug)
7197− * ~_(leaf+"cove" !!)
7198− ==
7199−++ comb :: combine two formulas
7200− ~/ %comb
7201− |= [mal=nock buz=nock]
7202− ^- nock
7203− ?: ?&(?=([%0 *] mal) !=(0 p.mal))
7204− ?: ?&(?=([%0 *] buz) !=(0 p.buz))
7205− [%0 (peg p.mal p.buz)]
7206− ?: ?=([%2 [%0 *] [%0 *]] buz)
7207− [%2 [%0 (peg p.mal p.p.buz)] [%0 (peg p.mal p.q.buz)]]
7208− [%7 mal buz]
7209− ?: ?=([^ [%0 %1]] mal)
7210− [%8 p.mal buz]
7211− ?: =([%0 %1] buz)
7212− mal
7213− [%7 mal buz]
7214−::
7215−++ cond :: ?: compile
7216− ~/ %cond
7217− |= [pex=nock yom=nock woq=nock]
7218− ^- nock
7219− ?- pex
7220− [%1 %0] yom
7221− [%1 %1] woq
7222− * [%6 pex yom woq]
7223− ==
7224−::
7225−++ cons :: make formula cell
7226− ~/ %cons
7227− |= [vur=nock sed=nock]
7228− ^- nock
7229− :: this optimization can remove crashes which are essential
7230− ::
7231− :: ?: ?=([[%0 *] [%0 *]] +<)
7232− :: ?: ?&(=(+(p.vur) p.sed) =((div p.vur 2) (div p.sed 2)))
7233− :: [%0 (div p.vur 2)]
7234− :: [vur sed]
7235− ?: ?=([[%1 *] [%1 *]] +<)
7236− [%1 p.vur p.sed]
7237− [vur sed]
7238−::
7239−++ fitz :: odor compatibility
7240− ~/ %fitz
7241− |= [yaz=term wix=term]
7242− =+ ^= fiz
7243− |= mot=@ta ^- [p=@ q=@ta]
7244− =+ len=(met 3 mot)
7245− ?: =(0 len)
7246− [0 %$]
7247− =+ tyl=(rsh [3 (dec len)] mot)
7248− ?: &((gte tyl 'A') (lte tyl 'Z'))
7249− [(sub tyl 64) (end [3 (dec len)] mot)]
7250− [0 mot]
7251− =+ [yoz=(fiz yaz) wux=(fiz wix)]
7252− ?& ?| =(0 p.yoz)
7253− =(0 p.wux)
7254− &(!=(0 p.wux) (lte p.wux p.yoz))
7255− ==
7256− |- ?| =(%$ p.yoz)
7257− =(%$ p.wux)
7258− ?& =((end 3 p.yoz) (end 3 p.wux))
7259− $(p.yoz (rsh 3 p.yoz), p.wux (rsh 3 p.wux))
7260− ==
7261− ==
7262− ==
7263−::
7264−++ flan :: loobean &
7265− ~/ %flan
7266− |= [bos=nock nif=nock]
7267− ^- nock
7268− ?: =(bos nif) bos
7269− ?: =([%0 0] bos) nif
7270− ?: =([%0 0] nif) bos
7271− ?- bos
7272− [%1 %1] bos
7273− [%1 %0] nif
7274− *
7275− ?- nif
7276− [%1 %1] nif
7277− [%1 %0] bos
7278− * [%6 bos nif [%1 1]]
7279− ==
7280− ==
7281−::
7282−++ flip :: loobean negation
7283− ~/ %flip
7284− |= dyr=nock
7285− ?: =([%0 0] dyr) dyr
7286− [%6 dyr [%1 1] [%1 0]]
7287−::
7288−++ flor :: loobean |
7289− ~/ %flor
7290− |= [bos=nock nif=nock]
7291− ^- nock
7292− ?: =(bos nif) bos
7293− ?: =([%0 0] bos) nif
7294− ?: =([%0 0] nif) bos
7295− ?- bos
7296− [%1 %1] nif
7297− [%1 %0] bos
7298− *
7299− ?- nif
7300− [%1 %1] bos
7301− [%1 %0] nif
7302− * [%6 bos [%1 0] nif]
7303− ==
7304− ==
7305−::
7306−++ hike
7307− ~/ %hike
7308− |= [a=axis pac=(list (pair axis nock))]
7309− |^ =/ rel=(map axis nock) (roll pac insert)
7310− =/ ord=(list axis) (sort ~(tap in ~(key by rel)) gth)
7311− |- ^- nock
7312− ?~ ord
7313− [%0 a]
7314− =/ b=axis i.ord
7315− =/ c=nock (~(got by rel) b)
7316− =/ d=nock $(ord t.ord)
7317− [%10 [b c] d]
7318− ::
7319− ++ contains
7320− |= [container=axis contained=axis]
7321− ^- ?
7322− =/ big=@ (met 0 container)
7323− =/ small=@ (met 0 contained)
7324− ?: (lte small big) |
7325− =/ dif=@ (sub small big)
7326− =(container (rsh [0 dif] contained))
7327− ::
7328− ++ parent
7329− |= a=axis
7330− `axis`(rsh 0 a)
7331− ::
7332− ++ sibling
7333− |= a=axis
7334− ^- axis
7335− ?~ (mod a 2)
7336− +(a)
7337− (dec a)
7338− ::
7339− ++ insert
7340− |= [e=[axe=axis fol=nock] n=(map axis nock)]
7341− ^- (map axis nock)
7342− ?: =/ a=axis axe.e
7343− |- ^- ?
7344− ?: =(1 a) |
7345− ?: (~(has by n) a)
7346− &
7347− $(a (parent a))
7348− :: parent already in
7349− n
7350− =. n
7351− :: remove children
7352− %+ roll ~(tap by n)
7353− |= [[axe=axis fol=nock] m=_n]
7354− ?. (contains axe.e axe) m
7355− (~(del by m) axe)
7356− =/ sib (sibling axe.e)
7357− =/ un (~(get by n) sib)
7358− ?~ un (~(put by n) axe.e fol.e)
7359− :: replace sibling with parent
7360− %= $
7361− n (~(del by n) sib)
7362− e :- (parent sib)
7363− ?: (gth sib axe.e)
7364− (cons fol.e u.un)
7365− (cons u.un fol.e)
7366− ==
7367− --
7368−::
7369−++ jock
7370− |= rad=?
7371− |= lot=coin ^- hoon
7372− ?- -.lot
7373− ~
7374− ?:(rad [%rock p.lot] [%sand p.lot])
7375− ::
7376− %blob
7377− ?: rad
7378− [%rock %$ p.lot]
7379− ?@(p.lot [%sand %$ p.lot] [$(p.lot -.p.lot) $(p.lot +.p.lot)])
7380− ::
7381− %many
7382− [%cltr (turn p.lot |=(a=coin ^$(lot a)))]
7383− ==
7384−::
7385−++ look
7386− ~/ %look
7387− |= [cog=term dab=(map term hoon)]
7388− =+ axe=1
7389− |- ^- (unit [p=axis q=hoon])
7390− ?- dab
7391− ~ ~
7392− ::
7393− [* ~ ~]
7394− ?:(=(cog p.n.dab) [~ axe q.n.dab] ~)
7395− ::
7396− [* ~ *]
7397− ?: =(cog p.n.dab)
7398− [~ (peg axe 2) q.n.dab]
7399− ?: (gor cog p.n.dab)
7400− ~
7401− $(axe (peg axe 3), dab r.dab)
7402− ::
7403− [* * ~]
7404− ?: =(cog p.n.dab)
7405− [~ (peg axe 2) q.n.dab]
7406− ?: (gor cog p.n.dab)
7407− $(axe (peg axe 3), dab l.dab)
7408− ~
7409− ::
7410− [* * *]
7411− ?: =(cog p.n.dab)
7412− [~ (peg axe 2) q.n.dab]
7413− ?: (gor cog p.n.dab)
7414− $(axe (peg axe 6), dab l.dab)
7415− $(axe (peg axe 7), dab r.dab)
7416− ==
7417−::
7418−++ loot
7419− ~/ %loot
7420− |= [cog=term dom=(map term tome)]
7421− =+ axe=1
7422− |- ^- (unit [p=axis q=hoon])
7423− ?- dom
7424− ~ ~
7425− ::
7426− [* ~ ~]
7427− %+ bind (look cog q.q.n.dom)
7428− |=((pair axis hoon) [(peg axe p) q])
7429− ::
7430− [* ~ *]
7431− =+ yep=(look cog q.q.n.dom)
7432− ?^ yep
7433− [~ (peg (peg axe 2) p.u.yep) q.u.yep]
7434− $(axe (peg axe 3), dom r.dom)
7435− ::
7436− [* * ~]
7437− =+ yep=(look cog q.q.n.dom)
7438− ?^ yep
7439− [~ (peg (peg axe 2) p.u.yep) q.u.yep]
7440− $(axe (peg axe 3), dom l.dom)
7441− ::
7442− [* * *]
7443− =+ yep=(look cog q.q.n.dom)
7444− ?^ yep
7445− [~ (peg (peg axe 2) p.u.yep) q.u.yep]
7446− =+ pey=$(axe (peg axe 6), dom l.dom)
7447− ?^ pey pey
7448− $(axe (peg axe 7), dom r.dom)
7449− ==
7450−::
7451−:: 5b: macro expansion
7452−+| %macro-expansions
7453−::
7454−++ ah :: tiki engine
7455− |_ tik=tiki
7456− ++ blue
7457− |= gen=hoon
7458− ^- hoon
7459− ?. &(?=(%| -.tik) ?=(~ p.tik)) gen
7460− [%tsgr [%$ 3] gen]
7461− ::
7462− ++ teal
7463− |= mod=spec
7464− ^- spec
7465− ?: ?=(%& -.tik) mod
7466− [%over [%& 3]~ mod]
7467− ::
7468− ++ tele
7469− |= syn=skin
7470− ^- skin
7471− ?: ?=(%& -.tik) syn
7472− [%over [%& 3]~ syn]
7473− ::
7474− ++ gray
7475− |= gen=hoon
7476− ^- hoon
7477− ?- -.tik
7478− %& ?~(p.tik gen [%tstr [u.p.tik ~] [%wing q.tik] gen])
7479− %| [%tsls ?~(p.tik q.tik [%ktts u.p.tik q.tik]) gen]
7480− ==
7481− ::
7482− ++ puce
7483− ^- wing
7484− ?- -.tik
7485− %& ?~(p.tik q.tik [u.p.tik ~])
7486− %| [[%& 2] ~]
7487− ==
7488− ::
7489− ++ wthp |= opt=(list (pair spec hoon))
7490− %+ gray %wthp
7491− [puce (turn opt |=([a=spec b=hoon] [a (blue b)]))]
7492− ++ wtkt |=([sic=hoon non=hoon] (gray [%wtkt puce (blue sic) (blue non)]))
7493− ++ wtls |= [gen=hoon opt=(list (pair spec hoon))]
7494− %+ gray %wtls
7495− [puce (blue gen) (turn opt |=([a=spec b=hoon] [a (blue b)]))]
7496− ++ wtpt |=([sic=hoon non=hoon] (gray [%wtpt puce (blue sic) (blue non)]))
7497− ++ wtsg |=([sic=hoon non=hoon] (gray [%wtsg puce (blue sic) (blue non)]))
7498− ++ wthx |=(syn=skin (gray [%wthx (tele syn) puce]))
7499− ++ wtts |=(mod=spec (gray [%wtts (teal mod) puce]))
7500− --
7501−::
7502−++ ax
7503− =+ :* :: .dom: axis to home
7504− :: .hay: wing to home
7505− :: .cox: hygienic context
7506− :: .bug: debug annotations
7507− :: .nut: annotations
7508− :: .def: default expression
7509− ::
7510− dom=`axis`1
7511− hay=*wing
7512− cox=*(map term spec)
7513− bug=*(list spot)
7514− nut=*(unit note)
7515− def=*(unit hoon)
7516− ==
7517− |_ mod=spec
7518− ::
7519− ++ autoname
7520− :: derive name from spec
7521− ::
7522− |- ^- (unit term)
7523− ?- -.mod
7524− %base ?.(?=([%atom *] p.mod) ~ ?:(=(%$ p.p.mod) `%atom `p.p.mod))
7525− %dbug $(mod q.mod)
7526− %gist $(mod q.mod)
7527− %leaf `p.mod
7528− %loop `p.mod
7529− %like ?~(p.mod ~ ?^(i.p.mod ?:(?=(%& -.i.p.mod) ~ q.i.p.mod) `i.p.mod))
7530− %make ~(name ap p.mod)
7531− %made $(mod q.mod)
7532− %over $(mod q.mod)
7533− %name $(mod q.mod)
7534− ::
7535− %bcbc $(mod p.mod)
7536− %bcbr $(mod p.mod)
7537− %bccb ~(name ap p.mod)
7538− %bccl $(mod i.p.mod)
7539− %bccn $(mod i.p.mod)
7540− %bcdt ~
7541− %bcgl $(mod q.mod)
7542− %bcgr $(mod q.mod)
7543− %bchp $(mod p.mod)
7544− %bckt $(mod q.mod)
7545− %bcls $(mod q.mod)
7546− %bcfs ~
7547− %bcmc ~(name ap p.mod)
7548− %bcpm $(mod p.mod)
7549− %bcsg $(mod q.mod)
7550− %bctc ~
7551− %bcts $(mod q.mod)
7552− %bcpt $(mod q.mod)
7553− %bcwt $(mod i.p.mod)
7554− %bczp ~
7555− ==
7556− ::
7557− ++ function
7558− :: construct a function example
7559− ::
7560− |= [fun=spec arg=spec]
7561− ^- hoon
7562− :: minimal context as subject
7563− ::
7564− :+ %tsgr
7565− :: context is example of both specs
7566− ::
7567− [example:clear(mod fun) example:clear(mod arg)]
7568− :: produce an %iron (contravariant) core
7569− ::
7570− :- %ktbr
7571− :: make an actual gate
7572− ::
7573− :+ %brcl
7574− [%$ 2]
7575− [%$ 15]
7576− ::
7577− ++ interface
7578− :: construct a core example
7579− ::
7580− |= [variance=vair payload=spec arms=(map term spec)]
7581− ^- hoon
7582− :: attach proper variance control
7583− ::
7584− =- ?- variance
7585− %gold -
7586− %lead [%ktwt -]
7587− %zinc [%ktpm -]
7588− %iron [%ktbr -]
7589− ==
7590− ^- hoon
7591− :+ %tsgr example:clear(mod payload)
7592− :+ %brcn ~
7593− =- [[%$ ~ -] ~ ~]
7594− %- ~(gas by *(map term hoon))
7595− %+ turn
7596− ~(tap by arms)
7597− |= [=term =spec]
7598− ::
7599− :: note that we *don't* make arm specs in an interface
7600− :: hygienic -- we leave them in context, to support
7601− :: maximum programmer flexibility
7602− ::
7603− [term example:clear(mod spec)]
7604− ::
7605− ++ home
7606− :: express a hoon against the original subject
7607− ::
7608− |= gen=hoon
7609− ^- hoon
7610− =/ ,wing
7611− ?: =(1 dom)
7612− hay
7613− (weld hay `wing`[[%& dom] ~])
7614− ?~ - gen
7615− [%tsgr [%wing -] gen]
7616− ::
7617− ++ clear
7618− :: clear annotations
7619− ^+ .
7620− .(bug ~, def ~, nut ~)
7621− ::
7622− ++ basal
7623− :: example base case
7624− ::
7625− |= bas=base
7626− ?- bas
7627− ::
7628− [%atom *]
7629− :: we may want sped
7630− ::
7631− [%sand p.bas ?:(=(%da p.bas) ~2000.1.1 0)]
7632− ::
7633− %noun
7634− :: raw nock produces noun type
7635− ::
7636− =+([%rock %$ 0] [%ktls [%dttr - - [%rock %$ 1]] -])
7637− ::
7638− %cell
7639− :: reduce to pair of nouns
7640− ::
7641− =+($(bas %noun) [- -])
7642− ::
7643− %flag
7644− :: comparison produces boolean type
7645− ::
7646− =+([%rock %$ 0] [%ktls [%dtts - -] -])
7647− ::
7648− %null
7649− [%rock %n 0]
7650− ::
7651− %void
7652− [%zpzp ~]
7653− ==
7654− ::
7655− ++ unfold
7656− |= [fun=hoon arg=(list spec)]
7657− ^- hoon
7658− [%cncl fun (turn arg |=(spec ktcl/+<))]
7659− ::
7660− ++ unreel
7661− |= [one=wing res=(list wing)]
7662− ^- hoon
7663− ?~(res [%wing one] [%tsgl [%wing one] $(one i.res, res t.res)])
7664− ::
7665− ++ descend
7666− :: record an axis to original subject
7667− ::
7668− |= axe=axis
7669− +>(dom (peg axe dom))
7670− ::
7671− ++ decorate
7672− :: apply documentation to expression
7673− ::
7674− |= gen=hoon
7675− ^- hoon
7676− =- ?~(nut - [%note u.nut -])
7677− |-
7678− ?~(bug gen [%dbug i.bug $(bug t.bug)])
7679− ::
7680− ++ pieces
7681− :: enumerate tuple wings
7682− ::
7683− |= =(list term)
7684− ^- (^list wing)
7685− (turn list |=(=term `wing`[term ~]))
7686− ::
7687− ++ spore
7688− :: build default sample
7689− ::
7690− ^- hoon
7691− :: sample is always typeless
7692− ::
7693− :+ %ktls
7694− [%bust %noun]
7695− :: consume debugging context
7696− ::
7697− %- decorate
7698− :: use home as subject
7699− ::
7700− %- home
7701− :: if default is set, use it
7702− ::
7703− ?^ def u.def
7704− :: else map structure to expression
7705− ::
7706− ~+
7707− |- ^- hoon
7708− ?- mod
7709− [%base *] ?:(=(%void p.mod) [%rock %n 0] (basal p.mod))
7710− [%bcbc *] :: track hygienic recursion points lexically
7711− ::
7712− %= $
7713− mod p.mod
7714− cox :: merge lexically and don't forget %$
7715− ::
7716− (~(put by ^+(cox (~(uni by cox) q.mod))) %$ p.mod)
7717− ==
7718− [%dbug *] [%dbug p.mod $(mod q.mod)]
7719− [%gist *] $(mod q.mod)
7720− [%leaf *] [%rock p.mod q.mod]
7721− [%loop *] ~|([%loop p.mod] $(mod (~(got by cox) p.mod)))
7722− [%like *] $(mod bcmc/(unreel p.mod q.mod))
7723− [%made *] $(mod q.mod)
7724− [%make *] $(mod bcmc/(unfold p.mod q.mod))
7725− [%name *] $(mod q.mod)
7726− [%over *] $(hay p.mod, mod q.mod)
7727− ::
7728− [%bcbr *] $(mod p.mod)
7729− [%bccb *] [%rock %n 0]
7730− [%bccl *] |- ^- hoon
7731− ?~ t.p.mod ^$(mod i.p.mod)
7732− :- ^$(mod i.p.mod)
7733− $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
7734− [%bccn *] :: use last entry
7735− ::
7736− |- ^- hoon
7737− ?~ t.p.mod ^$(mod i.p.mod)
7738− $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
7739− [%bchp *] :: see under %bccb
7740− ::
7741− [%rock %n 0]
7742− [%bcgl *] $(mod q.mod)
7743− [%bcgr *] $(mod q.mod)
7744− [%bckt *] $(mod q.mod)
7745− [%bcls *] [%note [%know p.mod] $(mod q.mod)]
7746− [%bcmc *] :: borrow sample
7747− ::
7748− [%tsgl [%$ 6] p.mod]
7749− [%bcpm *] $(mod p.mod)
7750− [%bcsg *] [%kthp q.mod p.mod]
7751− [%bcts *] [%ktts p.mod $(mod q.mod)]
7752− [%bcpt *] $(mod p.mod)
7753− [%bcwt *] :: use last entry
7754− ::
7755− |- ^- hoon
7756− ?~ t.p.mod ^$(mod i.p.mod)
7757− $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
7758− [%bcdt *] [%rock %n 0]
7759− [%bcfs *] [%rock %n 0]
7760− [%bctc *] [%rock %n 0]
7761− [%bczp *] [%rock %n 0]
7762− ==
7763− ::
7764− ++ example
7765− :: produce a correctly typed default instance
7766− ::
7767− ~+
7768− ^- hoon
7769− ?+ mod
7770− :: in the general case, make and analyze a spore
7771− ::
7772− :+ %tsls
7773− spore
7774− ~(relative analyze:(descend 3) 2)
7775− ::
7776− [%base *] (decorate (basal p.mod))
7777− [%dbug *] example(mod q.mod, bug [p.mod bug])
7778− [%gist *] example(mod q.mod, nut `p.mod)
7779− [%leaf *] (decorate [%rock p.mod q.mod])
7780− [%like *] example(mod bcmc/(unreel p.mod q.mod))
7781− [%loop *] [%limb p.mod]
7782− [%made *] example(mod q.mod, nut `made/[p.p.mod `(pieces q.p.mod)])
7783− [%make *] example(mod bcmc/(unfold p.mod q.mod))
7784− [%name *] example(mod q.mod, nut `made/[p.mod ~])
7785− [%over *] example(hay p.mod, mod q.mod)
7786− ::
7787− [%bccb *] (decorate (home p.mod))
7788− [%bccl *] %- decorate
7789− |- ^- hoon
7790− ?~ t.p.mod
7791− example:clear(mod i.p.mod)
7792− :- example:clear(mod i.p.mod)
7793− example:clear(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
7794− [%bchp *] (decorate (function:clear p.mod q.mod))
7795− [%bcmc *] (decorate (home [%tsgl [%limb %$] p.mod]))
7796− [%bcsg *] [%ktls example(mod q.mod) (home p.mod)]
7797− [%bcls *] (decorate [%note [%know p.mod] example(mod q.mod)])
7798− [%bcts *] (decorate [%ktts p.mod example:clear(mod q.mod)])
7799− [%bcdt *] (decorate (home (interface %gold p.mod q.mod)))
7800− [%bcfs *] (decorate (home (interface %iron p.mod q.mod)))
7801− [%bczp *] (decorate (home (interface %lead p.mod q.mod)))
7802− [%bctc *] (decorate (home (interface %zinc p.mod q.mod)))
7803− ==
7804− ::
7805− ++ factory
7806− :: make a normalizing gate (mold)
7807− ::
7808− ^- hoon
7809− :: process annotations outside construct, to catch default
7810− ::
7811− ::TODO: try seeing if putting %gist in here fixes %brbc
7812− ?: ?=(%dbug -.mod) factory(mod q.mod, bug [p.mod bug])
7813− ?: ?=(%bcsg -.mod) factory(mod q.mod, def `[%kthp q.mod p.mod])
7814− ^- hoon
7815− :: if we recognize an indirection
7816− ::
7817− ?: &(=(~ def) ?=(?(%bcmc %like %loop %make) -.mod))
7818− :: then short-circuit it
7819− ::
7820− %- decorate
7821− %- home
7822− ?- -.mod
7823− %bcmc p.mod
7824− %like (unreel p.mod q.mod)
7825− %loop [%limb p.mod]
7826− %make (unfold p.mod q.mod)
7827− ==
7828− :: else build a gate
7829− ::
7830− :+ %brcl
7831− [%ktsg spore]
7832− :+ %tsls
7833− ~(relative analyze:(descend 7) 6)
7834− :: trigger unifying equality
7835− ::
7836− :+ %tsls [%dtts $/14 $/2]
7837− $/6
7838− ::
7839− ++ analyze
7840− :: normalize a fragment of the subject
7841− ::
7842− |_ $: :: axe: axis to fragment
7843− ::
7844− axe=axis
7845− ==
7846− ++ basic
7847− |= bas=base
7848− ^- hoon
7849− ?- bas
7850− [%atom *]
7851− :+ %ktls example
7852− ^- hoon
7853− :^ %zppt
7854− [[[%| 0 `%ruth] ~] ~]
7855− [%cnls [%limb %ruth] [%sand %ta p.bas] fetch]
7856− [%wtpt fetch-wing fetch [%zpzp ~]]
7857− ::
7858− %cell
7859− :+ %ktls example
7860− =+ fetch-wing
7861− :- [%wing [[%& %2] -]]
7862− [%wing [[%& %3] -]]
7863− ::
7864− %flag
7865− :^ %wtcl
7866− [%dtts [%rock %$ &] [%$ axe]]
7867− [%rock %f &]
7868− :+ %wtgr
7869− [%dtts [%rock %$ |] [%$ axe]]
7870− [%rock %f |]
7871− ::
7872− %noun
7873− fetch
7874− ::
7875− %null
7876− :+ %wtgr
7877− [%dtts [%bust %noun] [%$ axe]]
7878− [%rock %n ~]
7879− :::
7880− %void
7881− [%zpzp ~]
7882− ==
7883− ++ clear
7884− .(..analyze ^clear)
7885− ::
7886− ++ fetch
7887− :: load the fragment
7888− ::
7889− ^- hoon
7890− [%$ axe]
7891− ::
7892− ++ fetch-wing
7893− :: load, as a wing
7894− ::
7895− ^- wing
7896− [[%& axe] ~]
7897− ::
7898− ++ choice
7899− :: match full models, by trying them
7900− ::
7901− |= $: :: one: first option
7902− :: rep: other options
7903− ::
7904− one=spec
7905− rep=(list spec)
7906− ==
7907− ^- hoon
7908− :: if no other choices, construct head
7909− ::
7910− ?~ rep relative:clear(mod one)
7911− :: build test
7912− ::
7913− :^ %wtcl
7914− :: if we fit the type of this choice
7915− ::
7916− [%fits example:clear(mod one) fetch-wing]
7917− :: build with this choice
7918− ::
7919− relative:clear(mod one)
7920− :: continue through loop
7921− ::
7922− $(one i.rep, rep t.rep)
7923− ::
7924− ++ switch
7925− |= $: :: one: first format
7926− :: two: more formats
7927− ::
7928− one=spec
7929− rep=(list spec)
7930− ==
7931− |- ^- hoon
7932− :: if no other choices, construct head
7933− ::
7934− ?~ rep relative:clear(mod one)
7935− :: fin: loop completion
7936− ::
7937− =/ fin=hoon $(one i.rep, rep t.rep)
7938− :: interrogate this instance
7939− ::
7940− :^ %wtcl
7941− :: test if the head matches this wing
7942− ::
7943− :+ %fits
7944− [%tsgl [%$ 2] example:clear(mod one)]
7945− fetch-wing(axe (peg axe 2))
7946− :: if so, use this form
7947− ::
7948− relative:clear(mod one)
7949− :: continue in the loop
7950− ::
7951− fin
7952− ::
7953− ++ relative
7954− :: local constructor
7955− ::
7956− ~+
7957− ^- hoon
7958− ?- mod
7959− ::
7960− :: base
7961− ::
7962− [%base *]
7963− (decorate (basic:clear p.mod))
7964− ::
7965− :: debug
7966− ::
7967− [%dbug *]
7968− relative(mod q.mod, bug [p.mod bug])
7969− ::
7970− :: formal comment
7971− ::
7972− [%gist *]
7973− relative(mod q.mod, nut `p.mod)
7974− ::
7975− :: constant
7976− ::
7977− [%leaf *]
7978− %- decorate
7979− :+ %wtgr
7980− [%dtts fetch [%rock %$ q.mod]]
7981− [%rock p.mod q.mod]
7982− ::
7983− :: composite
7984− ::
7985− [%make *]
7986− relative(mod bcmc/(unfold p.mod q.mod))
7987− ::
7988− :: indirect
7989− ::
7990− [%like *]
7991− relative(mod bcmc/(unreel p.mod q.mod))
7992− ::
7993− :: loop
7994− ::
7995− [%loop *]
7996− (decorate [%cnhp [%limb p.mod] fetch])
7997− ::
7998− :: simple named structure
7999− ::
8000− [%name *]
8001− relative(mod q.mod, nut `made/[p.mod ~])
8002− ::
8003− :: synthetic named structure
8004− ::
8005− [%made *]
8006− relative(mod q.mod, nut `made/[p.p.mod `(pieces q.p.mod)])
8007− ::
8008− :: subjective
8009− ::
8010− [%over *]
8011− relative(hay p.mod, mod q.mod)
8012− ::
8013− :: recursive, $$
8014− ::
8015− [%bcbc *]
8016− ::
8017− :: apply semantically
8018− ::
8019− :+ %brkt
8020− relative(mod p.mod, dom (peg 3 dom))
8021− =- [[%$ ~ -] ~ ~]
8022− %- ~(gas by *(map term hoon))
8023− ^- (list (pair term hoon))
8024− %+ turn
8025− ~(tap by q.mod)
8026− |= [=term =spec]
8027− [term relative(mod spec, dom (peg 3 dom))]
8028− ::
8029− :: normalize, $&
8030− ::
8031− [%bcpm *]
8032− :: push the raw result
8033− ::
8034− :+ %tsls relative(mod p.mod)
8035− :: push repair function
8036− ::
8037− :+ %tsls
8038− [%tsgr $/3 q.mod]
8039− :: push repaired product
8040− ::
8041− :+ %tsls
8042− [%cnhp $/2 $/6]
8043− :: sanity-check repaired product
8044− ::
8045− :+ %wtgr
8046− :: either
8047− ::
8048− :~ %wtbr
8049− :: the repair did not change anything
8050− ::
8051− [%dtts $/14 $/2]
8052− :: when we fix it again, it stays fixed
8053− ::
8054− [%dtts $/2 [%cnhp $/6 $/2]]
8055− ==
8056− $/2
8057− ::
8058− :: verify, $|
8059− ::
8060− [%bcbr *]
8061− ^- hoon
8062− :: push the raw product
8063− ::
8064− :+ %tsls relative(mod p.mod)
8065− ^- hoon
8066− :: assert
8067− ::
8068− :+ %wtgr
8069− :: run the verifier
8070− ::
8071− [%cnhp [%tsgr $/3 q.mod] $/2]
8072− :: produce verified product
8073− ::
8074− $/2
8075− ::
8076− :: special, $_
8077− ::
8078− [%bccb *]
8079− (decorate (home p.mod))
8080− ::
8081− :: switch, $%
8082− ::
8083− [%bccn *]
8084− (decorate (switch i.p.mod t.p.mod))
8085− ::
8086− :: tuple, $:
8087− ::
8088− [%bccl *]
8089− %- decorate
8090− |- ^- hoon
8091− ?~ t.p.mod
8092− relative:clear(mod i.p.mod)
8093− :- relative:clear(mod i.p.mod, axe (peg axe 2))
8094− %= relative
8095− i.p.mod i.t.p.mod
8096− t.p.mod t.t.p.mod
8097− axe (peg axe 3)
8098− ==
8099− ::
8100− :: exclude, $<
8101− ::
8102− [%bcgl *]
8103− :+ %tsls
8104− relative:clear(mod q.mod)
8105− :+ %wtgl
8106− [%wtts [%over ~[&/3] p.mod] ~[&/4]]
8107− $/2
8108− ::
8109− :: require, $>
8110− ::
8111− [%bcgr *]
8112− :+ %tsls
8113− relative:clear(mod q.mod)
8114− :+ %wtgr
8115− [%wtts [%over ~[&/3] p.mod] ~[&/4]]
8116− $/2
8117− ::
8118− :: function
8119− ::
8120− [%bchp *]
8121− %- decorate
8122− =/ fun (function:clear p.mod q.mod)
8123− ?^ def
8124− [%ktls fun u.def]
8125− fun
8126− ::
8127− :: bridge, $^
8128− ::
8129− [%bckt *]
8130− %- decorate
8131− :^ %wtcl
8132− [%dtwt fetch(axe (peg axe 2))]
8133− relative:clear(mod p.mod)
8134− relative:clear(mod q.mod)
8135− ::
8136− :: synthesis, $;
8137− ::
8138− [%bcmc *]
8139− (decorate [%cncl (home p.mod) fetch ~])
8140− ::
8141− :: default
8142− ::
8143− [%bcsg *]
8144− relative(mod q.mod, def `[%kthp q.mod p.mod])
8145− ::
8146− :: choice, $?
8147− ::
8148− [%bcwt *]
8149− (decorate (choice i.p.mod t.p.mod))
8150− ::
8151− :: name, $=
8152− ::
8153− [%bcts *]
8154− [%ktts p.mod relative(mod q.mod)]
8155− ::
8156− :: branch, $@
8157− ::
8158− [%bcpt *]
8159− %- decorate
8160− :^ %wtcl
8161− [%dtwt fetch]
8162− relative:clear(mod q.mod)
8163− relative:clear(mod p.mod)
8164− ::
8165− [%bcls *] [%note [%know p.mod] relative(mod q.mod)]
8166− [%bcdt *] (decorate (home (interface %gold p.mod q.mod)))
8167− [%bcfs *] (decorate (home (interface %iron p.mod q.mod)))
8168− [%bczp *] (decorate (home (interface %lead p.mod q.mod)))
8169− [%bctc *] (decorate (home (interface %zinc p.mod q.mod)))
8170− ==
8171− --
8172− --
8173−::
8174−++ ap :: hoon engine
8175− ~% %ap
8176− +>+
8177− ==
8178− %open open
8179− %rake rake
8180− ==
8181− |_ gen=hoon
8182− ::
8183− ++ grip
8184− |= =skin
8185− =| rel=wing
8186− |- ^- hoon
8187− ?- skin
8188− @
8189− [%tsgl [%tune skin] gen]
8190− [%base *]
8191− ?: ?=(%noun base.skin)
8192− gen
8193− [%kthp skin gen]
8194− ::
8195− [%cell *]
8196− =+ haf=~(half ap gen)
8197− ?^ haf
8198− :- $(skin skin.skin, gen p.u.haf)
8199− $(skin ^skin.skin, gen q.u.haf)
8200− :+ %tsls
8201− gen
8202− :- $(skin skin.skin, gen [%$ 4])
8203− $(skin ^skin.skin, gen [%$ 5])
8204− ::
8205− [%dbug *]
8206− [%dbug spot.skin $(skin skin.skin)]
8207− ::
8208− [%leaf *]
8209− [%kthp skin gen]
8210− ::
8211− [%help *]
8212− [%note [%help help.skin] $(skin skin.skin)]
8213− ::
8214− [%name *]
8215− [%tsgl [%tune term.skin] $(skin skin.skin)]
8216− ::
8217− [%over *]
8218− $(skin skin.skin, rel (weld wing.skin rel))
8219− ::
8220− [%spec *]
8221− :+ %kthp
8222− ?~(rel spec.skin [%over rel spec.skin])
8223− $(skin skin.skin)
8224− ::
8225− [%wash *]
8226− :+ %tsgl
8227− :- %wing
8228− |- ^- wing
8229− ?: =(0 depth.skin) ~
8230− [[%| 0 ~] $(depth.skin (dec depth.skin))]
8231− gen
8232− ==
8233− ::
8234− ++ name
8235− |- ^- (unit term)
8236− ?+ gen ~
8237− [%wing *] ?~ p.gen ~
8238− ?^ i.p.gen
8239− ?:(?=(%& -.i.p.gen) ~ q.i.p.gen)
8240− `i.p.gen
8241− [%limb *] `p.gen
8242− [%dbug *] $(gen ~(open ap gen))
8243− [%tsgl *] $(gen ~(open ap gen))
8244− [%tsgr *] $(gen q.gen)
8245− ==
8246− ::
8247− ++ feck
8248− |- ^- (unit term)
8249− ?- gen
8250− [%sand %tas @] [~ q.gen]
8251− [%dbug *] $(gen q.gen)
8252− * ~
8253− ==
8254− ::
8255− :: not used at present; see comment at %csng in ++open
8256−::::
8257−::++ hail
8258−:: |= axe=axis
8259−:: =| air=(list (pair wing hoon))
8260−:: |- ^+ air
8261−:: =+ hav=half
8262−:: ?~ hav [[[[%| 0 ~] [%& axe] ~] gen] air]
8263−:: $(gen p.u.hav, axe (peg axe 2), air $(gen q.u.hav, axe (peg axe 3)))
8264−::
8265− ++ half
8266− |- ^- (unit (pair hoon hoon))
8267− ?+ gen ~
8268− [^ *] `[p.gen q.gen]
8269− [%dbug *] $(gen q.gen)
8270− [%clcb *] `[q.gen p.gen]
8271− [%clhp *] `[p.gen q.gen]
8272− [%clkt *] `[p.gen %clls q.gen r.gen s.gen]
8273− [%clsg *] ?~(p.gen ~ `[i.p.gen %clsg t.p.gen])
8274− [%cltr *] ?~ p.gen ~
8275− ?~(t.p.gen $(gen i.p.gen) `[i.p.gen %cltr t.p.gen])
8276− ==
8277−::::
8278− :: +flay: hoon to skin
8279− ::
8280− ++ flay
8281− |- ^- (unit skin)
8282− ?+ gen
8283− =+(open ?:(=(- gen) ~ $(gen -)))
8284− ::
8285− [^ *]
8286− =+ [$(gen p.gen) $(gen q.gen)]
8287− ?~(-< ~ ?~(-> ~ `[%cell -<+ ->+]))
8288− ::
8289− [%base *]
8290− `gen
8291− ::
8292− [%rock *]
8293− ?@(q.gen `[%leaf p.gen q.gen] ~)
8294− ::
8295− [%cnts [@ ~] ~]
8296− `i.p.gen
8297− ::
8298− [%tsgr *]
8299− %+ biff reek(gen p.gen)
8300− |= =wing
8301− (bind ^$(gen q.gen) |=(=skin [%over wing skin]))
8302− ::
8303− [%limb @]
8304− `p.gen
8305− ::
8306− :: [%rock *]
8307− :: [%spec %leaf q.gen q.gen]
8308− ::
8309− [%note [%help *] *]
8310− (bind $(gen q.gen) |=(=skin [%help p.p.gen skin]))
8311− ::
8312− [%wing *]
8313− ?: ?=([@ ~] p.gen)
8314− `i.p.gen
8315− =/ depth 0
8316− |- ^- (unit skin)
8317− ?~ p.gen `[%wash depth]
8318− ?. =([%| 0 ~] i.p.gen) ~
8319− $(p.gen t.p.gen)
8320− ::
8321− [%kttr *]
8322− `[%spec p.gen %base %noun]
8323− ::
8324− [%ktts *]
8325− %+ biff $(gen q.gen)
8326− |= =skin
8327− ?@ p.gen `[%name p.gen skin]
8328− ?. ?=([%name @ [%base %noun]] p.gen) ~
8329− `[%name term.p.gen skin]
8330− ==
8331− ::
8332− :: +open: desugarer
8333− ++ open
8334− ^- hoon
8335− ?- gen
8336− [~ *] [%cnts [[%& p.gen] ~] ~]
8337− ::
8338− [%base *] ~(factory ax `spec`gen)
8339− [%bust *] ~(example ax %base p.gen)
8340− [%ktcl *] ~(factory ax p.gen)
8341− [%dbug *] q.gen
8342− [%eror *] ~_((crip p.gen) !!)
8343− ::
8344− [%knit *] ::
8345− :+ %tsgr [%ktts %v %$ 1] :: => v=.
8346− :- %brhp :: |-
8347− :+ %ktls :: ^+
8348− :- %brhp :: |-
8349− :^ %wtcl :: ?:
8350− [%bust %flag] :: ?
8351− [%bust %null] :: ~
8352− :- [%ktts %i [%sand 'tD' *@]] :: :- i=~~
8353− [%ktts %t [%limb %$]] :: t=$
8354− |- ^- hoon ::
8355− ?~ p.gen ::
8356− [%bust %null] :: ~
8357− =+ res=$(p.gen t.p.gen) ::
8358− ^- hoon ::
8359− ?@ i.p.gen ::
8360− [[%sand 'tD' i.p.gen] res] :: [~~{i.p.gen} {res}]
8361− :+ %tsls ::
8362− :- :+ %ktts :: ^=
8363− %a :: a
8364− :+ %ktls :: ^+
8365− [%limb %$] :: $
8366− [%tsgr [%limb %v] p.i.p.gen] :: =>(v {p.i.p.gen})
8367− [%ktts %b res] :: b=[res]
8368− ^- hoon ::
8369− :- %brhp :: |-
8370− :^ %wtpt :: ?@
8371− [%a ~] :: a
8372− [%limb %b] :: b
8373− :- [%tsgl [%$ 2] [%limb %a]] :: :- -.a
8374− :+ %cnts :: %=
8375− [%$ ~] :: $
8376− [[[%a ~] [%tsgl [%$ 3] [%limb %a]]] ~] :: a +.a
8377− ::
8378− [%leaf *] ~(factory ax `spec`gen)
8379− [%limb *] [%cnts [p.gen ~] ~]
8380− [%tell *] [%cncl [%limb %noah] [%zpgr [%cltr p.gen]] ~]
8381− [%wing *] [%cnts p.gen ~]
8382− [%yell *] [%cncl [%limb %cain] [%zpgr [%cltr p.gen]] ~]
8383− [%note *] q.gen
8384− ::
8385− ::TODO: does %gist need to be special cased here?
8386− [%brbc *] =- ?~ - !!
8387− :+ %brtr
8388− [%bccl -]
8389− |-
8390− ?. ?=([%gist *] body.gen)
8391− [%ktcl body.gen]
8392− [%note p.body.gen $(body.gen q.body.gen)]
8393− %+ turn `(list term)`sample.gen
8394− |= =term
8395− ^- spec
8396− =/ tar [%base %noun]
8397− [%bcts term [%bcsg tar [%bchp tar tar]]]
8398− [%brcb *] :+ %tsls [%kttr p.gen]
8399− :+ %brcn ~
8400− %- ~(run by r.gen)
8401− |= =tome
8402− :- p.tome
8403− %- ~(run by q.tome)
8404− |= =hoon
8405− ?~ q.gen hoon
8406− [%tstr [p.i.q.gen ~] q.i.q.gen $(q.gen t.q.gen)]
8407− [%brcl *] [%tsls p.gen [%brdt q.gen]]
8408− [%brdt *] :+ %brcn ~
8409− =- [[%$ ~ -] ~ ~]
8410− (~(put by *(map term hoon)) %$ p.gen)
8411− [%brkt *] :+ %tsgl [%limb %$]
8412− :+ %brcn ~
8413− =+ zil=(~(get by q.gen) %$)
8414− ?~ zil
8415− %+ ~(put by q.gen) %$
8416− [*what [[%$ p.gen] ~ ~]]
8417− %+ ~(put by q.gen) %$
8418− [p.u.zil (~(put by q.u.zil) %$ p.gen)]
8419− [%brhp *] [%tsgl [%limb %$] [%brdt p.gen]]
8420− [%brsg *] [%ktbr [%brts p.gen q.gen]]
8421− [%brtr *] :+ %tsls [%kttr p.gen]
8422− :+ %brpt ~
8423− =- [[%$ ~ -] ~ ~]
8424− (~(put by *(map term hoon)) %$ q.gen)
8425− [%brts *] :+ %brcb p.gen
8426− =- [~ [[%$ ~ -] ~ ~]]
8427− (~(put by *(map term hoon)) %$ q.gen)
8428− [%brwt *] [%ktwt %brdt p.gen]
8429− ::
8430− [%clkt *] [p.gen q.gen r.gen s.gen]
8431− [%clls *] [p.gen q.gen r.gen]
8432− [%clcb *] [q.gen p.gen]
8433− [%clhp *] [p.gen q.gen]
8434− [%clsg *]
8435− |- ^- hoon
8436− ?~ p.gen
8437− [%rock %n ~]
8438− [i.p.gen $(p.gen t.p.gen)]
8439− ::
8440− [%cltr *]
8441− |- ^- hoon
8442− ?~ p.gen
8443− [%zpzp ~]
8444− ?~ t.p.gen
8445− i.p.gen
8446− [i.p.gen $(p.gen t.p.gen)]
8447− ::
8448− [%kttr *] [%ktsg ~(example ax p.gen)]
8449− [%cncb *] [%ktls [%wing p.gen] %cnts p.gen q.gen]
8450− [%cndt *] [%cncl q.gen [p.gen ~]]
8451− [%cnkt *] [%cncl p.gen q.gen r.gen s.gen ~]
8452− [%cnls *] [%cncl p.gen q.gen r.gen ~]
8453− [%cnhp *] [%cncl p.gen q.gen ~]
8454− :: this probably should work, but doesn't
8455− ::
8456− :: [%cncl *] [%cntr [%$ ~] p.gen [[[[%& 6] ~] [%cltr q.gen]] ~]]
8457− [%cncl *] [%cnsg [%$ ~] p.gen q.gen]
8458− [%cnsg *]
8459− :: this complex matching system is a leftover from the old
8460− :: "electroplating" era. %cnsg should be removed and replaced
8461− :: with the commented-out %cncl above. but something is broken.
8462− ::
8463− :^ %cntr p.gen q.gen
8464− =+ axe=6
8465− |- ^- (list [wing hoon])
8466− ?~ r.gen ~
8467− ?~ t.r.gen [[[[%| 0 ~] [%& axe] ~] i.r.gen] ~]
8468− :- [[[%| 0 ~] [%& (peg axe 2)] ~] i.r.gen]
8469− $(axe (peg axe 3), r.gen t.r.gen)
8470− ::
8471− [%cntr *]
8472− ?: =(~ r.gen)
8473− [%tsgr q.gen [%wing p.gen]]
8474− :+ %tsls
8475− q.gen
8476− :+ %cnts
8477− (weld p.gen `wing`[[%& 2] ~])
8478− (turn r.gen |=([p=wing q=hoon] [p [%tsgr [%$ 3] q]]))
8479− ::
8480− [%ktdt *] [%ktls [%cncl p.gen q.gen ~] q.gen]
8481− [%kthp *] [%ktls ~(example ax p.gen) q.gen]
8482− [%ktts *] (grip(gen q.gen) p.gen)
8483− ::
8484− [%sgbr *]
8485− :+ %sggr
8486− :- %mean
8487− =+ fek=~(feck ap p.gen)
8488− ?^ fek [%rock %tas u.fek]
8489− [%brdt [%cncl [%limb %cain] [%zpgr [%tsgr [%$ 3] p.gen]] ~]]
8490− q.gen
8491− ::
8492− [%sgcb *] [%sggr [%mean [%brdt p.gen]] q.gen]
8493− [%sgcn *]
8494− :+ %sggl
8495− :- %fast
8496− :- %clls
8497− :+ [%rock %$ p.gen]
8498− [%zpts q.gen]
8499− :- %clsg
8500− =+ nob=`(list hoon)`~
8501− |- ^- (list hoon)
8502− ?~ r.gen
8503− nob
8504− [[[%rock %$ p.i.r.gen] [%zpts q.i.r.gen]] $(r.gen t.r.gen)]
8505− s.gen
8506− ::
8507− [%sgfs *] [%sgcn p.gen [%$ 7] ~ q.gen]
8508− [%sggl *] [%tsgl [%sggr p.gen [%$ 1]] q.gen]
8509− [%sgbc *] [%sggr [%live [%rock %$ p.gen]] q.gen]
8510− [%sgls *] [%sggr [%memo %rock %$ p.gen] q.gen]
8511− [%sgpm *]
8512− :+ %sggr
8513− [%slog [%sand %$ p.gen] [%cncl [%limb %cain] [%zpgr q.gen] ~]]
8514− r.gen
8515− ::
8516− [%sgts *] [%sggr [%germ p.gen] q.gen]
8517− [%sgwt *]
8518− :+ %tsls [%wtdt q.gen [%bust %null] [[%bust %null] r.gen]]
8519− :^ %wtsg [%& 2]~
8520− [%tsgr [%$ 3] s.gen]
8521− [%sgpm p.gen [%$ 5] [%tsgr [%$ 3] s.gen]]
8522− ::
8523− [%mcts *]
8524− |-
8525− ?~ p.gen [%bust %null]
8526− ?- -.i.p.gen
8527− ^ [[%xray i.p.gen] $(p.gen t.p.gen)]
8528− %manx [p.i.p.gen $(p.gen t.p.gen)]
8529− %tape [[%mcfs p.i.p.gen] $(p.gen t.p.gen)]
8530− %call [%cncl p.i.p.gen [$(p.gen t.p.gen)]~]
8531− %marl =- [%cndt [p.i.p.gen $(p.gen t.p.gen)] -]
8532− ^- hoon
8533− :+ %tsbr [%base %cell]
8534− :+ %brpt ~
8535− ^- (map term tome)
8536− =- [[%$ ~ -] ~ ~]
8537− ^- (map term hoon)
8538− :_ [~ ~]
8539− =+ sug=[[%& 12] ~]
8540− :- %$
8541− :^ %wtsg sug
8542− [%cnts sug [[[[%& 1] ~] [%$ 13]] ~]]
8543− [%cnts sug [[[[%& 3] ~] [%cnts [%$ ~] [[sug [%$ 25]] ~]]] ~]]
8544− ==
8545− ::
8546− [%mccl *]
8547− ?- q.gen
8548− ~ [%zpzp ~]
8549− [* ~] i.q.gen
8550− ^
8551− :+ %tsls
8552− p.gen
8553− =+ yex=`(list hoon)`q.gen
8554− |- ^- hoon
8555− ?- yex
8556− [* ~] [%tsgr [%$ 3] i.yex]
8557− [* ^] [%cncl [%$ 2] [%tsgr [%$ 3] i.yex] $(yex t.yex) ~]
8558− ~ !!
8559− ==
8560− ==
8561− ::
8562− [%mcfs *] =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~])
8563− [%mcgl *] [%cnls [%cnhp q ktcl+p] r [%brts p [%tsgr $+3 s]]]:gen
8564− ::
8565− [%mcsg *] :: ;~
8566− |- ^- hoon
8567− ?- q.gen
8568− ~ ~_(leaf+"open-mcsg" !!)
8569− ^
8570− :+ %tsgr [%ktts %v %$ 1] :: => v=.
8571− |- ^- hoon ::
8572− ?: ?=(~ t.q.gen) ::
8573− [%tsgr [%limb %v] i.q.gen] :: =>(v {i.q.gen})
8574− :+ %tsls [%ktts %a $(q.gen t.q.gen)] :: =+ ^= a
8575− :+ %tsls :: {$(q.gen t.q.gen)}
8576− [%ktts %b [%tsgr [%limb %v] i.q.gen]] :: =+ ^= b
8577− :+ %tsls :: =>(v {i.q.gen})
8578− :+ %ktts %c :: =+ c=,.+6.b
8579− :+ %tsgl ::
8580− [%wing [%| 0 ~] [%& 6] ~] ::
8581− [%limb %b] ::
8582− :- %brdt :: |.
8583− :^ %cnls :: %+
8584− [%tsgr [%limb %v] p.gen] :: =>(v {p.gen})
8585− [%cncl [%limb %b] [%limb %c] ~] :: (b c)
8586− :+ %cnts [%a ~] :: a(,.+6 c)
8587− [[[[%| 0 ~] [%& 6] ~] [%limb %c]] ~] ::
8588− == ::
8589− ::
8590− [%mcmc *] :: ;;
8591− [%cnhp ~(factory ax p.gen) q.gen]
8592− ::
8593− [%tsbr *]
8594− [%tsls ~(example ax p.gen) q.gen]
8595− ::
8596− [%tstr *]
8597− :+ %tsgl
8598− r.gen
8599− [%tune [[p.p.gen ~ ?~(q.p.gen q.gen [%kthp u.q.p.gen q.gen])] ~ ~] ~]
8600− ::
8601− [%tscl *]
8602− [%tsgr [%cncb [[%& 1] ~] p.gen] q.gen]
8603− ::
8604− [%tsfs *]
8605− [%tsls [%ktts p.gen q.gen] r.gen]
8606− ::
8607− [%tsmc *] [%tsfs p.gen r.gen q.gen]
8608− [%tsdt *]
8609− [%tsgr [%cncb [[%& 1] ~] [[p.gen q.gen] ~]] r.gen]
8610− [%tswt *] :: =?
8611− [%tsdt p.gen [%wtcl q.gen r.gen [%wing p.gen]] s.gen]
8612− ::
8613− [%tskt *] :: =^
8614− =+ wuy=(weld q.gen `wing`[%v ~]) ::
8615− :+ %tsgr [%ktts %v %$ 1] :: => v=.
8616− :+ %tsls [%ktts %a %tsgr [%limb %v] r.gen] :: =+ a==>(v \r.gen)
8617− :^ %tsdt wuy [%tsgl [%$ 3] [%limb %a]]
8618− :+ %tsgr :- :+ %ktts [%over [%v ~] p.gen]
8619− [%tsgl [%$ 2] [%limb %a]]
8620− [%limb %v]
8621− s.gen
8622− ::
8623− [%tsgl *] [%tsgr q.gen p.gen]
8624− [%tsls *] [%tsgr [p.gen [%$ 1]] q.gen]
8625− [%tshp *] [%tsls q.gen p.gen]
8626− [%tssg *]
8627− |- ^- hoon
8628− ?~ p.gen [%$ 1]
8629− ?~ t.p.gen i.p.gen
8630− [%tsgr i.p.gen $(p.gen t.p.gen)]
8631− ::
8632− [%wtbr *]
8633− |-
8634− ?~(p.gen [%rock %f 1] [%wtcl i.p.gen [%rock %f 0] $(p.gen t.p.gen)])
8635− ::
8636− [%wtdt *] [%wtcl p.gen r.gen q.gen]
8637− [%wtgl *] [%wtcl p.gen [%zpzp ~] q.gen]
8638− [%wtgr *] [%wtcl p.gen q.gen [%zpzp ~]]
8639− [%wtkt *] [%wtcl [%wtts [%base %atom %$] p.gen] r.gen q.gen]
8640− ::
8641− [%wthp *]
8642− |-
8643− ?~ q.gen
8644− [%lost [%wing p.gen]]
8645− :^ %wtcl
8646− [%wtts p.i.q.gen p.gen]
8647− q.i.q.gen
8648− $(q.gen t.q.gen)
8649− ::
8650− [%wtls *]
8651− [%wthp p.gen (weld r.gen `_r.gen`[[[%base %noun] q.gen] ~])]
8652− ::
8653− [%wtpm *]
8654− |-
8655− ?~(p.gen [%rock %f 0] [%wtcl i.p.gen $(p.gen t.p.gen) [%rock %f 1]])
8656− ::
8657− [%xray *]
8658− |^ :- [(open-mane n.g.p.gen) %clsg (turn a.g.p.gen open-mart)]
8659− [%mcts c.p.gen]
8660− ::
8661− ++ open-mane
8662− |= a=mane:hoot
8663− ?@(a [%rock %tas a] [[%rock %tas -.a] [%rock %tas +.a]])
8664− ::
8665− ++ open-mart
8666− |= [n=mane:hoot v=(list beer:hoot)]
8667− [(open-mane n) %knit v]
8668− --
8669− ::
8670− [%wtpt *] [%wtcl [%wtts [%base %atom %$] p.gen] q.gen r.gen]
8671− [%wtsg *] [%wtcl [%wtts [%base %null] p.gen] q.gen r.gen]
8672− [%wtts *] [%fits ~(example ax p.gen) q.gen]
8673− [%wtzp *] [%wtcl p.gen [%rock %f 1] [%rock %f 0]]
8674− [%zpgr *]
8675− [%cncl [%limb %onan] [%zpmc [%kttr [%bcmc %limb %abel]] p.gen] ~]
8676− ::
8677− [%zpwt *]
8678− ?: ?: ?=(@ p.gen)
8679− (lte hoon-version p.gen)
8680− &((lte hoon-version p.p.gen) (gte hoon-version q.p.gen))
8681− q.gen
8682− ~_(leaf+"hoon-version" !!)
8683− ::
8684− * gen
8685− ==
8686− ::
8687− ++ rake ~>(%mean.'rake-hoon' (need reek))
8688− ++ reek
8689− ^- (unit wing)
8690− ?+ gen ~
8691− [~ *] `[[%& p.gen] ~]
8692− [%limb *] `[p.gen ~]
8693− [%wing *] `p.gen
8694− [%cnts * ~] `p.gen
8695− [%dbug *] reek(gen q.gen)
8696− ==
8697− ++ rusk
8698− ^- term
8699− =+ wig=rake
8700− ?. ?=([@ ~] wig)
8701− ~>(%mean.'rusk-hoon' !!)
8702− i.wig
8703− --
8704−::
8705−:: 5c: compiler backend and prettyprinter
8706−+| %compiler-backend-and-prettyprinter
8707−::
8708−++ ut
8709− ~% %ut
8710− +>+
8711− ==
8712− %ar ar
8713− %fan fan
8714− %rib rib
8715− %vet vet
8716− %blow blow
8717− %burp burp
8718− %busk busk
8719− %buss buss
8720− %crop crop
8721− %duck duck
8722− %dune dune
8723− %dunk dunk
8724− %epla epla
8725− %emin emin
8726− %emul emul
8727− %feel feel
8728− %felt felt
8729− %fine fine
8730− %fire fire
8731− %fish fish
8732− %fond fond
8733− %fund fund
8734− %funk funk
8735− %fuse fuse
8736− %gain gain
8737− %lose lose
8738− %mile mile
8739− %mine mine
8740− %mint mint
8741− %moot moot
8742− %mull mull
8743− %nest nest
8744− %peel peel
8745− %play play
8746− %peek peek
8747− %repo repo
8748− %rest rest
8749− %sink sink
8750− %tack tack
8751− %toss toss
8752− %wrap wrap
8753− ==
8754− =+ :* fan=*(set [type hoon])
8755− rib=*(set [type type hoon])
8756− vet=`?`&
8757− ==
8758− =+ sut=`type`%noun
8759− |%
8760− ++ clip
8761− |= ref=type
8762− ?> ?|(!vet (nest(sut ref) & sut))
8763− ref
8764− ::
8765− :: +ar: texture engine
8766− ::
8767− ++ ar !:
8768− ~% %ar
8769− +>
8770− ==
8771− %fish fish
8772− %gain gain
8773− %lose lose
8774− ==
8775− |_ [ref=type =skin]
8776− ::
8777− :: +fish: make a $nock that tests a .ref at .axis for .skin
8778− ::
8779− ++ fish
8780− |= =axis
8781− ^- nock
8782− ?@ skin [%1 &]
8783− ?- -.skin
8784− ::
8785− %base
8786− ?- base.skin
8787− %cell $(skin [%cell [%base %noun] [%base %noun]])
8788− %flag ?: (~(nest ut bool) | ref)
8789− [%1 &]
8790− %+ flan
8791− $(skin [%base %atom %$])
8792− %+ flor
8793− [%5 [%0 axis] [%1 &]]
8794− [%5 [%0 axis] [%1 |]]
8795− %noun [%1 &]
8796− %null $(skin [%leaf %n ~])
8797− %void [%1 |]
8798− [%atom *] ?: (~(nest ut [%atom %$ ~]) | ref)
8799− [%1 &]
8800− ?: (~(nest ut [%cell %noun %noun]) | ref)
8801− [%1 |]
8802− (flip [%3 %0 axis])
8803− ==
8804− ::
8805− %cell
8806− ?: (~(nest ut [%atom %$ ~]) | ref) [%1 |]
8807− %+ flan
8808− ?: (~(nest ut [%cell %noun %noun]) | ref)
8809− [%1 &]
8810− [%3 %0 axis]
8811− %+ flan
8812− $(ref (peek(sut ref) %free 2), skin skin.skin)
8813− $(ref (peek(sut ref) %free 3), skin ^skin.skin)
8814− ::
8815− %leaf
8816− ?: (~(nest ut [%atom %$ `atom.skin]) | ref)
8817− [%1 &]
8818− [%5 [%1 atom.skin] [%0 axis]]
8819− ::
8820− %dbug $(skin skin.skin)
8821− %help $(skin skin.skin)
8822− %name $(skin skin.skin)
8823− %over $(skin skin.skin)
8824− %spec $(skin skin.skin)
8825− %wash [%1 1]
8826− ==
8827− ::
8828− :: +gain: make a $type by restricting .ref to .skin
8829− ::
8830− ++ gain
8831− |- ^- type
8832− ?@ skin [%face skin ref]
8833− ?- -.skin
8834− ::
8835− %base
8836− ?- base.skin
8837− %cell $(skin [%cell [%base %noun] [%base %noun]])
8838− %flag (fork $(skin [%leaf %f &]) $(skin [%leaf %f |]) ~)
8839− %null $(skin [%leaf %n ~])
8840− %void %void
8841− %noun ?:((~(nest ut %void) | ref) %void ref)
8842− [%atom *]
8843− =| gil=(set type)
8844− |- ^- type
8845− ?- ref
8846− %void %void
8847− %noun [%atom p.base.skin ~]
8848− [%atom *] ?. (fitz p.base.skin p.ref)
8849− ~>(%mean.'atom-mismatch' !!)
8850− :+ %atom
8851− (max p.base.skin p.ref)
8852− q.ref
8853− [%cell *] %void
8854− [%core *] %void
8855− [%face *] (face p.ref $(ref q.ref))
8856− [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
8857− [%hint *] (hint p.ref $(ref q.ref))
8858− [%hold *] ?: (~(has in gil) ref) %void
8859− $(gil (~(put in gil) ref), ref repo(sut ref))
8860− ==
8861− ==
8862− ::
8863− %cell
8864− =| gil=(set type)
8865− |- ^- type
8866− ?- ref
8867− %void %void
8868− %noun [%cell %noun %noun]
8869− [%atom *] %void
8870− [%cell *] =+ ^$(skin skin.skin, ref p.ref)
8871− ?: =(%void -) %void
8872− (cell - ^$(skin ^skin.skin, ref q.ref))
8873− [%core *] =+ ^$(skin skin.skin, ref p.ref)
8874− ?: =(%void -) %void
8875− ?. =(%noun ^skin.skin)
8876− (cell - ^$(skin ^skin.skin, ref %noun))
8877− [%core - q.ref]
8878− [%face *] (face p.ref $(ref q.ref))
8879− [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
8880− [%hint *] (hint p.ref $(ref q.ref))
8881− [%hold *] ?: (~(has in gil) ref) %void
8882− $(gil (~(put in gil) ref), ref repo(sut ref))
8883− ==
8884− ::
8885− %leaf
8886− =| gil=(set type)
8887− |- ^- type
8888− ?- ref
8889− %void %void
8890− %noun [%atom aura.skin `atom.skin]
8891− [%atom *] ?: &(?=(^ q.ref) !=(atom.skin u.q.ref))
8892− %void
8893− ?. (fitz aura.skin p.ref)
8894− ~>(%mean.'atom-mismatch' !!)
8895− :+ %atom
8896− (max aura.skin p.ref)
8897− `atom.skin
8898− [%cell *] %void
8899− [%core *] %void
8900− [%face *] (face p.ref $(ref q.ref))
8901− [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
8902− [%hint *] (hint p.ref $(ref q.ref))
8903− [%hold *] ?: (~(has in gil) ref) %void
8904− $(gil (~(put in gil) ref), ref repo(sut ref))
8905− ==
8906− ::
8907− %dbug $(skin skin.skin)
8908− %help (hint [sut %help help.skin] $(skin skin.skin))
8909− %name (face term.skin $(skin skin.skin))
8910− %over $(skin skin.skin, sut (~(play ut sut) %wing wing.skin))
8911− %spec =/ yon $(skin skin.skin)
8912− =/ hit (~(play ut sut) ~(example ax spec.skin))
8913− ?> (~(nest ut hit) & yon)
8914− hit
8915− %wash =- $(ref (~(play ut ref) -))
8916− :- %wing
8917− |- ^- wing
8918− ?: =(0 depth.skin) ~
8919− [[%| 0 ~] $(depth.skin (dec depth.skin))]
8920− ==
8921− ::
8922− :: +lose: make a $type by restricting .ref to exclude .skin
8923− ::
8924− ++ lose
8925− |- ^- type
8926− ?@ skin [%face skin ref]
8927− ?- -.skin
8928− ::
8929− %base
8930− ?- base.skin
8931− %cell $(skin [%cell [%base %noun] [%base %noun]])
8932− %flag $(skin [%base %atom %f])
8933− %null $(skin [%leaf %n ~])
8934− %void ref
8935− %noun %void
8936− [%atom *]
8937− =| gil=(set type)
8938− |- ^- type
8939− ?- ref
8940− %void %void
8941− %noun [%cell %noun %noun]
8942− [%atom *] %void
8943− [%cell *] ref
8944− [%core *] ref
8945− [%face *] (face p.ref $(ref q.ref))
8946− [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
8947− [%hint *] (hint p.ref $(ref q.ref))
8948− [%hold *] ?: (~(has in gil) ref) %void
8949− $(gil (~(put in gil) ref), ref repo(sut ref))
8950− ==
8951− ==
8952− ::
8953− %cell
8954− =| gil=(set type)
8955− |- ^- type
8956− ?- ref
8957− %void %void
8958− %noun [%atom %$ ~]
8959− [%atom *] ref
8960− [%cell *] =+ ^$(skin skin.skin, ref p.ref)
8961− ?: =(%void -) %void
8962− (cell - ^$(skin ^skin.skin, ref q.ref))
8963− [%core *] =+ ^$(skin skin.skin, ref p.ref)
8964− ?: =(%void -) %void
8965− ?. =(%noun ^skin.skin)
8966− (cell - ^$(skin ^skin.skin, ref %noun))
8967− [%core - q.ref]
8968− [%face *] (face p.ref $(ref q.ref))
8969− [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
8970− [%hint *] (hint p.ref $(ref q.ref))
8971− [%hold *] ?: (~(has in gil) ref) %void
8972− $(gil (~(put in gil) ref), ref repo(sut ref))
8973− ==
8974− ::
8975− %leaf
8976− =| gil=(set type)
8977− |- ^- type
8978− ?- ref
8979− %void %void
8980− %noun %noun
8981− [%atom *] ?: =(q.ref `atom.skin)
8982− %void
8983− ref
8984− [%cell *] ref
8985− [%core *] ref
8986− [%face *] (face p.ref $(ref q.ref))
8987− [%fork *] (fork (turn ~(tap in p.ref) |=(=type ^$(ref type))))
8988− [%hint *] (hint p.ref $(ref q.ref))
8989− [%hold *] ?: (~(has in gil) ref) %void
8990− $(gil (~(put in gil) ref), ref repo(sut ref))
8991− ==
8992− ::
8993− %dbug $(skin skin.skin)
8994− %help $(skin skin.skin)
8995− %name $(skin skin.skin)
8996− %over $(skin skin.skin)
8997− %spec $(skin skin.skin)
8998− %wash ref
8999− ==
9000− --
9001− ::
9002− ++ blow
9003− |= [gol=type gen=hoon]
9004− ^- [type nock]
9005− =+ pro=(mint gol gen)
9006− =+ jon=(apex:musk bran q.pro)
9007− ?: |(?=(~ jon) ?=(%wait -.u.jon))
9008− [p.pro q.pro]
9009− [p.pro %1 p.u.jon]
9010− ::
9011− ++ bran
9012− ~+
9013− =+ gil=*(set type)
9014− |- ~+ ^- seminoun:musk
9015− ?- sut
9016− %noun [full/[~ ~ ~] ~]
9017− %void [full/[~ ~ ~] ~]
9018− [%atom *] ?~(q.sut [full/[~ ~ ~] ~] [full/~ u.q.sut])
9019− [%cell *] (combine:musk $(sut p.sut) $(sut q.sut))
9020− [%core *] %+ combine:musk
9021− p.r.q.sut
9022− $(sut p.sut)
9023− [%face *] $(sut repo)
9024− [%fork *] [full/[~ ~ ~] ~]
9025− [%hint *] $(sut repo)
9026− [%hold *] ?: (~(has in gil) sut)
9027− [full/[~ ~ ~] ~]
9028− $(sut repo, gil (~(put in gil) sut))
9029− ==
9030− ::
9031− ++ burp
9032− :: expel undigested seminouns
9033− ::
9034− ^- type
9035− ~+
9036− =- ?.(=(sut -) - sut)
9037− ?+ sut sut
9038− [%cell *] [%cell burp(sut p.sut) burp(sut q.sut)]
9039− [%core *] :+ %core
9040− burp(sut p.sut)
9041− :* p.q.sut
9042− burp(sut q.q.sut)
9043− :_ q.r.q.sut
9044− ?: ?=([[%full ~] *] p.r.q.sut)
9045− p.r.q.sut
9046− [[%full ~ ~ ~] ~]
9047− ==
9048− [%face *] [%face p.sut burp(sut q.sut)]
9049− [%fork *] [%fork (~(run in p.sut) |=(type burp(sut +<)))]
9050− [%hint *] (hint [burp(sut p.p.sut) q.p.sut] burp(sut q.sut))
9051− [%hold *] [%hold burp(sut p.sut) q.sut]
9052− ==
9053− ::
9054− ++ busk
9055− ~/ %busk
9056− |= gen=hoon
9057− ^- type
9058− [%face [~ [gen ~]] sut]
9059− ::
9060− ++ buss
9061− ~/ %buss
9062− |= [cog=term gen=hoon]
9063− ^- type
9064− [%face [[[cog ~ gen] ~ ~] ~] sut]
9065− ::
9066− ++ crop
9067− ~/ %crop
9068− |= ref=type
9069− =+ bix=*(set [type type])
9070− =< dext
9071− |%
9072− ++ dext
9073− ^- type
9074− ~_ leaf+"crop"
9075− :: ~_ (dunk 'dext: sut')
9076− :: ~_ (dunk(sut ref) 'dext: ref')
9077− ?: |(=(sut ref) =(%noun ref))
9078− %void
9079− ?: =(%void ref)
9080− sut
9081− ?- sut
9082− [%atom *]
9083− ?+ ref sint
9084− [%atom *] ?^ q.sut
9085− ?^(q.ref ?:(=(q.ref q.sut) %void sut) %void)
9086− ?^(q.ref sut %void)
9087− [%cell *] sut
9088− ==
9089− ::
9090− [%cell *]
9091− ?+ ref sint
9092− [%atom *] sut
9093− [%cell *] ?. (nest(sut p.ref) | p.sut) sut
9094− (cell p.sut dext(sut q.sut, ref q.ref))
9095− ==
9096− ::
9097− [%core *] ?:(?=(?([%atom *] [%cell *]) ref) sut sint)
9098− [%face *] (face p.sut dext(sut q.sut))
9099− [%fork *] (fork (turn ~(tap in p.sut) |=(type dext(sut +<))))
9100− [%hint *] (hint p.sut dext(sut q.sut))
9101− [%hold *] ?< (~(has in bix) [sut ref])
9102− dext(sut repo, bix (~(put in bix) [sut ref]))
9103− %noun dext(sut repo)
9104− %void %void
9105− ==
9106− ::
9107− ++ sint
9108− ^- type
9109− ?+ ref !!
9110− [%core *] sut
9111− [%face *] dext(ref repo(sut ref))
9112− [%fork *] =+ yed=~(tap in p.ref)
9113− |- ^- type
9114− ?~ yed sut
9115− $(yed t.yed, sut dext(ref i.yed))
9116− [%hint *] dext(ref repo(sut ref))
9117− [%hold *] dext(ref repo(sut ref))
9118− ==
9119− --
9120− ::
9121− ++ cool
9122− |= [pol=? hyp=wing ref=type]
9123− ^- type
9124− =+ fid=(find %both hyp)
9125− ?- -.fid
9126− %| sut
9127− %& =< q
9128− %+ take p.p.fid
9129− |=(a=type ?:(pol (fuse(sut a) ref) (crop(sut a) ref)))
9130− ==
9131− ::
9132− ++ duck ^-(tank ~(duck us sut))
9133− ++ dune |.(duck)
9134− ++ dunk
9135− |= paz=term ^- tank
9136− :+ %palm
9137− [['.' ~] ['-' ~] ~ ~]
9138− [[%leaf (mesc (trip paz))] duck ~]
9139− ::
9140− ++ elbo
9141− |= [lop=palo rig=(list (pair wing hoon))]
9142− ^- type
9143− ?: ?=(%& -.q.lop)
9144− |- ^- type
9145− ?~ rig
9146− p.q.lop
9147− =+ zil=(play q.i.rig)
9148− =+ dar=(tack(sut p.q.lop) p.i.rig zil)
9149− %= $
9150− rig t.rig
9151− p.q.lop q.dar
9152− ==
9153− =+ hag=~(tap in q.q.lop)
9154− %- fire
9155− |- ^+ hag
9156− ?~ rig
9157− hag
9158− =+ zil=(play q.i.rig)
9159− =+ dix=(toss p.i.rig zil hag)
9160− %= $
9161− rig t.rig
9162− hag q.dix
9163− ==
9164− ::
9165− ++ ergo
9166− |= [lop=palo rig=(list (pair wing hoon))]
9167− ^- (pair type nock)
9168− =+ axe=(tend p.lop)
9169− =| hej=(list (pair axis nock))
9170− ?: ?=(%& -.q.lop)
9171− =- [p.- (hike axe q.-)]
9172− |- ^- (pair type (list (pair axis nock)))
9173− ?~ rig
9174− [p.q.lop hej]
9175− =+ zil=(mint %noun q.i.rig)
9176− =+ dar=(tack(sut p.q.lop) p.i.rig p.zil)
9177− %= $
9178− rig t.rig
9179− p.q.lop q.dar
9180− hej [[p.dar q.zil] hej]
9181− ==
9182− =+ hag=~(tap in q.q.lop)
9183− =- [(fire p.-) [%9 p.q.lop (hike axe q.-)]]
9184− |- ^- (pair (list (pair type foot)) (list (pair axis nock)))
9185− ?~ rig
9186− [hag hej]
9187− =+ zil=(mint %noun q.i.rig)
9188− =+ dix=(toss p.i.rig p.zil hag)
9189− %= $
9190− rig t.rig
9191− hag q.dix
9192− hej [[p.dix q.zil] hej]
9193− ==
9194− ::
9195− ++ endo
9196− |= [lop=(pair palo palo) dox=type rig=(list (pair wing hoon))]
9197− ^- (pair type type)
9198− ?: ?=(%& -.q.p.lop)
9199− ?> ?=(%& -.q.q.lop)
9200− |- ^- (pair type type)
9201− ?~ rig
9202− [p.q.p.lop p.q.q.lop]
9203− =+ zil=(mull %noun dox q.i.rig)
9204− =+ ^= dar
9205− :- p=(tack(sut p.q.p.lop) p.i.rig p.zil)
9206− q=(tack(sut p.q.q.lop) p.i.rig q.zil)
9207− ?> =(p.p.dar p.q.dar)
9208− %= $
9209− rig t.rig
9210− p.q.p.lop q.p.dar
9211− p.q.q.lop q.q.dar
9212− ==
9213− ?> ?=(%| -.q.q.lop)
9214− ?> =(p.q.p.lop p.q.q.lop)
9215− =+ hag=[p=~(tap in q.q.p.lop) q=~(tap in q.q.q.lop)]
9216− =- [(fire p.-) (fire(vet |) q.-)]
9217− |- ^- (pair (list (pair type foot)) (list (pair type foot)))
9218− ?~ rig
9219− hag
9220− =+ zil=(mull %noun dox q.i.rig)
9221− =+ ^= dix
9222− :- p=(toss p.i.rig p.zil p.hag)
9223− q=(toss p.i.rig q.zil q.hag)
9224− ?> =(p.p.dix p.q.dix)
9225− %= $
9226− rig t.rig
9227− hag [q.p.dix q.q.dix]
9228− ==
9229− ::
9230− ++ et
9231− |_ [hyp=wing rig=(list (pair wing hoon))]
9232− ::
9233− ++ play
9234− ^- type
9235− =+ lug=(find %read hyp)
9236− ?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.p.lug))
9237− (elbo p.lug rig)
9238− ::
9239− ++ mint
9240− |= gol=type
9241− ^- (pair type nock)
9242− =+ lug=(find %read hyp)
9243− ?: ?=(%| -.lug) ~>(%mean.'hoon' ?>(?=(~ rig) p.lug))
9244− =- ?>(?|(!vet (nest(sut gol) & p.-)) -)
9245− (ergo p.lug rig)
9246− ::
9247− ++ mull
9248− |= [gol=type dox=type]
9249− ^- [type type]
9250− =+ lug=[p=(find %read hyp) q=(find(sut dox) %read hyp)]
9251− ?: ?=(%| -.p.lug)
9252− ?> &(?=(%| -.q.lug) ?=(~ rig))
9253− [p.p.p.lug p.p.q.lug]
9254− ?> ?=(%& -.q.lug)
9255− =- ?>(?|(!vet (nest(sut gol) & p.-)) -)
9256− (endo [p.p.lug p.q.lug] dox rig)
9257− --
9258− ::
9259− ++ epla
9260− ~/ %epla
9261− |= [hyp=wing rig=(list (pair wing hoon))]
9262− ^- type
9263− ~(play et hyp rig)
9264− ::
9265− ++ emin
9266− ~/ %emin
9267− |= [gol=type hyp=wing rig=(list (pair wing hoon))]
9268− ^- (pair type nock)
9269− (~(mint et hyp rig) gol)
9270− ::
9271− ++ emul
9272− ~/ %emul
9273− |= [gol=type dox=type hyp=wing rig=(list (pair wing hoon))]
9274− ^- (pair type type)
9275− (~(mull et hyp rig) gol dox)
9276− ::
9277− ++ felt !!
9278− :: ::
9279− ++ feel :: detect existence
9280− |= rot=(list wing)
9281− ^- ?
9282− =. rot (flop rot)
9283− |- ^- ?
9284− ?~ rot &
9285− =/ yep (fond %free i.rot)
9286− ?~ yep |
9287− ?- -.yep
9288− %& %= $
9289− rot t.rot
9290− sut p:(fine %& p.yep)
9291− ==
9292− %| ?- -.p.yep
9293− %& |
9294− %| %= $
9295− rot t.rot
9296− sut p:(fine %| p.p.yep)
9297− ==
9298− == ==
9299− ::
9300− ++ fond
9301− ~/ %fond
9302− |= [way=vial hyp=wing]
9303− => |%
9304− ++ pony :: raw match
9305− $@ ~ :: void
9306− %+ each :: natural/abnormal
9307− palo :: arm or leg
9308− %+ each :: abnormal
9309− @ud :: unmatched
9310− (pair type nock) :: synthetic
9311− --
9312− ^- pony
9313− ?~ hyp
9314− [%& ~ %& sut]
9315− =+ mor=$(hyp t.hyp)
9316− ?- -.mor
9317− %|
9318− ?- -.p.mor
9319− %& mor
9320− %|
9321− =+ fex=(mint(sut p.p.p.mor) %noun [%wing i.hyp ~])
9322− [%| %| p.fex (comb q.p.p.mor q.fex)]
9323− ==
9324− ::
9325− %&
9326− =. sut
9327− =* lap q.p.mor
9328− ?- -.lap
9329− %& p.lap
9330− %| (fork (turn ~(tap in q.lap) head))
9331− ==
9332− => :_ +
9333− :* axe=`axis`1
9334− lon=p.p.mor
9335− heg=?^(i.hyp i.hyp [%| p=0 q=(some i.hyp)])
9336− ==
9337− ?: ?=(%& -.heg)
9338− [%& [`p.heg lon] %& (peek way p.heg)]
9339− =| gil=(set type)
9340− =< $
9341− |% ++ here ?: =(0 p.heg)
9342− [%& [~ `axe lon] %& sut]
9343− [%| %& (dec p.heg)]
9344− ++ lose [%| %& p.heg]
9345− ++ stop ?~(q.heg here lose)
9346− ++ twin |= [hax=pony yor=pony]
9347− ^- pony
9348− ~_ leaf+"find-fork"
9349− ?: =(hax yor) hax
9350− ?~ hax yor
9351− ?~ yor hax
9352− ?: ?=(%| -.hax)
9353− ?> ?& ?=(%| -.yor)
9354− ?=(%| -.p.hax)
9355− ?=(%| -.p.yor)
9356− =(q.p.p.hax q.p.p.yor)
9357− ==
9358− :+ %|
9359− %|
9360− [(fork p.p.p.hax p.p.p.yor ~) q.p.p.hax]
9361− ?> ?=(%& -.yor)
9362− ?> =(p.p.hax p.p.yor)
9363− ?: &(?=(%& -.q.p.hax) ?=(%& -.q.p.yor))
9364− :+ %& p.p.hax
9365− [%& (fork p.q.p.hax p.q.p.yor ~)]
9366− ?> &(?=(%| -.q.p.hax) ?=(%| -.q.p.yor))
9367− ?> =(p.q.p.hax p.q.p.yor)
9368− =+ wal=(~(uni in q.q.p.hax) q.q.p.yor)
9369− :+ %& p.p.hax
9370− [%| p.q.p.hax wal]
9371− ++ $
9372− ^- pony
9373− ?- sut
9374− %void ~
9375− %noun stop
9376− [%atom *] stop
9377− [%cell *]
9378− ?~ q.heg here
9379− =+ taf=$(axe (peg axe 2), sut p.sut)
9380− ?~ taf ~
9381− ?: |(?=(%& -.taf) ?=(%| -.p.taf))
9382− taf
9383− $(axe (peg axe 3), p.heg p.p.taf, sut q.sut)
9384− ::
9385− [%core *]
9386− ?~ q.heg here
9387− =^ zem p.heg
9388− =+ zem=(loot u.q.heg q.r.q.sut)
9389− ?~ zem [~ p.heg]
9390− ?:(=(0 p.heg) [zem 0] [~ (dec p.heg)])
9391− ?^ zem
9392− :+ %&
9393− [`axe lon]
9394− =/ zut ^- foot
9395− ?- q.p.q.sut
9396− %wet [%wet q.u.zem]
9397− %dry [%dry q.u.zem]
9398− ==
9399− [%| (peg 2 p.u.zem) [[sut zut] ~ ~]]
9400− =+ pec=(peel way r.p.q.sut)
9401− ?. sam.pec lose
9402− ?: con.pec $(sut p.sut, axe (peg axe 3))
9403− $(sut (peek(sut p.sut) way 2), axe (peg axe 6))
9404− ::
9405− [%hint *]
9406− $(sut repo)
9407− ::
9408− [%face *]
9409− ?: ?=(~ q.heg) here(sut q.sut)
9410− =* zot p.sut
9411− ?@ zot
9412− ?:(=(u.q.heg zot) here(sut q.sut) lose)
9413− =< main
9414− |%
9415− ++ main
9416− ^- pony
9417− =+ tyr=(~(get by p.zot) u.q.heg)
9418− ?~ tyr
9419− next
9420− ?~ u.tyr
9421− $(sut q.sut, lon [~ lon], p.heg +(p.heg))
9422− ?. =(0 p.heg)
9423− next(p.heg (dec p.heg))
9424− =+ tor=(fund way u.u.tyr)
9425− ?- -.tor
9426− %& [%& (weld p.p.tor `vein`[~ `axe lon]) q.p.tor]
9427− %| [%| %| p.p.tor (comb [%0 axe] q.p.tor)]
9428− ==
9429− ++ next
9430− |- ^- pony
9431− ?~ q.zot
9432− ^$(sut q.sut, lon [~ lon])
9433− =+ tiv=(mint(sut q.sut) %noun i.q.zot)
9434− =+ fid=^$(sut p.tiv, lon ~, axe 1, gil ~)
9435− ?~ fid ~
9436− ?: ?=([%| %& *] fid)
9437− $(q.zot t.q.zot, p.heg p.p.fid)
9438− =/ vat=(pair type nock)
9439− ?- -.fid
9440− %& (fine %& p.fid)
9441− %| (fine %| p.p.fid)
9442− ==
9443− [%| %| p.vat (comb (comb [%0 axe] q.tiv) q.vat)]
9444− --
9445− ::
9446− [%fork *]
9447− =+ wiz=(turn ~(tap in p.sut) |=(a=type ^$(sut a)))
9448− ?~ wiz ~
9449− |- ^- pony
9450− ?~ t.wiz i.wiz
9451− (twin i.wiz $(wiz t.wiz))
9452− ::
9453− [%hold *]
9454− ?: (~(has in gil) sut)
9455− ~
9456− $(gil (~(put in gil) sut), sut repo)
9457− ==
9458− --
9459− ==
9460− ::
9461− ++ find
9462− ~/ %find
9463− |= [way=vial hyp=wing]
9464− ^- port
9465− ~_ (show [%c %find] %l hyp)
9466− =- ?@ - !!
9467− ?- -<
9468− %& [%& p.-]
9469− %| ?- -.p.-
9470− %| [%| p.p.-]
9471− %& !!
9472− == ==
9473− (fond way hyp)
9474− ::
9475− ++ fund
9476− ~/ %fund
9477− |= [way=vial gen=hoon]
9478− ^- port
9479− =+ hup=~(reek ap gen)
9480− ?~ hup
9481− [%| (mint %noun gen)]
9482− (find way u.hup)
9483− ::
9484− ++ fine
9485− ~/ %fine
9486− |= tor=port
9487− ^- (pair type nock)
9488− ?- -.tor
9489− %| p.tor
9490− %& =+ axe=(tend p.p.tor)
9491− ?- -.q.p.tor
9492− %& [`type`p.q.p.tor %0 axe]
9493− %| [(fire ~(tap in q.q.p.tor)) [%9 p.q.p.tor %0 axe]]
9494− == ==
9495− ::
9496− ++ fire
9497− |= hag=(list [p=type q=foot])
9498− ^- type
9499− ?: ?=([[* [%wet ~ %1]] ~] hag)
9500− p.i.hag
9501− %- fork
9502− %+ turn
9503− hag.$
9504− |= [p=type q=foot]
9505− ?. ?=([%core *] p)
9506− ~_ (dunk %fire-type)
9507− ~_ leaf+"expected-fork-to-be-core"
9508− ~_ (dunk(sut p) %fork-type)
9509− ~>(%mean.'fire-core' !!)
9510− :- %hold
9511− =+ dox=[%core q.q.p q.p(r.p %gold)]
9512− ?: ?=(%dry -.q)
9513− :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-dry)
9514− ?> ?|(!vet (nest(sut q.q.p) & p.p))
9515− [dox p.q]
9516− ?> ?=(%wet -.q)
9517− :: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-wet)
9518− =. p.p (redo(sut p.p) q.q.p)
9519− ?> ?| !vet
9520− (~(has in rib) [sut dox p.q])
9521− !=(** (mull(sut p, rib (~(put in rib) sut dox p.q)) %noun dox p.q))
9522− ==
9523− [p p.q]
9524− ::
9525− ++ fish
9526− ~/ %fish
9527− |= axe=axis
9528− =+ vot=*(set type)
9529− |- ^- nock
9530− ?- sut
9531− %void [%1 1]
9532− %noun [%1 0]
9533− [%atom *] ?~ q.sut
9534− (flip [%3 %0 axe])
9535− [%5 [%1 u.q.sut] [%0 axe]]
9536− [%cell *]
9537− %+ flan
9538− [%3 %0 axe]
9539− (flan $(sut p.sut, axe (peg axe 2)) $(sut q.sut, axe (peg axe 3)))
9540− ::
9541− [%core *] ~>(%mean.'fish-core' !!)
9542− [%face *] $(sut q.sut)
9543− [%fork *] =+ yed=~(tap in p.sut)
9544− |- ^- nock
9545− ?~(yed [%1 1] (flor ^$(sut i.yed) $(yed t.yed)))
9546− [%hint *] $(sut q.sut)
9547− [%hold *]
9548− ?: (~(has in vot) sut)
9549− ~>(%mean.'fish-loop' !!)
9550− => %=(. vot (~(put in vot) sut))
9551− $(sut repo)
9552− ==
9553− ::
9554− ++ fuse
9555− ~/ %fuse
9556− |= ref=type
9557− =+ bix=*(set [type type])
9558− |- ^- type
9559− ?: ?|(=(sut ref) =(%noun ref))
9560− sut
9561− ?- sut
9562− [%atom *]
9563− ?- ref
9564− [%atom *] =+ foc=?:((fitz p.ref p.sut) p.sut p.ref)
9565− ?^ q.sut
9566− ?^ q.ref
9567− ?: =(q.sut q.ref)
9568− [%atom foc q.sut]
9569− %void
9570− [%atom foc q.sut]
9571− [%atom foc q.ref]
9572− [%cell *] %void
9573− * $(sut ref, ref sut)
9574− ==
9575− [%cell *]
9576− ?- ref
9577− [%cell *] (cell $(sut p.sut, ref p.ref) $(sut q.sut, ref q.ref))
9578− * $(sut ref, ref sut)
9579− ==
9580− ::
9581− [%core *] $(sut repo)
9582− [%face *] (face p.sut $(sut q.sut))
9583− [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
9584− [%hint *] (hint p.sut $(sut q.sut))
9585− [%hold *]
9586− ?: (~(has in bix) [sut ref])
9587− ~>(%mean.'fuse-loop' !!)
9588− $(sut repo, bix (~(put in bix) [sut ref]))
9589− ::
9590− %noun ref
9591− %void %void
9592− ==
9593− ::
9594− ++ gain
9595− ~/ %gain
9596− |= gen=hoon ^- type
9597− (chip & gen)
9598− ::
9599− ++ hemp
9600− :: generate formula from foot
9601− ::
9602− |= [hud=poly gol=type gen=hoon]
9603− ^- nock
9604− ~+
9605− =+ %hemp-141
9606− ?- hud
9607− %dry q:(mint gol gen)
9608− %wet q:(mint(vet |) gol gen)
9609− ==
9610− ::
9611− ++ laze
9612− :: produce lazy core generator for static execution
9613− ::
9614− |= [nym=(unit term) hud=poly dom=(map term tome)]
9615− ~+
9616− ^- seminoun
9617− =+ %hemp-141
9618− :: tal: map from battery axis to foot
9619− ::
9620− =; tal=(map @ud hoon)
9621− :: produce lazy battery
9622− ::
9623− :_ ~
9624− :+ %lazy 1
9625− |= axe=@ud
9626− ^- (unit noun)
9627− %+ bind (~(get by tal) axe)
9628− |= gen=hoon
9629− %. [hud %noun gen]
9630− hemp(sut (core sut [nym hud %gold] sut [[%lazy 1 ..^$] ~] dom))
9631− ::
9632− %- ~(gas by *(map @ud hoon))
9633− =| yeb=(list (pair @ud hoon))
9634− =+ axe=1
9635− |^ ?- dom
9636− ~ yeb
9637− [* ~ ~] (chapter q.q.n.dom)
9638− [* * ~] %= $
9639− dom l.dom
9640− axe (peg axe 3)
9641− yeb (chapter(axe (peg axe 2)) q.q.n.dom)
9642− ==
9643− [* ~ *] %= $
9644− dom r.dom
9645− axe (peg axe 3)
9646− yeb (chapter(axe (peg axe 2)) q.q.n.dom)
9647− ==
9648− [* * *] %= $
9649− dom r.dom
9650− axe (peg axe 7)
9651− yeb %= $
9652− dom l.dom
9653− axe (peg axe 6)
9654− yeb (chapter(axe (peg axe 2)) q.q.n.dom)
9655− == == ==
9656− ++ chapter
9657− |= dab=(map term hoon)
9658− ^+ yeb
9659− ?- dab
9660− ~ yeb
9661− [* ~ ~] [[axe q.n.dab] yeb]
9662− [* * ~] %= $
9663− dab l.dab
9664− axe (peg axe 3)
9665− yeb [[(peg axe 2) q.n.dab] yeb]
9666− ==
9667− [* ~ *] %= $
9668− dab r.dab
9669− axe (peg axe 3)
9670− yeb [[(peg axe 2) q.n.dab] yeb]
9671− ==
9672− [* * *] %= $
9673− dab r.dab
9674− axe (peg axe 7)
9675− yeb %= $
9676− dab l.dab
9677− axe (peg axe 6)
9678− yeb [[(peg axe 2) q.n.dab] yeb]
9679− == == ==
9680− --
9681− ::
9682− ++ lose
9683− ~/ %lose
9684− |= gen=hoon ^- type
9685− (chip | gen)
9686− ::
9687− ++ chip
9688− ~/ %chip
9689− |= [how=? gen=hoon] ^- type
9690− ?: ?=([%wtts *] gen)
9691− (cool how q.gen (play ~(example ax p.gen)))
9692− ?: ?=([%wthx *] gen)
9693− =+ (play %wing q.gen)
9694− ~> %slog.[0 [%leaf "chipping"]]
9695− ?: how
9696− =- ~> %slog.[0 (dunk(sut +<) 'chip: gain: ref')]
9697− ~> %slog.[0 (dunk(sut -) 'chip: gain: gain')]
9698− -
9699− ~(gain ar - p.gen)
9700− ~(lose ar - p.gen)
9701− ?: ?&(how ?=([%wtpm *] gen))
9702− |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
9703− ?: ?&(!how ?=([%wtbr *] gen))
9704− |-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
9705− =+ neg=~(open ap gen)
9706− ?:(=(neg gen) sut $(gen neg))
9707− ::
9708− ++ bake
9709− |= [dox=type hud=poly dab=(map term hoon)]
9710− ^- *
9711− ?: ?=(~ dab)
9712− ~
9713− =+ ^= dov
9714− :: this seems wrong but it's actually right
9715− ::
9716− ?- hud
9717− %dry (mull %noun dox q.n.dab)
9718− %wet ~
9719− ==
9720− ?- dab
9721− [* ~ ~] dov
9722− [* ~ *] [dov $(dab r.dab)]
9723− [* * ~] [dov $(dab l.dab)]
9724− [* * *] [dov $(dab l.dab) $(dab r.dab)]
9725− ==
9726− ::
9727− ++ balk
9728− |= [dox=type hud=poly dom=(map term tome)]
9729− ^- *
9730− ?: ?=(~ dom)
9731− ~
9732− =+ dov=(bake dox hud q.q.n.dom)
9733− ?- dom
9734− [* ~ ~] dov
9735− [* ~ *] [dov $(dom r.dom)]
9736− [* * ~] [dov $(dom l.dom)]
9737− [* * *] [dov $(dom l.dom) $(dom r.dom)]
9738− ==
9739− ::
9740− ++ mile
9741− :: mull all chapters and feet in a core
9742− ::
9743− |= [dox=type mel=vair nym=(unit term) hud=poly dom=(map term tome)]
9744− ^- (pair type type)
9745− =+ yet=(core sut [nym hud %gold] sut (laze nym hud dom) dom)
9746− =+ hum=(core dox [nym hud %gold] dox (laze nym hud dom) dom)
9747− =+ (balk(sut yet) hum hud dom)
9748− [yet hum]
9749− ::
9750− ++ mine
9751− :: mint all chapters and feet in a core
9752− ::
9753− |= [gol=type mel=vair nym=(unit term) hud=poly dom=(map term tome)]
9754− ^- (pair type nock)
9755− |^
9756− =/ log (chapters-check (core-check gol))
9757− =/ dog (get-tomes log)
9758− =- :_ [%1 dez]
9759− (core sut [nym hud mel] sut [[%full ~] dez] dom)
9760− ^= dez
9761− =. sut (core sut [nym hud %gold] sut (laze nym hud dom) dom)
9762− |- ^- ?(~ ^)
9763− ?: ?=(~ dom)
9764− ~
9765− =/ dov=?(~ ^)
9766− =/ dab=(map term hoon) q.q.n.dom
9767− =/ dag (arms-check dab (get-arms dog p.n.dom))
9768− |- ^- ?(~ ^)
9769− ?: ?=(~ dab)
9770− ~
9771− =/ gog (get-arm-type log dag p.n.dab)
9772− =+ vad=(hemp hud gog q.n.dab)
9773− ?- dab
9774− [* ~ ~] vad
9775− [* ~ *] [vad $(dab r.dab)]
9776− [* * ~] [vad $(dab l.dab)]
9777− [* * *] [vad $(dab l.dab) $(dab r.dab)]
9778− ==
9779− ?- dom
9780− [* ~ ~] dov
9781− [* ~ *] [dov $(dom r.dom)]
9782− [* * ~] [dov $(dom l.dom)]
9783− [* * *] [dov $(dom l.dom) $(dom r.dom)]
9784− ==
9785− ::
9786− :: all the below arms are used for gol checking and should have no
9787− :: effect other than giving more specific errors
9788− ::
9789− :: +gol-type: all the possible types we could be expecting.
9790− ::
9791− +$ gol-type
9792− $~ %noun
9793− $@ %noun
9794− $% [%cell p=type q=type]
9795− [%core p=type q=coil]
9796− [%fork p=(set gol-type)]
9797− ==
9798− :: +core-check: check that we're looking for a core
9799− ::
9800− ++ core-check
9801− |= log=type
9802− |- ^- gol-type
9803− ?+ log $(log repo(sut log))
9804− %noun (nice log &)
9805− %void (nice %noun |)
9806− [%atom *] (nice %noun |)
9807− [%cell *] (nice log (nest(sut p.log) & %noun))
9808− [%core *] (nice log(r.p.q %gold) &)
9809− [%fork *]
9810− =/ tys ~(tap in p.log)
9811− :- %fork
9812− |- ^- (set gol-type)
9813− ?~ tys
9814− ~
9815− =/ a ^$(log i.tys)
9816− =/ b $(tys t.tys)
9817− (~(put in b) a)
9818− ==
9819− :: +chapters-check: check we have the expected number of chapters
9820− ::
9821− ++ chapters-check
9822− |= log=gol-type
9823− |- ^- gol-type
9824− ?- log
9825− %noun (nice log &)
9826− [%cell *] (nice log &)
9827− [%core *] ~_ leaf+"core-number-of-chapters"
9828− (nice log =(~(wyt by dom) ~(wyt by q.r.q.log)))
9829− [%fork *]
9830− =/ tys ~(tap in p.log)
9831− |- ^- gol-type
9832− ?~ tys
9833− log
9834− =/ a ^$(log i.tys)
9835− =/ b $(tys t.tys)
9836− log
9837− ==
9838− :: +get-tomes: get map of tomes if exists
9839− ::
9840− ++ get-tomes
9841− |= log=gol-type
9842− ^- (unit (map term tome))
9843− ?- log
9844− %noun ~
9845− [%cell *] ~
9846− [%fork *] ~ :: maybe could be more aggressive
9847− [%core *] `q.r.q.log
9848− ==
9849− :: +get-arms: get arms in tome
9850− ::
9851− ++ get-arms
9852− |= [dog=(unit (map term tome)) nam=term]
9853− ^- (unit (map term hoon))
9854− %+ bind dog
9855− |= a=(map term tome)
9856− ~_ leaf+"unexpcted-chapter.{(trip nam)}"
9857− q:(~(got by a) nam)
9858− :: +arms-check: check we have the expected number of arms
9859− ::
9860− ++ arms-check
9861− |= [dab=(map term hoon) dag=(unit (map term hoon))]
9862− ?~ dag
9863− dag
9864− =/ a
9865− =/ exp ~(wyt by u.dag)
9866− =/ hav ~(wyt by dab)
9867− ~_ =/ expt (scow %ud exp)
9868− =/ havt (scow %ud hav)
9869− leaf+"core-number-of-arms.exp={expt}.hav={havt}"
9870− ~_ =/ missing ~(tap in (~(dif in ~(key by u.dag)) ~(key by dab)))
9871− leaf+"missing.{<missing>}"
9872− ~_ =/ extra ~(tap in (~(dif in ~(key by dab)) ~(key by u.dag)))
9873− leaf+"extra.{<extra>}"
9874− ~_ =/ have ~(tap in ~(key by dab))
9875− leaf+"have.{<have>}"
9876− (nice dag =(exp hav))
9877− a
9878− :: +get-arm-type: get expected type of this arm
9879− ::
9880− ++ get-arm-type
9881− |= [log=gol-type dag=(unit (map term hoon)) nam=term]
9882− ^- type
9883− %- fall :_ %noun
9884− %+ bind dag
9885− |= a=(map term hoon)
9886− =/ gen=hoon
9887− ~_ leaf+"unexpected-arm.{(trip nam)}"
9888− (~(got by a) nam)
9889− (play(sut log) gen)
9890− ::
9891− ++ nice
9892− |* [typ=* gud=?]
9893− ?: gud
9894− typ
9895− ~_ leaf+"core-nice"
9896− !!
9897− --
9898− ::
9899− ++ mint
9900− ~/ %mint
9901− |= [gol=type gen=hoon]
9902− ^- [p=type q=nock]
9903− ::~& %pure-mint
9904− |^ ^- [p=type q=nock]
9905− ?: ?&(=(%void sut) !?=([%dbug *] gen))
9906− ?. |(!vet ?=([%lost *] gen) ?=([%zpzp *] gen))
9907− ~>(%mean.'mint-vain' !!)
9908− [%void %0 0]
9909− ?- gen
9910− ::
9911− [^ *]
9912− =+ hed=$(gen p.gen, gol %noun)
9913− =+ tal=$(gen q.gen, gol %noun)
9914− [(nice (cell p.hed p.tal)) (cons q.hed q.tal)]
9915− ::
9916− [%brcn *] (grow %gold p.gen %dry [%$ 1] q.gen)
9917− [%brpt *] (grow %gold p.gen %wet [%$ 1] q.gen)
9918− ::
9919− [%cnts *] (~(mint et p.gen q.gen) gol)
9920− ::
9921− [%dtkt *]
9922− =+ nef=$(gen [%kttr p.gen])
9923− [p.nef [%12 [%1 hoon-version p.nef] q:$(gen q.gen, gol %noun)]]
9924− ::
9925− [%dtls *] [(nice [%atom %$ ~]) [%4 q:$(gen p.gen, gol [%atom %$ ~])]]
9926− [%sand *] [(nice (play gen)) [%1 q.gen]]
9927− [%rock *] [(nice (play gen)) [%1 q.gen]]
9928− ::
9929− [%dttr *]
9930− [(nice %noun) [%2 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
9931− ::
9932− [%dtts *]
9933− [(nice bool) [%5 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
9934− ::
9935− [%dtwt *] [(nice bool) [%3 q:$(gen p.gen, gol %noun)]]
9936− [%hand *] [p.gen q.gen]
9937− [%ktbr *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %iron)) q.vat])
9938− ::
9939− [%ktls *]
9940− =+(hif=(nice (play p.gen)) [hif q:$(gen q.gen, gol hif)])
9941− ::
9942− [%ktpm *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %zinc)) q.vat])
9943− [%ktsg *] (blow gol p.gen)
9944− [%tune *] [(face p.gen sut) [%0 %1]]
9945− [%ktwt *] =+(vat=$(gen p.gen) [(nice (wrap(sut p.vat) %lead)) q.vat])
9946− ::
9947− [%note *]
9948− =+ hum=$(gen q.gen)
9949− [(hint [sut p.gen] p.hum) q.hum]
9950− ::
9951− [%sgzp *] ~_(duck(sut (play p.gen)) $(gen q.gen))
9952− [%sggr *]
9953− =+ hum=$(gen q.gen)
9954− :: ?: &(huz !?=(%|(@ [?(%sgcn %sgls) ^]) p.gen))
9955− :: hum
9956− :- p.hum
9957− :+ %11
9958− ?- p.gen
9959− @ p.gen
9960− ^ [p.p.gen q:$(gen q.p.gen, gol %noun)]
9961− ==
9962− q.hum
9963− ::
9964− [%tsgr *]
9965− =+ fid=$(gen p.gen, gol %noun)
9966− =+ dov=$(sut p.fid, gen q.gen)
9967− [p.dov (comb q.fid q.dov)]
9968− ::
9969− [%tscm *]
9970− $(gen q.gen, sut (busk p.gen))
9971− ::
9972− [%wtcl *]
9973− =+ nor=$(gen p.gen, gol bool)
9974− =+ fex=(gain p.gen)
9975− =+ wux=(lose p.gen)
9976− =+ ^= duy
9977− ?: =(%void fex)
9978− ?:(=(%void wux) [%0 0] [%1 1])
9979− ?:(=(%void wux) [%1 0] q.nor)
9980− =+ hiq=$(sut fex, gen q.gen)
9981− =+ ran=$(sut wux, gen r.gen)
9982− [(fork p.hiq p.ran ~) (cond duy q.hiq q.ran)]
9983− ::
9984− [%wthx *]
9985− :- (nice bool)
9986− =+ fid=(find %read [[%& 1] q.gen])
9987− ~> %mean.'mint-fragment'
9988− ?> &(?=(%& -.fid) ?=(%& -.q.p.fid))
9989− (~(fish ar `type`p.q.p.fid `skin`p.gen) (tend p.p.fid))
9990− ::
9991− [%fits *]
9992− :- (nice bool)
9993− =+ ref=(play p.gen)
9994− =+ fid=(find %read q.gen)
9995− ~| [%test q.gen]
9996− |- ^- nock
9997− ?- -.fid
9998− %& ?- -.q.p.fid
9999− %& (fish(sut ref) (tend p.p.fid))
10000− %| $(fid [%| (fine fid)])
10001− ==
10002− %| [%7 q.p.fid (fish(sut ref) 1)]
10003− ==
10004− ::
10005− [%dbug *]
10006− ~_ (show %o p.gen)
10007− =+ hum=$(gen q.gen)
10008− [p.hum [%11 [%spot %1 p.gen] q.hum]]
10009− ::
10010− [%zpcm *] [(nice (play p.gen)) [%1 q.gen]] :: XX validate!
10011− [%lost *]
10012− ?: vet
10013− ~_ (dunk(sut (play p.gen)) 'lost')
10014− ~>(%mean.'mint-lost' !!)
10015− [%void [%0 0]]
10016− ::
10017− [%zpmc *]
10018− =+ vos=$(gol %noun, gen q.gen)
10019− =+ ref=p:$(gol %noun, gen p.gen)
10020− [(nice (cell ref p.vos)) (cons [%1 burp(sut p.vos)] q.vos)]
10021− ::
10022− [%zpgl *]
10023− =/ typ (nice (play [%kttr p.gen]))
10024− =/ val
10025− =< q
10026− %_ $
10027− gol %noun
10028− gen
10029− :^ %wtcl
10030− :+ %cncl [%limb %levi]
10031− :~ [%tsgr [%zpgr [%kttr p.gen]] [%$ 2]]
10032− [%tsgr q.gen [%$ 2]]
10033− ==
10034− [%tsgr q.gen [%$ 3]]
10035− [%zpzp ~]
10036− ==
10037− [typ val]
10038− ::
10039− [%zpts *] [(nice %noun) [%1 q:$(vet |, gen p.gen)]]
10040− [%zppt *] ?:((feel p.gen) $(gen q.gen) $(gen r.gen))
10041− ::
10042− [%zpzp ~] [%void [%0 0]]
10043− *
10044− =+ doz=~(open ap gen)
10045− ?: =(doz gen)
10046− ~_ (show [%c 'hoon'] [%q gen])
10047− ~>(%mean.'mint-open' !!)
10048− $(gen doz)
10049− ==
10050− ::
10051− ++ nice
10052− |= typ=type
10053− ~_ leaf+"mint-nice"
10054− ?> ?|(!vet (nest(sut gol) & typ))
10055− typ
10056− ::
10057− ++ grow
10058− |= [mel=vair nym=(unit term) hud=poly ruf=hoon dom=(map term tome)]
10059− ^- [p=type q=nock]
10060− =+ dan=^$(gen ruf, gol %noun)
10061− =+ pul=(mine gol mel nym hud dom)
10062− [(nice p.pul) (cons q.pul q.dan)]
10063− --
10064− ::
10065− ++ moot
10066− =+ gil=*(set type)
10067− |- ^- ?
10068− ?- sut
10069− [%atom *] |
10070− [%cell *] |($(sut p.sut) $(sut q.sut))
10071− [%core *] $(sut p.sut)
10072− [%face *] $(sut q.sut)
10073− [%fork *] (levy ~(tap in p.sut) |=(type ^$(sut +<)))
10074− [%hint *] $(sut q.sut)
10075− [%hold *] |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo))
10076− %noun |
10077− %void &
10078− ==
10079− ::
10080− ++ mull
10081− ~/ %mull
10082− |= [gol=type dox=type gen=hoon]
10083− |^ ^- [p=type q=type]
10084− ?: =(%void sut)
10085− ~>(%mean.'mull-none' !!)
10086− ?- gen
10087− ::
10088− [^ *]
10089− =+ hed=$(gen p.gen, gol %noun)
10090− =+ tal=$(gen q.gen, gol %noun)
10091− [(nice (cell p.hed p.tal)) (cell q.hed q.tal)]
10092− ::
10093− [%brcn *] (grow %gold p.gen %dry [%$ 1] q.gen)
10094− [%brpt *] (grow %gold p.gen %wet [%$ 1] q.gen)
10095− [%cnts *] (~(mull et p.gen q.gen) gol dox)
10096− [%dtkt *] =+($(gen q.gen, gol %noun) $(gen [%kttr p.gen]))
10097− [%dtls *] =+($(gen p.gen, gol [%atom %$ ~]) (beth [%atom %$ ~]))
10098− [%sand *] (beth (play gen))
10099− [%rock *] (beth (play gen))
10100− ::
10101− [%dttr *]
10102− =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth %noun))
10103− ::
10104− [%dtts *]
10105− =+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth bool))
10106− ::
10107− [%dtwt *] =+($(gen p.gen, gol %noun) (beth bool)) :: XX =|
10108− [%hand *] [p.gen p.gen]
10109− [%ktbr *]
10110− =+(vat=$(gen p.gen) [(wrap(sut p.vat) %iron) (wrap(sut q.vat) %iron)])
10111− ::
10112− [%ktls *]
10113− =+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)]
10114− =+($(gen q.gen, gol p.hif) hif)
10115− ::
10116− [%ktpm *]
10117− =+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) (wrap(sut q.vat) %zinc)])
10118− ::
10119− [%tune *]
10120− [(face p.gen sut) (face p.gen dox)]
10121− ::
10122− [%ktwt *]
10123− =+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) (wrap(sut q.vat) %lead)])
10124− ::
10125− [%note *]
10126− =+ vat=$(gen q.gen)
10127− [(hint [sut p.gen] p.vat) (hint [dox p.gen] q.vat)]
10128− ::
10129− [%ktsg *] $(gen p.gen)
10130− [%sgzp *] ~_(duck(sut (play p.gen)) $(gen q.gen))
10131− [%sggr *] $(gen q.gen)
10132− [%tsgr *]
10133− =+ lem=$(gen p.gen, gol %noun)
10134− $(gen q.gen, sut p.lem, dox q.lem)
10135− ::
10136− [%tscm *]
10137− =/ boc (busk p.gen)
10138− =/ nuf (busk(sut dox) p.gen)
10139− $(gen q.gen, sut boc, dox nuf)
10140− ::
10141− [%wtcl *]
10142− =+ nor=$(gen p.gen, gol bool)
10143− =+ ^= hiq ^- [p=type q=type]
10144− =+ fex=[p=(gain p.gen) q=(gain(sut dox) p.gen)]
10145− ?: =(%void p.fex)
10146− :- %void
10147− ?: =(%void q.fex)
10148− %void
10149− ~>(%mean.'if-z' (play(sut q.fex) q.gen))
10150− ?: =(%void q.fex)
10151− ~>(%mean.'mull-bonk-b' !!)
10152− $(sut p.fex, dox q.fex, gen q.gen)
10153− =+ ^= ran ^- [p=type q=type]
10154− =+ wux=[p=(lose p.gen) q=(lose(sut dox) p.gen)]
10155− ?: =(%void p.wux)
10156− :- %void
10157− ?: =(%void q.wux)
10158− %void
10159− ~>(%mean.'if-a' (play(sut q.wux) r.gen))
10160− ?: =(%void q.wux)
10161− ~>(%mean.'mull-bonk-c' !!)
10162− $(sut p.wux, dox q.wux, gen r.gen)
10163− [(nice (fork p.hiq p.ran ~)) (fork q.hiq q.ran ~)]
10164− ::
10165− [%fits *]
10166− =+ waz=[p=(play p.gen) q=(play(sut dox) p.gen)]
10167− =+ ^= syx :- p=(cove q:(mint %noun [%wing q.gen]))
10168− q=(cove q:(mint(sut dox) %noun [%wing q.gen]))
10169− =+ pov=[p=(fish(sut p.waz) p.syx) q=(fish(sut q.waz) q.syx)]
10170− ?. &(=(p.syx q.syx) =(p.pov q.pov))
10171− ~>(%mean.'mull-bonk-a' !!)
10172− (beth bool)
10173− ::
10174− [%wthx *]
10175− ~> %mean.'mull-bonk-x'
10176− =+ :- =+ (find %read [[%& 1] q.gen])
10177− ?> &(?=(%& -.-) ?=(%& -.q.p.-))
10178− new=[type=p.q.p.- axis=(tend p.p.-)]
10179− =+ (find(sut dox) %read [%& 1] q.gen)
10180− ?> &(?=(%& -.-) ?=(%& -.q.p.-))
10181− old=[type=p.q.p.- axis=(tend p.p.-)]
10182− ?> =(axis.old axis.new)
10183− ?> (nest(sut type.old) & type.new)
10184− (beth bool)
10185− ::
10186− [%dbug *] ~_((show %o p.gen) $(gen q.gen))
10187− [%zpcm *] [(nice (play p.gen)) (play(sut dox) p.gen)]
10188− [%lost *]
10189− ?: vet
10190− :: ~_ (dunk(sut (play p.gen)) 'also')
10191− ~>(%mean.'mull-skip' !!)
10192− (beth %void)
10193− ::
10194− [%zpts *] (beth %noun)
10195− ::
10196− [%zpmc *]
10197− =+ vos=$(gol %noun, gen q.gen) :: XX validate!
10198− [(nice (cell (play p.gen) p.vos)) (cell (play(sut dox) p.gen) q.vos)]
10199− ::
10200− [%zpgl *]
10201− :: XX is this right?
10202− (beth (play [%kttr p.gen]))
10203− ::
10204− [%zppt *]
10205− =+ [(feel p.gen) (feel(sut dox) p.gen)]
10206− ?. =(-< ->)
10207− ~>(%mean.'mull-bonk-f' !!)
10208− ?: -<
10209− $(gen q.gen)
10210− $(gen r.gen)
10211− ::
10212− [%zpzp *] (beth %void)
10213− *
10214− =+ doz=~(open ap gen)
10215− ?: =(doz gen)
10216− ~_ (show [%c 'hoon'] [%q gen])
10217− ~>(%mean.'mull-open' !!)
10218− $(gen doz)
10219− ==
10220− ::
10221− ++ beth
10222− |= typ=type
10223− [(nice typ) typ]
10224− ::
10225− ++ nice
10226− |= typ=type
10227− :: ~_ (dunk(sut gol) 'need')
10228− :: ~_ (dunk(sut typ) 'have')
10229− ~_ leaf+"mull-nice"
10230− ?> ?|(!vet (nest(sut gol) & typ))
10231− typ
10232− ::
10233− ++ grow
10234− |= [mel=vair nym=(unit term) hud=poly ruf=hoon dom=(map term tome)]
10235− :: make al
10236− ~_ leaf+"mull-grow"
10237− ^- [p=type q=type]
10238− =+ dan=^$(gen ruf, gol %noun)
10239− =+ yaz=(mile(sut p.dan) q.dan mel nym hud dom)
10240− [(nice p.yaz) q.yaz]
10241− --
10242− ++ meet |=(ref=type &((nest | ref) (nest(sut ref) | sut)))
10243− :: ::
10244− ++ miss :: nonintersection
10245− |= $: :: ref: symmetric type
10246− ::
10247− ref=type
10248− ==
10249− :: intersection of sut and ref is empty
10250− ::
10251− ^- ?
10252− =| gil=(set (set type))
10253− =< dext
10254− |%
10255− ++ dext
10256− ^- ?
10257− ::
10258− ?: =(ref sut)
10259− (nest(sut %void) | sut)
10260− ?- sut
10261− %void &
10262− %noun (nest(sut %void) | ref)
10263− [%atom *] sint
10264− [%cell *] sint
10265− [%core *] sint(sut [%cell %noun %noun])
10266− [%fork *] %+ levy ~(tap in p.sut)
10267− |=(type dext(sut +<))
10268− [%face *] dext(sut q.sut)
10269− [%hint *] dext(sut q.sut)
10270− [%hold *] =+ (~(gas in *(set type)) `(list type)`[sut ref ~])
10271− ?: (~(has in gil) -)
10272− &
10273− %= dext
10274− sut repo
10275− gil (~(put in gil) -)
10276− == ==
10277− ++ sint
10278− ?+ ref dext(sut ref, ref sut)
10279− [%atom *] ?. ?=([%atom *] sut) &
10280− ?& ?=(^ q.ref)
10281− ?=(^ q.sut)
10282− !=(q.ref q.sut)
10283− ==
10284− [%cell *] ?. ?=([%cell *] sut) &
10285− ?| dext(sut p.sut, ref p.ref)
10286− dext(sut q.sut, ref q.ref)
10287− == ==
10288− --
10289− ++ mite |=(ref=type |((nest | ref) (nest(sut ref) & sut)))
10290− ++ nest
10291− ~/ %nest
10292− |= [tel=? ref=type]
10293− =| $: seg=(set type) :: degenerate sut
10294− reg=(set type) :: degenerate ref
10295− gil=(set [p=type q=type]) :: assume nest
10296− ==
10297− =< dext
10298− ~% %nest-in ..$ ~
10299− |%
10300− ++ deem
10301− |= [mel=vair ram=vair]
10302− ^- ?
10303− ?. |(=(mel ram) =(%lead mel) =(%gold ram)) |
10304− ?- mel
10305− %lead &
10306− %gold meet
10307− %iron dext(sut (peek(sut ref) %rite 2), ref (peek %rite 2))
10308− %zinc dext(sut (peek %read 2), ref (peek(sut ref) %read 2))
10309− ==
10310− ::
10311− ++ deep
10312− |= $: dom=(map term tome)
10313− vim=(map term tome)
10314− ==
10315− ^- ?
10316− ?: ?=(~ dom) =(vim ~)
10317− ?: ?=(~ vim) |
10318− ?& =(p.n.dom p.n.vim)
10319− $(dom l.dom, vim l.vim)
10320− $(dom r.dom, vim r.vim)
10321− ::
10322− =+ [dab hem]=[q.q.n.dom q.q.n.vim]
10323− |- ^- ?
10324− ?: ?=(~ dab) =(hem ~)
10325− ?: ?=(~ hem) |
10326− ?& =(p.n.dab p.n.hem)
10327− $(dab l.dab, hem l.hem)
10328− $(dab r.dab, hem r.hem)
10329− %= dext
10330− sut (play q.n.dab)
10331− ref (play(sut ref) q.n.hem)
10332− == == ==
10333− ::
10334− ++ dext
10335− =< $
10336− ~% %nest-dext + ~
10337− |.
10338− ^- ?
10339− =- ?: - &
10340− ?. tel |
10341− ~_ (dunk %need)
10342− ~_ (dunk(sut ref) %have)
10343− ~> %mean.'nest-fail'
10344− !!
10345− ?: =(sut ref) &
10346− ?- sut
10347− %void sint
10348− %noun &
10349− [%atom *] ?. ?=([%atom *] ref) sint
10350− ?& (fitz p.sut p.ref)
10351− |(?=(~ q.sut) =(q.sut q.ref))
10352− ==
10353− [%cell *] ?. ?=([%cell *] ref) sint
10354− ?& dext(sut p.sut, ref p.ref, seg ~, reg ~)
10355− dext(sut q.sut, ref q.ref, seg ~, reg ~)
10356− ==
10357− [%core *] ?. ?=([%core *] ref) sint
10358− ?: =(q.sut q.ref) dext(sut p.sut, ref p.ref)
10359− ?& =(q.p.q.sut q.p.q.ref) :: same wet/dry
10360− meet(sut q.q.sut, ref p.sut)
10361− dext(sut q.q.ref, ref p.ref)
10362− (deem(sut q.q.sut, ref q.q.ref) r.p.q.sut r.p.q.ref)
10363− ?: =(%wet q.p.q.sut) =(q.r.q.sut q.r.q.ref)
10364− ?| (~(has in gil) [sut ref])
10365− %. [q.r.q.sut q.r.q.ref]
10366− %= deep
10367− gil (~(put in gil) [sut ref])
10368− sut sut(p q.q.sut, r.p.q %gold)
10369− ref ref(p q.q.ref, r.p.q %gold)
10370− == ==
10371− ==
10372− [%face *] dext(sut q.sut)
10373− [%fork *] ?. ?=(?([%atom *] %noun [%cell *] [%core *]) ref) sint
10374− (lien ~(tap in p.sut) |=(type dext(tel |, sut +<)))
10375− [%hint *] dext(sut q.sut)
10376− [%hold *] ?: (~(has in seg) sut) |
10377− ?: (~(has in gil) [sut ref]) &
10378− %= dext
10379− sut repo
10380− seg (~(put in seg) sut)
10381− gil (~(put in gil) [sut ref])
10382− == ==
10383− ::
10384− ++ meet &(dext dext(sut ref, ref sut))
10385− ++ sint
10386− ^- ?
10387− ?- ref
10388− %noun |
10389− %void &
10390− [%atom *] |
10391− [%cell *] |
10392− [%core *] dext(ref repo(sut ref))
10393− [%face *] dext(ref q.ref)
10394− [%fork *] (levy ~(tap in p.ref) |=(type dext(ref +<)))
10395− [%hint *] dext(ref q.ref)
10396− [%hold *] ?: (~(has in reg) ref) &
10397− ?: (~(has in gil) [sut ref]) &
10398− %= dext
10399− ref repo(sut ref)
10400− reg (~(put in reg) ref)
10401− gil (~(put in gil) [sut ref])
10402− == ==
10403− --
10404− ::
10405− ++ peek
10406− ~/ %peek
10407− |= [way=?(%read %rite %both %free) axe=axis]
10408− ^- type
10409− ?: =(1 axe)
10410− sut
10411− =+ [now=(cap axe) lat=(mas axe)]
10412− =+ gil=*(set type)
10413− |- ^- type
10414− ?- sut
10415− [%atom *] %void
10416− [%cell *] ?:(=(2 now) ^$(sut p.sut, axe lat) ^$(sut q.sut, axe lat))
10417− [%core *]
10418− ?. =(3 now) %noun
10419− =+ pec=(peel way r.p.q.sut)
10420− =/ tow
10421− ?: =(1 lat) 1
10422− (cap lat)
10423− %= ^$
10424− axe lat
10425− sut
10426− ?: ?| =([& &] pec)
10427− &(sam.pec =(tow 2))
10428− &(con.pec =(tow 3))
10429− ==
10430− p.sut
10431− ~_ leaf+"payload-block"
10432− ?. =(way %read) !!
10433− %+ cell
10434− ?.(sam.pec %noun ^$(sut p.sut, axe 2))
10435− ?.(con.pec %noun ^$(sut p.sut, axe 3))
10436− ==
10437− ::
10438− [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
10439− [%hold *]
10440− ?: (~(has in gil) sut)
10441− %void
10442− $(gil (~(put in gil) sut), sut repo)
10443− ::
10444− %void %void
10445− %noun %noun
10446− * $(sut repo)
10447− ==
10448− ::
10449− ++ peel
10450− |= [way=vial met=?(%gold %iron %lead %zinc)]
10451− ^- [sam=? con=?]
10452− ?: ?=(%gold met) [& &]
10453− ?- way
10454− %both [| |]
10455− %free [& &]
10456− %read [?=(%zinc met) |]
10457− %rite [?=(%iron met) |]
10458− ==
10459− ::
10460− ++ play
10461− ~/ %play
10462− => .(vet |)
10463− |= gen=hoon
10464− ^- type
10465− ?- gen
10466− [^ *] (cell $(gen p.gen) $(gen q.gen))
10467− [%brcn *] (core sut [p.gen %dry %gold] sut *seminoun q.gen)
10468− [%brpt *] (core sut [p.gen %wet %gold] sut *seminoun q.gen)
10469− [%cnts *] ~(play et p.gen q.gen)
10470− [%dtkt *] $(gen [%kttr p.gen])
10471− [%dtls *] [%atom %$ ~]
10472− [%rock *] |- ^- type
10473− ?@ q.gen [%atom p.gen `q.gen]
10474− [%cell $(q.gen -.q.gen) $(q.gen +.q.gen)]
10475− [%sand *] ?@ q.gen
10476− ?: =(%n p.gen) ?>(=(0 q.gen) [%atom p.gen `q.gen])
10477− ?: =(%f p.gen) ?>((lte q.gen 1) bool)
10478− [%atom p.gen ~]
10479− $(-.gen %rock)
10480− [%tune *] (face p.gen sut)
10481− [%dttr *] %noun
10482− [%dtts *] bool
10483− [%dtwt *] bool
10484− [%hand *] p.gen
10485− [%ktbr *] (wrap(sut $(gen p.gen)) %iron)
10486− [%ktls *] $(gen p.gen)
10487− [%ktpm *] (wrap(sut $(gen p.gen)) %zinc)
10488− [%ktsg *] $(gen p.gen)
10489− [%ktwt *] (wrap(sut $(gen p.gen)) %lead)
10490− [%note *] (hint [sut p.gen] $(gen q.gen))
10491− [%sgzp *] ~_(duck(sut ^$(gen p.gen)) $(gen q.gen))
10492− [%sggr *] $(gen q.gen)
10493− [%tsgr *] $(gen q.gen, sut $(gen p.gen))
10494− [%tscm *] $(gen q.gen, sut (busk p.gen))
10495− [%wtcl *] =+ [fex=(gain p.gen) wux=(lose p.gen)]
10496− %- fork :~
10497− ?:(=(%void fex) %void $(sut fex, gen q.gen))
10498− ?:(=(%void wux) %void $(sut wux, gen r.gen))
10499− ==
10500− [%fits *] bool
10501− [%wthx *] bool
10502− [%dbug *] ~_((show %o p.gen) $(gen q.gen))
10503− [%zpcm *] $(gen p.gen)
10504− [%lost *] %void
10505− [%zpmc *] (cell $(gen p.gen) $(gen q.gen))
10506− [%zpgl *] (play [%kttr p.gen])
10507− [%zpts *] %noun
10508− [%zppt *] ?:((feel p.gen) $(gen q.gen) $(gen r.gen))
10509− [%zpzp *] %void
10510− * =+ doz=~(open ap gen)
10511− ?: =(doz gen)
10512− ~_ (show [%c 'hoon'] [%q gen])
10513− ~> %mean.'play-open'
10514− !!
10515− $(gen doz)
10516− ==
10517− :: ::
10518− ++ redo :: refurbish faces
10519− ~/ %redo
10520− |= $: :: ref: raw payload
10521− ::
10522− ref=type
10523− ==
10524− :: :type: subject refurbished to reference namespace
10525− ::
10526− ^- type
10527− :: hos: subject tool stack
10528− :: wec: reference tool stack set
10529− :: gil: repetition set
10530− ::
10531− =| hos=(list tool)
10532− =/ wec=(set (list tool)) [~ ~ ~]
10533− =| gil=(set (pair type type))
10534− =< :: errors imply subject/reference mismatch
10535− ::
10536− ~| %redo-match
10537− :: reduce by subject
10538− ::
10539− dext
10540− |%
10541− :: ::
10542− ++ dear :: resolve tool stack
10543− :: :(unit (list tool)): unified tool stack
10544− ::
10545− ^- (unit (list tool))
10546− :: empty implies void
10547− ::
10548− ?~ wec `~
10549− :: any reference faces must be clear
10550− ::
10551− ?. ?=([* ~ ~] wec)
10552− ~& [%dear-many wec]
10553− ~
10554− :- ~
10555− :: har: single reference tool stack
10556− ::
10557− =/ har n.wec
10558− :: len: lengths of [sut ref] face stacks
10559− ::
10560− =/ len [p q]=[(lent hos) (lent har)]
10561− :: lip: length of sut-ref face stack overlap
10562− ::
10563− :: AB
10564− :: BC
10565− ::
10566− :: +lip is (lent B), where +hay is forward AB
10567− :: and +liv is forward BC (stack BA and CB).
10568− ::
10569− :: overlap is a weird corner case. +lip is
10570− :: almost always 0. brute force is fine.
10571− ::
10572− =/ lip
10573− =| lup=(unit @ud)
10574− =| lip=@ud
10575− |- ^- @ud
10576− ?: |((gth lip p.len) (gth lip q.len))
10577− (fall lup 0)
10578− :: lep: overlap candidate: suffix of subject face stack
10579− ::
10580− =/ lep (slag (sub p.len lip) hos)
10581− :: lap: overlap candidate: prefix of reference face stack
10582− ::
10583− =/ lap (scag lip har)
10584− :: save any match and continue
10585− ::
10586− $(lip +(lip), lup ?.(=(lep lap) lup `lip))
10587− :: ~& [har+har hos+hos len+len lip+lip]
10588− :: produce combined face stack (forward ABC, stack CBA)
10589− ::
10590− (weld hos (slag lip har))
10591− :: ::
10592− ++ dext :: subject traverse
10593− :: :type: refurbished subject
10594− ::
10595− ^- type
10596− :: check for trivial cases
10597− ::
10598− ?: ?| =(sut ref)
10599− ?=(?(%noun %void [?(%atom %core) *]) ref)
10600− ==
10601− done
10602− :: ~_ (dunk 'redo: dext: sut')
10603− :: ~_ (dunk(sut ref) 'redo: dext: ref')
10604− ?- sut
10605− ?(%noun %void [?(%atom %core) *])
10606− :: reduce reference and reassemble leaf
10607− ::
10608− done:(sint &)
10609− ::
10610− [%cell *]
10611− :: reduce reference to match subject
10612− ::
10613− => (sint &)
10614− ?> ?=([%cell *] sut)
10615− :: leaf with possible recursive descent
10616− ::
10617− %= done
10618− sut
10619− :: clear face stacks for descent
10620− ::
10621− =: hos ~
10622− wec [~ ~ ~]
10623− ==
10624− :: descend into cell
10625− ::
10626− :+ %cell
10627− dext(sut p.sut, ref (peek(sut ref) %free 2))
10628− dext(sut q.sut, ref (peek(sut ref) %free 3))
10629− ==
10630− ::
10631− [%face *]
10632− :: push face on subject stack, and descend
10633− ::
10634− dext(hos [p.sut hos], sut q.sut)
10635− ::
10636− [%hint *]
10637− :: work through hint
10638− ::
10639− (hint p.sut dext(sut q.sut))
10640− ::
10641− [%fork *]
10642− :: reconstruct each case in fork
10643− ::
10644− (fork (turn ~(tap in p.sut) |=(type dext(sut +<))))
10645− ::
10646− [%hold *]
10647− :: reduce to hard
10648− ::
10649− => (sint |)
10650− ?> ?=([%hold *] sut)
10651− ?: (~(has in fan) [p.sut q.sut])
10652− :: repo loop; redo depends on its own product
10653− ::
10654− done:(sint &)
10655− ?: (~(has in gil) [sut ref])
10656− :: type recursion, stop renaming
10657− ::
10658− done:(sint |)
10659− :: restore unchanged holds
10660− ::
10661− =+ repo
10662− =- ?:(=(- +<) sut -)
10663− dext(sut -, gil (~(put in gil) sut ref))
10664− ==
10665− :: ::
10666− ++ done :: complete assembly
10667− ^- type
10668− :: :type: subject refurbished
10669− ::
10670− :: lov: combined face stack
10671− ::
10672− =/ lov
10673− =/ lov dear
10674− ?~ lov
10675− :: ~_ (dunk 'redo: dear: sut')
10676− :: ~_ (dunk(sut ref) 'redo: dear: ref')
10677− ~& [%wec wec]
10678− !!
10679− (need lov)
10680− :: recompose faces
10681− ::
10682− |- ^- type
10683− ?~ lov sut
10684− $(lov t.lov, sut (face i.lov sut))
10685− ::
10686− ++ sint :: reduce by reference
10687− |= $: :: hod: expand holds
10688− ::
10689− hod=?
10690− ==
10691− :: ::.: reference with face/fork/hold reduced
10692− ::
10693− ^+ .
10694− :: =- ~> %slog.[0 (dunk 'sint: sut')]
10695− :: ~> %slog.[0 (dunk(sut ref) 'sint: ref')]
10696− :: ~> %slog.[0 (dunk(sut =>(- ref)) 'sint: pro')]
10697− :: -
10698− ?+ ref .
10699− [%hint *] $(ref q.ref)
10700− [%face *]
10701− :: extend all stacks in set
10702− ::
10703− %= $
10704− ref q.ref
10705− wec (~(run in wec) |=((list tool) [p.ref +<]))
10706− ==
10707− ::
10708− [%fork *]
10709− :: reconstruct all relevant cases
10710− ::
10711− =- :: ~> %slog.[0 (dunk 'fork: sut')]
10712− :: ~> %slog.[0 (dunk(sut ref) 'fork: ref')]
10713− :: ~> %slog.[0 (dunk(sut (fork ->)) 'fork: pro')]
10714− +(wec -<, ref (fork ->))
10715− =/ moy ~(tap in p.ref)
10716− |- ^- (pair (set (list tool)) (list type))
10717− ?~ moy [~ ~]
10718− :: head recurse
10719− ::
10720− =/ mor $(moy t.moy)
10721− :: prune reference cases outside subject
10722− ::
10723− ?: (miss i.moy) mor
10724− :: unify all cases
10725− ::
10726− =/ dis ^$(ref i.moy)
10727− [(~(uni in p.mor) wec.dis) [ref.dis q.mor]]
10728− ::
10729− [%hold *]
10730− ?. hod .
10731− $(ref repo(sut ref))
10732− ==
10733− --
10734− ::
10735− ++ repo
10736− ^- type
10737− ?- sut
10738− [%core *] [%cell %noun p.sut]
10739− [%face *] q.sut
10740− [%hint *] q.sut
10741− [%hold *] (rest [[p.sut q.sut] ~])
10742− %noun (fork [%atom %$ ~] [%cell %noun %noun] ~)
10743− * ~>(%mean.'repo-fltt' !!)
10744− ==
10745− ::
10746− ++ rest
10747− ~/ %rest
10748− |= leg=(list [p=type q=hoon])
10749− ^- type
10750− ?: (lien leg |=([p=type q=hoon] (~(has in fan) [p q])))
10751− ~>(%mean.'rest-loop' !!)
10752− => .(fan (~(gas in fan) leg))
10753− %- fork
10754− %~ tap in
10755− %- ~(gas in *(set type))
10756− (turn leg |=([p=type q=hoon] (play(sut p) q)))
10757− ::
10758− ++ sink
10759− ~/ %sink
10760− |^ ^- cord
10761− ?- sut
10762− %void 'void'
10763− %noun 'noun'
10764− [%atom *] (rap 3 'atom ' p.sut ' ' ?~(q.sut '~' u.q.sut) ~)
10765− [%cell *] (rap 3 'cell ' (mup p.sut) ' ' (mup q.sut) ~)
10766− [%face *] (rap 3 'face ' ?@(p.sut p.sut (mup p.sut)) ' ' (mup q.sut) ~)
10767− [%fork *] (rap 3 'fork ' (mup p.sut) ~)
10768− [%hint *] (rap 3 'hint ' (mup p.sut) ' ' (mup q.sut) ~)
10769− [%hold *] (rap 3 'hold ' (mup p.sut) ' ' (mup q.sut) ~)
10770− ::
10771− [%core *]
10772− %+ rap 3
10773− :~ 'core '
10774− (mup p.sut)
10775− ' '
10776− ?~(p.p.q.sut '~' u.p.p.q.sut)
10777− ' '
10778− q.p.q.sut
10779− ' '
10780− r.p.q.sut
10781− ' '
10782− (mup q.q.sut)
10783− ' '
10784− (mup p.r.q.sut)
10785− ==
10786− ==
10787− ::
10788− ++ mup |=(* (scot %p (mug +<)))
10789− --
10790− ::
10791− ++ take
10792− |= [vit=vein duz=$-(type type)]
10793− ^- (pair axis type)
10794− :- (tend vit)
10795− =. vit (flop vit)
10796− |- ^- type
10797− ?~ vit (duz sut)
10798− ?~ i.vit
10799− |- ^- type
10800− ?+ sut ^$(vit t.vit)
10801− [%face *] (face p.sut ^$(vit t.vit, sut q.sut))
10802− [%hint *] (hint p.sut ^$(sut q.sut))
10803− [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
10804− [%hold *] $(sut repo)
10805− ==
10806− =+ vil=*(set type)
10807− |- ^- type
10808− ?: =(1 u.i.vit)
10809− ^$(vit t.vit)
10810− =+ [now lat]=(cap u.i.vit)^(mas u.i.vit)
10811− ?- sut
10812− %noun $(sut [%cell %noun %noun])
10813− %void %void
10814− [%atom *] %void
10815− [%cell *] ?: =(2 now)
10816− (cell $(sut p.sut, u.i.vit lat) q.sut)
10817− (cell p.sut $(sut q.sut, u.i.vit lat))
10818− [%core *] ?: =(2 now)
10819− $(sut repo)
10820− (core $(sut p.sut, u.i.vit lat) q.sut)
10821− [%face *] (face p.sut $(sut q.sut))
10822− [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
10823− [%hint *] (hint p.sut $(sut q.sut))
10824− [%hold *] ?: (~(has in vil) sut)
10825− %void
10826− $(sut repo, vil (~(put in vil) sut))
10827− ==
10828− ::
10829− ++ tack
10830− |= [hyp=wing mur=type]
10831− ~_ (show [%c %tack] %l hyp)
10832− =+ fid=(find %rite hyp)
10833− ?> ?=(%& -.fid)
10834− (take p.p.fid |=(type mur))
10835− ::
10836− ++ tend
10837− |= vit=vein
10838− ^- axis
10839− ?~(vit 1 (peg $(vit t.vit) ?~(i.vit 1 u.i.vit)))
10840− ::
10841− ++ toss
10842− ~/ %toss
10843− |= [hyp=wing mur=type men=(list [p=type q=foot])]
10844− ^- [p=axis q=(list [p=type q=foot])]
10845− =- [(need p.wib) q.wib]
10846− ^= wib
10847− |- ^- [p=(unit axis) q=(list [p=type q=foot])]
10848− ?~ men
10849− [*(unit axis) ~]
10850− =+ geq=(tack(sut p.i.men) hyp mur)
10851− =+ mox=$(men t.men)
10852− [(mate p.mox `_p.mox`[~ p.geq]) [[q.geq q.i.men] q.mox]]
10853− ::
10854− ++ wrap
10855− ~/ %wrap
10856− |= yoz=?(%lead %iron %zinc)
10857− ~_ leaf+"wrap"
10858− ^- type
10859− ?+ sut sut
10860− [%cell *] (cell $(sut p.sut) $(sut q.sut))
10861− [%core *] ?>(|(=(%gold r.p.q.sut) =(%lead yoz)) sut(r.p.q yoz))
10862− [%face *] (face p.sut $(sut q.sut))
10863− [%fork *] (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
10864− [%hint *] (hint p.sut $(sut q.sut))
10865− [%hold *] $(sut repo)
10866− ==
10867− --
10868−++ us :: prettyprinter
10869− => |%
10870− +$ cape [p=(map @ud wine) q=wine] ::
10871− +$ wine ::
10872− $@ $? %noun ::
10873− %path ::
10874− %type ::
10875− %void ::
10876− %wall ::
10877− %wool ::
10878− %yarn ::
10879− == ::
10880− $% [%mato p=term] ::
10881− [%core p=(list @ta) q=wine] ::
10882− [%face p=term q=wine] ::
10883− [%list p=term q=wine] ::
10884− [%pear p=term q=@] ::
10885− [%bcwt p=(list wine)] ::
10886− [%plot p=(list wine)] ::
10887− [%stop p=@ud] ::
10888− [%tree p=term q=wine] ::
10889− [%unit p=term q=wine] ::
10890− [%name p=stud q=wine] ::
10891− == ::
10892− --
10893− |_ sut=type
10894− ++ dash
10895− |= [mil=tape lim=char lam=tape]
10896− ^- tape
10897− =/ esc (~(gas in *(set @tD)) lam)
10898− :- lim
10899− |- ^- tape
10900− ?~ mil [lim ~]
10901− ?: ?| =(lim i.mil)
10902− =('\\' i.mil)
10903− (~(has in esc) i.mil)
10904− ==
10905− ['\\' i.mil $(mil t.mil)]
10906− ?: (lte ' ' i.mil)
10907− [i.mil $(mil t.mil)]
10908− ['\\' ~(x ne (rsh 2 i.mil)) ~(x ne (end 2 i.mil)) $(mil t.mil)]
10909− ::
10910− ++ deal |=(lum=* (dish dole lum))
10911− ++ dial
10912− |= ham=cape
10913− =+ gid=*(set @ud)
10914− =< `tank`-:$
10915− |%
10916− ++ many
10917− |= haz=(list wine)
10918− ^- [(list tank) (set @ud)]
10919− ?~ haz [~ gid]
10920− =^ mor gid $(haz t.haz)
10921− =^ dis gid ^$(q.ham i.haz)
10922− [[dis mor] gid]
10923− ::
10924− ++ $
10925− ^- [tank (set @ud)]
10926− ?- q.ham
10927− %noun :_(gid [%leaf '*' ~])
10928− %path :_(gid [%leaf '/' ~])
10929− %type :_(gid [%leaf '#' 't' ~])
10930− %void :_(gid [%leaf '#' '!' ~])
10931− %wool :_(gid [%leaf '*' '"' '"' ~])
10932− %wall :_(gid [%leaf '*' '\'' '\'' ~])
10933− %yarn :_(gid [%leaf '"' '"' ~])
10934− [%mato *] :_(gid [%leaf '@' (trip p.q.ham)])
10935− [%core *]
10936− =^ cox gid $(q.ham q.q.ham)
10937− :_ gid
10938− :+ %rose
10939− [[' ' ~] ['<' ~] ['>' ~]]
10940− |- ^- (list tank)
10941− ?~ p.q.ham [cox ~]
10942− [[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
10943− ::
10944− [%face *]
10945− =^ cox gid $(q.ham q.q.ham)
10946− :_(gid [%palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
10947− ::
10948− [%list *]
10949− =^ cox gid $(q.ham q.q.ham)
10950− :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
10951− ::
10952− [%bcwt *]
10953− =^ coz gid (many p.q.ham)
10954− :_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
10955− ::
10956− [%plot *]
10957− =^ coz gid (many p.q.ham)
10958− :_(gid [%rose [[' ' ~] ['[' ~] [']' ~]] coz])
10959− ::
10960− [%pear *]
10961− :_(gid [%leaf '%' ~(rend co [%$ p.q.ham q.q.ham])])
10962− ::
10963− [%stop *]
10964− =+ num=~(rend co [%$ %ud p.q.ham])
10965− ?: (~(has in gid) p.q.ham)
10966− :_(gid [%leaf '#' num])
10967− =^ cox gid
10968− %= $
10969− gid (~(put in gid) p.q.ham)
10970− q.ham (~(got by p.ham) p.q.ham)
10971− ==
10972− :_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
10973− ::
10974− [%tree *]
10975− =^ cox gid $(q.ham q.q.ham)
10976− :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
10977− ::
10978− [%unit *]
10979− =^ cox gid $(q.ham q.q.ham)
10980− :_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
10981− ::
10982− [%name *]
10983− :_ gid
10984− ?@ p.q.ham (cat 3 '#' mark.p.q.ham)
10985− (rap 3 '#' auth.p.q.ham '+' (spat type.p.q.ham) ~)
10986− ==
10987− --
10988− ::
10989− ++ dish !:
10990− |= [ham=cape lum=*] ^- tank
10991− ~| [%dish-h ?@(q.ham q.ham -.q.ham)]
10992− ~| [%lump lum]
10993− ~| [%ham ham]
10994− %- need
10995− =| gil=(set [@ud *])
10996− |- ^- (unit tank)
10997− ?- q.ham
10998− %noun
10999− %= $
11000− q.ham
11001− ?: ?=(@ lum)
11002− [%mato %$]
11003− :- %plot
11004− |- ^- (list wine)
11005− [%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
11006− ==
11007− ::
11008− %path
11009− :- ~
11010− :+ %rose
11011− [['/' ~] ['/' ~] ~]
11012− |- ^- (list tank)
11013− ?~ lum ~
11014− ?@ lum !!
11015− ?> ?=(@ -.lum)
11016− [[%leaf (rip 3 -.lum)] $(lum +.lum)]
11017− ::
11018− %type
11019− =+ tyr=|.((dial dole))
11020− =+ vol=tyr(sut lum)
11021− =+ cis=;;(tank .*(vol [%9 2 %0 1]))
11022− :^ ~ %palm
11023− [~ ~ ~ ~]
11024− [[%leaf '#' 't' '/' ~] cis ~]
11025− ::
11026− %wall
11027− :- ~
11028− :+ %rose
11029− [[' ' ~] ['<' '|' ~] ['|' '>' ~]]
11030− |- ^- (list tank)
11031− ?~ lum ~
11032− ?@ lum !!
11033− [[%leaf (trip ;;(@ -.lum))] $(lum +.lum)]
11034− ::
11035− %wool
11036− :- ~
11037− :+ %rose
11038− [[' ' ~] ['<' '<' ~] ['>' '>' ~]]
11039− |- ^- (list tank)
11040− ?~ lum ~
11041− ?@ lum !!
11042− [(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
11043− ::
11044− %yarn
11045− [~ %leaf (dash (tape lum) '"' "\{")]
11046− ::
11047− %void
11048− ~
11049− ::
11050− [%mato *]
11051− ?. ?=(@ lum)
11052− ~
11053− :+ ~
11054− %leaf
11055− ?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
11056− ~(rend co [%$ p.q.ham lum])
11057− %$ ~(rend co [%$ %ud lum])
11058− %t (dash (rip 3 lum) '\'' ~)
11059− %tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
11060− ==
11061− ::
11062− [%core *]
11063− :: XX needs rethinking for core metal
11064− :: ?. ?=(^ lum) ~
11065− :: => .(lum `*`lum)
11066− :: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
11067− :: ^= tok
11068− :: |- ^- (unit (list tank))
11069− :: ?~ p.q.ham
11070− :: =+ den=^$(q.ham q.q.ham)
11071− :: ?~(den ~ [~ u.den ~])
11072− :: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
11073− :: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
11074− [~ (dial ham)]
11075− ::
11076− [%face *]
11077− =+ wal=$(q.ham q.q.ham)
11078− ?~ wal
11079− ~
11080− [~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
11081− ::
11082− [%list *]
11083− ?: =(~ lum)
11084− [~ %leaf '~' ~]
11085− =- ?~ tok
11086− ~
11087− [~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
11088− ^= tok
11089− |- ^- (unit (list tank))
11090− ?: ?=(@ lum)
11091− ?.(=(~ lum) ~ [~ ~])
11092− =+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
11093− ?. &(?=(^ for) ?=(^ aft))
11094− ~
11095− [~ u.for u.aft]
11096− ::
11097− [%bcwt *]
11098− |- ^- (unit tank)
11099− ?~ p.q.ham
11100− ~
11101− =+ wal=^$(q.ham i.p.q.ham)
11102− ?~ wal
11103− $(p.q.ham t.p.q.ham)
11104− wal
11105− ::
11106− [%plot *]
11107− =- ?~ tok
11108− ~
11109− [~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
11110− ^= tok
11111− |- ^- (unit (list tank))
11112− ?~ p.q.ham
11113− ~
11114− ?: ?=([* ~] p.q.ham)
11115− =+ wal=^$(q.ham i.p.q.ham)
11116− ?~(wal ~ [~ [u.wal ~]])
11117− ?@ lum
11118− ~
11119− =+ gim=^$(q.ham i.p.q.ham, lum -.lum)
11120− ?~ gim
11121− ~
11122− =+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
11123− ?~ myd
11124− ~
11125− [~ u.gim u.myd]
11126− ::
11127− [%pear *]
11128− ?. =(lum q.q.ham)
11129− ~
11130− =. p.q.ham
11131− (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
11132− =+ fox=$(q.ham [%mato p.q.ham])
11133− ?> ?=([~ %leaf ^] fox)
11134− ?: ?=(?(%n %tas) p.q.ham)
11135− fox
11136− [~ %leaf '%' p.u.fox]
11137− ::
11138− [%stop *]
11139− ?: (~(has in gil) [p.q.ham lum]) ~
11140− =+ kep=(~(get by p.ham) p.q.ham)
11141− ?~ kep
11142− ~|([%stop-loss p.q.ham] !!)
11143− $(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
11144− ::
11145− [%tree *]
11146− =- ?~ tok
11147− ~
11148− [~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
11149− ^= tok
11150− =+ tuk=*(list tank)
11151− |- ^- (unit (list tank))
11152− ?: =(~ lum)
11153− [~ tuk]
11154− ?. ?=([n=* l=* r=*] lum)
11155− ~
11156− =+ rol=$(lum r.lum)
11157− ?~ rol
11158− ~
11159− =+ tim=^$(q.ham q.q.ham, lum n.lum)
11160− ?~ tim
11161− ~
11162− $(lum l.lum, tuk [u.tim u.rol])
11163− ::
11164− [%unit *]
11165− ?@ lum
11166− ?.(=(~ lum) ~ [~ %leaf '~' ~])
11167− ?. =(~ -.lum)
11168− ~
11169− =+ wal=$(q.ham q.q.ham, lum +.lum)
11170− ?~ wal
11171− ~
11172− [~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
11173− ::
11174− [%name *]
11175− $(q.ham q.q.ham)
11176− ==
11177− ::
11178− ++ doge
11179− |= ham=cape
11180− =- ?+ woz woz
11181− [%list * [%mato %'ta']] %path
11182− [%list * [%mato %'t']] %wall
11183− [%list * [%mato %'tD']] %yarn
11184− [%list * %yarn] %wool
11185− ==
11186− ^= woz
11187− ^- wine
11188− ?. ?=([%stop *] q.ham)
11189− ?: ?& ?= [%bcwt [%pear %n %0] [%plot [%pear %n %0] [%face *] ~] ~]
11190− q.ham
11191− =(1 (met 3 p.i.t.p.i.t.p.q.ham))
11192− ==
11193− [%unit =<([p q] i.t.p.i.t.p.q.ham)]
11194− q.ham
11195− =+ may=(~(get by p.ham) p.q.ham)
11196− ?~ may
11197− q.ham
11198− =+ nul=[%pear %n 0]
11199− ?. ?& ?=([%bcwt *] u.may)
11200− ?=([* * ~] p.u.may)
11201− |(=(nul i.p.u.may) =(nul i.t.p.u.may))
11202− ==
11203− q.ham
11204− =+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
11205− ?: ?& ?=([%plot [%face *] [%face * %stop *] ~] din)
11206− =(p.q.ham p.q.i.t.p.din)
11207− =(1 (met 3 p.i.p.din))
11208− =(1 (met 3 p.i.t.p.din))
11209− ==
11210− :+ %list
11211− (cat 3 p.i.p.din p.i.t.p.din)
11212− q.i.p.din
11213− ?: ?& ?= $: %plot
11214− [%face *]
11215− [%face * %stop *]
11216− [[%face * %stop *] ~]
11217− ==
11218− din
11219− =(p.q.ham p.q.i.t.p.din)
11220− =(p.q.ham p.q.i.t.t.p.din)
11221− =(1 (met 3 p.i.p.din))
11222− =(1 (met 3 p.i.t.p.din))
11223− =(1 (met 3 p.i.t.t.p.din))
11224− ==
11225− :+ %tree
11226− %^ cat
11227− 3
11228− p.i.p.din
11229− (cat 3 p.i.t.p.din p.i.t.t.p.din)
11230− q.i.p.din
11231− q.ham
11232− ::
11233− ++ dole
11234− ^- cape
11235− =+ gil=*(set type)
11236− =+ dex=[p=*(map type @) q=*(map @ wine)]
11237− =< [q.p q]
11238− |- ^- [p=[p=(map type @) q=(map @ wine)] q=wine]
11239− =- [p.tez (doge q.p.tez q.tez)]
11240− ^= tez
11241− ^- [p=[p=(map type @) q=(map @ wine)] q=wine]
11242− ?: (~(meet ut sut) -:!>(*type))
11243− [dex %type]
11244− ?- sut
11245− %noun [dex sut]
11246− %void [dex sut]
11247− [%atom *] [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
11248− [%cell *]
11249− =+ hin=$(sut p.sut)
11250− =+ yon=$(dex p.hin, sut q.sut)
11251− :- p.yon
11252− :- %plot
11253− ?:(?=([%plot *] q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
11254− ::
11255− [%core *]
11256− =+ yad=$(sut p.sut)
11257− :- p.yad
11258− =+ ^= doy ^- [p=(list @ta) q=wine]
11259− ?: ?=([%core *] q.yad)
11260− [p.q.yad q.q.yad]
11261− [~ q.yad]
11262− :- %core
11263− :_ q.doy
11264− :_ p.doy
11265− %^ cat 3
11266− %~ rent co
11267− :+ %$ %ud
11268− %- ~(rep by (~(run by q.r.q.sut) |=(tome ~(wyt by q.+<))))
11269− |=([[@ a=@u] b=@u] (add a b))
11270− %^ cat 3
11271− ?-(r.p.q.sut %gold '.', %iron '|', %lead '?', %zinc '&')
11272− =+ gum=(mug q.r.q.sut)
11273− %+ can 3
11274− :~ [1 (add 'a' (mod gum 26))]
11275− [1 (add 'a' (mod (div gum 26) 26))]
11276− [1 (add 'a' (mod (div gum 676) 26))]
11277− ==
11278− ::
11279− [%hint *]
11280− =+ yad=$(sut q.sut)
11281− ?. ?=(%know -.q.p.sut) yad
11282− [p.yad [%name p.q.p.sut q.yad]]
11283− ::
11284− [%face *]
11285− =+ yad=$(sut q.sut)
11286− ?^(p.sut yad [p.yad [%face p.sut q.yad]])
11287− ::
11288− [%fork *]
11289− =+ yed=(sort ~(tap in p.sut) aor)
11290− =- [p [%bcwt q]]
11291− |- ^- [p=[p=(map type @) q=(map @ wine)] q=(list wine)]
11292− ?~ yed
11293− [dex ~]
11294− =+ mor=$(yed t.yed)
11295− =+ dis=^$(dex p.mor, sut i.yed)
11296− [p.dis q.dis q.mor]
11297− ::
11298− [%hold *]
11299− =+ hey=(~(get by p.dex) sut)
11300− ?^ hey
11301− [dex [%stop u.hey]]
11302− ?: (~(has in gil) sut)
11303− =+ dyr=+(~(wyt by p.dex))
11304− [[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
11305− =+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
11306− =+ rey=(~(get by p.p.rom) sut)
11307− ?~ rey
11308− rom
11309− [[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
11310− ==
11311− ::
11312− ++ duck (dial dole)
11313− --
11314−++ cain sell :: $-(vase tank)
11315−++ noah text :: $-(vase tape)
11316−++ onan seer :: $-(vise vase)
11317−++ levi :: $-([type type] ?)
11318− |= [a=type b=type]
11319− (~(nest ut a) & b)
11320−::
11321−++ text :: tape pretty-print
11322− |= vax=vase ^- tape
11323− ~(ram re (sell vax))
11324−::
11325−++ seem |=(toy=typo `type`toy) :: promote typo
11326−++ seer |=(vix=vise `vase`vix) :: promote vise
11327−::
11328−:: +sell: pretty-print a vase to a tank using +deal.
11329−::
11330−++ sell
11331− ~/ %sell
11332− |= vax=vase
11333− ^- tank
11334− ~| %sell
11335− (~(deal us p.vax) q.vax)
11336−::
11337−:: +skol: $-(type tank) using duck.
11338−::
11339−++ skol
11340− |= typ=type
11341− ^- tank
11342− ~(duck ut typ)
11343−::
11344−++ slam :: slam a gate
11345− |= [gat=vase sam=vase] ^- vase
11346− =+ :- ^= typ ^- type
11347− [%cell p.gat p.sam]
11348− ^= gen ^- hoon
11349− [%cnsg [%$ ~] [%$ 2] [%$ 3] ~]
11350− =+ gun=(~(mint ut typ) %noun gen)
11351− [p.gun (slum q.gat q.sam)]
11352−::
11353−:: +slab: states whether you can access an arm in a type.
11354−::
11355−:: .way: the access type ($vial): read, write, or read-and-write.
11356−:: The fourth case of $vial, %free, is not permitted because it would
11357−:: allow you to discover "private" information about a type,
11358−:: information which you could not make use of in (law-abiding) hoon anyway.
11359−::
11360−++ slab :: test if contains
11361− |= [way=?(%read %rite %both) cog=@tas typ=type]
11362− ?= [%& *]
11363− (~(fond ut typ) way ~[cog])
11364−::
11365−++ slap
11366− |= [vax=vase gen=hoon] ^- vase :: untyped vase .*
11367− =+ gun=(~(mint ut p.vax) %noun gen)
11368− [p.gun .*(q.vax q.gun)]
11369−::
11370−++ slog :: deify printf
11371− =| pri=@ :: priority level
11372− |= a=tang ^+ same :: .= ~&(%a 1)
11373− ?~(a same ~>(%slog.[pri i.a] $(a t.a))) :: ((slog ~[>%a<]) 1)
11374−:: ::
11375−++ mean :: crash with trace
11376− |= a=tang
11377− ^+ !!
11378− ?~ a !!
11379− ~_(i.a $(a t.a))
11380−::
11381−++ road
11382− |* =(trap *)
11383− ^+ $:trap
11384− =/ res (mule trap)
11385− ?- -.res
11386− %& p.res
11387− %| (mean p.res)
11388− ==
11389−::
11390−++ slew :: get axis in vase
11391− |= [axe=@ vax=vase]
11392− =/ typ |. (~(peek ut p.vax) %free axe)
11393− |- ^- (unit vase)
11394− ?: =(1 axe) `[$:typ q.vax]
11395− ?@ q.vax ~
11396− $(axe (mas axe), q.vax ?-((cap axe) %2 -.q.vax, %3 +.q.vax))
11397−::
11398−++ slim :: identical to seer?
11399− |= old=vise ^- vase
11400− old
11401−::
11402−++ slit :: type of slam
11403− |= [gat=type sam=type]
11404− ?> (~(nest ut (~(peek ut gat) %free 6)) & sam)
11405− (~(play ut [%cell gat sam]) [%cnsg [%$ ~] [%$ 2] [%$ 3] ~])
11406−::
11407−++ slob :: superficial arm
11408− |= [cog=@tas typ=type]
11409− ^- ?
11410− ?+ typ |
11411− [%hold *] $(typ ~(repo ut typ))
11412− [%hint *] $(typ ~(repo ut typ))
11413− [%core *]
11414− |- ^- ?
11415− ?~ q.r.q.typ |
11416− ?| (~(has by q.q.n.q.r.q.typ) cog)
11417− $(q.r.q.typ l.q.r.q.typ)
11418− $(q.r.q.typ r.q.r.q.typ)
11419− ==
11420− ==
11421−::
11422−++ sloe :: get arms in core
11423− |= typ=type
11424− ^- (list term)
11425− ?+ typ ~
11426− [%hold *] $(typ ~(repo ut typ))
11427− [%hint *] $(typ ~(repo ut typ))
11428− [%core *]
11429− %- zing
11430− %+ turn ~(tap by q.r.q.typ)
11431− |= [* b=tome]
11432− %+ turn ~(tap by q.b)
11433− |= [a=term *]
11434− a
11435− ==
11436−::
11437−++ slop :: cons two vases
11438− |= [hed=vase tal=vase]
11439− ^- vase
11440− [[%cell p.hed p.tal] [q.hed q.tal]]
11441−::
11442−++ slot :: got axis in vase
11443− |= [axe=@ vax=vase] ^- vase
11444− [(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])]
11445−::
11446−++ slym :: slam w+o sample-type
11447− |= [gat=vase sam=*] ^- vase
11448− (slap gat(+<.q sam) [%limb %$])
11449−::
11450−++ sped :: reconstruct type
11451− |= vax=vase
11452− ^- vase
11453− :_ q.vax
11454− ?@ q.vax (~(fuse ut p.vax) [%atom %$ ~])
11455− ?@ -.q.vax
11456− ^= typ
11457− %- ~(play ut p.vax)
11458− [%wtgr [%wtts [%leaf %tas -.q.vax] [%& 2]~] [%$ 1]]
11459− (~(fuse ut p.vax) [%cell %noun %noun])
11460−:: +swat: deferred +slap
11461−::
11462−++ swat
11463− |= [tap=(trap vase) gen=hoon]
11464− ^- (trap vase)
11465− =/ gun (~(mint ut p:$:tap) %noun gen)
11466− |. ~+
11467− [p.gun .*(q:$:tap q.gun)]
11468−::
11469−:: 5d: parser
11470−+| %parser
11471−::
11472−:: +vang: set +vast params
11473−::
11474−:: bug: debug mode
11475−:: doc: doccord parsing
11476−:: wer: where we are
11477−::
11478−++ vang
11479− |= [f=$@(? [bug=? doc=?]) wer=path]
11480− %*(. vast bug ?@(f f bug.f), doc ?@(f & doc.f), wer wer)
11481−::
11482−++ vast :: main parsing core
11483− =+ [bug=`?`| wer=*path doc=`?`&]
11484− |%
11485− ++ gash %+ cook :: parse path
11486− |= a=(list tyke) ^- tyke
11487− ?~(a ~ (weld i.a $(a t.a)))
11488− (more fas limp)
11489− ++ gasp ;~ pose :: parse =path= etc.
11490− %+ cook
11491− |=([a=tyke b=tyke c=tyke] :(weld a b c))
11492− ;~ plug
11493− (cook |=(a=(list) (turn a |=(b=* ~))) (star tis))
11494− (cook |=(a=hoon [[~ a] ~]) hasp)
11495− (cook |=(a=(list) (turn a |=(b=* ~))) (star tis))
11496− ==
11497− (cook |=(a=(list) (turn a |=(b=* ~))) (plus tis))
11498− ==
11499− ++ glam ~+((glue ace))
11500− ++ hasp ;~ pose :: path element
11501− (ifix [sel ser] wide)
11502− (stag %cncl (ifix [pal par] (most ace wide)))
11503− (stag %sand (stag %tas (cold %$ buc)))
11504− (stag %sand (stag %t qut))
11505− %+ cook
11506− |=(a=coin [%sand ?:(?=([~ %tas *] a) %tas %ta) ~(rent co a)])
11507− nuck:so
11508− ==
11509− ++ limp %+ cook
11510− |= [a=(list) b=tyke]
11511− ?~ a b
11512− $(a t.a, b [`[%sand %tas %$] b])
11513− ;~(plug (star fas) gasp)
11514− ++ mota %+ cook
11515− |=([a=tape b=tape] (rap 3 (weld a b)))
11516− ;~(plug (star low) (star hig))
11517− ++ docs
11518− |%
11519− :: +apex: prefix comment. may contain batch comments.
11520− ::
11521− :: when a prefix doccord is parsed, it is possible that there is no +gap
11522− :: afterward to be consumed, so we add an additional newline and
11523− :: decrement the line number in the `hair` of the parser
11524− ::
11525− :: the reason for this is that the whitespace parsing under +vast seems
11526− :: to factor more cleanly this way, at least compared to the variations
11527− :: tried without the extra newline. this doesn't mean there isn't a
11528− :: better factorization without it, though.
11529− ++ apex
11530− ?. doc (easy *whit)
11531− %+ knee *whit |. ~+
11532− ;~ plug
11533− |= tub=nail
11534− =/ vex
11535− %. tub
11536− %- star
11537− %+ cook |*([[a=* b=*] c=*] [a b c])
11538− ;~(pfix (punt leap) into ;~(pose larg smol))
11539− ?~ q.vex vex
11540− :- p=p.vex
11541− %- some
11542− ?~ p.u.q.vex
11543− [p=~ q=q.u.q.vex]
11544− :- p=(malt p.u.q.vex)
11545− q=`nail`[[(dec p.p.q.u.q.vex) q.p.q.u.q.vex] ['\0a' q.q.u.q.vex]]
11546− ==
11547− ::
11548− :: +apse: postfix comment.
11549− ::
11550− :: a one line comment at the end of a line (typically starting at column
11551− :: 57) that attaches to the expression starting at the beginning of the
11552− :: current line. does not use a $link.
11553− ++ apse
11554− ?. doc (easy *whiz)
11555− %+ knee *whiz |. ~+
11556− ;~ pose
11557− ;~(less ;~(plug into step en-link col ace) ;~(pfix into step line))
11558− ::
11559− (easy *whiz)
11560− ==
11561− ::
11562− ++ leap :: whitespace w/o docs
11563− %+ cold ~
11564− ;~ plug
11565− ;~ pose
11566− (just '\0a')
11567− ;~(plug gah ;~(pose gah skip))
11568− skip
11569− ==
11570− (star ;~(pose skip gah))
11571− ==
11572− ::
11573− :: +smol: 2 aces then summary, 4 aces then paragraphs.
11574− ++ smol
11575− ;~ pfix
11576− step
11577− ;~ plug
11578− ;~ plug
11579− (plus en-link)
11580− ;~ pose
11581− (ifix [;~(plug col ace) (just '\0a')] (cook crip (plus prn)))
11582− (ifix [(star ace) (just '\0a')] (easy *cord))
11583− ==
11584− ==
11585− (rant ;~(pfix step step text))
11586− ==
11587− ==
11588− ::
11589− :: +larg: 4 aces then summary, 2 aces then paragraphs.
11590− ++ larg
11591− ;~ pfix
11592− step step
11593− ;~ plug
11594− ;~ sfix
11595− ;~ plug
11596− ;~ pose
11597− ;~(sfix (plus en-link) col ace)
11598− ;~(less ace (easy *cuff))
11599− ==
11600− ;~(less ace (cook crip (plus prn)))
11601− ==
11602− (just '\0a')
11603− ==
11604− (rant ;~(pfix step teyt))
11605− ==
11606− ==
11607− ::
11608− ++ rant
11609− |* sec=rule
11610− %- star
11611− ;~ pfix
11612− (ifix [into (just '\0a')] (star ace))
11613− (plus (ifix [into (just '\0a')] sec))
11614− ==
11615− ::
11616− ++ skip :: non-doccord comment
11617− ;~ plug
11618− col col
11619− ;~(less ;~(pose larg smol) ;~(plug (star prn) (just '\0a')))
11620− ==
11621− ::
11622− ++ null (cold ~ (star ace))
11623− ++ text (pick line code)
11624− ++ teyt (pick line ;~(pfix step code))
11625− ++ line ;~(less ace (cook crip (star prn)))
11626− ++ code ;~(pfix step ;~(less ace (cook crip (star prn))))
11627− ++ step ;~(plug ace ace)
11628− ::
11629− ++ into
11630− ;~(plug (star ace) col col)
11631− ::
11632− ++ en-link
11633− |= a=nail %. a
11634− %+ knee *link |. ~+
11635− %- stew
11636− ^. stet ^. limo
11637− :~ :- '|' ;~(pfix bar (stag %chat sym))
11638− :- '.' ;~(pfix dot (stag %frag sym))
11639− :- '+' ;~(pfix lus (stag %funk sym))
11640− :- '$' ;~(pfix buc (stag %plan sym))
11641− :- '%' ;~(pfix cen (stag %cone bisk:so))
11642− ==
11643− --
11644− ::
11645− ++ clad :: hoon doccords
11646− |* fel=rule
11647− %+ cook
11648− |= [a=whit b=hoon c=whiz]
11649− =? b !=(c *whiz)
11650− [%note help/`[c]~ b]
11651− =+ docs=~(tap by bat.a)
11652− |-
11653− ?~ docs b
11654− $(docs t.docs, b [%note help/i.docs b])
11655− (seam fel)
11656− ++ coat :: spec doccords
11657− |* fel=rule
11658− %+ cook
11659− |= [a=whit b=spec c=whiz]
11660− =? b !=(c *whiz)
11661− [%gist help/`[c]~ b]
11662− =+ docs=~(tap by bat.a)
11663− |-
11664− ?~ docs b
11665− $(docs t.docs, b [%gist help/i.docs b])
11666− (seam fel)
11667− ++ scye :: with prefix doccords
11668− |* fel=rule
11669− ;~(pose ;~(plug apex:docs ;~(pfix gap fel)) ;~(plug (easy *whit) fel))
11670− ++ seam :: with doccords
11671− |* fel=rule
11672− (scye ;~(plug fel apse:docs))
11673− ::
11674− ++ plex :: reparse static path
11675− |= gen=hoon ^- (unit path)
11676− ?: ?=([%dbug *] gen) :: unwrap %dbug
11677− $(gen q.gen)
11678− ?. ?=([%clsg *] gen) ~ :: require :~ hoon
11679− %+ reel p.gen :: build using elements
11680− |= [a=hoon b=_`(unit path)`[~ u=/]] :: starting from just /
11681− ?~ b ~
11682− ?. ?=([%sand ?(%ta %tas) @] a) ~ :: /foo constants
11683− `[q.a u.b]
11684− ::
11685− ++ phax
11686− |= ruw=(list (list woof))
11687− =+ [yun=*(list hoon) cah=*(list @)]
11688− =+ wod=|=([a=tape b=(list hoon)] ^+(b ?~(a b [[%mcfs %knit (flop a)] b])))
11689− |- ^+ yun
11690− ?~ ruw
11691− (flop (wod cah yun))
11692− ?~ i.ruw $(ruw t.ruw)
11693− ?@ i.i.ruw
11694− $(i.ruw t.i.ruw, cah [i.i.ruw cah])
11695− $(i.ruw t.i.ruw, cah ~, yun [p.i.i.ruw (wod cah yun)])
11696− ::
11697− ++ posh
11698− |= [pre=(unit tyke) pof=(unit [p=@ud q=tyke])]
11699− ^- (unit (list hoon))
11700− =- ?^(- - ~&(%posh-fail -))
11701− =+ wom=(poof wer)
11702− %+ biff
11703− ?~ pre `u=wom
11704− %+ bind (poon wom u.pre)
11705− |= moz=(list hoon)
11706− ?~(pof moz (weld moz (slag (lent u.pre) wom)))
11707− |= yez=(list hoon)
11708− ?~ pof `yez
11709− =+ zey=(flop yez)
11710− =+ [moz=(scag p.u.pof zey) gul=(slag p.u.pof zey)]
11711− =+ zom=(poon (flop moz) q.u.pof)
11712− ?~(zom ~ `(weld (flop gul) u.zom))
11713− ::
11714− ++ poof :: path -> (list hoon)
11715− |=(pax=path ^-((list hoon) (turn pax |=(a=@ta [%sand %ta a]))))
11716− ::
11717− :: tyke is =foo== as ~[~ `foo ~ ~]
11718− :: interpolate '=' path components
11719− ++ poon :: try to replace '='s
11720− |= [pag=(list hoon) goo=tyke] :: default to pag
11721− ^- (unit (list hoon)) :: for null goo's
11722− ?~ goo `~ :: keep empty goo
11723− %+ both :: otherwise head comes
11724− ?^(i.goo i.goo ?~(pag ~ `u=i.pag)) :: from goo or pag
11725− $(goo t.goo, pag ?~(pag ~ t.pag)) :: recurse on tails
11726− ::
11727− ++ poor
11728− %+ sear posh
11729− ;~ plug
11730− (stag ~ gash)
11731− ;~(pose (stag ~ ;~(pfix cen porc)) (easy ~))
11732− ==
11733− ::
11734− ++ porc
11735− ;~ plug
11736− (cook |=(a=(list) (lent a)) (star cen))
11737− ;~(pfix fas gash)
11738− ==
11739− ::
11740− ++ rump
11741− %+ sear
11742− |= [a=wing b=(unit hoon)] ^- (unit hoon)
11743− ?~(b [~ %wing a] ?.(?=([@ ~] a) ~ [~ [%rock %tas i.a] u.b]))
11744− ;~(plug rope ;~(pose (stag ~ wede) (easy ~)))
11745− ::
11746− ++ rood
11747− ;~ pfix fas
11748− (stag %clsg poor)
11749− ==
11750− ::
11751− ++ reed
11752− ;~ pfix fas
11753− (stag %clsg (more fas stem))
11754− ==
11755− ::
11756− ++ stem
11757− %+ knee *hoon |. ~+
11758− %+ cook
11759− |= iota=$%([%hoon =hoon] iota)
11760− ?@ iota [%rock %tas iota]
11761− ?: ?=(%hoon -.iota) hoon.iota
11762− [%clhp [%rock %tas -.iota] [%sand iota]]
11763− |^ %- stew
11764− ^. stet ^. limo
11765− :~ :- 'a'^'z' ;~ pose
11766− (spit (stag %cncl (ifix [pal par] (most ace wide))))
11767− (spit (ifix [sel ser] wide))
11768− (slot sym)
11769− ==
11770− :- '$' (cold %$ buc)
11771− :- '0'^'9' (slot bisk:so)
11772− :- '-' (slot tash:so)
11773− :- '.' ;~(pfix dot zust:so)
11774− :- '~' (slot ;~(pfix sig ;~(pose crub:so (easy [%n ~]))))
11775− :- '\'' (stag %t qut)
11776− :- '[' (slip (ifix [sel ser] wide))
11777− :- '(' (slip (stag %cncl (ifix [pal par] (most ace wide))))
11778− ==
11779− ::
11780− ++ slip |*(r=rule (stag %hoon r))
11781− ++ slot |*(r=rule (sear (soft iota) r))
11782− ++ spit
11783− |* r=rule
11784− %+ stag %hoon
11785− %+ cook
11786− |*([a=term b=*] `hoon`[%clhp [%rock %tas a] b])
11787− ;~((glue lus) sym r)
11788− --
11789− ::
11790− ++ rupl
11791− %+ cook
11792− |= [a=? b=(list hoon) c=?]
11793− ?: a
11794− ?: c
11795− [%clsg [%clsg b] ~]
11796− [%clsg b]
11797− ?: c
11798− [%clsg [%cltr b] ~]
11799− [%cltr b]
11800− ;~ plug
11801− ;~ pose
11802− (cold | (just '['))
11803− (cold & (jest '~['))
11804− ==
11805− ::
11806− ;~ pose
11807− (ifix [ace gap] (most gap tall))
11808− (most ace wide)
11809− ==
11810− ::
11811− ;~ pose
11812− (cold & (jest ']~'))
11813− (cold | (just ']'))
11814− ==
11815− ==
11816− ::
11817− ::
11818− ++ sail :: xml template
11819− |= in-tall-form=? =| lin=?
11820− |%
11821− ::
11822− ++ apex :: product hoon
11823− %+ cook
11824− |= tum=(each manx:hoot marl:hoot) ^- hoon
11825− ?- -.tum
11826− %& [%xray p.tum]
11827− %| [%mcts p.tum]
11828− ==
11829− top-level
11830− ::
11831− ++ top-level :: entry-point
11832− ;~(pfix mic ?:(in-tall-form tall-top wide-top))
11833− ::
11834− ++ inline-embed :: brace interpolation
11835− %+ cook |=(a=tuna:hoot a)
11836− ;~ pose
11837− ;~(pfix mic bracketed-elem(in-tall-form |))
11838− ;~(plug tuna-mode sump)
11839− (stag %tape sump)
11840− ==
11841− ::
11842− ++ script-or-style :: script or style
11843− %+ cook |=(a=marx:hoot a)
11844− ;~ plug
11845− ;~(pose (jest %script) (jest %style))
11846− wide-attrs
11847− ==
11848− ::
11849− ++ tuna-mode :: xml node(s) kind
11850− ;~ pose
11851− (cold %tape hep)
11852− (cold %manx lus)
11853− (cold %marl tar)
11854− (cold %call cen)
11855− ==
11856− ::
11857− ++ wide-top :: wide outer top
11858− %+ knee *(each manx:hoot marl:hoot) |. ~+
11859− ;~ pose
11860− (stag %| wide-quote)
11861− (stag %| wide-paren-elems)
11862− (stag %& ;~(plug tag-head wide-tail))
11863− ==
11864− ::
11865− ++ wide-inner-top :: wide inner top
11866− %+ knee *(each tuna:hoot marl:hoot) |. ~+
11867− ;~ pose
11868− wide-top
11869− (stag %& ;~(plug tuna-mode wide))
11870− ==
11871− ::
11872− ++ wide-attrs :: wide attributes
11873− %+ cook |=(a=(unit mart:hoot) (fall a ~))
11874− %- punt
11875− %+ ifix [pal par]
11876− %+ more (jest ', ')
11877− ;~((glue ace) a-mane hopefully-quote)
11878− ::
11879− ++ wide-tail :: wide elements
11880− %+ cook |=(a=marl:hoot a)
11881− ;~(pose ;~(pfix col wrapped-elems) (cold ~ mic) (easy ~))
11882− ::
11883− ++ wide-elems :: wide elements
11884− %+ cook |=(a=marl:hoot a)
11885− %+ cook join-tops
11886− (star ;~(pfix ace wide-inner-top))
11887− ::
11888− ++ wide-paren-elems :: wide flow
11889− %+ cook |=(a=marl:hoot a)
11890− %+ cook join-tops
11891− (ifix [pal par] (more ace wide-inner-top))
11892− ::
11893− ::+|
11894− ::
11895− ++ drop-top
11896− |= a=(each tuna:hoot marl:hoot) ^- marl:hoot
11897− ?- -.a
11898− %& [p.a]~
11899− %| p.a
11900− ==
11901− ::
11902− ++ join-tops
11903− |= a=(list (each tuna:hoot marl:hoot)) ^- marl:hoot
11904− (zing (turn a drop-top))
11905− ::
11906− ::+|
11907− ::
11908− ++ wide-quote :: wide quote
11909− %+ cook |=(a=marl:hoot a)
11910− ;~ pose
11911− ;~ less (jest '"""')
11912− (ifix [doq doq] (cook collapse-chars quote-innards))
11913− ==
11914− ::
11915− %- inde
11916− %+ ifix [(jest '"""\0a') (jest '\0a"""')]
11917− (cook collapse-chars quote-innards(lin |))
11918− ==
11919− ::
11920− ++ quote-innards :: wide+tall flow
11921− %+ cook |=(a=(list $@(@ tuna:hoot)) a)
11922− %- star
11923− ;~ pose
11924− ;~(pfix bas ;~(pose (mask "-+*%;\{") bas doq bix:ab))
11925− inline-embed
11926− ;~(less bas kel ?:(in-tall-form fail doq) prn)
11927− ?:(lin fail ;~(less (jest '\0a"""') (just '\0a')))
11928− ==
11929− ::
11930− ++ bracketed-elem :: bracketed element
11931− %+ ifix [kel ker]
11932− ;~(plug tag-head wide-elems)
11933− ::
11934− ++ wrapped-elems :: wrapped tuna
11935− %+ cook |=(a=marl:hoot a)
11936− ;~ pose
11937− wide-paren-elems
11938− (cook |=(@t `marl`[;/((trip +<))]~) qut)
11939− (cook drop-top wide-top)
11940− ==
11941− ::
11942− ++ a-mane :: mane as hoon
11943− %+ cook
11944− |= [a=@tas b=(unit @tas)]
11945− ?~(b a [a u.b])
11946− ;~ plug
11947− mixed-case-symbol
11948− ;~ pose
11949− %+ stag ~
11950− ;~(pfix cab mixed-case-symbol)
11951− (easy ~)
11952− ==
11953− ==
11954− ::
11955− ++ en-class
11956− |= a=(list [%class p=term])
11957− ^- (unit [%class tape])
11958− ?~ a ~
11959− %- some
11960− :- %class
11961− |-
11962− %+ welp (trip p.i.a)
11963− ?~ t.a ~
11964− [' ' $(a t.a)]
11965− ::
11966− ++ tag-head :: tag head
11967− %+ cook
11968− |= [a=mane:hoot b=mart:hoot c=mart:hoot]
11969− ^- marx:hoot
11970− [a (weld b c)]
11971− ;~ plug
11972− a-mane
11973− ::
11974− %+ cook
11975− |= a=(list (unit [term (list beer:hoot)]))
11976− ^- (list [term (list beer:hoot)])
11977− :: discard nulls
11978− (murn a same)
11979− ;~ plug
11980− (punt ;~(plug (cold %id hax) (cook trip sym)))
11981− (cook en-class (star ;~(plug (cold %class dot) sym)))
11982− (punt ;~(plug ;~(pose (cold %href fas) (cold %src pat)) soil))
11983− (easy ~)
11984− ==
11985− ::
11986− wide-attrs
11987− ==
11988− ::
11989− ++ tall-top :: tall top
11990− %+ knee *(each manx:hoot marl:hoot) |. ~+
11991− ;~ pose
11992− (stag %| ;~(pfix (plus ace) (cook collapse-chars quote-innards)))
11993− (stag %& ;~(plug script-or-style script-style-tail))
11994− (stag %& tall-elem)
11995− (stag %| wide-quote)
11996− (stag %| ;~(pfix tis tall-tail))
11997− (stag %& ;~(pfix gar gap (stag [%div ~] cram)))
11998− (stag %| ;~(plug ;~((glue gap) tuna-mode tall) (easy ~)))
11999− (easy %| [;/("\0a")]~)
12000− ==
12001− ::
12002− ++ tall-attrs :: tall attributes
12003− %- star
12004− ;~ pfix ;~(plug gap tis)
12005− ;~((glue gap) a-mane hopefully-quote)
12006− ==
12007− ::
12008− ++ tall-elem :: tall preface
12009− %+ cook
12010− |= [a=[p=mane:hoot q=mart:hoot] b=mart:hoot c=marl:hoot]
12011− ^- manx:hoot
12012− [[p.a (weld q.a b)] c]
12013− ;~(plug tag-head tall-attrs tall-tail)
12014− ::
12015− ::REVIEW is there a better way to do this?
12016− ++ hopefully-quote :: prefer "quote" form
12017− %+ cook |=(a=(list beer:hoot) a)
12018− %+ cook |=(a=hoon ?:(?=(%knit -.a) p.a [~ a]~))
12019− wide
12020− ::
12021− ++ script-style-tail :: unescaped tall tail
12022− %+ cook |=(a=marl:hoot a)
12023− %+ ifix [gap ;~(plug gap duz)]
12024− %+ most gap
12025− ;~ pfix mic
12026− %+ cook |=(a=tape ;/(a))
12027− ;~ pose
12028− ;~(pfix ace (star prn))
12029− (easy "\0a")
12030− ==
12031− ==
12032− ::
12033− ++ tall-tail :: tall tail
12034− ?> in-tall-form
12035− %+ cook |=(a=marl:hoot a)
12036− ;~ pose
12037− (cold ~ mic)
12038− ;~(pfix col wrapped-elems(in-tall-form |))
12039− ;~(pfix col ace (cook collapse-chars(in-tall-form |) quote-innards))
12040− (ifix [gap ;~(plug gap duz)] tall-kids)
12041− ==
12042− ::
12043− ++ tall-kids :: child elements
12044− %+ cook join-tops
12045− :: look for sail first, or markdown if not
12046− (most gap ;~(pose top-level (stag %| cram)))
12047− ::
12048− ++ collapse-chars :: group consec chars
12049− |= reb=(list $@(@ tuna:hoot))
12050− ^- marl:hoot
12051− =| [sim=(list @) tuz=marl:hoot]
12052− |- ^- marl:hoot
12053− ?~ reb
12054− =. sim
12055− ?. in-tall-form sim
12056− [10 |-(?~(sim sim ?:(=(32 i.sim) $(sim t.sim) sim)))]
12057− ?~(sim tuz [;/((flop sim)) tuz])
12058− ?@ i.reb
12059− $(reb t.reb, sim [i.reb sim])
12060− ?~ sim [i.reb $(reb t.reb, sim ~)]
12061− [;/((flop sim)) i.reb $(reb t.reb, sim ~)]
12062− --
12063− ++ cram :: parse unmark
12064− => |%
12065− ++ item (pair mite marl:hoot) :: xml node generator
12066− ++ colm @ud :: column
12067− ++ tarp marl:hoot :: node or generator
12068− ++ mite :: context
12069− $? %down :: outer embed
12070− %lunt :: unordered list
12071− %lime :: list item
12072− %lord :: ordered list
12073− %poem :: verse
12074− %bloc :: blockquote
12075− %head :: heading
12076− == ::
12077− ++ trig :: line style
12078− $: col=@ud :: start column
12079− sty=trig-style :: style
12080− == ::
12081− ++ trig-style :: type of parsed line
12082− $% $: %end :: terminator
12083− $? %done :: end of input
12084− %stet :: == end of markdown
12085− %dent :: outdent
12086− == == ::
12087− $: %one :: leaf node
12088− $? %rule :: --- horz rule
12089− %fens :: ``` code fence
12090− %expr :: ;sail expression
12091− == == ::
12092− [%new p=trig-new] :: open container
12093− [%old %text] :: anything else
12094− == ::
12095− ++ trig-new :: start a
12096− $? %lite :: + line item
12097− %lint :: - line item
12098− %head :: # heading
12099− %bloc :: > block-quote
12100− %poem :: [ ]{8} poem
12101− == ::
12102− ++ graf :: paragraph element
12103− $% [%bold p=(list graf)] :: *bold*
12104− [%talc p=(list graf)] :: _italics_
12105− [%quod p=(list graf)] :: "double quote"
12106− [%code p=tape] :: code literal
12107− [%text p=tape] :: text symbol
12108− [%link p=(list graf) q=tape] :: URL
12109− [%mage p=tape q=tape] :: image
12110− [%expr p=tuna:hoot] :: interpolated hoon
12111− ==
12112− --
12113− =< (non-empty:parse |=(nail `(like tarp)`~($ main +<)))
12114− |%
12115− ++ main
12116− ::
12117− :: state of the parsing loop.
12118− ::
12119− :: we maintain a construction stack for elements and a line
12120− :: stack for lines in the current block. a blank line
12121− :: causes the current block to be parsed and thrown in the
12122− :: current element. when the indent column retreats, the
12123− :: element stack rolls up.
12124− ::
12125− :: .verbose: debug printing enabled
12126− :: .err: error position
12127− :: .ind: outer and inner indent level
12128− :: .hac: stack of items under construction
12129− :: .cur: current item under construction
12130− :: .par: current "paragraph" being read in
12131− :: .[loc txt]: parsing state
12132− ::
12133− =/ verbose &
12134− =| err=(unit hair)
12135− =| ind=[out=@ud inr=@ud]
12136− =| hac=(list item)
12137− =/ cur=item [%down ~]
12138− =| par=(unit (pair hair wall))
12139− |_ [loc=hair txt=tape]
12140− ::
12141− ++ $ :: resolve
12142− ^- (like tarp)
12143− => line
12144− ::
12145− :: if error position is set, produce error
12146− ?. =(~ err)
12147− ~& err+err
12148− [+.err ~]
12149− ::
12150− :: all data was consumed
12151− =- [loc `[- [loc txt]]]
12152− => close-par
12153− |- ^- tarp
12154− ::
12155− :: fold all the way to top
12156− ?~ hac cur-to-tarp
12157− $(..^$ close-item)
12158− ::
12159− ::+|
12160− ::
12161− ++ cur-indent
12162− ?- p.cur
12163− %down 2
12164− %head 0
12165− %lunt 0
12166− %lime 2
12167− %lord 0
12168− %poem 8
12169− %bloc 2
12170− ==
12171− ::
12172− ++ back :: column retreat
12173− |= luc=@ud
12174− ^+ +>
12175− ?: (gte luc inr.ind) +>
12176− ::
12177− :: nex: next backward step that terminates this context
12178− =/ nex=@ud cur-indent :: REVIEW code and poem blocks are
12179− :: handled elsewhere
12180− ?: (gth nex (sub inr.ind luc))
12181− ::
12182− :: indenting pattern violation
12183− ~? verbose indent-pattern-violation+[p.cur nex inr.ind luc]
12184− ..^$(inr.ind luc, err `[p.loc luc])
12185− =. ..^$ close-item
12186− $(inr.ind (sub inr.ind nex))
12187− ::
12188− ++ cur-to-tarp :: item to tarp
12189− ^- tarp
12190− ?: ?=(?(%down %head %expr) p.cur)
12191− (flop q.cur)
12192− =- [[- ~] (flop q.cur)]~
12193− ?- p.cur
12194− %lunt %ul
12195− %lord %ol
12196− %lime %li
12197− %poem %div ::REVIEW actual container element?
12198− %bloc %blockquote
12199− ==
12200− ::
12201− ++ close-item ^+ . :: complete and pop
12202− ?~ hac .
12203− %= .
12204− hac t.hac
12205− cur [p.i.hac (weld cur-to-tarp q.i.hac)]
12206− ==
12207− ::
12208− ++ read-line :: capture raw line
12209− =| lin=tape
12210− |- ^+ [[lin *(unit _err)] +<.^$] :: parsed tape and halt/error
12211− ::
12212− :: no unterminated lines
12213− ?~ txt
12214− ~? verbose %unterminated-line
12215− [[~ ``loc] +<.^$]
12216− ?. =(`@`10 i.txt)
12217− ?: (gth inr.ind q.loc)
12218− ?. =(' ' i.txt)
12219− ~? verbose expected-indent+[inr.ind loc txt]
12220− [[~ ``loc] +<.^$]
12221− $(txt t.txt, q.loc +(q.loc))
12222− ::
12223− :: save byte and repeat
12224− $(txt t.txt, q.loc +(q.loc), lin [i.txt lin])
12225− =. lin
12226− ::
12227− :: trim trailing spaces
12228− |- ^- tape
12229− ?: ?=([%' ' *] lin)
12230− $(lin t.lin)
12231− (flop lin)
12232− ::
12233− =/ eat-newline=nail [[+(p.loc) 1] t.txt]
12234− =/ saw look(+<.$ eat-newline)
12235− ::
12236− ?: ?=([~ @ %end ?(%stet %dent)] saw) :: stop on == or dedent
12237− [[lin `~] +<.^$]
12238− [[lin ~] eat-newline]
12239− ::
12240− ++ look :: inspect line
12241− ^- (unit trig)
12242− %+ bind (wonk (look:parse loc txt))
12243− |= a=trig ^+ a
12244− ::
12245− :: treat a non-terminator as a terminator
12246− :: if it's outdented
12247− ?: =(%end -.sty.a) a
12248− ?: (lth col.a out.ind)
12249− a(sty [%end %dent])
12250− a
12251− ::
12252− ++ close-par :: make block
12253− ^+ .
12254− ::
12255− :: empty block, no action
12256− ?~ par .
12257− ::
12258− :: if block is verse
12259− ?: ?=(%poem p.cur)
12260− ::
12261− :: add break between stanzas
12262− =. q.cur ?~(q.cur q.cur [[[%br ~] ~] q.cur])
12263− =- close-item(par ~, q.cur (weld - q.cur), inr.ind (sub inr.ind 8))
12264− %+ turn q.u.par
12265− |= tape ^- manx
12266− ::
12267− :: each line is a paragraph
12268− :- [%p ~]
12269− :_ ~
12270− ;/("{+<}\0a")
12271− ::
12272− :: yex: block recomposed, with newlines
12273− =/ yex=tape
12274− %- zing
12275− %+ turn (flop q.u.par)
12276− |= a=tape
12277− (runt [(dec inr.ind) ' '] "{a}\0a")
12278− ::
12279− :: vex: parse of paragraph
12280− =/ vex=(like tarp)
12281− ::
12282− :: either a one-line header or a paragraph
12283− %. [p.u.par yex]
12284− ?: ?=(%head p.cur)
12285− (full head:parse)
12286− (full para:parse)
12287− ::
12288− :: if error, propagate correctly
12289− ?~ q.vex
12290− ~? verbose [%close-par p.cur yex]
12291− ..$(err `p.vex)
12292− ::
12293− :: finish tag if it's a header
12294− =< ?:(?=(%head p.cur) close-item ..$)
12295− ::
12296− :: save good result, clear buffer
12297− ..$(par ~, q.cur (weld p.u.q.vex q.cur))
12298− ::
12299− ++ line ^+ . :: body line loop
12300− ::
12301− :: abort after first error
12302− ?: !=(~ err) .
12303− ::
12304− :: saw: profile of this line
12305− =/ saw look
12306− ~? [debug=|] [%look ind=ind saw=saw txt=txt]
12307− ::
12308− :: if line is blank
12309− ?~ saw
12310− ::
12311− :: break section
12312− =^ a=[tape fin=(unit _err)] +<.$ read-line
12313− ?^ fin.a
12314− ..$(err u.fin.a)
12315− =>(close-par line)
12316− ::
12317− :: line is not blank
12318− => .(saw u.saw)
12319− ::
12320− :: if end of input, complete
12321− ?: ?=(%end -.sty.saw)
12322− ..$(q.loc col.saw)
12323− ::
12324− =. ind ?~(out.ind [col.saw col.saw] ind) :: init indents
12325− ::
12326− ?: ?| ?=(~ par) :: if after a paragraph or
12327− ?& ?=(?(%down %lime %bloc) p.cur) :: unspaced new container
12328− |(!=(%old -.sty.saw) (gth col.saw inr.ind))
12329− == ==
12330− => .(..$ close-par)
12331− ::
12332− :: if column has retreated, adjust stack
12333− =. ..$ (back col.saw)
12334− ::
12335− =^ col-ok sty.saw
12336− ?+ (sub col.saw inr.ind) [| sty.saw] :: columns advanced
12337− %0 [& sty.saw]
12338− %8 [& %new %poem]
12339− ==
12340− ?. col-ok
12341− ~? verbose [%columns-advanced col.saw inr.ind]
12342− ..$(err `[p.loc col.saw])
12343− ::
12344− =. inr.ind col.saw
12345− ::
12346− :: unless adding a matching item, close lists
12347− =. ..$
12348− ?: ?| &(?=(%lunt p.cur) !?=(%lint +.sty.saw))
12349− &(?=(%lord p.cur) !?=(%lite +.sty.saw))
12350− ==
12351− close-item
12352− ..$
12353− ::
12354− =< line(par `[loc ~]) ^+ ..$ :: continue with para
12355− ?- -.sty.saw
12356− %one (read-one +.sty.saw) :: parse leaves
12357− %new (open-item p.sty.saw) :: open containers
12358− %old ..$ :: just text
12359− ==
12360− ::
12361− ::
12362− ::- - - foo
12363− :: detect bad block structure
12364− ?. :: first line of container is legal
12365− ?~ q.u.par &
12366− ?- p.cur
12367− ::
12368− :: can't(/directly) contain text
12369− ?(%lord %lunt) ~|(bad-leaf-container+p.cur !!)
12370− ::
12371− :: only one line in a header
12372− %head |
12373− ::
12374− :: indented literals need to end with a blank line
12375− %poem (gte col.saw inr.ind)
12376− ::
12377− :: text tarps must continue aligned
12378− ?(%down %lunt %lime %lord %bloc) =(col.saw inr.ind)
12379− ==
12380− ~? verbose bad-block-structure+[p.cur inr.ind col.saw]
12381− ..$(err `[p.loc col.saw])
12382− ::
12383− :: accept line and maybe continue
12384− =^ a=[lin=tape fin=(unit _err)] +<.$ read-line
12385− =. par par(q.u [lin.a q.u.par])
12386− ?^ fin.a ..$(err u.fin.a)
12387− line
12388− ++ parse-block :: execute parser
12389− |= fel=$-(nail (like tarp)) ^+ +>
12390− =/ vex=(like tarp) (fel loc txt)
12391− ?~ q.vex
12392− ~? verbose [%parse-block txt]
12393− +>.$(err `p.vex)
12394− =+ [res loc txt]=u.q.vex
12395− %_ +>.$
12396− loc loc
12397− txt txt
12398− q.cur (weld (flop `tarp`res) q.cur) :: prepend to the stack
12399− ==
12400− ::
12401− ++ read-one :: read %one item
12402− |= sty=?(%expr %rule %fens) ^+ +>
12403− ?- sty
12404− %expr (parse-block expr:parse)
12405− %rule (parse-block hrul:parse)
12406− %fens (parse-block (fens:parse inr.ind))
12407− ==
12408− ::
12409− ++ open-item :: enter list/quote
12410− |= saw=trig-new
12411− =< +>.$:apex
12412− |%
12413− ++ apex ^+ . :: open container
12414− ?- saw
12415− %poem (push %poem) :: verse literal
12416− %head (push %head) :: heading
12417− %bloc (entr %bloc) :: blockquote line
12418− %lint (lent %lunt) :: unordered list
12419− %lite (lent %lord) :: ordered list
12420− ==
12421− ::
12422− ++ push :: push context
12423− |=(mite +>(hac [cur hac], cur [+< ~]))
12424− ::
12425− ++ entr :: enter container
12426− |= typ=mite
12427− ^+ +>
12428− ::
12429− :: indent by 2
12430− =. inr.ind (add 2 inr.ind)
12431− ::
12432− :: "parse" marker
12433− =. txt (slag (sub inr.ind q.loc) txt)
12434− =. q.loc inr.ind
12435− ::
12436− (push typ)
12437− ::
12438− ++ lent :: list entry
12439− |= ord=?(%lord %lunt)
12440− ^+ +>
12441− => ?:(=(ord p.cur) +>.$ (push ord)) :: push list if new
12442− (entr %lime)
12443− --
12444− --
12445− ::
12446− ++ parse :: individual parsers
12447− |%
12448− ++ look :: classify line
12449− %+ cook |=(a=(unit trig) a)
12450− ;~ pfix (star ace)
12451− %+ here :: report indent
12452− |=([a=pint b=?(~ trig-style)] ?~(b ~ `[q.p.a b]))
12453− ;~ pose
12454− (cold ~ (just `@`10)) :: blank line
12455− ::
12456− (full (easy [%end %done])) :: end of input
12457− (cold [%end %stet] duz) :: == end of markdown
12458− ::
12459− (cold [%one %rule] ;~(plug hep hep hep)) :: --- horizontal ruler
12460− (cold [%one %fens] ;~(plug tic tic tic)) :: ``` code fence
12461− (cold [%one %expr] mic) :: ;sail expression
12462− ::
12463− (cold [%new %head] ;~(plug (star hax) ace)) :: # heading
12464− (cold [%new %lint] ;~(plug hep ace)) :: - line item
12465− (cold [%new %lite] ;~(plug lus ace)) :: + line item
12466− (cold [%new %bloc] ;~(plug gar ace)) :: > block-quote
12467− ::
12468− (easy [%old %text]) :: anything else
12469− ==
12470− ==
12471− ::
12472− ::
12473− ++ calf :: cash but for tic tic
12474− |* tem=rule
12475− %- star
12476− ;~ pose
12477− ;~(pfix bas tem)
12478− ;~(less tem prn)
12479− ==
12480− ++ cash :: escaped fence
12481− |* tem=rule
12482− %- echo
12483− %- star
12484− ;~ pose
12485− whit
12486− ;~(plug bas tem)
12487− ;~(less tem prn)
12488− ==
12489− ::
12490− ++ cool :: reparse
12491− |* $: :: fex: primary parser
12492− :: sab: secondary parser
12493− ::
12494− fex=rule
12495− sab=rule
12496− ==
12497− |= [loc=hair txt=tape]
12498− ^+ *sab
12499− ::
12500− :: vex: fenced span
12501− =/ vex=(like tape) (fex loc txt)
12502− ?~ q.vex vex
12503− ::
12504− :: hav: reparse full fenced text
12505− =/ hav ((full sab) [loc p.u.q.vex])
12506− ::
12507− :: reparsed error position is always at start
12508− ?~ q.hav [loc ~]
12509− ::
12510− :: the complete type with the main product
12511− :- p.vex
12512− `[p.u.q.hav q.u.q.vex]
12513− ::
12514− ::REVIEW surely there is a less hacky "first or after space" solution
12515− ++ easy-sol :: parse start of line
12516− |* a=*
12517− |= b=nail
12518− ?: =(1 q.p.b) ((easy a) b)
12519− (fail b)
12520− ::
12521− ++ echo :: hoon literal
12522− |* sab=rule
12523− |= [loc=hair txt=tape]
12524− ^- (like tape)
12525− ::
12526− :: vex: result of parsing wide hoon
12527− =/ vex (sab loc txt)
12528− ::
12529− :: use result of expression parser
12530− ?~ q.vex vex
12531− =- [p.vex `[- q.u.q.vex]]
12532− ::
12533− :: but replace payload with bytes consumed
12534− |- ^- tape
12535− ?: =(q.q.u.q.vex txt) ~
12536− ?~ txt ~
12537− [i.txt $(txt +.txt)]
12538− ::
12539− ++ non-empty
12540− |* a=rule
12541− |= tub=nail ^+ (a)
12542− =/ vex (a tub)
12543− ~! vex
12544− ?~ q.vex vex
12545− ?. =(tub q.u.q.vex) vex
12546− (fail tub)
12547− ::
12548− ::
12549− ++ word :: tarp parser
12550− %+ knee *(list graf) |. ~+
12551− %+ cook
12552− |= a=$%(graf [%list (list graf)])
12553− ^- (list graf)
12554− ?:(?=(%list -.a) +.a [a ~])
12555− ;~ pose
12556− ::
12557− :: ordinary word
12558− ::
12559− %+ stag %text
12560− ;~(plug ;~(pose low hig) (star ;~(pose nud low hig hep)))
12561− ::
12562− :: naked \escape
12563− ::
12564− (stag %text ;~(pfix bas (cook trip ;~(less ace prn))))
12565− ::
12566− :: trailing \ to add <br>
12567− ::
12568− (stag %expr (cold [[%br ~] ~] ;~(plug bas (just '\0a'))))
12569− ::
12570− :: *bold literal*
12571− ::
12572− (stag %bold (ifix [tar tar] (cool (cash tar) werk)))
12573− ::
12574− :: _italic literal_
12575− ::
12576− (stag %talc (ifix [cab cab] (cool (cash cab) werk)))
12577− ::
12578− :: "quoted text"
12579− ::
12580− (stag %quod (ifix [doq doq] (cool (cash doq) werk)))
12581− ::
12582− :: `classic markdown quote`
12583− ::
12584− (stag %code (ifix [tic tic] (calf tic)))
12585− ::
12586− :: ++arm, +$arm, +*arm, ++arm:core, ...
12587− ::
12588− %+ stag %code
12589− ;~ plug
12590− lus ;~(pose lus buc tar)
12591− low (star ;~(pose nud low hep col))
12592− ==
12593− ::
12594− :: [arbitrary *content*](url)
12595− ::
12596− %+ stag %link
12597− ;~ (glue (punt whit))
12598− (ifix [sel ser] (cool (cash ser) werk))
12599− (ifix [pal par] (cash par))
12600− ==
12601− ::
12602− :: 
12603− ::
12604− %+ stag %mage
12605− ;~ pfix zap
12606− ;~ (glue (punt whit))
12607− (ifix [sel ser] (cash ser))
12608− (ifix [pal par] (cash par))
12609− ==
12610− ==
12611− ::
12612− :: #hoon
12613− ::
12614− %+ stag %list
12615− ;~ plug
12616− (stag %text ;~(pose (cold " " whit) (easy-sol ~)))
12617− (stag %code ;~(pfix hax (echo wide)))
12618− ;~(simu whit (easy ~))
12619− ==
12620− ::
12621− :: direct hoon constant
12622− ::
12623− %+ stag %list
12624− ;~ plug
12625− (stag %text ;~(pose (cold " " whit) (easy-sol ~)))
12626− ::
12627− %+ stag %code
12628− %- echo
12629− ;~ pose
12630− ::REVIEW just copy in 0x... parsers directly?
12631− ;~(simu ;~(plug (just '0') alp) bisk:so)
12632− ::
12633− tash:so
12634− ;~(pfix dot perd:so)
12635− ;~(pfix sig ;~(pose twid:so (easy [%$ %n 0])))
12636− ;~(pfix cen ;~(pose sym buc pam bar qut nuck:so))
12637− ==
12638− ::
12639− ;~(simu whit (easy ~))
12640− ==
12641− ::
12642− :: whitespace
12643− ::
12644− (stag %text (cold " " whit))
12645− ::
12646− :: {interpolated} sail
12647− ::
12648− (stag %expr inline-embed:(sail |))
12649− ::
12650− :: just a byte
12651− ::
12652− (stag %text (cook trip ;~(less ace prn)))
12653− ==
12654− ::
12655− ++ werk (cook zing (star word)) :: indefinite tarp
12656− ::
12657− ++ down :: parse inline tarp
12658− %+ knee *tarp |. ~+
12659− =- (cook - werk)
12660− ::
12661− :: collect raw tarp into xml tags
12662− |= gaf=(list graf)
12663− ^- tarp
12664− =< main
12665− |%
12666− ++ main
12667− ^- tarp
12668− ?~ gaf ~
12669− ?. ?=(%text -.i.gaf)
12670− (weld (item i.gaf) $(gaf t.gaf))
12671− ::
12672− :: fip: accumulate text blocks
12673− =/ fip=(list tape) [p.i.gaf]~
12674− |- ^- tarp
12675− ?~ t.gaf [;/((zing (flop fip))) ~]
12676− ?. ?=(%text -.i.t.gaf)
12677− [;/((zing (flop fip))) ^$(gaf t.gaf)]
12678− $(gaf t.gaf, fip :_(fip p.i.t.gaf))
12679− ::
12680− ++ item
12681− |= nex=graf
12682− ^- tarp ::CHECK can be tuna:hoot?
12683− ?- -.nex
12684− %text !! :: handled separately
12685− %expr [p.nex]~
12686− %bold [[%b ~] ^$(gaf p.nex)]~
12687− %talc [[%i ~] ^$(gaf p.nex)]~
12688− %code [[%code ~] ;/(p.nex) ~]~
12689− %quod ::
12690− :: smart quotes
12691− %= ^$
12692− gaf
12693− :- [%text (tufa ~-~201c. ~)]
12694− %+ weld p.nex
12695− `(list graf)`[%text (tufa ~-~201d. ~)]~
12696− ==
12697− %link [[%a [%href q.nex] ~] ^$(gaf p.nex)]~
12698− %mage [[%img [%src q.nex] ?~(p.nex ~ [%alt p.nex]~)] ~]~
12699− ==
12700− --
12701− ::
12702− ++ hrul :: empty besides fence
12703− %+ cold [[%hr ~] ~]~
12704− ;~(plug (star ace) hep hep hep (star hep) (just '\0a'))
12705− ::
12706− ++ tics
12707− ;~(plug tic tic tic (just '\0a'))
12708− ::
12709− ++ fens
12710− |= col=@u ~+
12711− =/ ind (stun [(dec col) (dec col)] ace)
12712− =/ ind-tics ;~(plug ind tics)
12713− %+ cook |=(txt=tape `tarp`[[%pre ~] ;/(txt) ~]~)
12714− ::
12715− :: leading outdent is ok since container may
12716− :: have already been parsed and consumed
12717− %+ ifix [;~(plug (star ace) tics) ind-tics]
12718− %^ stir "" |=([a=tape b=tape] "{a}\0a{b}")
12719− ;~ pose
12720− %+ ifix [ind (just '\0a')]
12721− ;~(less tics (star prn))
12722− ::
12723− (cold "" ;~(plug (star ace) (just '\0a')))
12724− ==
12725− ::
12726− ++ para :: paragraph
12727− %+ cook
12728− |=(a=tarp ?~(a ~ [[%p ~] a]~))
12729− ;~(pfix (punt whit) down)
12730− ::
12731− ++ expr :: expression
12732− => (sail &) :: tall-form
12733− %+ ifix [(star ace) ;~(simu gap (easy))] :: look-ahead for gap
12734− (cook drop-top top-level) :: list of tags
12735− ::
12736− ::
12737− ++ whit :: whitespace
12738− (cold ' ' (plus ;~(pose (just ' ') (just '\0a'))))
12739− ::
12740− ++ head :: parse heading
12741− %+ cook
12742− |= [haxes=tape kids=tarp] ^- tarp
12743− =/ tag (crip 'h' <(lent haxes)>) :: e.g. ### -> %h3
12744− =/ id (contents-to-id kids)
12745− [[tag [%id id]~] kids]~
12746− ::
12747− ;~(pfix (star ace) ;~((glue whit) (stun [1 6] hax) down))
12748− ::
12749− ++ contents-to-id :: # text into elem id
12750− |= a=(list tuna:hoot) ^- tape
12751− =; raw=tape
12752− %+ turn raw
12753− |= @tD
12754− ^- @tD
12755− ?: ?| &((gte +< 'a') (lte +< 'z'))
12756− &((gte +< '0') (lte +< '9'))
12757− ==
12758− +<
12759− ?: &((gte +< 'A') (lte +< 'Z'))
12760− (add 32 +<)
12761− '-'
12762− ::
12763− :: collect all text in header tarp
12764− |- ^- tape
12765− ?~ a ~
12766− %+ weld
12767− ^- tape
12768− ?- i.a
12769− [[%$ [%$ *] ~] ~] :: text node contents
12770− (murn v.i.a.g.i.a |=(a=beer:hoot ?^(a ~ (some a))))
12771− [^ *] $(a c.i.a) :: concatenate children
12772− [@ *] ~ :: ignore interpolation
12773− ==
12774− $(a t.a)
12775− --
12776− --
12777− ::
12778− ++ scad
12779− %+ knee *spec |. ~+
12780− %- stew
12781− ^. stet ^. limo
12782− :~
12783− :- '_'
12784− ;~(pfix cab (stag %bccb wide))
12785− :- ','
12786− ;~(pfix com (stag %bcmc wide))
12787− :- '$'
12788− (stag %like (most col rope))
12789− :- '%'
12790− ;~ pose
12791− ;~ pfix cen
12792− ;~ pose
12793− (stag %leaf (stag %tas (cold %$ buc)))
12794− (stag %leaf (stag %f (cold & pam)))
12795− (stag %leaf (stag %f (cold | bar)))
12796− (stag %leaf (stag %t qut))
12797− (stag %leaf (sear |=(a=coin ?:(?=(%$ -.a) (some +.a) ~)) nuck:so))
12798− ==
12799− ==
12800− ==
12801− :- '('
12802− %+ cook |=(spec +<)
12803− %+ stag %make
12804− %+ ifix [pal par]
12805− ;~ plug
12806− wide
12807− ;~(pose ;~(pfix ace (most ace wyde)) (easy ~))
12808− ==
12809− :- '['
12810− (stag %bccl (ifix [sel ser] (most ace wyde)))
12811− :- '*'
12812− (cold [%base %noun] tar)
12813− :- '/'
12814− ;~(pfix fas (stag %loop ;~(pose (cold %$ buc) sym)))
12815− :- '@'
12816− ;~(pfix pat (stag %base (stag %atom mota)))
12817− :- '?'
12818− ;~ pose
12819− %+ stag %bcwt
12820− ;~(pfix wut (ifix [pal par] (most ace wyde)))
12821− ::
12822− (cold [%base %flag] wut)
12823− ==
12824− :- '~'
12825− (cold [%base %null] sig)
12826− :- '!'
12827− (cold [%base %void] ;~(plug zap zap))
12828− :- '^'
12829− ;~ pose
12830− (stag %like (most col rope))
12831− (cold [%base %cell] ket)
12832− ==
12833− :- '='
12834− ;~ pfix tis
12835− %+ sear
12836− |= [=(unit term) =spec]
12837− %+ bind
12838− ~(autoname ax spec)
12839− |= =term
12840− =* name ?~(unit term (cat 3 u.unit (cat 3 '-' term)))
12841− [%bcts name spec]
12842− ;~ pose
12843− ;~(plug (stag ~ ;~(sfix sym tis)) wyde)
12844− (stag ~ wyde)
12845− ==
12846− ==
12847− :- ['a' 'z']
12848− ;~ pose
12849− (stag %bcts ;~(plug sym ;~(pfix tis wyde)))
12850− (stag %like (most col rope))
12851− ==
12852− ==
12853− ::
12854− ++ scat
12855− %+ knee *hoon |. ~+
12856− %- stew
12857− ^. stet ^. limo
12858− :~
12859− :- ','
12860− ;~ pose
12861− (stag %ktcl ;~(pfix com wyde))
12862− (stag %wing rope)
12863− ==
12864− :- '!'
12865− ;~ pose
12866− (stag %wtzp ;~(pfix zap wide))
12867− (stag %zpzp (cold ~ ;~(plug zap zap)))
12868− ==
12869− :- '_'
12870− ;~(pfix cab (stag %ktcl (stag %bccb wide)))
12871− :- '$'
12872− ;~ pose
12873− ;~ pfix buc
12874− ;~ pose
12875− :: XX: these are all obsolete in hoon 142
12876− ::
12877− (stag %leaf (stag %tas (cold %$ buc)))
12878− (stag %leaf (stag %t qut))
12879− (stag %leaf (sear |=(a=coin ?:(?=(%$ -.a) (some +.a) ~)) nuck:so))
12880− ==
12881− ==
12882− rump
12883− ==
12884− :- '%'
12885− ;~ pfix cen
12886− ;~ pose
12887− (stag %clsg (sear |~([a=@ud b=tyke] (posh ~ ~ a b)) porc))
12888− (stag %rock (stag %tas (cold %$ buc)))
12889− (stag %rock (stag %f (cold & pam)))
12890− (stag %rock (stag %f (cold | bar)))
12891− (stag %rock (stag %t qut))
12892− (cook (jock &) nuck:so)
12893− (stag %clsg (sear |=(a=(list) (posh ~ ~ (lent a) ~)) (star cen)))
12894− ==
12895− ==
12896− :- '&'
12897− ;~ pose
12898− (cook |=(a=wing [%cnts a ~]) rope)
12899− (stag %wtpm ;~(pfix pam (ifix [pal par] (most ace wide))))
12900− ;~(plug (stag %rock (stag %f (cold & pam))) wede)
12901− (stag %sand (stag %f (cold & pam)))
12902− ==
12903− :- '\''
12904− (stag %sand (stag %t qut))
12905− :- '('
12906− (stag %cncl (ifix [pal par] (most ace wide)))
12907− :- '*'
12908− ;~ pose
12909− (stag %kttr ;~(pfix tar wyde))
12910− (cold [%base %noun] tar)
12911− ==
12912− :- '@'
12913− ;~(pfix pat (stag %base (stag %atom mota)))
12914− :- '+'
12915− ;~ pose
12916− (stag %dtls ;~(pfix lus (ifix [pal par] wide)))
12917− ::
12918− %+ cook
12919− |= a=(list (list woof))
12920− :- %mcfs
12921− [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))]
12922− (most dog ;~(pfix lus soil))
12923− ::
12924− (cook |=(a=wing [%cnts a ~]) rope)
12925− ==
12926− :- '-'
12927− ;~ pose
12928− (stag %sand tash:so)
12929− ::
12930− %+ cook
12931− |= a=(list (list woof))
12932− [%clsg (phax a)]
12933− (most dog ;~(pfix hep soil))
12934− ::
12935− (cook |=(a=wing [%cnts a ~]) rope)
12936− ==
12937− :- '.'
12938− ;~ pose
12939− (cook (jock |) ;~(pfix dot perd:so))
12940− (cook |=(a=wing [%cnts a ~]) rope)
12941− ==
12942− :- ['0' '9']
12943− %+ cook
12944− |= [a=dime b=(unit hoon)]
12945− ?~(b [%sand a] [[%rock a] u.b])
12946− ;~(plug bisk:so (punt wede))
12947− :- ':'
12948− ;~ pfix col
12949− ;~ pose
12950− (stag %mccl (ifix [pal par] (most ace wide)))
12951− ;~(pfix fas (stag %mcfs wide))
12952− ==
12953− ==
12954− :- '='
12955− ;~ pfix tis
12956− ;~ pose
12957− (stag %dtts (ifix [pal par] ;~(glam wide wide)))
12958− ::
12959− %+ sear
12960− :: mainly used for +skin formation
12961− ::
12962− |= =spec
12963− ^- (unit hoon)
12964− %+ bind ~(autoname ax spec)
12965− |=(=term `hoon`[%ktts term %kttr spec])
12966− wyde
12967− ==
12968− ==
12969− :- '?'
12970− ;~ pose
12971− %+ stag %ktcl
12972− (stag %bcwt ;~(pfix wut (ifix [pal par] (most ace wyde))))
12973− ::
12974− (cold [%base %flag] wut)
12975− ==
12976− :- '['
12977− rupl
12978− :- '^'
12979− ;~ pose
12980− (stag %wing rope)
12981− (cold [%base %cell] ket)
12982− ==
12983− :- '`'
12984− ;~ pfix tic
12985− ;~ pose
12986− %+ cook
12987− |=([a=@ta b=hoon] [%ktls [%sand a 0] [%ktls [%sand %$ 0] b]])
12988− ;~(pfix pat ;~(plug mota ;~(pfix tic wide)))
12989− ;~ pfix tar
12990− (stag %kthp (stag [%base %noun] ;~(pfix tic wide)))
12991− ==
12992− (stag %kthp ;~(plug wyde ;~(pfix tic wide)))
12993− (stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tic wide))))
12994− (cook |=(a=hoon [[%rock %n ~] a]) wide)
12995− ==
12996− ==
12997− :- '"'
12998− %+ cook
12999− |= a=(list (list woof))
13000− [%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))]
13001− (most dog soil)
13002− :- ['a' 'z']
13003− rump
13004− :- '|'
13005− ;~ pose
13006− (cook |=(a=wing [%cnts a ~]) rope)
13007− (stag %wtbr ;~(pfix bar (ifix [pal par] (most ace wide))))
13008− ;~(plug (stag %rock (stag %f (cold | bar))) wede)
13009− (stag %sand (stag %f (cold | bar)))
13010− ==
13011− :- '~'
13012− ;~ pose
13013− rupl
13014− ::
13015− ;~ pfix sig
13016− ;~ pose
13017− (stag %clsg (ifix [sel ser] (most ace wide)))
13018− ::
13019− %+ stag %cnsg
13020− %+ ifix
13021− [pal par]
13022− ;~(glam rope wide (most ace wide))
13023− ::
13024− (cook (jock |) twid:so)
13025− (stag [%bust %null] wede)
13026− (easy [%bust %null])
13027− ==
13028− ==
13029− ==
13030− :- '/'
13031− rood
13032− :- '<'
13033− (ifix [gal gar] (stag %tell (most ace wide)))
13034− :- '>'
13035− (ifix [gar gal] (stag %yell (most ace wide)))
13036− :- '#'
13037− ;~(pfix hax reed)
13038− ==
13039− ++ soil
13040− ;~ pose
13041− ;~ less (jest '"""')
13042− %+ ifix [doq doq]
13043− %- star
13044− ;~ pose
13045− ;~(pfix bas ;~(pose bas doq kel bix:ab))
13046− ;~(less doq bas kel prn)
13047− (stag ~ sump)
13048− ==
13049− ==
13050− ::
13051− %- iny %+ ifix
13052− [(jest '"""\0a') (jest '\0a"""')]
13053− %- star
13054− ;~ pose
13055− ;~(pfix bas ;~(pose bas kel bix:ab))
13056− ;~(less bas kel prn)
13057− ;~(less (jest '\0a"""') (just `@`10))
13058− (stag ~ sump)
13059− ==
13060− ==
13061− ++ sump (ifix [kel ker] (stag %cltr (most ace wide)))
13062− ++ norm :: rune regular form
13063− |= tol=?
13064− |%
13065− ++ structure
13066− %- stew
13067− ^. stet ^. limo
13068− :~ :- '$'
13069− ;~ pfix buc
13070− %- stew
13071− ^. stet ^. limo
13072− :~ [':' (rune col %bccl exqs)]
13073− ['%' (rune cen %bccn exqs)]
13074− ['<' (rune gal %bcgl exqb)]
13075− ['>' (rune gar %bcgr exqb)]
13076− ['^' (rune ket %bckt exqb)]
13077− ['~' (rune sig %bcsg exqd)]
13078− ['|' (rune bar %bcbr exqc)]
13079− ['&' (rune pam %bcpm exqc)]
13080− ['@' (rune pat %bcpt exqb)]
13081− ['_' (rune cab %bccb expa)]
13082− ['-' (rune hep %bchp exqb)]
13083− ['=' (rune tis %bcts exqg)]
13084− ['?' (rune wut %bcwt exqs)]
13085− [';' (rune mic %bcmc expa)]
13086− ['+' (rune lus %bcls exqg)]
13087− ==
13088− ==
13089− :- '%'
13090− ;~ pfix cen
13091− %- stew
13092− ^. stet ^. limo
13093− :~ :- '^'
13094− %+ cook
13095− |= [%cnkt a=hoon b=spec c=spec d=spec]
13096− [%make a b c d ~]
13097− (rune ket %cnkt exqy)
13098− ::
13099− :- '+'
13100− %+ cook
13101− |= [%cnls a=hoon b=spec c=spec]
13102− [%make a b c ~]
13103− (rune lus %cnls exqx)
13104− ::
13105− :- '-'
13106− %+ cook
13107− |= [%cnhp a=hoon b=spec]
13108− [%make a b ~]
13109− (rune hep %cnhp exqd)
13110− ::
13111− :- ':'
13112− %+ cook
13113− |= [%cncl a=hoon b=(list spec)]
13114− [%make a b]
13115− (rune col %cncl exqz)
13116− ==
13117− ==
13118− :- '#'
13119− ;~ pfix hax fas
13120− %+ stag %bccl
13121− %+ cook
13122− |= [[i=spec t=(list spec)] e=spec]
13123− [i (snoc t e)]
13124− ;~ plug
13125− %+ most ;~(less ;~(plug fas tar) fas)
13126− %- stew
13127− ^. stet ^. limo
13128− :~ :- ['a' 'z']
13129− ;~ pose
13130− :: /name=@aura
13131− ::
13132− %+ cook
13133− |= [=term =aura]
13134− ^- spec
13135− :+ %bccl
13136− [%leaf %tas aura]
13137− :_ ~
13138− :+ %bcts term
13139− ?+ aura [%base %atom aura]
13140− %f [%base %flag]
13141− %n [%base %null]
13142− ==
13143− ;~(plug sym ;~(pfix tis pat mota))
13144− ::
13145− :: /constant
13146− ::
13147− (stag %leaf (stag %tas ;~(pose sym (cold %$ buc))))
13148− ==
13149− ::
13150− :: /@aura
13151− ::
13152− :- '@'
13153− %+ cook
13154− |= =aura
13155− ^- spec
13156− :+ %bccl
13157− [%leaf %tas aura]
13158− [%base %atom aura]~
13159− ;~(pfix pat mota)
13160− ::
13161− :: /?
13162− ::
13163− :- '?'
13164− (cold [%bccl [%leaf %tas %f] [%base %flag] ~] wut)
13165− ::
13166− :: /~
13167− ::
13168− :- '~'
13169− (cold [%bccl [%leaf %tas %n] [%base %null] ~] sig)
13170− ==
13171− ::
13172− :: open-ended or fixed-length
13173− ::
13174− ;~ pose
13175− (cold [%base %noun] ;~(plug fas tar))
13176− (easy %base %null)
13177− ==
13178− ==
13179− ==
13180− ==
13181− ++ expression
13182− %- stew
13183− ^. stet ^. limo
13184− :~ :- '|'
13185− ;~ pfix bar
13186− %- stew
13187− ^. stet ^. limo
13188− :~ ['_' (rune cab %brcb exqr)]
13189− ['%' (runo cen %brcn ~ expe)]
13190− ['@' (runo pat %brpt ~ expe)]
13191− [':' (rune col %brcl expb)]
13192− ['.' (rune dot %brdt expa)]
13193− ['-' (rune hep %brhp expa)]
13194− ['^' (rune ket %brkt expr)]
13195− ['~' (rune sig %brsg exqc)]
13196− ['*' (rune tar %brtr exqc)]
13197− ['=' (rune tis %brts exqc)]
13198− ['?' (rune wut %brwt expa)]
13199− ['$' (rune buc %brbc exqe)]
13200− ==
13201− ==
13202− :- '$'
13203− ;~ pfix buc
13204− %- stew
13205− ^. stet ^. limo
13206− :~ ['@' (stag %ktcl (rune pat %bcpt exqb))]
13207− ['_' (stag %ktcl (rune cab %bccb expa))]
13208− [':' (stag %ktcl (rune col %bccl exqs))]
13209− ['%' (stag %ktcl (rune cen %bccn exqs))]
13210− ['<' (stag %ktcl (rune gal %bcgl exqb))]
13211− ['>' (stag %ktcl (rune gar %bcgr exqb))]
13212− ['|' (stag %ktcl (rune bar %bcbr exqc))]
13213− ['&' (stag %ktcl (rune pam %bcpm exqc))]
13214− ['^' (stag %ktcl (rune ket %bckt exqb))]
13215− ['~' (stag %ktcl (rune sig %bcsg exqd))]
13216− ['-' (stag %ktcl (rune hep %bchp exqb))]
13217− ['=' (stag %ktcl (rune tis %bcts exqg))]
13218− ['?' (stag %ktcl (rune wut %bcwt exqs))]
13219− ['+' (stag %ktcl (rune lus %bcls exqg))]
13220− ['.' (rune dot %kttr exqa)]
13221− [',' (rune com %ktcl exqa)]
13222− ==
13223− ==
13224− :- '%'
13225− ;~ pfix cen
13226− %- stew
13227− ^. stet ^. limo
13228− :~ ['_' (rune cab %cncb exph)]
13229− ['.' (rune dot %cndt expb)]
13230− ['^' (rune ket %cnkt expd)]
13231− ['+' (rune lus %cnls expc)]
13232− ['-' (rune hep %cnhp expb)]
13233− [':' (rune col %cncl expi)]
13234− ['~' (rune sig %cnsg expn)]
13235− ['*' (rune tar %cntr expm)]
13236− ['=' (rune tis %cnts exph)]
13237− ==
13238− ==
13239− :- ':'
13240− ;~ pfix col
13241− %- stew
13242− ^. stet ^. limo
13243− :~ ['_' (rune cab %clcb expb)]
13244− ['^' (rune ket %clkt expd)]
13245− ['+' (rune lus %clls expc)]
13246− ['-' (rune hep %clhp expb)]
13247− ['~' (rune sig %clsg exps)]
13248− ['*' (rune tar %cltr exps)]
13249− ==
13250− ==
13251− :- '.'
13252− ;~ pfix dot
13253− %- stew
13254− ^. stet ^. limo
13255− :~ ['+' (rune lus %dtls expa)]
13256− ['*' (rune tar %dttr expb)]
13257− ['=' (rune tis %dtts expb)]
13258− ['?' (rune wut %dtwt expa)]
13259− ['^' (rune ket %dtkt exqn)]
13260− ==
13261− ==
13262− :- '^'
13263− ;~ pfix ket
13264− %- stew
13265− ^. stet ^. limo
13266− :~ ['|' (rune bar %ktbr expa)]
13267− ['.' (rune dot %ktdt expb)]
13268− ['-' (rune hep %kthp exqc)]
13269− ['+' (rune lus %ktls expb)]
13270− ['&' (rune pam %ktpm expa)]
13271− ['~' (rune sig %ktsg expa)]
13272− ['=' (rune tis %ktts expj)]
13273− ['?' (rune wut %ktwt expa)]
13274− ['*' (rune tar %kttr exqa)]
13275− [':' (rune col %ktcl exqa)]
13276− ==
13277− ==
13278− :- '~'
13279− ;~ pfix sig
13280− %- stew
13281− ^. stet ^. limo
13282− :~ ['|' (rune bar %sgbr expb)]
13283− ['$' (rune buc %sgbc expf)]
13284− ['_' (rune cab %sgcb expb)]
13285− ['%' (rune cen %sgcn hind)]
13286− ['/' (rune fas %sgfs hine)]
13287− ['<' (rune gal %sggl hinb)]
13288− ['>' (rune gar %sggr hinb)]
13289− ['+' (rune lus %sgls hinc)]
13290− ['&' (rune pam %sgpm hinf)]
13291− ['?' (rune wut %sgwt hing)]
13292− ['=' (rune tis %sgts expb)]
13293− ['!' (rune zap %sgzp expb)]
13294− ==
13295− ==
13296− :- ';'
13297− ;~ pfix mic
13298− %- stew
13299− ^. stet ^. limo
13300− :~ [':' (rune col %mccl expi)]
13301− ['/' (rune fas %mcfs expa)]
13302− ['<' (rune gal %mcgl expz)]
13303− ['~' (rune sig %mcsg expi)]
13304− [';' (rune mic %mcmc exqc)]
13305− ==
13306− ==
13307− :- '='
13308− ;~ pfix tis
13309− %- stew
13310− ^. stet ^. limo
13311− :~ ['|' (rune bar %tsbr exqc)]
13312− ['.' (rune dot %tsdt expq)]
13313− ['?' (rune wut %tswt expw)]
13314− ['^' (rune ket %tskt expt)]
13315− [':' (rune col %tscl expp)]
13316− ['/' (rune fas %tsfs expo)]
13317− [';' (rune mic %tsmc expo)]
13318− ['<' (rune gal %tsgl expb)]
13319− ['>' (rune gar %tsgr expb)]
13320− ['-' (rune hep %tshp expb)]
13321− ['*' (rune tar %tstr expg)]
13322− [',' (rune com %tscm expb)]
13323− ['+' (rune lus %tsls expb)]
13324− ['~' (rune sig %tssg expi)]
13325− ==
13326− ==
13327− :- '?'
13328− ;~ pfix wut
13329− %- stew
13330− ^. stet ^. limo
13331− :~ ['|' (rune bar %wtbr exps)]
13332− [':' (rune col %wtcl expc)]
13333− ['.' (rune dot %wtdt expc)]
13334− ['<' (rune gal %wtgl expb)]
13335− ['>' (rune gar %wtgr expb)]
13336− ['-' ;~(pfix hep (toad txhp))]
13337− ['^' ;~(pfix ket (toad tkkt))]
13338− ['=' ;~(pfix tis (toad txts))]
13339− ['#' ;~(pfix hax (toad txhx))]
13340− ['+' ;~(pfix lus (toad txls))]
13341− ['&' (rune pam %wtpm exps)]
13342− ['@' ;~(pfix pat (toad tkvt))]
13343− ['~' ;~(pfix sig (toad tksg))]
13344− ['!' (rune zap %wtzp expa)]
13345− ==
13346− ==
13347− :- '!'
13348− ;~ pfix zap
13349− %- stew
13350− ^. stet ^. limo
13351− :~ [':' ;~(pfix col (toad expy))]
13352− ['.' ;~(pfix dot (toad |.(loaf(bug |))))]
13353− [',' (rune com %zpcm expb)]
13354− [';' (rune mic %zpmc expb)]
13355− ['>' (rune gar %zpgr expa)]
13356− ['<' (rune gal %zpgl exqc)]
13357− ['@' (rune pat %zppt expx)]
13358− ['=' (rune tis %zpts expa)]
13359− ['?' (rune wut %zpwt hinh)]
13360− ==
13361− ==
13362− ==
13363− ::
13364− ++ boog !:
13365− %+ knee [p=*whit q=*term r=*help s=*hoon]
13366− |.(~+((scye ;~(pose bola boba))))
13367− ++ bola :: ++ arms
13368− %+ knee [q=*term r=*help s=*hoon] |. ~+
13369− %+ cook
13370− |= [q=term r=whiz s=hoon]
13371− ?: =(r *whiz)
13372− [q *help s]
13373− [q [[%funk q]~ [r]~] s]
13374− ;~ pfix (jest '++')
13375− ;~ plug
13376− ;~(pfix gap ;~(pose (cold %$ buc) sym))
13377− apse:docs
13378− ;~(pfix jump loaf)
13379− ==
13380− ==
13381− ::TODO consider special casing $%
13382− ++ boba :: +$ arms
13383− %+ knee [q=*term r=*help s=*hoon] |. ~+
13384− %+ cook
13385− |= [q=term r=whiz s=spec]
13386− ?: =(r *whiz)
13387− [q *help [%ktcl %name q s]]
13388− [q [[%plan q]~ [r]~] [%ktcl %name q s]]
13389− ;~ pfix (jest '+$')
13390− ;~ plug
13391− ;~(pfix gap sym)
13392− apse:docs
13393− ;~(pfix jump loan)
13394− ==
13395− ==
13396− ::
13397− :: parses a or [a b c] or a b c ==
13398− ++ lynx
13399− =/ wid (ifix [sel ser] (most ace sym))
13400− =/ tal
13401− ;~ sfix
13402− (most gap sym)
13403− ;~(plug gap duz)
13404− ==
13405− =/ one
13406− %- cook :_ sym
13407− |= a=term
13408− `(list term)`~[a]
13409− %- cook
13410− :_ ;~(pose (runq wid tal) one)
13411− :: lestify
13412− |= a=(list term)
13413− ?~(a !! a)
13414− ::
13415− ++ whap !: :: chapter
13416− %+ cook
13417− |= a=(list (qual whit term help hoon))
13418− :: separate $helps into their own list to be passed to +glow
13419− =/ [duds=(list help) nude=(list (pair term hoon))]
13420− %+ roll a
13421− |= $: $= bog
13422− (qual whit term help hoon)
13423− ::
13424− $= gob
13425− [duds=(list help) nude=(list (pair term hoon))]
13426− ==
13427− =/ [unt=(list help) tag=(list help)]
13428− %+ skid ~(tap by bat.p.bog) |=(=help =(~ cuff.help))
13429− :- ?: =(*help r.bog)
13430− (weld tag duds.gob)
13431− [r.bog (weld tag duds.gob)]
13432− |-
13433− ?~ unt [[q.bog s.bog] nude.gob]
13434− =. s.bog [%note help/i.unt s.bog]
13435− $(unt t.unt)
13436− ::
13437− %+ glow duds
13438− |- ^- (map term hoon)
13439− ?~ nude ~
13440− =+ $(nude t.nude)
13441− %+ ~(put by -)
13442− p.i.nude
13443− ?: (~(has by -) p.i.nude)
13444− [%eror (weld "duplicate arm: +" (trip p.i.nude))]
13445− q.i.nude
13446− ::
13447− (most mush boog)
13448− ::
13449− :: +glow: moves batch comments to the correct arm
13450− ++ glow
13451− |= [duds=(list help) nude=(map term hoon)]
13452− ^- (map term hoon)
13453− |-
13454− ?~ duds nude
13455− :: if there is no link, its not part of a batch comment
13456− ?~ cuff.i.duds
13457− :: this shouldn't happen yet until we look for cuffs of length >1
13458− :: but we need to prove that cuff is nonempty anyways
13459− $(duds t.duds)
13460− ::
13461− ::TODO: look past the first link. this probably requires
13462− ::a major rethink on how batch comments work
13463− =/ nom=(unit term)
13464− ?+ i.cuff.i.duds ~
13465− :: we only support ++ and +$ batch comments right now
13466− ::
13467− ?([%funk *] [%plan *])
13468− `p.i.cuff.i.duds
13469− ==
13470− %= $
13471− duds t.duds
13472− nude ?~ nom nude
13473− ?. (~(has by nude) u.nom)
13474− :: ~> %slog.[0 leaf+"glow: unmatched link"]
13475− nude
13476− (~(jab by nude) u.nom |=(a=hoon [%note help+i.duds a]))
13477− ==
13478− ::
13479− ++ whip :: chapter declare
13480− %+ cook
13481− |= [[a=whit b=term c=whiz] d=(map term hoon)]
13482− ^- [whit (pair term (map term hoon))]
13483− ?. =(*whit a)
13484− [a b d]
13485− ?: =(*whiz c)
13486− [*whit b d]
13487− [%*(. *whit bat (malt [[%chat b]~ [c]~]~)) b d]
13488− ;~(plug (seam ;~(pfix (jest '+|') gap cen sym)) whap)
13489− ::
13490− ++ wasp :: $brcb aliases
13491− ;~ pose
13492− %+ ifix
13493− [;~(plug lus tar muck) muck]
13494− (most muck ;~(gunk sym loll))
13495− ::
13496− (easy ~)
13497− ==
13498− ::
13499− ++ wisp !: :: core tail
13500− ?. tol fail
13501− %+ cook
13502− |= a=(list [wit=whit wap=(pair term (map term hoon))])
13503− ^- (map term tome)
13504− =< p
13505− |- ^- (pair (map term tome) (map term hoon))
13506− ?~ a [~ ~]
13507− =/ mor $(a t.a)
13508− =. q.wap.i.a
13509− %- ~(urn by q.wap.i.a)
13510− |= b=(pair term hoon) ^+ +.b
13511− :: tests for duplicate arms between two chapters
13512− ?. (~(has by q.mor) p.b) +.b
13513− [%eror (weld "duplicate arm: +" (trip p.b))]
13514− :_ (~(uni by q.mor) q.wap.i.a)
13515− %+ ~(put by p.mor)
13516− p.wap.i.a
13517− :- %- ~(get by bat.wit.i.a)
13518− ?: (~(has by bat.wit.i.a) [%chat p.wap.i.a]~)
13519− [%chat p.wap.i.a]~
13520− ~
13521− ?. (~(has by p.mor) p.wap.i.a)
13522− q.wap.i.a
13523− [[%$ [%eror (weld "duplicate chapter: |" (trip p.wap.i.a))]] ~ ~]
13524− ::
13525− ::TODO: allow cores with unnamed chapter as well as named chapters?
13526− ;~ pose
13527− dun
13528− ;~ sfix
13529− ;~ pose
13530− (most mush whip)
13531− ;~(plug (stag *whit (stag %$ whap)) (easy ~))
13532− ==
13533− gap
13534− dun
13535− ==
13536− ==
13537− ::
13538− ::TODO: check parser performance
13539− ++ toad :: untrap parser expr
13540− |* har=_expa
13541− =+ dur=(ifix [pal par] $:har(tol |))
13542− ?. tol
13543− dur
13544− ;~(pose ;~(pfix jump $:har(tol &)) ;~(pfix gap $:har(tol &)) dur)
13545− ::
13546− ++ rune :: build rune
13547− |* [dif=rule tuq=* har=_expa]
13548− ;~(pfix dif (stag tuq (toad har)))
13549− ::
13550− ++ runo :: rune plus
13551− |* [dif=rule hil=* tuq=* har=_expa]
13552− ;~(pfix dif (stag hil (stag tuq (toad har))))
13553− ::
13554− ++ runq :: wide or tall if tol
13555− |* [wid=rule tal=rule] :: else wide
13556− ?. tol
13557− wid
13558− ;~(pose wid tal)
13559− ::
13560− ++ butt |* zor=rule :: closing == if tall
13561− ?:(tol ;~(sfix zor ;~(plug gap duz)) zor)
13562− ++ ulva |* zor=rule :: closing -- and tall
13563− ?.(tol fail ;~(sfix zor ;~(plug gap dun)))
13564− ++ glop ~+((glue mash)) :: separated by space
13565− ++ gunk ~+((glue muck)) :: separated list
13566− ++ goop ~+((glue mush)) :: separator list & docs
13567− ++ hank (most mush loaf) :: gapped hoons
13568− ++ hunk (most mush loan) :: gapped specs
13569− ++ jump ;~(pose leap:docs gap) :: gap before docs
13570− ++ loaf ?:(tol tall wide) :: hoon
13571− ++ loll ?:(tol tall(doc |) wide(doc |)) :: hoon without docs
13572− ++ loan ?:(tol till wyde) :: spec
13573− ++ lore (sear |=(=hoon ~(flay ap hoon)) loaf) :: skin
13574− ++ lomp ;~(plug sym (punt ;~(pfix tis wyde))) :: typeable name
13575− ++ mash ?:(tol gap ;~(plug com ace)) :: list separator
13576− ++ muss ?:(tol jump ;~(plug com ace)) :: list w/ doccords
13577− ++ muck ?:(tol gap ace) :: general separator
13578− ++ mush ?:(tol jump ace) :: separator w/ docs
13579− ++ teak %+ knee *tiki |. ~+ :: wing or hoon
13580− =+ ^= gub
13581− |= [a=term b=$%([%& p=wing] [%| p=hoon])]
13582− ^- tiki
13583− ?-(-.b %& [%& [~ a] p.b], %| [%| [~ a] p.b])
13584− =+ ^= wyp
13585− ;~ pose
13586− %+ cook gub
13587− ;~ plug
13588− sym
13589− ;~(pfix tis ;~(pose (stag %& rope) (stag %| wide)))
13590− ==
13591− ::
13592− (stag %& (stag ~ rope))
13593− (stag %| (stag ~ wide))
13594− ==
13595− ?. tol wyp
13596− ;~ pose
13597− wyp
13598− ::
13599− ;~ pfix
13600− ;~(plug ket tis gap)
13601− %+ cook gub
13602− ;~ plug
13603− sym
13604− ;~(pfix gap ;~(pose (stag %& rope) (stag %| tall)))
13605− ==
13606− ==
13607− ::
13608− (stag %| (stag ~ tall))
13609− ==
13610− ++ rack (most muss ;~(goop loaf loaf)) :: list [hoon hoon]
13611− ++ ruck (most muss ;~(goop loan loaf)) :: list [spec hoon]
13612− ++ rick (most mash ;~(goop rope loaf)) :: list [wing hoon]
13613− :: hoon contents
13614− ::
13615− ++ expa |.(loaf) :: one hoon
13616− ++ expb |.(;~(goop loaf loaf)) :: two hoons
13617− ++ expc |.(;~(goop loaf loaf loaf)) :: three hoons
13618− ++ expd |.(;~(goop loaf loaf loaf loaf)) :: four hoons
13619− ++ expe |.(wisp) :: core tail
13620− ++ expf |.(;~(goop ;~(pfix cen sym) loaf)) :: %term and hoon
13621− ++ expg |.(;~(gunk lomp loll loaf)) :: term/spec, two hoons
13622− ++ exph |.((butt ;~(gunk rope rick))) :: wing, [wing hoon]s
13623− ++ expi |.((butt ;~(goop loaf hank))) :: one or more hoons
13624− ++ expj |.(;~(goop lore loaf)) :: skin and hoon
13625− :: ++ expk |.(;~(gunk loaf ;~(plug loaf (easy ~)))):: list of two hoons
13626− :: ++ expl |.(;~(gunk sym loaf loaf)) :: term, two hoons
13627− ++ expm |.((butt ;~(gunk rope loaf rick))) :: several [spec hoon]s
13628− ++ expn |. ;~ gunk rope loaf :: wing, hoon,
13629− ;~(plug loaf (easy ~)) :: list of one hoon
13630− == ::
13631− ++ expo |.(;~(goop wise loaf loaf)) :: =;
13632− ++ expp |.(;~(goop (butt rick) loaf)) :: [wing hoon]s, hoon
13633− ++ expq |.(;~(goop rope loaf loaf)) :: wing and two hoons
13634− ++ expr |.(;~(goop loaf wisp)) :: hoon and core tail
13635− ++ exps |.((butt hank)) :: closed gapped hoons
13636− ++ expt |.(;~(gunk wise rope loaf loaf)) :: =^
13637− ++ expu |.(;~(gunk rope loaf (butt hank))) :: wing, hoon, hoons
13638− :: ++ expv |.((butt rick)) :: just changes
13639− ++ expw |.(;~(goop rope loaf loaf loaf)) :: wing and three hoons
13640− ++ expx |.(;~(goop ropa loaf loaf)) :: wings and two hoons
13641− ++ expy |.(loaf(bug &)) :: hoon with tracing
13642− ++ expz |.(;~(goop loan loaf loaf loaf)) :: spec and three hoons
13643− :: spec contents
13644− ::
13645− ++ exqa |.(loan) :: one spec
13646− ++ exqb |.(;~(goop loan loan)) :: two specs
13647− ++ exqc |.(;~(goop loan loaf)) :: spec then hoon
13648− ++ exqd |.(;~(goop loaf loan)) :: hoon then spec
13649− ++ exqe |.(;~(goop lynx loan)) :: list of names then spec
13650− ++ exqs |.((butt hunk)) :: closed gapped specs
13651− ++ exqg |.(;~(goop sym loan)) :: term and spec
13652− ::++ exqk |.(;~(goop loaf ;~(plug loan (easy ~)))):: hoon with one spec
13653− ++ exqn |.(;~(gunk loan (stag %cltr (butt hank)))):: autoconsed hoons
13654− ++ exqr |.(;~(gunk loan ;~(plug wasp wisp))) :: spec/aliases?/tail
13655− ::++ exqw |.(;~(goop loaf loan)) :: hoon and spec
13656− ++ exqx |.(;~(goop loaf loan loan)) :: hoon, two specs
13657− ++ exqy |.(;~(goop loaf loan loan loan)) :: hoon, three specs
13658− ++ exqz |.(;~(goop loaf (butt hunk))) :: hoon, n specs
13659− ::
13660− :: tiki expansion for %wt runes
13661− ::
13662− ++ txhp |. %+ cook |= [a=tiki b=(list (pair spec hoon))]
13663− (~(wthp ah a) b)
13664− (butt ;~(gunk teak ruck))
13665− ++ tkkt |. %+ cook |= [a=tiki b=hoon c=hoon]
13666− (~(wtkt ah a) b c)
13667− ;~(gunk teak loaf loaf)
13668− ++ txls |. %+ cook |= [a=tiki b=hoon c=(list (pair spec hoon))]
13669− (~(wtls ah a) b c)
13670− (butt ;~(gunk teak loaf ruck))
13671− ++ tkvt |. %+ cook |= [a=tiki b=hoon c=hoon]
13672− (~(wtpt ah a) b c)
13673− ;~(gunk teak loaf loaf)
13674− ++ tksg |. %+ cook |= [a=tiki b=hoon c=hoon]
13675− (~(wtsg ah a) b c)
13676− ;~(gunk teak loaf loaf)
13677− ++ txts |. %+ cook |= [a=spec b=tiki]
13678− (~(wtts ah b) a)
13679− ;~(gunk loan teak)
13680− ++ txhx |. %+ cook |= [a=skin b=tiki]
13681− (~(wthx ah b) a)
13682− ;~(gunk lore teak)
13683− ::
13684− :: hint syntax
13685− ::
13686− ++ hinb |.(;~(goop bont loaf)) :: hint and hoon
13687− ++ hinc |. :: optional =en, hoon
13688− ;~(pose ;~(goop bony loaf) (stag ~ loaf)) ::
13689− ++ hind |.(;~(gunk bonk loaf ;~(goop bonz loaf))) :: jet hoon "bon"s hoon
13690− ++ hine |.(;~(goop bonk loaf)) :: jet-hint and hoon
13691− ++ hinf |. :: 0-3 >s, two hoons
13692− ;~ pose
13693− ;~(goop (cook lent (stun [1 3] gar)) loaf loaf)
13694− (stag 0 ;~(goop loaf loaf))
13695− ==
13696− ++ hing |. :: 0-3 >s, three hoons
13697− ;~ pose
13698− ;~(goop (cook lent (stun [1 3] gar)) loaf loaf loaf)
13699− (stag 0 ;~(goop loaf loaf loaf))
13700− ==
13701− ++ bonk :: jet signature
13702− ;~ pfix cen
13703− ;~ pose
13704− ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot ;~(pfix dot dem)))))
13705− ;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot dem))))
13706− ;~(plug sym ;~(pfix dot dem))
13707− sym
13708− ==
13709− ==
13710− ++ hinh |. :: 1/2 numbers, hoon
13711− ;~ goop
13712− ;~ pose
13713− dem
13714− (ifix [sel ser] ;~(plug dem ;~(pfix ace dem)))
13715− ==
13716− loaf
13717− ==
13718− ++ bont ;~ (bend) :: term, optional hoon
13719− ;~(pfix cen sym)
13720− ;~(pfix dot ;~(pose wide ;~(pfix muck loaf)))
13721− ==
13722− ++ bony (cook |=(a=(list) (lent a)) (plus tis)) :: base 1 =en count
13723− ++ bonz :: term-labelled hoons
13724− ;~ pose
13725− (cold ~ sig)
13726− %+ ifix
13727− ?:(tol [;~(plug duz gap) ;~(plug gap duz)] [pal par])
13728− (more mash ;~(gunk ;~(pfix cen sym) loaf))
13729− ==
13730− --
13731− ::
13732− ++ lang :: lung sample
13733− $: ros=hoon
13734− $= vil
13735− $% [%tis p=hoon]
13736− [%col p=hoon]
13737− [%ket p=hoon]
13738− [%lit p=(list (pair wing hoon))]
13739− ==
13740− ==
13741− ::
13742− ++ lung
13743− ~+
13744− %- bend
13745− |: $:lang
13746− ^- (unit hoon)
13747− ?- -.vil
13748− %col ?:(=([%base %flag] ros) ~ [~ %tsgl ros p.vil])
13749− %lit (bind ~(reek ap ros) |=(hyp=wing [%cnts hyp p.vil]))
13750− %ket [~ ros p.vil]
13751− %tis =+ rud=~(flay ap ros)
13752− ?~(rud ~ `[%ktts u.rud p.vil])
13753− ==
13754− ::
13755− ++ long
13756− %+ knee *hoon |. ~+
13757− ;~ lung
13758− scat
13759− ;~ pose
13760− ;~(plug (cold %tis tis) wide)
13761− ;~(plug (cold %col col) wide)
13762− ;~(plug (cold %ket ket) wide)
13763− ;~ plug
13764− (easy %lit)
13765− (ifix [pal par] lobo)
13766− ==
13767− ==
13768− ==
13769− ::
13770− ++ lobo (most ;~(plug com ace) ;~(glam rope wide))
13771− ++ loon (most ;~(plug com ace) ;~(glam wide wide))
13772− ++ lute :: tall [] noun
13773− ~+
13774− %+ cook |=(hoon +<)
13775− %+ stag %cltr
13776− %+ ifix
13777− [;~(plug sel gap) ;~(plug gap ser)]
13778− (most gap tall)
13779− ::
13780− ++ ropa (most col rope)
13781− ++ rope :: wing form
13782− %+ knee *wing
13783− |. ~+
13784− %+ (slug |=([a=limb b=wing] [a b]))
13785− dot
13786− ;~ pose
13787− (cold [%| 0 ~] com)
13788− %+ cook
13789− |=([a=(list) b=term] ?~(a b [%| (lent a) `b]))
13790− ;~(plug (star ket) ;~(pose sym (cold %$ buc)))
13791− ::
13792− %+ cook
13793− |=(a=axis [%& a])
13794− ;~ pose
13795− ;~(pfix lus dim:ag)
13796− ;~(pfix pam (cook |=(a=@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag))
13797− ;~(pfix bar (cook |=(a=@ ?:(=(0 a) 1 +((mul 2 $(a (dec a)))))) dim:ag))
13798− ven
13799− (cold 1 dot)
13800− ==
13801− ==
13802− ::
13803− ++ wise
13804− ;~ pose
13805− ;~ pfix tis
13806− %+ sear
13807− |= =spec
13808− ^- (unit skin)
13809− %+ bind ~(autoname ax spec)
13810− |= =term
13811− [%name term %spec spec %base %noun]
13812− wyde
13813− ==
13814− ::
13815− %+ cook
13816− |= [=term =(unit spec)]
13817− ^- skin
13818− ?~ unit
13819− term
13820− [%name term %spec u.unit %base %noun]
13821− ;~ plug sym
13822− (punt ;~(pfix ;~(pose fas tis) wyde))
13823− ==
13824− ::
13825− %+ cook
13826− |= =spec
13827− ^- skin
13828− [%spec spec %base %noun]
13829− wyde
13830− ==
13831− ::
13832− ++ tall :: full tall form
13833− %+ knee *hoon
13834− |.(~+((wart (clad ;~(pose expression:(norm &) long lute apex:(sail &))))))
13835− ++ till :: mold tall form
13836− %+ knee *spec
13837− |.(~+((wert (coat ;~(pose structure:(norm &) scad)))))
13838− ++ wede :: wide bulb
13839− :: XX: lus deprecated
13840− ::
13841− ;~(pfix ;~(pose lus fas) wide)
13842− ++ wide :: full wide form
13843− %+ knee *hoon
13844− |.(~+((wart ;~(pose expression:(norm |) long apex:(sail |)))))
13845− ++ wyde :: mold wide form
13846− %+ knee *spec
13847− |.(~+((wert ;~(pose structure:(norm |) scad))))
13848− ++ wart
13849− |* zor=rule
13850− %+ here
13851− |= [a=pint b=hoon]
13852− ?:(bug [%dbug [wer a] b] b)
13853− zor
13854− ++ wert
13855− |* zor=rule
13856− %+ here
13857− |= [a=pint b=spec]
13858− ?:(bug [%dbug [wer a] b] b)
13859− zor
13860− --
13861−::
13862−++ vest
13863− ~/ %vest
13864− |= tub=nail
13865− ^- (like hoon)
13866− %. tub
13867− %- full
13868− (ifix [gay gay] tall:vast)
13869−::
13870−++ vice
13871− |= txt=@ta
13872− ^- hoon
13873− (rash txt wide:vast)
13874−::
13875−++ make :: compile cord to nock
13876− |= txt=@
13877− q:(~(mint ut %noun) %noun (ream txt))
13878−::
13879−++ rain :: parse with % path
13880− |= [bon=path txt=@]
13881− ^- hoon
13882− =+ vaz=vast
13883− ~| bon
13884− (scan (trip txt) (full (ifix [gay gay] tall:vaz(wer bon))))
13885−::
13886−++ ream :: parse cord to hoon
13887− |= txt=@
13888− ^- hoon
13889− (rash txt vest)
13890−::
13891−++ reck :: parse hoon file
13892− |= bon=path
13893− (rain bon .^(@t %cx (weld bon `path`[%hoon ~])))
13894−::
13895−++ ride :: end-to-end compiler
13896− |= [typ=type txt=@]
13897− ^- (pair type nock)
13898− ~> %slog.[0 leaf/"ride: parsing"]
13899− =/ gen (ream txt)
13900− ~> %slog.[0 leaf/"ride: compiling"]
13901− ~< %slog.[0 leaf/"ride: compiled"]
13902− (~(mint ut typ) %noun gen)
13903−::
13904−:: 5e: molds and mold builders
13905−+| %molds-and-mold-builders
13906−::
13907−+$ mane $@(@tas [@tas @tas]) :: XML name+space
13908−+$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node
13909−+$ marl (list manx) :: XML node list
13910−+$ mars [t=[n=%$ a=[i=[n=%$ v=tape] t=~]] c=~] :: XML cdata
13911−+$ mart (list [n=mane v=tape]) :: XML attributes
13912−+$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag
13913−+$ mite (list @ta) :: mime type
13914−+$ pass @ :: public key
13915−+$ ring @ :: private key
13916−+$ ship @p :: network identity
13917−+$ shop (each ship (list @ta)) :: urbit/dns identity
13918−+$ spur path :: ship desk case spur
13919−+$ time @da :: galactic time
13920−::
13921−:: 5f: profiling support (XX move)
13922−+| %profiling-support
13923−::
13924−++ pi-heck
13925− |= [nam=@tas day=doss]
13926− ^- doss
13927− =+ lam=(~(get by hit.day) nam)
13928− day(hit (~(put by hit.day) nam ?~(lam 1 +(u.lam))))
13929−::
13930−++ pi-noon :: sample trace
13931− |= [mot=term paz=(list path) day=doss]
13932− =| lax=(unit path)
13933− |- ^- doss
13934− ?~ paz day(mon (pi-mope mot mon.day))
13935− %= $
13936− paz t.paz
13937− lax `i.paz
13938− cut.day
13939− %+ ~(put by cut.day) i.paz
13940− ^- hump
13941− =+ nax=`(unit path)`?~(t.paz ~ `i.t.paz)
13942− =+ hup=`hump`=+(hup=(~(get by cut.day) i.paz) ?^(hup u.hup [*moan ~ ~]))
13943− :+ (pi-mope mot mon.hup)
13944− ?~ lax out.hup
13945− =+ hag=(~(get by out.hup) u.lax)
13946− (~(put by out.hup) u.lax ?~(hag 1 +(u.hag)))
13947− ?~ nax inn.hup
13948− =+ hag=(~(get by inn.hup) u.nax)
13949− (~(put by inn.hup) u.nax ?~(hag 1 +(u.hag)))
13950− ==
13951−++ pi-mope :: add sample
13952− |= [mot=term mon=moan]
13953− ?+ mot mon
13954− %fun mon(fun +(fun.mon))
13955− %noc mon(noc +(noc.mon))
13956− %glu mon(glu +(glu.mon))
13957− %mal mon(mal +(mal.mon))
13958− %far mon(far +(far.mon))
13959− %coy mon(coy +(coy.mon))
13960− %euq mon(euq +(euq.mon))
13961− ==
13962−++ pi-moth :: count sample
13963− |= mon=moan ^- @ud
13964− :(add fun.mon noc.mon glu.mon mal.mon far.mon coy.mon euq.mon)
13965−::
13966−++ pi-mumm :: print sample
13967− |= mon=moan ^- tape
13968− =+ tot=(pi-moth mon)
13969− ;: welp
13970− ^- tape
13971− ?: =(0 noc.mon) ~
13972− (welp (scow %ud (div (mul 100 noc.mon) tot)) "n ")
13973− ::
13974− ^- tape
13975− ?: =(0 fun.mon) ~
13976− (welp (scow %ud (div (mul 100 fun.mon) tot)) "c ")
13977− ::
13978− ^- tape
13979− ?: =(0 glu.mon) ~
13980− (welp (scow %ud (div (mul 100 glu.mon) tot)) "g ")
13981− ::
13982− ^- tape
13983− ?: =(0 mal.mon) ~
13984− (welp (scow %ud (div (mul 100 mal.mon) tot)) "m ")
13985− ::
13986− ^- tape
13987− ?: =(0 far.mon) ~
13988− (welp (scow %ud (div (mul 100 far.mon) tot)) "f ")
13989− ::
13990− ^- tape
13991− ?: =(0 coy.mon) ~
13992− (welp (scow %ud (div (mul 100 coy.mon) tot)) "y ")
13993− ::
13994− ^- tape
13995− ?: =(0 euq.mon) ~
13996− (welp (scow %ud (div (mul 100 euq.mon) tot)) "e ")
13997− ==
13998−::
13999−++ pi-tell :: produce dump
14000− |= day=doss
14001− ^- (list tape)
14002− ?: =(day *doss) ~
14003− =+ tot=(pi-moth mon.day)
14004− ;: welp
14005− [(welp "events: " (pi-mumm mon.day)) ~]
14006− ::
14007− %+ turn
14008− %+ sort ~(tap by hit.day)
14009− |= [a=[* @] b=[* @]]
14010− (lth +.a +.b)
14011− |= [nam=term num=@ud]
14012− :(welp (trip nam) ": " (scow %ud num))
14013− ["" ~]
14014− ::
14015− %- zing
14016− ^- (list (list tape))
14017− %+ turn
14018− %+ sort ~(tap by cut.day)
14019− |= [one=(pair path hump) two=(pair path hump)]
14020− (gth (pi-moth mon.q.one) (pi-moth mon.q.two))
14021− |= [pax=path hup=hump]
14022− =+ ott=(pi-moth mon.hup)
14023− ;: welp
14024− [(welp "label: " (spud pax)) ~]
14025− [(welp "price: " (scow %ud (div (mul 100 ott) tot))) ~]
14026− [(welp "shape: " (pi-mumm mon.hup)) ~]
14027− ::
14028− ?: =(~ out.hup) ~
14029− :- "into:"
14030− %+ turn
14031− %+ sort ~(tap by out.hup)
14032− |=([[* a=@ud] [* b=@ud]] (gth a b))
14033− |= [pax=path num=@ud]
14034− ^- tape
14035− :(welp " " (spud pax) ": " (scow %ud num))
14036− ::
14037− ?: =(~ inn.hup) ~
14038− :- "from:"
14039− %+ turn
14040− %+ sort ~(tap by inn.hup)
14041− |=([[* a=@ud] [* b=@ud]] (gth a b))
14042− |= [pax=path num=@ud]
14043− ^- tape
14044− :(welp " " (spud pax) ": " (scow %ud num))
14045− ::
14046− ["" ~]
14047− ~
14048− ==
14049− ==
14050−--