@@ -0,0 +1,14050 @@
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+--