shrub/sys/hoon.hoon

13553 lines
413 KiB
Plaintext
Raw Normal View History

2018-04-08 20:44:15 +03:00
:: ::
2016-11-24 07:25:07 +03:00
:::: /sys/hoon ::
2018-03-20 05:42:13 +03:00
:: ::
2016-11-24 07:25:07 +03:00
=< ride
2017-09-16 00:40:24 +03:00
=> %143 =>
2016-11-24 07:25:07 +03:00
:: ::
:::: 0: version stub ::
:: ::
2017-09-16 00:40:24 +03:00
~% %k.143 ~ ~ ::
2016-11-24 07:25:07 +03:00
|%
2017-10-31 21:07:42 +03:00
++ hoon-version +
2016-11-24 07:25:07 +03:00
-- =>
~% %one + ~
2017-11-16 22:09:03 +03:00
:> # %base
:>
:> basic mathematical operations
2016-11-24 07:25:07 +03:00
|%
2017-11-16 22:09:03 +03:00
:> # %math
:> unsigned arithmetic
+|
++ add
2016-11-24 07:25:07 +03:00
~/ %add
2017-11-16 22:09:03 +03:00
:> unsigned addition
:>
:> a: augend
:> b: addend
2017-10-18 22:55:02 +03:00
|= [a=@ b=@]
:> sum
2016-11-24 07:25:07 +03:00
^- @
?: =(0 a) b
$(a (dec a), b +(b))
::
2017-11-16 22:09:03 +03:00
++ dec
2016-11-24 07:25:07 +03:00
~/ %dec
2017-11-16 22:09:03 +03:00
:> unsigned decrement by one.
|= a=@
2016-11-24 07:25:07 +03:00
~_ leaf+"decrement-underflow"
?< =(0 a)
=+ b=0
2017-11-16 22:09:03 +03:00
:> decremented integer
2016-11-24 07:25:07 +03:00
|- ^- @
?: =(a +(b)) b
$(b +(b))
::
2017-11-16 22:09:03 +03:00
++ div
2016-11-24 07:25:07 +03:00
~/ %div
2017-11-16 22:09:03 +03:00
:> unsigned divide
:>
:> a: dividend
:> b: divisor
|: [a=`@`1 b=`@`1]
:> quotient
2016-11-24 07:25:07 +03:00
^- @
~_ leaf+"divide-by-zero"
?< =(0 b)
=+ c=0
|-
?: (lth a b) c
$(a (sub a b), c +(c))
::
2017-11-16 22:09:03 +03:00
++ dvr
2016-11-24 07:25:07 +03:00
~/ %dvr
2017-11-16 22:09:03 +03:00
:> unsigned divide with remainder
:>
:> a: dividend
:> b: divisor
|= [a=@ b=@]
:> p: quotient
:> q: remainder
^- [p=@ q=@]
2016-11-24 07:25:07 +03:00
[(div a b) (mod a b)]
::
2017-11-16 22:09:03 +03:00
++ gte
2016-11-24 07:25:07 +03:00
~/ %gte
2017-11-16 22:09:03 +03:00
:> unsigned greater than or equals
:>
:> returns whether {a >= b}.
:>
:> a: left hand operand (todo: name)
:> b: right hand operand
|= [a=@ b=@]
:> greater than or equal to?
2016-11-24 07:25:07 +03:00
^- ?
!(lth a b)
::
2017-11-16 22:09:03 +03:00
++ gth
2016-11-24 07:25:07 +03:00
~/ %gth
2017-11-16 22:09:03 +03:00
:> unsigned greater than
:>
:> returns whether {a > b}
:>
:> a: left hand operand (todo: name)
:> b: right hand operand
|= [a=@ b=@]
:> greater than?
2016-11-24 07:25:07 +03:00
^- ?
!(lte a b)
::
2017-11-16 22:09:03 +03:00
++ lte
2016-11-24 07:25:07 +03:00
~/ %lte
2017-11-16 22:09:03 +03:00
:> unsigned less than or equals
:>
:> returns whether {a >= b}.
:>
:> a: left hand operand (todo: name)
:> b: right hand operand
|= [a=@ b=@]
:> less than or equal to?
2016-11-24 07:25:07 +03:00
|(=(a b) (lth a b))
::
2017-11-16 22:09:03 +03:00
++ lth
2016-11-24 07:25:07 +03:00
~/ %lth
2017-11-16 22:09:03 +03:00
:> unsigned less than
:>
:> a: left hand operand (todo: name)
:> b: right hand operand
|= [a=@ b=@]
:> less than?
2016-11-24 07:25:07 +03:00
^- ?
?& !=(a b)
|-
?| =(0 a)
?& !=(0 b)
$(a (dec a), b (dec b))
== == ==
::
2017-11-16 22:09:03 +03:00
++ max
2016-11-24 07:25:07 +03:00
~/ %max
2017-11-16 22:09:03 +03:00
:> unsigned maximum
|= [a=@ b=@]
:> the maximum
2016-11-24 07:25:07 +03:00
^- @
?: (gth a b) a
b
::
2017-11-16 22:09:03 +03:00
++ min
2016-11-24 07:25:07 +03:00
~/ %min
2017-11-16 22:09:03 +03:00
:> unsigned minimum
|= [a=@ b=@]
:> the minimum
2016-11-24 07:25:07 +03:00
^- @
?: (lth a b) a
b
::
2017-11-16 22:09:03 +03:00
++ mod
2016-11-24 07:25:07 +03:00
~/ %mod
2017-11-16 22:09:03 +03:00
:> unsigned modulus
:>
:> a: dividend
:> b: divisor
2016-11-24 07:25:07 +03:00
|: [a=`@`1 b=`@`1]
2017-11-16 22:09:03 +03:00
:> the remainder
2016-11-24 07:25:07 +03:00
^- @
?< =(0 b)
(sub a (mul b (div a b)))
::
2017-11-16 22:09:03 +03:00
++ mul
2016-11-24 07:25:07 +03:00
~/ %mul
2017-11-16 22:09:03 +03:00
:> unsigned multiplication
:>
:> a: multiplicand
:> b: multiplier
2016-11-24 07:25:07 +03:00
|: [a=`@`1 b=`@`1]
2017-11-16 22:09:03 +03:00
:> product
2016-11-24 07:25:07 +03:00
^- @
=+ c=0
|-
?: =(0 a) c
$(a (dec a), c (add b c))
::
2017-11-16 22:09:03 +03:00
++ sub
2016-11-24 07:25:07 +03:00
~/ %sub
2017-11-16 22:09:03 +03:00
:> unsigned subtraction
:>
:> a: minuend
:> b: subtrahend
|= [a=@ b=@]
2016-11-24 07:25:07 +03:00
~_ leaf+"subtract-underflow"
2017-11-16 22:09:03 +03:00
:> difference
2016-11-24 07:25:07 +03:00
^- @
?: =(0 b) a
$(a (dec a), b (dec b))
2017-11-16 22:09:03 +03:00
::
:> # %tree
:>
:> tree addressing
+|
++ cap
2016-11-24 07:25:07 +03:00
~/ %cap
:> tree head
:>
:> tests whether an `a` is in the head or tail of a noun. produces %2 if it
:> is within the head, or %3 if it is within the tail.
|= a=@
2016-11-24 07:25:07 +03:00
^- ?($2 $3)
?- a
$2 %2
$3 %3
?($0 $1) !!
* $(a (div a 2))
==
::
++ mas
2016-11-24 07:25:07 +03:00
~/ %mas
:> axis within head/tail
:>
:> computes the axis of `a` within either the head or tail of a noun
:> (depends whether `a` lies within the the head or tail).
|= a=@
2016-11-24 07:25:07 +03:00
^- @
?- a
$1 !!
$2 1
$3 1
* (add (mod a 2) (mul $(a (div a 2)) 2))
==
::
++ peg
2016-11-24 07:25:07 +03:00
~/ %peg
:> axis within axis
:>
:> computes the axis of {b} within axis {a}.
|= [a=@ b=@]
2016-11-24 07:25:07 +03:00
?< =(0 a)
:> a composed axis
2016-11-24 07:25:07 +03:00
^- @
?- b
$1 a
$2 (mul a 2)
$3 +((mul a 2))
* (add (mod b 2) (mul $(b (div b 2)) 2))
==
2017-12-10 05:44:54 +03:00
:: ::
:::: 2n: functional hacks ::
:: ::
::
++ aftr |*(a/$-(* *) |*(b/$-(* *) (pair b a))) :: pair after
2017-12-10 06:18:00 +03:00
++ cork |*({a/$-(* *) b/$-(* *)} (corl b a)) :: compose forward
2017-12-10 05:44:54 +03:00
++ corl :: compose backwards
2017-12-10 06:18:00 +03:00
|* {a/$-(* *) b/$-(* *)}
2017-12-10 05:44:54 +03:00
=< +:|.((a (b))) :: type check
2017-12-10 06:18:00 +03:00
=+ c=+<.b
|% +- $ (a (b c))
--
2017-12-10 05:44:54 +03:00
::
++ cury :: curry left
|* {a/$-(^ *) b/*}
=+ c=+<+.a
|% +- $ (a b c)
--
::
++ curr :: curry right
|* {a/$-(^ *) c/*}
=+ b=+<+.a
|% +- $ (a b c)
--
::
++ fore |*(a/$-(* *) |*(b/$-(* *) (pair a b))) :: pair before
++ hard :: force remold
|* han/$-(* *)
|= fud/* ^- han
~_ leaf+"hard"
=+ gol=(han fud)
?>(=(gol fud) gol)
::
::
++ head |*(^ ,:+<-) :: get head
++ same |*(* +<) :: identity
++ soft :: maybe remold
|* han/$-(* *)
|= fud/* ^- (unit han)
=+ gol=(han fud)
?.(=(gol fud) ~ [~ gol])
::
++ tail |*(^ ,:+<+) :: get tail
++ test |=(^ =(+<- +<+)) :: equality
::
:> # %containers
:>
:> the most basic of data types
+|
++ bloq
:> blocksize
:>
:> a blocksize is the power of 2 size of an atom. ie, 3 is a byte as 2^3 is
:> 8 bits.
@
::
++ each
:> either {a} or {b}, defaulting to {a}.
:>
:> mold generator: produces a discriminated fork between two types,
:> defaulting to {a}.
2018-03-19 06:54:47 +03:00
|*({a/$-(* *) b/$-(* *)} $%({%| p/b} {%& p/a}))
::
++ gate
:> function
:>
:> a core with one arm, `$`--the empty name--which transforms a sample noun
:> into a product noun. If used dryly as a type, the subject must have a
:> sample type of `*`.
$-(* *)
::
++ list
:> null-terminated list
:>
:> mold generator: produces a mold of a null-terminated list of the
:> homogeneous type {a}.
|*(a/$-(* *) $@(~ {i/a t/(list a)}))
::
++ lone
:> single item tuple
:>
:> mold generator: puts the face of `p` on the passed in mold.
2017-12-10 05:44:54 +03:00
|*(a/$-(* *) {p/a})
::
++ mold
:> normalizing gate
:>
:> a gate that accepts any noun, and validates its shape, producing the
:> input if it fits or a default value if it doesn't.
:>
:> examples: * @ud ,[p=time q=?(%a %b)]
_|=(* +<)
::
++ pair
:> dual tuple
:>
:> mold generator: produces a tuple of the two types passed in.
:>
:> a: first type, labeled {p}
:> b: second type, labeled {q}
2017-12-10 05:44:54 +03:00
|*({a/$-(* *) b/$-(* *)} {p/a q/b})
::
++ pole
:> faceless list
:>
:> like ++list, but without the faces {i} and {t}.
:>
:> a: a mold for the item type.
|*(a/$-(* *) $@(~ {a (pole a)}))
::
++ qual
:> quadruple tuple
:>
:> mold generator: produces a tuple of the four types passed in.
:>
:> a: first type, labeled {p}
:> b: second type, labeled {q}
:> c: third type, labeled {r}
:> d: fourth type, labeled {s}
2017-12-10 05:44:54 +03:00
|* {a/$-(* *) b/$-(* *) c/$-(* *) d/$-(* *)}
{p/a q/b r/c s/d}
::
++ quip
:> pair of list of first and second
:>
:> a common pattern in hoon code is to return a ++list of changes, along with
:> a new state.
:>
:> a: type of list item
:> b: type of returned state
2017-12-10 05:44:54 +03:00
|*({a/$-(* *) b/$-(* *)} {(list a) b})
::
++ trap
:> a core with one arm `$`
:>
:> a: return type of the `$` arm.
2017-12-10 05:44:54 +03:00
|*(a/$-(* *) _|?($:a))
::
++ tree
:> tree mold generator
:>
:> a `++tree` can be empty, or contain a node of a type and
:> left/right sub `++tree` of the same type. pretty-printed with `{}`.
:>
:> a: type of tree node
|*(a/$-(* *) $@(~ {n/a l/(tree a) r/(tree a)})) :: binary tree
::
++ trel
:> triple tuple
:>
:> mold generator: produces a tuple of the three types passed in.
:>
:> a: first type, labeled {p}
:> b: second type, labeled {q}
:> c: third type, labeled {r}
2017-12-10 05:44:54 +03:00
|*({a/$-(* *) b/$-(* *) c/$-(* *)} {p/a q/b r/c})
::
++ unit
:> maybe
:>
:> mold generator: either `~` or `[~ u=a]` where `a` is the
:> type that was passed in.
:>
:> a: type when non-null
|*(a/$-(* *) $@(~ {~ u/a}))
2017-12-10 05:44:54 +03:00
::
:: ::
2017-12-10 06:18:00 +03:00
:::: 2o: containers ::
2017-12-10 05:44:54 +03:00
:: ::
::
2017-12-10 06:18:00 +03:00
++ jar |*({a/$-(* *) b/$-(* *)} (map a (list b))) :: map of lists
++ jug |*({a/$-(* *) b/$-(* *)} (map a (set b))) :: map of sets
++ map |*({a/$-(* *) b/$-(* *)} (tree (pair a b))) :: table
++ qeu |*(a/$-(* *) (tree a)) :: queue
++ set |*(a/$-(* *) (tree a)) :: set
2017-12-10 05:44:54 +03:00
::
:::: 2q: molds and mold builders ::
:: ::
::
2017-12-12 05:05:48 +03:00
++ axis @ :: tree address
++ bean ? :: 0=&=yes, 1=|=no
2018-03-19 05:40:38 +03:00
++ flag ?
2017-12-10 05:44:54 +03:00
++ char @t :: UTF8 byte
++ cord @t :: UTF8, LSB first
++ date {{a/? y/@ud} m/@ud t/tarp} :: parsed date
++ knot @ta :: ASCII text
2017-12-12 05:05:48 +03:00
++ noun * :: any noun
2018-04-17 03:33:42 +03:00
++ path (list knot) :: like unix path
++ stud :: standard name
$@ @tas :: auth=urbit
$: auth=@tas :: standards authority
type=path :: standard label
== ::
2018-04-11 04:51:33 +03:00
++ plum :: new output noun
$@ cord
2018-04-17 06:28:30 +03:00
$% :: %|: wrappable paragraph without linebreaks
:: %&: decorated list
2018-04-17 03:33:42 +03:00
::
2018-04-17 06:28:30 +03:00
[%| p=(list @t)]
$: %&
2018-04-17 03:33:42 +03:00
$= decor
$: :: wide: one-line syntax
:: tall: multiline syntax
::
$= wide
%- unit
$: :: delimit: delimiter between items
:: enclose: enclosure around items
::
delimit=knot
enclose=(unit (pair knot knot))
==
$= tall
2018-04-17 06:28:30 +03:00
%- unit
$: :: intro: initial string (like |%)
2018-04-17 03:33:42 +03:00
::
intro=knot
2018-04-17 06:28:30 +03:00
:: indef: indefinite, not fixed, fanout
2018-04-17 03:33:42 +03:00
::
$= indef
%- unit
$: :: sigil: before each item (like ++)
2018-04-17 06:28:30 +03:00
:: final: final string (like --)
2018-04-17 03:33:42 +03:00
::
sigil=knot
final=knot
== == ==
:: list: subplums
::
2018-04-17 06:28:30 +03:00
=(list plum)
2018-04-17 03:33:42 +03:00
==
2018-04-11 04:51:33 +03:00
==
2017-12-10 05:44:54 +03:00
++ tang (list tank) :: bottom-first error
2018-02-11 08:24:22 +03:00
++ tank $~ [%leaf ~] ::
$% {$leaf p/tape} :: printing formats
2017-12-10 05:44:54 +03:00
$: $palm :: backstep list
p/{p/tape q/tape r/tape s/tape} ::
q/(list tank) ::
== ::
$: $rose :: flat list
p/{p/tape q/tape r/tape} :: mid open close
q/(list tank) ::
== ::
== ::
2018-03-31 06:54:04 +03:00
++ tape (list @tD) :: utf8 string as list
++ tour (list @c) :: utf32 clusters
2017-12-10 05:44:54 +03:00
++ tarp {d/@ud h/@ud m/@ud s/@ud f/(list @ux)} :: parsed time
++ term @tas :: ascii symbol
++ wain (list cord) :: text lines
++ wall (list tape) :: text lines
2016-11-24 07:25:07 +03:00
-- =>
:: ::
:::: 2: layer two ::
:: ::
:: 2a: unit logic ::
:: 2b: list logic ::
:: 2c: bit arithmetic ::
:: 2d: bit logic ::
:: 2e: insecure hashing ::
:: 2f: noun ordering ::
:: 2g: unsigned powers ::
:: 2h: set logic ::
:: 2i: map logic ::
:: 2j: jar and jug logic ::
:: 2k: queue logic ::
:: 2l: container from container ::
:: 2m: container from noun ::
:: 2n: functional hacks ::
:: 2o: normalizing containers ::
:: 2p: serialization ::
:: 2q: molds and mold builders ::
::
~% %two + ~
|%
:: ::
:::: 2a: unit logic ::
:: ::
:: biff, bind, bond, both, clap, drop, ::
:: fall, flit, lift, mate, need, some ::
::
++ biff :: apply
|* {a/(unit) b/$-(* (unit))}
?~ a ~
(b u.a)
::
++ bind :: argue
|* {a/(unit) b/$-(* *)}
2016-11-24 07:25:07 +03:00
?~ a ~
[~ u=(b u.a)]
::
++ bond :: replace
|* a/(trap)
|* b/(unit)
?~ b $:a
u.b
::
++ both :: all the above
|* {a/(unit) b/(unit)}
?~ a ~
?~ b ~
[~ u=[u.a u.b]]
::
++ clap :: combine
2017-12-10 15:37:33 +03:00
|* {a/(unit) b/(unit) c/_=>(~ |=(^ +<-))}
2016-11-24 07:25:07 +03:00
?~ a b
?~ b a
[~ u=(c u.a u.b)]
::
++ drop :: enlist
|* a/(unit)
?~ a ~
[i=u.a t=~]
::
++ fall :: default
|* {a/(unit) b/*}
?~(a b u.a)
::
++ flit :: make filter
|* a/$-(* ?)
|* b/*
?.((a b) ~ [~ u=b])
::
++ hunt :: first of units
|* {ord/$-({* *} ?) one/(unit) two/(unit)}
^- (unit ?(_,.+.one _,.+.two))
?~ one two
?~ two one
?:((ord ,.+.one ,.+.two) one two)
::
2016-11-24 07:25:07 +03:00
++ lift :: lift mold (fmap)
|* a/mold :: flipped
|* b/(unit) :: curried
(bind b a) :: bind
::
++ mate :: choose
|* {a/(unit) b/(unit)}
?~ b a
?~ a b
?.(=(u.a u.b) ~>(%mean.[%leaf "mate"] !!) a)
::
++ need :: demand
|* a/(unit)
?~ a ~>(%mean.[%leaf "need"] !!)
u.a
::
++ some :: lift (pure)
|* a/*
[~ u=a]
::
:::: 2b: list logic ::
:: ::
:: ::
::
++ fand :: all indices
~/ %fand
|= {nedl/(list) hstk/(list)}
=| i/@ud
=| fnd/(list @ud)
|- ^+ fnd
=+ [n=nedl h=hstk]
|-
?: |(?=(~ n) ?=(~ h))
2016-11-24 07:25:07 +03:00
(flop fnd)
?: =(i.n i.h)
?~ t.n
^$(i +(i), hstk +.hstk, fnd [i fnd])
$(n t.n, h t.h)
^$(i +(i), hstk +.hstk)
::
++ find :: first index
~/ %find
|= {nedl/(list) hstk/(list)}
=| i/@ud
|- ^- (unit @ud)
=+ [n=nedl h=hstk]
|-
?: |(?=(~ n) ?=(~ h))
2016-11-24 07:25:07 +03:00
~
?: =(i.n i.h)
?~ t.n
`i
$(n t.n, h t.h)
^$(i +(i), hstk +.hstk)
::
++ flop :: reverse
~/ %flop
|* a/(list)
=> .(a (homo a))
^+ a
=+ b=`_a`~
|-
?~ a b
$(a t.a, b [i.a b])
::
++ gulf :: range inclusive
|= {a/@ b/@}
2016-11-24 07:25:07 +03:00
^- (list @)
?:(=(a +(b)) ~ [a $(a +(a))])
::
++ homo :: homogenize
|* a/(list)
^+ =< $
|% +- $ ?:(*? ~ [i=(snag 0 a) t=$])
--
a
::
++ lent :: length
~/ %lent
|= a/(list)
^- @
=+ b=0
|-
?~ a b
$(a t.a, b +(b))
::
++ levy
~/ %levy :: all of
|* {a/(list) b/$-(* ?)}
|- ^- ?
?~ a &
?. (b i.a) |
$(a t.a)
::
++ lien :: some of
~/ %lien
|* {a/(list) b/$-(* ?)}
|- ^- ?
?~ a |
?: (b i.a) &
$(a t.a)
::
++ limo :: listify
|* a/*
^+ =< $
|% +- $ ?~(a ~ ?:(*? [i=-.a t=$] $(a +.a)))
--
a
::
++ murn :: maybe transform
~/ %murn
|* {a/(list) b/$-(* (unit))}
|-
?~ a ~
=+ c=(b i.a)
?~ c
$(a t.a)
[i=u.c t=$(a t.a)]
::
++ oust :: remove
~/ %oust
|* {{a/@ b/@} c/(list)}
(weld (scag +<-< c) (slag (add +<-< +<->) c))
2016-11-24 07:25:07 +03:00
::
++ reap :: replicate
~/ %reap
|* {a/@ b/*}
|- ^- (list _b)
?~ a ~
[b $(a (dec a))]
::
++ reel :: right fold
~/ %reel
2017-12-10 06:18:00 +03:00
|* {a/(list) b/_=>(~ |=({* *} +<+))}
2016-11-24 07:25:07 +03:00
|- ^+ ,.+<+.b
?~ a
+<+.b
(b i.a $(a t.a))
::
++ roll :: left fold
~/ %roll
2017-12-10 06:18:00 +03:00
|* {a/(list) b/_=>(~ |=({* *} +<+))}
2016-11-24 07:25:07 +03:00
|- ^+ ,.+<+.b
?~ a
+<+.b
$(a t.a, b b(+<+ (b i.a +<+.b)))
::
++ scag :: prefix
~/ %scag
|* {a/@ b/(list)}
|- ^+ b
?: |(?=(~ b) =(0 a)) ~
2016-11-24 07:25:07 +03:00
[i.b $(b t.b, a (dec a))]
::
++ skid :: separate
~/ %skid
|* {a/(list) b/$-(* ?)}
|- ^+ [p=a q=a]
?~ a [~ ~]
=+ c=$(a t.a)
?:((b i.a) [[i.a p.c] q.c] [p.c [i.a q.c]])
::
++ skim :: only
~/ %skim
|* {a/(list) b/$-(* ?)}
|-
^+ a
?~ a ~
?:((b i.a) [i.a $(a t.a)] $(a t.a))
::
++ skip :: except
~/ %skip
|* {a/(list) b/$-(* ?)}
|-
^+ a
?~ a ~
?:((b i.a) $(a t.a) [i.a $(a t.a)])
::
++ slag :: suffix
~/ %slag
|* {a/@ b/(list)}
|- ^+ b
?: =(0 a) b
?~ b ~
$(b t.b, a (dec a))
::
++ snag :: index
~/ %snag
|* {a/@ b/(list)}
|- ^+ ?>(?=(^ b) i.b)
?~ b
~_ leaf+"snag-fail"
!!
?: =(0 a) i.b
$(b t.b, a (dec a))
::
2017-12-10 05:44:54 +03:00
++ sort !. :: quicksort
2016-11-24 07:25:07 +03:00
~/ %sort
|* {a/(list) b/$-({* *} ?)}
2016-11-24 07:25:07 +03:00
=> .(a ^.(homo a))
|- ^+ a
?~ a ~
%+ weld
2017-12-10 05:44:54 +03:00
$(a (skim t.a |:(c=i.a (b c i.a))))
2016-11-24 07:25:07 +03:00
^+ t.a
2017-12-10 05:44:54 +03:00
[i.a $(a (skim t.a |:(c=i.a !(b c i.a))))]
2016-11-24 07:25:07 +03:00
::
++ spin
2017-12-10 06:18:00 +03:00
|* {a/(list) b/_=>(~ |=({* *} [** +<+])) c/*}
:: ?< ?=($-([_?<(?=(~ a) i.a) _c] [* _c]) b)
2016-11-24 07:25:07 +03:00
|-
?~ a
~
=+ v=(b i.a c)
[i=-.v t=$(a t.a, c +.v)]
::
++ spun
2017-12-10 06:18:00 +03:00
|* {a/(list) b/_=>(~ |=({* *} [** +<+]))}
2016-11-24 07:25:07 +03:00
=| c/_+<+.b
|-
?~ a
~
=+ v=(b i.a c)
[i=-.v t=$(a t.a, c +.v)]
::
++ swag :: slice
|* {{a/@ b/@} c/(list)}
(scag +<-> (slag +<-< c))
::
++ turn :: transform
~/ %turn
|* {a/(list) b/$-(* *)}
|-
?~ a ~
[i=(b i.a) t=$(a t.a)]
::
++ weld :: concatenate
~/ %weld
|* {a/(list) b/(list)}
=> .(a ^.(homo a), b ^.(homo b))
|- ^+ b
?~ a b
[i.a $(a t.a)]
::
++ welp :: faceless weld
=| {* *}
|%
+- $
?~ +<-
+<-(. +<+)
+<-(+ $(+<- +<->))
--
::
++ zing :: promote
=| *
|%
+- $
?~ +<
+<
(welp +<- $(+< +<+))
--
:: ::
:::: 2c: bit arithmetic ::
:: ::
::
++ bex :: binary exponent
~/ %bex
|= a/@
^- @
?: =(0 a) 1
(mul 2 $(a (dec a)))
::
++ can :: assemble
~/ %can
|= {a/bloq b/(list {p/@u q/@})}
^- @
?~ b 0
(add (end a p.i.b q.i.b) (lsh a p.i.b $(b t.b)))
::
++ cat :: concatenate
~/ %cat
|= {a/bloq b/@ c/@}
(add (lsh a (met a b) c) b)
::
++ cut :: slice
~/ %cut
|= {a/bloq {b/@u c/@u} d/@}
(end a c (rsh a b d))
::
++ end :: tail
~/ %end
|= {a/bloq b/@u c/@}
(mod c (bex (mul (bex a) b)))
::
++ fil :: fill bloqstream
|= {a/bloq b/@u c/@}
=+ n=0
=+ d=c
|- ^- @
?: =(n b)
(rsh a 1 d)
$(d (add c (lsh a 1 d)), n +(n))
::
++ lsh :: left-shift
~/ %lsh
|= {a/bloq b/@u c/@}
(mul (bex (mul (bex a) b)) c)
::
++ met :: measure
~/ %met
|= {a/bloq b/@}
^- @
=+ c=0
|-
?: =(0 b) c
$(b (rsh a 1 b), c +(c))
::
++ rap :: assemble nonzero
~/ %rap
2016-11-24 07:25:07 +03:00
|= {a/bloq b/(list @)}
^- @
=+ ~ ::REMOVEME jet dashboard bump
2016-11-24 07:25:07 +03:00
?~ b 0
(cat a i.b $(b t.b))
::
++ rep :: assemble single
~/ %rep
|= {a/bloq b/(list @)}
^- @
=+ c=0
|-
?~ b 0
(add (lsh a c (end a 1 i.b)) $(c +(c), b t.b))
::
++ rip :: disassemble
~/ %rip
|= {a/bloq b/@}
^- (list @)
?: =(0 b) ~
[(end a 1 b) $(b (rsh a 1 b))]
::
++ rsh :: right-shift
~/ %rsh
|= {a/bloq b/@u c/@}
(div c (bex (mul (bex a) b)))
::
++ swp |=({a/bloq b/@} (rep a (flop (rip a b)))) :: reverse bloq order
++ xeb :: binary logarithm
~/ %xeb
|= a/@
^- @
(met 0 a)
::
++ fe :: modulo bloq
|_ a/bloq
++ dif :: difference
|=({b/@ c/@} (sit (sub (add out (sit b)) (sit c))))
++ inv |=(b/@ (sub (dec out) (sit b))) :: inverse
++ net |= b/@ ^- @ :: flip byte endianness
=> .(b (sit b))
?: (lte a 3)
b
=+ c=(dec a)
%+ con
(lsh c 1 $(a c, b (cut c [0 1] b)))
$(a c, b (cut c [1 1] b))
++ out (bex (bex a)) :: mod value
++ rol |= {b/bloq c/@ d/@} ^- @ :: roll left
=+ e=(sit d)
=+ f=(bex (sub a b))
=+ g=(mod c f)
(sit (con (lsh b g e) (rsh b (sub f g) e)))
++ ror |= {b/bloq c/@ d/@} ^- @ :: roll right
=+ e=(sit d)
=+ f=(bex (sub a b))
=+ g=(mod c f)
(sit (con (rsh b g e) (lsh b (sub f g) e)))
++ sum |=({b/@ c/@} (sit (add b c))) :: wrapping add
++ sit |=(b/@ (end a 1 b)) :: enforce modulo
--
:: ::
:::: 2d: bit logic ::
:: ::
::
++ con :: binary or
~/ %con
|= {a/@ b/@}
=+ [c=0 d=0]
|- ^- @
?: ?&(=(0 a) =(0 b)) d
%= $
a (rsh 0 1 a)
b (rsh 0 1 b)
c +(c)
d %+ add d
%^ lsh 0 c
?& =(0 (end 0 1 a))
=(0 (end 0 1 b))
==
==
::
++ dis :: binary and
~/ %dis
|= {a/@ b/@}
=| {c/@ d/@}
|- ^- @
?: ?|(=(0 a) =(0 b)) d
%= $
a (rsh 0 1 a)
b (rsh 0 1 b)
c +(c)
d %+ add d
%^ lsh 0 c
?| =(0 (end 0 1 a))
=(0 (end 0 1 b))
==
==
::
++ mix :: binary xor
~/ %mix
|= {a/@ b/@}
^- @
=+ [c=0 d=0]
|-
?: ?&(=(0 a) =(0 b)) d
%= $
a (rsh 0 1 a)
b (rsh 0 1 b)
c +(c)
d (add d (lsh 0 c =((end 0 1 a) (end 0 1 b))))
==
::
++ not |= {a/bloq b/@ c/@} :: binary not (sized)
(mix c (dec (bex (mul b (bex a)))))
:: ::
:::: 2e: insecure hashing ::
:: ::
::
++ fnv |=(a/@ (end 5 1 (mul 16.777.619 a))) :: FNV scrambler
::
++ muk :: standard murmur3
~% %muk ..muk ~
=+ ~(. fe 5)
|= {syd/@ len/@ key/@}
?> &((lte (met 5 syd) 1) (lte (met 0 len) 31))
=/ pad (sub len (met 3 key))
=/ data (weld (rip 3 key) (reap pad 0))
=/ nblocks (div len 4) :: intentionally off-by-one
=/ h1 syd
=+ [c1=0xcc9e.2d51 c2=0x1b87.3593]
=/ blocks (rip 5 key)
=/ i nblocks
=. h1 =/ hi h1 |-
?: =(0 i) hi
=/ k1 (snag (sub nblocks i) blocks) :: negative array index
=. k1 (sit (mul k1 c1))
=. k1 (rol 0 15 k1)
=. k1 (sit (mul k1 c2))
=. hi (mix hi k1)
=. hi (rol 0 13 hi)
=. hi (sum (sit (mul hi 5)) 0xe654.6b64)
$(i (dec i))
=/ tail (slag (mul 4 nblocks) data)
=/ k1 0
=/ tlen (dis len 3)
=. h1
?+ tlen h1 :: fallthrough switch
$3 =. k1 (mix k1 (lsh 0 16 (snag 2 tail)))
=. k1 (mix k1 (lsh 0 8 (snag 1 tail)))
=. k1 (mix k1 (snag 0 tail))
=. k1 (sit (mul k1 c1))
=. k1 (rol 0 15 k1)
=. k1 (sit (mul k1 c2))
(mix h1 k1)
$2 =. k1 (mix k1 (lsh 0 8 (snag 1 tail)))
=. k1 (mix k1 (snag 0 tail))
=. k1 (sit (mul k1 c1))
=. k1 (rol 0 15 k1)
=. k1 (sit (mul k1 c2))
(mix h1 k1)
$1 =. k1 (mix k1 (snag 0 tail))
=. k1 (sit (mul k1 c1))
=. k1 (rol 0 15 k1)
=. k1 (sit (mul k1 c2))
(mix h1 k1)
==
=. h1 (mix h1 len)
|^ (fmix32 h1)
++ fmix32
|= h/@
=. h (mix h (rsh 0 16 h))
=. h (sit (mul h 0x85eb.ca6b))
=. h (mix h (rsh 0 13 h))
=. h (sit (mul h 0xc2b2.ae35))
=. h (mix h (rsh 0 16 h))
h
--
::
++ mum :: mug with murmur3
~/ %mum
|= a/*
|^ (trim ?@(a a (mix $(a -.a) (mix 0x7fff.ffff $(a +.a)))))
++ trim :: 31-bit nonzero
|= key/@
=+ syd=0xcafe.babe
|- ^- @
=+ haz=(muk syd (met 3 key) key)
=+ ham=(mix (rsh 0 31 haz) (end 0 31 haz))
?.(=(0 ham) ham $(syd +(syd)))
--
::
++ mug :: 31bit nonzero FNV1a
~/ %mug
|= a/*
?^ a
=+ b=[p=$(a -.a) q=$(a +.a)]
|- ^- @
=+ c=(fnv (mix p.b (fnv q.b)))
=+ d=(mix (rsh 0 31 c) (end 0 31 c))
?. =(0 d) d
$(q.b +(q.b))
=+ b=2.166.136.261
|- ^- @
=+ c=b
=+ [d=0 e=(met 3 a)]
|- ^- @
?: =(d e)
=+ f=(mix (rsh 0 31 c) (end 0 31 c))
?. =(0 f) f
^$(b +(b))
$(c (fnv (mix c (cut 3 [d 1] a))), d +(d))
:: ::
:::: 2f: noun ordering ::
:: ::
:: aor, dor, gor, hor, lor, vor ::
::
++ aor :: a-order
~/ %aor
|= {a/* b/*}
^- ?
?: =(a b) &
?. ?=(@ a)
?: ?=(@ b) |
?: =(-.a -.b)
$(a +.a, b +.b)
$(a -.a, b -.b)
?. ?=(@ b) &
|-
=+ [c=(end 3 1 a) d=(end 3 1 b)]
?: =(c d)
$(a (rsh 3 1 a), b (rsh 3 1 b))
(lth c d)
::
++ dor :: d-order
~/ %dor
|= {a/* b/*}
^- ?
?: =(a b) &
?. ?=(@ a)
?: ?=(@ b) |
?: =(-.a -.b)
$(a +.a, b +.b)
$(a -.a, b -.b)
?. ?=(@ b) &
(lth a b)
::
++ gor :: g-order
~/ %gor
|= {a/* b/*}
^- ?
=+ [c=(mug a) d=(mug b)]
?: =(c d)
(dor a b)
(lth c d)
::
++ hor :: h-order
~/ %hor
|= {a/* b/*}
^- ?
?: ?=(@ a)
?. ?=(@ b) &
(gor a b)
?: ?=(@ b) |
?: =(-.a -.b)
(gor +.a +.b)
(gor -.a -.b)
::
++ lor :: l-order
~/ %lor
|= {a/* b/*}
^- ?
?: =(a b) &
?@ a
?^ b &
(lth a b)
?: =(-.a -.b)
$(a +.a, b +.b)
$(a -.a, b -.b)
::
++ vor :: v-order
~/ %vor
|= {a/* b/*}
^- ?
=+ [c=(mug (mug a)) d=(mug (mug b))]
?: =(c d)
(dor a b)
(lth c d)
:: ::
:::: ::
:: 2g: unsigned powers ::
:: ::
::
++ pow :: unsigned exponent
~/ %pow
|= {a/@ b/@}
?: =(b 0) 1
|- ?: =(b 1) a
=+ c=$(b (div b 2))
=+ d=(mul c c)
?~ (dis b 1) d (mul d a)
::
++ sqt :: unsigned sqrt/rem
~/ %sqt
|= a/@ ^- {p/@ q/@}
?~ a [0 0]
=+ [q=(div (dec (xeb a)) 2) r=0]
=- [-.b (sub a +.b)]
^= b |-
=+ s=(add r (bex q))
=+ t=(mul s s)
?: =(q 0)
?:((lte t a) [s t] [r (mul r r)])
?: (lte t a)
$(r s, q (dec q))
2016-11-24 07:25:07 +03:00
$(q (dec q))
:: ::
:::: ::
:: ::
:: 2h: set logic ::
:: ::
::
++ in :: set engine
~/ %in
2016-12-09 02:10:40 +03:00
|_ a/(tree) :: (set)
2016-11-24 07:25:07 +03:00
+- all :: logical AND
~/ %all
|* b/$-(* ?)
|- ^- ?
?~ a
&
?&((b n.a) $(a l.a) $(a r.a))
::
+- any :: logical OR
~/ %any
|* b/$-(* ?)
|- ^- ?
?~ a
|
?|((b n.a) $(a l.a) $(a r.a))
::
+- apt :: check correctness
=| {l/(unit) r/(unit)}
|- ^- ?
?~ a &
?& ?~(l & (hor n.a u.l))
?~(r & (hor u.r n.a))
?~(l.a & ?&((vor n.a n.l.a) $(a l.a, l `n.a)))
?~(r.a & ?&((vor n.a n.r.a) $(a r.a, r `n.a)))
==
::
+- bif :: splits a by b
~/ %bif
|* b/*
^+ [l=a r=a]
=< [+< +>]
|- ^+ a
?~ a
[b ~ ~]
?: =(b n.a)
a
?: (hor b n.a)
=+ c=$(a l.a)
?> ?=(^ c)
[n.c l.c [n.a r.c r.a]]
=+ c=$(a r.a)
?> ?=(^ c)
[n.c [n.a l.a l.c] r.c]
::
+- del :: b without any a
~/ %del
|* b/*
|- ^+ a
?~ a
~
?. =(b n.a)
?: (hor b n.a)
[n.a $(a l.a) r.a]
[n.a l.a $(a r.a)]
|- ^- {$?(~ _a)}
2016-11-24 07:25:07 +03:00
?~ l.a r.a
?~ r.a l.a
?: (vor n.l.a n.r.a)
[n.l.a l.l.a $(l.a r.l.a)]
[n.r.a $(r.a l.r.a) r.r.a]
::
+- dif :: difference
~/ %dif
2017-12-10 15:37:33 +03:00
=+ b=a
|%
+- $
2017-12-10 22:08:12 +03:00
|- ^+ a
2017-12-10 15:37:33 +03:00
?~ b
a
=+ c=(bif n.b)
?> ?=(^ c)
=+ d=$(a l.c, b l.b)
=+ e=$(a r.c, b r.b)
|- ^- {$?(~ _a)}
2017-12-10 15:37:33 +03:00
?~ d e
?~ e d
?: (vor n.d n.e)
[n.d l.d $(d r.d)]
[n.e $(e l.e) r.e]
--
2016-11-24 07:25:07 +03:00
::
+- dig :: axis of a in b
|= b/*
=+ c=1
|- ^- (unit @)
?~ a ~
?: =(b n.a) [~ u=(peg c 2)]
?: (hor b n.a)
$(a l.a, c (peg c 6))
$(a r.a, c (peg c 7))
::
+- gas :: concatenate
~/ %gas
|= b/(list _?>(?=(^ a) n.a))
|- ^+ a
?~ b
a
$(b t.b, a (put i.b))
::
+- has :: b exists in a check
~/ %has
|* b/*
|- ^- ?
?~ a
|
?: =(b n.a)
&
?: (hor b n.a)
$(a l.a)
$(a r.a)
::
+- int :: intersection
~/ %int
2017-12-10 15:37:33 +03:00
=+ b=a
|%
+- $
|- ^+ a
?~ b
~
?~ a
~
?. (vor n.a n.b)
$(a b, b a)
?: =(n.b n.a)
[n.a $(a l.a, b l.b) $(a r.a, b r.b)]
?: (hor n.b n.a)
%- uni(a $(a l.a, b [n.b l.b ~])) $(b r.b)
%- uni(a $(a r.a, b [n.b ~ r.b])) $(b l.b)
--
2016-11-24 07:25:07 +03:00
::
+- put :: puts b in a, sorted
~/ %put
|* b/*
|- ^+ a
?~ a
[b ~ ~]
?: =(b n.a)
a
?: (hor b n.a)
=+ c=$(a l.a)
?> ?=(^ c)
?: (vor n.a n.c)
[n.a c r.a]
[n.c l.c [n.a r.c r.a]]
=+ c=$(a r.a)
?> ?=(^ c)
?: (vor n.a n.c)
[n.a l.a c]
[n.c [n.a l.a l.c] r.c]
::
+- rep :: replace by product
2017-12-10 15:37:33 +03:00
|* b/_=>(~ |=({* *} +<+))
2016-11-24 07:25:07 +03:00
|-
?~ a +<+.b
$(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
::
+- run :: apply gate to values
~/ %run
|* b/gate
2018-02-15 04:39:08 +03:00
=+ c=`(set _?>(?=(^ a) (b n.a)))`~
2016-11-24 07:25:07 +03:00
|- ?~ a c
=. c (~(put in c) (b n.a))
=. c $(a l.a, c c)
$(a r.a, c c)
::
+- tap :: convert to list
=< $
2016-11-24 07:25:07 +03:00
~/ %tap
2018-02-15 04:39:08 +03:00
=+ b=`(list _?>(?=(^ a) n.a))`~
|. ^+ b
2016-11-24 07:25:07 +03:00
?~ a
b
$(a r.a, b [n.a $(a l.a)])
::
+- uni :: union
~/ %uni
2017-12-10 15:37:33 +03:00
=+ b=a
|%
+- $
?: =(a b) a
|- ^+ a
?~ b
a
?~ a
b
?: (vor n.a n.b)
?: =(n.b n.a)
[n.b $(a l.a, b l.b) $(a r.a, b r.b)]
?: (hor n.b n.a)
$(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b)
$(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b)
?: =(n.a n.b)
[n.b $(b l.b, a l.a) $(b r.b, a r.a)]
?: (hor n.a n.b)
$(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a)
$(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a)
--
2016-11-24 07:25:07 +03:00
::
+- wyt :: size of set
2016-11-09 08:03:58 +03:00
=< $
~% %wyt + ~
|. ^- @
2016-11-24 07:25:07 +03:00
?~(a 0 +((add $(a l.a) $(a r.a))))
--
:: ::
:::: 2i: map logic ::
:: ::
::
++ by :: map engine
~/ %by
2016-12-09 02:10:40 +03:00
=| a/(tree (pair)) :: (map)
2016-11-24 07:25:07 +03:00
=* node ?>(?=(^ a) n.a)
|%
+- all :: logical AND
~/ %all
|* b/$-(* ?)
|- ^- ?
?~ a
&
?&((b q.n.a) $(a l.a) $(a r.a))
::
+- any :: logical OR
~/ %any
|* b/$-(* ?)
|- ^- ?
?~ a
|
?|((b q.n.a) $(a l.a) $(a r.a))
::
+- bif :: splits a by b
~/ %bif
|* {b/* c/*}
^+ [l=a r=a]
=< [+< +>]
|- ^+ a
?~ a
[[b c] ~ ~]
?: =(b p.n.a)
?: =(c q.n.a)
a
[[b c] l.a r.a]
?: (gor b p.n.a)
=+ d=$(a l.a)
?> ?=(^ d)
[n.d l.d [n.a r.d r.a]]
=+ d=$(a r.a)
?> ?=(^ d)
[n.d [n.a l.a l.d] r.d]
::
+- del :: delete at key b
~/ %del
|* b/*
|- ^+ a
?~ a
~
?. =(b p.n.a)
?: (gor b p.n.a)
[n.a $(a l.a) r.a]
[n.a l.a $(a r.a)]
|- ^- {$?(~ _a)}
2016-11-24 07:25:07 +03:00
?~ l.a r.a
?~ r.a l.a
?: (vor p.n.l.a p.n.r.a)
[n.l.a l.l.a $(l.a r.l.a)]
[n.r.a $(r.a l.r.a) r.r.a]
::
+- dif :: difference
~/ %dif
2017-12-10 15:37:33 +03:00
=+ b=a
|%
+- $
|- ^+ a
?~ b
a
=+ c=(bif p.n.b q.n.b)
?> ?=(^ c)
=+ d=$(a l.c, b l.b)
=+ e=$(a r.c, b r.b)
|- ^- {$?(~ _a)}
2017-12-10 15:37:33 +03:00
?~ d e
?~ e d
?: (vor p.n.d p.n.e)
[n.d l.d $(d r.d)]
[n.e $(e l.e) r.e]
--
2016-11-24 07:25:07 +03:00
::
+- dig :: axis of b key
|= b/*
=+ c=1
|- ^- (unit @)
?~ a ~
?: =(b p.n.a) [~ u=(peg c 2)]
?: (gor b p.n.a)
$(a l.a, c (peg c 6))
$(a r.a, c (peg c 7))
::
2016-12-08 21:34:52 +03:00
+- apt :: check correctness
2016-11-24 07:25:07 +03:00
=| {l/(unit) r/(unit)}
|- ^- ?
?~ a &
?& ?~(l & (gor p.n.a u.l))
?~(r & (gor u.r p.n.a))
?~(l.a & ?&((vor p.n.a p.n.l.a) $(a l.a, l `p.n.a)))
?~(r.a & ?&((vor p.n.a p.n.r.a) $(a r.a, r `p.n.a)))
==
::
+- gas :: concatenate
~/ %gas
|* b/(list {p/* q/*})
=> .(b `(list _?>(?=(^ a) n.a))`b)
|- ^+ a
?~ b
a
$(b t.b, a (put p.i.b q.i.b))
::
+- get :: grab value by key
~/ %get
|= b/*
^- {$@(~ {~ u/_?>(?=(^ a) q.n.a)})}
2017-11-15 01:55:05 +03:00
=+ 42
2016-11-24 07:25:07 +03:00
?~ a
~
?: =(b p.n.a)
[~ u=q.n.a]
?: (gor b p.n.a)
$(a l.a)
$(a r.a)
::
+- got
|* b/*
(need (get b))
::
+- has :: key existence check
~/ %has
|* b/*
!=(~ (get b))
::
+- int :: intersection
~/ %int
2017-12-10 15:37:33 +03:00
=+ b=a
|%
+- $
|- ^+ a
?~ b
~
?~ a
~
?: (vor p.n.a p.n.b)
?: =(p.n.b p.n.a)
[n.b $(a l.a, b l.b) $(a r.a, b r.b)]
?: (gor p.n.b p.n.a)
%- uni(a $(a l.a, b [n.b l.b ~])) $(b r.b)
%- uni(a $(a r.a, b [n.b ~ r.b])) $(b l.b)
?: =(p.n.a p.n.b)
[n.b $(b l.b, a l.a) $(b r.b, a r.a)]
?: (gor p.n.a p.n.b)
%- uni(a $(b l.b, a [n.a l.a ~])) $(a r.a)
%- uni(a $(b r.b, a [n.a ~ r.a])) $(a l.a)
--
2016-11-24 07:25:07 +03:00
::
+- mar :: add with validation
2017-12-10 15:37:33 +03:00
|* {b/* c/(unit *)}
2016-11-24 07:25:07 +03:00
?~ c
(del b)
(put b u.c)
::
+- put :: adds key-value pair
~/ %put
|* {b/* c/*}
|- ^+ a
?~ a
[[b c] ~ ~]
?: =(b p.n.a)
?: =(c q.n.a)
a
[[b c] l.a r.a]
?: (gor b p.n.a)
=+ d=$(a l.a)
?> ?=(^ d)
?: (vor p.n.a p.n.d)
[n.a d r.a]
[n.d l.d [n.a r.d r.a]]
=+ d=$(a r.a)
?> ?=(^ d)
?: (vor p.n.a p.n.d)
[n.a l.a d]
[n.d [n.a l.a l.d] r.d]
::
+- rep :: replace by product
2017-12-10 15:37:33 +03:00
|* b/_=>(~ |=({* *} +<+))
2016-11-24 07:25:07 +03:00
|-
?~ a +<+.b
$(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b)))
::
+- rib :: transform + product
|* {b/* c/$-(* *)}
|- ^+ [b a]
?~ a [b ~]
=+ d=(c n.a b)
=. n.a +.d
=+ e=$(a l.a, b -.d)
=+ f=$(a r.a, b -.e)
[-.f [n.a +.e +.f]]
::
+- run :: apply gate to values
|* b/$-(* *)
|-
?~ a a
[n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)]
::
+- rut :: apply gate to nodes
|* b/gate
|-
?~ a a
[n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)]
::
+- tap :: listify pairs
=< $
2016-11-24 07:25:07 +03:00
~/ %tap
2018-02-15 04:39:08 +03:00
=+ b=`(list _?>(?=(^ a) n.a))`~
|. ^+ b
2016-11-24 07:25:07 +03:00
?~ a
b
$(a r.a, b [n.a $(a l.a)])
::
+- uni :: union, merge
~/ %uni
2017-12-10 15:37:33 +03:00
=+ b=a
|%
+- $
|- ^+ a
?~ b
a
?~ a
b
?: (vor p.n.a p.n.b)
?: =(p.n.b p.n.a)
[n.b $(a l.a, b l.b) $(a r.a, b r.b)]
?: (gor p.n.b p.n.a)
$(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b)
$(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b)
?: =(p.n.a p.n.b)
[n.b $(b l.b, a l.a) $(b r.b, a r.a)]
?: (gor p.n.a p.n.b)
$(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a)
$(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a)
--
2016-11-24 07:25:07 +03:00
::
+- uno :: general union
2017-12-10 15:37:33 +03:00
=+ b=a
|%
+- $
|* meg/$-({* * *} *)
|- ^+ a
?~ b
a
?~ a
b
?: (vor p.n.a p.n.b)
?: =(p.n.b p.n.a)
[n.b $(a l.a, b l.b) $(a r.a, b r.b)]
?: (gor p.n.b p.n.a)
$(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b)
$(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b)
?: =(p.n.a p.n.b)
:+ [p.n.a (meg p.n.a q.n.a q.n.b)]
$(b l.b, a l.a)
$(b r.b, a r.a)
?: (gor p.n.a p.n.b)
$(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a)
$(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a)
--
2016-11-24 07:25:07 +03:00
::
::
+- urn :: apply gate to nodes
|* b/$-({* *} *)
|-
?~ a ~
[n=[p=p.n.a q=(b p.n.a q.n.a)] l=$(a l.a) r=$(a r.a)]
::
+- wyt :: depth of map
|- ^- @
?~(a 0 +((add $(a l.a) $(a r.a))))
::
+- key :: set of keys
2018-02-15 04:39:08 +03:00
=+ b=`(set _?>(?=(^ a) p.n.a))`~
2016-11-24 07:25:07 +03:00
|- ^+ b
?~ a b
$(a r.a, b $(a l.a, b (~(put in b) p.n.a)))
::
2016-11-24 07:25:07 +03:00
+- val :: list of vals
2018-02-15 04:39:08 +03:00
=+ b=`(list _?>(?=(^ a) q.n.a))`~
2016-11-24 07:25:07 +03:00
|- ^+ b
?~ a b
$(a r.a, b [q.n.a $(a l.a)])
--
:: ::
:::: 2j: jar and jug logic ::
:: ::
::
++ ja :: jar engine
2016-12-09 02:10:40 +03:00
|_ a/(tree (pair * (list))) :: (jar)
2016-11-24 07:25:07 +03:00
+- get :: gets list by key
|* b/*
=+ c=(~(get by a) b)
?~(c ~ u.c)
::
+- add :: adds key-list pair
|* {b/* c/*}
=+ d=(get b)
(~(put by a) b [c d])
--
++ ju :: jug engine
2016-12-09 02:10:40 +03:00
|_ a/(tree (pair * (tree))) :: (jug)
2016-11-24 07:25:07 +03:00
+- del :: del key-set pair
|* {b/* c/*}
^+ a
=+ d=(get b)
=+ e=(~(del in d) c)
?~ e
(~(del by a) b)
(~(put by a) b e)
::
+- gas :: concatenate
|* b/(list {p/* q/*})
=> .(b `(list _?>(?=({{* ^} ^} a) [p=p q=n.q]:n.a))`b)
|- ^+ a
?~ b
a
$(b t.b, a (put p.i.b q.i.b))
::
+- get :: gets set by key
|* b/*
=+ c=(~(get by a) b)
?~(c ~ u.c)
::
+- has :: existence check
|* {b/* c/*}
^- ?
(~(has in (get b)) c)
::
+- put :: add key-set pair
|* {b/* c/*}
^+ a
=+ d=(get b)
(~(put by a) b (~(put in d) c))
--
:: ::
:::: 2k: queue logic ::
:: ::
::
++ to :: queue engine
2016-12-09 02:10:40 +03:00
|_ a/(tree) :: (qeu)
2016-11-24 07:25:07 +03:00
+- bal
|- ^+ a
?~ a ~
?. |(?=(~ l.a) (vor n.a n.l.a))
2016-11-24 07:25:07 +03:00
$(a [n.l.a l.l.a $(a [n.a r.l.a r.a])])
?. |(?=(~ r.a) (vor n.a n.r.a))
2016-11-24 07:25:07 +03:00
$(a [n.r.a $(a [n.a l.a l.r.a]) r.r.a])
a
::
+- dep :: max depth of queue
|- ^- @
?~ a 0
+((max $(a l.a) $(a r.a)))
::
+- gas :: insert list to que
|= b/(list _?>(?=(^ a) n.a))
|- ^+ a
?~(b a $(b t.b, a (put i.b)))
::
+- get :: head-rest pair
|- ^+ ?>(?=(^ a) [p=n.a q=*(tree _n.a)])
?~ a
!!
?~ r.a
[n.a l.a]
=+ b=$(a r.a)
:- p.b
?: |(?=(~ q.b) (vor n.a n.q.b))
2016-11-24 07:25:07 +03:00
[n.a l.a q.b]
[n.q.b [n.a l.a l.q.b] r.q.b]
::
+- nip :: remove root
|- ^+ a
?~ a ~
?~ l.a r.a
?~ r.a l.a
?: (vor n.l.a n.r.a)
[n.l.a l.l.a $(l.a r.l.a)]
[n.r.a $(r.a l.r.a) r.r.a]
::
+- nap :: removes head
?> ?=(^ a)
?: =(~ l.a) r.a
=+ b=get(a l.a)
bal(a ^+(a [p.b q.b r.a]))
::
+- put :: insert new tail
|* b/*
|- ^+ a
?~ a
[b ~ ~]
bal(a a(l $(a l.a)))
::
+- tap :: adds list to end
2018-02-15 04:39:08 +03:00
=+ b=`(list _?>(?=(^ a) n.a))`~
|- ^+ b
2016-11-24 07:25:07 +03:00
=+ 0 :: hack for jet match
?~ a
b
$(a r.a, b [n.a $(a l.a)])
::
+- top :: produces head
|- ^- (unit _?>(?=(^ a) n.a))
?~ a ~
?~(r.a [~ n.a] $(a r.a))
--
:: ::
:::: 2l: container from container ::
:: ::
::
++ malt :: map from list
|* a/(list)
2016-11-24 07:25:07 +03:00
(molt `(list {p/_-<.a q/_->.a})`a)
::
++ molt :: map from pair list
2016-12-09 02:10:40 +03:00
|* a/(list (pair)) :: ^- =,(i.-.a (map _p _q))
2016-11-24 07:25:07 +03:00
(~(gas by `(tree {p/_p.i.-.a q/_q.i.-.a})`~) a)
::
++ silt :: set from list
2016-12-09 02:10:40 +03:00
|* a/(list) :: ^- (set _i.-.a)
2016-11-24 07:25:07 +03:00
=+ b=*(tree _?>(?=(^ a) i.a))
(~(gas in b) a)
:: ::
:::: 2m: container from noun ::
:: ::
::
++ ly :: list from raw noun
2017-09-08 02:47:49 +03:00
le:nl
2016-11-24 07:25:07 +03:00
::
++ my :: map from raw noun
2017-09-08 02:47:49 +03:00
my:nl
2016-11-24 07:25:07 +03:00
::
++ sy :: set from raw noun
2017-09-08 02:47:49 +03:00
si:nl
2017-09-07 01:17:37 +03:00
::
++ nl
|%
:: ::
++ le :: construct list
|* a/(list)
^+ =< $
|% +- $ ?:(*? ~ [i=(snag 0 a) t=$])
--
a
:: ::
++ my :: construct map
|* a/(list (pair))
=> .(a ^+((le a) a))
(~(gas by `(map _p.i.-.a _q.i.-.a)`~) a)
:: ::
++ mz :: construct map
|* a/(list (pair))
=> .(a ^+((le a) a))
(~(gas by ~) a)
:: ::
++ si :: construct set
|* a/(list)
=> .(a ^+((le a) a))
(~(gas in `(set _i.-.a)`~) a)
:: ::
++ snag :: index
|* {a/@ b/(list)}
?~ b
~_ leaf+"snag-fail"
!!
?: =(0 a) i.b
$(b t.b, a (dec a))
:: ::
++ weld :: concatenate
|* {a/(list) b/(list)}
=> .(a ^+((le a) a), b ^+((le b) b))
=+ 42
|-
?~ a b
[i=i.a t=$(a t.a)]
--
2016-11-24 07:25:07 +03:00
::
:::: 2p: serialization ::
:: ::
::
++ cue :: unpack
~/ %cue
|= a/@
^- *
=+ b=0
=+ m=`(map @ *)`~
=< q
|- ^- {p/@ q/* r/(map @ *)}
?: =(0 (cut 0 [b 1] a))
=+ c=(rub +(b) a)
[+(p.c) q.c (~(put by m) b q.c)]
=+ c=(add 2 b)
?: =(0 (cut 0 [+(b) 1] a))
=+ u=$(b c)
=+ v=$(b (add p.u c), m r.u)
=+ w=[q.u q.v]
[(add 2 (add p.u p.v)) w (~(put by r.v) b w)]
=+ d=(rub c a)
[(add 2 p.d) (need (~(get by m) q.d)) m]
::
++ jam :: pack
~/ %jam
|= a/*
^- @
=+ b=0
=+ m=`(map * @)`~
=< q
|- ^- {p/@ q/@ r/(map * @)}
=+ c=(~(get by m) a)
?~ c
=> .(m (~(put by m) a b))
?: ?=(@ a)
=+ d=(mat a)
[(add 1 p.d) (lsh 0 1 q.d) m]
=> .(b (add 2 b))
=+ d=$(a -.a)
=+ e=$(a +.a, b (add b p.d), m r.d)
[(add 2 (add p.d p.e)) (mix 1 (lsh 0 2 (cat 0 q.d q.e))) r.e]
?: ?&(?=(@ a) (lte (met 0 a) (met 0 u.c)))
=+ d=(mat a)
[(add 1 p.d) (lsh 0 1 q.d) m]
=+ d=(mat u.c)
[(add 2 p.d) (mix 3 (lsh 0 2 q.d)) m]
::
++ mat :: length-encode
~/ %mat
|= a/@
^- {p/@ q/@}
?: =(0 a)
[1 1]
=+ b=(met 0 a)
=+ c=(met 0 b)
:- (add (add c c) b)
(cat 0 (bex c) (mix (end 0 (dec c) b) (lsh 0 (dec c) a)))
::
++ rub :: length-decode
~/ %rub
|= {a/@ b/@}
^- {p/@ q/@}
=+ ^= c
=+ [c=0 m=(met 0 b)]
|- ?< (gth c m)
?. =(0 (cut 0 [(add a c) 1] b))
c
$(c +(c))
?: =(0 c)
[1 0]
=+ d=(add a +(c))
=+ e=(add (bex (dec c)) (cut 0 [d (dec c)] b))
[(add (add c c) e) (cut 0 [(add d (dec c)) e] b)]
2017-12-12 05:05:48 +03:00
::
++ fn :: float, infinity, or NaN
:: s=sign, e=exponent, a=arithmetic form
:: (-1)^s * a * 2^e
$% {$f s/? e/@s a/@u}
{$i s/?}
{$n ~}
2017-12-12 05:05:48 +03:00
==
::
++ dn :: decimal float, infinity, or NaN
:: (-1)^s * a * 10^e
$% {$d s/? e/@s a/@u}
{$i s/?}
{$n ~}
2017-12-12 05:05:48 +03:00
==
::
++ rn :: parsed decimal float
::
$% {$d a/? b/{c/@ {d/@ e/@} f/? i/@}}
{$i a/?}
{$n ~}
2017-12-12 05:05:48 +03:00
==
2016-11-24 07:25:07 +03:00
-- =>
:: ::
:::: 3: layer three ::
:: ::
:: 3a: signed and modular ints ::
:: 3b: floating point ::
:: 3c: urbit time ::
:: 3d: SHA hash family ::
:: 3e: (reserved) ::
:: 3f: scrambling ::
:: 3g: molds and mold builders ::
:: ::
~% %tri + ~
|%
::
:::: 3a: signed and modular ints ::
:: ::
::
++ egcd :: schneier's egcd
|= {a/@ b/@}
=+ si
=+ [c=(sun a) d=(sun b)]
=+ [u=[c=(sun 1) d=--0] v=[c=--0 d=(sun 1)]]
|- ^- {d/@ u/@s v/@s}
?: =(--0 c)
[(abs d) d.u d.v]
:: ?> ?& =(c (sum (pro (sun a) c.u) (pro (sun b) c.v)))
:: =(d (sum (pro (sun a) d.u) (pro (sun b) d.v)))
:: ==
=+ q=(fra d c)
%= $
c (dif d (pro q c))
d c
u [(dif d.u (pro q c.u)) c.u]
v [(dif d.v (pro q c.v)) c.v]
==
::
++ fo :: modulo prime
2017-04-13 04:28:26 +03:00
^?
2016-11-24 07:25:07 +03:00
|_ a/@
++ dif
|= {b/@ c/@}
(sit (sub (add a b) (sit c)))
::
++ exp
|= {b/@ c/@}
?: =(0 b)
1
=+ d=$(b (rsh 0 1 b))
=+ e=(pro d d)
?:(=(0 (end 0 1 b)) e (pro c e))
::
++ fra
|= {b/@ c/@}
(pro b (inv c))
::
++ inv
|= b/@
=+ c=(dul:si u:(egcd b a) a)
c
::
++ pro
|= {b/@ c/@}
(sit (mul b c))
::
++ sit
|= b/@
(mod b a)
::
++ sum
|= {b/@ c/@}
(sit (add b c))
--
::
++ si :: signed integer
2017-04-13 04:28:26 +03:00
^?
2016-11-24 07:25:07 +03:00
|%
++ abs |=(a/@s (add (end 0 1 a) (rsh 0 1 a))) :: absolute value
++ dif |= {a/@s b/@s} :: subtraction
(sum a (new !(syn b) (abs b)))
++ dul |= {a/@s b/@} :: modulus
=+(c=(old a) ?:(-.c (mod +.c b) (sub b +.c)))
++ fra |= {a/@s b/@s} :: divide
(new =(0 (mix (syn a) (syn b))) (div (abs a) (abs b)))
++ new |= {a/? b/@} :: [sign value] to @s
`@s`?:(a (mul 2 b) ?:(=(0 b) 0 +((mul 2 (dec b)))))
++ old |=(a/@s [(syn a) (abs a)]) :: [sign value]
++ pro |= {a/@s b/@s} :: multiplication
(new =(0 (mix (syn a) (syn b))) (mul (abs a) (abs b)))
++ rem |=({a/@s b/@s} (dif a (pro b (fra a b)))) :: remainder
++ sum |= {a/@s b/@s} :: addition
=+ [c=(old a) d=(old b)]
?: -.c
?: -.d
(new & (add +.c +.d))
?: (gte +.c +.d)
(new & (sub +.c +.d))
(new | (sub +.d +.c))
?: -.d
?: (gte +.c +.d)
(new | (sub +.c +.d))
(new & (sub +.d +.c))
(new | (add +.c +.d))
++ sun |=(a/@u (mul 2 a)) :: @u to @s
++ syn |=(a/@s =(0 (end 0 1 a))) :: sign test
++ cmp |= {a/@s b/@s} :: compare
^- @s
?: =(a b)
--0
?: (syn a)
?: (syn b)
?: (gth a b)
--1
-1
--1
?: (syn b)
-1
?: (gth a b)
-1
--1
--
:: ::
:::: 3b: floating point ::
:: ::
::
::
++ fl :: arb. precision fp
=+ ^- {{p/@u v/@s w/@u} r/$?($n $u $d $z $a) d/$?($d $f $i)}
[[113 -16.494 32.765] %n %d]
:: p=precision: number of bits in arithmetic form; must be at least 2
:: v=min exponent: minimum value of e
:: w=width: max - min value of e, 0 is fixed point
:: r=rounding mode: nearest (ties to even), up, down, to zero, away from zero
:: d=behavior: return denormals, flush denormals to zero,
:: infinite exponent range
=>
~% %cofl +> ~
:: internal functions; mostly operating on {e/@s a/@u}, in other words
:: positive numbers. many of these error out if a=0.
2016-11-24 07:25:07 +03:00
|%
++ rou
|= {a/{e/@s a/@u}} ^- fn (rau a &)
::
++ rau
|= {a/{e/@s a/@u} t/?} ^- fn
?- r
$z (lug %fl a t) $d (lug %fl a t)
$a (lug %ce a t) $u (lug %ce a t)
$n (lug %ne a t)
==
::
++ add :: add; exact if e
|= {a/{e/@s a/@u} b/{e/@s a/@u} e/?} ^- fn
=+ q=(dif:si e.a e.b)
|- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exp
?: e
[%f & e.b (^add (lsh 0 (abs:si q) a.a) a.b)]
=+ [ma=(met 0 a.a) mb=(met 0 a.b)]
=+ ^= w %+ dif:si e.a %- sun:si :: expanded exp of a
?: (gth prc ma) (^sub prc ma) 0
=+ ^= x %+ sum:si e.b (sun:si mb) :: highest exp for b
?: =((cmp:si w x) --1) :: don't need to add
?- r
$z (lug %fl a &) $d (lug %fl a &)
$a (lug %lg a &) $u (lug %lg a &)
$n (lug %na a &)
==
(rou [e.b (^add (lsh 0 (abs:si q) a.a) a.b)])
::
++ sub :: subtract; exact if e
|= {a/{e/@s a/@u} b/{e/@s a/@u} e/?} ^- fn
=+ q=(dif:si e.a e.b)
|- ?. (syn:si q)
(fli $(b a, a b, q +(q), r swr))
=+ [ma=(met 0 a.a) mb=(met 0 a.b)]
=+ ^= w %+ dif:si e.a %- sun:si
?: (gth prc ma) (^sub prc ma) 0
=+ ^= x %+ sum:si e.b (sun:si +(mb))
2016-11-24 07:25:07 +03:00
?: &(!e =((cmp:si w x) --1))
?- r
$z (lug %sm a &) $d (lug %sm a &)
$a (lug %ce a &) $u (lug %ce a &)
$n (lug %nt a &)
==
=+ j=(lsh 0 (abs:si q) a.a)
|- ?. (gte j a.b)
(fli $(a.b j, j a.b, r swr))
=+ i=(^sub j a.b)
?~ i [%f & zer]
?: e [%f & e.b i] (rou [e.b i])
::
++ mul :: multiply
|= {a/{e/@s a/@u} b/{e/@s a/@u}} ^- fn
(rou (sum:si e.a e.b) (^mul a.a a.b))
::
++ div :: divide
|= {a/{e/@s a/@u} b/{e/@s a/@u}} ^- fn
=+ [ma=(met 0 a.a) mb=(met 0 a.b)]
=+ v=(dif:si (sun:si ma) (sun:si +((^add mb prc))))
=. a ?: (syn:si v) a
a(e (sum:si v e.a), a (lsh 0 (abs:si v) a.a))
=+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)]
(rau [j p.q] =(q.q 0))
::
++ sqt :: square root
|= {a/{e/@s a/@u}} ^- fn
=. a
=+ [w=(met 0 a.a) x=(^mul +(prc) 2)]
=+ ?:((^lth w x) (^sub x w) 0)
=+ ?: =((dis - 1) (dis (abs:si e.a) 1)) -
(^add - 1)
a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a))
=+ [y=(^sqt a.a) z=(fra:si e.a --2)]
(rau [z p.y] =(q.y 0))
::
++ lth :: less-than
|= {a/{e/@s a/@u} b/{e/@s a/@u}} ^- ?
?: =(e.a e.b) (^lth a.a a.b)
=+ c=(cmp:si (ibl a) (ibl b))
?: =(c -1) & ?: =(c --1) |
?: =((cmp:si e.a e.b) -1)
(^lth (rsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
(^lth (lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
::
++ equ :: equals
|= {a/{e/@s a/@u} b/{e/@s a/@u}} ^- ?
?. =((ibl a) (ibl b)) |
?: =((cmp:si e.a e.b) -1)
=((lsh 0 (abs:si (dif:si e.a e.b)) a.b) a.a)
=((lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
::
:: integer binary logarithm: 2^ibl(a) <= |a| < 2^(ibl(a)+1)
++ ibl
|= {a/{e/@s a/@u}} ^- @s
(sum:si (sun:si (dec (met 0 a.a))) e.a)
::
:: change to a representation where a.a is odd
:: every fn has a unique representation of this kind
++ uni
|= {a/{e/@s a/@u}}
|- ?: =((end 0 1 a.a) 1) a
$(a.a (rsh 0 1 a.a), e.a (sum:si e.a --1))
::
:: expands to either full precision or to denormalized
++ xpd
|= {a/{e/@s a/@u}}
=+ ma=(met 0 a.a)
?: (gte ma prc) a
=+ ?: =(den %i) (^sub prc ma)
=+ ^= q
=+ w=(dif:si e.a emn)
?: (syn:si w) (abs:si w) 0
(min q (^sub prc ma))
a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a))
::
:: central rounding mechanism
:: can perform: floor, ceiling, smaller, larger,
:: nearest (round ties to: even, away from 0, toward 0)
:: s is sticky bit: represents a value less than ulp(a) = 2^(e.a)
::
++ lug
~/ %lug
|= {t/$?($fl $ce $sm $lg $ne $na $nt) a/{e/@s a/@u} s/?} ^- fn
?< =(a.a 0)
=-
?. =(den %f) - :: flush denormals
?. ?=({$f *} -) -
?: =((met 0 ->+>) prc) - [%f & zer]
::
=+ m=(met 0 a.a)
?> |(s (gth m prc)) :: require precision
2017-06-16 09:31:07 +03:00
=+ ^= q %+ max
?: (gth m prc) (^sub m prc) 0 :: reduce precision
2017-07-14 22:00:10 +03:00
%- abs:si ?: =(den %i) --0 :: enforce min. exp
2016-11-24 07:25:07 +03:00
?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0
=^ b a :- (end 0 q a.a)
a(e (sum:si e.a (sun:si q)), a (rsh 0 q a.a))
::
?~ a.a
?< =(den %i)
?- t
$fl [%f & zer]
2016-11-24 07:25:07 +03:00
$sm [%f & zer]
$ce [%f & spd]
2016-11-24 07:25:07 +03:00
$lg [%f & spd]
2017-03-02 10:47:54 +03:00
$ne ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
2016-11-24 07:25:07 +03:00
[%f & ?:((^lth b (bex (dec q))) zer spd)]
2017-03-02 10:47:54 +03:00
$nt ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
2016-11-24 07:25:07 +03:00
[%f & ?:((^lth b (bex (dec q))) zer spd)]
$na [%f & ?:((^lth b (bex (dec q))) zer spd)]
==
::
=. a (xpd a)
::
=. a
?- t
$fl a
$lg a(a +(a.a))
$sm ?. &(=(b 0) s) a
?: &(=(e.a emn) !=(den %i)) a(a (dec a.a))
=+ y=(dec (^mul a.a 2))
2017-03-02 10:47:54 +03:00
?. (lte (met 0 y) prc) a(a (dec a.a))
2016-11-24 07:25:07 +03:00
[(dif:si e.a --1) y]
$ce ?: &(=(b 0) s) a a(a +(a.a))
$ne ?~ b a
=+ y=(bex (dec q))
?: &(=(b y) s) :: round halfs to even
?~ (dis a.a 1) a a(a +(a.a))
?: (^lth b y) a a(a +(a.a))
$na ?~ b a
=+ y=(bex (dec q))
?: (^lth b y) a a(a +(a.a))
$nt ?~ b a
=+ y=(bex (dec q))
?: =(b y) ?: s a a(a +(a.a))
?: (^lth b y) a a(a +(a.a))
==
::
=. a ?. =((met 0 a.a) +(prc)) a
a(a (rsh 0 1 a.a), e (sum:si e.a --1))
?~ a.a [%f & zer]
::
?: =(den %i) [%f & a]
?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp
::
2017-06-16 09:31:07 +03:00
++ drg :: dragon4; get
~/ %drg :: printable decimal;
|= {a/{e/@s a/@u}} ^- {@s @u} :: guaranteed accurate
?< =(a.a 0) :: for rounded floats
2016-11-24 07:25:07 +03:00
=. a (xpd a)
=+ r=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) a.a)
=+ s=(lsh 0 ?.((syn:si e.a) (abs:si e.a) 0) 1)
2017-06-16 09:31:07 +03:00
=+ mn=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) 1)
=+ mp=mn
=> ?.
?& =(a.a (bex (dec prc))) :: if next smallest
|(!=(e.a emn) =(den %i)) :: float is half ULP,
== :: tighten lower bound
.
%= .
mp (lsh 0 1 mp)
r (lsh 0 1 r)
s (lsh 0 1 s)
==
2016-11-24 07:25:07 +03:00
=+ [k=--0 q=(^div (^add s 9) 10)]
|- ?: (^lth r q)
%= $
k (dif:si k --1)
r (^mul r 10)
2017-06-16 09:31:07 +03:00
mn (^mul mn 10)
mp (^mul mp 10)
2016-11-24 07:25:07 +03:00
==
2017-06-16 09:31:07 +03:00
|- ?: (gte (^add (^mul r 2) mp) (^mul s 2))
2016-11-24 07:25:07 +03:00
$(s (^mul s 10), k (sum:si k --1))
=+ [u=0 o=0]
2017-06-16 09:31:07 +03:00
|- :: r/s+o = a*10^-k
2016-11-24 07:25:07 +03:00
=+ v=(dvr (^mul r 10) s)
=> %= .
k (dif:si k --1)
u p.v
r q.v
2017-06-16 09:31:07 +03:00
mn (^mul mn 10)
mp (^mul mp 10)
2016-11-24 07:25:07 +03:00
==
2017-06-16 09:31:07 +03:00
=+ l=(^lth (^mul r 2) mn) :: in lower bound
=+ ^= h :: in upper bound
?| (^lth (^mul s 2) mp)
(gth (^mul r 2) (^sub (^mul s 2) mp))
2016-11-24 07:25:07 +03:00
==
?: &(!l !h)
$(o (^add (^mul o 10) u))
2017-06-16 09:31:07 +03:00
=+ q=&(h |(!l (gth (^mul r 2) s)))
2016-11-24 07:25:07 +03:00
=. o (^add (^mul o 10) ?:(q +(u) u))
[k o]
::
++ toj :: round to integer
|= {a/{e/@s a/@u}} ^- fn
?. =((cmp:si e.a --0) -1) [%f & a]
=+ x=(abs:si e.a)
=+ y=(rsh 0 x a.a)
?: |(=(r %d) =(r %z)) [%f & --0 y]
=+ z=(end 0 x a.a)
?: |(=(r %u) =(r %a)) [%f & --0 ?~(z y +(y))]
=+ i=(bex (dec x))
?: &(=(z i) =((dis y 1) 0)) [%f & --0 y]
?: (^lth z i) [%f & --0 y] [%f & --0 +(y)]
::
++ ned :: require ?=({$f *} a)
|= {a/fn} ^- {$f s/? e/@s a/@u}
?: ?=({$f *} a) a
~_ leaf+"need-float"
!!
::
++ shf :: a * 2^b; no rounding
|= {a/fn b/@s}
?: |(?=({$n *} a) ?=({$i *} a)) a
a(e (sum:si e.a b))
::
++ fli :: flip sign
|= {a/fn} ^- fn
?-(-.a $f a(s !s.a), $i a(s !s.a), $n a)
::
++ swr ?+(r r $d %u, $u %d) :: flipped rounding
++ prc ?>((gth p 1) p) :: force >= 2 precision
++ den d :: denorm+flush+inf exp
++ emn v :: minimum exponent
++ emx (sum:si emn (sun:si w)) :: maximum exponent
++ spd [e=emn a=1] :: smallest denormal
++ spn [e=emn a=(bex (dec prc))] :: smallest normal
++ lfn [e=emx a=(fil 0 prc 1)] :: largest
++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is > than all
++ zer [e=--0 a=0]
--
|%
++ rou :: round
|= {a/fn} ^- fn
?. ?=({$f *} a) a
?~ a.a [%f s.a zer]
?: s.a (^rou +>.a)
=.(r swr (fli (^rou +>.a)))
::
++ syn :: get sign
|= {a/fn} ^- ?
?-(-.a $f s.a, $i s.a, $n &)
::
++ abs :: absolute value
|= {a/fn} ^- fn
?: ?=({$f *} a) [%f & e.a a.a]
?: ?=({$i *} a) [%i &] [%n ~]
::
++ add :: add
|= {a/fn b/fn} ^- fn
?: |(?=({$n *} a) ?=({$n *} b)) [%n ~]
?: |(?=({$i *} a) ?=({$i *} b))
?: &(?=({$i *} a) ?=({$i *} b))
?: =(a b) a [%n ~]
?: ?=({$i *} a) a b
?: |(=(a.a 0) =(a.b 0))
?. &(=(a.a 0) =(a.b 0)) %- rou ?~(a.a b a)
[%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
%- |= {a/fn}
?. ?=({$f *} a) a
?. =(a.a 0) a
[%f !=(r %d) zer]
?: =(s.a s.b)
?: s.a (^add +>.a +>.b |)
=.(r swr (fli (^add +>.a +>.b |)))
?: s.a (^sub +>.a +>.b |)
(^sub +>.b +>.a |)
::
++ ead :: exact add
|= {a/fn b/fn} ^- fn
?: |(?=({$n *} a) ?=({$n *} b)) [%n ~]
?: |(?=({$i *} a) ?=({$i *} b))
?: &(?=({$i *} a) ?=({$i *} b))
?: =(a b) a [%n ~]
?: ?=({$i *} a) a b
?: |(=(a.a 0) =(a.b 0))
?. &(=(a.a 0) =(a.b 0)) ?~(a.a b a)
[%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
%- |= {a/fn}
?. ?=({$f *} a) a
?. =(a.a 0) a
[%f !=(r %d) zer]
?: =(s.a s.b)
?: s.a (^add +>.a +>.b &)
(fli (^add +>.a +>.b &))
?: s.a (^sub +>.a +>.b &)
(^sub +>.b +>.a &)
::
++ sub :: subtract
|= {a/fn b/fn} ^- fn (add a (fli b))
::
++ mul :: multiply
|= {a/fn b/fn} ^- fn
?: |(?=({$n *} a) ?=({$n *} b)) [%n ~]
?: ?=({$i *} a)
?: ?=({$i *} b)
2016-11-24 07:25:07 +03:00
[%i =(s.a s.b)]
?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
?: ?=({$i *} b)
?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
?: =(s.a s.b) (^mul +>.a +>.b)
=.(r swr (fli (^mul +>.a +>.b)))
::
++ emu :: exact multiply
|= {a/fn b/fn} ^- fn
?: |(?=({$n *} a) ?=({$n *} b)) [%n ~]
?: ?=({$i *} a)
?: ?=({$i *} b)
2016-11-24 07:25:07 +03:00
[%i =(s.a s.b)]
?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
?: ?=({$i *} b)
?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
[%f =(s.a s.b) (sum:si e.a e.b) (^^mul a.a a.b)]
::
++ div :: divide
|= {a/fn b/fn} ^- fn
?: |(?=({$n *} a) ?=({$n *} b)) [%n ~]
?: ?=({$i *} a)
?: ?=({$i *} b) [%n ~] [%i =(s.a s.b)]
?: ?=({$i *} b) [%f =(s.a s.b) zer]
?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer]
?: =(a.b 0) [%i =(s.a s.b)]
?: =(s.a s.b) (^div +>.a +>.b)
=.(r swr (fli (^div +>.a +>.b)))
::
++ fma :: fused multiply-add
|= {a/fn b/fn c/fn} ^- fn :: (a * b) + c
(add (emu a b) c)
::
++ sqt :: square root
|= {a/fn} ^- fn
?: ?=({$n *} a) [%n ~]
?: ?=({$i *} a) ?:(s.a a [%n ~])
?~ a.a [%f s.a zer]
?: s.a (^sqt +>.a) [%n ~]
::
++ inv :: inverse
|= {a/fn} ^- fn
(div [%f & --0 1] a)
::
++ sun :: uns integer to float
|= {a/@u} ^- fn
(rou [%f & --0 a])
::
++ san :: sgn integer to float
|= {a/@s} ^- fn
=+ b=(old:si a)
(rou [%f -.b --0 +.b])
::
:: comparisons return ~ in the event of a NaN
++ lth :: less-than
|= {a/fn b/fn} ^- (unit ?)
?: |(?=({$n *} a) ?=({$n *} b)) ~ :- ~
?: =(a b) |
?: ?=({$i *} a) !s.a ?: ?=({$i *} b) s.b
?: |(=(a.a 0) =(a.b 0))
?: &(=(a.a 0) =(a.b 0)) |
?: =(a.a 0) s.b !s.a
?: !=(s.a s.b) s.b
?: s.a (^lth +>.a +>.b) (^lth +>.b +>.a)
::
++ lte :: less-equal
|= {a/fn b/fn} ^- (unit ?)
%+ bind (lth b a) |= a/? !a
2016-11-24 07:25:07 +03:00
::
++ equ :: equal
|= {a/fn b/fn} ^- (unit ?)
?: |(?=({$n *} a) ?=({$n *} b)) ~ :- ~
?: =(a b) &
?: |(?=({$i *} a) ?=({$i *} b)) |
?: |(=(a.a 0) =(a.b 0))
?: &(=(a.a 0) =(a.b 0)) & |
?: |(=(e.a e.b) !=(s.a s.b)) |
(^equ +>.a +>.b)
::
++ gte :: greater-equal
|= {a/fn b/fn} ^- (unit ?) (lte b a)
::
++ gth :: greater-than
|= {a/fn b/fn} ^- (unit ?) (lth b a)
::
++ drg :: float to decimal
|= {a/fn} ^- dn
?: ?=({$n *} a) [%n ~]
?: ?=({$i *} a) [%i s.a]
?~ a.a [%d s.a --0 0]
[%d s.a (^drg +>.a)]
::
++ grd :: decimal to float
|= {a/dn} ^- fn
?: ?=({$n *} a) [%n ~]
?: ?=({$i *} a) [%i s.a]
=> .(r %n)
=+ q=(abs:si e.a)
?: (syn:si e.a)
(mul [%f s.a --0 a.a] [%f & e.a (pow 5 q)])
(div [%f s.a --0 a.a] [%f & (sun:si q) (pow 5 q)])
::
++ toi :: round to integer @s
|= {a/fn} ^- (unit @s)
=+ b=(toj a)
?. ?=({$f *} b) ~ :- ~
=+ c=(^^mul (bex (abs:si e.b)) a.b)
(new:si s.b c)
::
++ toj :: round to integer fn
|= {a/fn} ^- fn
?. ?=({$f *} a) a
?~ a.a [%f s.a zer]
?: s.a (^toj +>.a)
=.(r swr (fli (^toj +>.a)))
--
::
++ ff :: ieee 754 format fp
|_ {{w/@u p/@u b/@s} r/$?($n $u $d $z $a)}
:: this core has no use outside of the functionality
:: provided to ++rd, ++rs, ++rq, and ++rh
::
:: w=width: bits in exponent field
:: p=precision: bits in fraction field
:: w=bias: added to exponent when storing
:: r=rounding mode: same as in ++fl
::
++ sb (bex (^add w p)) :: sign bit
++ me (dif:si (dif:si --1 b) (sun:si p)) :: minimum exponent
::
++ pa
%*(. fl p +(p), v me, w (^sub (bex w) 3), d %d, r r)
::
++ sea :: @r to fn
|= {a/@r} ^- fn
=+ [f=(cut 0 [0 p] a) e=(cut 0 [p w] a)]
=+ s=(sig a)
?: =(e 0)
?: =(f 0) [%f s --0 0] [%f s me f]
?: =(e (fil 0 w 1))
?: =(f 0) [%i s] [%n ~]
=+ q=:(sum:si (sun:si e) me -1)
=+ r=(^add f (bex p))
[%f s q r]
::
++ bit |= {a/fn} (bif (rou:pa a)) :: fn to @r w+ rounding
::
++ bif :: fn to @r no rounding
|= {a/fn} ^- @r
?: ?=({$i *} a)
=+ q=(lsh 0 p (fil 0 w 1))
?: s.a q (^add q sb)
?: ?=({$n *} a) (lsh 0 (dec p) (fil 0 +(w) 1))
?~ a.a ?: s.a `@r`0 sb
=+ ma=(met 0 a.a)
?. =(ma +(p))
?> =(e.a me)
?> (^lth ma +(p))
?: s.a `@r`a.a (^add a.a sb)
=+ q=(sum:si (dif:si e.a me) --1)
=+ r=(^add (lsh 0 p (abs:si q)) (end 0 p a.a))
?: s.a r (^add r sb)
::
++ sig :: get sign
|= {a/@r} ^- ?
=(0 (cut 0 [(^add p w) 1] a))
::
++ exp :: get exponent
|= {a/@r} ^- @s
(dif:si (sun:si (cut 0 [p w] a)) b)
::
++ add :: add
|= {a/@r b/@r}
(bif (add:pa (sea a) (sea b)))
::
++ sub :: subtract
|= {a/@r b/@r}
(bif (sub:pa (sea a) (sea b)))
::
++ mul :: multiply
|= {a/@r b/@r}
(bif (mul:pa (sea a) (sea b)))
::
++ div :: divide
|= {a/@r b/@r}
(bif (div:pa (sea a) (sea b)))
::
++ fma :: fused multiply-add
|= {a/@r b/@r c/@r}
(bif (fma:pa (sea a) (sea b) (sea c)))
::
++ sqt :: square root
|= {a/@r}
(bif (sqt:pa (sea a)))
::
++ lth :: less-than
|= {a/@r b/@r} (fall (lth:pa (sea a) (sea b)) |)
++ lte :: less-equals
|= {a/@r b/@r} (fall (lte:pa (sea a) (sea b)) |)
++ equ :: equals
|= {a/@r b/@r} (fall (equ:pa (sea a) (sea b)) |)
++ gte :: greater-equals
|= {a/@r b/@r} (fall (gte:pa (sea a) (sea b)) |)
++ gth :: greater-than
|= {a/@r b/@r} (fall (gth:pa (sea a) (sea b)) |)
++ sun :: uns integer to @r
|= {a/@u} (bit [%f & --0 a])
++ san :: signed integer to @r
|= {a/@s} (bit [%f (syn:si a) --0 (abs:si a)])
++ toi :: round to integer
|= {a/@r} (toi:pa (sea a))
++ drg :: @r to decimal float
|= {a/@r} (drg:pa (sea a))
++ grd :: decimal float to @r
|= {a/dn} (bif (grd:pa a))
--
::
++ rlyd |= a/@rd ^- dn (drg:rd a) :: prep @rd for print
++ rlys |= a/@rs ^- dn (drg:rs a) :: prep @rs for print
++ rlyh |= a/@rh ^- dn (drg:rh a) :: prep @rh for print
++ rlyq |= a/@rq ^- dn (drg:rq a) :: prep @rq for print
++ ryld |= a/dn ^- @rd (grd:rd a) :: finish parsing @rd
++ ryls |= a/dn ^- @rs (grd:rs a) :: finish parsing @rs
++ rylh |= a/dn ^- @rh (grd:rh a) :: finish parsing @rh
++ rylq |= a/dn ^- @rq (grd:rq a) :: finish parsing @rq
::
++ rd :: double precision fp
2017-04-13 04:28:26 +03:00
^?
2016-11-24 07:25:07 +03:00
~% %rd +> ~
|_ r/$?($n $u $d $z)
:: round to nearest, round up, round down, round to zero
::
++ ma
%*(. ff w 11, p 52, b --1.023, r r)
::
++ sea :: @rd to fn
|= {a/@rd} (sea:ma a)
::
++ bit :: fn to @rd
|= {a/fn} ^- @rd (bit:ma a)
::
++ add ~/ %add :: add
|= {a/@rd b/@rd} ^- @rd
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(add:ma a b)
::
++ sub ~/ %sub :: subtract
|= {a/@rd b/@rd} ^- @rd
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(sub:ma a b)
::
++ mul ~/ %mul :: multiply
|= {a/@rd b/@rd} ^- @rd
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(mul:ma a b)
::
++ div ~/ %div :: divide
|= {a/@rd b/@rd} ^- @rd
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(div:ma a b)
::
++ fma ~/ %fma :: fused multiply-add
|= {a/@rd b/@rd c/@rd} ^- @rd
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(fma:ma a b c)
::
++ sqt ~/ %sqt :: square root
|= {a/@rd} ^- @rd ~_ leaf+"rd-fail"
(sqt:ma a)
::
++ lth ~/ %lth :: less-than
|= {a/@rd b/@rd}
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(lth:ma a b)
::
++ lte ~/ %lte :: less-equals
|= {a/@rd b/@rd}
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(lte:ma a b)
::
++ equ ~/ %equ :: equals
|= {a/@rd b/@rd}
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(equ:ma a b)
::
++ gte ~/ %gte :: greater-equals
|= {a/@rd b/@rd}
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(gte:ma a b)
::
++ gth ~/ %gth :: greater-than
|= {a/@rd b/@rd}
2016-11-24 07:25:07 +03:00
~_ leaf+"rd-fail"
(gth:ma a b)
::
++ sun |= {a/@u} ^- @rd (sun:ma a) :: uns integer to @rd
++ san |= {a/@s} ^- @rd (san:ma a) :: sgn integer to @rd
++ sig |= {a/@rd} ^- ? (sig:ma a) :: get sign
++ exp |= {a/@rd} ^- @s (exp:ma a) :: get exponent
++ toi |= {a/@rd} ^- (unit @s) (toi:ma a) :: round to integer
++ drg |= {a/@rd} ^- dn (drg:ma a) :: @rd to decimal float
++ grd |= {a/dn} ^- @rd (grd:ma a) :: decimal float to @rd
--
::
++ rs :: single precision fp
~% %rs +> ~
2017-04-13 04:28:26 +03:00
^?
2016-11-24 07:25:07 +03:00
|_ r/$?($n $u $d $z)
:: round to nearest, round up, round down, round to zero
::
++ ma
%*(. ff w 8, p 23, b --127, r r)
::
++ sea :: @rs to fn
|= {a/@rs} (sea:ma a)
::
++ bit :: fn to @rs
|= {a/fn} ^- @rs (bit:ma a)
::
++ add ~/ %add :: add
|= {a/@rs b/@rs} ^- @rs
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(add:ma a b)
::
++ sub ~/ %sub :: subtract
|= {a/@rs b/@rs} ^- @rs
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(sub:ma a b)
::
++ mul ~/ %mul :: multiply
|= {a/@rs b/@rs} ^- @rs
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(mul:ma a b)
::
++ div ~/ %div :: divide
|= {a/@rs b/@rs} ^- @rs
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(div:ma a b)
::
++ fma ~/ %fma :: fused multiply-add
|= {a/@rs b/@rs c/@rs} ^- @rs
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(fma:ma a b c)
::
++ sqt ~/ %sqt :: square root
|= {a/@rs} ^- @rs
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(sqt:ma a)
::
++ lth ~/ %lth :: less-than
|= {a/@rs b/@rs}
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(lth:ma a b)
::
++ lte ~/ %lte :: less-equals
|= {a/@rs b/@rs}
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(lte:ma a b)
::
++ equ ~/ %equ :: equals
|= {a/@rs b/@rs}
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(equ:ma a b)
::
++ gte ~/ %gte :: greater-equals
|= {a/@rs b/@rs}
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(gte:ma a b)
::
++ gth ~/ %gth :: greater-than
|= {a/@rs b/@rs}
2016-11-24 07:25:07 +03:00
~_ leaf+"rs-fail"
(gth:ma a b)
::
++ sun |= {a/@u} ^- @rs (sun:ma a) :: uns integer to @rs
++ san |= {a/@s} ^- @rs (san:ma a) :: sgn integer to @rs
++ sig |= {a/@rs} ^- ? (sig:ma a) :: get sign
++ exp |= {a/@rs} ^- @s (exp:ma a) :: get exponent
++ toi |= {a/@rs} ^- (unit @s) (toi:ma a) :: round to integer
++ drg |= {a/@rs} ^- dn (drg:ma a) :: @rs to decimal float
++ grd |= {a/dn} ^- @rs (grd:ma a) :: decimal float to @rs
--
::
++ rq :: quad precision fp
~% %rq +> ~
2017-04-13 04:28:26 +03:00
^?
2016-11-24 07:25:07 +03:00
|_ r/$?($n $u $d $z)
:: round to nearest, round up, round down, round to zero
::
++ ma
%*(. ff w 15, p 112, b --16.383, r r)
::
++ sea :: @rq to fn
|= {a/@rq} (sea:ma a)
::
++ bit :: fn to @rq
|= {a/fn} ^- @rq (bit:ma a)
::
++ add ~/ %add :: add
|= {a/@rq b/@rq} ^- @rq
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(add:ma a b)
::
++ sub ~/ %sub :: subtract
|= {a/@rq b/@rq} ^- @rq
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(sub:ma a b)
::
++ mul ~/ %mul :: multiply
|= {a/@rq b/@rq} ^- @rq
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(mul:ma a b)
::
++ div ~/ %div :: divide
|= {a/@rq b/@rq} ^- @rq
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(div:ma a b)
::
++ fma ~/ %fma :: fused multiply-add
|= {a/@rq b/@rq c/@rq} ^- @rq
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(fma:ma a b c)
::
++ sqt ~/ %sqt :: square root
|= {a/@rq} ^- @rq
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(sqt:ma a)
::
++ lth ~/ %lth :: less-than
|= {a/@rq b/@rq}
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(lth:ma a b)
::
++ lte ~/ %lte :: less-equals
|= {a/@rq b/@rq}
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(lte:ma a b)
::
++ equ ~/ %equ :: equals
|= {a/@rq b/@rq}
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(equ:ma a b)
::
++ gte ~/ %gte :: greater-equals
|= {a/@rq b/@rq}
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(gte:ma a b)
::
++ gth ~/ %gth :: greater-than
|= {a/@rq b/@rq}
2016-11-24 07:25:07 +03:00
~_ leaf+"rq-fail"
(gth:ma a b)
::
++ sun |= {a/@u} ^- @rq (sun:ma a) :: uns integer to @rq
++ san |= {a/@s} ^- @rq (san:ma a) :: sgn integer to @rq
++ sig |= {a/@rq} ^- ? (sig:ma a) :: get sign
++ exp |= {a/@rq} ^- @s (exp:ma a) :: get exponent
++ toi |= {a/@rq} ^- (unit @s) (toi:ma a) :: round to integer
++ drg |= {a/@rq} ^- dn (drg:ma a) :: @rq to decimal float
++ grd |= {a/dn} ^- @rq (grd:ma a) :: decimal float to @rq
--
::
++ rh :: half precision fp
2017-03-02 10:47:54 +03:00
~% %rh +> ~
2017-04-13 04:28:26 +03:00
^?
2016-11-24 07:25:07 +03:00
|_ r/$?($n $u $d $z)
:: round to nearest, round up, round down, round to zero
::
++ ma
%*(. ff w 5, p 10, b --15, r r)
::
++ sea :: @rh to fn
|= {a/@rh} (sea:ma a)
::
++ bit :: fn to @rh
|= {a/fn} ^- @rh (bit:ma a)
::
2017-03-02 10:47:54 +03:00
++ add ~/ %add :: add
|= {a/@rh b/@rh} ^- @rh
~_ leaf+"rh-fail"
(add:ma a b)
::
++ sub ~/ %sub :: subtract
|= {a/@rh b/@rh} ^- @rh
~_ leaf+"rh-fail"
(sub:ma a b)
::
++ mul ~/ %mul :: multiply
|= {a/@rh b/@rh} ^- @rh
~_ leaf+"rh-fail"
(mul:ma a b)
::
++ div ~/ %div :: divide
|= {a/@rh b/@rh} ^- @rh
~_ leaf+"rh-fail"
(div:ma a b)
::
++ fma ~/ %fma :: fused multiply-add
|= {a/@rh b/@rh c/@rh} ^- @rh
~_ leaf+"rh-fail"
(fma:ma a b c)
::
++ sqt ~/ %sqt :: square root
|= {a/@rh} ^- @rh
~_ leaf+"rh-fail"
(sqt:ma a)
::
++ lth ~/ %lth :: less-than
|= {a/@rh b/@rh}
~_ leaf+"rh-fail"
(lth:ma a b)
::
++ lte ~/ %lte :: less-equals
|= {a/@rh b/@rh}
~_ leaf+"rh-fail"
(lte:ma a b)
::
++ equ ~/ %equ :: equals
|= {a/@rh b/@rh}
~_ leaf+"rh-fail"
(equ:ma a b)
::
++ gte ~/ %gte :: greater-equals
|= {a/@rh b/@rh}
~_ leaf+"rh-fail"
(gte:ma a b)
::
++ gth ~/ %gth :: greater-than
|= {a/@rh b/@rh}
~_ leaf+"rh-fail"
(gth:ma a b)
::
2016-11-24 07:25:07 +03:00
++ tos :: @rh to @rs
|= {a/@rh} (bit:rs (sea a))
::
++ fos :: @rs to @rh
|= {a/@rs} (bit (sea:rs a))
::
++ sun |= {a/@u} ^- @rh (sun:ma a) :: uns integer to @rh
++ san |= {a/@s} ^- @rh (san:ma a) :: sgn integer to @rh
++ sig |= {a/@rh} ^- ? (sig:ma a) :: get sign
++ exp |= {a/@rh} ^- @s (exp:ma a) :: get exponent
++ toi |= {a/@rh} ^- (unit @s) (toi:ma a) :: round to integer
++ drg |= {a/@rh} ^- dn (drg:ma a) :: @rh to decimal float
++ grd |= {a/dn} ^- @rh (grd:ma a) :: decimal float to @rh
--
:: 3c: urbit time ::
:::: ::
:: year, yore, yell, yule, yall, yawn, yelp, yo ::
::
++ year :: date to @d
|= det/date
^- @da
=+ ^= yer
?: a.det
(add 292.277.024.400 y.det)
(sub 292.277.024.400 (dec y.det))
=+ day=(yawn yer m.det d.t.det)
(yule day h.t.det m.t.det s.t.det f.t.det)
::
++ yore :: @d to date
|= now/@da
^- date
=+ rip=(yell now)
=+ ger=(yall d.rip)
:- ?: (gth y.ger 292.277.024.400)
[a=& y=(sub y.ger 292.277.024.400)]
[a=| y=+((sub 292.277.024.400 y.ger))]
[m.ger d.ger h.rip m.rip s.rip f.rip]
::
++ yell :: tarp from @d
|= now/@d
^- tarp
=+ sec=(rsh 6 1 now)
=+ ^= fan
=+ [muc=4 raw=(end 6 1 now)]
|- ^- (list @ux)
?: |(=(0 raw) =(0 muc))
~
=> .(muc (dec muc))
[(cut 4 [muc 1] raw) $(raw (end 4 muc raw))]
=+ day=(div sec day:yo)
=> .(sec (mod sec day:yo))
=+ hor=(div sec hor:yo)
=> .(sec (mod sec hor:yo))
=+ mit=(div sec mit:yo)
=> .(sec (mod sec mit:yo))
[day hor mit sec fan]
::
++ yule :: time atom
|= rip/tarp
^- @d
=+ ^= sec ;: add
(mul d.rip day:yo)
(mul h.rip hor:yo)
(mul m.rip mit:yo)
s.rip
==
=+ ^= fac =+ muc=4
|- ^- @
?~ f.rip
0
=> .(muc (dec muc))
(add (lsh 4 muc i.f.rip) $(f.rip t.f.rip))
(con (lsh 6 1 sec) fac)
::
++ yall :: day / to day of year
|= day/@ud
^- {y/@ud m/@ud d/@ud}
=+ [era=0 cet=0 lep=*?]
=> .(era (div day era:yo), day (mod day era:yo))
=> ^+ .
?: (lth day +(cet:yo))
.(lep &, cet 0)
=> .(lep |, cet 1, day (sub day +(cet:yo)))
.(cet (add cet (div day cet:yo)), day (mod day cet:yo))
=+ yer=(add (mul 400 era) (mul 100 cet))
|- ^- {y/@ud m/@ud d/@ud}
=+ dis=?:(lep 366 365)
?. (lth day dis)
=+ ner=+(yer)
$(yer ner, day (sub day dis), lep =(0 (end 0 2 ner)))
|- ^- {y/@ud m/@ud d/@ud}
=+ [mot=0 cah=?:(lep moy:yo moh:yo)]
|- ^- {y/@ud m/@ud d/@ud}
=+ zis=(snag mot cah)
?: (lth day zis)
[yer +(mot) +(day)]
$(mot +(mot), day (sub day zis))
::
++ yawn :: days since Jesus
|= {yer/@ud mot/@ud day/@ud}
^- @ud
=> .(mot (dec mot), day (dec day))
=> ^+ .
%= .
day
=+ cah=?:((yelp yer) moy:yo moh:yo)
|- ^- @ud
?: =(0 mot)
day
$(mot (dec mot), cah (slag 1 cah), day (add day (snag 0 cah)))
==
|- ^- @ud
?. =(0 (mod yer 4))
=+ ney=(dec yer)
$(yer ney, day (add day ?:((yelp ney) 366 365)))
?. =(0 (mod yer 100))
=+ nef=(sub yer 4)
$(yer nef, day (add day ?:((yelp nef) 1.461 1.460)))
?. =(0 (mod yer 400))
=+ nec=(sub yer 100)
$(yer nec, day (add day ?:((yelp nec) 36.525 36.524)))
(add day (mul (div yer 400) (add 1 (mul 4 36.524))))
::
++ yelp :: leap year
|= yer/@ud ^- ?
&(=(0 (mod yer 4)) |(!=(0 (mod yer 100)) =(0 (mod yer 400))))
::
++ yo :: time constants
|% ++ cet 36.524 :: (add 24 (mul 100 365))
++ day 86.400 :: (mul 24 hor)
++ era 146.097 :: (add 1 (mul 4 cet))
++ hor 3.600 :: (mul 60 mit)
++ jes 106.751.991.084.417 :: (mul 730.692.561 era)
++ mit 60
++ moh `(list @ud)`[31 28 31 30 31 30 31 31 30 31 30 31 ~]
++ moy `(list @ud)`[31 29 31 30 31 30 31 31 30 31 30 31 ~]
++ qad 126.144.001 :: (add 1 (mul 4 yer))
++ yer 31.536.000 :: (mul 365 day)
--
:: ::
:::: 3d: SHA hash family ::
:: ::
::
++ shad |=(ruz/@ (shax (shax ruz))) :: double sha-256
++ shaf :: half sha-256
|= {sal/@ ruz/@}
=+ haz=(shas sal ruz)
(mix (end 7 1 haz) (rsh 7 1 haz))
::
++ sham :: 128bit noun hash
|= yux/* ^- @uvH ^- @
?@ yux
(shaf %mash yux)
(shaf %sham (jam yux))
::
++ shas :: salted hash
|= {sal/@ ruz/@}
(shax (mix sal (shax ruz)))
::
++ shax :: sha-256
~/ %shax
|= ruz/@ ^- @
(shay [(met 3 ruz) ruz])
::
++ shay :: sha-256 with length
~/ %shay
|= {len/@u ruz/@} ^- @
=> .(ruz (cut 3 [0 len] ruz))
=+ [few==>(fe .(a 5)) wac=|=({a/@ b/@} (cut 5 [a 1] b))]
=+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
=+ ral=(lsh 0 3 len)
=+ ^= ful
%+ can 0
:~ [ral ruz]
[8 128]
[(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
[64 (~(net fe 6) ral)]
==
=+ lex=(met 9 ful)
=+ ^= kbx 0xc671.78f2.bef9.a3f7.a450.6ceb.90be.fffa.
8cc7.0208.84c8.7814.78a5.636f.748f.82ee.
682e.6ff3.5b9c.ca4f.4ed8.aa4a.391c.0cb3.
34b0.bcb5.2748.774c.1e37.6c08.19a4.c116.
106a.a070.f40e.3585.d699.0624.d192.e819.
c76c.51a3.c24b.8b70.a81a.664b.a2bf.e8a1.
9272.2c85.81c2.c92e.766a.0abb.650a.7354.
5338.0d13.4d2c.6dfc.2e1b.2138.27b7.0a85.
1429.2967.06ca.6351.d5a7.9147.c6e0.0bf3.
bf59.7fc7.b003.27c8.a831.c66d.983e.5152.
76f9.88da.5cb0.a9dc.4a74.84aa.2de9.2c6f.
240c.a1cc.0fc1.9dc6.efbe.4786.e49b.69c1.
c19b.f174.9bdc.06a7.80de.b1fe.72be.5d74.
550c.7dc3.2431.85be.1283.5b01.d807.aa98.
ab1c.5ed5.923f.82a4.59f1.11f1.3956.c25b.
e9b5.dba5.b5c0.fbcf.7137.4491.428a.2f98
=+ ^= hax 0x5be0.cd19.1f83.d9ab.9b05.688c.510e.527f.
a54f.f53a.3c6e.f372.bb67.ae85.6a09.e667
=+ i=0
|- ^- @
?: =(i lex)
(rep 5 (turn (rip 5 hax) net))
=+ ^= wox
=+ dux=(cut 9 [i 1] ful)
=+ wox=(rep 5 (turn (rip 5 dux) net))
=+ j=16
|- ^- @
?: =(64 j)
wox
=+ :* l=(wac (sub j 15) wox)
m=(wac (sub j 2) wox)
n=(wac (sub j 16) wox)
o=(wac (sub j 7) wox)
==
=+ x=:(mix (ror 0 7 l) (ror 0 18 l) (rsh 0 3 l))
=+ y=:(mix (ror 0 17 m) (ror 0 19 m) (rsh 0 10 m))
=+ z=:(sum n x o y)
$(wox (con (lsh 5 j z) wox), j +(j))
=+ j=0
=+ :* a=(wac 0 hax)
b=(wac 1 hax)
c=(wac 2 hax)
d=(wac 3 hax)
e=(wac 4 hax)
f=(wac 5 hax)
g=(wac 6 hax)
h=(wac 7 hax)
==
|- ^- @
?: =(64 j)
%= ^$
i +(i)
hax %+ rep 5
:~ (sum a (wac 0 hax))
(sum b (wac 1 hax))
(sum c (wac 2 hax))
(sum d (wac 3 hax))
(sum e (wac 4 hax))
(sum f (wac 5 hax))
(sum g (wac 6 hax))
(sum h (wac 7 hax))
==
==
=+ l=:(mix (ror 0 2 a) (ror 0 13 a) (ror 0 22 a)) :: s0
=+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj
=+ n=(sum l m) :: t2
=+ o=:(mix (ror 0 6 e) (ror 0 11 e) (ror 0 25 e)) :: s1
=+ p=(mix (dis e f) (dis (inv e) g)) :: ch
=+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1
$(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g)
::
++ shaw :: hash to nbits
|= {sal/@ len/@ ruz/@}
(~(raw og (shas sal (mix len ruz))) len)
::
++ shaz :: sha-512
|= ruz/@ ^- @
(shal [(met 3 ruz) ruz])
::
++ shal :: sha-512 with length
~/ %shal
|= {len/@ ruz/@} ^- @
=> .(ruz (cut 3 [0 len] ruz))
=+ [few==>(fe .(a 6)) wac=|=({a/@ b/@} (cut 6 [a 1] b))]
=+ [sum=sum.few ror=ror.few net=net.few inv=inv.few]
=+ ral=(lsh 0 3 len)
=+ ^= ful
%+ can 0
:~ [ral ruz]
[8 128]
[(mod (sub 1.920 (mod (add 8 ral) 1.024)) 1.024) 0]
[128 (~(net fe 7) ral)]
==
=+ lex=(met 10 ful)
=+ ^= kbx 0x6c44.198c.4a47.5817.5fcb.6fab.3ad6.faec.
597f.299c.fc65.7e2a.4cc5.d4be.cb3e.42b6.
431d.67c4.9c10.0d4c.3c9e.be0a.15c9.bebc.
32ca.ab7b.40c7.2493.28db.77f5.2304.7d84.
1b71.0b35.131c.471b.113f.9804.bef9.0dae.
0a63.7dc5.a2c8.98a6.06f0.67aa.7217.6fba.
f57d.4f7f.ee6e.d178.eada.7dd6.cde0.eb1e.
d186.b8c7.21c0.c207.ca27.3ece.ea26.619c.
c671.78f2.e372.532b.bef9.a3f7.b2c6.7915.
a450.6ceb.de82.bde9.90be.fffa.2363.1e28.
8cc7.0208.1a64.39ec.84c8.7814.a1f0.ab72.
78a5.636f.4317.2f60.748f.82ee.5def.b2fc.
682e.6ff3.d6b2.b8a3.5b9c.ca4f.7763.e373.
4ed8.aa4a.e341.8acb.391c.0cb3.c5c9.5a63.
34b0.bcb5.e19b.48a8.2748.774c.df8e.eb99.
1e37.6c08.5141.ab53.19a4.c116.b8d2.d0c8.
106a.a070.32bb.d1b8.f40e.3585.5771.202a.
d699.0624.5565.a910.d192.e819.d6ef.5218.
c76c.51a3.0654.be30.c24b.8b70.d0f8.9791.
a81a.664b.bc42.3001.a2bf.e8a1.4cf1.0364.
9272.2c85.1482.353b.81c2.c92e.47ed.aee6.
766a.0abb.3c77.b2a8.650a.7354.8baf.63de.
5338.0d13.9d95.b3df.4d2c.6dfc.5ac4.2aed.
2e1b.2138.5c26.c926.27b7.0a85.46d2.2ffc.
1429.2967.0a0e.6e70.06ca.6351.e003.826f.
d5a7.9147.930a.a725.c6e0.0bf3.3da8.8fc2.
bf59.7fc7.beef.0ee4.b003.27c8.98fb.213f.
a831.c66d.2db4.3210.983e.5152.ee66.dfab.
76f9.88da.8311.53b5.5cb0.a9dc.bd41.fbd4.
4a74.84aa.6ea6.e483.2de9.2c6f.592b.0275.
240c.a1cc.77ac.9c65.0fc1.9dc6.8b8c.d5b5.
efbe.4786.384f.25e3.e49b.69c1.9ef1.4ad2.
c19b.f174.cf69.2694.9bdc.06a7.25c7.1235.
80de.b1fe.3b16.96b1.72be.5d74.f27b.896f.
550c.7dc3.d5ff.b4e2.2431.85be.4ee4.b28c.
1283.5b01.4570.6fbe.d807.aa98.a303.0242.
ab1c.5ed5.da6d.8118.923f.82a4.af19.4f9b.
59f1.11f1.b605.d019.3956.c25b.f348.b538.
e9b5.dba5.8189.dbbc.b5c0.fbcf.ec4d.3b2f.
7137.4491.23ef.65cd.428a.2f98.d728.ae22
=+ ^= hax 0x5be0.cd19.137e.2179.1f83.d9ab.fb41.bd6b.
9b05.688c.2b3e.6c1f.510e.527f.ade6.82d1.
a54f.f53a.5f1d.36f1.3c6e.f372.fe94.f82b.
bb67.ae85.84ca.a73b.6a09.e667.f3bc.c908
=+ i=0
|- ^- @
?: =(i lex)
(rep 6 (turn (rip 6 hax) net))
=+ ^= wox
=+ dux=(cut 10 [i 1] ful)
=+ wox=(rep 6 (turn (rip 6 dux) net))
=+ j=16
|- ^- @
?: =(80 j)
wox
=+ :* l=(wac (sub j 15) wox)
m=(wac (sub j 2) wox)
n=(wac (sub j 16) wox)
o=(wac (sub j 7) wox)
==
=+ x=:(mix (ror 0 1 l) (ror 0 8 l) (rsh 0 7 l))
=+ y=:(mix (ror 0 19 m) (ror 0 61 m) (rsh 0 6 m))
=+ z=:(sum n x o y)
$(wox (con (lsh 6 j z) wox), j +(j))
=+ j=0
=+ :* a=(wac 0 hax)
b=(wac 1 hax)
c=(wac 2 hax)
d=(wac 3 hax)
e=(wac 4 hax)
f=(wac 5 hax)
g=(wac 6 hax)
h=(wac 7 hax)
==
|- ^- @
?: =(80 j)
%= ^$
i +(i)
hax %+ rep 6
:~ (sum a (wac 0 hax))
(sum b (wac 1 hax))
(sum c (wac 2 hax))
(sum d (wac 3 hax))
(sum e (wac 4 hax))
(sum f (wac 5 hax))
(sum g (wac 6 hax))
(sum h (wac 7 hax))
==
==
=+ l=:(mix (ror 0 28 a) (ror 0 34 a) (ror 0 39 a)) :: S0
=+ m=:(mix (dis a b) (dis a c) (dis b c)) :: maj
=+ n=(sum l m) :: t2
=+ o=:(mix (ror 0 14 e) (ror 0 18 e) (ror 0 41 e)) :: S1
=+ p=(mix (dis e f) (dis (inv e) g)) :: ch
=+ q=:(sum h o p (wac j kbx) (wac j wox)) :: t1
$(j +(j), a (sum q n), b a, c b, d c, e (sum d q), f e, g f, h g)
::
++ shan :: sha-1 (deprecated)
|= ruz/@
=+ [few==>(fe .(a 5)) wac=|=({a/@ b/@} (cut 5 [a 1] b))]
=+ [sum=sum.few ror=ror.few rol=rol.few net=net.few inv=inv.few]
=+ ral=(lsh 0 3 (met 3 ruz))
=+ ^= ful
%+ can 0
:~ [ral ruz]
[8 128]
[(mod (sub 960 (mod (add 8 ral) 512)) 512) 0]
[64 (~(net fe 6) ral)]
==
=+ lex=(met 9 ful)
=+ kbx=0xca62.c1d6.8f1b.bcdc.6ed9.eba1.5a82.7999
=+ hax=0xc3d2.e1f0.1032.5476.98ba.dcfe.efcd.ab89.6745.2301
=+ i=0
|-
?: =(i lex)
(rep 5 (flop (rip 5 hax)))
=+ ^= wox
=+ dux=(cut 9 [i 1] ful)
=+ wox=(rep 5 (turn (rip 5 dux) net))
=+ j=16
|- ^- @
?: =(80 j)
wox
=+ :* l=(wac (sub j 3) wox)
m=(wac (sub j 8) wox)
n=(wac (sub j 14) wox)
o=(wac (sub j 16) wox)
==
=+ z=(rol 0 1 :(mix l m n o))
$(wox (con (lsh 5 j z) wox), j +(j))
=+ j=0
=+ :* a=(wac 0 hax)
b=(wac 1 hax)
c=(wac 2 hax)
d=(wac 3 hax)
e=(wac 4 hax)
==
|- ^- @
?: =(80 j)
%= ^$
i +(i)
hax %+ rep 5
:~
(sum a (wac 0 hax))
(sum b (wac 1 hax))
(sum c (wac 2 hax))
(sum d (wac 3 hax))
(sum e (wac 4 hax))
==
==
=+ fx=(con (dis b c) (dis (not 5 1 b) d))
=+ fy=:(mix b c d)
=+ fz=:(con (dis b c) (dis b d) (dis c d))
=+ ^= tem
?: &((gte j 0) (lte j 19))
:(sum (rol 0 5 a) fx e (wac 0 kbx) (wac j wox))
?: &((gte j 20) (lte j 39))
:(sum (rol 0 5 a) fy e (wac 1 kbx) (wac j wox))
?: &((gte j 40) (lte j 59))
:(sum (rol 0 5 a) fz e (wac 2 kbx) (wac j wox))
:(sum (rol 0 5 a) fy e (wac 3 kbx) (wac j wox))
$(j +(j), a tem, b a, c (rol 0 30 b), d c, e d)
::
++ og :: shax-powered rng
~/ %og
|_ a/@
++ rad :: random in range
|= b/@ ^- @
=+ c=(raw (met 0 b))
?:((lth c b) c $(a +(a)))
::
++ rads :: random continuation
|= b/@
=+ r=(rad b)
[r +>.$(a (shas %og-s (mix a r)))]
::
++ raw :: random bits
~/ %raw
|= b/@ ^- @
%+ can
0
=+ c=(shas %og-a (mix b a))
|- ^- (list {@ @})
?: =(0 b)
~
=+ d=(shas %og-b (mix b (mix a c)))
?: (lth b 256)
[[b (end 0 b d)] ~]
[[256 d] $(c d, b (sub b 256))]
::
++ raws :: random bits
|= b/@ :: continuation
=+ r=(raw b)
[r +>.$(a (shas %og-s (mix a r)))]
--
:: ::
:::: 3e: AES encryption (XX removed) ::
:: ::
::
:: ::
:::: 3f: scrambling ::
:: ::
:: ob ::
::
++ un :: =(x (wred (wren x)))
|%
++ wren :: conceal structure
|= pyn/@ ^- @
=+ len=(met 3 pyn)
?: =(0 len)
0
=> .(len (dec len))
=+ mig=(zaft (xafo len (cut 3 [len 1] pyn)))
%+ can 3
%- flop ^- (list {@ @})
:- [1 mig]
|- ^- (list {@ @})
?: =(0 len)
~
=> .(len (dec len))
=+ mog=(zyft :(mix mig (end 3 1 len) (cut 3 [len 1] pyn)))
[[1 mog] $(mig mog)]
::
++ wred :: restore structure
|= cry/@ ^- @
=+ len=(met 3 cry)
?: =(0 len)
0
=> .(len (dec len))
=+ mig=(cut 3 [len 1] cry)
%+ can 3
%- flop ^- (list {@ @})
:- [1 (xaro len (zart mig))]
|- ^- (list {@ @})
?: =(0 len)
~
=> .(len (dec len))
=+ mog=(cut 3 [len 1] cry)
[[1 :(mix mig (end 3 1 len) (zyrt mog))] $(mig mog)]
::
++ xafo |=({a/@ b/@} +((mod (add (dec b) a) 255)))
++ xaro |=({a/@ b/@} +((mod (add (dec b) (sub 255 (mod a 255))) 255)))
::
++ zaft :: forward 255-sbox
|= a/@D
=+ ^= b
0xcc.75bc.86c8.2fb1.9a42.f0b3.79a0.92ca.21f6.1e41.cde5.fcc0.
7e85.51ae.1005.c72d.1246.07e8.7c64.a914.8d69.d9f4.59c2.8038.
1f4a.dca2.6fdf.66f9.f561.a12e.5a16.f7b0.a39f.364e.cb70.7318.
1de1.ad31.63d1.abd4.db68.6a33.134d.a760.edee.5434.493a.e323.
930d.8f3d.3562.bb81.0b24.43cf.bea5.a6eb.52b4.0229.06b2.6704.
78c9.45ec.d75e.58af.c577.b7b9.c40e.017d.90c3.87f8.96fa.1153.
0372.7f30.1c32.ac83.ff17.c6e4.d36d.6b55.e2ce.8c71.8a5b.b6f3.
9d4b.eab5.8b3c.e7f2.a8fe.9574.5de0.bf20.3f15.9784.9939.5f9c.
e609.564f.d8a4.b825.9819.94aa.2c08.8e4c.9b22.477a.2840.3ed6.
3750.6ef1.44dd.89ef.6576.d00a.fbda.9ed2.3b6c.7b0c.bde9.2ade.
5c88.c182.481a.1b0f.2bfd.d591.2726.57ba
(cut 3 [(dec a) 1] b)
::
++ zart :: reverse 255-sbox
|= a/@D
=+ ^= b
0x68.4f07.ea1c.73c9.75c2.efc8.d559.5125.f621.a7a8.8591.5613.
dd52.40eb.65a2.60b7.4bcb.1123.ceb0.1bd6.3c84.2906.b164.19b3.
1e95.5fec.ffbc.f187.fbe2.6680.7c77.d30e.e94a.9414.fd9a.017d.
3a7e.5a55.8ff5.8bf9.c181.e5b6.6ab2.35da.50aa.9293.3bc0.cdc6.
f3bf.1a58.4130.f844.3846.744e.36a0.f205.789e.32d8.5e54.5c22.
0f76.fce7.4569.0d99.d26e.e879.dc16.2df4.887f.1ffe.4dba.6f5d.
bbcc.2663.1762.aed7.af8a.ca20.dbb4.9bc7.a942.834c.105b.c4d4.
8202.3e61.a671.90e6.273d.bdab.3157.cfa4.0c2e.df86.2496.f7ed.
2b48.2a9d.5318.a343.d128.be9c.a5ad.6bb5.6dfa.c5e1.3408.128d.
2c04.0339.97a1.2ff0.49d0.eeb8.6c0a.0b37.b967.c347.d9ac.e072.
e409.7b9f.1598.1d3f.33de.8ce3.8970.8e7a
(cut 3 [(dec a) 1] b)
::
++ zyft :: forward 256-sbox
|= a/@D
=+ ^= b
0xbb49.b71f.b881.b402.17e4.6b86.69b5.1647.115f.dddb.7ca5.
8371.4bd5.19a9.b092.605d.0d9b.e030.a0cc.78ba.5706.4d2d.
986a.768c.f8e8.c4c7.2f1c.effe.3cae.01c0.253e.65d3.3872.
ce0e.7a74.8ac6.daac.7e5c.6479.44ec.4143.3d20.4af0.ee6c.
c828.deca.0377.249f.ffcd.7b4f.eb7d.66f2.8951.042e.595a.
8e13.f9c3.a79a.f788.6199.9391.7fab.6200.4ce5.0758.e2f1.
7594.c945.d218.4248.afa1.e61a.54fb.1482.bea4.96a2.3473.
63c2.e7cb.155b.120a.4ed7.bfd8.b31b.4008.f329.fca3.5380.
9556.0cb2.8722.2bea.e96e.3ac5.d1bc.10e3.2c52.a62a.b1d6.
35aa.d05e.f6a8.0f3b.31ed.559d.09ad.f585.6d21.fd1d.8d67.
370b.26f4.70c1.b923.4684.6fbd.cf8b.5036.0539.9cdc.d93f.
9068.1edf.8f33.b632.d427.97fa.9ee1
(cut 3 [a 1] b)
::
++ zyrt :: reverse 256-sbox
|= a/@D
=+ ^= b
0x9fc8.2753.6e02.8fcf.8b35.2b20.5598.7caa.c9a9.30b0.9b48.
47ce.6371.80f6.407d.00dd.0aa5.ed10.ecb7.0f5a.5c3a.e605.
c077.4337.17bd.9eda.62a4.79a7.ccb8.44cd.8e64.1ec4.5b6b.
1842.ffd8.1dfb.fd07.f2f9.594c.3be3.73c6.2cb6.8438.e434.
8d3d.ea6a.5268.72db.a001.2e11.de8c.88d3.0369.4f7a.87e2.
860d.0991.25d0.16b9.978a.4bf4.2a1a.e96c.fa50.85b5.9aeb.
9dbb.b2d9.a2d1.7bba.66be.e81f.1946.29a8.f5d2.f30c.2499.
c1b3.6583.89e1.ee36.e0b4.6092.937e.d74e.2f6f.513e.9615.
9c5d.d581.e7ab.fe74.f01b.78b1.ae75.af57.0ec2.adc7.3245.
12bf.2314.3967.0806.31dc.cb94.d43f.493c.54a6.0421.c3a1.
1c4a.28ac.fc0b.26ca.5870.e576.f7f1.616d.905f.ef41.33bc.
df4d.225e.2d56.7fd6.1395.a3f8.c582
(cut 3 [a 1] b)
--
::
++ ob
|%
++ feen :: conceal structure v2
|= pyn/@ ^- @
?: &((gte pyn 0x1.0000) (lte pyn 0xffff.ffff))
(add 0x1.0000 (fice (sub pyn 0x1.0000)))
?: &((gte pyn 0x1.0000.0000) (lte pyn 0xffff.ffff.ffff.ffff))
=+ lo=(dis pyn 0xffff.ffff)
=+ hi=(dis pyn 0xffff.ffff.0000.0000)
%+ con hi
$(pyn lo)
pyn
::
++ fend :: restore structure v2
|= cry/@ ^- @
?: &((gte cry 0x1.0000) (lte cry 0xffff.ffff))
(add 0x1.0000 (teil (sub cry 0x1.0000)))
?: &((gte cry 0x1.0000.0000) (lte cry 0xffff.ffff.ffff.ffff))
=+ lo=(dis cry 0xffff.ffff)
=+ hi=(dis cry 0xffff.ffff.0000.0000)
%+ con hi
$(cry lo)
cry
::
++ fice :: adapted from
|= nor/@ :: black and rogaway
^- @ :: "ciphers with
=+ ^= sel :: arbitrary finite
%+ rynd 3 :: domains", 2002
%+ rynd 2
%+ rynd 1
%+ rynd 0
[(mod nor 65.535) (div nor 65.535)]
(add (mul 65.535 -.sel) +.sel)
::
++ teil :: reverse ++fice
|= vip/@
^- @
=+ ^= sel
%+ rund 0
%+ rund 1
%+ rund 2
%+ rund 3
[(mod vip 65.535) (div vip 65.535)]
(add (mul 65.535 -.sel) +.sel)
::
++ rynd :: feistel round
|= {n/@ l/@ r/@}
^- {@ @}
:- r
?~ (mod n 2)
(~(sum fo 65.535) l (muk (snag n raku) 2 r))
(~(sum fo 65.536) l (muk (snag n raku) 2 r))
::
++ rund :: reverse round
|= {n/@ l/@ r/@}
^- {@ @}
:- r
?~ (mod n 2)
(~(dif fo 65.535) l (muk (snag n raku) 2 r))
(~(dif fo 65.536) l (muk (snag n raku) 2 r))
::
++ raku
^- (list @ux)
:~ 0xb76d.5eed
0xee28.1300
0x85bc.ae01
0x4b38.7af7
==
--
::
:::: 3g: molds and mold builders
::
2018-02-11 08:24:22 +03:00
++ coin $~ [%$ %ud 0] :: print format
$% {$$ p/dime} ::
2016-11-24 07:25:07 +03:00
{$blob p/*} ::
{$many p/(list coin)} ::
== ::
++ dime {p/@ta q/@} ::
++ edge {p/hair q/(unit {p/* q/nail})} :: parsing output
++ hair {p/@ud q/@ud} :: parsing trace
++ like |* a/$-(* *) :: generic edge
2017-12-12 05:05:48 +03:00
|: b=`*`[(hair) ~] ::
2016-11-24 07:25:07 +03:00
:- p=(hair -.b) ::
^= q ::
?@ +.b ~ ::
:- ~ ::
u=[p=(a +>-.b) q=[p=(hair -.b) q=(tape +.b)]] ::
++ nail {p/hair q/tape} :: parsing input
++ pint {p/{p/@ q/@} q/{p/@ q/@}} :: line+column range
2017-12-12 05:05:48 +03:00
++ rule _|:($:nail $:edge) :: parsing rule
2016-11-24 07:25:07 +03:00
++ spot {p/path q/pint} :: range in file
++ tone $% {$0 p/*} :: success
{$1 p/(list)} :: blocks
{$2 p/(list {@ta *})} :: error report
== ::
++ toon $% {$0 p/*} :: success
{$1 p/(list)} :: blocks
{$2 p/(list tank)} :: stack trace
== ::
2017-12-12 05:05:48 +03:00
++ wonk =+ veq=$:edge :: product from edge
|% +- $ ?~(q.veq !! p.u.q.veq) ::
-- ::
2016-11-24 07:25:07 +03:00
-- =>
:: ::
:::: 4: layer four ::
:: ::
:: 4a: exotic bases ::
:: 4b: text processing ::
:: 4c: tank printer ::
:: 4d: parsing (tracing) ::
:: 4e: parsing (combinators) ::
:: 4f: parsing (rule builders) ::
:: 4g: parsing (outside caller) ::
:: 4h: parsing (ascii glyphs) ::
:: 4i: parsing (useful idioms) ::
:: 4j: parsing (bases and base digits) ::
:: 4k: atom printing ::
:: 4l: atom parsing ::
:: 4m: formatting functions ::
:: 4n: virtualization ::
:: 4o: molds and mold builders ::
::
~% %qua
+
2016-11-24 07:25:07 +03:00
==
%mute mute
%show show
==
|%
::
:::: 4a: exotic bases
::
++ po :: phonetic base
~/ %po
=+ :- ^= sis :: prefix syllables
'dozmarbinwansamlitsighidfidlissogdirwacsabwissib\
/rigsoldopmodfoglidhopdardorlorhodfolrintogsilmir\
/holpaslacrovlivdalsatlibtabhanticpidtorbolfosdot\
/losdilforpilramtirwintadbicdifrocwidbisdasmidlop\
/rilnardapmolsanlocnovsitnidtipsicropwitnatpanmin\
/ritpodmottamtolsavposnapnopsomfinfonbanmorworsip\
/ronnorbotwicsocwatdolmagpicdavbidbaltimtasmallig\
/sivtagpadsaldivdactansidfabtarmonranniswolmispal\
/lasdismaprabtobrollatlonnodnavfignomnibpagsopral\
/bilhaddocridmocpacravripfaltodtiltinhapmicfanpat\
/taclabmogsimsonpinlomrictapfirhasbosbatpochactid\
/havsaplindibhosdabbitbarracparloddosbortochilmac\
/tomdigfilfasmithobharmighinradmashalraglagfadtop\
/mophabnilnosmilfopfamdatnoldinhatnacrisfotribhoc\
/nimlarfitwalrapsarnalmoslandondanladdovrivbacpol\
/laptalpitnambonrostonfodponsovnocsorlavmatmipfip'
^= dex :: suffix syllables
'zodnecbudwessevpersutletfulpensytdurwepserwylsun\
/rypsyxdyrnuphebpeglupdepdysputlughecryttyvsydnex\
/lunmeplutseppesdelsulpedtemledtulmetwenbynhexfeb\
/pyldulhetmevruttylwydtepbesdexsefwycburderneppur\
/rysrebdennutsubpetrulsynregtydsupsemwynrecmegnet\
/secmulnymtevwebsummutnyxrextebfushepbenmuswyxsym\
/selrucdecwexsyrwetdylmynmesdetbetbeltuxtugmyrpel\
/syptermebsetdutdegtexsurfeltudnuxruxrenwytnubmed\
/lytdusnebrumtynseglyxpunresredfunrevrefmectedrus\
/bexlebduxrynnumpyxrygryxfeptyrtustyclegnemfermer\
/tenlusnussyltecmexpubrymtucfyllepdebbermughuttun\
/bylsudpemdevlurdefbusbeprunmelpexdytbyttyplevmyl\
/wedducfurfexnulluclennerlexrupnedlecrydlydfenwel\
/nydhusrelrudneshesfetdesretdunlernyrsebhulryllud\
/remlysfynwerrycsugnysnyllyndyndemluxfedsedbecmun\
/lyrtesmudnytbyrsenwegfyrmurtelreptegpecnelnevfes'
|%
++ ins ~/ %ins :: parse prefix
|= a/@tas
=+ b=0
|- ^- (unit @)
?:(=(256 b) ~ ?:(=(a (tos b)) [~ b] $(b +(b))))
++ ind ~/ %ind :: parse suffix
|= a/@tas
=+ b=0
|- ^- (unit @)
?:(=(256 b) ~ ?:(=(a (tod b)) [~ b] $(b +(b))))
++ tos ~/ %tos :: fetch prefix
|=(a/@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] sis)))
++ tod ~/ %tod :: fetch suffix
|=(a/@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] dex)))
--
::
++ fa :: base58check
=+ key='123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz'
=+ ^- yek/@ux ~+
=- yek:(roll (rip 3 key) -)
=+ [a=*char b=*@ yek=`@ux`(fil 3 256 0xff)]
|.
[+(b) (mix yek (lsh 3 `@u`a (~(inv fe 3) b)))]
|%
++ cha |=(a/char `(unit @uF)`=+(b=(cut 3 [`@`a 1] yek) ?:(=(b 0xff) ~ `b)))
++ tok
|= a/@ux ^- @ux
=+ b=(pad a)
=- (~(net fe 5) (end 3 4 (shay 32 -)))
(shay (add b (met 3 a)) (lsh 3 b (swp 3 a)))
::
++ pad |=(a/@ =+(b=(met 3 a) ?:((gte b 21) 0 (sub 21 b))))
++ enc |=(a/@ux `@ux`(mix (lsh 3 4 a) (tok a)))
++ den
|= a/@ux ^- (unit @ux)
=+ b=(rsh 3 4 a)
?. =((tok b) (end 3 4 a))
~
`b
--
::
:::: 4b: text processing
::
2016-11-24 07:25:07 +03:00
++ at :: basic printing
|_ a/@
++ r
?: ?& (gte (met 3 a) 2)
|-
?: =(0 a)
&
=+ vis=(end 3 1 a)
?& ?|(=('-' vis) ?&((gte vis 'a') (lte vis 'z')))
$(a (rsh 3 1 a))
==
==
rtam
?: (lte (met 3 a) 2)
rud
rux
::
2018-03-19 06:54:47 +03:00
++ rf `tape`[?-(a %& '&', %| '|', * !!) ~]
2016-11-24 07:25:07 +03:00
++ rn `tape`[?>(=(0 a) '~') ~]
++ rt `tape`['\'' (weld (mesc (trip a)) `tape`['\'' ~])]
++ rta rt
++ rtam `tape`['%' (trip a)]
++ rub `tape`['0' 'b' (rum 2 ~ |=(b/@ (add '0' b)))]
++ rud (rum 10 ~ |=(b/@ (add '0' b)))
++ rum
|= {b/@ c/tape d/$-(@ @)}
^- tape
?: =(0 a)
[(d 0) c]
=+ e=0
|- ^- tape
?: =(0 a)
c
=+ f=&(!=(0 e) =(0 (mod e ?:(=(10 b) 3 4))))
%= $
a (div a b)
c [(d (mod a b)) ?:(f [?:(=(10 b) ',' '-') c] c)]
e +(e)
==
::
++ rup
=+ b=(met 3 a)
^- tape
:- '-'
|- ^- tape
?: (gth (met 5 a) 1)
%+ weld
$(a (rsh 5 1 a), b (sub b 4))
`tape`['-' '-' $(a (end 5 1 a), b 4)]
?: =(0 b)
['~' ~]
?: (lte b 1)
(trip (tos:po a))
|- ^- tape
?: =(2 b)
=+ c=(rsh 3 1 a)
=+ d=(end 3 1 a)
(weld (trip (tod:po c)) (trip (tos:po (mix c d))))
=+ c=(rsh 3 2 a)
=+ d=(end 3 2 a)
(weld ^$(a c, b (met 3 c)) `tape`['-' $(a (mix c d), b 2)])
::
++ ruv
^- tape
:+ '0'
'v'
%^ rum
64
~
|= b/@
?: =(63 b)
'+'
?: =(62 b)
'-'
?:((lth b 26) (add 65 b) ?:((lth b 52) (add 71 b) (sub b 4)))
::
++ rux `tape`['0' 'x' (rum 16 ~ |=(b/@ (add b ?:((lth b 10) 48 87))))]
--
++ cass :: lowercase
|= vib/tape
^- tape
(turn vib |=(a/@ ?.(&((gte a 'A') (lte a 'Z')) a (add 32 a))))
::
++ cuss :: uppercase
|= vib/tape
^- tape
(turn vib |=(a/@ ?.(&((gte a 'a') (lte a 'z')) a (sub a 32))))
::
++ crip |=(a/tape `@t`(rap 3 a)) :: tape to cord
::
++ mesc :: ctrl code escape
|= vib/tape
^- tape
?~ vib
~
?: =('\\' i.vib)
['\\' '\\' $(vib t.vib)]
?: ?|((gth i.vib 126) (lth i.vib 32) =(`@`39 i.vib))
['\\' (welp ~(rux at i.vib) '/' $(vib t.vib))]
[i.vib $(vib t.vib)]
::
++ runt :: prepend repeatedly
|= {{a/@ b/@} c/tape}
^- tape
?: =(0 a)
c
[b $(a (dec a))]
::
++ sand :: atom sanity
|= a/@ta
(flit (sane a))
::
++ sane :: atom sanity
|= a/@ta
|= b/@ ^- ?
2018-03-27 02:55:02 +03:00
?. =(%t (end 3 1 a))
:: XX more and better sanity
::
&
2016-11-24 07:25:07 +03:00
=+ [inx=0 len=(met 3 b)]
?: =(%tas a)
|- ^- ?
?: =(inx len) &
=+ cur=(cut 3 [inx 1] b)
?& ?| &((gte cur 'a') (lte cur 'z'))
&(=('-' cur) !=(0 inx) !=(len inx))
&(&((gte cur '0') (lte cur '9')) !=(0 inx))
==
$(inx +(inx))
==
?: =(%ta a)
|- ^- ?
?: =(inx len) &
=+ cur=(cut 3 [inx 1] b)
?& ?| &((gte cur 'a') (lte cur 'z'))
&((gte cur '0') (lte cur '9'))
|(=('-' cur) =('~' cur) =('_' cur) =('.' cur))
==
$(inx +(inx))
==
|- ^- ?
?: =(0 b) &
=+ cur=(end 3 1 b)
?: &((lth cur 32) !=(10 cur)) |
=+ len=(teff cur)
?& |(=(1 len) =+(i=1 |-(|(=(i len) &((gte (cut 3 [i 1] b) 128) $(i +(i)))))))
$(b (rsh 3 len b))
==
::
2018-03-27 02:55:02 +03:00
++ ruth :: biblical sanity
|= {a/@ta b/*}
^- @
?^ b !!
:: ?. ((sane a) b) !!
b
::
2016-11-24 07:25:07 +03:00
++ trim :: tape split
|= {a/@ b/tape}
^- {p/tape q/tape}
?~ b
[~ ~]
?: =(0 a)
[~ b]
=+ c=$(a (dec a), b t.b)
[[i.b p.c] q.c]
::
++ trip :: cord to tape
~/ %trip
|= a/@ ^- tape
?: =(0 (met 3 a))
~
[^-(@ta (end 3 1 a)) $(a (rsh 3 1 a))]
::
++ teff :: length utf8
|= a/@t ^- @
=+ b=(end 3 1 a)
?: =(0 b)
?>(=(`@`0 a) 0)
?> |((gte b 32) =(10 b))
?:((lte b 127) 1 ?:((lte b 223) 2 ?:((lte b 239) 3 4)))
::
++ turf :: utf8 to utf32
|= a/@t
^- @c
%+ rap 5
|- ^- (list @c)
=+ b=(teff a)
?: =(0 b) ~
=+ ^= c
%+ can 0
%+ turn
^- (list {p/@ q/@})
?+ b !!
$1 [[0 7] ~]
$2 [[8 6] [0 5] ~]
$3 [[16 6] [8 6] [0 4] ~]
$4 [[24 6] [16 6] [8 6] [0 3] ~]
==
|=({p/@ q/@} [q (cut 0 [p q] a)])
?> =((tuft c) (end 3 b a))
[c $(a (rsh 3 b a))]
::
++ tuba :: utf8 to utf32 tape
|= a/tape
^- (list @c)
(rip 5 (turf (rap 3 a))) :: XX horrible
::
++ tufa :: utf32 to utf8 tape
|= a/(list @c)
^- tape
?~ a ""
(weld (rip 3 (tuft i.a)) $(a t.a))
::
++ tuft :: utf32 to utf8 text
|= a/@c
^- @t
%+ rap 3
|- ^- (list @)
?: =(`@`0 a)
~
=+ b=(end 5 1 a)
=+ c=$(a (rsh 5 1 a))
?: (lte b 0x7f)
[b c]
?: (lte b 0x7ff)
:* (mix 0b1100.0000 (cut 0 [6 5] b))
(mix 0b1000.0000 (end 0 6 b))
c
==
?: (lte b 0xffff)
:* (mix 0b1110.0000 (cut 0 [12 4] b))
(mix 0b1000.0000 (cut 0 [6 6] b))
(mix 0b1000.0000 (end 0 6 b))
c
==
:* (mix 0b1111.0000 (cut 0 [18 3] b))
(mix 0b1000.0000 (cut 0 [12 6] b))
(mix 0b1000.0000 (cut 0 [6 6] b))
(mix 0b1000.0000 (end 0 6 b))
c
==
::
++ wack :: knot escape
|= a/@ta
^- @ta
=+ b=(rip 3 a)
%+ rap 3
|- ^- tape
?~ b
~
?: =('~' i.b) ['~' '~' $(b t.b)]
?: =('_' i.b) ['~' '-' $(b t.b)]
[i.b $(b t.b)]
::
++ wick :: knot unescape
|= a/@
^- (unit @ta)
=+ b=(rip 3 a)
=- ?^(b ~ (some (rap 3 (flop c))))
=| c/tape
|- ^- {b/tape c/tape}
?~ b [~ c]
?. =('~' i.b)
$(b t.b, c [i.b c])
?~ t.b [b ~]
?- i.t.b
$'~' $(b t.t.b, c ['~' c])
$'-' $(b t.t.b, c ['_' c])
@ [b ~]
==
::
++ woad :: cord unescape
|= a/@ta
^- @t
%+ rap 3
|- ^- (list @)
?: =(`@`0 a)
~
=+ b=(end 3 1 a)
=+ c=(rsh 3 1 a)
?: =('.' b)
[' ' $(a c)]
?. =('~' b)
[b $(a c)]
=> .(b (end 3 1 c), c (rsh 3 1 c))
?+ b =- (weld (rip 3 (tuft p.d)) $(a q.d))
^= d
=+ d=0
|- ^- {p/@ q/@}
?: =('.' b)
[d c]
?< =(0 c)
%= $
b (end 3 1 c)
c (rsh 3 1 c)
d %+ add (mul 16 d)
%+ sub b
?: &((gte b '0') (lte b '9')) 48
?>(&((gte b 'a') (lte b 'z')) 87)
==
$'.' ['.' $(a c)]
$'~' ['~' $(a c)]
==
::
++ wood :: cord escape
|= a/@t
^- @ta
%+ rap 3
|- ^- (list @)
?: =(`@`0 a)
~
=+ b=(teff a)
=+ c=(turf (end 3 b a))
=+ d=$(a (rsh 3 b a))
?: ?| &((gte c 'a') (lte c 'z'))
&((gte c '0') (lte c '9'))
=(`@`'-' c)
==
[c d]
?+ c
:- '~'
=+ e=(met 2 c)
|- ^- tape
?: =(0 e)
['.' d]
=. e (dec e)
=+ f=(rsh 2 e c)
[(add ?:((lte f 9) 48 87) f) $(c (end 2 e c))]
::
$' ' ['.' d]
$'.' ['~' '.' d]
$'~' ['~' '~' d]
==
::
:::: 4c: tank printer
::
++ wash :: render tank at width
|= {{tab/@ edg/@} tac/tank} ^- wall
(~(win re tac) tab edg)
::
++ re
|_ tac/tank
++ ram
^- tape
?- -.tac
$leaf p.tac
$palm ram(tac [%rose [p.p.tac (weld q.p.tac r.p.tac) s.p.tac] q.tac])
$rose
%+ weld
q.p.tac
|- ^- tape
?~ q.tac
r.p.tac
=+ voz=$(q.tac t.q.tac)
(weld ram(tac i.q.tac) ?~(t.q.tac voz (weld p.p.tac voz)))
==
::
++ win
|= {tab/@ edg/@}
=+ lug=`wall`~
|^ |- ^- wall
?- -.tac
$leaf (rig p.tac)
$palm
?: fit
(rig ram)
?~ q.tac
(rig q.p.tac)
?~ t.q.tac
(rig(tab (add 2 tab), lug $(tac i.q.tac)) q.p.tac)
=> .(q.tac `(list tank)`q.tac)
=+ lyn=(mul 2 (lent q.tac))
=+ ^= qyr
|- ^- wall
?~ q.tac
lug
%= ^$
tac i.q.tac
tab (add tab (sub lyn 2))
lug $(q.tac t.q.tac, lyn (sub lyn 2))
==
(wig(lug qyr) q.p.tac)
::
$rose
?: fit
(rig ram)
=. lug
|- ^- wall
?~ q.tac
?:(=(~ r.p.tac) lug (rig r.p.tac))
^$(tac i.q.tac, lug $(q.tac t.q.tac), tab din)
?: =(~ q.p.tac)
lug
(wig q.p.tac)
==
::
++ din (mod (add 2 tab) (mul 2 (div edg 3)))
++ fit (lte (lent ram) (sub edg tab))
++ rig
|= hom/tape
^- wall
?: (lte (lent hom) (sub edg tab))
[(runt [tab ' '] hom) lug]
=> .(tab (add tab 2), edg (sub edg 2))
=+ mut=(trim (sub edg tab) hom)
:- (runt [(sub tab 2) ' '] ['\\' '/' (weld p.mut `_hom`['\\' '/' ~])])
=> .(hom q.mut)
|-
?~ hom
:- %+ runt
[(sub tab 2) ' ']
['\\' '/' (runt [(sub edg tab) ' '] ['\\' '/' ~])]
lug
=> .(mut (trim (sub edg tab) hom))
[(runt [tab ' '] p.mut) $(hom q.mut)]
::
++ wig
|= hom/tape
^- wall
?~ lug
(rig hom)
=+ lin=(lent hom)
=+ wug=:(add 1 tab lin)
?. =+ mir=i.lug
|- ?~ mir
|
?|(=(0 wug) ?&(=(' ' i.mir) $(mir t.mir, wug (dec wug))))
(rig hom) :: ^ XX regular form?
[(runt [tab ' '] (weld hom `tape`[' ' (slag wug i.lug)])) t.lug]
--
--
++ show :: XX deprecated!
|= vem/*
|^ ^- tank
?: ?=(@ vem)
[%leaf (mesc (trip vem))]
?- vem
{s/~ c/*}
2016-11-24 07:25:07 +03:00
[%leaf '\'' (weld (mesc (tape +.vem)) `tape`['\'' ~])]
::
{s/$a c/@} [%leaf (mesc (trip c.vem))]
{s/$b c/*} (shop c.vem |=(a/@ ~(rub at a)))
{s/{$c p/@} c/*}
:+ %palm
[['.' ~] ['-' ~] ~ ~]
[[%leaf (mesc (trip p.s.vem))] $(vem c.vem) ~]
::
{s/$d c/*} (shop c.vem |=(a/@ ~(rud at a)))
{s/$k c/*} (tank c.vem)
{s/$h c/*}
:+ %rose
[['/' ~] ['/' ~] ~]
=+ yol=((list @ta) c.vem)
(turn yol |=(a/@ta [%leaf (trip a)]))
::
{s/$l c/*} (shol c.vem)
{s/$o c/*}
%= $
vem
:- [%m '%h:<[%d %d].[%d %d]>']
[-.c.vem +<-.c.vem +<+.c.vem +>-.c.vem +>+.c.vem ~]
==
::
{s/$p c/*} (shop c.vem |=(a/@ ~(rup at a)))
{s/$q c/*} (shop c.vem |=(a/@ ~(r at a)))
{s/$r c/*} $(vem [[%r ' ' '{' '}'] c.vem])
{s/$t c/*} (shop c.vem |=(a/@ ~(rt at a)))
{s/$v c/*} (shop c.vem |=(a/@ ~(ruv at a)))
{s/$x c/*} (shop c.vem |=(a/@ ~(rux at a)))
{s/{$m p/@} c/*} (shep p.s.vem c.vem)
{s/{$r p/@} c/*}
$(vem [[%r ' ' (cut 3 [0 1] p.s.vem) (cut 3 [1 1] p.s.vem)] c.vem])
::
{s/{$r p/@ q/@ r/@} c/*}
:+ %rose
:* p=(mesc (trip p.s.vem))
q=(mesc (trip q.s.vem))
r=(mesc (trip r.s.vem))
==
|- ^- (list tank)
?@ c.vem
~
[^$(vem -.c.vem) $(c.vem +.c.vem)]
::
{s/$z c/*} $(vem [[%r %$ %$ %$] c.vem])
* !!
==
++ shep
|= {fom/@ gar/*}
^- tank
=+ l=(met 3 fom)
=+ i=0
:- %leaf
|- ^- tape
?: (gte i l)
~
=+ c=(cut 3 [i 1] fom)
?. =(37 c)
(weld (mesc [c ~]) $(i +(i)))
=+ d=(cut 3 [+(i) 1] fom)
?. .?(gar)
['\\' '#' $(i (add 2 i))]
(weld ~(ram re (show d -.gar)) $(i (add 2 i), gar +.gar))
::
++ shop
|= {aug/* vel/$-(a/@ tape)}
^- tank
?: ?=(@ aug)
[%leaf (vel aug)]
:+ %rose
[[' ' ~] ['[' ~] [']' ~]]
=> .(aug `*`aug)
|- ^- (list tank)
?: ?=(@ aug)
[^$ ~]
[^$(aug -.aug) $(aug +.aug)]
::
++ shol
|= lim/*
:+ %rose
[['.' ~] ~ ~]
|- ^- (list tank)
?: ?=(@ lim) ~
:_ $(lim +.lim)
?+ -.lim (show '#')
~ (show '$')
2016-11-24 07:25:07 +03:00
c/@ (show c.lim)
2018-03-19 06:54:47 +03:00
{%& $1} (show '.')
{%& c/@}
2016-11-24 07:25:07 +03:00
[%leaf '+' ~(rud at c.lim)]
::
2018-03-19 06:54:47 +03:00
{%| @ ~} (show ',')
{%| n/@ ~ c/@}
2016-11-24 07:25:07 +03:00
[%leaf (weld (reap n.lim '^') ?~(c.lim "$" (trip c.lim)))]
==
--
::
:::: 4d: parsing (tracing)
::
++ last |= {zyc/hair naz/hair} :: farther trace
^- hair
?: =(p.zyc p.naz)
?:((gth q.zyc q.naz) zyc naz)
?:((gth p.zyc p.naz) zyc naz)
::
++ lust |= {weq/char naz/hair} :: detect newline
^- hair
?:(=(`@`10 weq) [+(p.naz) 1] [p.naz +(q.naz)])
::
:::: 4e: parsing (combinators)
::
++ bend :: conditional comp
~/ %bend
2017-12-12 05:05:48 +03:00
=+ raq=|*({a/* b/*} [~ u=[a b]])
|%
+- $
~/ %fun
|* {vex/edge sab/rule}
?~ q.vex
vex
=+ yit=(sab q.u.q.vex)
=+ yur=(last p.vex p.yit)
?~ q.yit
[p=yur q=q.vex]
=+ vux=(raq p.u.q.vex p.u.q.yit)
?~ vux
[p=yur q=q.vex]
[p=yur q=[~ u=[p=u.vux q=q.u.q.yit]]]
--
2016-11-24 07:25:07 +03:00
::
++ comp
~/ %comp
2017-12-12 05:05:48 +03:00
=+ raq=|*({a/* b/*} [a b]) :: arbitrary compose
|%
+- $
~/ %fun
|* {vex/edge sab/rule}
~! +<
?~ q.vex
vex
=+ yit=(sab q.u.q.vex)
=+ yur=(last p.vex p.yit)
?~ q.yit
[p=yur q=q.yit]
[p=yur q=[~ u=[p=(raq p.u.q.vex p.u.q.yit) q=q.u.q.yit]]]
--
2016-11-24 07:25:07 +03:00
::
++ fail |=(tub/nail [p=p.tub q=~]) :: never parse
++ glue :: add rule
~/ %glue
|* bus/rule
~/ %fun
|* {vex/edge sab/rule}
(plug vex ;~(pfix bus sab))
::
++ less :: no first and second
|* {vex/edge sab/rule}
?~ q.vex
=+ roq=(sab)
[p=(last p.vex p.roq) q=q.roq]
(fail +<.sab)
::
++ pfix :: discard first rule
~/ %pfix
(comp |*({a/* b/*} b))
::
++ plug :: first then second
~/ %plug
|* {vex/edge sab/rule}
?~ q.vex
vex
=+ yit=(sab q.u.q.vex)
=+ yur=(last p.vex p.yit)
?~ q.yit
[p=yur q=q.yit]
[p=yur q=[~ u=[p=[p.u.q.vex p.u.q.yit] q=q.u.q.yit]]]
::
++ pose :: first or second
~/ %pose
|* {vex/edge sab/rule}
?~ q.vex
=+ roq=(sab)
[p=(last p.vex p.roq) q=q.roq]
vex
::
++ simu :: first and second
|* {vex/edge sab/rule}
?~ q.vex
vex
=+ roq=(sab)
roq
::
++ sfix :: discard second rule
~/ %sfix
(comp |*({a/* b/*} a))
::
:::: 4f: parsing (rule builders)
::
++ bass :: leftmost base
|* {wuc/@ tyd/rule}
%+ cook
|= waq/(list @)
%+ roll
waq
=|({p/@ q/@} |.((add p (mul wuc q))))
tyd
::
++ boss :: rightmost base
|* {wuc/@ tyd/rule}
%+ cook
|= waq/(list @)
%+ reel
waq
=|({p/@ q/@} |.((add p (mul wuc q))))
tyd
::
++ cold :: replace w+ constant
~/ %cold
|* {cus/* sef/rule}
~/ %fun
|= tub/nail
=+ vex=(sef tub)
?~ q.vex
vex
[p=p.vex q=[~ u=[p=cus q=q.u.q.vex]]]
::
++ cook :: apply gate
~/ %cook
|* {poq/$-(* *) sef/rule}
~/ %fun
|= tub/nail
=+ vex=(sef tub)
?~ q.vex
vex
[p=p.vex q=[~ u=[p=(poq p.u.q.vex) q=q.u.q.vex]]]
::
++ easy :: always parse
~/ %easy
|* huf/*
~/ %fun
|= tub/nail
^- (like _huf)
[p=p.tub q=[~ u=[p=huf q=tub]]]
::
2018-03-19 05:40:38 +03:00
++ fuss
2016-11-24 07:25:07 +03:00
|= {sic/@t non/@t}
;~(pose (cold %& (jest sic)) (cold %| (jest non)))
::
++ full :: has to fully parse
|* sef/rule
|= tub/nail
=+ vex=(sef tub)
?~(q.vex vex ?:(=(~ q.q.u.q.vex) vex [p=p.vex q=~]))
::
++ funk :: add to tape first
|* {pre/tape sef/rule}
|= tub/nail
(sef p.tub (weld pre q.tub))
::
++ here :: place-based apply
~/ %here
2017-12-12 05:05:48 +03:00
=+ [hez=|=({a/pint b/*} [a b]) sef=*rule]
|%
+- $
~/ %fun
|= tub/nail
=+ vex=(sef tub)
?~ q.vex
vex
[p=p.vex q=[~ u=[p=(hez [p.tub p.q.u.q.vex] p.u.q.vex) q=q.u.q.vex]]]
--
2016-11-24 07:25:07 +03:00
::
++ inde |* sef/rule :: indentation block
|= nail ^+ (sef)
=+ [har tap]=[p q]:+<
=+ lev=(fil 3 (dec q.har) ' ')
=+ eol=(just `@t`10)
=+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap)
;~(simu ;~(plug eol eol) eol)
?~ q.roq roq
=+ vex=(sef har(q 1) p.u.q.roq)
=+ fur=p.vex(q (add (dec q.har) q.p.vex))
?~ q.vex vex(p fur)
=- vex(p fur, u.q -)
:+ &3.vex
&4.vex(q.p (add (dec q.har) q.p.&4.vex))
=+ res=|4.vex
|- ?~ res |4.roq
?. =(10 -.res) [-.res $(res +.res)]
(welp [`@t`10 (trip lev)] $(res +.res))
::
2016-11-24 07:25:07 +03:00
++ ifix
|* {fel/{rule rule} hof/rule}
~! +<
~! +<:-.fel
~! +<:+.fel
;~(pfix -.fel ;~(sfix hof +.fel))
::
++ jest :: match a cord
|= daf/@t
|= tub/nail
=+ fad=daf
|- ^- (like @t)
?: =(`@`0 daf)
[p=p.tub q=[~ u=[p=fad q=tub]]]
?: |(?=(~ q.tub) !=((end 3 1 daf) i.q.tub))
2016-11-24 07:25:07 +03:00
(fail tub)
$(p.tub (lust i.q.tub p.tub), q.tub t.q.tub, daf (rsh 3 1 daf))
::
++ just :: XX redundant, jest
~/ %just :: match a char
|= daf/char
~/ %fun
|= tub/nail
^- (like char)
?~ q.tub
(fail tub)
?. =(daf i.q.tub)
(fail tub)
(next tub)
::
++ knee :: callbacks
2017-12-14 05:44:18 +03:00
=| {gar/* sef/_|.(*rule)}
|% +- $
|= tub/nail
^- (like _gar)
((sef) tub)
--
2016-11-24 07:25:07 +03:00
::
++ mask :: match char in set
~/ %mask
|= bud/(list char)
~/ %fun
|= tub/nail
^- (like char)
?~ q.tub
(fail tub)
?. (lien bud |=(a/char =(i.q.tub a)))
(fail tub)
(next tub)
::
++ more :: separated, *
|* {bus/rule fel/rule}
;~(pose (most bus fel) (easy ~))
::
++ most :: separated, +
|* {bus/rule fel/rule}
;~(plug fel (star ;~(pfix bus fel)))
::
++ next :: consume a char
|= tub/nail
^- (like char)
?~ q.tub
(fail tub)
=+ zac=(lust i.q.tub p.tub)
[zac [~ i.q.tub [zac t.q.tub]]]
::
++ perk :: parse cube fork
2016-11-24 07:25:07 +03:00
|* a/(pole @tas)
?~ a fail
;~ pose
2016-11-24 07:25:07 +03:00
(cold -.a (jest -.a))
$(a +.a)
==
::
++ pick :: rule for ++each
|* {a/rule b/rule}
;~ pose
(stag %& a)
(stag %| b)
==
++ plus |*(fel/rule ;~(plug fel (star fel))) ::
++ punt |*({a/rule} ;~(pose (stag ~ a) (easy ~))) ::
++ sear :: conditional cook
|* {pyq/$-(* (unit)) sef/rule}
|= tub/nail
=+ vex=(sef tub)
?~ q.vex
vex
=+ gey=(pyq p.u.q.vex)
?~ gey
[p=p.vex q=~]
[p=p.vex q=[~ u=[p=u.gey q=q.u.q.vex]]]
::
++ shim :: match char in range
~/ %shim
|= {les/@ mos/@}
~/ %fun
|= tub/nail
^- (like char)
?~ q.tub
(fail tub)
?. ?&((gte i.q.tub les) (lte i.q.tub mos))
(fail tub)
(next tub)
::
++ stag :: add a label
~/ %stag
|* {gob/* sef/rule}
~/ %fun
|= tub/nail
=+ vex=(sef tub)
?~ q.vex
vex
[p=p.vex q=[~ u=[p=[gob p.u.q.vex] q=q.u.q.vex]]]
::
++ stet ::
|* leh/(list {?(@ {@ @}) rule})
|-
?~ leh
~
[i=[p=-.i.leh q=+.i.leh] t=$(leh t.leh)]
::
++ stew :: switch by first char
~/ %stew
|* leh/(list {p/?(@ {@ @}) q/rule}) :: char+range keys
=+ ^= wor :: range complete lth
|= {ort/?(@ {@ @}) wan/?(@ {@ @})}
?@ ort
?@(wan (lth ort wan) (lth ort -.wan))
?@(wan (lth +.ort wan) (lth +.ort -.wan))
=+ ^= hel :: build parser map
=+ hel=`(tree _?>(?=(^ leh) i.leh))`~
|- ^+ hel
?~ leh
~
=+ yal=$(leh t.leh)
|- ^+ hel
?~ yal
[i.leh ~ ~]
?: (wor p.i.leh p.n.yal)
=+ nuc=$(yal l.yal)
?> ?=(^ nuc)
?: (vor p.n.yal p.n.nuc)
[n.yal nuc r.yal]
[n.nuc l.nuc [n.yal r.nuc r.yal]]
=+ nuc=$(yal r.yal)
?> ?=(^ nuc)
?: (vor p.n.yal p.n.nuc)
[n.yal l.yal nuc]
[n.nuc [n.yal l.yal l.nuc] r.nuc]
~% %fun ..^$ ~
|= tub/nail
?~ q.tub
(fail tub)
|-
?~ hel
(fail tub)
?: ?@ p.n.hel
=(p.n.hel i.q.tub)
?&((gte i.q.tub -.p.n.hel) (lte i.q.tub +.p.n.hel))
:: (q.n.hel [(lust i.q.tub p.tub) t.q.tub])
(q.n.hel tub)
?: (wor i.q.tub p.n.hel)
$(hel l.hel)
$(hel r.hel)
::
++ slug ::
2017-12-14 05:44:18 +03:00
|* raq/_=>(~ |*({a/* b/*} [a b]))
2016-11-24 07:25:07 +03:00
|* {bus/rule fel/rule}
;~((comp raq) fel (stir +<+.raq raq ;~(pfix bus fel)))
::
++ star :: 0 or more times
|* fel/rule
(stir `(list _(wonk *fel))`~ |*({a/* b/*} [a b]) fel)
::
++ stir
~/ %stir
2017-12-14 05:44:18 +03:00
|* {rud/* raq/_=>(~ |*({a/* b/*} [a b])) fel/rule}
2016-11-24 07:25:07 +03:00
~/ %fun
|= tub/nail
^- (like _rud)
=+ vex=(fel tub)
?~ q.vex
[p.vex [~ rud tub]]
=+ wag=$(tub q.u.q.vex)
?> ?=(^ q.wag)
[(last p.vex p.wag) [~ (raq p.u.q.vex p.u.q.wag) q.u.q.wag]]
::
++ stun :: parse several times
|* {lig/{@ @} fel/rule}
|= tub/nail
^- (like (list _(wonk (fel))))
?: =(0 +.lig)
[p.tub [~ ~ tub]]
=+ vex=(fel tub)
?~ q.vex
?: =(0 -.lig)
[p.vex [~ ~ tub]]
vex
=+ ^= wag %= $
-.lig ?:(=(0 -.lig) 0 (dec -.lig))
+.lig ?:(=(0 +.lig) 0 (dec +.lig))
tub q.u.q.vex
==
?~ q.wag
wag
[p.wag [~ [p.u.q.vex p.u.q.wag] q.u.q.wag]]
::
:::: 4g: parsing (outside caller)
::
++ rash |*({naf/@ sab/rule} (scan (trip naf) sab)) ::
++ rose |* {los/tape sab/rule}
=+ vex=(sab [[1 1] los])
=+ len=(lent los)
?. =(+(len) q.p.vex) [%| p=(dec q.p.vex)]
?~ q.vex
[%& p=~]
[%& p=[~ u=p.u.q.vex]]
++ rush |*({naf/@ sab/rule} (rust (trip naf) sab))
++ rust |* {los/tape sab/rule}
=+ vex=((full sab) [[1 1] los])
?~(q.vex ~ [~ u=p.u.q.vex])
++ scan |* {los/tape sab/rule}
=+ vex=((full sab) [[1 1] los])
?~ q.vex
~_ (show [%m '{%d %d}'] p.p.vex q.p.vex ~)
~_(leaf+"syntax error" !!)
p.u.q.vex
::
:::: 4h: parsing (ascii glyphs)
::
++ ace (just ' ')
++ bar (just '|')
++ bas (just '\\')
++ buc (just '$')
++ cab (just '_')
++ cen (just '%')
++ col (just ':')
++ com (just ',')
++ dot (just '.')
++ gal (just '<')
++ gar (just '>')
2018-03-19 06:38:01 +03:00
++ vat (just '@')
2016-11-24 07:25:07 +03:00
++ hax (just '#')
2018-03-14 07:36:10 +03:00
++ hep (just '-')
2016-11-24 07:25:07 +03:00
++ ket (just '^')
2018-03-19 06:38:01 +03:00
++ leb (just '{')
2018-03-14 07:36:10 +03:00
++ lit (just '(')
++ lac (just '[')
2016-11-24 07:25:07 +03:00
++ lus (just '+')
2018-03-14 07:36:10 +03:00
++ mic (just ';')
++ net (just '/')
++ pad (just '&')
++ rac (just ']')
2018-03-19 06:38:01 +03:00
++ reb (just '}')
2018-03-14 07:36:10 +03:00
++ rit (just ')')
++ say (just '\'')
2016-11-24 07:25:07 +03:00
++ sig (just '~')
++ tar (just '*')
++ tec (just '`')
++ tis (just '=')
2018-04-14 08:31:53 +03:00
++ toc (just '"') :: XX deprecated
2018-04-13 01:42:39 +03:00
++ yel (just '"')
2016-11-24 07:25:07 +03:00
++ wut (just '?')
++ zap (just '!')
::
:::: 4i: parsing (useful idioms)
::
++ alf ;~(pose low hig) :: alphabetic
++ aln ;~(pose low hig nud) :: alphanumeric
++ alp ;~(pose low hig nud hep) :: alphanumeric and -
++ bet ;~(pose (cold 2 hep) (cold 3 lus)) :: axis syntax - +
++ bin (bass 2 (most gon but)) :: binary to atom
++ but (cook |=(a/@ (sub a '0')) (shim '0' '1')) :: binary digit
++ cit (cook |=(a/@ (sub a '0')) (shim '0' '7')) :: octal digit
++ dem (bass 10 (most gon dit)) :: decimal to atom
++ dit (cook |=(a/@ (sub a '0')) (shim '0' '9')) :: decimal digit
++ dog ;~(plug dot gay) :: . number separator
++ doh ;~(plug ;~(plug hep hep) gay) :: -- phon separator
++ dun (cold ~ ;~(plug hep hep)) :: -- (stop) to ~
++ duz (cold ~ ;~(plug tis tis)) :: == (stet) to ~
++ gah (mask [`@`10 ' ' ~]) :: newline or ace
++ gap (cold ~ ;~(plug gaq (star ;~(pose vul gah)))) :: plural space
++ gaq ;~ pose :: end of line
(just `@`10)
;~(plug gah ;~(pose gah vul))
vul
==
++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white
++ gay ;~(pose gap (easy ~)) ::
2018-03-14 07:36:10 +03:00
++ gon ;~(pose ;~(plug bas gay net) (easy ~)) :: long numbers \ /
2016-11-24 07:25:07 +03:00
++ gul ;~(pose (cold 2 gal) (cold 3 gar)) :: axis syntax < >
++ hex (bass 16 (most gon hit)) :: hex to atom
++ hig (shim 'A' 'Z') :: uppercase
++ hit ;~ pose :: hex digits
dit
(cook |=(a/char (sub a 87)) (shim 'a' 'f'))
(cook |=(a/char (sub a 55)) (shim 'A' 'F'))
==
++ iny :: indentation block
|* sef/rule
|= nail ^+ (sef)
=+ [har tap]=[p q]:+<
=+ lev=(fil 3 (dec q.har) ' ')
=+ eol=(just `@t`10)
=+ =- roq=((star ;~(pose prn ;~(sfix eol (jest lev)) -)) har tap)
;~(simu ;~(plug eol eol) eol)
?~ q.roq roq
=+ vex=(sef har(q 1) p.u.q.roq)
=+ fur=p.vex(q (add (dec q.har) q.p.vex))
?~ q.vex vex(p fur)
=- vex(p fur, u.q -)
:+ &3.vex
&4.vex(q.p (add (dec q.har) q.p.&4.vex))
=+ res=|4.vex
|- ?~ res |4.roq
?. =(10 -.res) [-.res $(res +.res)]
(welp [`@t`10 (trip lev)] $(res +.res))
::
++ low (shim 'a' 'z') :: lowercase
++ mes %+ cook :: hexbyte
|=({a/@ b/@} (add (mul 16 a) b))
;~(plug hit hit)
++ nix (boss 256 (star ;~(pose aln cab))) ::
++ nud (shim '0' '9') :: numeric
2017-04-05 03:33:20 +03:00
++ prn ;~(less (just `@`127) (shim 32 256)) :: non-control
2016-11-24 07:25:07 +03:00
++ qat ;~ pose :: chars in blockcord
prn
;~(less ;~(plug (just `@`10) soz) (just `@`10))
==
++ qit ;~ pose :: chars in a cord
2018-03-14 07:36:10 +03:00
;~(less bas say prn)
;~(pfix bas ;~(pose bas say mes)) :: escape chars
2016-11-24 07:25:07 +03:00
==
2018-03-14 07:36:10 +03:00
++ qut ;~ simu say :: cord
2016-11-24 07:25:07 +03:00
;~ pose
;~ less soz
2018-03-14 07:36:10 +03:00
(ifix [say say] (boss 256 (more gon qit)))
2016-11-24 07:25:07 +03:00
==
=+ hed=;~(pose ;~(plug (plus ace) vul) (just '\0a'))
%- iny %+ ifix
:- ;~(plug soz hed)
;~(plug (just '\0a') soz)
(boss 256 (star qat))
==
==
2018-03-14 07:36:10 +03:00
++ soz ;~(plug say say say) :: delimiting '''
2016-11-24 07:25:07 +03:00
++ sym :: symbol
%+ cook
|=(a/tape (rap 3 ^-((list @) a)))
;~(plug low (star ;~(pose nud low hep)))
::
++ ven ;~ (comp |=({a/@ b/@} (peg a b))) :: +>- axis syntax
bet
=+ hom=`?`|
|= tub/nail
^- (like @)
=+ vex=?:(hom (bet tub) (gul tub))
?~ q.vex
[p.tub [~ 1 tub]]
=+ wag=$(p.tub p.vex, hom !hom, tub q.u.q.vex)
?> ?=(^ q.wag)
[p.wag [~ (peg p.u.q.vex p.u.q.wag) q.u.q.wag]]
==
++ vit :: base64 digit
;~ pose
(cook |=(a/@ (sub a 65)) (shim 'A' 'Z'))
(cook |=(a/@ (sub a 71)) (shim 'a' 'z'))
(cook |=(a/@ (add a 4)) (shim '0' '9'))
(cold 62 (just '-'))
(cold 63 (just '+'))
==
++ vul %+ cold ~ :: comments
;~ plug col col
(star prn)
(just `@`10)
==
::
:::: 4j: parsing (bases and base digits)
::
++ ab
|%
++ bix (bass 16 (stun [2 2] six))
++ fem (sear |=(a/@ (cha:fa a)) aln)
++ haf (bass 256 ;~(plug tep tiq (easy ~)))
++ hef %+ sear |=(a/@ ?:(=(a 0) ~ (some a)))
%+ bass 256
;~(plug tip tiq (easy ~))
++ hif (bass 256 ;~(plug tip tiq (easy ~)))
++ hof (bass 0x1.0000 ;~(plug hef (stun [1 3] ;~(pfix hep hif))))
++ huf (bass 0x1.0000 ;~(plug hef (stun [0 3] ;~(pfix hep hif))))
++ hyf (bass 0x1.0000 ;~(plug hif (stun [3 3] ;~(pfix hep hif))))
++ pev (bass 32 ;~(plug sev (stun [0 4] siv)))
++ pew (bass 64 ;~(plug sew (stun [0 4] siw)))
++ piv (bass 32 (stun [5 5] siv))
++ piw (bass 64 (stun [5 5] siw))
++ qeb (bass 2 ;~(plug seb (stun [0 3] sib)))
++ qex (bass 16 ;~(plug sex (stun [0 3] hit)))
++ qib (bass 2 (stun [4 4] sib))
++ qix (bass 16 (stun [4 4] six))
++ seb (cold 1 (just '1'))
++ sed (cook |=(a/@ (sub a '0')) (shim '1' '9'))
++ sev ;~(pose sed sov)
++ sew ;~(pose sed sow)
++ sex ;~(pose sed sox)
++ sib (cook |=(a/@ (sub a '0')) (shim '0' '1'))
++ sid (cook |=(a/@ (sub a '0')) (shim '0' '9'))
++ siv ;~(pose sid sov)
++ siw ;~(pose sid sow)
++ six ;~(pose sid sox)
++ sov (cook |=(a/@ (sub a 87)) (shim 'a' 'v'))
++ sow ;~ pose
(cook |=(a/@ (sub a 87)) (shim 'a' 'z'))
(cook |=(a/@ (sub a 29)) (shim 'A' 'Z'))
(cold 62 (just '-'))
(cold 63 (just '~'))
==
++ sox (cook |=(a/@ (sub a 87)) (shim 'a' 'f'))
++ ted (bass 10 ;~(plug sed (stun [0 2] sid)))
++ tep (sear |=(a/@ ?:(=(a 'doz') ~ (ins:po a))) til)
++ tip (sear |=(a/@ (ins:po a)) til)
++ tiq (sear |=(a/@ (ind:po a)) til)
++ tid (bass 10 (stun [3 3] sid))
++ til (boss 256 (stun [3 3] low))
++ urs %+ cook
|=(a/tape (rap 3 ^-((list @) a)))
(star ;~(pose nud low hep dot sig cab))
++ urt %+ cook
|=(a/tape (rap 3 ^-((list @) a)))
(star ;~(pose nud low hep dot sig))
++ urx %+ cook
|=(a/tape (rap 3 ^-((list @) a)))
%- star
;~ pose
2016-11-24 07:25:07 +03:00
nud
low
hep
cab
(cold ' ' dot)
(cook tuft (ifix [sig dot] hex))
;~(pfix sig ;~(pose sig dot))
==
2018-03-14 07:36:10 +03:00
++ voy ;~(pfix bas ;~(pose bas say bix))
2016-11-24 07:25:07 +03:00
--
++ ag
|%
++ ape |*(fel/rule ;~(pose (cold 0 (just '0')) fel))
++ bay (ape (bass 16 ;~(plug qeb:ab (star ;~(pfix dog qib:ab)))))
++ bip =+ tod=(ape qex:ab)
(bass 0x1.0000 ;~(plug tod (stun [7 7] ;~(pfix dog tod))))
++ dem (ape (bass 1.000 ;~(plug ted:ab (star ;~(pfix dog tid:ab)))))
++ dim (ape dip)
++ dip (bass 10 ;~(plug sed:ab (star sid:ab)))
++ dum (bass 10 (plus sid:ab))
++ fed %+ cook fend:ob
;~ pose
%+ bass 0x1.0000.0000.0000.0000 :: oversized
;~ plug
huf:ab
(plus ;~(pfix doh hyf:ab))
==
hof:ab :: planet or moon
haf:ab :: star
tiq:ab :: galaxy
==
++ fim (sear den:fa (bass 58 (plus fem:ab)))
++ hex (ape (bass 0x1.0000 ;~(plug qex:ab (star ;~(pfix dog qix:ab)))))
++ lip =+ tod=(ape ted:ab)
(bass 256 ;~(plug tod (stun [3 3] ;~(pfix dog tod))))
++ mot ;~ pose
;~ pfix
(just '1')
(cook |=(a/@ (add 10 (sub a '0'))) (shim '0' '2'))
==
sed:ab
==
++ viz (ape (bass 0x200.0000 ;~(plug pev:ab (star ;~(pfix dog piv:ab)))))
++ vum (bass 32 (plus siv:ab))
++ wiz (ape (bass 0x4000.0000 ;~(plug pew:ab (star ;~(pfix dog piw:ab)))))
--
++ mu
|_ {top/@ bot/@}
++ zag [p=(end 4 1 (add top bot)) q=bot]
++ zig [p=(end 4 1 (add top (sub 0x1.0000 bot))) q=bot]
++ zug (mix (lsh 4 1 top) bot)
--
++ ne
|_ tig/@
++ c (cut 3 [tig 1] key:fa)
++ d (add tig '0')
++ x ?:((gte tig 10) (add tig 87) d)
++ v ?:((gte tig 10) (add tig 87) d)
++ w ?:(=(tig 63) '~' ?:(=(tig 62) '-' ?:((gte tig 36) (add tig 29) x)))
--
::
:::: 4k: atom printing
::
2017-12-14 05:44:18 +03:00
++ co
2016-11-24 07:25:07 +03:00
~% %co ..co ~
=< |_ lot/coin
++ rear |=(rom/tape =>(.(rep rom) rend))
++ rent `@ta`(rap 3 rend)
++ rend
^- tape
?: ?=($blob -.lot)
['~' '0' ((v-co 1) (jam p.lot))]
?: ?=($many -.lot)
:- '.'
|- ^- tape
?~ p.lot
['_' '_' rep]
['_' (weld (trip (wack rent(lot i.p.lot))) $(p.lot t.p.lot))]
=+ [yed=(end 3 1 p.p.lot) hay=(cut 3 [1 1] p.p.lot)]
|- ^- tape
?+ yed (z-co q.p.lot)
$c ['~' '-' (weld (rip 3 (wood (tuft q.p.lot))) rep)]
$d
?+ hay (z-co q.p.lot)
$a
=+ yod=(yore q.p.lot)
=> ^+(. .(rep ?~(f.t.yod rep ['.' (s-co f.t.yod)])))
=> ^+ .
%= .
rep
?: &(=(~ f.t.yod) =(0 h.t.yod) =(0 m.t.yod) =(0 s.t.yod))
rep
=> .(rep ['.' (y-co s.t.yod)])
=> .(rep ['.' (y-co m.t.yod)])
['.' '.' (y-co h.t.yod)]
==
=> .(rep ['.' (a-co d.t.yod)])
=> .(rep ['.' (a-co m.yod)])
=> .(rep ?:(a.yod rep ['-' rep]))
['~' (a-co y.yod)]
::
$r
=+ yug=(yell q.p.lot)
=> ^+(. .(rep ?~(f.yug rep ['.' (s-co f.yug)])))
:- '~'
?: &(=(0 d.yug) =(0 m.yug) =(0 h.yug) =(0 s.yug))
['s' '0' rep]
=> ^+(. ?:(=(0 s.yug) . .(rep ['.' 's' (a-co s.yug)])))
=> ^+(. ?:(=(0 m.yug) . .(rep ['.' 'm' (a-co m.yug)])))
=> ^+(. ?:(=(0 h.yug) . .(rep ['.' 'h' (a-co h.yug)])))
=> ^+(. ?:(=(0 d.yug) . .(rep ['.' 'd' (a-co d.yug)])))
+.rep
==
::
$f
?: =(& q.p.lot)
['.' 'y' rep]
?:(=(| q.p.lot) ['.' 'n' rep] (z-co q.p.lot))
::
$n ['~' rep]
$i
?+ hay (z-co q.p.lot)
$f ((ro-co [3 10 4] |=(a/@ ~(d ne a))) q.p.lot)
$s ((ro-co [4 16 8] |=(a/@ ~(x ne a))) q.p.lot)
==
::
$p
=+ sxz=(feen:ob q.p.lot)
=+ dyx=(met 3 sxz)
:- '~'
?: (lte dyx 1)
(weld (trip (tod:po sxz)) rep)
=+ dyy=(met 4 sxz)
=+ imp=*@
|- ^- tape
?: =(imp dyy)
rep
%= $
sxz (rsh 4 1 sxz)
imp +(imp)
rep
=+ log=(end 4 1 sxz)
;: weld
(trip (tos:po (rsh 3 1 log)))
(trip (tod:po (end 3 1 log)))
?:(=((mod imp 4) 0) ?:(=(imp 0) "" "--") "-")
rep
==
==
::
$r
?+ hay (z-co q.p.lot)
$d ['.' '~' (r-co (rlyd q.p.lot))]
$h ['.' '~' '~' (r-co (rlyh q.p.lot))]
$q ['.' '~' '~' '~' (r-co (rlyq q.p.lot))]
$s ['.' (r-co (rlys q.p.lot))]
==
::
$u
?: ?=($c hay)
%+ welp ['0' 'c' (reap (pad:fa q.p.lot) '1')]
(c-co (enc:fa q.p.lot))
=- (weld p.gam ?:(=(0 q.p.lot) `tape`['0' ~] q.gam))
^= gam ^- {p/tape q/tape}
?+ hay [~ ((ox-co [10 3] |=(a/@ ~(d ne a))) q.p.lot)]
$b [['0' 'b' ~] ((ox-co [2 4] |=(a/@ ~(d ne a))) q.p.lot)]
$i [['0' 'i' ~] ((d-co 1) q.p.lot)]
$x [['0' 'x' ~] ((ox-co [16 4] |=(a/@ ~(x ne a))) q.p.lot)]
$v [['0' 'v' ~] ((ox-co [32 5] |=(a/@ ~(x ne a))) q.p.lot)]
$w [['0' 'w' ~] ((ox-co [64 5] |=(a/@ ~(w ne a))) q.p.lot)]
==
::
$s
%+ weld
?:((syn:si q.p.lot) "--" "-")
$(yed 'u', q.p.lot (abs:si q.p.lot))
::
$t
?: =('a' hay)
?: =('s' (cut 3 [2 1] p.p.lot))
(weld (rip 3 q.p.lot) rep)
['~' '.' (weld (rip 3 q.p.lot) rep)]
['~' '~' (weld (rip 3 (wood q.p.lot)) rep)]
==
--
=+ rep=*tape
=< |%
++ a-co |=(dat/@ ((d-co 1) dat))
++ c-co (em-co [58 1] |=({? b/@ c/tape} [~(c ne b) c]))
++ d-co |=(min/@ (em-co [10 min] |=({? b/@ c/tape} [~(d ne b) c])))
++ r-co
|= a/dn
?: ?=({$i *} a) (weld ?:(s.a "inf" "-inf") rep)
?: ?=({$n *} a) (weld "nan" rep)
=+ ^= e %+ ed-co [10 1]
|= {a/? b/@ c/tape}
?: a [~(d ne b) '.' c]
[~(d ne b) c]
=+ ^= f
=>(.(rep ~) (e a.a))
=. e.a (sum:si e.a (sun:si (dec +.f)))
=+ b=?:((syn:si e.a) "e" "e-")
=> .(rep ?~(e.a rep (weld b ((d-co 1) (abs:si e.a)))))
=> .(rep (weld -.f rep))
?:(s.a rep ['-' rep])
::
++ s-co
|= esc/(list @) ^- tape
?~ esc
rep
:- '.'
=>(.(rep $(esc t.esc)) ((x-co 4) i.esc))
::
++ v-co |=(min/@ (em-co [32 min] |=({? b/@ c/tape} [~(v ne b) c])))
++ w-co |=(min/@ (em-co [64 min] |=({? b/@ c/tape} [~(w ne b) c])))
++ x-co |=(min/@ (em-co [16 min] |=({? b/@ c/tape} [~(x ne b) c])))
++ y-co |=(dat/@ ((d-co 2) dat))
++ z-co |=(dat/@ `tape`['0' 'x' ((x-co 1) dat)])
--
|%
++ em-co
|= {{bas/@ min/@} par/$-({? @ tape} tape)}
|= hol/@
^- tape
?: &(=(0 hol) =(0 min))
rep
=+ [rad=(mod hol bas) dar=(div hol bas)]
%= $
min ?:(=(0 min) 0 (dec min))
hol dar
rep (par =(0 dar) rad rep)
==
::
++ ed-co
|= {{bas/@ min/@} par/$-({? @ tape} tape)}
=+ [fir=& cou=0]
|= hol/@
^- {tape @}
?: &(=(0 hol) =(0 min))
[rep cou]
=+ [rad=(mod hol bas) dar=(div hol bas)]
%= $
min ?:(=(0 min) 0 (dec min))
hol dar
rep (par &(=(0 dar) !fir) rad rep)
fir |
cou +(cou)
==
::
++ ox-co
|= {{bas/@ gop/@} dug/$-(@ @)}
%+ em-co
[|-(?:(=(0 gop) 1 (mul bas $(gop (dec gop))))) 0]
|= {top/? seg/@ res/tape}
%+ weld
?:(top ~ `tape`['.' ~])
%. seg
%+ em-co(rep res)
[bas ?:(top 0 gop)]
|=({? b/@ c/tape} [(dug b) c])
::
++ ro-co
|= {{buz/@ bas/@ dop/@} dug/$-(@ @)}
|= hol/@
^- tape
?: =(0 dop)
rep
=> .(rep $(dop (dec dop)))
:- '.'
%- (em-co [bas 1] |=({? b/@ c/tape} [(dug b) c]))
[(cut buz [(dec dop) 1] hol)]
--
::
:::: 4l: atom parsing
::
++ so
~% %so + ~
|%
++ bisk
~+
;~ pose
;~ pfix (just '0')
;~ pose
(stag %ub ;~(pfix (just 'b') bay:ag))
(stag %uc ;~(pfix (just 'c') fim:ag))
(stag %ui ;~(pfix (just 'i') dim:ag))
(stag %ux ;~(pfix (just 'x') hex:ag))
(stag %uv ;~(pfix (just 'v') viz:ag))
(stag %uw ;~(pfix (just 'w') wiz:ag))
==
==
(stag %ud dem:ag)
==
++ crub
~+
;~ pose
%+ cook
|=(det/date `dime`[%da (year det)])
;~ plug
%+ cook
|=({a/@ b/?} [b a])
;~(plug dim:ag ;~(pose (cold | hep) (easy &)))
;~(pfix dot mot:ag) :: month
;~(pfix dot dip:ag) :: day
;~ pose
;~ pfix
;~(plug dot dot)
;~ plug
dum:ag
;~(pfix dot dum:ag)
;~(pfix dot dum:ag)
;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
==
==
(easy [0 0 0 ~])
==
==
::
%+ cook
|= {a/(list {p/?($d $h $m $s) q/@}) b/(list @)}
=+ rop=`tarp`[0 0 0 0 b]
|- ^- dime
?~ a
[%dr (yule rop)]
?- p.i.a
$d $(a t.a, d.rop (add q.i.a d.rop))
$h $(a t.a, h.rop (add q.i.a h.rop))
$m $(a t.a, m.rop (add q.i.a m.rop))
$s $(a t.a, s.rop (add q.i.a s.rop))
==
;~ plug
%+ most
dot
;~ pose
;~(pfix (just 'd') (stag %d dim:ag))
;~(pfix (just 'h') (stag %h dim:ag))
;~(pfix (just 'm') (stag %m dim:ag))
;~(pfix (just 's') (stag %s dim:ag))
==
;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
==
::
(stag %p fed:ag)
;~(pfix dot (stag %ta urs:ab))
;~(pfix sig (stag %t urx:ab))
;~(pfix hep (stag %c (cook turf urx:ab)))
==
++ nuck
~/ %nuck |= a/nail %. a
%+ knee *coin |. ~+
%- stew
^. stet ^. limo
:~ :- ['a' 'z'] (cook |=(a/@ta [%$ %tas a]) sym)
:- ['0' '9'] (stag %$ bisk)
:- '-' (stag %$ tash)
:- '.' ;~(pfix dot perd)
:- '~' ;~(pfix sig ;~(pose twid (easy [%$ %n 0])))
==
++ nusk
~+
:(sear |=(a/@ta (rush a nuck)) wick urt:ab)
++ perd
~+
;~ pose
(stag %$ zust)
(stag %many (ifix [cab ;~(plug cab cab)] (more cab nusk)))
==
++ royl
~+
=+ ^= moo
|= a/tape
:- (lent a)
(scan a (bass 10 (plus sid:ab)))
=+ ^= voy
%+ cook royl-cell
;~ pose
;~ plug
(easy %d)
;~ pose (cold | hep) (easy &) ==
;~ plug dim:ag
;~ pose
;~(pfix dot (cook moo (plus (shim '0' '9'))))
(easy [0 0])
==
;~ pose
;~ pfix
(just 'e')
;~(plug ;~(pose (cold | hep) (easy &)) dim:ag)
==
(easy [& 0])
==
==
==
;~ plug
(easy %i)
;~ sfix
;~ pose (cold | hep) (easy &) ==
(jest 'inf')
==
==
;~ plug
(easy %n)
(cold ~ (jest 'nan'))
==
==
;~ pose
(stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy)))
(stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy)))
(stag %rd (cook ryld ;~(pfix sig voy)))
(stag %rs (cook ryls voy))
==
::
++ royl-cell
|= rn
^- dn
?. ?=({$d *} +<) +<
=+ ^= h
(dif:si (new:si f.b i.b) (sun:si d.b))
[%d a h (add (mul c.b (pow 10 d.b)) e.b)]
::
++ tash
~+
=+ ^= neg
|= {syn/? mol/dime} ^- dime
?> =('u' (end 3 1 p.mol))
[(cat 3 's' (rsh 3 1 p.mol)) (new:si syn q.mol)]
;~ pfix hep
;~ pose
(cook |=(a/dime (neg | a)) bisk)
;~(pfix hep (cook |=(a/dime (neg & a)) bisk))
==
==
::
++ twid
~+
;~ pose
(cook |=(a/@ [%blob (cue a)]) ;~(pfix (just '0') vum:ag))
(stag %$ crub)
==
::
++ zust
~+
;~ pose
(stag %is bip:ag)
(stag %if lip:ag)
royl
(stag %f ;~(pose (cold & (just 'y')) (cold | (just 'n'))))
2016-11-24 07:25:07 +03:00
==
--
::
:::: 4m: formatting functions
::
++ scot |=(mol/dime ~(rent co %$ mol))
++ scow |=(mol/dime ~(rend co %$ mol))
++ slat |=(mod/@tas |=(txt/@ta (slaw mod txt)))
++ slav |=({mod/@tas txt/@ta} (need (slaw mod txt)))
++ slaw
~/ %slaw
|= {mod/@tas txt/@ta}
^- (unit @)
=+ con=(slay txt)
?.(&(?=({~ $$ @ @} con) =(p.p.u.con mod)) ~ [~ q.p.u.con])
2016-11-24 07:25:07 +03:00
::
++ slay
|= txt/@ta ^- (unit coin)
=+ ^= vex
?: (gth 0x7fff.ffff txt) :: XX petty cache
~+ ((full nuck:so) [[1 1] (trip txt)])
((full nuck:so) [[1 1] (trip txt)])
?~ q.vex
~
[~ p.u.q.vex]
::
++ smyt :: pretty print path
|= bon/path ^- tank
:+ %rose [['/' ~] ['/' ~] ~]
(turn bon |=(a/@ [%leaf (trip a)]))
::
++ spat |=(pax/path (crip (spud pax))) :: render path to cord
++ spud |=(pax/path ~(ram re (smyt pax))) :: render path to tape
++ stab :: parse cord to path
2018-03-14 07:36:10 +03:00
=+ fel=;~(pfix net (more net urs:ab))
2016-11-24 07:25:07 +03:00
|=(zep/@t `path`(rash zep fel))
::
:::: 4n: virtualization
::
++ mack
|= {sub/* fol/*}
^- (unit)
=+ ton=(mink [sub fol] |=({* *} ~))
?.(?=({$0 *} ton) ~ [~ p.ton])
::
++ mink !.
2016-11-24 07:25:07 +03:00
~/ %mink
|= {{sub/* fol/*} gul/$-({* *} (unit (unit)))}
=+ tax=*(list {@ta *})
|- ^- tone
?@ fol
[%2 tax]
?: ?=(^ -.fol)
=+ hed=$(fol -.fol)
?: ?=($2 -.hed)
hed
=+ tal=$(fol +.fol)
?- -.tal
$0 ?-(-.hed $0 [%0 p.hed p.tal], $1 hed)
$1 ?-(-.hed $0 tal, $1 [%1 (weld p.hed p.tal)])
$2 tal
==
?+ fol
[%2 tax]
::
{$0 b/@}
?: =(0 b.fol) [%2 tax]
?: =(1 b.fol) [%0 sub]
?: ?=(@ sub) [%2 tax]
=+ [now=(cap b.fol) lat=(mas b.fol)]
$(b.fol lat, sub ?:(=(2 now) -.sub +.sub))
::
{$1 b/*}
[%0 b.fol]
::
{$2 b/{^ *}}
=+ ben=$(fol b.fol)
?. ?=($0 -.ben) ben
?>(?=(^ p.ben) $(sub -.p.ben, fol +.p.ben))
::?>(?=(^ p.ben) $([sub fol] p.ben)
::
{$3 b/*}
=+ ben=$(fol b.fol)
?. ?=($0 -.ben) ben
[%0 .?(p.ben)]
::
{$4 b/*}
=+ ben=$(fol b.fol)
?. ?=($0 -.ben) ben
?. ?=(@ p.ben) [%2 tax]
[%0 .+(p.ben)]
::
{$5 b/*}
=+ ben=$(fol b.fol)
?. ?=($0 -.ben) ben
?. ?=(^ p.ben) [%2 tax]
[%0 =(-.p.ben +.p.ben)]
::
{$6 b/* c/* d/*}
$(fol =>(fol [2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b]))
::
{$7 b/* c/*} $(fol =>(fol [2 b 1 c]))
2017-11-23 03:03:15 +03:00
{$8 b/* c/*} $(fol =>(fol [7 [[7 [0 1] b] 0 1] c]))
{$9 b/* c/*} $(fol =>(fol [7 c 2 [0 1] 0 b]))
2016-11-24 07:25:07 +03:00
{$10 @ c/*} $(fol c.fol)
{$10 {b/* c/*} d/*}
=+ ben=$(fol c.fol)
?. ?=($0 -.ben) ben
?: ?=(?($hunk $hand $lose $mean $spot) b.fol)
$(fol d.fol, tax [[b.fol p.ben] tax])
$(fol d.fol)
::
{$11 b/* c/*}
=+ ref=$(fol b.fol)
=+ ben=$(fol c.fol)
?. ?=($0 -.ref) ref
?. ?=($0 -.ben) ben
=+ val=(gul p.ref p.ben)
?~(val [%1 p.ben ~] ?~(u.val [%2 [[%hunk (mush p.ben)] tax]] [%0 u.u.val]))
==
::
++ mock
|= {{sub/* fol/*} gul/$-({* *} (unit (unit)))}
(mook (mink [sub fol] gul))
::
2018-02-12 07:03:38 +03:00
++ mook
|= ton/tone
^- toon
?. ?=({$2 *} ton) ton
:- %2
:: =. p.ton (moop p.ton)
=+ yel=(lent p.ton)
=. p.ton
2018-02-25 05:01:53 +03:00
?. (gth yel 1.024) p.ton
2018-02-12 07:03:38 +03:00
%+ weld
2018-02-25 05:01:53 +03:00
(scag 512 p.ton)
2018-02-12 07:03:38 +03:00
^- (list {@ta *})
2018-02-25 05:01:53 +03:00
:_ (slag (sub yel 512) p.ton)
2018-02-12 07:03:38 +03:00
:- %lose
%+ rap 3
2018-02-25 05:01:53 +03:00
"[skipped {(scow %ud (sub yel 1.024))} frames]"
2018-02-12 07:03:38 +03:00
|- ^- (list tank)
?~ p.ton ~
=+ rep=$(p.ton t.p.ton)
?+ -.i.p.ton rep
$hunk [(tank +.i.p.ton) rep]
$lose [[%leaf (rip 3 (@ +.i.p.ton))] rep]
$hand [[%leaf (scow %p (mug +.i.p.ton))] rep]
$mean :_ rep
?@ +.i.p.ton [%leaf (rip 3 (@ +.i.p.ton))]
=+ mac=(mack +.i.p.ton +<.i.p.ton)
?~(mac [%leaf "####"] (tank u.mac))
$spot :_ rep
=+ sot=(spot +.i.p.ton)
:+ %rose [":" ~ ~]
:~ (smyt p.sot)
=> [ud=|=(a/@u (scow %ud a)) q.sot]
leaf+"<[{(ud p.p)} {(ud q.p)}].[{(ud p.q)} {(ud q.q)}]>"
== ==
::
++ mush :: sane name to leaf
|= val/*
^- tank
:+ %rose
[['/' ~] ['/' ~] ~]
(turn ((list @ta) val) |=(a/@ta [%leaf (trip a)]))
::
++ mong
|= {{gat/* sam/*} gul/$-({* *} (unit (unit)))}
^- toon
?. &(?=(^ gat) ?=(^ +.gat))
[%2 ~]
(mock [[-.gat [sam +>.gat]] -.gat] gul)
::
++ mule :: typed virtual
~/ %mule
=+ taq=|.(**)
|% +- $
=+ mud=(mute taq)
?- -.mud
2018-03-19 06:54:47 +03:00
%& [%& p=$:taq]
%| [%| p=p.mud]
2017-11-22 06:55:32 +03:00
==
2018-02-12 07:03:38 +03:00
--
::
++ mute :: untyped virtual
|= taq/_=>(~ ^?(|.(**)))
^- (each * (list tank))
=+ ton=(mock [taq 9 2 0 1] |=({* *} ~))
?- -.ton
$0 [%& p.ton]
$1 [%| (turn p.ton |=(a/* (smyt (path a))))]
$2 [%| p.ton]
==
::
:::: 4o: molds and mold builders
2016-11-24 07:25:07 +03:00
::
2017-11-16 23:44:27 +03:00
++ abel typo :: original sin: type
++ alas (list (pair term hoon)) :: alias list
2016-11-24 07:25:07 +03:00
++ atom @ :: just an atom
++ aura @ta :: atom format
++ base :: base mold
$@ $? $noun :: any noun
$cell :: any cell
2018-03-19 05:40:38 +03:00
$flag :: loobean
2016-11-24 07:25:07 +03:00
$null :: ~ == 0
2018-03-31 06:54:04 +03:00
$void :: empty set
2016-11-24 07:25:07 +03:00
== ::
{$atom p/aura} :: atom
::
++ woof $@(@ {~ p/hoon}) :: simple embed
2016-11-24 07:25:07 +03:00
++ beet $@ @ :: advanced embed
2017-11-17 00:50:03 +03:00
$% {$a p/hoon} :: take tape
{$b p/hoon} :: take manx
{$c p/hoon} :: take marl
{$d p/hoon} :: take $-(marl marl)
{$e p/hoon q/(list tuna)} :: element literal
2016-11-24 07:25:07 +03:00
== ::
++ chap (pair (unit term) what) :: labeled help
2016-11-24 07:25:07 +03:00
++ chum $? lef/term :: jet name
{std/term kel/@} :: kelvin version
{ven/term pro/term kel/@} :: vendor and product
{ven/term pro/term ver/@ kel/@} :: all of the above
== ::
2017-11-16 23:44:27 +03:00
++ coil $: p/?($gold $iron $lead $zinc) :: core type
q/type :: built with
r/chap :: docs
s/{p/seminoun q/(map @ tomb)} :: arms
2016-11-24 07:25:07 +03:00
== ::
2017-11-17 00:50:03 +03:00
++ foot $% {$ash p/hoon} :: dry arm, geometric
{$elm p/hoon} :: wet arm, generic
2016-11-24 07:25:07 +03:00
== ::
++ limb $@ term :: wing element
2018-03-19 06:54:47 +03:00
$% {%& p/axis} :: by geometry
{%| p/@ud q/(unit term)} :: by name
2016-11-24 07:25:07 +03:00
== ::
2018-03-27 02:55:02 +03:00
:: XX more and better sanity
::
2017-09-20 08:32:08 +03:00
++ metl ?($gold $iron $zinc $lead) :: core variance
+= null ~ :: null, nil, etc
2017-11-16 23:44:27 +03:00
++ onyx (list (pair type foot)) :: arm activation
2016-11-24 07:25:07 +03:00
++ opal :: limb match
2018-03-19 06:54:47 +03:00
$% {%& p/type} :: leg
{%| p/axis q/(set {p/type q/foot})} :: arm
2016-11-24 07:25:07 +03:00
== ::
2017-04-05 03:33:20 +03:00
++ pica (pair ? cord) :: & prose, | code
2016-11-24 07:25:07 +03:00
++ palo (pair vein opal) :: wing trace, match
2018-03-31 06:54:04 +03:00
++ plot :: output analysis
$~ [%base %noun] ::
$% [%base p=base] :: base type
[%core p=plot q=@udF r=(set term)] :: core with arms, mug
[%leaf p=@tas] :: constant
[%loop p=@ud] :: repetition point
[%list p=plot] :: i-t list
[%many p=(list plot)] :: tuple
[%mark p=term q=plot] :: famous format
[%name p=term q=plot] :: name attached
[%pair p=plot q=plot] :: pq cell
[%path ~] :: with @ta segments
[%pick p=(list plot)] :: overlap
[%qual p=plot q=plot r=plot] :: formal
[%quil p=plot q=plot r=plot s=plot t=plot]:: formal quintuple
[%tape ~] :: utf8 bytes
[%tour ~] :: utf32 graphemes
[%tree p=plot] :: n-l-r tree
[%trip p=plot q=plot r=plot s=plot] :: formal triple
[%unit p=plot] :: maybe
== ::
2016-11-24 07:25:07 +03:00
++ pock (pair axis nock) :: changes
2017-11-16 23:44:27 +03:00
++ port (each palo (pair type nock)) :: successful match
2017-11-17 00:50:03 +03:00
++ root hoon :: produce model
2018-03-29 21:03:14 +03:00
++ spec :: structure definition
2018-03-14 07:37:45 +03:00
$~ [%base %null] ::
2018-03-11 08:15:09 +03:00
$% {$base p/base} :: base type
2018-03-29 21:03:14 +03:00
{$dbug p/spot q/spec} :: set debug
2018-03-14 07:37:45 +03:00
{$leaf p/term q/@} :: constant atom
2018-04-11 07:06:46 +03:00
{$like p/wing q/(list wing)} :: reference
2018-04-14 08:31:53 +03:00
{$loop p/term} :: hygienic reference
2018-03-31 06:54:04 +03:00
{$make p/hoon q/(list spec)} :: composed spec
2018-04-11 07:06:46 +03:00
{$over p/wing q/spec} :: relative to subject
2018-03-14 08:56:31 +03:00
:: ::
2018-04-14 08:31:53 +03:00
{$bcbc p/spec q/(map term spec)} :: $$, recursion
2018-03-31 06:54:04 +03:00
{$bcbr p/spec q/hoon} :: $|, verify
{$bccb p/hoon} :: $_, example
{$bccl p/{i/spec t/(list spec)}} :: $:, tuple
{$bccn p/{i/spec t/(list spec)}} :: $%, head pick
2018-04-08 20:44:15 +03:00
{$bcdt p/spec q/(map term spec)} :: $., read-write core
2018-03-31 06:54:04 +03:00
{$bcgl p/spec q/spec} :: $<, filter: exclude
{$bcgr p/spec q/spec} :: $>, filter: require
{$bchp p/spec q/spec} :: $-, function core
{$bckt p/spec q/spec} :: $^, cons pick
2018-04-15 01:12:00 +03:00
{$bcls p/stud q/spec} :: $+, standard
2018-04-08 20:44:15 +03:00
{$bcnt p/spec q/(map term spec)} :: $/, write-only core
2018-03-31 06:54:04 +03:00
{$bcmc p/hoon} :: $;, manual
{$bcpd p/spec q/hoon} :: $&, repair
{$bcsg p/hoon q/spec} :: $~, default
2018-04-13 01:42:39 +03:00
{$bctc p/spec q/(map term spec)} :: $`, read-only core
2018-03-31 06:54:04 +03:00
{$bcts p/toga q/spec} :: $=, name
{$bcvt p/spec q/spec} :: $@, atom pick
{$bcwt p/{i/spec t/(list spec)}} :: $?, full pick
2018-04-08 20:44:15 +03:00
{$bczp p/spec q/(map term spec)} :: $!, opaque core
2016-11-24 07:25:07 +03:00
== ::
++ tent :: model builder
2018-03-29 21:03:14 +03:00
$% {%| p/wing q/tent r/(list spec)} :: ~(p q r...)
{%& p/(list wing)} :: a.b:c.d
== ::
++ tiki :: test case
$% {%& p/(unit term) q/wing} :: simple wing
{%| p/(unit term) q/hoon} :: named wing
== ::
2016-11-24 07:25:07 +03:00
++ toga :: face control
$@ p/term :: two togas
$% {$0 ~} :: no toga
{$1 p/(pair what term) q/toga} :: deep toga
2016-11-24 07:25:07 +03:00
{$2 p/toga q/toga} :: cell toga
== ::
++ tomb (pair chap (map term (pair what foot))) :: core chapter
++ tope :: topographic type
$@ $? %& :: cell or atom
%| :: atom
== ::
(pair tope tope) :: cell
2016-11-24 07:25:07 +03:00
++ tuna :: tagflow
2018-02-26 07:34:31 +03:00
$~ [%f ~]
2017-11-17 00:50:03 +03:00
$% {$a p/hoon} :: plain text
{$b p/hoon} :: single tag
{$c p/hoon} :: simple list
{$d p/hoon} :: dynamic list
{$e p/hoon q/(list tuna)} :: element
2016-11-24 07:25:07 +03:00
{$f p/(list tuna)} :: subflow
== ::
2018-02-26 07:34:31 +03:00
++ hoon-structures
2017-12-14 06:47:01 +03:00
|% ::REVIEW
++ beer $@(char {~ p/hoon}) :: simple embed
2017-12-14 06:47:01 +03:00
++ mane $@(@tas {@tas @tas}) :: XML name+space
2018-02-11 08:24:22 +03:00
++ manx $~([[%$ ~] ~] {g/marx c/marl}) :: dynamic XML node
2017-12-14 06:47:01 +03:00
++ marl (list tuna) :: dynamic XML nodes
++ mart (list {n/mane v/(list beer)}) :: dynamic XML attrs
2018-02-11 08:24:22 +03:00
++ marx $~([%$ ~] {n/mane a/mart}) :: dynamic XML tag
2017-12-14 06:47:01 +03:00
++ mare (each manx marl) :: node or nodes
++ maru (each tuna marl) :: interp or nodes
++ tuna :: maybe interpolation
2018-02-26 07:34:31 +03:00
$~ [[%$ ~] ~]
$^ manx
$: ?($tape $manx $marl $call)
p/hoon
==
2017-12-14 06:47:01 +03:00
-- ::
2017-11-17 00:50:03 +03:00
++ hoon ::
2018-02-26 07:34:31 +03:00
=, hoon-structures
$~ [%zpzp ~]
2017-11-17 00:50:03 +03:00
$^ {p/hoon q/hoon} ::
2016-11-24 07:25:07 +03:00
$% ::
{$$ p/axis} :: simple leg
:: ::
{$base p/base} :: base
{$bust p/base} :: bunt base
2017-11-17 00:50:03 +03:00
{$dbug p/spot q/hoon} :: debug info in trace
2017-04-05 03:33:20 +03:00
{$eror p/tape} :: assembly error
2017-11-16 23:44:27 +03:00
{$hand p/type q/nock} :: premade result
2018-04-15 01:12:00 +03:00
{$form p/note q/hoon} :: annotate
2018-03-14 06:17:30 +03:00
{$fits p/hoon q/wing} :: underlying ?=
2016-11-24 07:25:07 +03:00
{$knit p/(list woof)} :: assemble string
{$leaf p/(pair term @)} :: symbol
2018-03-14 06:17:30 +03:00
{$limb p/term} :: take limb
2017-11-17 00:50:03 +03:00
{$lost p/hoon} :: not to be taken
2016-11-24 07:25:07 +03:00
{$rock p/term q/*} :: fixed constant
{$sand p/term q/*} :: unfixed constant
2017-11-17 00:50:03 +03:00
{$tell p/(list hoon)} :: render as tape
{$tune p/(pair what $@(term tune))} :: minimal face
2018-03-14 06:17:30 +03:00
{$wing p/wing} :: take wing
2017-11-17 00:50:03 +03:00
{$yell p/(list hoon)} :: render as tank
2018-03-13 08:56:27 +03:00
{$xray p/manx} :: ;foo; templating
2018-03-14 06:17:30 +03:00
:: :::::: structures
2018-03-29 21:03:14 +03:00
{$bcdt p/spec} :: example
{$bccm p/spec} :: factory
2016-11-24 07:25:07 +03:00
:: :::::: cores
2018-03-29 21:03:14 +03:00
{$brcb p/chap q/spec r/alas s/(map @ tomb)} :: |_
2017-11-17 00:50:03 +03:00
{$brcl p/chap q/hoon r/hoon} :: |:
2017-09-18 04:32:20 +03:00
{$brcn p/chap q/(map @ tomb)} :: |%
2017-11-17 00:50:03 +03:00
{$brdt p/chap q/hoon} :: |.
{$brkt p/chap q/hoon r/(map @ tomb)} :: |^
{$brhp p/chap q/hoon} :: |-
2018-03-29 21:03:14 +03:00
{$brsg p/chap q/spec r/hoon} :: |~
{$brtr p/chap q/spec r/hoon} :: |*
{$brts p/chap q/spec r/hoon} :: |=
2017-11-17 00:50:03 +03:00
{$brwt p/chap q/hoon} :: |?
2016-11-24 07:25:07 +03:00
:: :::::: tuples
2018-03-12 08:29:13 +03:00
{$clcb p/hoon q/hoon} :: :_ [q p]
{$clkt p/hoon q/hoon r/hoon s/hoon} :: :^ [p q r s]
{$clhp p/hoon q/hoon} :: :- [p q]
{$clls p/hoon q/hoon r/hoon} :: :+ [p q r]
{$clsg p/(list hoon)} :: :~ [p ~]
{$cltr p/(list hoon)} :: :* p as a tuple
2016-11-24 07:25:07 +03:00
:: :::::: invocations
2017-11-17 00:50:03 +03:00
{$cncb p/wing q/(list (pair wing hoon))} :: %_
{$cndt p/hoon q/hoon} :: %.
2018-03-14 06:17:30 +03:00
{$cnhp p/hoon q/hoon} :: %-
2018-03-20 05:42:13 +03:00
{$cncl p/hoon q/(list hoon)} :: %:
2017-11-17 00:50:03 +03:00
{$cntr p/wing q/hoon r/(list (pair wing hoon))} :: %*
{$cnkt p/hoon q/hoon r/hoon s/hoon} :: %^
{$cnls p/hoon q/hoon r/hoon} :: %+
{$cnsg p/wing q/hoon r/(list hoon)} :: %~
{$cnts p/wing q/(list (pair wing hoon))} :: %=
2016-11-24 07:25:07 +03:00
:: :::::: nock
2018-03-29 21:03:14 +03:00
{$dtkt p/spec q/hoon} :: .^ nock 11
2017-11-17 00:50:03 +03:00
{$dtls p/hoon} :: .+ nock 4
{$dttr p/hoon q/hoon} :: .* nock 2
{$dtts p/hoon q/hoon} :: .= nock 5
{$dtwt p/hoon} :: .? nock 3
2017-11-16 23:44:27 +03:00
:: :::::: type conversion
2018-03-14 06:17:30 +03:00
{$ktbr p/hoon} :: ^| contravariant
2017-11-17 00:50:03 +03:00
{$ktcn p/hoon} :: ^% enter test mode
2018-03-14 06:17:30 +03:00
{$ktdt p/hoon q/hoon} :: ^. self-cast
{$ktls p/hoon q/hoon} :: ^+ expression cast
2018-03-29 21:03:14 +03:00
{$kthp p/spec q/hoon} :: ^- structure cast
2018-03-14 06:17:30 +03:00
{$ktpd p/hoon} :: ^& covariant
{$ktsg p/hoon} :: ^~ constant
{$ktts p/toga q/hoon} :: ^= label
{$ktwt p/hoon} :: ^? bivariant
2016-11-24 07:25:07 +03:00
:: :::::: hints
2017-11-17 00:50:03 +03:00
{$sgbr p/hoon q/hoon} :: ~| sell on trace
{$sgcb p/hoon q/hoon} :: ~_ tank on trace
{$sgcn p/chum q/hoon r/tyre s/hoon} :: ~% general jet hint
2018-03-14 06:17:30 +03:00
{$sgnt p/chum q/hoon} :: ~/ function j-hint
2017-11-17 00:50:03 +03:00
{$sggl p/$@(term {p/term q/hoon}) q/hoon} :: ~< backward hint
{$sggr p/$@(term {p/term q/hoon}) q/hoon} :: ~> forward hint
{$sgbc p/term q/hoon} :: ~$ profiler hit
{$sgls p/@ q/hoon} :: ~+ cache/memoize
2018-03-20 05:42:13 +03:00
{$sgpd p/@ud q/hoon r/hoon} :: ~& printf/priority
2017-11-17 00:50:03 +03:00
{$sgts p/hoon q/hoon} :: ~= don't duplicate
{$sgwt p/@ud q/hoon r/hoon s/hoon} :: ~? tested printf
{$sgzp p/hoon q/hoon} :: ~! type on trace
2016-11-24 07:25:07 +03:00
:: :::::: miscellaneous
2018-03-14 06:17:30 +03:00
{$mcts p/marl} :: ;= list templating
{$mccl p/hoon q/(list hoon)} :: ;: binary to nary
{$mcnt p/hoon} :: ;/ [%$ [%$ p ~] ~]
{$mcsg p/hoon q/(list hoon)} :: ;~ kleisli arrow
{$mcmc p/hoon q/hoon} :: ;; normalize
2016-11-24 07:25:07 +03:00
:: :::::: compositions
2018-03-29 21:03:14 +03:00
{$tsbr p/spec q/hoon} :: =| push bunt
2018-03-12 08:29:13 +03:00
{$tscl p/(list (pair wing hoon)) q/hoon} :: =: q w/ p changes
2018-03-14 06:17:30 +03:00
{$tsnt p/sofa q/hoon r/hoon} :: =/ typed variable
{$tsmc p/sofa q/hoon r/hoon} :: =; =/(q p r)
2018-03-12 08:29:13 +03:00
{$tsdt p/wing q/hoon r/hoon} :: =. r with p as q
{$tswt p/wing q/hoon r/hoon s/hoon} :: =? conditional =.
{$tsgl p/hoon q/hoon} :: =< =>(q p)
{$tshp p/hoon q/hoon} :: =- =+(q p)
{$tsgr p/hoon q/hoon} :: => q w/subject p
2018-03-13 04:20:48 +03:00
{$tskt p/sofa q/wing r/hoon s/hoon} :: =^ state machine
2018-03-12 08:29:13 +03:00
{$tsls p/hoon q/hoon} :: =+ q w/[p subject]
{$tssg p/(list hoon)} :: =~ hoon stack
{$tstr p/(pair what term) q/hoon r/hoon} :: =* r w/alias p/q
{$tscm p/hoon q/hoon} :: =, overload p in q
2016-11-24 07:25:07 +03:00
:: :::::: conditionals
2018-03-12 08:29:13 +03:00
{$wtbr p/(list hoon)} :: ?| loobean or
2018-03-29 21:03:14 +03:00
{$wthp p/wing q/(list (pair spec hoon))} :: ?- pick case in q
2018-03-12 08:29:13 +03:00
{$wtcl p/hoon q/hoon r/hoon} :: ?: if/then/else
2017-11-17 00:50:03 +03:00
{$wtdt p/hoon q/hoon r/hoon} :: ?. ?:(p r q)
{$wtkt p/wing q/hoon r/hoon} :: ?^ if p is a cell
{$wtgl p/hoon q/hoon} :: ?< ?:(p !! q)
{$wtgr p/hoon q/hoon} :: ?> ?:(p q !!)
2018-03-29 21:03:14 +03:00
{$wtls p/wing q/hoon r/(list (pair spec hoon))} :: ?+ ?- w/default
2018-03-20 05:42:13 +03:00
{$wtpd p/(list hoon)} :: ?& loobean and
2018-03-19 05:40:38 +03:00
{$wtvt p/wing q/hoon r/hoon} :: ?@ if p is atom
2017-11-17 00:50:03 +03:00
{$wtsg p/wing q/hoon r/hoon} :: ?~ if p is null
2018-03-29 21:03:14 +03:00
{$wtts p/spec q/wing} :: ?= if q matches p
2018-03-12 08:29:13 +03:00
{$wtzp p/hoon} :: ?! loobean not
2018-02-12 07:03:38 +03:00
:: :::::: special
{$zpcm p/hoon q/hoon} :: !,
{$zpgr p/hoon} :: !>
2018-03-14 06:17:30 +03:00
{$zpmc p/hoon q/hoon} :: !;
2018-02-12 07:03:38 +03:00
{$zpts p/hoon} :: !=
2018-03-27 02:55:02 +03:00
{$zpvt p/(list wing) q/hoon r/hoon} :: !@
2018-02-12 07:03:38 +03:00
{$zpwt p/$@(p/@ {p/@ q/@}) q/hoon} :: !?
2018-03-12 08:29:13 +03:00
{$zpzp ~} :: !!
2018-02-12 07:03:38 +03:00
== ::
2018-03-29 21:03:14 +03:00
++ sofa (pair toga (unit spec))
2018-02-12 07:03:38 +03:00
++ twit hoon :: last-gen hoon
++ tyre (list {p/term q/hoon}) ::
++ tyke (list (unit hoon)) ::
:: :::::: virtual nock
++ nock $^ {p/nock q/nock} :: autocons
$% {$1 p/*} :: constant
{$2 p/nock q/nock} :: compose
{$3 p/nock} :: cell test
{$4 p/nock} :: increment
{$5 p/nock q/nock} :: equality test
{$6 p/nock q/nock r/nock} :: if, then, else
{$7 p/nock q/nock} :: serial compose
{$8 p/nock q/nock} :: push onto subject
{$9 p/@ q/nock} :: select arm and fire
{$10 p/$@(@ {p/@ q/nock}) q/nock} :: hint
{$11 p/nock q/nock} :: grab data from sky
{$0 p/@} :: axis select
== ::
2018-04-15 01:12:00 +03:00
++ note :: type annotation
$% {$made p/spec} :: constructed by
{$make p/spec} :: constructor for
{$mark p/stud} :: declared standard
== ::
2018-03-27 02:55:02 +03:00
++ type $~ %noun ::
$@ $? $noun :: any nouns
2018-02-12 07:03:38 +03:00
$void :: no noun
== ::
$% {$atom p/term q/(unit @)} :: atom / constant
{$cell p/type q/type} :: ordered pair
{$core p/type q/coil} :: object
2018-04-15 01:12:00 +03:00
{$face p/{p/what q/$@(term tune)} q/type} :: namespace
2018-02-12 07:03:38 +03:00
{$fork p/(set type)} :: union
2018-04-15 01:12:00 +03:00
{$form p/(pair type note) q/type} :: annotation
2018-02-12 07:03:38 +03:00
{$hold p/type q/hoon} :: lazy evaluation
== ::
++ tony :: ++tone done right
$% {$0 p/tine q/*} :: success
{$1 p/(set)} :: blocks
{$2 p/(list {@ta *})} :: error ~_s
== ::
++ tine :: partial noun
2018-03-27 02:55:02 +03:00
$@ ~ :: open
2018-03-19 06:54:47 +03:00
$% {%& p/tine q/tine} :: half-blocked
{%| p/(set)} :: fully blocked
2018-02-12 07:03:38 +03:00
== ::
++ tool $@(term tune) :: type decoration
++ tune :: complex
2018-02-26 07:34:31 +03:00
$~ [~ ~] ::
2018-02-12 07:03:38 +03:00
$: p/(map term (pair what (unit hoon))) :: aliases
q/(list hoon) :: bridges
== ::
++ typo type :: old type
++ vase {p/type q/*} :: type-value pair
++ vise {p/typo q/*} :: old vase
++ vial ?($read $rite $both $free) :: co/contra/in/bi
++ vair ?($gold $iron $lead $zinc) :: in/contra/bi/co
++ vein (list (unit axis)) :: search trace
++ sect (list pica) :: paragraph
++ whit ::
$: lab/(unit term) :: label
boy/(unit (pair cord (list sect))) :: body
def/(map term (pair cord (list sect))) :: definitions
use/(set term) :: defs used
== ::
++ what (unit (pair cord (list sect))) :: help slogan/section
++ wing (list limb) :: search path
++ worm :: compiler cache
$: nes/(set ^) :: ++nest
pay/(map (pair type hoon) type) :: ++play
mit/(map (pair type hoon) (pair type nock)) :: ++mint
== ::
2018-02-25 06:37:00 +03:00
::
2018-02-22 08:27:35 +03:00
:: +block: abstract identity of resource awaited
2018-02-20 04:27:23 +03:00
::
++ block
path
2018-02-25 06:37:00 +03:00
::
2018-02-22 08:27:35 +03:00
:: +result: internal interpreter result
2018-02-20 04:27:23 +03:00
::
++ result
$@(~ seminoun)
2018-02-25 06:37:00 +03:00
::
2018-02-22 08:27:35 +03:00
:: +thunk: fragment constructor
2018-02-20 04:27:23 +03:00
::
++ thunk
2018-02-22 08:27:35 +03:00
$-(@ud (unit noun))
2018-02-25 06:37:00 +03:00
::
2018-02-22 08:27:35 +03:00
:: +seminoun:
2018-02-20 04:27:23 +03:00
::
++ seminoun
:: partial noun; blocked subtrees are ~
::
$~ [[%full ~] ~]
{mask/stencil data/noun}
2018-02-25 06:37:00 +03:00
::
2018-02-22 08:27:35 +03:00
:: +stencil: noun knowledge map
2018-02-20 04:27:23 +03:00
::
++ stencil
2018-02-25 06:37:00 +03:00
$% ::
:: %half: noun has partial block substructure
2018-02-20 04:27:23 +03:00
::
2018-02-22 08:27:35 +03:00
[%half left=stencil rite=stencil]
2018-02-25 06:37:00 +03:00
::
2018-02-22 08:27:35 +03:00
:: %full: noun is either fully complete, or fully blocked
2018-02-20 04:27:23 +03:00
::
2018-02-22 08:27:35 +03:00
[%full blocks=(set block)]
2018-02-25 06:37:00 +03:00
::
2018-02-22 08:27:35 +03:00
:: %lazy: noun can be generated from virtual subtree
2018-02-20 04:27:23 +03:00
::
2018-02-22 08:27:35 +03:00
[%lazy fragment/axis resolve/thunk]
2018-02-20 04:27:23 +03:00
==
::
++ output
2018-02-25 06:37:00 +03:00
:: ~: interpreter stopped
2018-02-20 04:27:23 +03:00
::
%- unit
2018-02-25 06:37:00 +03:00
$% ::
:: %done: output is complete
::
[%done p/noun]
2018-02-20 04:27:23 +03:00
::
2018-02-25 06:37:00 +03:00
:: %wait: output is waiting for resources
2018-02-20 04:27:23 +03:00
::
2018-02-25 06:37:00 +03:00
[%wait p/(list block)]
2018-02-20 04:27:23 +03:00
==
2018-02-12 07:03:38 +03:00
:: profiling
++ doss
$: mon/moan :: sample count
hit/(map term @ud) :: hit points
cut/(map path hump) :: cut points
==
++ moan :: sample metric
$: fun/@ud :: samples in C
noc/@ud :: samples in nock
glu/@ud :: samples in glue
mal/@ud :: samples in alloc
far/@ud :: samples in frag
coy/@ud :: samples in copy
euq/@ud :: samples in equal
== ::
::
++ hump
$: mon/moan :: sample count
out/(map path @ud) :: calls out of
inn/(map path @ud) :: calls into
==
--
:: ::
:::: 5: layer five ::
:: ::
:: 5a: compiler utilities ::
:: 5b: macro expansion ::
:: 5c: compiler backend and prettyprinter ::
:: 5d: parser ::
:: 5e: caching compiler ::
:: 5f: molds and mold builders ::
:: 5g: profiling support (XX remove) ::
::
~% %pen
+
==
%ap ap
%ut ut
==
|%
::
:::: 5aa: new partial nock interpreter
::
++ musk !. :: nock with block set
2018-02-12 07:03:38 +03:00
|%
++ abet
:: simplify raw result
::
|= $: :: noy: raw result
::
noy/result
==
^- output
:: propagate stop
::
?~ noy ~
:- ~
:: merge all blocking sets
::
=/ blocks (squash mask.noy)
?: =(~ blocks)
:: no blocks, data is complete
::
2018-02-16 02:53:32 +03:00
done/data.noy
2018-02-12 07:03:38 +03:00
:: reduce block set to block list
::
2018-02-16 02:53:32 +03:00
wait/~(tap in blocks)
2018-02-12 07:03:38 +03:00
::
++ araw
:: execute nock on partial subject
::
|= $: :: bus: subject, a partial noun
:: fol: formula, a complete noun
::
bus/seminoun
fol/noun
==
:: interpreter loop
::
|- ^- result
?@ fol
:: bad formula, stop
::
~
?: ?=(^ -.fol)
:: hed: interpret head
::
=+ hed=$(fol -.fol)
:: propagate stop
::
?~ hed ~
:: tal: interpret tail
::
=+ tal=$(fol +.fol)
:: propagate stop
::
?~ tal ~
:: combine
::
(combine hed tal)
?+ fol
:: bad formula; stop
::
~
:: 0; fragment
::
{$0 b/@}
:: if bad axis, stop
::
?: =(0 b.fol) ~
:: reduce to fragment
::
(fragment b.fol bus)
::
:: 1; constant
::
{$1 b/*}
:: constant is complete
::
2018-02-16 02:53:32 +03:00
[full/~ b.fol]
2018-02-12 07:03:38 +03:00
::
:: 2; recursion
::
{$2 b/* c/*}
:: require complete formula
::
%+ require
:: compute formula with current subject
::
$(fol c.fol)
|= :: ryf: next formula
::
ryf/noun
:: lub: next subject
::
=+ lub=^$(fol b.fol)
:: propagate stop
::
?~ lub ~
:: recurse
::
^$(fol ryf, bus lub)
::
:: 3; probe
::
{$3 b/*}
%+ require
$(fol b.fol)
|= :: fig: probe input
::
fig/noun
:: yes if cell, no if atom
::
2018-02-16 02:53:32 +03:00
[full/~ .?(fig)]
2018-02-12 07:03:38 +03:00
::
:: 4; increment
::
{$4 b/*}
%+ require
$(fol b.fol)
|= :: fig: increment input
::
fig/noun
:: stop for cells, increment for atoms
::
2018-02-16 02:53:32 +03:00
?^(fig ~ [full/~ +(fig)])
2018-02-12 07:03:38 +03:00
::
:: 5; compare
::
{$5 b/*}
%+ require
$(fol b.fol)
|= :: fig: operator input
::
fig/noun
:: stop for atoms, compare cells
::
2018-02-16 02:53:32 +03:00
?@(fig ~ [full/~ =(-.fig +.fig)])
2018-02-12 07:03:38 +03:00
::
:: 6; if-then-else
::
{$6 b/* c/* d/*}
:: semantic expansion
::
%+ require
$(fol b.fol)
|= :: fig: boolean
::
fig/noun
:: apply proper booleans
::
?: =(& fig) ^$(fol c.fol)
?: =(| fig) ^$(fol d.fol)
:: stop on bad test
::
~
::
:: 7; composition
::
{$7 b/* c/*}
:: one: input
::
=+ one=$(fol b.fol)
:: propagate stop
::
?~ one ~
:: complete composition
::
$(fol c.fol, bus one)
::
:: 8; introduction
::
{$8 b/* c/*}
:: one: input
::
=+ one=$(fol b.fol)
:: propagate stop
::
?~ one ~
:: complete introduction
::
$(fol c.fol, bus (combine one bus))
::
:: 9; invocation
::
2018-02-25 06:37:00 +03:00
{$9 b/* c/*}
2018-02-12 07:03:38 +03:00
:: semantic expansion
::
?^ b.fol ~
:: one: core
::
=+ one=$(fol c.fol)
:: propagate stop
::
?~ one ~
2018-02-25 06:37:00 +03:00
:: if core is constant
::
?: ?=([[%full ~] *] one)
:: then call virtual nock directly
::
=+ (mack data.one [%9 b.fol %0 1])
:: propagate stop
::
?~ - ~
:: produce result
::
[[%full ~] u.-]
:: else complete call
2018-02-12 07:03:38 +03:00
::
%+ require
:: retrieve formula
::
(fragment b.fol one)
:: continue
::
|=(noun ^$(bus one, fol +<))
::
:: 10; static hint
::
{$10 @ c/*}
:: ignore hint
::
$(fol c.fol)
::
:: 10; dynamic hint
::
{$10 {b/* c/*} d/*}
:: noy: dynamic hint
::
=+ noy=$(fol c.fol)
:: propagate stop
::
?~ noy ~
:: if hint is a fully computed trace
::
2018-02-16 02:53:32 +03:00
?: &(?=($spot b.fol) ?=([[%full ~] *] noy))
2018-02-12 07:03:38 +03:00
:: compute within trace
::
~_((show %o +.noy) $(fol d.fol))
:: else ignore hint
::
$(fol d.fol)
==
::
++ apex
:: execute nock on partial subject
::
|= $: :: bus: subject, a partial noun
:: fol: formula, a complete noun
::
bus/seminoun
fol/noun
==
2018-03-04 05:54:15 +03:00
~+
2018-02-12 07:03:38 +03:00
^- output
:: simplify result
::
(abet (araw bus fol))
2016-11-24 07:25:07 +03:00
::
2018-02-12 07:03:38 +03:00
++ combine
:: combine a pair of seminouns
::
|= $: :: hed: head of pair
:: tal: tail of pair
::
hed/seminoun
tal/seminoun
==
^- seminoun
2018-02-16 02:53:32 +03:00
?. ?& &(?=($full -.mask.hed) ?=($full -.mask.tal))
2018-02-12 07:03:38 +03:00
=(=(~ blocks.mask.hed) =(~ blocks.mask.tal))
==
:: default merge
::
2018-02-16 02:53:32 +03:00
[half/[mask.hed mask.tal] [data.hed data.tal]]
2018-02-12 07:03:38 +03:00
:: both sides total
::
?: =(~ blocks.mask.hed)
:: both sides are complete
::
2018-02-16 02:53:32 +03:00
[full/~ data.hed data.tal]
2018-02-12 07:03:38 +03:00
:: both sides are blocked
::
2018-02-16 02:53:32 +03:00
[full/(~(uni in blocks.mask.hed) blocks.mask.tal) ~]
::
++ complete
:: complete any laziness
::
|= bus/seminoun
^- seminoun
?- -.mask.bus
$full bus
2018-02-23 04:06:49 +03:00
$lazy :: fragment 1 is the whole thing
::
?: =(1 fragment.mask.bus)
2018-02-25 05:01:53 +03:00
:: blocked; we can't get fragment 1 while compiling it
2018-02-23 04:06:49 +03:00
::
[[%full [~ ~ ~]] ~]
:: execute thunk
2018-02-16 02:53:32 +03:00
::
2018-02-22 08:27:35 +03:00
=+ (resolve.mask.bus fragment.mask.bus)
:: if product is nil
::
?~ -
:: then blocked
::
[[%full [~ ~ ~]] ~]
:: else use value
::
[[%full ~] u.-]
2018-02-16 02:53:32 +03:00
$half :: recursive descent
::
%+ combine
$(bus [left.mask.bus -.data.bus])
$(bus [rite.mask.bus +.data.bus])
==
2018-02-12 07:03:38 +03:00
::
++ fragment
:: seek to an axis in a seminoun
::
|= $: :: axe: tree address of subtree
:: bus: partial noun
::
axe/axis
bus/seminoun
==
^- result
:: 1 is the root
::
?: =(1 axe) bus
2018-02-22 08:27:35 +03:00
:: now: top of axis (2 or 3)
2018-02-12 07:03:38 +03:00
:: lat: rest of axis
::
=+ [now=(cap axe) lat=(mas axe)]
?- -.mask.bus
2018-02-22 08:27:35 +03:00
%lazy :: propagate laziness
::
bus(fragment.mask (peg fragment.mask.bus axe))
2018-02-12 07:03:38 +03:00
::
2018-02-22 08:27:35 +03:00
%full :: if fully blocked, produce self
2018-02-16 02:53:32 +03:00
::
?^ blocks.mask.bus bus
:: descending into atom, stop
::
?@ data.bus ~
:: descend into complete cell
::
$(axe lat, bus [full/~ ?:(=(2 now) -.data.bus +.data.bus)])
2018-02-12 07:03:38 +03:00
::
2018-02-22 08:27:35 +03:00
%half :: descend into partial cell
2018-02-16 02:53:32 +03:00
::
%= $
axe lat
bus ?: =(2 now)
[left.mask.bus -.data.bus]
[rite.mask.bus +.data.bus]
== ==
2018-02-12 07:03:38 +03:00
:: require complete intermediate step
::
++ require
|= $: noy/result
yen/$-(* result)
==
^- result
:: propagate stop
::
?~ noy ~
2018-02-16 02:53:32 +03:00
:: suppress laziness
::
=/ bus/seminoun (complete noy)
?< ?=($lazy -.mask.bus)
2018-02-12 07:03:38 +03:00
:: if partial block, squash blocks and stop
::
2018-02-16 02:53:32 +03:00
?: ?=($half -.mask.bus) [full/(squash mask.bus) ~]
2018-02-12 07:03:38 +03:00
:: if full block, propagate block
::
2018-02-16 02:53:32 +03:00
?: ?=(^ blocks.mask.bus) [mask.bus ~]
2018-02-12 07:03:38 +03:00
:: otherwise use complete noun
::
2018-02-16 02:53:32 +03:00
(yen data.bus)
2018-02-12 07:03:38 +03:00
::
++ squash
:: convert stencil to block set
::
|= tyn/stencil
^- (set block)
?- -.tyn
2018-02-16 02:53:32 +03:00
$lazy $(tyn -:(complete tyn ~))
$full blocks.tyn
$half (~(uni in $(tyn left.tyn)) $(tyn rite.tyn))
2018-02-12 07:03:38 +03:00
==
--
2016-11-24 07:25:07 +03:00
::
:::: 5a: compiler utilities
::
2017-11-16 23:44:27 +03:00
++ bool `type`(fork [%atom %f `0] [%atom %f `1] ~) :: make loobean
++ cell :: make %cell type
2016-11-24 07:25:07 +03:00
~/ %cell
2017-11-16 23:44:27 +03:00
|= {hed/type tal/type}
^- type
2016-11-24 07:25:07 +03:00
?:(=(%void hed) %void ?:(=(%void tal) %void [%cell hed tal]))
::
2017-11-16 23:44:27 +03:00
++ core :: make %core type
2016-11-24 07:25:07 +03:00
~/ %core
2017-11-16 23:44:27 +03:00
|= {pac/type con/coil}
^- type
2016-11-24 07:25:07 +03:00
?:(=(%void pac) %void [%core pac con])
::
2018-03-27 02:55:02 +03:00
++ form
~/ %form
2018-04-15 01:12:00 +03:00
|= {p/(pair type note) q/type}
2018-03-27 02:55:02 +03:00
^- type
?: =(%void q)
%void
[%form p q]
::
2017-11-16 23:44:27 +03:00
++ face :: make %face type
2016-11-24 07:25:07 +03:00
~/ %face
2017-11-16 23:44:27 +03:00
|= {giz/{what $@(term tune)} der/type}
^- type
2016-11-24 07:25:07 +03:00
?: =(%void der)
%void
[%face giz der]
::
2017-11-16 23:44:27 +03:00
++ fork :: make %fork type
2016-11-24 07:25:07 +03:00
~/ %fork
2017-11-16 23:44:27 +03:00
|= yed/(list type)
=| lez/(set type)
|- ^- type
2016-11-24 07:25:07 +03:00
?~ yed
?~ lez %void
?: ?=({* ~ ~} lez) n.lez
2016-11-24 07:25:07 +03:00
[%fork lez]
%= $
yed t.yed
lez
?: =(%void i.yed) lez
?: ?=({$fork *} i.yed) (~(uni in lez) p.i.yed)
(~(put in lez) i.yed)
==
::
++ cove :: extract [0 *] axis
|= nug/nock
?- nug
{$0 *} p.nug
{$10 *} $(nug q.nug)
* ~_(leaf+"cove" !!)
==
++ comb :: combine two formulas
~/ %comb
|= {mal/nock buz/nock}
^- nock
?: ?&(?=({$0 *} mal) !=(0 p.mal))
?: ?&(?=({$0 *} buz) !=(0 p.buz))
[%0 (peg p.mal p.buz)]
?: ?=({$2 {$0 *} {$0 *}} buz)
[%2 [%0 (peg p.mal p.p.buz)] [%0 (peg p.mal p.q.buz)]]
[%7 mal buz]
?: ?=({^ {$0 $1}} mal)
[%8 p.mal buz]
?: =([%0 %1] buz)
mal
[%7 mal buz]
::
++ cond :: ?: compile
~/ %cond
|= {pex/nock yom/nock woq/nock}
^- nock
?- pex
{$1 $0} yom
{$1 $1} woq
* [%6 pex yom woq]
==
::
++ cons :: make formula cell
~/ %cons
2016-11-24 07:25:07 +03:00
|= {vur/nock sed/nock}
^- nock
?: ?=({{$0 *} {$0 *}} +<)
?: ?&(=(+(p.vur) p.sed) =((div p.vur 2) (div p.sed 2)))
[%0 (div p.vur 2)]
[vur sed]
?: ?=({{$1 *} {$1 *}} +<)
[%1 p.vur p.sed]
[vur sed]
::
++ fitz :: odor compatibility
~/ %fitz
|= {yaz/term wix/term}
=+ ^= fiz
|= mot/@ta ^- {p/@ q/@ta}
=+ len=(met 3 mot)
?: =(0 len)
[0 %$]
=+ tyl=(rsh 3 (dec len) mot)
?: &((gte tyl 'A') (lte tyl 'Z'))
[(sub tyl 64) (end 3 (dec len) mot)]
[0 mot]
=+ [yoz=(fiz yaz) wux=(fiz wix)]
?& ?| =(0 p.yoz)
=(0 p.wux)
&(!=(0 p.wux) (lte p.wux p.yoz))
==
|- ?| =(%$ p.yoz)
=(%$ p.wux)
?& =((end 3 1 p.yoz) (end 3 1 p.wux))
$(p.yoz (rsh 3 1 p.yoz), p.wux (rsh 3 1 p.wux))
==
==
==
::
++ flan :: loobean &
~/ %flan
|= {bos/nock nif/nock}
^- nock
?- bos
{$1 $1} bos
{$1 $0} nif
*
?- nif
{$1 $1} nif
{$1 $0} bos
* [%6 bos nif [%1 1]]
==
==
::
++ flip :: loobean negation
~/ %flip
|= dyr/nock
[%6 dyr [%1 1] [%1 0]]
::
++ flor :: loobean |
~/ %flor
|= {bos/nock nif/nock}
^- nock
?- bos
{$1 $1} nif
{$1 $0} bos
*
?- nif
{$1 $1} bos
{$1 $0} nif
* [%6 bos [%1 0] nif]
==
==
::
++ hike
~/ %hike
|= {axe/axis pac/(list {p/axis q/nock})}
^- nock
?~ pac
[%0 axe]
=+ zet=(skim pac.$ |=({p/axis q/nock} [=(1 p)]))
?~ zet
=+ tum=(skim pac.$ |=({p/axis q/nock} ?&(!=(1 p) =(2 (cap p)))))
=+ gam=(skim pac.$ |=({p/axis q/nock} ?&(!=(1 p) =(3 (cap p)))))
%+ cons
%= $
axe (peg axe 2)
pac (turn tum |=({p/axis q/nock} [(mas p) q]))
==
%= $
axe (peg axe 3)
pac (turn gam |=({p/axis q/nock} [(mas p) q]))
==
?>(?=({* ~} zet) q.i.zet)
2016-11-24 07:25:07 +03:00
::
++ jock
|= rad/?
2017-11-17 00:50:03 +03:00
|= lot/coin ^- hoon
2016-11-24 07:25:07 +03:00
?- -.lot
~
2016-11-24 07:25:07 +03:00
?:(rad [%rock p.lot] [%sand p.lot])
::
$blob
?: rad
[%rock %$ p.lot]
?@(p.lot [%sand %$ p.lot] [$(p.lot -.p.lot) $(p.lot +.p.lot)])
::
$many
2017-09-18 21:50:10 +03:00
[%cltr (turn p.lot |=(a/coin ^$(lot a)))]
2016-11-24 07:25:07 +03:00
==
::
++ look
~/ %look
|= {cog/term dab/(map term (pair what foot))}
2016-11-24 07:25:07 +03:00
=+ axe=1
|- ^- (unit {p/axis q/(pair what foot)})
2016-11-24 07:25:07 +03:00
?- dab
~ ~
2016-11-24 07:25:07 +03:00
::
{* ~ ~}
2017-04-17 01:37:40 +03:00
?:(=(cog p.n.dab) [~ axe q.n.dab] ~)
2016-11-24 07:25:07 +03:00
::
{* ~ *}
2016-11-24 07:25:07 +03:00
?: =(cog p.n.dab)
2017-04-17 01:37:40 +03:00
[~ (peg axe 2) q.n.dab]
2016-11-24 07:25:07 +03:00
?: (gor cog p.n.dab)
~
$(axe (peg axe 3), dab r.dab)
::
{* * ~}
2016-11-24 07:25:07 +03:00
?: =(cog p.n.dab)
2017-04-17 01:37:40 +03:00
[~ (peg axe 2) q.n.dab]
2016-11-24 07:25:07 +03:00
?: (gor cog p.n.dab)
$(axe (peg axe 3), dab l.dab)
~
::
{* * *}
?: =(cog p.n.dab)
2017-04-17 01:37:40 +03:00
[~ (peg axe 2) q.n.dab]
2016-11-24 07:25:07 +03:00
?: (gor cog p.n.dab)
$(axe (peg axe 6), dab l.dab)
$(axe (peg axe 7), dab r.dab)
==
::
2017-04-17 01:37:40 +03:00
++ loot
~/ %loot
|= {cog/term dom/(map @ tomb)}
=+ axe=1
|- ^- (unit {p/axis q/(pair what foot)})
2017-04-17 01:37:40 +03:00
?- dom
~ ~
2017-04-17 01:37:40 +03:00
::
{* ~ ~}
2017-04-17 01:37:40 +03:00
%+ bind (look cog q.q.n.dom)
|=((pair axis (pair what foot)) [(peg axe p) q])
2017-04-17 01:37:40 +03:00
::
{* ~ *}
2017-04-17 01:37:40 +03:00
=+ yep=(look cog q.q.n.dom)
?^ yep
[~ (peg (peg axe 2) p.u.yep) q.u.yep]
$(axe (peg axe 3), dom r.dom)
::
{* * ~}
2017-04-17 01:37:40 +03:00
=+ yep=(look cog q.q.n.dom)
?^ yep
[~ (peg (peg axe 2) p.u.yep) q.u.yep]
$(axe (peg axe 3), dom l.dom)
::
{* * *}
=+ yep=(look cog q.q.n.dom)
?^ yep
[~ (peg (peg axe 2) p.u.yep) q.u.yep]
=+ pey=$(axe (peg axe 6), dom l.dom)
?^ pey pey
$(axe (peg axe 7), dom r.dom)
==
::
2016-11-24 07:25:07 +03:00
:::: 5b: macro expansion
::
++ ah :: tiki engine
|_ tik/tiki
++ blue
2017-11-17 00:50:03 +03:00
|= gen/hoon
^- hoon
2018-03-19 06:54:47 +03:00
?. &(?=(%| -.tik) ?=(~ p.tik)) gen
2017-09-20 23:15:30 +03:00
[%tsgr [%$ 3] gen]
2016-11-24 07:25:07 +03:00
::
2018-03-14 08:56:31 +03:00
++ teal
2018-03-29 21:03:14 +03:00
|= mod/spec
^- spec
2018-03-14 08:56:31 +03:00
[%over [%& 3]~ mod]
::
2016-11-24 07:25:07 +03:00
++ gray
2017-11-17 00:50:03 +03:00
|= gen/hoon
^- hoon
2016-11-24 07:25:07 +03:00
?- -.tik
2018-03-19 06:54:47 +03:00
%& ?~(p.tik gen [%tstr [~ u.p.tik] [%wing q.tik] gen])
%| [%tsls ?~(p.tik q.tik [%ktts u.p.tik q.tik]) gen]
2016-11-24 07:25:07 +03:00
==
::
++ puce
^- wing
?- -.tik
2018-03-19 06:54:47 +03:00
%& ?~(p.tik q.tik [u.p.tik ~])
%| [[%& 2] ~]
2016-11-24 07:25:07 +03:00
==
::
2018-03-29 21:03:14 +03:00
++ wthp |= opt/(list (pair spec hoon))
2017-09-21 00:13:10 +03:00
%+ gray %wthp
2018-03-29 21:03:14 +03:00
[puce (turn opt |=({a/spec b/hoon} [a (blue b)]))]
2017-11-17 00:50:03 +03:00
++ wtkt |=({sic/hoon non/hoon} (gray [%wtkt puce (blue sic) (blue non)]))
2018-03-29 21:03:14 +03:00
++ wtls |= {gen/hoon opt/(list (pair spec hoon))}
2017-09-21 00:13:10 +03:00
%+ gray %wtls
2018-03-29 21:03:14 +03:00
[puce (blue gen) (turn opt |=({a/spec b/hoon} [a (blue b)]))]
2018-03-19 05:40:38 +03:00
++ wtvt |=({sic/hoon non/hoon} (gray [%wtvt puce (blue sic) (blue non)]))
2017-11-17 00:50:03 +03:00
++ wtsg |=({sic/hoon non/hoon} (gray [%wtsg puce (blue sic) (blue non)]))
2018-03-29 21:03:14 +03:00
++ wtts |=(mod/spec (gray [%wtts (teal mod) puce]))
2016-11-24 07:25:07 +03:00
--
2018-04-17 06:28:30 +03:00
++ limb-to-plum
|= =limb
?- -.limb
%& (scot %ui p.limb)
%| (crip (runt [0 p.limb] ?~(q.limb "," (trip u.q.limb))))
==
::
++ wing-to-plum
|= =wing
^- plum
:+ %&
[`['.' ~] ~]
(turn wing limb-to-plum)
::
++ battery-to-plum
|= =(map term spec)
%+ turn ~(tap by map)
|= [=term =spec]
:+ %&
[`[' ' ~] `['' ~]]
[term (spec-to-plum spec) ~]
::
++ core-to-plum
|= [=knot =spec =(map term spec)]
^- plum
:+ %&
[~ `[knot ~]]
:~ (spec-to-plum spec)
:+ %&
[~ `['' `['++' '==']]]
(battery-to-plum map)
==
::
++ hoon-to-plum
|= =hoon
^- plum
%hooon
::
++ spec-to-plum
|= =spec
^- plum
?+ -.spec !!
%base ?- p.spec
%noun '*'
%cell '^'
%flag '?'
%null '~'
%void '!!'
[%atom *] (cat 3 '@' p.p.spec)
==
%dbug $(spec q.spec)
%leaf (cat 3 '%' (scot p.spec q.spec))
%like :+ %&
[`[':' ~] ~]
(turn `(list wing)`+.spec wing-to-plum)
%loop (cat 3 '$' p.spec)
%make =+ (lent q.spec)
:+ %&
:- `[' ' `['(' ')']]
:- ~
?: |((gth - 3) =(- 0))
['%:' `['' '==']]
:_ ~
?: =(- 3) '%^'
?: =(- 2) '%+' '%-'
[(hoon-to-plum p.spec) (turn q.spec ..$)]
%bcbc (core-to-plum '$$' p.spec q.spec)
%bcbr :+ %&
[`[' ' `['$|(' ')']] `['$|' ~]]
:~ $(spec p.spec)
(hoon-to-plum q.spec)
==
%bccb (hoon-to-plum p.spec)
%bccl :+ %&
[`[' ' `['[' ']']] `['$:' `['' '==']]]
(turn `(list ^spec)`+.spec ..$)
%bccn :+ %&
[`[' ' `['$%(' ')']] `['$%' `['' '==']]]
(turn `(list ^spec)`+.spec ..$)
%bcdt (core-to-plum '$.' p.spec q.spec)
==
++ cosmetic
:: entry-trace: current potential block entries
:: block-count: cumulative blocks detected
:: block-pairs: blocking numbers and specs
2018-03-31 06:54:04 +03:00
::
=| entry-trace=(set type)
2018-04-08 20:44:15 +03:00
=| block-count=@ud
=| block-pairs=(map type (pair @ud spec))
2018-03-31 06:54:04 +03:00
::
2018-04-11 04:51:33 +03:00
:: sut: type we're analyzing
2018-04-08 20:44:15 +03:00
::
=| sut/type
2018-03-31 06:54:04 +03:00
=< :: public interface
::
|? |%
::
:: +structure: make cosmetic spec from :sut
2018-03-31 06:54:04 +03:00
::
++ structure
2018-04-15 04:19:13 +03:00
:: spec: raw analysis product
2018-04-12 02:40:22 +03:00
::
=^ spec +> specify
2018-04-15 04:19:13 +03:00
:: if we didn't block, just use it
2018-04-12 02:40:22 +03:00
::
?: =(~ block-pairs) spec
:: otherwise, insert hygienic recursion
2018-04-12 02:40:22 +03:00
::
2018-04-15 04:19:13 +03:00
:+ %bcbc spec
%- ~(gas by *(map term ^spec))
%+ turn
~(tap by block-pairs)
|= [=type index=@ud spec=^spec]
2018-04-15 04:19:13 +03:00
[(synthetic index) spec]
2018-03-31 06:54:04 +03:00
::
2018-04-11 04:51:33 +03:00
:: +pattern: pattern and context for data inspection
2018-03-31 06:54:04 +03:00
::
++ pattern
^- $: :: main: rendering pattern
:: context: recursion points by counter
::
main=plot
2018-04-11 04:51:33 +03:00
loop=(map @ud plot)
2018-03-31 06:54:04 +03:00
==
!!
--
:: private core
::
|%
2018-04-08 20:44:15 +03:00
:: +synthetic: convert :number to a synthetic name
2018-03-31 06:54:04 +03:00
::
2018-04-08 20:44:15 +03:00
++ synthetic
|= number=@ud
^- @tas
?: (lte number 26)
(add 'a' number)
(cat 3 (add 'a' (mod number 26)) $(number (div number 26)))
::
2018-04-15 04:19:13 +03:00
:: +specify: make spec that matches :sut
2018-03-31 06:54:04 +03:00
::
++ specify
^- [spec _.]
=< [- +>]
=< entry
|%
:: +entry: make spec at potential entry point
::
++ entry
^- [spec _.]
:: if we are already inside :sut
::
?: (~(has in entry-trace) sut)
:: then produce and record a block reference
2018-03-31 06:54:04 +03:00
::
=+ [%loop (synthetic block-count)]
:- -
%_ +
block-count +(block-count)
block-pairs (~(put by block-pairs) sut [block-count -])
==
:: else filter main loop for block promotion
::
=^ spec . main(entry-trace (~(put in entry-trace) sut))
:: loc: output block record for :sut
::
=/ loc (~(get by block-pairs) sut)
:: if we did not find :sut inside itself, not a true entry point
::
?~ loc [spec +>]
:: else produce a block reference and record the analysis
::
:- [%loop (synthetic p.u.loc)]
+>(block-pairs (~(put by block-pairs) sut [p.u.loc spec]))
::
:: +main: make spec from any type
::
++ main
?- sut
%void :_(. [%base %void])
%noun :_(. [%base %noun])
::
[%atom *] (atom p.sut q.sut)
[%cell *] (cell p.sut q.sut)
[%core *] (core p.sut q.sut)
[%face *] (face p.sut q.sut)
[%form *] !! :: (form(sut p.p.sut) q.p.sut)
[%fork *] (fork p.sut)
[%hold *] entry(sut ~(repo ut sut))
==
::
:: +form: rationalize structure from trace (stub)
2018-04-08 20:44:15 +03:00
::
2018-04-12 02:40:22 +03:00
++ form
2018-04-08 20:44:15 +03:00
|= =spec
2018-04-12 02:40:22 +03:00
^- [^spec _+>]
:_ +>
|- ^- ^spec
:: reform a spec left as a type annotation
::
2018-04-13 01:42:39 +03:00
?+ -.spec spec
:: incomplete
::
2018-04-12 02:40:22 +03:00
%dbug $(spec q.spec)
%like :: hub: type of context
:: poy: reference
::
=/ hub %- ~(play ut sut)
|- ^- hoon
?~ q.spec [%$ 1]
2018-04-13 01:42:39 +03:00
[%tsgl [%wing i.q.spec] $(q.spec t.q.spec)]
=/ poy (~(fond ut hub) %free p.spec)
:: if we have a simple arm
::
?: ?=([%& * * %| *] poy)
:: then keep the spec
::
spec
!!
2018-04-12 02:40:22 +03:00
==
2018-04-08 20:44:15 +03:00
::
:: +atom: convert atomic type to spec
2018-03-31 06:54:04 +03:00
::
++ atom
|= $: :: aura: flavor of atom
:: constant: one value, or all values
::
aura=term
constant=(unit @)
==
:: pure function
::
:_ +> ^- spec
:: if atom is not constant
::
?~ constant
:: %base: flavored atom with arbitrary value
::
[%base atom/aura]
:: %leaf: flavored constant
::
[%leaf aura u.constant]
::
2018-04-08 20:44:15 +03:00
:: +cell: convert a %cell to a spec
2018-03-31 06:54:04 +03:00
::
++ cell
|= $: :: left: head of cell
:: rite: tail of cell
::
left=type
rite=type
==
^- [spec _+>]
:: head: cosmetic structure of head
:: tail: cosmetic structure of tail
::
=^ head +>.$ main(sut left)
=^ tail +>.$ main(sut rite)
2018-04-12 02:40:22 +03:00
:_ +>.$
2018-03-31 06:54:04 +03:00
:: %bccl: raw tuple
::
2018-04-12 02:40:22 +03:00
?: ?=(%bccl -.tail)
[%bccl head +.tail]
[%bccl head tail ~]
2018-03-31 06:54:04 +03:00
::
2018-04-08 20:44:15 +03:00
:: +core: convert a %core to a spec
::
++ core
|= $: :: payload: data
:: battery: code
::
payload=type
battery=coil
==
^- [spec _+>]
:: payload-spec: converted payload
::
=^ payload-spec +>.$ main(sut payload)
2018-04-08 20:44:15 +03:00
:: arms: all arms in the core, as hoons
::
=/ arms
^- (list (pair term hoon))
%- zing
^- (list (list (pair term hoon)))
%+ turn ~(tap by q.s.battery)
|= [term =tomb]
^- (list (pair term hoon))
%+ turn ~(tap by q.tomb)
|= [=term =what =foot]
^- (pair @tas hoon)
[term p.foot]
:: arm-specs: all arms in the core, as specs
::
=^ arm-specs +>.$
|- ^- [(list (pair term spec)) _+>.^$]
?~ arms [~ +>.^$]
=^ mor +>.^$ $(arms t.arms)
=^ les +>.^$
main(sut [%hold [%core payload battery] q.i.arms])
2018-04-08 20:44:15 +03:00
[[[p.i.arms les] mor] +>.^$]
:: arm-map: all arms in the core, as a a spec map
::
=* arm-map (~(gas by *(map term spec)) arm-specs)
:_ +>.$
?- p.battery
%lead [%bczp payload-spec arm-map]
%gold [%bcdt payload-spec arm-map]
%zinc [%bctc payload-spec arm-map]
%iron [%bcnt payload-spec arm-map]
==
::
:: +face: convert a %face to a +spec
2018-03-31 06:54:04 +03:00
::
++ face
|= $: :: decor: decoration
:: content: decorated content
::
decor=(pair what $@(term tune))
content=type
==
2018-04-08 20:44:15 +03:00
^- [spec _+>]
=^ body +>.$ main(sut content)
2018-03-31 06:54:04 +03:00
:_ +>.$
2018-04-08 20:44:15 +03:00
?@ q.decor [%bcts q.decor body]
:: discard aliases, etc
::
body
::
:: +fork: convert a %fork to a +spec
::
++ fork
|= types=(set type)
^- [spec _+>]
:: type-list: type set as a list
::
=/ type-list ~(tap by types)
:: specs: type set as a list of specs
2018-03-31 06:54:04 +03:00
::
2018-04-08 20:44:15 +03:00
=^ specs +>.$
|- ^- [(list spec) _+>.^$]
?~ type-list [~ +>.^$]
=^ mor +>.^$ $(type-list t.type-list)
=^ les +>.^$ main(sut i.type-list)
2018-04-08 20:44:15 +03:00
[[les mor] +>.^$]
?< ?=(~ specs)
:_(+>.$ [%bcwt specs])
2018-03-31 06:54:04 +03:00
--
::
:: +explore:cosmetic: convert :sut to an inspection pattern (+plot).
::
++ explore
^- [plot _.]
=< [- +>]
|^ ^- [plot _.]
?+ sut !!
2018-04-08 20:44:15 +03:00
%void :_(. [%base %void])
%noun :_(. [%base %noun])
2018-03-31 06:54:04 +03:00
==
2018-04-08 20:44:15 +03:00
++ foo !!
2018-03-31 06:54:04 +03:00
--
--
::
2018-03-07 01:28:14 +03:00
++ ax
2018-01-01 06:13:45 +03:00
=+ :* :: dom: axis to home
2018-03-14 08:56:31 +03:00
:: hay: wing to home
2018-04-14 08:31:53 +03:00
:: cox: hygienic context
2018-01-01 06:13:45 +03:00
:: bug: debug annotations
2018-02-10 02:15:32 +03:00
:: def: default expression
2018-01-01 06:13:45 +03:00
::
dom=`axis`1
2018-03-14 08:56:31 +03:00
hay=*wing
2018-04-14 08:31:53 +03:00
cox=*(map term spec)
2018-01-01 06:13:45 +03:00
bug=*(list spot)
2018-02-10 02:15:32 +03:00
def=*(unit hoon)
==
2018-03-29 21:03:14 +03:00
|_ {fab/? mod/spec}
2017-12-20 23:31:45 +03:00
::
2018-04-11 07:06:46 +03:00
++ autoname
:: derive name from spec
::
|- ^- (unit term)
?- -.mod
$base ?.(?=([%atom *] p.mod) ~ `p.p.mod)
$dbug $(mod q.mod)
$leaf `p.mod
2018-04-14 08:31:53 +03:00
$loop `p.mod
2018-04-17 03:33:42 +03:00
$like ?~(p.mod ~ ?^(i.p.mod ?:(?=(%& -.i.p.mod) ~ q.i.p.mod) `i.p.mod))
2018-04-11 07:06:46 +03:00
$make ~(name ap p.mod)
$over $(mod q.mod)
::
2018-04-14 08:31:53 +03:00
$bcbc $(mod p.mod)
2018-04-11 07:06:46 +03:00
$bcbr $(mod p.mod)
$bccb ~(name ap p.mod)
$bccl $(mod i.p.mod)
$bccn $(mod i.p.mod)
$bcdt ~
$bcgl $(mod q.mod)
$bcgr $(mod q.mod)
$bchp $(mod p.mod)
$bckt $(mod q.mod)
2018-04-15 01:12:00 +03:00
$bcls $(mod q.mod)
2018-04-11 07:06:46 +03:00
$bcnt ~
$bcmc ~(name ap p.mod)
$bcpd $(mod p.mod)
$bcsg $(mod q.mod)
$bctc ~
$bcts $(mod q.mod)
$bcvt $(mod q.mod)
$bcwt $(mod i.p.mod)
$bczp ~
==
::
2017-12-20 23:31:45 +03:00
++ function
:: construct a function example
::
2018-03-29 21:03:14 +03:00
|= {fun/spec arg/spec}
2017-12-20 23:31:45 +03:00
^- hoon
:: minimal context as subject
::
:+ %tsgr
2018-03-29 21:03:14 +03:00
:: context is example of both specs
2017-12-20 23:31:45 +03:00
::
2018-02-11 08:24:22 +03:00
[example:clear(mod fun) example:clear(mod arg)]
2017-12-20 23:31:45 +03:00
:: produce an %iron (contravariant) core
::
:- %ktbr
:: make an actual gate
::
:^ %brcl [~ ~]
[%$ 2]
[%$ 15]
::
++ interface
:: construct a core example
::
2018-03-29 21:03:14 +03:00
|= {variance/vair payload/spec arms/(map term spec)}
^- hoon
:: attach proper variance control
::
=- ?- variance
%gold -
%lead [%ktwt -]
%zinc [%ktpd -]
%iron [%ktbr -]
==
^- hoon
:+ %tsgr example:clear(mod payload)
:+ %brcn *chap
=- [[0 [~ ~] -] ~ ~]
%- ~(gas by *(map term (pair what foot)))
^- (list (trel term what foot))
%+ turn
~(tap by arms)
2018-03-29 21:03:14 +03:00
|= [=term =spec]
::
2018-03-29 21:03:14 +03:00
:: note that we *don't* make arm specs in an interface
:: hygienic -- we leave them in context, to support
:: maximum programmer flexibility
::
2018-03-29 21:03:14 +03:00
[term *what %ash example:clear(mod spec)]
::
++ home
:: express a hoon against the original subject
::
2018-03-14 08:56:31 +03:00
|= gen/hoon
^- hoon
=+ ^- wing
?: =(1 dom)
hay
(weld hay `wing`[[%& dom] ~])
?~ - gen
[%tsgr [%wing -] gen]
::
2018-01-01 06:13:45 +03:00
++ clear
:: clear annotations
^+ .
.(bug ~, def ~)
::
2018-01-01 06:13:45 +03:00
++ basal
2018-02-11 08:24:22 +03:00
:: example base case
2018-01-01 06:13:45 +03:00
::
|= bas/base
?- bas
::
{$atom *}
2018-03-29 21:03:14 +03:00
:: we may want sped
::
2018-03-27 02:55:02 +03:00
[%sand p.bas ?:(=(%da p.bas) ~2000.1.1 0)]
::
$noun
:: raw nock produces noun type
::
=+([%rock %$ 0] [%ktls [%dttr - - [%rock %$ 1]] -])
::
$cell
:: reduce to pair of nouns
::
2017-12-06 04:05:09 +03:00
=+($(bas %noun) [- -])
2018-03-19 05:40:38 +03:00
::
$flag
:: comparison produces boolean type
::
=+([%rock %$ 0] [%ktls [%dtts - -] -])
::
$null
[%rock %n 0]
2018-03-31 06:54:04 +03:00
::
$void
[%zpzp ~]
==
::
2018-03-20 07:42:45 +03:00
++ unfold
2018-03-29 21:03:14 +03:00
|= [fun/hoon arg/(list spec)]
2018-03-20 07:42:45 +03:00
^- hoon
2018-03-29 21:03:14 +03:00
[%cncl fun (turn arg |=(spec bccm/+<))]
2018-03-20 07:42:45 +03:00
::
2018-04-11 07:06:46 +03:00
++ unreel
|= [one/wing res/(list wing)]
^- hoon
?~(res [%wing one] [%tsgl [%wing one] $(one i.res, res t.res)])
::
++ descend
2018-03-14 08:56:31 +03:00
:: record an axis to original subject
::
|= axe/axis
+>(dom (peg axe dom))
::
++ decorate
:: apply documentation to expression
::
|= gen/hoon
^- hoon
|- ^- hoon
?~(bug gen [%dbug i.bug $(bug t.bug)])
2018-03-14 08:56:31 +03:00
::
2018-03-03 03:58:58 +03:00
++ spore
:: build default sample
::
^- hoon
:: sample is always typeless
::
:+ %ktls
[%bust %noun]
:: consume debugging context
::
%- decorate
:: use home as subject
::
%- home
:: if default is set, use it
::
?^ def u.def
:: else map structure to expression
::
~+
|- ^- hoon
?- mod
2018-03-31 06:54:04 +03:00
{$base *} ?:(=(%void p.mod) [%rock %n 0] (basal p.mod))
2018-04-14 08:31:53 +03:00
{$bcbc *} :: track hygienic recursion points lexically
::
%= $
mod p.mod
cox :: merge lexically and don't forget %$
::
(~(put by ^+(cox (~(uni by cox) q.mod))) %$ p.mod)
==
2018-03-11 08:15:09 +03:00
{$dbug *} [%dbug p.mod $(mod q.mod)]
2018-03-19 20:43:25 +03:00
{$leaf *} [%rock p.mod q.mod]
2018-04-14 08:31:53 +03:00
{$loop *} ~|([%loop p.mod] $(mod (~(got by cox) p.mod)))
2018-04-11 07:06:46 +03:00
{$like *} $(mod bcmc/(unreel p.mod q.mod))
2018-03-20 07:42:45 +03:00
{$make *} $(mod bcmc/(unfold p.mod q.mod))
2018-03-19 20:43:25 +03:00
{$over *} $(hay p.mod, mod q.mod)
::
2018-03-20 05:42:13 +03:00
{$bcbr *} $(mod p.mod)
2018-03-19 20:43:25 +03:00
{$bccb *} [%rock %n 0]
{$bccl *} |- ^- hoon
?~ t.p.mod ^$(mod i.p.mod)
:- ^$(mod i.p.mod)
$(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
{$bccn *} :: use last entry
::
|- ^- hoon
?~ t.p.mod ^$(mod i.p.mod)
$(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
2018-03-11 08:15:09 +03:00
{$bchp *} :: see under %bccb
2018-03-05 02:08:12 +03:00
::
[%rock %n 0]
2018-03-19 23:38:19 +03:00
{$bcgl *} $(mod q.mod)
{$bcgr *} $(mod q.mod)
2018-03-19 20:43:25 +03:00
{$bckt *} $(mod q.mod)
{$bcls *} $(mod q.mod)
2018-03-14 07:36:10 +03:00
{$bcmc *} :: borrow sample
::
[%tsgl [%$ 6] p.mod]
2018-03-20 05:42:13 +03:00
{$bcpd *} $(mod p.mod)
2018-03-19 20:43:25 +03:00
{$bcsg *} p.mod
{$bcts *} [%ktts p.mod $(mod q.mod)]
{$bcvt *} $(mod p.mod)
{$bcwt *} :: use last entry
::
|- ^- hoon
?~ t.p.mod ^$(mod i.p.mod)
$(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
{$bcdt *} [%rock %n 0]
{$bcnt *} [%rock %n 0]
{$bctc *} [%rock %n 0]
{$bczp *} [%rock %n 0]
==
::
2018-02-11 08:24:22 +03:00
++ example
:: produce a correctly typed default instance
::
~+
^- hoon
2018-03-19 23:38:19 +03:00
?+ mod
:: in the general case, make and analyze a spore
2018-03-19 20:43:25 +03:00
::
2018-02-11 08:24:22 +03:00
:+ %tsls
2018-03-04 05:54:15 +03:00
spore
2018-03-19 20:43:25 +03:00
~(relative analyze:(descend 3) 2)
::
2018-03-19 23:38:19 +03:00
{$base *} (decorate (basal p.mod))
{$dbug *} example(mod q.mod, bug [p.mod bug])
{$leaf *} (decorate [%rock p.mod q.mod])
2018-04-11 07:06:46 +03:00
{$like *} example(mod bcmc/(unreel p.mod q.mod))
2018-04-14 08:31:53 +03:00
{$loop *} [%limb p.mod]
2018-03-20 07:42:45 +03:00
{$make *} example(mod bcmc/(unfold p.mod q.mod))
2018-03-19 23:38:19 +03:00
{$over *} example(hay p.mod, mod q.mod)
::
2018-03-20 05:42:13 +03:00
{$bccb *} (decorate (home p.mod))
2018-03-19 23:38:19 +03:00
{$bccl *} %- decorate
|- ^- hoon
?~ t.p.mod
example:clear(mod i.p.mod)
:- example:clear(mod i.p.mod)
example:clear(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod)
{$bchp *} (decorate (function:clear p.mod q.mod))
{$bcmc *} (decorate (home [%tsgl [%limb %$] p.mod]))
{$bcsg *} [%ktls example(mod q.mod) (home p.mod)]
{$bcls *} (decorate example(mod q.mod))
2018-03-19 23:38:19 +03:00
{$bcts *} (decorate [%ktts p.mod example:clear(mod q.mod)])
{$bcdt *} (decorate (home (interface %gold p.mod q.mod)))
{$bcnt *} (decorate (home (interface %iron p.mod q.mod)))
{$bczp *} (decorate (home (interface %lead p.mod q.mod)))
{$bctc *} (decorate (home (interface %zinc p.mod q.mod)))
==
::
++ factory
2018-04-11 07:06:46 +03:00
:: make a normalizing gate (mold)
::
^- hoon
2018-01-01 06:13:45 +03:00
:: process annotations outside construct, to catch default
::
2018-03-11 08:15:09 +03:00
?: ?=($dbug -.mod) factory(mod q.mod, bug [p.mod bug])
?: ?=($bcsg -.mod) factory(mod q.mod, def `p.mod)
^- hoon
2018-04-14 08:31:53 +03:00
:: if we recognize an indirection
2018-04-11 07:06:46 +03:00
::
2018-04-14 08:31:53 +03:00
?: &(=(~ def) ?=(?(%bcmc %like %loop %make) -.mod))
:: then short-circuit it
::
2018-04-11 07:06:46 +03:00
%- decorate
%- home
?- -.mod
%bcmc p.mod
%like (unreel p.mod q.mod)
2018-04-14 08:31:53 +03:00
%loop [%limb p.mod]
2018-04-11 07:06:46 +03:00
%make (unfold p.mod q.mod)
==
2018-04-14 08:31:53 +03:00
:: else build a gate
2018-04-11 07:06:46 +03:00
::
:^ %brcl ~^~
2018-03-07 01:42:05 +03:00
[%ktsg spore]
2018-03-19 20:43:25 +03:00
~(relative analyze:(descend 7) 6)
::
2018-03-19 20:43:25 +03:00
++ analyze
2018-02-04 05:45:07 +03:00
:: normalize a fragment of the subject
::
2018-02-04 05:45:07 +03:00
|_ $: :: axe: axis to fragment
::
axe/axis
==
++ basic
|= bas/base
2018-01-01 06:13:45 +03:00
^- hoon
?- bas
{%atom *}
:+ %ktls example
2018-03-27 02:55:02 +03:00
^- hoon
:^ %zpvt
[[[%| 0 `%ruth] ~] ~]
[%cnls [%limb %ruth] [%sand %ta p.bas] fetch]
2018-03-19 05:40:38 +03:00
[%wtvt fetch-wing fetch [%zpzp ~]]
::
$cell
:+ %ktls example
=+ fetch-wing
:- [%wing [[%& %2] -]]
[%wing [[%& %3] -]]
2018-03-19 05:40:38 +03:00
::
$flag
:^ %wtcl
[%dtts [%rock %$ &] [%$ axe]]
[%rock %f &]
:+ %wtgr
[%dtts [%rock %$ |] [%$ axe]]
[%rock %f |]
2018-03-19 23:38:19 +03:00
::
$noun
fetch
::
$null
:+ %wtgr
[%dtts [%bust %noun] [%$ axe]]
[%rock %n ~]
2018-04-08 20:44:15 +03:00
:::
$void
[%zpzp ~]
==
2018-01-01 06:13:45 +03:00
++ clear
2018-03-19 20:43:25 +03:00
.(..analyze ^clear)
2018-03-19 23:38:19 +03:00
::
++ fetch
2018-02-04 05:45:07 +03:00
:: load the fragment
::
^- hoon
[%$ axe]
::
++ fetch-wing
:: load, as a wing
::
^- wing
[[%& axe] ~]
::
++ choice
:: match full models, by trying them
::
|= $: :: one: first option
:: rep: other options
::
2018-03-29 21:03:14 +03:00
one/spec
rep/(list spec)
==
^- hoon
:: if no other choices, construct head
::
2018-02-12 07:03:38 +03:00
?~ rep relative:clear(mod one)
:: build test
::
:^ %wtcl
2018-03-18 04:06:15 +03:00
:: if we fit the type of this choice
::
2018-03-18 04:06:15 +03:00
[%fits example:clear(mod one) fetch-wing]
:: build with this choice
::
2018-03-18 04:06:15 +03:00
relative:clear(mod one)
:: continue through loop
::
$(one i.rep, rep t.rep)
::
++ switch
|= $: :: one: first format
:: two: more formats
::
2018-03-29 21:03:14 +03:00
one/spec
rep/(list spec)
==
|- ^- hoon
:: if no other choices, construct head
::
?~ rep relative:clear(mod one)
:: fin: loop completion
::
=/ fin/hoon $(one i.rep, rep t.rep)
:: interrogate this instance
::
:^ %wtcl
2017-12-06 04:05:09 +03:00
:: test if the head matches this wing
::
2018-03-09 03:41:21 +03:00
:+ %fits
[%tsgl [%$ 2] example:clear(mod one)]
2018-03-09 03:41:21 +03:00
fetch-wing(axe (peg axe 2))
2017-12-06 04:05:09 +03:00
:: if so, use this form
::
relative:clear(mod one)
:: continue in the loop
::
fin
::
2018-02-12 07:03:38 +03:00
++ relative
2018-02-04 07:04:56 +03:00
:: local constructor
::
2018-02-04 07:04:56 +03:00
~+
^- hoon
?- mod
::
2018-03-20 05:42:13 +03:00
:: base
::
{$base *}
(decorate (basic:clear p.mod))
::
:: debug
::
{$dbug *}
relative(mod q.mod, bug [p.mod bug])
::
2018-03-19 23:38:19 +03:00
:: constant
::
{$leaf *}
%- decorate
:+ %wtgr
[%dtts fetch [%rock %$ q.mod]]
[%rock p.mod q.mod]
::
2018-03-20 07:42:45 +03:00
:: composite
::
{$make *}
2018-03-20 07:42:45 +03:00
relative(mod bcmc/(unfold p.mod q.mod))
::
2018-04-11 07:06:46 +03:00
:: indirect
::
{$like *}
relative(mod bcmc/(unreel p.mod q.mod))
::
2018-04-14 08:31:53 +03:00
:: loop
::
{$loop *}
(decorate [%cnhp [%limb p.mod] fetch])
::
2018-03-19 23:38:19 +03:00
:: subjective
::
{$over *}
relative(hay p.mod, mod q.mod)
::
2018-04-14 08:31:53 +03:00
:: recursive, $$
::
{$bcbc *}
::
:: apply semantically
::
:^ %brkt *chap
relative(mod p.mod, dom (peg 3 dom))
=- [[0 [~ ~] -] ~ ~]
%- ~(gas by *(map term (pair what foot)))
^- (list (trel term what foot))
%+ turn
~(tap by q.mod)
|= [=term =spec]
[term *what %ash relative(mod spec, dom (peg 3 dom))]
::
2018-03-20 05:42:13 +03:00
:: normalize, $&
::
2018-03-20 05:42:13 +03:00
{$bcpd *}
2018-03-27 02:55:02 +03:00
:: push the raw result
2018-03-20 05:42:13 +03:00
::
:+ %tsls relative(mod p.mod)
2018-03-27 02:55:02 +03:00
:: push repair function
2018-03-20 05:42:13 +03:00
::
:+ %tsls
[%tsgr $/3 q.mod]
2018-03-27 02:55:02 +03:00
:: push repaired product
2018-03-20 05:42:13 +03:00
::
:+ %tsls
[%cnhp $/2 $/6]
2018-03-27 02:55:02 +03:00
:: sanity-check repaired product
2018-03-20 05:42:13 +03:00
::
:+ %wtgr
:: either
::
:~ %wtbr
:: the repair did not change anything
::
[%dtts $/14 $/2]
:: when we fix it again, it stays fixed
::
[%dtts $/2 [%cnhp $/6 $/2]]
==
$/2
2018-01-01 06:13:45 +03:00
::
2018-03-20 05:42:13 +03:00
:: verify, $|
::
2018-03-20 05:42:13 +03:00
{$bcbr *}
^- hoon
:: push the raw product
::
:+ %tsls relative(mod p.mod)
^- hoon
:: assert
::
:+ %wtgr
:: run the verifier
::
[%cnhp [%tsgr $/3 q.mod] $/2]
:: produce verified product
::
$/2
::
2018-03-20 05:42:13 +03:00
:: special, $_
::
2018-03-20 05:42:13 +03:00
{$bccb *}
(decorate (home p.mod))
::
2018-03-20 05:42:13 +03:00
:: switch, $%
::
{$bccn *}
(decorate (switch i.p.mod t.p.mod))
::
2018-02-04 08:52:57 +03:00
:: tuple, $:
::
2018-03-11 08:15:09 +03:00
{$bccl *}
2018-02-04 08:52:57 +03:00
%- decorate
|- ^- hoon
?~ t.p.mod
2018-02-12 07:03:38 +03:00
relative:clear(mod i.p.mod)
:- relative:clear(mod i.p.mod, axe (peg axe 2))
2018-02-12 07:03:38 +03:00
%= relative
2018-02-04 08:52:57 +03:00
i.p.mod i.t.p.mod
t.p.mod t.t.p.mod
axe (peg axe 3)
==
::
2018-03-19 23:38:19 +03:00
:: exclude, $<
::
2018-03-19 23:38:19 +03:00
{$bcgl *}
:+ %tsls
relative
:+ %wtgl
[%wtts [%over ~[&/3] p.mod] ~[&/4]]
$/2
2018-03-14 08:56:31 +03:00
::
2018-03-19 23:38:19 +03:00
:: require, $>
2018-03-14 08:56:31 +03:00
::
2018-03-19 23:38:19 +03:00
{$bcgr *}
:+ %tsls
relative
:+ %wtgr
[%wtts [%over ~[&/3] p.mod] ~[&/4]]
$/2
::
2017-12-20 23:31:45 +03:00
:: function
::
2018-03-11 08:15:09 +03:00
{$bchp *}
%- decorate
=/ fun (function:clear p.mod q.mod)
?^ def
2018-02-10 02:15:32 +03:00
[%ktls fun u.def]
fun
2017-12-20 23:31:45 +03:00
::
:: bridge, $^
::
2018-03-11 08:15:09 +03:00
{$bckt *}
2018-01-01 06:13:45 +03:00
%- decorate
:^ %wtcl
[%dtwt fetch(axe (peg axe 2))]
relative:clear(mod p.mod)
relative:clear(mod q.mod)
::
2018-03-20 05:42:13 +03:00
:: synthesis, $;
::
2018-03-20 05:42:13 +03:00
{$bcmc *}
(decorate [%cncl (home p.mod) fetch ~])
::
:: default
::
{$bcsg *}
relative(mod q.mod, def `p.mod)
::
:: choice, $?
::
{$bcwt *}
(decorate (choice i.p.mod t.p.mod))
::
:: name, $=
::
{$bcts *}
[%ktts p.mod relative(mod q.mod)]
::
:: branch, $@
::
{$bcvt *}
%- decorate
:^ %wtcl
[%dtwt fetch]
relative:clear(mod q.mod)
relative:clear(mod p.mod)
::
{$bcls *} relative(mod q.mod)
{$bcdt *} (decorate (home (interface %gold p.mod q.mod)))
{$bcnt *} (decorate (home (interface %iron p.mod q.mod)))
{$bczp *} (decorate (home (interface %lead p.mod q.mod)))
{$bctc *} (decorate (home (interface %zinc p.mod q.mod)))
==
--
--
::
2017-11-17 00:50:03 +03:00
++ ap :: hoon engine
2016-11-24 07:25:07 +03:00
~% %ap
2018-01-30 06:13:00 +03:00
+>+
2016-11-24 07:25:07 +03:00
==
%etch etch
%open open
%rake rake
==
2018-01-30 06:13:00 +03:00
=+ fab=`?`&
2017-11-17 00:50:03 +03:00
|_ gen/hoon
2016-11-24 07:25:07 +03:00
++ etch
~_ leaf+"etch"
|- ^- term
2017-09-20 02:24:30 +03:00
?: ?=({$ktts *} gen)
2016-11-24 07:25:07 +03:00
?>(?=(@ p.gen) p.gen)
=+ voq=~(open ap gen)
?<(=(gen voq) $(gen voq))
::
2018-04-11 07:06:46 +03:00
++ name
|- ^- (unit term)
?+ gen ~
{$wing *} ?~ p.gen ~
?^ i.p.gen
?:(?=(%& -.i.p.gen) ~ q.i.p.gen)
`i.p.gen
2018-04-11 07:06:46 +03:00
{$limb *} `p.gen
{$dbug *} $(gen ~(open ap gen))
{$tsgl *} $(gen ~(open ap gen))
{$tsgr *} $(gen q.gen)
==
::
2016-11-24 07:25:07 +03:00
++ feck
|- ^- (unit term)
?- gen
{$sand $tas @} [~ q.gen]
{$dbug *} $(gen q.gen)
* ~
==
::
2017-04-05 03:33:20 +03:00
++ gi
=| whit
=* wit -
|%
++ gray
^- ?
|
:: on reflection, perhaps just obsessive linting
::
:: ?| ?=(^ lab)
:: ?=(^ boy)
:: |- ^- ?
:: ?~ def |
:: |($(def l.def) $(def r.def) !(~(has in use) p.n.def))
:: ==
::
++ grad
2017-11-17 00:50:03 +03:00
|= $: gen/hoon
2017-04-05 03:33:20 +03:00
wit/whit
2017-11-17 00:50:03 +03:00
aid/$-({? hoon whit} {hoon whit})
2017-04-05 03:33:20 +03:00
==
2017-11-17 00:50:03 +03:00
^- (unit (pair hoon whit))
2017-04-05 03:33:20 +03:00
=: ^gen gen
^wit wit
==
?: =([~ ~ ~ ~] wit) `[gen wit]
=< apex
|%
++ apex
2017-11-17 00:50:03 +03:00
^- (unit (pair hoon whit))
2017-04-05 03:33:20 +03:00
=^ one wit prim
=^ two wit senc(gen one)
?: =(gen two)
~
`(aid & two wit)
::
:: resolve body and label issues
::
++ prim
2017-11-17 00:50:03 +03:00
^- (pair hoon whit)
2017-04-05 03:33:20 +03:00
?: ?=(^ -.gen) flam
?+ -.gen flam
$base runk
$leaf runk
2017-09-18 04:32:20 +03:00
$brcb ((doof -.gen +>.gen) p.gen)
$brcl ((doof -.gen +>.gen) p.gen)
$brcn ((doof -.gen +>.gen) p.gen)
$brdt ((doof -.gen +>.gen) p.gen)
$brkt ((doof -.gen +>.gen) p.gen)
$brhp ((doof -.gen +>.gen) p.gen)
$brsg ((doof -.gen +>.gen) p.gen)
$brtr ((doof -.gen +>.gen) p.gen)
2017-09-17 21:14:12 +03:00
$brts ((doof -.gen +>.gen) p.gen)
2017-09-18 04:32:20 +03:00
$brwt ((doof -.gen +>.gen) p.gen)
2017-04-05 03:33:20 +03:00
==
::
:: resolve variable issues
::
++ senc
2017-11-17 00:50:03 +03:00
^- (pair hoon whit)
2017-04-05 03:33:20 +03:00
?: ?=(^ -.gen) flam
?+ -.gen flam
2017-09-20 02:24:30 +03:00
$ktts ((helk -.gen +>.gen) p.gen)
2018-03-14 06:17:30 +03:00
$tsnt ((himp -.gen +>.gen) p.gen)
$tsmc ((himp -.gen +>.gen) p.gen)
2018-03-13 04:20:48 +03:00
$tskt ((himp -.gen +>.gen) p.gen)
2018-03-12 08:29:13 +03:00
$tstr ((humm -.gen +>.gen) p.gen)
2017-04-05 03:33:20 +03:00
==
::
++ flam [gen wit]
++ grif
|= {cog/term wat/what}
^- {what whit}
?: =(~ def)
?~ boy [wat wit]
[boy wit(boy ~)]
=+ yeb=(~(get by def) cog)
?~ yeb [wat wit]
[`u.yeb wit(use (~(put in use) cog))]
::
++ doof
|* {pif/@tas suf/*}
|= pac/chap
2017-11-17 00:50:03 +03:00
^- (pair hoon whit)
2017-04-05 03:33:20 +03:00
:_ wit(lab ~, boy ~)
=- [pif - suf]
^- chap
:- ?~(lab p.pac [~ u.lab])
2017-04-05 03:33:20 +03:00
?~(boy q.pac boy)
::
++ helk
|* {pif/@tas suf/*}
|= got/toga
2017-11-17 00:50:03 +03:00
^- (pair hoon whit)
2017-04-05 03:33:20 +03:00
=^ gef wit (tong got)
[[pif gef suf] wit]
::
2018-03-12 08:29:13 +03:00
++ himp
|* {pif/@tas suf/*}
|= het/sofa
^- (pair hoon whit)
=^ tog wit (tong p.het)
[[pif [tog q.het] suf] wit]
::
2017-04-05 03:33:20 +03:00
++ humm
|* {pif/@tas suf/*}
|= {wat/what cog/term}
2017-11-17 00:50:03 +03:00
^- (pair hoon whit)
2017-04-05 03:33:20 +03:00
=^ taw wit (grif cog wat)
[[pif [taw cog] suf] wit]
::
++ runk
2017-11-17 00:50:03 +03:00
^- (pair hoon whit)
2018-03-27 02:55:02 +03:00
:: ?~ boy flam
:: [[%docs u.boy gen] wit(boy ~)]
flam
2017-04-05 03:33:20 +03:00
::
++ tong
|= got/toga
^- {toga whit}
?@ got
=^ wat wit (grif got ~)
?~ wat [got wit]
[[%1 [wat got] [%0 ~]] wit]
?- -.got
$0 [got wit]
$1 =^ wat wit (grif q.p.got p.p.got)
=^ sub wit $(got q.got)
[[%1 [wat q.p.got] sub] wit]
$2 =^ one wit $(got p.got)
=^ two wit $(got q.got)
[[%2 one two] wit]
==
--
::
++ graf
2017-11-17 00:50:03 +03:00
:: ^- (unit hoon)
2017-04-05 03:33:20 +03:00
:: =^ nex wit ((walk whit) wit grad)
:: ?:(gray ~ `nex)
=^ nex wit ((walk whit) wit grad)
nex
--
::
2016-11-24 07:25:07 +03:00
:: not used at present; see comment at $csng in ++open
::::
::++ hail
:: |= axe/axis
2017-11-17 00:50:03 +03:00
:: =| air/(list (pair wing hoon))
2016-11-24 07:25:07 +03:00
:: |- ^+ air
:: =+ hav=half
:: ?~ hav [[[[%| 0 ~] [%& axe] ~] gen] air]
:: $(gen p.u.hav, axe (peg axe 2), air $(gen q.u.hav, axe (peg axe 3)))
::::
::++ half
2017-11-17 00:50:03 +03:00
:: |- ^- (unit (pair hoon hoon))
2016-11-24 07:25:07 +03:00
:: ?+ gen ~
:: {^ *} `[p.gen q.gen]
:: {$dbug *} $(gen q.gen)
2017-09-18 21:50:10 +03:00
:: {$clcb *} `[q.gen p.gen]
2017-09-18 20:25:05 +03:00
:: {$clhp *} `[p.gen q.gen]
2017-09-18 21:50:10 +03:00
:: {$clkt *} `[p.gen %clls q.gen r.gen s.gen]
:: {$clsg *} ?~(p.gen ~ `[i.p.gen %clsg t.p.gen])
:: {$cltr *} ?~ p.gen ~
:: ?~(t.p.gen $(gen i.p.gen) `[i.p.gen %cltr t.p.gen])
:: ==
2016-11-24 07:25:07 +03:00
::::
++ hock
|- ^- toga
?- gen
{$cnts {@ ~} ~} i.p.gen
2016-11-24 07:25:07 +03:00
{$limb @} p.gen
{$wing {@ ~}} i.p.gen
2016-11-24 07:25:07 +03:00
{$dbug *} $(gen q.gen)
{@ *} =+(neg=open ?:(=(gen neg) [%0 ~] $(gen neg)))
{^ *} =+ toe=[$(gen p.gen) $(gen q.gen)]
?:(=(toe [[%0 ~] [%0 ~]]) [%0 ~] [%2 toe])
==
::
++ open
2017-11-17 00:50:03 +03:00
^- hoon
2016-11-24 07:25:07 +03:00
?- gen
{~ *} [%cnts [[%& p.gen] ~] ~]
2016-11-24 07:25:07 +03:00
::
2018-03-29 21:03:14 +03:00
{$base *} ~(factory ax fab `spec`gen)
2018-03-14 08:56:31 +03:00
{$bust *} ~(example ax fab %base p.gen)
{$bccm *} ~(factory ax fab p.gen)
2016-11-24 07:25:07 +03:00
{$dbug *} q.gen
2017-04-05 03:33:20 +03:00
{$eror *} ~|(p.gen !!)
2016-11-24 07:25:07 +03:00
::
{$knit *} ::
2017-09-20 23:15:30 +03:00
:+ %tsgr [%ktts %v %$ 1] :: => v=.
2017-09-18 04:32:20 +03:00
:+ %brhp [~ ~] :: |-
2017-09-20 02:24:30 +03:00
:+ %ktls :: ^+
2017-09-18 04:32:20 +03:00
:+ %brhp [~ ~] :: |-
2017-09-21 00:43:14 +03:00
:^ %wtcl :: ?:
2018-03-19 06:00:25 +03:00
[%bust %flag] :: ?
2016-11-24 07:25:07 +03:00
[%bust %null] :: ~
2017-09-20 02:24:30 +03:00
:- [%ktts %i [%sand 'tD' *@]] :: :- i=~~
[%ktts %t [%limb %$]] :: t=$
2017-11-17 00:50:03 +03:00
|- ^- hoon ::
2016-11-24 07:25:07 +03:00
?~ p.gen ::
[%bust %null] :: ~
=+ res=$(p.gen t.p.gen) ::
2017-11-17 00:50:03 +03:00
^- hoon ::
2016-11-24 07:25:07 +03:00
?@ i.p.gen ::
[[%sand 'tD' i.p.gen] res] :: [~~{i.p.gen} {res}]
2017-09-20 23:15:30 +03:00
:+ %tsls ::
2017-09-20 02:24:30 +03:00
:- :+ %ktts :: ^=
2016-11-24 07:25:07 +03:00
%a :: a
2017-09-20 02:24:30 +03:00
:+ %ktls :: ^+
2016-11-24 07:25:07 +03:00
[%limb %$] :: $
2017-09-20 23:15:30 +03:00
[%tsgr [%limb %v] p.i.p.gen] :: =>(v {p.i.p.gen})
2017-09-20 02:24:30 +03:00
[%ktts %b res] :: b={res}
2017-11-17 00:50:03 +03:00
^- hoon ::
2017-09-18 04:32:20 +03:00
:+ %brhp [~ ~] :: |-
2018-03-19 05:40:38 +03:00
:^ %wtvt :: ?@
2016-11-24 07:25:07 +03:00
[%a ~] :: a
[%limb %b] :: b
2017-09-20 23:15:30 +03:00
:- [%tsgl [%$ 2] [%limb %a]] :: :- -.a
2017-09-19 03:19:22 +03:00
:+ %cnts :: %=
2016-11-24 07:25:07 +03:00
[%$ ~] :: $
2017-09-20 23:15:30 +03:00
[[[%a ~] [%tsgl [%$ 3] [%limb %a]]] ~] :: a +.a
2016-11-24 07:25:07 +03:00
::
2018-03-29 21:03:14 +03:00
{$leaf *} ~(factory ax fab `spec`gen)
2017-09-19 03:19:22 +03:00
{$limb *} [%cnts [p.gen ~] ~]
2018-03-14 06:17:30 +03:00
{$tell *} [%cncl [%limb %noah] [%zpgr [%cltr p.gen]] ~]
2017-09-19 03:19:22 +03:00
{$wing *} [%cnts p.gen ~]
2018-03-14 06:17:30 +03:00
{$yell *} [%cncl [%limb %cain] [%zpgr [%cltr p.gen]] ~]
2016-11-24 07:25:07 +03:00
::
2018-03-14 06:17:30 +03:00
{$brcb *} :+ %tsls [%bcdt q.gen]
2018-03-12 08:29:13 +03:00
:+ %brcn p.gen
%- ~(run by s.gen)
|= tom/tomb
^+ tom
:- p.tom
%- ~(run by q.tom)
|= a/(pair what foot)
^+ a
:- p.a
=- ?:(?=({$ash *} q.a) [-.q.a -] [-.q.a -])
|- ^- hoon
?~ r.gen p.q.a
[%tstr [~ p.i.r.gen] q.i.r.gen $(r.gen t.r.gen)]
2017-12-10 00:47:28 +03:00
{$brcl *} [%tsls q.gen [%brdt p.gen r.gen]]
2017-09-18 04:32:20 +03:00
{$brdt *} :+ %brcn p.gen
=- [[0 [~ ~] -] ~ ~]
(~(put by *(map term (pair what foot))) %$ ~ [%ash q.gen])
2017-09-20 23:15:30 +03:00
{$brkt *} :+ %tsgr
2017-09-18 04:32:20 +03:00
:+ %brcn p.gen
2017-04-17 01:37:40 +03:00
=+ one=(~(got by r.gen) 0)
%+ ~(put by r.gen) 0
one(q (~(put by q.one) %$ [~ [%ash q.gen]]))
[%limb %$]
2017-09-20 23:15:30 +03:00
{$brhp *} [%tsgl [%limb %$] [%brdt p.gen q.gen]]
2017-09-20 02:24:30 +03:00
{$brsg *} [%ktbr [%brts p.gen q.gen r.gen]]
2018-03-14 06:17:30 +03:00
{$brtr *} :+ %tsls [%bcdt q.gen]
2018-03-12 08:29:13 +03:00
:+ %brcn p.gen
=- [[0 [~ ~] -] ~ ~]
(~(put by *(map term (pair what foot))) %$ ~ [%elm r.gen])
2017-12-11 08:13:09 +03:00
{$brts *} :^ %brcb p.gen q.gen
=- [~ [[0 [~ ~] -] ~ ~]]
(~(put by *(map term (pair what foot))) %$ ~ [%ash r.gen])
2017-09-20 02:24:30 +03:00
{$brwt *} [%ktwt %brdt p.gen q.gen]
2016-11-24 07:25:07 +03:00
::
2017-09-18 21:50:10 +03:00
{$clkt *} [p.gen q.gen r.gen s.gen]
{$clls *} [p.gen q.gen r.gen]
{$clcb *} [q.gen p.gen]
2017-09-18 20:25:05 +03:00
{$clhp *} [p.gen q.gen]
2017-09-18 21:50:10 +03:00
{$clsg *}
2017-11-17 00:50:03 +03:00
|- ^- hoon
2016-11-24 07:25:07 +03:00
?~ p.gen
[%rock %n ~]
[i.p.gen $(p.gen t.p.gen)]
::
2017-09-18 21:50:10 +03:00
{$cltr *}
2017-11-17 00:50:03 +03:00
|- ^- hoon
2016-11-24 07:25:07 +03:00
?~ p.gen
2017-09-21 03:54:04 +03:00
[%zpzp ~]
2016-11-24 07:25:07 +03:00
?~ t.p.gen
i.p.gen
[i.p.gen $(p.gen t.p.gen)]
::
2018-03-14 08:56:31 +03:00
{$bcdt *} [%ktsg ~(example ax fab p.gen)]
2017-09-20 02:24:30 +03:00
{$cncb *} [%ktls [%wing p.gen] %cnts p.gen q.gen]
2018-03-14 06:17:30 +03:00
{$cndt *} [%cncl q.gen [p.gen ~]]
{$cnkt *} [%cncl p.gen q.gen r.gen s.gen ~]
{$cnls *} [%cncl p.gen q.gen r.gen ~]
{$cnhp *} [%cncl p.gen q.gen ~]
2018-03-14 08:56:31 +03:00
:: this probably should work, but doesn't
::
:: {$cncl *} [%cntr [%$ ~] p.gen [[[[%& 6] ~] [%cltr q.gen]] ~]]
2018-03-14 06:17:30 +03:00
{$cncl *} [%cnsg [%$ ~] p.gen q.gen]
2018-03-14 08:56:31 +03:00
{$cnsg *}
:: this complex matching system is a leftover from the old
:: "electroplating" era. %cnsg should be removed and replaced
:: with the commented-out %cncl above. but something is broken.
2016-11-24 07:25:07 +03:00
::
2018-03-14 08:56:31 +03:00
:^ %cntr p.gen q.gen
2016-11-24 07:25:07 +03:00
=+ axe=6
2017-11-17 00:50:03 +03:00
|- ^- (list {wing hoon})
2016-11-24 07:25:07 +03:00
?~ r.gen ~
?~ t.r.gen [[[[%| 0 ~] [%& axe] ~] i.r.gen] ~]
:- [[[%| 0 ~] [%& (peg axe 2)] ~] i.r.gen]
$(axe (peg axe 3), r.gen t.r.gen)
::
2017-09-18 22:37:25 +03:00
{$cntr *}
2016-11-24 07:25:07 +03:00
?: =(~ r.gen)
2017-09-20 23:15:30 +03:00
[%tsgr q.gen [%wing p.gen]]
:+ %tsls
2016-11-24 07:25:07 +03:00
q.gen
2017-09-19 03:19:22 +03:00
:+ %cnts
2016-11-24 07:25:07 +03:00
(weld p.gen `wing`[[%& 2] ~])
2017-11-17 00:50:03 +03:00
(turn r.gen |=({p/wing q/hoon} [p [%tsgr [%$ 3] q]]))
2016-11-24 07:25:07 +03:00
::
2018-03-14 06:17:30 +03:00
{$ktdt *} [%ktls [%cncl p.gen q.gen ~] q.gen]
2018-03-14 08:56:31 +03:00
{$kthp *} [%ktls ~(example ax fab p.gen) q.gen]
2017-09-20 09:13:11 +03:00
{$sgbr *}
:+ %sggr
2016-11-24 07:25:07 +03:00
:- %mean
=+ fek=~(feck ap p.gen)
?^ fek [%rock %tas u.fek]
2018-03-14 06:17:30 +03:00
[%brdt [~ ~] [%cncl [%limb %cain] [%zpgr [%tsgr [%$ 3] p.gen]] ~]]
2016-11-24 07:25:07 +03:00
q.gen
::
2017-09-20 09:13:11 +03:00
{$sgcb *} [%sggr [%mean [%brdt [~ ~] p.gen]] q.gen]
{$sgcn *}
:+ %sggl
2017-09-20 20:18:59 +03:00
:- %fast
2017-09-18 21:50:10 +03:00
:- %clls
2016-11-24 07:25:07 +03:00
:+ [%rock %$ p.gen]
2017-09-21 02:12:03 +03:00
[%zpts q.gen]
2017-09-18 21:50:10 +03:00
:- %clsg
2017-11-17 00:50:03 +03:00
=+ nob=`(list hoon)`~
|- ^- (list hoon)
2016-11-24 07:25:07 +03:00
?~ r.gen
nob
2017-09-21 02:12:03 +03:00
[[[%rock %$ p.i.r.gen] [%zpts q.i.r.gen]] $(r.gen t.r.gen)]
2016-11-24 07:25:07 +03:00
s.gen
::
2018-03-14 06:17:30 +03:00
{$sgnt *} [%sgcn p.gen [%$ 7] ~ q.gen]
2017-09-20 23:15:30 +03:00
{$sggl *} [%tsgl [%sggr p.gen [%$ 1]] q.gen]
2017-09-20 09:13:11 +03:00
{$sgbc *} [%sggr [%live [%rock %$ p.gen]] q.gen]
{$sgls *} [%sggr [%memo %rock %$ p.gen] q.gen]
2018-03-20 05:42:13 +03:00
{$sgpd *}
:+ %sggr
[%slog [%sand %$ p.gen] [%cncl [%limb %cain] [%zpgr q.gen] ~]]
r.gen
2016-11-24 07:25:07 +03:00
::
2017-09-20 09:13:11 +03:00
{$sgts *} [%sggr [%germ p.gen] q.gen]
{$sgwt *}
2017-09-21 00:13:10 +03:00
:+ %tsls [%wtdt q.gen [%bust %null] [[%bust %null] r.gen]]
:^ %wtsg [%& 2]~
2017-09-20 23:15:30 +03:00
[%tsgr [%$ 3] s.gen]
2018-03-20 05:42:13 +03:00
[%sgpd p.gen [%$ 5] [%tsgr [%$ 3] s.gen]]
::
2018-03-14 06:17:30 +03:00
{$mcts *}
|-
?~ p.gen [%bust %null]
?- -.i.p.gen
2017-09-20 20:36:34 +03:00
^ [[%xray i.p.gen] $(p.gen t.p.gen)]
$manx [p.i.p.gen $(p.gen t.p.gen)]
2018-03-14 06:17:30 +03:00
$tape [[%mcnt p.i.p.gen] $(p.gen t.p.gen)]
$call [%cncl p.i.p.gen [$(p.gen t.p.gen)]~]
2017-09-19 03:55:32 +03:00
$marl =- [%cndt [p.i.p.gen $(p.gen t.p.gen)] -]
2017-11-17 00:50:03 +03:00
^- hoon
2017-09-20 23:15:30 +03:00
:+ %tsbr [%base %cell]
2017-09-18 04:32:20 +03:00
:+ %brcn *chap
^- (map @ tomb)
=- [[0 [~ ~] -] ~ ~]
^- (map term (pair what foot))
:_ [~ ~]
=+ sug=[[%& 12] ~]
:^ %$ ~ %elm
2017-09-21 00:13:10 +03:00
:^ %wtsg sug
2017-09-19 03:19:22 +03:00
[%cnts sug [[[[%& 1] ~] [%$ 13]] ~]]
[%cnts sug [[[[%& 3] ~] [%cnts [%$ ~] [[sug [%$ 25]] ~]]] ~]]
==
2016-11-24 07:25:07 +03:00
::
2018-03-14 06:17:30 +03:00
{$mccl *}
2016-11-24 07:25:07 +03:00
?- q.gen
~ [%zpzp ~]
{* ~} i.q.gen
2016-11-24 07:25:07 +03:00
^
2017-09-20 23:15:30 +03:00
:+ %tsls
2016-11-24 07:25:07 +03:00
p.gen
2017-11-17 00:50:03 +03:00
=+ yex=`(list hoon)`q.gen
|- ^- hoon
2016-11-24 07:25:07 +03:00
?- yex
{* ~} [%tsgr [%$ 3] i.yex]
2018-03-14 06:17:30 +03:00
{* ^} [%cncl [%$ 2] [%tsgr [%$ 3] i.yex] $(yex t.yex) ~]
~ !!
2016-11-24 07:25:07 +03:00
==
==
::
2018-03-14 06:17:30 +03:00
{$mcnt *} =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~])
{$mcsg *} :: ;~
2017-11-17 00:50:03 +03:00
|- ^- hoon
2016-11-24 07:25:07 +03:00
?- q.gen
2018-03-14 06:17:30 +03:00
~ ~_(leaf+"open-mcsg" !!)
2016-11-24 07:25:07 +03:00
^
2017-11-09 22:03:39 +03:00
:+ %tsgr [%ktts %v %$ 1] :: => v=.
2017-11-17 00:50:03 +03:00
|- ^- hoon ::
?: ?=(~ t.q.gen) ::
2017-11-09 22:03:39 +03:00
[%tsgr [%limb %v] i.q.gen] :: =>(v {i.q.gen})
:+ %tsls [%ktts %a $(q.gen t.q.gen)] :: =+ ^= a
:+ %tsls :: {$(q.gen t.q.gen)}
[%ktts %b [%tsgr [%limb %v] i.q.gen]] :: =+ ^= b
:+ %tsls :: =>(v {i.q.gen})
2017-09-20 02:24:30 +03:00
:+ %ktts %c :: =+ c=,.+6.b
2017-11-09 22:03:39 +03:00
:+ %tsgl ::
2016-11-24 07:25:07 +03:00
[%wing [%| 0 ~] [%& 6] ~] ::
[%limb %b] ::
2017-09-18 04:32:20 +03:00
:+ %brdt [~ ~] :: |.
2017-09-19 03:55:32 +03:00
:^ %cnls :: %+
2017-11-09 22:03:39 +03:00
[%tsgr [%limb %v] p.gen] :: =>(v {p.gen})
2018-03-14 06:17:30 +03:00
[%cncl [%limb %b] [%limb %c] ~] :: (b c)
2017-09-19 03:19:22 +03:00
:+ %cnts [%a ~] :: a(,.+6 c)
2016-11-24 07:25:07 +03:00
[[[[%| 0 ~] [%& 6] ~] [%limb %c]] ~] ::
== ::
::
2018-03-14 06:17:30 +03:00
{$mcmc *} :: ;;
2017-11-09 22:03:39 +03:00
:+ %tsgr [%ktts %v %$ 1] :: => v=.
:+ %tsls :+ %ktts %a :: =+ ^= a
[%tsgr [%limb %v] p.gen] :: =>(v {p.gen})
:+ %tsls [%ktts %b [%tsgr [%limb %v] q.gen]] :: =+ b==>(v {q.gen})
:+ %tsls :: =+ c=(a b)
2018-03-14 06:17:30 +03:00
[%ktts %c [%cncl [%limb %a] [%limb %b] ~]] ::
2017-09-21 00:13:10 +03:00
:+ %wtgr :: ?>(=(`*`c `*`b) c)
2017-09-19 23:37:15 +03:00
:+ %dtts ::
2017-09-20 02:24:30 +03:00
[%kthp [%base %noun] [%limb %c]] ::
[%kthp [%base %noun] [%limb %b]] ::
2017-03-21 19:44:13 +03:00
[%limb %c] ::
2016-11-24 07:25:07 +03:00
::
2017-09-20 23:15:30 +03:00
{$tsbr *}
2018-03-14 08:56:31 +03:00
[%tsls ~(example ax fab p.gen) q.gen]
2016-11-24 07:25:07 +03:00
::
2017-09-20 23:15:30 +03:00
{$tscl *}
[%tsgr [%cncb [[%& 1] ~] p.gen] q.gen]
2016-11-24 07:25:07 +03:00
::
2018-03-14 06:17:30 +03:00
{$tsnt *}
2017-04-17 01:37:40 +03:00
?~ q.p.gen
2017-09-20 23:15:30 +03:00
[%tsls [%ktts p.p.gen q.gen] r.gen]
2018-03-13 08:56:27 +03:00
[%tsls [%kthp [%bcts p.p.gen u.q.p.gen] q.gen] r.gen]
2016-11-24 07:25:07 +03:00
::
2018-03-14 06:17:30 +03:00
{$tsmc *} [%tsnt p.gen r.gen q.gen]
2017-09-20 23:15:30 +03:00
{$tsdt *}
[%tsgr [%cncb [[%& 1] ~] [[p.gen q.gen] ~]] r.gen]
{$tswt *} :: =?
2017-09-21 00:43:14 +03:00
[%tsdt p.gen [%wtcl q.gen r.gen [%wing p.gen]] s.gen]
2018-03-12 08:29:13 +03:00
::
2018-03-13 04:20:48 +03:00
{$tskt *} :: =^
2018-03-12 08:29:13 +03:00
=+ wuy=(weld q.gen `wing`[%v ~]) ::
:+ %tsgr [%ktts %v %$ 1] :: => v=.
:+ %tsls [%ktts %a %tsgr [%limb %v] r.gen] :: =+ a==>(v \r.gen)
:^ %tsdt wuy [%tsgl [%$ 3] [%limb %a]]
:+ %tsgr :- ?~ q.p.gen
:+ %ktts p.p.gen
[%tsgl [%$ 2] [%limb %a]]
2018-03-13 08:56:27 +03:00
:+ %kthp
2018-03-12 08:29:13 +03:00
:+ %bcts p.p.gen
2018-03-14 08:56:31 +03:00
[%over [%| 0 `%v]~ u.q.p.gen]
2018-03-12 08:29:13 +03:00
[%tsgl [%$ 2] [%limb %a]]
[%limb %v]
s.gen
2016-11-24 07:25:07 +03:00
::
2017-09-20 23:15:30 +03:00
{$tsgl *} [%tsgr q.gen p.gen]
{$tsls *} [%tsgr [p.gen [%$ 1]] q.gen]
{$tshp *} [%tsls q.gen p.gen]
{$tssg *}
2017-11-17 00:50:03 +03:00
|- ^- hoon
2016-11-24 07:25:07 +03:00
?~ p.gen [%$ 1]
?~ t.p.gen i.p.gen
2017-09-20 23:15:30 +03:00
[%tsgr i.p.gen $(p.gen t.p.gen)]
2016-11-24 07:25:07 +03:00
::
2017-09-21 00:13:10 +03:00
{$wtbr *}
2016-11-24 07:25:07 +03:00
|-
2017-09-21 00:43:14 +03:00
?~(p.gen [%rock %f 1] [%wtcl i.p.gen [%rock %f 0] $(p.gen t.p.gen)])
2016-11-24 07:25:07 +03:00
::
2017-09-21 00:43:14 +03:00
{$wtdt *} [%wtcl p.gen r.gen q.gen]
2017-09-21 03:54:04 +03:00
{$wtgl *} [%wtcl p.gen [%zpzp ~] q.gen]
{$wtgr *} [%wtcl p.gen q.gen [%zpzp ~]]
2017-09-21 00:43:14 +03:00
{$wtkt *} [%wtcl [%wtts [%base %atom %$] p.gen] r.gen q.gen]
2016-11-24 07:25:07 +03:00
::
2017-09-21 00:13:10 +03:00
{$wthp *}
2016-11-24 07:25:07 +03:00
|-
?~ q.gen
[%lost [%wing p.gen]]
2017-09-21 00:43:14 +03:00
:^ %wtcl
2017-09-21 00:13:10 +03:00
[%wtts p.i.q.gen p.gen]
2016-11-24 07:25:07 +03:00
q.i.q.gen
$(q.gen t.q.gen)
::
2017-09-21 00:13:10 +03:00
{$wtls *}
[%wthp p.gen (weld r.gen `_r.gen`[[[%base %noun] q.gen] ~])]
2018-03-20 05:42:13 +03:00
::
{$wtpd *}
|-
?~(p.gen [%rock %f 0] [%wtcl i.p.gen $(p.gen t.p.gen) [%rock %f 1]])
2017-12-04 23:07:41 +03:00
::
{$xray *}
|^ :- [(open-mane n.g.p.gen) %clsg (turn a.g.p.gen open-mart)]
2018-03-14 06:17:30 +03:00
[%mcts c.p.gen]
2017-12-04 23:07:41 +03:00
::
++ open-mane
|= a/mane:hoon
?@(a [%rock %tas a] [[%rock %tas -.a] [%rock %tas +.a]])
::
++ open-mart
|= {n/mane:hoon v/(list beer:hoon)}
[(open-mane n) %knit v]
--
2016-11-24 07:25:07 +03:00
::
2018-03-19 05:40:38 +03:00
{$wtvt *} [%wtcl [%wtts [%base %atom %$] p.gen] q.gen r.gen]
2017-09-21 00:43:14 +03:00
{$wtsg *} [%wtcl [%wtts [%base %null] p.gen] q.gen r.gen]
2018-03-14 08:56:31 +03:00
{$wtts *} [%fits ~(example ax fab p.gen) q.gen]
2017-09-21 00:43:14 +03:00
{$wtzp *} [%wtcl p.gen [%rock %f 1] [%rock %f 0]]
2017-09-21 02:12:03 +03:00
{$zpgr *}
2018-03-14 07:36:10 +03:00
[%cncl [%limb %onan] [%zpmc [%bcdt [%bcmc %limb %abel]] p.gen] ~]
2016-11-24 07:25:07 +03:00
::
2017-09-21 02:12:03 +03:00
{$zpwt *}
2016-11-24 07:25:07 +03:00
?: ?: ?=(@ p.gen)
2017-10-31 21:07:42 +03:00
(lte hoon-version p.gen)
&((lte hoon-version p.p.gen) (gte hoon-version q.p.gen))
2016-11-24 07:25:07 +03:00
q.gen
~_(leaf+"hoon-version" !!)
::
* gen
==
::
2017-11-17 00:50:03 +03:00
++ rake ~>(%mean.[%leaf "rake-hoon"] (need reek))
2016-11-24 07:25:07 +03:00
++ reek
^- (unit wing)
?+ gen ~
{~ *} `[[%& p.gen] ~]
2016-11-24 07:25:07 +03:00
{$limb *} `[p.gen ~]
{$wing *} `p.gen
{$cnts * ~} `p.gen
2016-11-24 07:25:07 +03:00
{$dbug *} reek(gen q.gen)
==
++ rusk
^- term
=+ wig=rake
?. ?=({@ ~} wig)
2017-11-17 00:50:03 +03:00
~>(%mean.[%leaf "rusk-hoon"] !!)
2016-11-24 07:25:07 +03:00
i.wig
2017-04-17 01:37:40 +03:00
::
++ walk :: forward traverse
|* life/mold
2017-12-15 01:53:04 +03:00
|: =< $
$: vit/life
2017-04-05 03:33:20 +03:00
$= mac
2017-12-15 01:53:04 +03:00
$_ ^|
|: =< $
$: hoon
2017-04-05 03:33:20 +03:00
life
2017-12-15 01:53:04 +03:00
_^|(|:($:{? hoon life} $:{hoon life}))
2017-04-05 03:33:20 +03:00
==
2017-12-15 01:53:04 +03:00
=< $
2017-11-17 00:50:03 +03:00
(unit (pair hoon life))
2017-04-17 01:37:40 +03:00
==
2017-11-17 00:50:03 +03:00
^- {hoon life}
2017-04-05 03:33:20 +03:00
=/ use &
=< apex
|%
++ apex
2017-11-17 00:50:03 +03:00
|- ^- {hoon life}
2017-12-15 01:53:04 +03:00
=* aid |: $:{use/? gen/hoon vit/life}
2017-04-05 03:33:20 +03:00
^$(use use, gen gen, vit vit)
=/ gun ?:(use (mac gen vit aid) ~)
?^ gun u.gun
?: ?=(^ -.gen)
%.(gen dubs)
?- -.gen
$$ (lead -.gen %.(+.gen noop))
$base (lead -.gen %.(+.gen noop))
2018-03-14 06:17:30 +03:00
$bcdt (lead -.gen %.(+.gen stir))
2018-03-14 07:36:10 +03:00
$bccm (lead -.gen %.(+.gen stir))
2017-04-05 03:33:20 +03:00
$bust (lead -.gen %.(+.gen noop))
$dbug (lead -.gen %.(+.gen nexp))
$hand (lead -.gen %.(+.gen noop))
$knit (lead -.gen %.(+.gen (moto bark)))
$leaf (lead -.gen %.(+.gen noop))
$limb (lead -.gen %.(+.gen noop))
$lost (lead -.gen %.(+.gen expr))
$rock (lead -.gen %.(+.gen noop))
$sand (lead -.gen %.(+.gen noop))
$tell (lead -.gen %.(+.gen moar))
$tune (lead -.gen %.(+.gen tung))
$wing (lead -.gen %.(+.gen noop))
$yell (lead -.gen %.(+.gen moar))
2018-03-13 04:20:48 +03:00
$brcb (lead -.gen %.(+.gen (quad noop stir exps arms)))
2017-09-18 04:32:20 +03:00
$brcl (lead -.gen %.(+.gen (twin noop dubs)))
$brcn (lead -.gen %.(+.gen (twin noop arms)))
$brdt (lead -.gen %.(+.gen (twin noop expr)))
$brkt (lead -.gen %.(+.gen (trio noop expr arms)))
$brhp (lead -.gen %.(+.gen (twin noop expr)))
2018-03-13 04:20:48 +03:00
$brsg (lead -.gen %.(+.gen (trio noop stir expr)))
$brtr (lead -.gen %.(+.gen (trio noop stir expr)))
$brts (lead -.gen %.(+.gen (trio noop stir expr)))
2017-09-18 04:32:20 +03:00
$brwt (lead -.gen %.(+.gen (twin noop expr)))
2017-09-18 21:50:10 +03:00
$clcb (lead -.gen %.(+.gen dubs))
$clkt (lead -.gen %.(+.gen (quad expr expr expr expr)))
2017-09-18 20:25:05 +03:00
$clhp (lead -.gen %.(+.gen dubs))
2017-09-18 21:50:10 +03:00
$clls (lead -.gen %.(+.gen trey))
$clsg (lead -.gen %.(+.gen moar))
$cltr (lead -.gen %.(+.gen moar))
2017-09-19 03:55:32 +03:00
$cncb (lead -.gen %.(+.gen (twin noop moan)))
$cndt (lead -.gen %.(+.gen dubs))
2018-03-14 06:17:30 +03:00
$cnhp (lead -.gen %.(+.gen dubs))
$cncl (lead -.gen %.(+.gen (twin expr moar)))
2017-09-18 22:37:25 +03:00
$cntr (lead -.gen %.(+.gen (trio noop expr moan)))
2017-09-19 03:55:32 +03:00
$cnkt (lead -.gen %.(+.gen (quad expr expr expr expr)))
$cnls (lead -.gen %.(+.gen trey))
2017-09-19 01:32:35 +03:00
$cnsg (lead -.gen %.(+.gen (trio noop expr moar)))
2017-09-19 03:19:22 +03:00
$cnts (lead -.gen %.(+.gen (twin noop moan)))
2018-03-13 04:20:48 +03:00
$dtkt (lead -.gen %.(+.gen (twin stir expr)))
2017-09-19 23:37:15 +03:00
$dtls (lead -.gen %.(+.gen expr))
$dttr (lead -.gen %.(+.gen dubs))
$dtts (lead -.gen %.(+.gen dubs))
$dtwt (lead -.gen %.(+.gen expr))
2017-09-20 02:24:30 +03:00
$ktbr (lead -.gen %.(+.gen expr))
2017-12-11 06:43:32 +03:00
$ktcn (lead -.gen %.(+.gen expr))
2017-09-20 02:24:30 +03:00
$ktdt (lead -.gen %.(+.gen dubs))
$ktls (lead -.gen %.(+.gen dubs))
2018-03-13 08:56:27 +03:00
$kthp (lead -.gen %.(+.gen (twin stir expr)))
2018-03-14 06:17:30 +03:00
$ktpd (lead -.gen %.(+.gen expr))
2017-09-20 02:24:30 +03:00
$ktsg (lead -.gen %.(+.gen expr))
$ktts (lead -.gen %.(+.gen nexp))
$ktwt (lead -.gen %.(+.gen expr))
2017-09-20 09:13:11 +03:00
$sgbr (lead -.gen %.(+.gen dubs))
$sgcb (lead -.gen %.(+.gen dubs))
2017-04-05 03:33:20 +03:00
$crap (lead -.gen %.(+.gen (raid expr)))
2017-09-20 09:13:11 +03:00
$sgcn (lead -.gen %.(+.gen (quad noop expr moan expr)))
2018-03-14 06:17:30 +03:00
$sgnt (lead -.gen %.(+.gen nexp))
2017-09-20 09:13:11 +03:00
$sggl (lead -.gen %.(+.gen (twin toad expr)))
$sggr (lead -.gen %.(+.gen (twin toad expr)))
$sgbc (lead -.gen %.(+.gen nexp))
$sgls (lead -.gen %.(+.gen nexp))
2018-03-20 05:42:13 +03:00
$sgpd (lead -.gen %.(+.gen trip))
2017-09-20 09:13:11 +03:00
$sgts (lead -.gen %.(+.gen dubs))
$sgwt (lead -.gen %.(+.gen (quad noop expr expr expr)))
$sgzp (lead -.gen %.(+.gen dubs))
2018-03-14 06:17:30 +03:00
$mccl (lead -.gen %.(+.gen (twin expr moar)))
$mcnt (lead -.gen %.(+.gen expr))
$mcsg (lead -.gen %.(+.gen (twin expr moar)))
$mcmc (lead -.gen %.(+.gen dubs))
2018-03-13 04:20:48 +03:00
$tsbr (lead -.gen %.(+.gen (twin stir expr)))
2018-03-12 08:29:13 +03:00
$tscl (lead -.gen %.(+.gen (twin moan expr)))
2018-03-14 06:17:30 +03:00
$tsnt (lead -.gen %.(+.gen (trio torp expr expr)))
$tsmc (lead -.gen %.(+.gen (trio torp expr expr)))
2018-03-12 08:29:13 +03:00
$tsdt (lead -.gen %.(+.gen trip))
$tswt (lead -.gen %.(+.gen (quad noop expr expr expr)))
$tsgl (lead -.gen %.(+.gen dubs))
$tshp (lead -.gen %.(+.gen dubs))
$tsgr (lead -.gen %.(+.gen dubs))
2018-03-13 04:20:48 +03:00
$tskt (lead -.gen %.(+.gen (quad torp noop expr expr)))
2018-03-12 08:29:13 +03:00
$tsls (lead -.gen %.(+.gen dubs))
$tssg (lead -.gen %.(+.gen moar))
$tstr (lead -.gen %.(+.gen trip))
$tscm (lead -.gen %.(+.gen dubs))
$wtbr (lead -.gen %.(+.gen moar))
$wthp (lead -.gen %.(+.gen (twin noop (moto (twin stir expr)))))
2018-03-12 08:29:13 +03:00
$wtcl (lead -.gen %.(+.gen trey))
2017-09-21 00:13:10 +03:00
$wtdt (lead -.gen %.(+.gen trey))
$wtkt (lead -.gen %.(+.gen trip))
$wtgl (lead -.gen %.(+.gen dubs))
$wtgr (lead -.gen %.(+.gen dubs))
$wtls (lead -.gen %.(+.gen (trio noop expr (moto (twin stir expr)))))
2018-03-20 05:42:13 +03:00
$wtpd (lead -.gen %.(+.gen moar))
2018-03-19 05:40:38 +03:00
$wtvt (lead -.gen %.(+.gen trip))
2017-09-21 00:13:10 +03:00
$wtsg (lead -.gen %.(+.gen trip))
$wtts (lead -.gen %.(+.gen (twin stir noop)))
2018-03-12 08:29:13 +03:00
$wtzp (lead -.gen %.(+.gen expr))
2017-09-21 02:12:03 +03:00
$zpcm (lead -.gen %.(+.gen dubs))
$zpgr (lead -.gen %.(+.gen expr))
2018-03-14 06:17:30 +03:00
$zpmc (lead -.gen %.(+.gen dubs))
2017-09-21 02:12:03 +03:00
$zpts (lead -.gen %.(+.gen expr))
$zpwt (lead -.gen %.(+.gen nexp))
2017-09-21 03:54:04 +03:00
$zpzp (lead -.gen %.(+.gen noop))
2017-04-05 03:33:20 +03:00
==
++ arms
(raid (twin noop (raid (twin noop heel))))
::
++ bark
|= wof/woof
?-(wof @ [wof vit], ^ (lead ~ (expr p.wof)))
::
++ dubs
(twin expr expr)
::
++ expr
2017-11-17 00:50:03 +03:00
|= p/hoon
2017-04-05 03:33:20 +03:00
^$(gen p)
::
2017-10-04 05:37:10 +03:00
++ exps
2017-12-02 06:02:46 +03:00
|= p/(list (pair term hoon))
=| out/(list (pair term hoon))
2017-10-04 05:37:10 +03:00
|- ^+ [out vit]
?~ p
[out vit]
=^ nex vit ^^$(gen q.i.p)
$(p t.p, out [[p.i.p nex] out])
::
2017-04-05 03:33:20 +03:00
++ heel
|= bud/foot
?- -.bud
$ash =^(nex vit ^$(gen p.bud) [[%ash nex] vit])
$elm =^(nex vit ^$(gen p.bud) [[%elm nex] vit])
==
::
++ lead
2017-12-15 01:53:04 +03:00
=+ [sem=@tas out=[** $:life]]
|% +- $
[[sem -.out] +.out]
--
2017-04-05 03:33:20 +03:00
::
++ moan
(moto nexp)
::
++ moar
(moto expr)
::
++ moto
2017-12-15 01:53:04 +03:00
=+ =< $
$: etc/_^|(|:(** $:{* life}))
==
|% +- $
|* bud/*
^+ [bud vit]
?: =(~ bud) [bud vit]
=^ heb vit (etc -.bud)
=^ mor vit $(bud +.bud)
[[heb mor] vit]
--
2017-04-05 03:33:20 +03:00
::
++ nexp
(twin noop expr)
::
++ noop
|* bud/*
[bud vit]
::
2018-03-12 07:16:36 +03:00
++ stir
2018-03-29 21:03:14 +03:00
|= p/spec
2018-03-12 07:16:36 +03:00
[p vit]
::
2017-04-05 03:33:20 +03:00
++ quad
2017-12-15 01:53:04 +03:00
=+ =< $
$: one/_^|(|:(** $:{* life}))
two/_^|(|:(** $:{* life}))
tri/_^|(|:(** $:{* life}))
qua/_^|(|:(** $:{* life}))
2017-04-05 03:33:20 +03:00
==
2017-12-15 01:53:04 +03:00
|% +- $
|* bud/*
=^ yal vit (one -.bud)
=^ ves vit (two +<.bud)
=^ jot vit (tri +>-.bud)
=^ wip vit (qua +>+.bud)
[[yal ves jot wip] vit]
--
2017-04-05 03:33:20 +03:00
::
++ raid
2017-12-15 01:53:04 +03:00
=+ =< $
$: etc/_^|(|:(** $:{* life}))
==
|% +- $
|* bud/*
^+ [bud vit]
?: =(~ bud) [bud vit]
=^ lef vit $(bud +<.bud)
=^ ryt vit $(bud +>.bud)
=^ top vit (etc ->.bud)
[[[-<.bud top] lef ryt] vit]
--
2017-04-05 03:33:20 +03:00
::
++ trey
(trio expr expr expr)
::
++ trio
2017-12-15 01:53:04 +03:00
=+ =< $
$: one/_^|(|:(** $:{* life}))
two/_^|(|:(** $:{* life}))
tri/_^|(|:(** $:{* life}))
2017-04-05 03:33:20 +03:00
==
2017-12-15 01:53:04 +03:00
|% +- $
|* bud/*
=^ yal vit (one -.bud)
=^ ves vit (two +<.bud)
=^ jot vit (tri +>.bud)
[[yal ves jot] vit]
--
2017-04-05 03:33:20 +03:00
::
++ trip
(trio noop expr expr)
::
++ toad
2017-11-17 00:50:03 +03:00
|= bud/$@(term {p/term q/hoon})
2017-04-05 03:33:20 +03:00
?@ bud [bud vit]
(lead p.bud (expr q.bud))
::
++ tora
(twin noop twee)
::
2018-03-12 08:29:13 +03:00
++ torp
(twin noop twef)
::
2017-04-05 03:33:20 +03:00
++ tung
|= bud/{p/what q/$@(term tune)}
?@ q.bud [bud vit]
(lead p.bud %.(q.bud (twin (raid (twin noop twee)) (moto expr))))
::
++ twee
2017-11-17 00:50:03 +03:00
|= bud/(unit hoon)
2017-04-05 03:33:20 +03:00
?~ bud [~ vit]
(lead ~ (expr u.bud))
::
2018-03-12 08:29:13 +03:00
++ twef
2018-03-29 21:03:14 +03:00
|= bud/(unit spec)
2018-03-12 08:29:13 +03:00
?~ bud [~ vit]
(lead ~ (stir u.bud))
::
2017-04-05 03:33:20 +03:00
++ twin
2017-12-15 01:53:04 +03:00
=+ =< $
$: one/_^|(|:(** $:{* life}))
two/_^|(|:(** $:{* life}))
==
|% +- $
|* bud/*
=^ yal vit (one -.bud)
=^ ves vit (two +.bud)
[[yal ves] vit]
--
2017-04-05 03:33:20 +03:00
--
2016-11-24 07:25:07 +03:00
--
::
:::: 5c: compiler backend and prettyprinter
::
++ ut
~% %ut
+>+
==
%fan fan
%rib rib
%vet vet
%fab fab
2017-11-22 06:55:32 +03:00
%blow blow
%burp burp
2016-11-24 07:25:07 +03:00
%burn burn
%busk busk
%buss buss
%crop crop
%duck duck
%dune dune
%dunk dunk
%epla epla
%emin emin
%emul emul
2018-03-27 02:55:02 +03:00
%feel feel
2016-11-24 07:25:07 +03:00
%felt felt
%fine fine
%fire fire
%fish fish
%fond fond
%fund fund
%funk funk
%fuse fuse
%gain gain
%lose lose
2018-02-19 04:52:25 +03:00
%mile mile
%mine mine
2016-11-24 07:25:07 +03:00
%mint mint
%moot moot
%mull mull
%nest nest
%peel peel
%play play
%peek peek
%repo repo
%rest rest
%tack tack
%toss toss
%wrap wrap
2016-11-24 07:25:07 +03:00
==
2017-11-17 00:50:03 +03:00
=+ :* fan=*(set {type hoon})
rib=*(set {type type hoon})
2016-11-24 07:25:07 +03:00
vet=`?`&
fab=`?`&
==
2017-11-16 23:44:27 +03:00
=+ sut=`type`%noun
2016-11-24 07:25:07 +03:00
|%
2018-03-04 05:54:15 +03:00
++ bleu
2017-11-22 06:55:32 +03:00
|= {gol/type gen/hoon}
^- {type nock}
=+ pro=(mint gol gen)
2018-03-04 05:54:15 +03:00
=+ jon=(apex:musk bran q.pro)
?: |(?=(~ jon) ?=($wait -.u.jon))
2018-03-05 02:08:12 +03:00
?: &(!fab vet)
~& %bleu-fail
!!
[p.pro q.pro]
2018-03-04 05:54:15 +03:00
[p.pro %1 p.u.jon]
::
++ blow
|= {gol/type gen/hoon}
^- {type nock}
=+ pro=(mint gol gen)
=+ jon=(apex:musk bran q.pro)
?: |(?=(~ jon) ?=($wait -.u.jon))
[p.pro q.pro]
2017-12-12 05:05:48 +03:00
[p.pro %1 p.u.jon]
2017-11-22 06:55:32 +03:00
::
2016-11-24 07:25:07 +03:00
++ burn
2017-11-16 23:44:27 +03:00
=+ gil=*(set type)
2016-11-24 07:25:07 +03:00
|- ^- (unit)
?- sut
{$atom *} q.sut
{$cell *} %+ biff $(sut p.sut)
2017-12-10 05:44:54 +03:00
|=(a/* (biff ^$(sut q.sut) |=(b/* `[a b])))
{$core *} (biff $(sut p.sut) |=(* `[p.s.q.sut +<]))
2016-11-24 07:25:07 +03:00
{$face *} $(sut repo)
2017-12-07 19:48:06 +03:00
{$fork *} ~
2018-03-27 02:55:02 +03:00
{$form *} $(sut repo)
2016-11-24 07:25:07 +03:00
{$hold *} ?: (~(has in gil) sut)
~
$(sut repo, gil (~(put in gil) sut))
$noun ~
$void ~
==
2017-11-22 06:55:32 +03:00
++ bran
2018-03-04 05:54:15 +03:00
~+
2017-11-22 06:55:32 +03:00
=+ gil=*(set type)
|- ^- seminoun:musk
?- sut
2018-02-16 02:53:32 +03:00
$noun [full/[~ ~ ~] ~]
$void [full/[~ ~ ~] ~]
{$atom *} ?~(q.sut [full/[~ ~ ~] ~] [full/~ u.q.sut])
2017-11-22 06:55:32 +03:00
{$cell *} (combine:musk $(sut p.sut) $(sut q.sut))
2018-02-16 02:53:32 +03:00
{$core *} %+ combine:musk
2018-02-20 04:27:23 +03:00
p.s.q.sut
2017-11-23 03:03:15 +03:00
$(sut p.sut)
2017-11-22 06:55:32 +03:00
{$face *} $(sut repo)
2018-02-16 02:53:32 +03:00
{$fork *} [full/[~ ~ ~] ~]
2018-03-27 02:55:02 +03:00
{$form *} $(sut repo)
2017-11-22 06:55:32 +03:00
{$hold *} ?: (~(has in gil) sut)
2018-02-16 02:53:32 +03:00
[full/[~ ~ ~] ~]
2017-11-22 06:55:32 +03:00
$(sut repo, gil (~(put in gil) sut))
2016-11-24 07:25:07 +03:00
==
::
++ burp
:: expel undigested seminouns
::
^- type
~+
~= sut
?+ sut sut
[%cell *] [%cell burp(sut p.sut) burp(sut q.sut)]
[%core *] :+ %core
burp(sut p.sut)
:* p.q.sut
burp(sut q.q.sut)
r.q.sut
:_ q.s.q.sut
?: ?=([[%full ~] *] p.s.q.sut)
p.s.q.sut
[[%full ~ ~ ~] ~]
==
[%face *] [%face p.sut burp(sut q.sut)]
[%fork *] [%fork (~(run in p.sut) |=(type burp(sut +<)))]
2018-03-29 21:21:04 +03:00
[%form *] [%form p.sut burp(sut q.sut)]
[%hold *] [%hold burp(sut p.sut) q.sut]
==
::
2016-11-24 07:25:07 +03:00
++ busk
~/ %busk
2017-11-17 00:50:03 +03:00
|= gen/hoon
2017-11-16 23:44:27 +03:00
^- type
[%face [~ ~ [gen ~]] sut]
2016-11-24 07:25:07 +03:00
::
++ buss
~/ %buss
2017-11-17 00:50:03 +03:00
|= {{wat/what cog/term} gen/hoon}
2017-11-16 23:44:27 +03:00
^- type
2017-04-05 03:33:20 +03:00
[%face [wat [[cog ~ ~ gen] ~ ~] ~] sut]
2016-11-24 07:25:07 +03:00
::
++ conk
|= got/toga
2017-11-16 23:44:27 +03:00
^- type
?@ got [%face [~ got] sut]
2016-11-24 07:25:07 +03:00
?- -.got
$0 sut
2017-04-17 01:37:40 +03:00
$1 [%face p.got $(got q.got)]
2016-11-24 07:25:07 +03:00
$2 ?> |(!vet (nest(sut [%cell %noun %noun]) & sut))
:+ %cell
$(got p.got, sut (peek %both 2))
$(got q.got, sut (peek %both 3))
==
::
++ crop
~/ %crop
2017-11-16 23:44:27 +03:00
|= ref/type
=+ bix=*(set {type type})
2016-11-24 07:25:07 +03:00
=< dext
|%
++ dext
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
~_ leaf+"crop"
:: ~_ (dunk 'dext: sut')
:: ~_ (dunk(sut ref) 'dext: ref')
?: |(=(sut ref) =(%noun ref))
%void
?: =(%void ref)
sut
?- sut
{$atom *}
?+ ref sint
{$atom *} ?^ q.sut
?^(q.ref ?:(=(q.ref q.sut) %void sut) %void)
?^(q.ref sut %void)
{$cell *} sut
==
::
{$cell *}
?+ ref sint
{$atom *} sut
{$cell *} ?. (nest(sut p.ref) | p.sut) sut
(cell p.sut dext(sut q.sut, ref q.ref))
==
::
{$core *} ?:(?=(?({$atom *} {$cell *}) ref) sut sint)
{$face *} (face p.sut dext(sut q.sut))
2017-11-16 23:44:27 +03:00
{$fork *} (fork (turn ~(tap in p.sut) |=(type dext(sut +<))))
2018-03-27 02:55:02 +03:00
{$form *} (form p.sut dext(sut q.sut))
2016-11-24 07:25:07 +03:00
{$hold *} ?< (~(has in bix) [sut ref])
dext(sut repo, bix (~(put in bix) [sut ref]))
$noun dext(sut repo)
$void %void
==
::
++ sint
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
?+ ref !!
{$core *} sut
{$face *} dext(ref repo(sut ref))
{$fork *} =+ yed=~(tap in p.ref)
2017-11-16 23:44:27 +03:00
|- ^- type
2016-11-24 07:25:07 +03:00
?~ yed sut
$(yed t.yed, sut dext(ref i.yed))
{$hold *} dext(ref repo(sut ref))
==
--
::
++ cool
2017-11-16 23:44:27 +03:00
|= {pol/? hyp/wing ref/type}
^- type
2016-11-24 07:25:07 +03:00
=+ fid=(find %both hyp)
?- -.fid
2018-03-19 06:54:47 +03:00
%| sut
%& =< q
%+ take p.p.fid
2017-11-16 23:44:27 +03:00
|=(a/type ?:(pol (fuse(sut a) ref) (crop(sut a) ref)))
2016-11-24 07:25:07 +03:00
==
::
++ duck ^-(tank ~(duck us sut))
++ dune |.(duck)
++ dunk
|= paz/term ^- tank
:+ %palm
[['.' ~] ['-' ~] ~ ~]
[[%leaf (mesc (trip paz))] duck ~]
2016-11-24 07:25:07 +03:00
::
++ elbo
2017-11-17 00:50:03 +03:00
|= {lop/palo rig/(list (pair wing hoon))}
2017-11-16 23:44:27 +03:00
^- type
2018-03-19 06:54:47 +03:00
?: ?=(%& -.q.lop)
2017-11-16 23:44:27 +03:00
|- ^- type
?~ rig
2016-11-24 07:25:07 +03:00
p.q.lop
=+ zil=(play q.i.rig)
=+ dar=(tack(sut p.q.lop) p.i.rig zil)
%= $
rig t.rig
p.q.lop q.dar
==
=+ hag=~(tap in q.q.lop)
2016-11-24 07:25:07 +03:00
%- fire
|- ^+ hag
?~ rig
hag
=+ zil=(play q.i.rig)
=+ dix=(toss p.i.rig zil hag)
%= $
rig t.rig
hag q.dix
==
::
++ ergo
2017-11-17 00:50:03 +03:00
|= {lop/palo rig/(list (pair wing hoon))}
2017-11-16 23:44:27 +03:00
^- (pair type nock)
2016-11-24 07:25:07 +03:00
=+ axe=(tend p.lop)
=| hej/(list (pair axis nock))
2018-03-19 06:54:47 +03:00
?: ?=(%& -.q.lop)
2016-11-24 07:25:07 +03:00
=- [p.- (hike axe q.-)]
2017-11-16 23:44:27 +03:00
|- ^- (pair type (list (pair axis nock)))
2016-11-24 07:25:07 +03:00
?~ rig
[p.q.lop hej]
=+ zil=(mint %noun q.i.rig)
=+ dar=(tack(sut p.q.lop) p.i.rig p.zil)
%= $
rig t.rig
p.q.lop q.dar
hej [[p.dar q.zil] hej]
==
=+ hag=~(tap in q.q.lop)
2016-11-24 07:25:07 +03:00
=- [(fire p.-) [%9 p.q.lop (hike axe q.-)]]
2017-11-16 23:44:27 +03:00
|- ^- (pair (list (pair type foot)) (list (pair axis nock)))
2016-11-24 07:25:07 +03:00
?~ rig
[hag hej]
=+ zil=(mint %noun q.i.rig)
=+ dix=(toss p.i.rig p.zil hag)
%= $
rig t.rig
hag q.dix
hej [[p.dix q.zil] hej]
==
::
++ endo
2017-11-17 00:50:03 +03:00
|= {lop/(pair palo palo) dox/type rig/(list (pair wing hoon))}
2017-11-16 23:44:27 +03:00
^- (pair type type)
2018-03-19 06:54:47 +03:00
?: ?=(%& -.q.p.lop)
?> ?=(%& -.q.q.lop)
2017-11-16 23:44:27 +03:00
|- ^- (pair type type)
?~ rig
2016-11-24 07:25:07 +03:00
[p.q.p.lop p.q.q.lop]
2018-03-05 02:08:12 +03:00
=+ zil=(mull %noun dox q.i.rig)
2016-11-24 07:25:07 +03:00
=+ ^= dar
:- p=(tack(sut p.q.p.lop) p.i.rig p.zil)
q=(tack(sut p.q.q.lop) p.i.rig q.zil)
?> =(p.p.dar p.q.dar)
%= $
rig t.rig
p.q.p.lop q.p.dar
p.q.q.lop q.q.dar
==
2018-03-19 06:54:47 +03:00
?> ?=(%| -.q.q.lop)
2016-11-24 07:25:07 +03:00
?> =(p.q.p.lop p.q.q.lop)
=+ hag=[p=~(tap in q.q.p.lop) q=~(tap in q.q.q.lop)]
=- [(fire p.-) (fire(vet |) q.-)]
2017-11-16 23:44:27 +03:00
|- ^- (pair (list (pair type foot)) (list (pair type foot)))
2016-11-24 07:25:07 +03:00
?~ rig
hag
2018-03-05 02:08:12 +03:00
=+ zil=(mull %noun dox q.i.rig)
=+ ^= dix
2016-11-24 07:25:07 +03:00
:- p=(toss p.i.rig p.zil p.hag)
q=(toss p.i.rig q.zil q.hag)
?> =(p.p.dix p.q.dix)
%= $
rig t.rig
hag [q.p.dix q.q.dix]
==
::
++ ad
|%
++ arc
|%
++ deft :: generic
|%
2017-11-16 23:44:27 +03:00
++ bath * :: leg match type
++ claw * :: arm match type
2016-11-24 07:25:07 +03:00
++ form |*({* *} p=+<-) :: attach build state
++ skin |*(p/* p) :: reveal build state
++ meat |*(p/* p) :: remove build state
--
++ make :: for mint
|%
2017-11-16 23:44:27 +03:00
++ bath type :: leg match type
2016-11-24 07:25:07 +03:00
++ claw onyx :: arm
++ form |*({* *} [p=+<- q=+<+]) ::
++ skin |*({p/* q/*} q) :: unwrap baggage
++ meat |*({p/* q/*} p) :: unwrap filling
--
--
++ def
=+ deft:arc
|% +- $
=> +<
|%
++ pord |*(* (form +< *nock)) :: wrap mint formula
++ rosh |*(* (form +< *(list pock))) :: wrap mint changes
2017-12-14 06:47:01 +03:00
++ fleg _(pord $:bath) :: legmatch + code
++ fram _(pord $:claw) :: armmatch +
++ foat _(rosh $:bath) :: leg with changes
++ fult _(rosh $:claw) :: arm with changes
2016-11-24 07:25:07 +03:00
-- --
::
++ lib
|%
++ deft
=> (def deft:arc)
|%
2017-12-14 06:47:01 +03:00
++ halp ^|(|:($:hoon $:fleg))
2016-11-24 07:25:07 +03:00
++ vant
2017-12-14 06:47:01 +03:00
|% ++ trep ^|(|:($:{bath wing bath} $:{axis bath}))
++ tasp ^|(|:($:{{axis bath} fleg foat} $:foat))
++ tyle ^|(|:($:foat $:foat))
2016-11-24 07:25:07 +03:00
--
++ vunt
2017-12-14 06:47:01 +03:00
|% ++ trep ^|(|:($:{claw wing bath} $:{axis claw}))
++ tasp ^|(|:($:{{axis claw} fleg fult} $:fult))
++ tyle ^|(|:($:fult $:foat))
2016-11-24 07:25:07 +03:00
-- --
::
++ make
=> (def make:arc)
|%
2017-11-17 00:50:03 +03:00
++ halp |~ a/hoon
2016-11-24 07:25:07 +03:00
^- fleg
(mint %noun a)
++ vant
2017-12-14 06:47:01 +03:00
|% ++ trep |: $:{a/type b/wing c/type}
2017-11-16 23:44:27 +03:00
^- {axis type}
2016-11-24 07:25:07 +03:00
(tack(sut a) b c)
2017-12-14 06:47:01 +03:00
++ tasp |: $:{a/(pair axis type) b/fleg c/foat}
2016-11-24 07:25:07 +03:00
^- foat
[q.a [[p.a (skin b)] (skin c)]]
2017-12-14 06:47:01 +03:00
++ tyle |:($:foat +<)
2016-11-24 07:25:07 +03:00
--
++ vunt
2017-12-14 06:47:01 +03:00
|% ++ trep |: $:{a/claw b/wing c/bath}
2016-11-24 07:25:07 +03:00
^- (pair axis claw)
(toss b c a)
2017-12-14 06:47:01 +03:00
++ tasp |: $:{a/(pair axis claw) b/fleg c/fult}
2016-11-24 07:25:07 +03:00
^- fult
[q.a [[p.a (skin b)] (skin c)]]
2017-12-14 06:47:01 +03:00
++ tyle |: $:fult
2016-11-24 07:25:07 +03:00
^- foat
[(fire +<-) +<+]
-- -- --
::
++ bin
=+ deft:lib
|% +- $
=> +<
|%
++ rame
=> vant |%
2016-11-24 07:25:07 +03:00
++ clom bath
++ chog fleg
++ ceut foat
--
++ gelp
=> vunt |%
2016-11-24 07:25:07 +03:00
++ clom claw
++ chog fram
++ ceut fult
--
++ ecbo (ecco rame)
++ eclo (ecco gelp)
++ ecco
=+ rame
|% +- $
=> +<
2017-12-14 06:47:01 +03:00
|: $:{rum/clom rig/(list (pair wing hoon))}
2016-11-24 07:25:07 +03:00
^- foat
%- tyle
|- ^- ceut
?~ rig (rosh rum)
=+ mor=$(rig t.rig)
=+ zil=(halp q.i.rig)
=+ dar=(trep (meat mor) p.i.rig (meat zil))
(tasp dar zil mor)
-- -- -- --
::
++ oc
=+ inc=(bin:ad)
|% +- $
=> inc
|%
++ echo
2017-12-14 06:47:01 +03:00
|: $:{rum/bath rig/(list (pair wing hoon))}
2016-11-24 07:25:07 +03:00
(ecbo rum rig)
::
++ ecmo
2017-12-14 06:47:01 +03:00
|: $:{hag/claw rig/(list (pair wing hoon))}
2016-11-24 07:25:07 +03:00
(eclo hag rig)
-- --
::
++ etco
2017-11-17 00:50:03 +03:00
|= {lop/palo rig/(list (pair wing hoon))}
2017-11-16 23:44:27 +03:00
^- (pair type nock)
2016-11-24 07:25:07 +03:00
=+ cin=(oc (bin:ad make:lib:ad))
=. rig (flop rig) :: XX this unbreaks, void order in devulc
=+ axe=(tend p.lop)
2018-03-19 06:54:47 +03:00
?: ?=(%& -.q.lop)
2016-11-24 07:25:07 +03:00
=- [p.- (hike axe q.-)]
(echo:cin p.q.lop rig)
=- [p.- [%9 p.q.lop (hike axe q.-)]]
(ecmo:cin ~(tap in q.q.lop) rig)
2016-11-24 07:25:07 +03:00
::
++ et
2017-11-17 00:50:03 +03:00
|_ {hyp/wing rig/(list (pair wing hoon))}
2016-11-24 07:25:07 +03:00
::
++ play
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
=+ lug=(find %read hyp)
2018-03-19 06:54:47 +03:00
?: ?=(%| -.lug) ~>(%mean.[%leaf "hoon"] ?>(?=(~ rig) p.p.lug))
2016-11-24 07:25:07 +03:00
(elbo p.lug rig)
::
++ mint
2017-11-16 23:44:27 +03:00
|= gol/type
^- (pair type nock)
2016-11-24 07:25:07 +03:00
=+ lug=(find %read hyp)
2018-03-19 06:54:47 +03:00
?: ?=(%| -.lug) ~>(%mean.[%leaf "hoon"] ?>(?=(~ rig) p.lug))
2016-11-24 07:25:07 +03:00
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
(etco p.lug rig)
::
++ mull
2017-11-16 23:44:27 +03:00
|= {gol/type dox/type}
^- {type type}
2016-11-24 07:25:07 +03:00
=+ lug=[p=(find %read hyp) q=(find(sut dox) %read hyp)]
2018-03-19 06:54:47 +03:00
?: ?=(%| -.p.lug)
?> &(?=(%| -.q.lug) ?=(~ rig))
2016-11-24 07:25:07 +03:00
[p.p.p.lug p.p.q.lug]
2018-03-19 06:54:47 +03:00
?> ?=(%& -.q.lug)
2016-11-24 07:25:07 +03:00
=- ?>(?|(!vet (nest(sut gol) & p.-)) -)
(endo [p.p.lug p.q.lug] dox rig)
--
::
++ epla
~/ %epla
2017-11-17 00:50:03 +03:00
|= {hyp/wing rig/(list (pair wing hoon))}
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
~(play et hyp rig)
::
++ emin
~/ %emin
2017-11-17 00:50:03 +03:00
|= {gol/type hyp/wing rig/(list (pair wing hoon))}
2017-11-16 23:44:27 +03:00
^- (pair type nock)
(~(mint et hyp rig) gol)
2016-11-24 07:25:07 +03:00
::
++ emul
~/ %emul
2017-11-17 00:50:03 +03:00
|= {gol/type dox/type hyp/wing rig/(list (pair wing hoon))}
2017-11-16 23:44:27 +03:00
^- (pair type type)
2016-11-24 07:25:07 +03:00
(~(mull et hyp rig) gol dox)
::
++ felt
~/ %felt
|= lap/opal
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
?- -.lap
2018-03-19 06:54:47 +03:00
%& p.lap
%| %- fire
%+ turn ~(tap in q.lap)
2017-11-16 23:44:27 +03:00
|= {a/type b/foot}
2016-11-24 07:25:07 +03:00
[a [%ash %$ 1]]
==
2018-03-27 02:55:02 +03:00
:: ::
++ feel :: detect existence
|= rot/(list wing)
^- ?
=. rot (flop rot)
|- ^- ?
?~ rot &
=/ yep (fond %free i.rot)
?~ yep |
?- -.yep
%& %= $
rot t.rot
sut p:(fine %& q.p.yep)
==
%| ?- -.p.yep
%& |
%| %= $
rot t.rot
sut p:(fine %| q.p.p.yep)
==
== ==
2016-11-24 07:25:07 +03:00
::
++ fond
~/ %fond
|= {way/vial hyp/wing}
=> |%
++ pony :: raw match
2018-03-27 02:55:02 +03:00
$@ ~ :: void
2016-11-24 07:25:07 +03:00
%+ each :: natural/abnormal
(pair what palo) :: arm or leg
2016-11-24 07:25:07 +03:00
%+ each :: abnormal
@ud :: unmatched
2017-11-16 23:44:27 +03:00
(pair what (pair type nock)) :: synthetic
2016-11-24 07:25:07 +03:00
--
^- pony
?~ hyp
2017-04-17 01:37:40 +03:00
[%& ~ ~ %& sut]
2016-11-24 07:25:07 +03:00
=+ mor=$(hyp t.hyp)
?- -.mor
2018-03-19 06:54:47 +03:00
%|
2016-11-24 07:25:07 +03:00
?- -.p.mor
2018-03-19 06:54:47 +03:00
%& mor
%|
2017-04-17 01:37:40 +03:00
=+ fex=(mint(sut p.q.p.p.mor) %noun [%wing i.hyp ~])
[%| %| p.p.p.mor p.fex (comb q.q.p.p.mor q.fex)]
2016-11-24 07:25:07 +03:00
==
::
2018-03-19 06:54:47 +03:00
%&
2017-04-17 01:37:40 +03:00
=. sut (felt q.q.p.mor)
2016-11-24 07:25:07 +03:00
=> :_ +
:* axe=`axis`1
2017-04-17 01:37:40 +03:00
lon=p.q.p.mor
2016-11-24 07:25:07 +03:00
heg=?^(i.hyp i.hyp [%| p=0 q=(some i.hyp)])
==
2018-03-19 06:54:47 +03:00
?: ?=(%& -.heg)
2017-04-17 01:37:40 +03:00
[%& ~ [`p.heg lon] %& (peek way p.heg)]
2017-11-16 23:44:27 +03:00
=| gil/(set type)
2016-11-24 07:25:07 +03:00
=< $
|% ++ here ?: =(0 p.heg)
2017-04-17 01:37:40 +03:00
[%& ~ [~ `axe lon] %& sut]
2016-11-24 07:25:07 +03:00
[%| %& (dec p.heg)]
++ join |=({a/what b/what} ?~(a b a))
2016-11-24 07:25:07 +03:00
++ lose [%| %& p.heg]
++ stop ?~(q.heg here lose)
++ twin |= {hax/pony yor/pony}
^- pony
~_ leaf+"find-fork"
?: =(hax yor) hax
?~ hax yor
?~ yor hax
2018-03-19 06:54:47 +03:00
?: ?=(%| -.hax)
?> ?& ?=(%| -.yor)
?=(%| -.p.hax)
?=(%| -.p.yor)
2017-04-17 01:37:40 +03:00
=(q.q.p.p.hax q.q.p.p.yor)
2016-11-24 07:25:07 +03:00
==
2017-04-17 01:37:40 +03:00
:^ %|
%|
(join p.p.p.hax p.p.p.yor)
[(fork p.q.p.p.hax p.q.p.p.yor ~) q.q.p.p.hax]
2018-03-19 06:54:47 +03:00
?> ?=(%& -.yor)
2016-11-24 07:25:07 +03:00
?> =(p.q.p.hax p.q.p.yor)
2018-03-19 06:54:47 +03:00
?: &(?=(%& -.q.q.p.hax) ?=(%& -.q.q.p.yor))
2017-12-19 05:18:06 +03:00
:^ %& (join p.p.hax p.p.yor) p.q.p.hax
2017-04-17 01:37:40 +03:00
[%& (fork p.q.q.p.hax p.q.q.p.yor ~)]
2018-03-19 06:54:47 +03:00
?> &(?=(%| -.q.q.p.hax) ?=(%| -.q.q.p.yor))
2017-04-17 01:37:40 +03:00
?> =(p.q.q.p.hax p.q.q.p.yor)
=+ wal=(~(uni in q.q.q.p.hax) q.q.q.p.yor)
2017-12-19 05:18:06 +03:00
:^ %& ~ p.q.p.hax
2017-04-17 01:37:40 +03:00
[%| p.q.q.p.hax wal]
2016-11-24 07:25:07 +03:00
++ $
^- pony
?- sut
2017-12-19 05:18:06 +03:00
$void ~
2016-11-24 07:25:07 +03:00
$noun stop
{$atom *} stop
{$cell *}
2016-11-24 07:25:07 +03:00
?~ q.heg here
=+ taf=$(axe (peg axe 2), sut p.sut)
?~ taf ~
2018-03-19 06:54:47 +03:00
?: |(?=(%& -.taf) ?=(%| -.p.taf))
2016-11-24 07:25:07 +03:00
taf
$(axe (peg axe 3), p.heg p.p.taf, sut q.sut)
::
2016-11-24 07:25:07 +03:00
{$core *}
?~ q.heg here
=^ zem p.heg
=+ zem=(loot u.q.heg q.s.q.sut)
2016-11-24 07:25:07 +03:00
?~ zem [~ p.heg]
?:(=(0 p.heg) [zem 0] [~ (dec p.heg)])
?^ zem
2017-04-17 01:37:40 +03:00
:^ %&
p.q.u.zem
[`axe lon]
[%| (peg 2 p.u.zem) [[sut(p.q %gold) q.q.u.zem] ~ ~]]
2016-11-24 07:25:07 +03:00
=+ pec=(peel way p.q.sut)
?. sam.pec lose
?: con.pec $(sut p.sut, axe (peg axe 3))
$(sut (peek(sut p.sut) way 2), axe (peg axe 6))
2018-03-27 02:55:02 +03:00
::
{$form *}
$(sut repo)
2016-11-24 07:25:07 +03:00
::
{$face *}
?: ?=(~ q.heg) here(sut q.sut)
=* zot q.p.sut
?@ zot
?:(=(u.q.heg zot) here(sut q.sut) lose)
2016-11-24 07:25:07 +03:00
=< main
|%
++ main
^- pony
=+ tyr=(~(get by p.zot) u.q.heg)
?~ tyr
2016-11-24 07:25:07 +03:00
next
2017-04-17 01:37:40 +03:00
?~ q.u.tyr
2016-11-24 07:25:07 +03:00
$(sut q.sut, lon [~ lon], p.heg +(p.heg))
2017-04-17 01:37:40 +03:00
=+ tor=(fund way u.q.u.tyr)
2016-11-24 07:25:07 +03:00
?- -.tor
2018-03-19 06:54:47 +03:00
%& [%& ~ (weld p.p.tor `vein`[~ `axe lon]) q.p.tor]
%| [%| %| p.u.tyr p.p.tor (comb [%0 axe] q.p.tor)]
2016-11-24 07:25:07 +03:00
==
++ next
|- ^- pony
?~ q.zot
2016-11-24 07:25:07 +03:00
^$(sut q.sut, lon [~ lon])
=+ tiv=(mint(sut q.sut) %noun i.q.zot)
2016-11-24 07:25:07 +03:00
=+ fid=^$(sut p.tiv, lon ~, axe 1, gil ~)
?~ fid ~
2018-03-19 06:54:47 +03:00
?: ?=({%| %& *} fid)
$(q.zot t.q.zot, p.heg p.p.fid)
2017-11-16 23:44:27 +03:00
=+ ^- {wat/what vat/(pair type nock)}
2017-04-17 01:37:40 +03:00
?- -.fid
2018-03-19 06:54:47 +03:00
%& [p.p.fid (fine %& q.p.fid)]
%| [p.p.p.fid (fine %| q.p.p.fid)]
2017-04-17 01:37:40 +03:00
==
[%| %| wat p.vat (comb (comb [%0 axe] q.tiv) q.vat)]
2016-11-24 07:25:07 +03:00
--
::
{$fork *}
2017-11-16 23:44:27 +03:00
=+ wiz=(turn ~(tap in p.sut) |=(a/type ^$(sut a)))
2016-11-24 07:25:07 +03:00
?~ wiz ~
|- ^- pony
?~ t.wiz i.wiz
(twin i.wiz $(wiz t.wiz))
::
{$hold *}
?: (~(has in gil) sut)
~
$(gil (~(put in gil) sut), sut repo)
==
--
==
::
++ find
~/ %find
|= {way/vial hyp/wing}
^- port
~_ (show [%c %find] %l hyp)
=- ?@ - !!
?- -<
2018-03-19 06:54:47 +03:00
%& [%& q.p.-]
%| ?- -.p.-
%| [%| q.p.p.-]
%& !!
2016-11-24 07:25:07 +03:00
== ==
(fond way hyp)
::
++ fund
~/ %fund
2017-11-17 00:50:03 +03:00
|= {way/vial gen/hoon}
2016-11-24 07:25:07 +03:00
^- port
=+ hup=~(reek ap gen)
?~ hup
[%| (mint %noun gen)]
(find way u.hup)
::
++ fine
~/ %fine
|= tor/port
2017-11-16 23:44:27 +03:00
^- (pair type nock)
2016-11-24 07:25:07 +03:00
?- -.tor
2018-03-19 06:54:47 +03:00
%| p.tor
%& =+ axe=(tend p.p.tor)
2016-11-24 07:25:07 +03:00
?- -.q.p.tor
2018-03-19 06:54:47 +03:00
%& [`type`p.q.p.tor %0 axe]
%| [(fire ~(tap in q.q.p.tor)) [%9 p.q.p.tor %0 axe]]
== ==
2016-11-24 07:25:07 +03:00
::
++ fire
2017-11-16 23:44:27 +03:00
|= hag/(list {p/type q/foot})
^- type
?: ?=({{* {$elm ~ $1}} ~} hag)
2016-11-24 07:25:07 +03:00
p.i.hag
%- fork
%+ turn
hag.$
2017-11-16 23:44:27 +03:00
|= {p/type q/foot}
2016-11-24 07:25:07 +03:00
:- %hold
?. ?=({$core *} p)
2017-11-16 23:44:27 +03:00
~_ (dunk %fire-type)
2016-11-24 07:25:07 +03:00
~>(%mean.[%leaf "fire-core"] !!)
=+ dox=[%core q.q.p q.p]
?: ?=($ash -.q)
:: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-dry)
?> ?|(!vet (nest(sut q.q.p) & p.p))
[dox p.q]
?> ?=($elm -.q)
:: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-wet)
2017-09-08 02:47:49 +03:00
:: =. p.p ?:(fab p.p (redo(sut p.p) q.q.p))
=. p.p (redo(sut p.p) q.q.p)
2016-11-24 07:25:07 +03:00
?> ?| !vet
(~(has in rib) [sut dox p.q])
!=(** (mull(sut p, rib (~(put in rib) sut dox p.q)) %noun dox p.q))
==
[p p.q]
::
++ fish
~/ %fish
|= axe/axis
2017-11-16 23:44:27 +03:00
=+ vot=*(set type)
2016-11-24 07:25:07 +03:00
|- ^- nock
?- sut
$void [%1 1]
$noun [%1 0]
{$atom *} ?~ q.sut
(flip [%3 %0 axe])
[%5 [%1 u.q.sut] [%0 axe]]
{$cell *}
%+ flan
[%3 %0 axe]
(flan $(sut p.sut, axe (peg axe 2)) $(sut q.sut, axe (peg axe 3)))
::
2018-03-18 04:06:15 +03:00
{$core *} ~>(%mean.[%leaf "fish-core"] !!)
2016-11-24 07:25:07 +03:00
{$face *} $(sut q.sut)
{$fork *} =+ yed=~(tap in p.sut)
2016-11-24 07:25:07 +03:00
|- ^- nock
?~(yed [%1 1] (flor ^$(sut i.yed) $(yed t.yed)))
2018-03-27 02:55:02 +03:00
{$form *} $(sut q.sut)
2016-11-24 07:25:07 +03:00
{$hold *}
?: (~(has in vot) sut)
2018-03-18 04:06:15 +03:00
~>(%mean.[%leaf "fish-loop"] !!)
2016-11-24 07:25:07 +03:00
=> %=(. vot (~(put in vot) sut))
$(sut repo)
==
::
++ fuse
~/ %fuse
2017-11-16 23:44:27 +03:00
|= ref/type
=+ bix=*(set {type type})
|- ^- type
2016-11-24 07:25:07 +03:00
?: ?|(=(sut ref) =(%noun ref))
sut
?- sut
{$atom *}
?- ref
{$atom *} =+ foc=?:((fitz p.ref p.sut) p.sut p.ref)
?^ q.sut
?^ q.ref
?: =(q.sut q.ref)
[%atom foc q.sut]
%void
[%atom foc q.sut]
[%atom foc q.ref]
{$cell *} %void
* $(sut ref, ref sut)
==
{$cell *}
?- ref
{$cell *} (cell $(sut p.sut, ref p.ref) $(sut q.sut, ref q.ref))
* $(sut ref, ref sut)
==
::
{$core *} $(sut repo)
{$face *} (face p.sut $(sut q.sut))
2017-11-16 23:44:27 +03:00
{$fork *} (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
2018-03-27 02:55:02 +03:00
{$form *} (form p.sut $(sut q.sut))
2016-11-24 07:25:07 +03:00
{$hold *}
?: (~(has in bix) [sut ref])
~>(%mean.[%leaf "fuse-loop"] !!)
$(sut repo, bix (~(put in bix) [sut ref]))
::
$noun ref
$void %void
==
::
++ gain
~/ %gain
2017-11-17 00:50:03 +03:00
|= gen/hoon ^- type
2016-11-24 07:25:07 +03:00
(chip & gen)
::
++ hemp
:: generate formula from foot
::
|= fut/foot
^- nock
~+
?- -.fut
$ash q:(mint %noun p.fut)
2018-03-05 02:08:12 +03:00
$elm q:(mint(vet |) %noun p.fut)
==
::
2018-02-22 08:27:35 +03:00
++ laze
:: produce lazy core generator for static execution
::
2018-02-23 02:32:23 +03:00
|= [wad=chap dom=(map @ tomb)]
2018-03-04 05:54:15 +03:00
:: only one layer of fabrication analysis
::
=. fab &
~+
2018-02-22 08:27:35 +03:00
^- seminoun
:: tal: map from battery axis to foot
::
=; tal/(map @ud foot)
:: produce lazy battery
::
:_ ~
:+ %lazy 1
|= axe/@ud
^- (unit noun)
2018-02-23 04:06:49 +03:00
%+ bind (~(get by tal) axe)
|= fut/foot
%.(fut hemp(sut (core sut %gold sut wad [[%lazy 1 ..^$] ~] dom)))
2018-02-22 08:27:35 +03:00
::
%- ~(gas by *(map @ud foot))
=| yeb/(list (pair @ud foot))
=+ axe=1
|^ ?- dom
~ yeb
[* ~ ~] (chapter q.q.n.dom)
[* * ~] %= $
dom l.dom
axe (peg axe 3)
yeb (chapter(axe (peg axe 2)) q.q.n.dom)
==
[* ~ *] %= $
dom r.dom
axe (peg axe 3)
yeb (chapter(axe (peg axe 2)) q.q.n.dom)
==
[* * *] %= $
dom r.dom
axe (peg axe 7)
yeb %= $
dom l.dom
axe (peg axe 6)
yeb (chapter(axe (peg axe 2)) q.q.n.dom)
== == ==
++ chapter
|= dab/(map term (pair what foot))
^+ yeb
?- dab
~ yeb
[* ~ ~] [[axe q.q.n.dab] yeb]
[* * ~] %= $
dab l.dab
axe (peg axe 3)
yeb [[(peg axe 2) q.q.n.dab] yeb]
==
[* ~ *] %= $
dab r.dab
axe (peg axe 3)
yeb [[(peg axe 2) q.q.n.dab] yeb]
==
[* * *] %= $
dab r.dab
axe (peg axe 7)
yeb %= $
dab l.dab
axe (peg axe 6)
yeb [[(peg axe 2) q.q.n.dab] yeb]
== == ==
--
::
2016-11-24 07:25:07 +03:00
++ lose
~/ %lose
2017-11-17 00:50:03 +03:00
|= gen/hoon ^- type
2016-11-24 07:25:07 +03:00
(chip | gen)
::
++ chip
~/ %chip
2017-11-17 00:50:03 +03:00
|= {how/? gen/hoon} ^- type
2017-09-21 00:13:10 +03:00
?: ?=({$wtts *} gen)
2018-03-14 08:56:31 +03:00
(cool how q.gen (play ~(example ax fab p.gen)))
2018-03-20 05:42:13 +03:00
?: ?&(how ?=({$wtpd *} gen))
|-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
2017-09-21 00:13:10 +03:00
?: ?&(!how ?=({$wtbr *} gen))
2016-11-24 07:25:07 +03:00
|-(?~(p.gen sut $(p.gen t.p.gen, sut ^$(gen i.p.gen))))
2017-12-11 08:13:09 +03:00
=+ neg=~(open ap gen)
2016-11-24 07:25:07 +03:00
?:(=(neg gen) sut $(gen neg))
::
2018-02-19 04:52:25 +03:00
++ bake
|= [dox/type dab/(map term (pair what foot))]
^- *
?: ?=(~ dab)
~
=+ ^= dov
?- -.q.q.n.dab
$ash (mull %noun dox p.q.q.n.dab)
$elm ~
==
?- dab
{* ~ ~} dov
{* ~ *} [dov $(dab r.dab)]
{* * ~} [dov $(dab l.dab)]
{* * *} [dov $(dab l.dab) $(dab r.dab)]
==
::
++ balk
|= [dox/type dom/(map @ tomb)]
^- *
?: ?=(~ dom)
~
=+ dov=(bake dox q.q.n.dom)
?- dom
{* ~ ~} dov
{* ~ *} [dov $(dom r.dom)]
{* * ~} [dov $(dom l.dom)]
{* * *} [dov $(dom l.dom) $(dom r.dom)]
==
::
++ mile
:: mull all chapters and feet in a core
::
|= [dox=type mel=vair wad=chap dom=(map @ tomb)]
^- (pair type type)
2018-02-27 08:18:47 +03:00
=+ yet=(core sut %gold sut wad (laze wad dom) dom)
=+ hum=(core dox %gold dox wad (laze wad dom) dom)
=+ %+ balk(sut yet)
hum
dom
2018-02-27 08:18:47 +03:00
[yet hum]
2018-02-19 04:52:25 +03:00
::
++ mine
2018-02-19 04:52:25 +03:00
:: mint all chapters and feet in a core
::
|= [mel/vair wad/chap dom/(map @ tomb)]
^- (pair type nock)
=- :_ [%1 dez]
2018-02-20 04:27:23 +03:00
(core sut mel sut wad [[%full ~] dez] dom)
^= dez
2018-02-27 08:18:47 +03:00
=. sut (core sut %gold sut wad (laze wad dom) dom)
2018-02-19 04:52:25 +03:00
|- ^- ?(~ ^)
?: ?=(~ dom)
~
=/ dov/?(~ ^)
=/ dab/(map term (pair what foot)) q.q.n.dom
|- ^- ?(~ ^)
?: ?=(~ dab)
~
=+ vad=(hemp q.q.n.dab)
?- dab
{* ~ ~} vad
{* ~ *} [vad $(dab r.dab)]
{* * ~} [vad $(dab l.dab)]
{* * *} [vad $(dab l.dab) $(dab r.dab)]
==
?- dom
{* ~ ~} dov
{* ~ *} [dov $(dom r.dom)]
{* * ~} [dov $(dom l.dom)]
{* * *} [dov $(dom l.dom) $(dom r.dom)]
==
::
2016-11-24 07:25:07 +03:00
++ mint
~/ %mint
2017-11-17 00:50:03 +03:00
|= {gol/type gen/hoon}
2017-11-16 23:44:27 +03:00
^- {p/type q/nock}
2016-11-24 07:25:07 +03:00
~& %pure-mint
2017-11-16 23:44:27 +03:00
|^ ^- {p/type q/nock}
2016-11-24 07:25:07 +03:00
?: ?&(=(%void sut) !?=({$dbug *} gen))
2017-09-21 03:54:04 +03:00
?. |(!vet ?=({$lost *} gen) ?=({$zpzp *} gen))
2016-11-24 07:25:07 +03:00
~>(%mean.[%leaf "mint-vain"] !!)
[%void %0 0]
?- gen
::
{^ *}
=+ hed=$(gen p.gen, gol %noun)
=+ tal=$(gen q.gen, gol %noun)
[(nice (cell p.hed p.tal)) (cons q.hed q.tal)]
::
2017-12-04 06:10:51 +03:00
{$ktcn *} $(fab |, gen p.gen)
2017-09-18 04:32:20 +03:00
{$brcn *} (grow %gold [%$ 1] p.gen q.gen)
2016-11-24 07:25:07 +03:00
::
2017-09-19 03:19:22 +03:00
{$cnts *} (~(mint et p.gen q.gen) gol)
2018-03-12 21:32:56 +03:00
::
2018-03-13 04:20:48 +03:00
{$dtkt *}
2018-03-14 06:17:30 +03:00
=+ nef=$(gen [%bcdt p.gen])
2018-03-12 21:32:56 +03:00
[p.nef [%11 [%1 %151 p.nef] q:$(gen q.gen, gol %noun)]]
2016-11-24 07:25:07 +03:00
::
2017-09-19 23:37:15 +03:00
{$dtls *} [(nice [%atom %$ ~]) [%4 q:$(gen p.gen, gol [%atom %$ ~])]]
2016-11-24 07:25:07 +03:00
{$sand *} [(nice (play gen)) [%1 q.gen]]
{$rock *} [(nice (play gen)) [%1 q.gen]]
::
2017-09-19 23:37:15 +03:00
{$dttr *}
2016-11-24 07:25:07 +03:00
[(nice %noun) [%2 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
::
2017-09-19 23:37:15 +03:00
{$dtts *}
2016-11-24 07:25:07 +03:00
=+ [one two]=[$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)]
[(nice bool) [%5 q:$(gen p.gen, gol %noun) q:$(gen q.gen, gol %noun)]]
::
2017-09-19 23:37:15 +03:00
{$dtwt *} [(nice bool) [%3 q:$(gen p.gen, gol %noun)]]
2016-11-24 07:25:07 +03:00
{$hand *} [p.gen q.gen]
2017-09-20 08:32:08 +03:00
{$ktbr *} =+(vat=$(gen p.gen) [(wrap(sut p.vat) %iron) q.vat])
2016-11-24 07:25:07 +03:00
::
2017-09-20 02:24:30 +03:00
{$ktls *}
2016-11-24 07:25:07 +03:00
=+(hif=(nice (play p.gen)) [hif q:$(gen q.gen, gol hif)])
::
2018-03-14 06:17:30 +03:00
{$ktpd *} =+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) q.vat])
2018-03-07 01:42:05 +03:00
{$ktsg *} (blow gol p.gen)
2017-09-20 02:24:30 +03:00
{$ktts *} =+(vat=$(gen q.gen) [(conk(sut p.vat) p.gen) q.vat])
2017-04-17 01:37:40 +03:00
{$tune *} [(face p.gen sut) [%0 %1]]
2017-09-20 08:32:08 +03:00
{$ktwt *} =+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) q.vat])
2018-03-27 02:55:02 +03:00
::
{$form *}
=+ hum=$(gen q.gen)
[(form [sut p.gen] p.hum) q.hum]
::
2017-09-20 09:13:11 +03:00
{$sgzp *} ~_(duck(sut (play p.gen)) $(gen q.gen))
{$sggr *}
2016-11-24 07:25:07 +03:00
=+ hum=$(gen q.gen)
2018-03-19 06:54:47 +03:00
:: ?: &(huz !?=(%|(@ [?(%sgcn %sgls) ^]) p.gen))
2016-11-24 07:25:07 +03:00
:: hum
:- p.hum
:+ %10
?- p.gen
@ p.gen
^ [p.p.gen q:$(gen q.p.gen, gol %noun)]
==
q.hum
::
2017-09-20 23:15:30 +03:00
{$tsgr *}
2016-11-24 07:25:07 +03:00
=+ fid=$(gen p.gen, gol %noun)
=+ dov=$(sut p.fid, gen q.gen)
[p.dov (comb q.fid q.dov)]
::
2017-09-20 23:15:30 +03:00
{$tstr *}
2016-11-24 07:25:07 +03:00
$(gen r.gen, sut (buss p.gen q.gen))
::
2017-09-20 23:15:30 +03:00
{$tscm *}
2016-11-24 07:25:07 +03:00
$(gen q.gen, sut (busk p.gen))
::
2017-09-21 00:43:14 +03:00
{$wtcl *}
2016-11-24 07:25:07 +03:00
=+ nor=$(gen p.gen, gol bool)
=+ fex=(gain p.gen)
=+ wux=(lose p.gen)
=+ ^= duy
?: =(%void fex)
?:(=(%void wux) [%0 0] [%1 1])
?:(=(%void wux) [%1 0] q.nor)
=+ hiq=$(sut fex, gen q.gen)
=+ ran=$(sut wux, gen r.gen)
[(fork p.hiq p.ran ~) (cond duy q.hiq q.ran)]
::
2017-12-04 23:07:41 +03:00
{$fits *}
2016-11-24 07:25:07 +03:00
:- (nice bool)
2017-12-04 23:07:41 +03:00
=+ ref=(play p.gen)
2016-11-24 07:25:07 +03:00
=+ fid=(find %read q.gen)
~| [%test q.gen]
|- ^- nock
?- -.fid
2018-03-19 06:54:47 +03:00
%& ?- -.q.p.fid
%& (fish(sut ref) (tend p.p.fid))
%| $(fid [%| (fine fid)])
2016-11-24 07:25:07 +03:00
==
2018-03-19 06:54:47 +03:00
%| [%7 q.p.fid (fish(sut ref) 1)]
2016-11-24 07:25:07 +03:00
==
::
{$dbug *}
~_ (show %o p.gen)
=+ hum=$(gen q.gen)
[p.hum [%10 [%spot %1 p.gen] q.hum]]
::
2017-09-21 02:12:03 +03:00
{$zpcm *} [(nice (play p.gen)) [%1 q.gen]] :: XX validate!
2016-11-24 07:25:07 +03:00
{$lost *}
?: vet
~_ (dunk(sut (play p.gen)) 'lost')
~>(%mean.[%leaf "mint-lost"] !!)
[%void [%0 0]]
::
2018-03-14 06:17:30 +03:00
{$zpmc *}
2016-11-24 07:25:07 +03:00
=+ vos=$(gol %noun, gen q.gen)
=+ ref=p:$(gol %noun, gen p.gen)
2017-11-16 23:44:27 +03:00
?> (~(nest ut p:!>(*type)) & ref)
[(nice (cell ref p.vos)) (cons [%1 burp(sut p.vos)] q.vos)]
2016-11-24 07:25:07 +03:00
::
2017-09-21 02:12:03 +03:00
{$zpts *} [(nice %noun) [%1 q:$(vet |, gen p.gen)]]
2018-03-27 02:55:02 +03:00
{$zpvt *} ?:((feel p.gen) $(gen q.gen) $(gen r.gen))
::
{$zpzp ~} [%void [%0 0]]
2016-11-24 07:25:07 +03:00
*
=+ doz=~(open ap gen)
?: =(doz gen)
~_ (show [%c 'hoon'] [%q gen])
~>(%mean.[%leaf "mint-open"] !!)
$(gen doz)
==
::
++ nice
2017-11-16 23:44:27 +03:00
|= typ/type
2016-11-24 07:25:07 +03:00
~_ leaf+"mint-nice"
?> ?|(!vet (nest(sut gol) & typ))
typ
::
++ grow
2017-11-17 00:50:03 +03:00
|= {mel/vair ruf/hoon wad/chap dom/(map @ tomb)}
2017-11-16 23:44:27 +03:00
^- {p/type q/nock}
2016-11-24 07:25:07 +03:00
=+ dan=^$(gen ruf, gol %noun)
=+ pul=(mine mel wad dom)
[(nice p.pul) (cons q.pul q.dan)]
2016-11-24 07:25:07 +03:00
--
::
++ moot
2017-11-16 23:44:27 +03:00
=+ gil=*(set type)
2016-11-24 07:25:07 +03:00
|- ^- ?
?- sut
{$atom *} |
{$cell *} |($(sut p.sut) $(sut q.sut))
{$core *} $(sut p.sut)
{$face *} $(sut q.sut)
2017-11-16 23:44:27 +03:00
{$fork *} (lien ~(tap in p.sut) |=(type ^$(sut +<)))
2018-03-27 02:55:02 +03:00
{$form *} $(sut q.sut)
2016-11-24 07:25:07 +03:00
{$hold *} |((~(has in gil) sut) $(gil (~(put in gil) sut), sut repo))
$noun |
$void &
==
::
++ mull
~/ %mull
2017-11-17 00:50:03 +03:00
|= {gol/type dox/type gen/hoon}
2017-11-16 23:44:27 +03:00
|^ ^- {p/type q/type}
2016-11-24 07:25:07 +03:00
?: =(%void sut)
~>(%mean.[%leaf "mull-none"] !!)
?- gen
::
{^ *}
=+ hed=$(gen p.gen, gol %noun)
=+ tal=$(gen q.gen, gol %noun)
[(nice (cell p.hed p.tal)) (cell q.hed q.tal)]
::
2017-09-20 02:24:30 +03:00
{$ktcn *} $(fab |, gen p.gen)
2017-09-18 04:32:20 +03:00
{$brcn *} (grow %gold [%$ 1] p.gen q.gen)
2017-09-19 03:19:22 +03:00
{$cnts *} (~(mull et p.gen q.gen) gol dox)
2018-03-14 06:17:30 +03:00
{$dtkt *} =+($(gen q.gen, gol %noun) $(gen [%bcdt p.gen]))
2017-09-19 23:37:15 +03:00
{$dtls *} =+($(gen p.gen, gol [%atom %$ ~]) (beth [%atom %$ ~]))
2016-11-24 07:25:07 +03:00
{$sand *} (beth (play gen))
{$rock *} (beth (play gen))
::
2017-09-19 23:37:15 +03:00
{$dttr *}
2016-11-24 07:25:07 +03:00
=+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth %noun))
::
2017-09-19 23:37:15 +03:00
{$dtts *}
2016-11-24 07:25:07 +03:00
=+([$(gen p.gen, gol %noun) $(gen q.gen, gol %noun)] (beth bool))
::
2017-09-19 23:37:15 +03:00
{$dtwt *} =+($(gen p.gen, gol %noun) (beth bool)) :: XX =|
2016-11-24 07:25:07 +03:00
{$hand *} [p.gen p.gen]
2017-09-20 02:24:30 +03:00
{$ktbr *}
2017-09-20 08:32:08 +03:00
=+(vat=$(gen p.gen) [(wrap(sut p.vat) %iron) (wrap(sut q.vat) %iron)])
2016-11-24 07:25:07 +03:00
::
2017-09-20 02:24:30 +03:00
{$ktls *}
2016-11-24 07:25:07 +03:00
=+ hif=[p=(nice (play p.gen)) q=(play(sut dox) p.gen)]
=+($(gen q.gen, gol p.hif) hif)
::
2018-03-14 06:17:30 +03:00
{$ktpd *}
2017-09-20 08:32:08 +03:00
=+(vat=$(gen p.gen) [(wrap(sut p.vat) %zinc) (wrap(sut q.vat) %zinc)])
2016-11-24 07:25:07 +03:00
::
2017-09-20 02:24:30 +03:00
{$ktts *}
2016-11-24 07:25:07 +03:00
=+(vat=$(gen q.gen) [(conk(sut p.vat) p.gen) (conk(sut q.vat) p.gen)])
::
{$tune *}
2017-04-17 01:37:40 +03:00
[(face p.gen sut) (face p.gen dox)]
2016-11-24 07:25:07 +03:00
::
2017-09-20 02:24:30 +03:00
{$ktwt *}
2017-09-20 08:32:08 +03:00
=+(vat=$(gen p.gen) [(wrap(sut p.vat) %lead) (wrap(sut q.vat) %lead)])
2018-03-27 02:55:02 +03:00
::
{$form *}
=+ vat=$(gen q.gen)
[(form [sut p.gen] p.vat) (form [dox p.gen] q.vat)]
2016-11-24 07:25:07 +03:00
::
2017-09-20 02:24:30 +03:00
{$ktsg *} $(gen p.gen)
2017-09-20 09:13:11 +03:00
{$sgzp *} ~_(duck(sut (play p.gen)) $(gen q.gen))
{$sggr *} $(gen q.gen)
2017-09-20 23:15:30 +03:00
{$tsgr *}
2016-11-24 07:25:07 +03:00
=+ lem=$(gen p.gen, gol %noun)
$(gen q.gen, sut p.lem, dox q.lem)
::
2017-09-20 23:15:30 +03:00
{$tstr *}
2016-11-24 07:25:07 +03:00
%= $
gen r.gen
sut (buss p.gen q.gen)
dox (buss(sut dox) p.gen q.gen)
==
::
2017-09-21 00:43:14 +03:00
{$wtcl *}
2016-11-24 07:25:07 +03:00
=+ nor=$(gen p.gen, gol bool)
2017-11-16 23:44:27 +03:00
=+ ^= hiq ^- {p/type q/type}
2016-11-24 07:25:07 +03:00
=+ fex=[p=(gain p.gen) q=(gain(sut dox) p.gen)]
?: =(%void p.fex)
:- %void
?: =(%void q.fex)
%void
2016-11-24 07:25:07 +03:00
~>(%mean.[%leaf "if-z"] (play(sut q.fex) q.gen))
?: =(%void q.fex)
~>(%mean.[%leaf "mull-bonk-b"] !!)
$(sut p.fex, dox q.fex, gen q.gen)
2017-11-16 23:44:27 +03:00
=+ ^= ran ^- {p/type q/type}
2016-11-24 07:25:07 +03:00
=+ wux=[p=(lose p.gen) q=(lose(sut dox) p.gen)]
?: =(%void p.wux)
:- %void
?: =(%void q.wux)
%void
2016-11-24 07:25:07 +03:00
~>(%mean.[%leaf "if-a"] (play(sut q.wux) r.gen))
?: =(%void q.wux)
~>(%mean.[%leaf "mull-bonk-c"] !!)
$(sut p.wux, dox q.wux, gen r.gen)
[(nice (fork p.hiq p.ran ~)) (fork q.hiq q.ran ~)]
::
2018-03-12 08:29:13 +03:00
{$fits *}
=+ waz=[p=(play p.gen) q=(play(sut dox) p.gen)]
2016-11-24 07:25:07 +03:00
=+ ^= syx :- p=(cove q:(mint %noun [%wing q.gen]))
q=(cove q:(mint(sut dox) %noun [%wing q.gen]))
=+ pov=[p=(fish(sut p.waz) p.syx) q=(fish(sut q.waz) q.syx)]
?. &(=(p.syx q.syx) =(p.pov q.pov))
~>(%mean.[%leaf "mull-bonk-a"] !!)
(beth bool)
::
{$dbug *} ~_((show %o p.gen) $(gen q.gen))
2017-09-21 02:12:03 +03:00
{$zpcm *} [(nice (play p.gen)) (play(sut dox) p.gen)]
2016-11-24 07:25:07 +03:00
{$lost *}
?: vet
:: ~_ (dunk(sut (play p.gen)) 'also')
~>(%mean.[%leaf "mull-skip"] !!)
(beth %void)
::
2017-09-21 02:12:03 +03:00
{$zpts *} (beth %noun)
2018-03-14 06:17:30 +03:00
::
{$zpmc *}
2018-03-27 02:55:02 +03:00
=+ vos=$(gol %noun, gen q.gen) :: XX validate!
2016-11-24 07:25:07 +03:00
[(nice (cell (play p.gen) p.vos)) (cell (play(sut dox) p.gen) q.vos)]
::
2018-03-27 02:55:02 +03:00
{$zpvt *}
=+ [(feel p.gen) (feel(sut dox) p.gen)]
?. =(-< ->)
~>(%mean.[%leaf "mull-bonk-f"] !!)
?: -<
$(gen q.gen)
$(gen r.gen)
2016-11-24 07:25:07 +03:00
::
2017-09-21 03:54:04 +03:00
{$zpzp *} (beth %void)
2016-11-24 07:25:07 +03:00
*
=+ doz=~(open ap gen)
?: =(doz gen)
~_ (show [%c 'hoon'] [%q gen])
~>(%mean.[%leaf "mull-open"] !!)
$(gen doz)
==
::
++ beth
2017-11-16 23:44:27 +03:00
|= typ/type
2016-11-24 07:25:07 +03:00
[(nice typ) typ]
::
++ nice
2017-11-16 23:44:27 +03:00
|= typ/type
2016-11-24 07:25:07 +03:00
:: ~_ (dunk(sut gol) 'need')
:: ~_ (dunk(sut typ) 'have')
~_ leaf+"mull-nice"
?> ?|(!vet (nest(sut gol) & typ))
typ
::
++ grow
2017-11-17 00:50:03 +03:00
|= {mel/vair ruf/hoon wad/chap dom/(map @ tomb)}
2018-02-19 04:52:25 +03:00
:: make al
2016-11-24 07:25:07 +03:00
~_ leaf+"mull-grow"
2017-11-16 23:44:27 +03:00
^- {p/type q/type}
2016-11-24 07:25:07 +03:00
=+ dan=^$(gen ruf, gol %noun)
=+ yaz=(mile(sut p.dan) q.dan mel wad dom)
[(nice p.yaz) q.yaz]
2016-11-24 07:25:07 +03:00
--
2017-11-16 23:44:27 +03:00
++ meet |=(ref/type &((nest | ref) (nest(sut ref) | sut)))
2017-09-07 01:17:37 +03:00
:: ::
2017-09-09 20:50:22 +03:00
++ miss :: nonintersection
2017-11-16 23:44:27 +03:00
|= $: :: ref: symmetric type
2017-09-07 01:17:37 +03:00
::
2017-11-16 23:44:27 +03:00
ref/type
2017-09-07 01:17:37 +03:00
==
:: intersection of sut and ref is empty
::
^- ?
2017-11-16 23:44:27 +03:00
=| gil/(set (set type))
2017-09-07 01:17:37 +03:00
=< dext
|%
++ dext
^- ?
::
?: =(ref sut)
(nest(sut %void) | sut)
?- sut
$void &
$noun (nest(sut %void) | ref)
{$atom *} sint
{$cell *} sint
{$core *} sint(sut [%cell %noun %noun])
{$fork *} %+ levy ~(tap in p.sut)
2017-11-16 23:44:27 +03:00
|=(type dext(sut +<))
2017-09-07 01:17:37 +03:00
{$face *} dext(sut q.sut)
2018-03-27 02:55:02 +03:00
{$form *} dext(sut q.sut)
2017-11-16 23:44:27 +03:00
{$hold *} =+ (~(gas in *(set type)) `(list type)`[sut ref ~])
2017-09-07 01:17:37 +03:00
?: (~(has in gil) -)
&
%= dext
sut repo
gil (~(put in gil) -)
== ==
++ sint
?+ ref dext(sut ref, ref sut)
{$atom *} ?. ?=({$atom *} sut) &
?& ?=(^ q.ref)
?=(^ q.sut)
!=(q.ref q.sut)
==
{$cell *} ?. ?=({$cell *} sut) &
?| dext(sut p.sut, ref p.ref)
dext(sut q.sut, ref q.ref)
== ==
--
2017-11-16 23:44:27 +03:00
++ mite |=(ref/type |((nest | ref) (nest(sut ref) & sut)))
2016-11-24 07:25:07 +03:00
++ nest
~/ %nest
2017-11-16 23:44:27 +03:00
|= {tel/? ref/type}
=| $: seg/(set type) :: degenerate sut
reg/(set type) :: degenerate ref
gil/(set {p/type q/type}) :: assume nest
2016-11-24 07:25:07 +03:00
==
=< dext
|%
++ deem
|= {mel/vair ram/vair}
^- ?
2017-09-20 08:32:08 +03:00
?. |(=(mel ram) =(%lead mel) =(%gold ram)) |
?: ?=($lead mel) &
2016-11-24 07:25:07 +03:00
?: ?=($gold mel) meet
2017-09-20 08:32:08 +03:00
=+ vay=?-(mel $iron %rite, $zinc %read)
2016-11-24 07:25:07 +03:00
dext(sut (peek vay 2), ref (peek(sut ref) vay 2))
::
++ deep
2017-04-17 01:37:40 +03:00
|= $: dom/(map @ tomb)
vim/(map @ tomb)
==
2016-11-24 07:25:07 +03:00
^- ?
?: ?=(~ dom) =(vim ~)
?: ?=(~ vim) |
2017-04-17 01:37:40 +03:00
?& =(p.n.dom p.n.vim)
$(dom l.dom, vim l.vim)
$(dom r.dom, vim r.vim)
::
=+ [dab hem]=[q.q.n.dom q.q.n.vim]
|- ^- ?
?: ?=(~ dab) =(hem ~)
?: ?=(~ hem) |
2017-04-17 01:37:40 +03:00
?& =(p.n.dab p.n.hem)
$(dab l.dab, hem l.hem)
$(dab r.dab, hem r.hem)
?- -.q.q.n.dab
$elm =(q.q.n.dab q.q.n.hem)
$ash ?& ?=($ash -.q.q.n.hem)
%= dext
sut (play p.q.q.n.dab)
ref (play(sut ref) p.q.q.n.hem)
== == == == ==
2016-11-24 07:25:07 +03:00
::
++ dext
^- ?
=- ?: - &
?. tel |
:: ~_ (dunk %need)
2016-11-24 07:25:07 +03:00
:: ~_ (dunk(sut ref) %have)
~>(%mean.[%leaf "nest-fail"] !!)
?: =(sut ref) &
?- sut
$void sint
$noun &
{$atom *} ?. ?=({$atom *} ref) sint
?& (fitz p.sut p.ref)
|(?=(~ q.sut) =(q.sut q.ref))
2016-11-24 07:25:07 +03:00
==
{$cell *} ?. ?=({$cell *} ref) sint
?& dext(sut p.sut, ref p.ref, seg ~, reg ~)
dext(sut q.sut, ref q.ref, seg ~, reg ~)
==
{$core *} ?. ?=({$core *} ref) sint
?: =(q.sut q.ref) dext(sut p.sut, ref p.ref)
?& meet(sut q.q.sut, ref p.sut)
dext(sut q.q.ref, ref p.ref)
(deem(sut q.q.sut, ref q.q.ref) p.q.sut p.q.ref)
?| (~(has in gil) [sut ref])
%. [q.s.q.sut q.s.q.ref]
2016-11-24 07:25:07 +03:00
%= deep
gil (~(put in gil) [sut ref])
sut sut(p q.q.sut, p.q %gold)
ref ref(p q.q.ref, p.q %gold)
== ==
==
{$face *} dext(sut q.sut)
{$fork *} ?. ?=(?({$atom *} $noun {$cell *} {$core *}) ref) sint
2017-11-16 23:44:27 +03:00
(lien ~(tap in p.sut) |=(type dext(tel |, sut +<)))
2018-03-27 02:55:02 +03:00
{$form *} dext(sut q.sut)
2016-11-24 07:25:07 +03:00
{$hold *} ?: (~(has in seg) sut) |
?: (~(has in gil) [sut ref]) &
%= dext
sut repo
2016-11-24 07:25:07 +03:00
seg (~(put in seg) sut)
gil (~(put in gil) [sut ref])
== ==
::
++ meet &(dext dext(sut ref, ref sut))
++ sint
^- ?
?- ref
$noun |
$void &
{$atom *} |
{$cell *} |
{$core *} dext(ref repo(sut ref))
{$face *} dext(ref q.ref)
2017-11-16 23:44:27 +03:00
{$fork *} (levy ~(tap in p.ref) |=(type sint(ref +<)))
2018-03-27 02:55:02 +03:00
{$form *} dext(ref q.ref)
2016-11-24 07:25:07 +03:00
{$hold *} ?: (~(has in reg) ref) &
?: (~(has in gil) [sut ref]) &
%= dext
ref repo(sut ref)
reg (~(put in reg) ref)
gil (~(put in gil) [sut ref])
== ==
--
::
++ peek
~/ %peek
|= {way/?($read $rite $both $free) axe/axis}
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
?: =(1 axe)
sut
=+ [now=(cap axe) lat=(mas axe)]
2017-11-16 23:44:27 +03:00
=+ gil=*(set type)
|- ^- type
2016-11-24 07:25:07 +03:00
?- sut
{$atom *} %void
{$cell *} ?:(=(2 now) ^$(sut p.sut, axe lat) ^$(sut q.sut, axe lat))
{$core *}
?. =(3 now) %noun
=+ pec=(peel way p.q.sut)
%= ^$
axe lat
sut
?: =([& &] pec) p.sut
%+ cell
?.(sam.pec %noun ^$(sut p.sut, axe 2))
?.(con.pec %noun ^$(sut p.sut, axe 3))
==
::
2017-11-16 23:44:27 +03:00
{$fork *} (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
2016-11-24 07:25:07 +03:00
{$hold *}
?: (~(has in gil) sut)
%void
$(gil (~(put in gil) sut), sut repo)
::
$void %void
$noun %noun
* $(sut repo)
==
::
++ peel
2017-09-20 08:32:08 +03:00
|= {way/vial met/?($gold $iron $lead $zinc)}
2016-11-24 07:25:07 +03:00
^- {sam/? con/?}
?: ?=($gold met) [& &]
?- way
$both [| |]
$free [& &]
2017-09-20 08:32:08 +03:00
$read [?=($zinc met) |]
$rite [?=($iron met) |]
2016-11-24 07:25:07 +03:00
==
::
++ play
~/ %play
=> .(vet |)
2017-11-17 00:50:03 +03:00
|= gen/hoon
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
?- gen
{^ *} (cell $(gen p.gen) $(gen q.gen))
2017-09-20 02:24:30 +03:00
{$ktcn *} $(fab |, gen p.gen)
2018-02-20 04:27:23 +03:00
{$brcn *} (core sut %gold sut p.gen *seminoun q.gen)
2017-09-19 03:19:22 +03:00
{$cnts *} ~(play et p.gen q.gen)
2018-03-14 06:17:30 +03:00
{$dtkt *} $(gen [%bcdt p.gen])
2017-09-19 23:37:15 +03:00
{$dtls *} [%atom %$ ~]
2017-11-16 23:44:27 +03:00
{$rock *} |- ^- type
2016-11-24 07:25:07 +03:00
?@ q.gen [%atom p.gen `q.gen]
[%cell $(q.gen -.q.gen) $(q.gen +.q.gen)]
2017-11-16 23:44:27 +03:00
{$sand *} |- ^- type
2016-11-24 07:25:07 +03:00
?@ q.gen
?: =(%n p.gen) ?>(=(0 q.gen) [%atom p.gen ~ q.gen])
?:(=(%f p.gen) ?>((lte q.gen 1) bool) [%atom p.gen ~])
[%cell $(q.gen -.q.gen) $(q.gen +.q.gen)]
2017-04-17 01:37:40 +03:00
{$tune *} (face p.gen sut)
2017-09-19 23:37:15 +03:00
{$dttr *} %noun
{$dtts *} bool
{$dtwt *} bool
2016-11-24 07:25:07 +03:00
{$hand *} p.gen
2017-09-20 08:32:08 +03:00
{$ktbr *} (wrap(sut $(gen p.gen)) %iron)
2017-09-20 02:24:30 +03:00
{$ktls *} $(gen p.gen)
2018-03-14 06:17:30 +03:00
{$ktpd *} (wrap(sut $(gen p.gen)) %zinc)
2017-09-20 02:24:30 +03:00
{$ktsg *} $(gen p.gen)
{$ktts *} (conk(sut $(gen q.gen)) p.gen)
2017-09-20 08:32:08 +03:00
{$ktwt *} (wrap(sut $(gen p.gen)) %lead)
2018-03-27 02:55:02 +03:00
{$form *} (form [sut p.gen] $(gen q.gen))
2017-09-20 09:13:11 +03:00
{$sgzp *} ~_(duck(sut ^$(gen p.gen)) $(gen q.gen))
{$sggr *} $(gen q.gen)
2017-09-20 23:15:30 +03:00
{$tsgr *} $(gen q.gen, sut $(gen p.gen))
{$tstr *} $(gen r.gen, sut (buss p.gen q.gen))
2017-09-21 00:43:14 +03:00
{$wtcl *} =+ [fex=(gain p.gen) wux=(lose p.gen)]
2016-11-24 07:25:07 +03:00
%- fork :~
?:(=(%void fex) %void $(sut fex, gen q.gen))
?:(=(%void wux) %void $(sut wux, gen r.gen))
==
2018-03-12 08:29:13 +03:00
{$fits *} bool
2016-11-24 07:25:07 +03:00
{$dbug *} ~_((show %o p.gen) $(gen q.gen))
2017-09-21 02:12:03 +03:00
{$zpcm *} (play p.gen)
2016-11-24 07:25:07 +03:00
{$lost *} %void
2018-03-14 06:17:30 +03:00
{$zpmc *} (cell $(gen p.gen) $(gen q.gen))
2017-09-21 02:12:03 +03:00
{$zpts *} %noun
2018-03-27 02:55:02 +03:00
{$zpvt *} ?:((feel p.gen) $(gen q.gen) $(gen r.gen))
2017-09-21 03:54:04 +03:00
{$zpzp *} %void
2016-11-24 07:25:07 +03:00
* =+ doz=~(open ap gen)
?: =(doz gen)
~_ (show [%c 'hoon'] [%q gen])
~>(%mean.[%leaf "play-open"] !!)
$(gen doz)
==
2017-09-07 01:17:37 +03:00
:: ::
2017-09-09 20:50:22 +03:00
++ redo :: refurbish faces
2017-09-07 01:17:37 +03:00
|= $: :: ref: raw payload
::
2017-11-16 23:44:27 +03:00
ref/type
2017-09-07 01:17:37 +03:00
==
2017-11-16 23:44:27 +03:00
:: :type: subject refurbished to reference namespace
2017-09-07 01:17:37 +03:00
::
2017-11-16 23:44:27 +03:00
^- type
2017-09-07 01:17:37 +03:00
:: hos: subject tool stack
:: wec: reference tool stack set
:: gil: repetition set
::
=| hos/(list tool)
=/ wec/(set (list tool)) [~ ~ ~]
2017-11-16 23:44:27 +03:00
=| gil/(set (pair type type))
2017-09-07 01:17:37 +03:00
=< :: errors imply subject/reference mismatch
::
~| %redo-match
:: reduce by subject
::
dext
|%
:: ::
++ dear :: resolve tool stack
:: :(unit (list tool)): unified tool stack
::
^- (unit (list tool))
:: empty implies void
::
?~ wec `~
:: any reference faces must be clear
::
?. ?=({* ~ ~} wec)
2017-09-07 01:17:37 +03:00
~& [%dear-many wec]
~
:- ~
:: har: single reference tool stack
::
=/ har n.wec
:: len: lengths of [sut ref] face stacks
::
=/ len [p q]=[(lent hos) (lent har)]
:: lip: length of sut-ref face stack overlap
::
:: AB
:: BC
::
:: +lip is (lent B), where +hay is forward AB
:: and +liv is forward BC (stack BA and CB).
::
:: overlap is a weird corner case. +lip is
:: almost always 0. brute force is fine.
::
=/ lip
=| lup/(unit @ud)
=| lip/@ud
|- ^- @ud
?: |((gth lip p.len) (gth lip q.len))
(fall lup 0)
:: lep: overlap candidate: suffix of subject face stack
::
=/ lep (slag (sub p.len lip) hos)
:: lap: overlap candidate: prefix of reference face stack
::
=/ lap (scag lip har)
:: save any match and continue
::
$(lip +(lip), lup ?.(=(lep lap) lup `lip))
:: ~& [har+har hos+hos len+len lip+lip]
:: produce combined face stack (forward ABC, stack CBA)
::
(weld hos (slag lip har))
:: ::
++ dext :: subject traverse
2017-11-16 23:44:27 +03:00
:: :type: refurbished subject
2017-09-07 01:17:37 +03:00
::
2017-11-16 23:44:27 +03:00
^- type
2017-09-07 01:17:37 +03:00
:: check for trivial cases
::
?: ?| =(sut ref)
?=(?($noun $void {?($atom $core) *}) ref)
==
done
2017-10-26 00:20:43 +03:00
:: ~_ (dunk 'redo: dext: sut')
:: ~_ (dunk(sut ref) 'redo: dext: ref')
2017-09-07 01:17:37 +03:00
?- sut
?($noun $void {?($atom $core) *})
:: reduce reference and reassemble leaf
::
done:(sint &)
::
{$cell *}
:: reduce reference to match subject
::
=> (sint &)
?> ?=({$cell *} sut)
:: leaf with possible recursive descent
::
%= done
sut
:: clear face stacks for descent
::
=: hos ~
wec [~ ~ ~]
==
:: descend into cell
::
:+ %cell
dext(sut p.sut, ref (peek(sut ref) %free 2))
dext(sut q.sut, ref (peek(sut ref) %free 3))
==
::
{$face *}
:: push face on subject stack, and descend
::
dext(hos [q.p.sut hos], sut q.sut)
2018-03-27 02:55:02 +03:00
::
{$form *}
:: work through form
::
[%form p.sut dext(sut q.sut)]
2017-09-07 01:17:37 +03:00
::
{$fork *}
:: reconstruct each case in fork
::
2017-11-16 23:44:27 +03:00
(fork (turn ~(tap in p.sut) |=(type dext(sut +<))))
2017-09-07 01:17:37 +03:00
::
{$hold *}
:: reduce to hard
::
=> (sint |)
?> ?=({$hold *} sut)
?: (~(has in fan) [p.sut q.sut])
:: repo loop; redo depends on its own product
::
done:(sint &)
?: (~(has in gil) [sut ref])
:: type recursion, stop renaming
::
done:(sint |)
:: restore unchanged holds
::
=+ repo
=- ?:(=(- +<) sut -)
dext(sut -, gil (~(put in gil) sut ref))
==
:: ::
++ done :: complete assembly
2017-11-16 23:44:27 +03:00
^- type
:: :type: subject refurbished
2017-09-07 01:17:37 +03:00
::
:: lov: combined face stack
::
=/ lov
=/ lov dear
?~ lov
2017-10-26 00:20:43 +03:00
:: ~_ (dunk 'redo: dear: sut')
:: ~_ (dunk(sut ref) 'redo: dear: ref')
2017-09-07 01:17:37 +03:00
~& [%wec wec]
!!
(need lov)
:: recompose faces
::
2017-11-16 23:44:27 +03:00
|- ^- type
2017-09-07 01:17:37 +03:00
?~ lov sut
$(lov t.lov, sut (face [~ i.lov] sut))
:: ::
++ sint :: reduce by reference
|= $: :: hod: expand holds
::
hod/?
==
:: ::.: reference with face/fork/hold reduced
::
^+ .
:: =- ~> %slog.[0 (dunk 'sint: sut')]
:: ~> %slog.[0 (dunk(sut ref) 'sint: ref')]
:: ~> %slog.[0 (dunk(sut =>(- ref)) 'sint: pro')]
:: -
?+ ref .
2018-03-27 02:55:02 +03:00
{$form *} $(ref q.ref)
2017-09-07 01:17:37 +03:00
{$face *}
:: extend all stacks in set
::
%= $
ref q.ref
wec (~(run in wec) |=((list tool) [q.p.ref +<]))
==
::
{$fork *}
:: reconstruct all relevant cases
::
=- :: ~> %slog.[0 (dunk 'fork: sut')]
:: ~> %slog.[0 (dunk(sut ref) 'fork: ref')]
:: ~> %slog.[0 (dunk(sut (fork ->)) 'fork: pro')]
+(wec -<, ref (fork ->))
=/ moy ~(tap in p.ref)
2017-11-16 23:44:27 +03:00
|- ^- (pair (set (list tool)) (list type))
2017-09-07 01:17:37 +03:00
?~ moy [~ ~]
:: head recurse
::
=/ mor $(moy t.moy)
:: prune reference cases outside subject
::
?: (miss i.moy) mor
:: unify all cases
::
=/ dis ^$(ref i.moy)
[(~(uni in p.mor) wec.dis) [ref.dis q.mor]]
::
{$hold *}
?. hod .
$(ref repo(sut ref))
==
--
2016-11-24 07:25:07 +03:00
::
++ repo
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
?- sut
{$core *} [%cell %noun p.sut]
{$face *} q.sut
2018-03-27 02:55:02 +03:00
{$form *} q.sut
2016-11-24 07:25:07 +03:00
{$hold *} (rest [[p.sut q.sut] ~])
$noun (fork [%atom %$ ~] [%cell %noun %noun] ~)
* ~>(%mean.[%leaf "repo-fltt"] !!)
==
::
++ rest
~/ %rest
2017-11-17 00:50:03 +03:00
|= leg/(list {p/type q/hoon})
2017-11-16 23:44:27 +03:00
^- type
2017-11-17 00:50:03 +03:00
?: (lien leg |=({p/type q/hoon} (~(has in fan) [p q])))
2016-11-24 07:25:07 +03:00
~>(%mean.[%leaf "rest-loop"] !!)
=> .(fan (~(gas in fan) leg))
%- fork
%~ tap in
2017-11-16 23:44:27 +03:00
%- ~(gas in *(set type))
2017-11-17 00:50:03 +03:00
(turn leg |=({p/type q/hoon} (play(sut p) q)))
==
2016-11-24 07:25:07 +03:00
::
++ take
2017-12-14 05:44:18 +03:00
|= {vit/vein duz/$-(type type)}
2017-11-16 23:44:27 +03:00
^- (pair axis type)
2016-11-24 07:25:07 +03:00
:- (tend vit)
=. vit (flop vit)
2017-11-16 23:44:27 +03:00
|- ^- type
2016-11-24 07:25:07 +03:00
?~ vit (duz sut)
?~ i.vit
2017-11-16 23:44:27 +03:00
|- ^- type
2016-11-24 07:25:07 +03:00
?+ sut ^$(vit t.vit)
{$face *} (face p.sut ^$(vit t.vit, sut q.sut))
2017-11-16 23:44:27 +03:00
{$fork *} (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
{$hold *} $(sut repo)
2016-11-24 07:25:07 +03:00
==
2017-11-16 23:44:27 +03:00
=+ vil=*(set type)
|- ^- type
2016-11-24 07:25:07 +03:00
?: =(1 u.i.vit)
^$(vit t.vit)
=+ [now lat]=(cap u.i.vit)^(mas u.i.vit)
?- sut
$noun $(sut [%cell %noun %noun])
$void %void
{$atom *} %void
{$cell *} ?: =(2 now)
(cell $(sut p.sut, u.i.vit lat) q.sut)
(cell p.sut $(sut q.sut, u.i.vit lat))
{$core *} ?: =(2 now)
$(sut repo)
(core $(sut p.sut, u.i.vit lat) q.sut)
{$face *} (face p.sut $(sut q.sut))
2017-11-16 23:44:27 +03:00
{$fork *} (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
2018-03-27 02:55:02 +03:00
{$form *} (form p.sut $(sut q.sut))
2016-11-24 07:25:07 +03:00
{$hold *} ?: (~(has in vil) sut)
%void
$(sut repo, vil (~(put in vil) sut))
==
::
++ tack
2017-11-16 23:44:27 +03:00
|= {hyp/wing mur/type}
2016-11-24 07:25:07 +03:00
~_ (show [%c %tack] %l hyp)
=+ fid=(find %rite hyp)
2018-03-19 06:54:47 +03:00
?> ?=(%& -.fid)
2017-11-16 23:44:27 +03:00
(take p.p.fid |=(type mur))
2016-11-24 07:25:07 +03:00
::
++ tend
|= vit/vein
^- axis
?~(vit 1 (peg $(vit t.vit) ?~(i.vit 1 u.i.vit)))
::
++ toss
~/ %toss
2017-11-16 23:44:27 +03:00
|= {hyp/wing mur/type men/(list {p/type q/foot})}
^- {p/axis q/(list {p/type q/foot})}
2016-11-24 07:25:07 +03:00
=- [(need p.wib) q.wib]
^= wib
2017-11-16 23:44:27 +03:00
|- ^- {p/(unit axis) q/(list {p/type q/foot})}
2016-11-24 07:25:07 +03:00
?~ men
[*(unit axis) ~]
=+ geq=(tack(sut p.i.men) hyp mur)
=+ mox=$(men t.men)
[(mate p.mox `_p.mox`[~ p.geq]) [[q.geq q.i.men] q.mox]]
::
++ wrap
~/ %wrap
2017-09-20 08:32:08 +03:00
|= yoz/?($lead $iron $zinc)
2016-11-24 07:25:07 +03:00
~_ leaf+"wrap"
2017-11-16 23:44:27 +03:00
^- type
2016-11-24 07:25:07 +03:00
?+ sut sut
{$cell *} (cell $(sut p.sut) $(sut q.sut))
2017-09-20 08:32:08 +03:00
{$core *} ?>(|(=(%gold p.q.sut) =(%lead yoz)) sut(p.q yoz))
2016-11-24 07:25:07 +03:00
{$face *} (face p.sut $(sut q.sut))
2017-11-16 23:44:27 +03:00
{$fork *} (fork (turn ~(tap in p.sut) |=(type ^$(sut +<))))
2018-03-27 02:55:02 +03:00
{$form *} (form p.sut $(sut q.sut))
2016-11-24 07:25:07 +03:00
{$hold *} $(sut repo)
==
--
++ us :: prettyprinter
=> |%
++ cape {p/(map @ud wine) q/wine} ::
++ wine ::
$@ $? $noun ::
$path ::
2017-11-16 23:44:27 +03:00
$type ::
2016-11-24 07:25:07 +03:00
$void ::
$wall ::
$wool ::
$yarn ::
== ::
$% {$mato p/term} ::
{$core p/(list @ta) q/wine} ::
{$face p/term q/wine} ::
{$list p/term q/wine} ::
{$pear p/term q/@} ::
2017-09-18 02:31:49 +03:00
{$bcwt p/(list wine)} ::
2016-11-24 07:25:07 +03:00
{$plot p/(list wine)} ::
{$stop p/@ud} ::
{$tree p/term q/wine} ::
{$unit p/term q/wine} ::
== ::
--
2017-11-16 23:44:27 +03:00
|_ sut/type
2016-11-24 07:25:07 +03:00
++ dash
|= {mil/tape lim/char} ^- tape
:- lim
|- ^- tape
?~ mil [lim ~]
?: =(lim i.mil) ['\\' i.mil $(mil t.mil)]
?: =('\\' i.mil) ['\\' i.mil $(mil t.mil)]
?: (lte ' ' i.mil) [i.mil $(mil t.mil)]
['\\' ~(x ne (rsh 2 1 i.mil)) ~(x ne (end 2 1 i.mil)) $(mil t.mil)]
::
++ deal |=(lum/* (dish dole lum))
++ dial
|= ham/cape
=+ gid=*(set @ud)
=< `tank`-:$
|%
2016-11-24 07:25:07 +03:00
++ many
|= haz/(list wine)
^- {(list tank) (set @ud)}
?~ haz [~ gid]
=^ mor gid $(haz t.haz)
=^ dis gid ^$(q.ham i.haz)
[[dis mor] gid]
::
++ $
^- {tank (set @ud)}
?- q.ham
$noun :_(gid [%leaf '*' ~])
$path :_(gid [%leaf '/' ~])
2017-11-16 23:44:27 +03:00
$type :_(gid [%leaf '#' 't' ~])
2016-11-24 07:25:07 +03:00
$void :_(gid [%leaf '#' '!' ~])
$wool :_(gid [%leaf '*' '"' '"' ~])
$wall :_(gid [%leaf '*' '\'' '\'' ~])
$yarn :_(gid [%leaf '"' '"' ~])
{$mato *} :_(gid [%leaf '@' (trip p.q.ham)])
{$core *}
=^ cox gid $(q.ham q.q.ham)
:_ gid
:+ %rose
[[' ' ~] ['<' ~] ['>' ~]]
|- ^- (list tank)
?~ p.q.ham [cox ~]
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
::
{$face *}
=^ cox gid $(q.ham q.q.ham)
:_(gid [%palm [['/' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
::
{$list *}
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
2017-09-18 02:31:49 +03:00
{$bcwt *}
2016-11-24 07:25:07 +03:00
=^ coz gid (many p.q.ham)
:_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
::
{$plot *}
=^ coz gid (many p.q.ham)
:_(gid [%rose [[' ' ~] ['{' ~] ['}' ~]] coz])
::
{$pear *}
:_(gid [%leaf '$' ~(rend co [%$ p.q.ham q.q.ham])])
::
{$stop *}
=+ num=~(rend co [%$ %ud p.q.ham])
?: (~(has in gid) p.q.ham)
:_(gid [%leaf '#' num])
=^ cox gid
%= $
gid (~(put in gid) p.q.ham)
q.ham (~(got by p.ham) p.q.ham)
==
:_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
::
{$tree *}
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
{$unit *}
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
==
--
::
++ dish
|= {ham/cape lum/*} ^- tank
~| [%dish-h ?@(q.ham q.ham -.q.ham)]
~| [%lump lum]
~| [%ham ham]
%- need
=| gil/(set {@ud *})
|- ^- (unit tank)
?- q.ham
$noun
%= $
q.ham
?: ?=(@ lum)
[%mato %$]
:- %plot
|- ^- (list wine)
[%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
==
::
$path
:- ~
:+ %rose
[['/' ~] ['/' ~] ~]
|- ^- (list tank)
?~ lum ~
?@ lum !!
?> ?=(@ -.lum)
[[%leaf (rip 3 -.lum)] $(lum +.lum)]
::
2017-11-16 23:44:27 +03:00
$type
2016-11-24 07:25:07 +03:00
=+ tyr=|.((dial dole))
=+ vol=tyr(sut lum)
=+ cis=((hard tank) .*(vol -:vol))
:^ ~ %palm
[~ ~ ~ ~]
[[%leaf '#' 't' '/' ~] cis ~]
::
$wall
:- ~
:+ %rose
[[' ' ~] ['<' '|' ~] ['|' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[[%leaf (trip ((hard @) -.lum))] $(lum +.lum)]
::
$wool
:- ~
:+ %rose
[[' ' ~] ['<' '<' ~] ['>' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
::
$yarn
[~ %leaf (dash (tape lum) '"')]
::
$void
~
::
{$mato *}
?. ?=(@ lum)
~
:+ ~
%leaf
?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
~(rend co [%$ p.q.ham lum])
$$ ~(rend co [%$ %ud lum])
$t (dash (rip 3 lum) '\'')
$tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
==
::
{$core *}
:: XX needs rethinking for core metal
:: ?. ?=(^ lum) ~
:: => .(lum `*`lum)
:: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
:: ^= tok
:: |- ^- (unit (list tank))
:: ?~ p.q.ham
:: =+ den=^$(q.ham q.q.ham)
:: ?~(den ~ [~ u.den ~])
:: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
:: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
[~ (dial ham)]
::
{$face *}
=+ wal=$(q.ham q.q.ham)
?~ wal
~
[~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
::
{$list *}
?: =(~ lum)
[~ %leaf '~' ~]
=- ?~ tok
~
[~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?: ?=(@ lum)
?.(=(~ lum) ~ [~ ~])
=+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
?. &(?=(^ for) ?=(^ aft))
~
[~ u.for u.aft]
::
2017-09-18 02:31:49 +03:00
{$bcwt *}
2016-11-24 07:25:07 +03:00
|- ^- (unit tank)
?~ p.q.ham
~
=+ wal=^$(q.ham i.p.q.ham)
?~ wal
$(p.q.ham t.p.q.ham)
wal
::
{$plot *}
=- ?~ tok
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?~ p.q.ham
~
?: ?=({* ~} p.q.ham)
2016-11-24 07:25:07 +03:00
=+ wal=^$(q.ham i.p.q.ham)
?~(wal ~ [~ [u.wal ~]])
?@ lum
~
=+ gim=^$(q.ham i.p.q.ham, lum -.lum)
?~ gim
~
=+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
?~ myd
~
[~ u.gim u.myd]
::
{$pear *}
?. =(lum q.q.ham)
~
=. p.q.ham
(rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
=+ fox=$(q.ham [%mato p.q.ham])
?> ?=({~ $leaf ^} fox)
2016-11-24 07:25:07 +03:00
?: ?=(?($n $tas) p.q.ham)
fox
[~ %leaf '%' p.u.fox]
::
{$stop *}
?: (~(has in gil) [p.q.ham lum]) ~
=+ kep=(~(get by p.ham) p.q.ham)
?~ kep
~|([%stop-loss p.q.ham] !!)
$(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
::
{$tree *}
=- ?~ tok
~
[~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
^= tok
=+ tuk=*(list tank)
|- ^- (unit (list tank))
?: =(~ lum)
[~ tuk]
?. ?=({n/* l/* r/*} lum)
~
=+ rol=$(lum r.lum)
?~ rol
~
=+ tim=^$(q.ham q.q.ham, lum n.lum)
?~ tim
~
$(lum l.lum, tuk [u.tim u.rol])
::
{$unit *}
?@ lum
?.(=(~ lum) ~ [~ %leaf '~' ~])
?. =(~ -.lum)
~
=+ wal=$(q.ham q.q.ham, lum +.lum)
?~ wal
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
==
::
++ doge
|= ham/cape
=- ?+ woz woz
{$list * {$mato $'ta'}} %path
{$list * {$mato $'t'}} %wall
{$list * {$mato $'tD'}} %yarn
{$list * $yarn} %wool
==
^= woz
^- wine
?. ?=({$stop *} q.ham)
?: ?& ?= {$bcwt {$pear $n $0} {$plot {$pear $n $0} {$face *} ~} ~}
2016-11-24 07:25:07 +03:00
q.ham
=(1 (met 3 p.i.t.p.i.t.p.q.ham))
==
[%unit =<([p q] i.t.p.i.t.p.q.ham)]
q.ham
=+ may=(~(get by p.ham) p.q.ham)
?~ may
q.ham
=+ nul=[%pear %n 0]
2017-09-18 02:31:49 +03:00
?. ?& ?=({$bcwt *} u.may)
?=({* * ~} p.u.may)
2016-11-24 07:25:07 +03:00
|(=(nul i.p.u.may) =(nul i.t.p.u.may))
==
q.ham
=+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
?: ?& ?=({$plot {$face *} {$face * $stop *} ~} din)
2016-11-24 07:25:07 +03:00
=(p.q.ham p.q.i.t.p.din)
=(1 (met 3 p.i.p.din))
=(1 (met 3 p.i.t.p.din))
==
:+ %list
(cat 3 p.i.p.din p.i.t.p.din)
q.i.p.din
?: ?& ?= $: $plot
{$face *}
{$face * $stop *}
{{$face * $stop *} ~}
2016-11-24 07:25:07 +03:00
==
din
=(p.q.ham p.q.i.t.p.din)
=(p.q.ham p.q.i.t.t.p.din)
=(1 (met 3 p.i.p.din))
=(1 (met 3 p.i.t.p.din))
=(1 (met 3 p.i.t.t.p.din))
==
:+ %tree
%^ cat
3
p.i.p.din
(cat 3 p.i.t.p.din p.i.t.t.p.din)
q.i.p.din
q.ham
::
++ dole
^- cape
2017-11-16 23:44:27 +03:00
=+ gil=*(set type)
=+ dex=[p=*(map type @) q=*(map @ wine)]
2016-11-24 07:25:07 +03:00
=< [q.p q]
2017-11-16 23:44:27 +03:00
|- ^- {p/{p/(map type @) q/(map @ wine)} q/wine}
2016-11-24 07:25:07 +03:00
=- [p.tez (doge q.p.tez q.tez)]
^= tez
2017-11-16 23:44:27 +03:00
^- {p/{p/(map type @) q/(map @ wine)} q/wine}
?: (~(meet ut sut) -:!>(*type))
[dex %type]
2016-11-24 07:25:07 +03:00
?- sut
$noun [dex sut]
$void [dex sut]
{$atom *} [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
{$cell *}
=+ hin=$(sut p.sut)
=+ yon=$(dex p.hin, sut q.sut)
:- p.yon
:- %plot
?:(?=({$plot *} q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
::
{$core *}
=+ yad=$(sut p.sut)
:- p.yad
=+ ^= doy ^- {p/(list @ta) q/wine}
?: ?=({$core *} q.yad)
[p.q.yad q.q.yad]
[~ q.yad]
:- %core
:_ q.doy
:_ p.doy
%^ cat 3
%~ rent co
2016-11-24 07:25:07 +03:00
:+ %$ %ud
2017-10-24 00:52:06 +03:00
%- ~(rep by (~(run by q.s.q.sut) |=(tomb ~(wyt by q))))
|=([[@ a=@u] b=@u] (add a b))
==
2016-11-24 07:25:07 +03:00
%^ cat 3
2017-09-20 08:32:08 +03:00
?-(p.q.sut $gold '.', $iron '|', $lead '?', $zinc '&')
=+ gum=(mug q.s.q.sut)
2016-11-24 07:25:07 +03:00
%+ can 3
:~ [1 (add 'a' (mod gum 26))]
[1 (add 'a' (mod (div gum 26) 26))]
[1 (add 'a' (mod (div gum 676) 26))]
==
2018-03-27 02:55:02 +03:00
::
{$form *}
$(sut q.sut)
2016-11-24 07:25:07 +03:00
::
{$face *}
=+ yad=$(sut q.sut)
?^(q.p.sut yad [p.yad [%face q.p.sut q.yad]])
2016-11-24 07:25:07 +03:00
::
{$fork *}
=+ yed=~(tap in p.sut)
2017-09-18 02:31:49 +03:00
=- [p [%bcwt q]]
2017-11-16 23:44:27 +03:00
|- ^- {p/{p/(map type @) q/(map @ wine)} q/(list wine)}
2016-11-24 07:25:07 +03:00
?~ yed
[dex ~]
=+ mor=$(yed t.yed)
=+ dis=^$(dex p.mor, sut i.yed)
[p.dis q.dis q.mor]
::
{$hold *}
=+ hey=(~(get by p.dex) sut)
?^ hey
[dex [%stop u.hey]]
?: (~(has in gil) sut)
=+ dyr=+(~(wyt by p.dex))
[[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
=+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
=+ rey=(~(get by p.p.rom) sut)
?~ rey
rom
[[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
==
::
++ duck (dial dole)
--
++ cain sell :: $-(vase tank)
2016-11-24 07:25:07 +03:00
++ noah text :: $-(vase tape)
++ onan seer :: $-(vise vase)
2016-11-24 07:25:07 +03:00
++ text :: tape pretty-print
|= vax/vase ^- tape
~(ram re (sell vax))
::
2017-11-16 23:44:27 +03:00
++ seem |=(toy/typo `type`toy) :: promote typo
2016-11-24 07:25:07 +03:00
++ seer |=(vix/vise `vase`vix) :: promote vise
++ sell :: tank pretty-print
|= vax/vase ^- tank
~| %sell
(~(deal us p.vax) q.vax)
::
2017-11-16 23:44:27 +03:00
++ skol :: $-(type tank) for ~!
|= typ/type ^- tank
2016-11-24 07:25:07 +03:00
~(duck ut typ)
::
++ slam :: slam a gate
|= {gat/vase sam/vase} ^- vase
2017-11-16 23:44:27 +03:00
=+ :- ^= typ ^- type
2016-11-24 07:25:07 +03:00
[%cell p.gat p.sam]
2017-11-17 00:50:03 +03:00
^= gen ^- hoon
2017-09-19 01:32:35 +03:00
[%cnsg [%$ ~] [%$ 2] [%$ 3] ~]
2016-11-24 07:25:07 +03:00
=+ gun=(~(mint ut typ) %noun gen)
[p.gun .*([q.gat q.sam] q.gun)]
::
++ slab :: test if contains
2017-11-16 23:44:27 +03:00
|= {cog/@tas typ/type}
2016-11-24 07:25:07 +03:00
=(& -:(~(find ut typ) %free [cog ~]))
::
++ slap
2017-11-17 00:50:03 +03:00
|= {vax/vase gen/hoon} ^- vase :: untyped vase .*
2016-11-24 07:25:07 +03:00
=+ gun=(~(mint ut p.vax) %noun gen)
[p.gun .*(q.vax q.gun)]
::
2017-12-10 05:44:54 +03:00
++ slog :: deify printf
=| pri/@ :: priority level
|= a/tang ^+ same :: .= ~&(%a 1)
?~(a same ~>(%slog.[pri i.a] $(a t.a))) :: ((slog ~[>%a<]) 1)
:: ::
++ mean :: crash with trace
|= a/tang
^+ !!
?~ a !!
~_(i.a $(a t.a))
::
2016-11-24 07:25:07 +03:00
++ slew :: get axis in vase
|= {axe/@ vax/vase} ^- (unit vase)
?. |- ^- ?
?: =(1 axe) &
?. ?=(^ q.vax) |
$(axe (mas axe), q.vax .*(q.vax [0 (cap axe)]))
~
`[(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])]
::
++ slim :: identical to seer?
|= old/vise ^- vase
old
::
2017-11-16 23:44:27 +03:00
++ slit :: type of slam
|= {gat/type sam/type}
2016-11-24 07:25:07 +03:00
?> (~(nest ut (~(peek ut gat) %free 6)) & sam)
2017-09-19 01:32:35 +03:00
(~(play ut [%cell gat sam]) [%cnsg [%$ ~] [%$ 2] [%$ 3] ~])
2016-11-24 07:25:07 +03:00
::
++ slob :: superficial arm
2017-11-16 23:44:27 +03:00
|= {cog/@tas typ/type}
2016-11-24 07:25:07 +03:00
^- ?
?+ typ |
2017-04-17 01:37:40 +03:00
{$hold *} $(typ ~(repo ut typ))
{$core *}
|- ^- ?
?~ q.s.q.typ |
?| (~(has by q.q.n.q.s.q.typ) cog)
$(q.s.q.typ l.q.s.q.typ)
$(q.s.q.typ r.q.s.q.typ)
2017-04-17 01:37:40 +03:00
==
2016-11-24 07:25:07 +03:00
==
::
++ sloe :: get arms in core
2017-11-16 23:44:27 +03:00
|= typ/type
2016-11-24 07:25:07 +03:00
^- (list term)
?+ typ ~
{$hold *} $(typ ~(repo ut typ))
{$core *}
2017-05-29 20:17:36 +03:00
%- zing
%+ turn ~(tap by q.s.q.typ)
|= {* b/tomb}
%+ turn ~(tap by q.b)
|= {a/term *}
a
2016-11-24 07:25:07 +03:00
==
::
++ slop :: cons two vases
|= {hed/vase tal/vase}
^- vase
[[%cell p.hed p.tal] [q.hed q.tal]]
::
++ slot :: got axis in vase
|= {axe/@ vax/vase} ^- vase
[(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])]
::
2017-11-16 23:44:27 +03:00
++ slym :: slam w+o sample-type
2016-11-24 07:25:07 +03:00
|= {gat/vase sam/*} ^- vase
(slap gat(+<.q sam) [%limb %$])
::
2018-03-29 21:03:14 +03:00
++ sped :: reconstruct type
2016-11-24 07:25:07 +03:00
|= vax/vase
^- vase
:_ q.vax
?@ q.vax (~(fuse ut p.vax) [%atom %$ ~])
?@ -.q.vax
^= typ
%- ~(play ut p.vax)
2017-09-21 00:13:10 +03:00
[%wtgr [%wtts [%leaf %tas -.q.vax] [%& 2]~] [%$ 1]]
2016-11-24 07:25:07 +03:00
(~(fuse ut p.vax) [%cell %noun %noun])
::
:::: 5d: parser
::
2017-09-09 02:47:31 +03:00
++ vang :: set ++vast params
|= {bug/? wer/path} :: bug: debug mode
%*(. vast bug bug, wer wer) :: wer: where we are
2016-11-24 07:25:07 +03:00
::
2017-11-02 01:44:05 +03:00
++ vast :: main parsing core
2017-04-17 01:37:40 +03:00
=+ [bug=`?`| wer=*path]
2016-11-24 07:25:07 +03:00
|%
2017-09-09 02:47:31 +03:00
++ gash %+ cook :: parse path
2016-11-24 07:25:07 +03:00
|= a/(list tyke) ^- tyke
?~(a ~ (weld i.a $(a t.a)))
2018-03-14 07:36:10 +03:00
(more net limp)
2017-09-09 02:47:31 +03:00
++ gasp ;~ pose :: parse =path= etc.
2016-11-24 07:25:07 +03:00
%+ cook
|=({a/tyke b/tyke c/tyke} :(weld a b c))
;~ plug
(cook |=(a/(list) (turn a |=(b/* ~))) (star tis))
2017-11-17 00:50:03 +03:00
(cook |=(a/hoon [[~ a] ~]) hasp)
2016-11-24 07:25:07 +03:00
(cook |=(a/(list) (turn a |=(b/* ~))) (star tis))
==
(cook |=(a/(list) (turn a |=(b/* ~))) (plus tis))
==
++ glam ~+((glue ace))
2017-09-09 02:47:31 +03:00
++ hasp ;~ pose :: path element
2018-03-14 07:36:10 +03:00
(ifix [lac rac] wide)
(stag %cncl (ifix [lit rit] (most ace wide)))
2017-11-16 23:44:27 +03:00
(stag %sand (stag %tas (cold %$ buc)))
2016-11-24 07:25:07 +03:00
(stag %sand (stag %t qut))
%+ cook
|=(a/coin [%sand ?:(?=({~ $tas *} a) %tas %ta) ~(rent co a)])
2016-11-24 07:25:07 +03:00
nuck:so
==
++ limp %+ cook
|= {a/(list) b/tyke}
?~ a b
$(a t.a, b [`[%sand %tas %$] b])
2018-03-14 07:36:10 +03:00
;~(plug (star net) gasp)
2016-11-24 07:25:07 +03:00
++ mota %+ cook
|=({a/tape b/tape} (rap 3 (weld a b)))
;~(plug (star low) (star hig))
2017-04-05 03:33:20 +03:00
++ glom
|= {wit/whit taw/whit}
^- whit
:* ?~(lab.wit lab.taw lab.wit)
?~(boy.wit boy.taw boy.wit)
(~(uni by def.wit) def.taw)
(~(uni in use.wit) use.taw)
==
++ docs
|%
2017-11-15 22:22:11 +03:00
::
2017-04-05 03:33:20 +03:00
:: above core
::
++ apex
;~ plug
2017-11-15 22:22:11 +03:00
=/ ron (punt (indo noel))
(punt (ifix [ron ron] (into head))) :: label
::
=/ ron (punt (indo null))
(ifix [ron ron] (punt body)) :: body
::
(cook malt (star fill)) :: definitions
(easy ~) :: defs used (none)
2017-04-05 03:33:20 +03:00
==
2017-11-15 22:22:11 +03:00
::
2017-04-05 03:33:20 +03:00
:: backward line
::
++ apse
;~ pose
2017-11-15 22:22:11 +03:00
%+ cook |=({a/term b/cord} %*(. *whit def (my [a b ~] ~)))
(exit fine)
::
%+ cook |=(a/cord %*(. *whit boy `[a ~]))
(exit line)
::
2017-04-05 03:33:20 +03:00
(easy *whit)
==
::
::
++ beer
2017-11-15 22:22:11 +03:00
|= $: lab/(unit term)
boy/(unit (pair cord (list sect)))
def/(list (pair (pair term cord) (list sect)))
2017-04-05 03:33:20 +03:00
==
^- whit
2017-11-15 22:22:11 +03:00
=; def [lab boy (malt def) ~]
(turn def |=({{a/term b/cord} c/(list sect)} [a [b c]]))
2017-04-05 03:33:20 +03:00
::
::
++ body
2017-11-15 22:22:11 +03:00
;~ pose
;~ plug :: can duplicate :>
(into ;~(pfix (punt ;~(plug null col gar step)) line))
(easy ~)
==
;~ plug
(into ;~(pfix step line))
(rant text)
2017-04-05 03:33:20 +03:00
==
==
::
2017-11-15 22:22:11 +03:00
++ text (pick line code) :: text line
++ line ;~(less ace (cook crip (star prn))) :: prose line
++ code ;~(pfix step step (cook crip (star prn))) :: code line
++ noel ;~(plug (punt ;~(pfix step hax)) null) :: header padding
++ head ;~(pfix hax step cen sym) :: header line
++ null (cold ~ (star ace)) :: blank line
++ fine :: definition line
;~ (glue ;~(plug col ace))
sym
(cook crip (star prn))
==
2017-04-05 03:33:20 +03:00
::
::
:: step: indent
2017-11-15 22:22:11 +03:00
:: into: :> and indent to end of line, consuming following space.
:: indo: :> to end of line, consuming following space.
:: exit: :< to end of line, not consuming following space.
2017-04-05 03:33:20 +03:00
::
2017-11-15 22:22:11 +03:00
++ step ;~(plug ace ace)
++ into |*(bod/rule (indo ;~(pfix step bod)))
2017-04-05 03:33:20 +03:00
::
2017-11-15 22:22:11 +03:00
++ indo
2017-04-05 03:33:20 +03:00
|* bod/rule
2017-11-15 22:22:11 +03:00
;~(pfix col gar ;~(sfix bod (just `@`10) (punt gap)))
2017-04-05 03:33:20 +03:00
::
++ exit
|* bod/rule
2017-11-15 22:22:11 +03:00
;~(pfix (star ace) col gal step bod)
2017-04-05 03:33:20 +03:00
::
:: fill: full definition
::
++ fill
%+ cook |=({{a/term b/cord} c/(list sect) (unit ~)} [a b c])
2017-11-15 22:22:11 +03:00
;~ plug
(into fine)
(rant ;~(pfix step text))
(punt (indo null))
2017-04-05 03:33:20 +03:00
==
::
:: rant: series of sections.
::
++ rant
|* sec/rule
%- star
;~ pfix
2017-11-15 22:22:11 +03:00
(indo null)
(plus (into sec))
2017-04-05 03:33:20 +03:00
==
--
2016-11-24 07:25:07 +03:00
::
2017-09-09 02:47:31 +03:00
++ plex :: reparse static path
2017-11-17 00:50:03 +03:00
|= gen/hoon ^- (unit path)
2017-09-09 02:47:31 +03:00
?: ?=({$dbug *} gen) :: unwrap $dbug
2016-11-24 07:25:07 +03:00
$(gen q.gen)
2017-12-02 06:02:46 +03:00
?. ?=({$clsg *} gen) ~ :: require :~ hoon
2017-09-09 02:47:31 +03:00
%+ reel p.gen :: build using elements
2017-11-21 03:13:05 +03:00
|= {a/hoon b/_`(unit path)`[~ u=/]} :: starting from just /
2016-11-24 07:25:07 +03:00
?~ b ~
?. ?=({$sand ?($ta $tas) @} a) ~ :: /foo constants
2016-11-24 07:25:07 +03:00
`[q.a u.b]
::
++ phax
|= ruw/(list (list woof))
2017-11-17 00:50:03 +03:00
=+ [yun=*(list hoon) cah=*(list @)]
2018-03-14 06:17:30 +03:00
=+ wod=|=({a/tape b/(list hoon)} ^+(b ?~(a b [[%mcnt %knit (flop a)] b])))
2016-11-24 07:25:07 +03:00
|- ^+ yun
?~ ruw
(flop (wod cah yun))
?~ i.ruw $(ruw t.ruw)
?@ i.i.ruw
$(i.ruw t.i.ruw, cah [i.i.ruw cah])
$(i.ruw t.i.ruw, cah ~, yun [p.i.i.ruw (wod cah yun)])
::
++ posh
|= {pre/(unit tyke) pof/(unit {p/@ud q/tyke})}
2017-11-17 00:50:03 +03:00
^- (unit (list hoon))
2016-11-24 07:25:07 +03:00
=- ?^(- - ~&(%posh-fail -))
=+ wom=(poof wer)
%+ biff
?~ pre `u=wom
%+ bind (poon wom u.pre)
2017-11-17 00:50:03 +03:00
|= moz/(list hoon)
2016-11-24 07:25:07 +03:00
?~(pof moz (weld moz (slag (lent u.pre) wom)))
2017-11-17 00:50:03 +03:00
|= yez/(list hoon)
2016-11-24 07:25:07 +03:00
?~ pof `yez
=+ zey=(flop yez)
=+ [moz=(scag p.u.pof zey) gul=(slag p.u.pof zey)]
=+ zom=(poon (flop moz) q.u.pof)
?~(zom ~ `(weld (flop gul) u.zom))
::
2017-12-02 06:02:46 +03:00
++ poof :: path -> (list hoon)
2017-11-21 03:13:05 +03:00
|=(pax/path ^-((list hoon) (turn pax |=(a/@ta [%sand %ta a]))))
2017-09-09 02:47:31 +03:00
::
:: tyke is =foo== as ~[~ `foo ~ ~]
:: interpolate '=' path components
++ poon :: try to replace '='s
2017-11-21 03:13:05 +03:00
|= {pag/(list hoon) goo/tyke} :: default to pag
^- (unit (list hoon)) :: for null goo's
2017-09-09 02:47:31 +03:00
?~ goo `~ :: keep empty goo
%+ both :: otherwise head comes
?^(i.goo i.goo ?~(pag ~ `u=i.pag)) :: from goo or pag
$(goo t.goo, pag ?~(pag ~ t.pag)) :: recurse on tails
2016-11-24 07:25:07 +03:00
::
++ poor
%+ sear posh
;~ plug
(stag ~ gash)
;~(pose (stag ~ ;~(pfix cen porc)) (easy ~))
==
::
++ porc
;~ plug
(cook |=(a/(list) (lent a)) (star cen))
2018-03-14 07:36:10 +03:00
;~(pfix net gash)
2016-11-24 07:25:07 +03:00
==
::
++ rump
%+ sear
2017-11-17 00:50:03 +03:00
|= {a/wing b/(unit hoon)} ^- (unit hoon)
?~(b [~ %wing a] ?.(?=({@ ~} a) ~ [~ [%rock %tas i.a] u.b]))
;~(plug rope ;~(pose (stag ~ wede) (easy ~)))
2016-11-24 07:25:07 +03:00
::
++ rood
2018-03-14 07:36:10 +03:00
;~ pfix net
2017-09-18 21:50:10 +03:00
(stag %clsg poor)
2016-11-24 07:25:07 +03:00
==
::
++ rupl
%+ cook
2017-11-17 00:50:03 +03:00
|= {a/? b/(list hoon) c/?}
2016-11-24 07:25:07 +03:00
?: a
?: c
2017-09-18 21:50:10 +03:00
[%clsg [%clsg b] ~]
[%clsg b]
2016-11-24 07:25:07 +03:00
?: c
2017-09-18 21:50:10 +03:00
[%clsg [%cltr b] ~]
[%cltr b]
2016-11-24 07:25:07 +03:00
;~ plug
;~ pose
(cold | (just '['))
(cold & (jest '~['))
==
::
;~ pose
(ifix [ace gap] (most gap tall))
(most ace wide)
==
::
;~ pose
(cold & (jest ']~'))
(cold | (just ']'))
==
==
::
2017-11-01 21:48:12 +03:00
::
++ sail :: xml template
|= in-tall-form/? =| lin/?
2016-11-24 07:25:07 +03:00
|%
::
2017-11-17 00:50:03 +03:00
++ apex :: product hoon
2016-11-24 07:25:07 +03:00
%+ cook
2017-11-20 22:17:27 +03:00
|= tum/(each manx:hoon marl:hoon) ^- hoon
?- -.tum
2018-03-19 06:54:47 +03:00
%& [%xray p.tum]
%| [%mcts p.tum]
==
top-level
2016-11-24 07:25:07 +03:00
::
++ top-level :: entry-point
2018-03-14 07:36:10 +03:00
;~(pfix mic ?:(in-tall-form tall-top wide-top))
2016-11-24 07:25:07 +03:00
::
++ inline-embed :: brace interpolation
2017-11-17 00:50:03 +03:00
%+ cook |=(a/tuna:hoon a)
2016-11-24 07:25:07 +03:00
;~ pose
2018-03-14 07:36:10 +03:00
;~(pfix mic bracketed-elem(in-tall-form |))
;~(plug tuna-mode sump)
(stag %tape sump)
==
::
++ script-or-style :: script or style
2017-11-17 00:50:03 +03:00
%+ cook |=(a/marx:hoon a)
;~ plug
;~(pose (jest %script) (jest %style))
wide-attrs
2016-11-24 07:25:07 +03:00
==
::
++ tuna-mode :: xml node(s) kind
2016-11-24 07:25:07 +03:00
;~ pose
(cold %tape hep)
(cold %manx lus)
(cold %marl tar)
2017-11-01 21:48:12 +03:00
(cold %call cen)
2016-11-24 07:25:07 +03:00
==
::
++ wide-top :: wide outer top
2017-11-20 22:17:27 +03:00
%+ knee *(each manx:hoon marl:hoon) |. ~+
2016-11-24 07:25:07 +03:00
;~ pose
(stag %| wide-quote)
(stag %| wide-paren-elems)
(stag %& ;~(plug tag-head wide-tail))
2016-11-24 07:25:07 +03:00
==
::
++ wide-inner-top :: wide inner top
2017-11-20 22:17:27 +03:00
%+ knee *(each tuna:hoon marl:hoon) |. ~+
;~ pose
wide-top
(stag %& ;~(plug tuna-mode wide))
==
2016-11-24 07:25:07 +03:00
::
++ wide-attrs :: wide attributes
2017-11-17 00:50:03 +03:00
%+ cook |=(a/(unit mart:hoon) (fall a ~))
%- punt
2018-03-14 07:36:10 +03:00
%+ ifix [lit rit]
%+ more (jest ', ')
;~((glue ace) a-mane hopefully-quote)
::
++ wide-tail :: wide elements
2017-11-17 00:50:03 +03:00
%+ cook |=(a/marl:hoon a)
2018-03-14 07:36:10 +03:00
;~(pose ;~(pfix col wrapped-elems) (cold ~ mic) (easy ~))
::
++ wide-elems :: wide elements
2017-11-17 00:50:03 +03:00
%+ cook |=(a/marl:hoon a)
%+ cook join-tops
(star ;~(pfix ace wide-inner-top))
::
++ wide-paren-elems :: wide flow
2017-11-17 00:50:03 +03:00
%+ cook |=(a/marl:hoon a)
%+ cook join-tops
2018-03-14 07:36:10 +03:00
(ifix [lit rit] (more ace wide-inner-top))
::
::+|
::
++ drop-top
2017-11-20 22:17:27 +03:00
|= a/(each tuna:hoon marl:hoon) ^- marl:hoon
?- -.a
2018-03-19 06:54:47 +03:00
%& [p.a]~
%| p.a
2016-11-24 07:25:07 +03:00
==
::
++ join-tops
2017-11-20 22:17:27 +03:00
|= a/(list (each tuna:hoon marl:hoon)) ^- marl:hoon
(zing (turn a drop-top))
2016-11-24 07:25:07 +03:00
::
::+|
::
++ wide-quote :: wide quote
2017-11-17 00:50:03 +03:00
%+ cook |=(a/marl:hoon a)
;~ pose
;~ less (jest '"""')
2018-04-14 08:31:53 +03:00
(ifix [yel yel] (cook collapse-chars quote-innards))
2016-11-24 07:25:07 +03:00
==
::
%- inde
%+ ifix [(jest '"""\0a') (jest '\0a"""')]
(cook collapse-chars quote-innards(lin |))
2016-11-24 07:25:07 +03:00
==
::
++ quote-innards :: wide+tall flow
2017-11-17 00:50:03 +03:00
%+ cook |=(a/(list $@(@ tuna:hoon)) a)
2016-11-24 07:25:07 +03:00
%- star
;~ pose
2018-04-14 08:31:53 +03:00
;~(pfix bas ;~(pose (mask "-+*%;\{") bas yel bix:ab))
inline-embed
2018-03-19 06:38:01 +03:00
;~(less bas leb ?:(in-tall-form fail toc) prn)
?:(lin fail ;~(less (jest '\0a"""') (just '\0a')))
2016-11-24 07:25:07 +03:00
==
::
++ bracketed-elem :: bracketed element
2018-03-19 06:38:01 +03:00
%+ ifix [leb reb]
;~(plug tag-head wide-elems)
2016-11-24 07:25:07 +03:00
::
++ wrapped-elems :: wrapped tuna
2017-11-17 00:50:03 +03:00
%+ cook |=(a/marl:hoon a)
2016-11-24 07:25:07 +03:00
;~ pose
wide-paren-elems
(cook |=(@t `marl`[;/((trip +<))]~) qut)
(cook drop-top wide-top)
2016-11-24 07:25:07 +03:00
==
::
::+|
2016-11-24 07:25:07 +03:00
::
2017-11-17 00:50:03 +03:00
++ a-mane :: mane as hoon
%+ cook
|= {a/@tas b/(unit @tas)}
?~(b a [a u.b])
;~(plug sym ;~(pose (stag ~ ;~(pfix cab sym)) (easy ~)))
2016-11-24 07:25:07 +03:00
::
++ en-class
|= a/(list {$class p/term})
^- (unit {$class tape})
?~ a ~
%- some
:- %class
|-
%+ welp (trip p.i.a)
?~ t.a ~
[' ' $(a t.a)]
::
++ tag-head :: tag head
%+ cook
2017-11-17 00:50:03 +03:00
=+ hoon ::REVIEW rename dynamic xml types
|= {a/mane b/mart c/mart}
^- marx
[a (weld b c)]
;~ plug
a-mane
::
%+ cook
2017-11-17 00:50:03 +03:00
|= a/(list (unit {term (list beer:hoon)}))
^- (list {term (list beer:hoon)})
:: discard nulls
(murn a same)
;~ plug
(punt ;~(plug (cold %id hax) (cook trip sym)))
(cook en-class (star ;~(plug (cold %class dot) sym)))
2018-03-19 06:38:01 +03:00
(punt ;~(plug ;~(pose (cold %href net) (cold %src vat)) soil))
(easy ~)
2016-11-24 07:25:07 +03:00
==
::
wide-attrs
2016-11-24 07:25:07 +03:00
==
::
::+|
2016-11-24 07:25:07 +03:00
::
++ tall-top :: tall top
2017-11-20 22:17:27 +03:00
%+ knee *(each manx:hoon marl:hoon) |. ~+
2016-11-24 07:25:07 +03:00
;~ pose
(stag %| ;~(pfix (plus ace) (cook collapse-chars quote-innards)))
(stag %& ;~(plug script-or-style script-style-tail))
(stag %& tall-elem)
(stag %| wide-quote)
(stag %| ;~(pfix tis tall-tail))
2017-11-14 05:02:40 +03:00
(stag %& ;~(pfix gar gap (stag [%div ~] cram)))
(stag %| ;~(plug ;~((glue gap) tuna-mode tall) (easy ~)))
(easy %| [;/("\0a")]~)
2016-11-24 07:25:07 +03:00
==
::
++ tall-attrs :: tall attributes
%- star
;~ pfix ;~(plug gap tis)
;~((glue gap) a-mane hopefully-quote)
==
2016-11-24 07:25:07 +03:00
::
++ tall-elem :: tall preface
%+ cook
2017-11-17 00:50:03 +03:00
=+ hoon ::REVIEW rename dynamic xml types
|= {a/{p/mane q/mart} b/mart c/marl}
^- manx
[[p.a (weld q.a b)] c]
;~(plug tag-head tall-attrs tall-tail)
::
::+|
::
::REVIEW is there a better way to do this?
++ hopefully-quote :: prefer "quote" form
2017-11-17 00:50:03 +03:00
%+ cook |=(a/(list beer:hoon) a)
%+ cook |=(a/hoon ?:(?=($knit -.a) p.a [~ a]~))
wide
::
++ script-style-tail :: unescaped tall tail
2017-11-17 00:50:03 +03:00
%+ cook |=(a/marl:hoon a)
%+ ifix [gap ;~(plug gap duz)]
%+ most gap
2018-03-14 07:36:10 +03:00
;~ pfix mic
%+ cook |=(a/tape ;/(a))
;~ pose
;~(pfix ace (star prn))
(easy "\0a")
2016-11-24 07:25:07 +03:00
==
==
::
++ tall-tail :: tall tail
?> in-tall-form
2017-11-17 00:50:03 +03:00
%+ cook |=(a/marl:hoon a)
2016-11-24 07:25:07 +03:00
;~ pose
2018-03-14 07:36:10 +03:00
(cold ~ mic)
;~(pfix col wrapped-elems(in-tall-form |))
;~(pfix col ace (cook collapse-chars(in-tall-form |) quote-innards))
2017-11-14 05:02:40 +03:00
(ifix [gap ;~(plug gap duz)] tall-kids)
2016-11-24 07:25:07 +03:00
==
::
2017-11-14 05:02:40 +03:00
++ tall-kids :: child elements
%+ cook join-tops
:: look for sail first, or markdown if not
(most gap ;~(pose top-level (stag %| cram)))
::
++ collapse-chars :: group consec chars
2017-11-17 00:50:03 +03:00
|= reb/(list $@(@ tuna:hoon))
^- marl:hoon
=| {sim/(list @) tuz/marl:hoon}
|- ^- marl:hoon
2016-11-24 07:25:07 +03:00
?~ reb
=. sim
?. in-tall-form sim
2016-11-24 07:25:07 +03:00
[10 |-(?~(sim sim ?:(=(32 i.sim) $(sim t.sim) sim)))]
?~(sim tuz [;/((flop sim)) tuz])
2016-11-24 07:25:07 +03:00
?@ i.reb
$(reb t.reb, sim [i.reb sim])
?~ sim [i.reb $(reb t.reb, sim ~)]
[;/((flop sim)) i.reb $(reb t.reb, sim ~)]
2016-11-24 07:25:07 +03:00
--
2017-08-03 02:25:32 +03:00
++ cram :: parse unmark
=> |%
2017-11-17 00:50:03 +03:00
++ item (pair mite marl:hoon) :: xml node generator
2017-08-03 02:25:32 +03:00
++ colm @ud :: column
2017-11-20 22:17:27 +03:00
++ tarp marl:hoon :: node or generator
2017-08-03 02:25:32 +03:00
++ mite :: context
$? $down :: outer embed
2017-11-14 05:02:40 +03:00
$lunt :: unordered list
2017-08-03 02:25:32 +03:00
$lime :: list item
$lord :: ordered list
$poem :: verse
$bloc :: blockquote
$head :: heading
== ::
++ trig :: line style
$: col/@ud :: start column
sty/trig-style :: style
== ::
2017-08-19 04:43:44 +03:00
++ trig-style :: type of parsed line
2017-11-14 05:02:40 +03:00
$% $: $end :: terminator
2017-08-03 02:25:32 +03:00
$? $done :: end of input
2017-11-14 05:02:40 +03:00
$stet :: == end of markdown
$dent :: outdent
== == ::
$: $one :: leaf node
$? $rule :: --- horz rule
$fens :: ``` code fence
$expr :: ;sail expression
== == ::
{$new p/trig-new} :: open container
{$old $text} :: anything else
== ::
++ trig-new :: start a
$? $lite :: + line item
$lint :: - line item
2017-08-03 02:25:32 +03:00
$head :: # heading
$bloc :: > block-quote
2017-11-14 05:02:40 +03:00
$poem :: [ ]{8} poem
2017-08-03 02:25:32 +03:00
== ::
2017-08-19 04:43:44 +03:00
++ graf :: paragraph element
2017-08-03 02:25:32 +03:00
$% {$bold p/(list graf)} :: *bold*
{$talc p/(list graf)} :: _italics_
{$quod p/(list graf)} :: "double quote"
{$code p/tape} :: code literal
{$text p/tape} :: text symbol
{$link p/(list graf) q/tape} :: URL
2017-11-17 00:50:03 +03:00
{$expr p/tuna:hoon} :: interpolated hoon
2017-08-03 02:25:32 +03:00
==
--
2017-11-14 05:02:40 +03:00
=< (non-empty:parse |=(nail `(like tarp)`~($ main +<)))
2017-08-03 02:25:32 +03:00
|%
++ main
::
:: state of the parsing loop. we maintain a construction
:: stack for elements and a line stack for lines in the
:: current block. a blank line causes the current block
:: to be parsed and thrown in the current element. when
:: the indent column retreats, the element stack rolls up.
::
2017-11-14 05:02:40 +03:00
:: verbose: debug printing enabled
2017-08-03 02:25:32 +03:00
:: err: error position
2017-11-14 05:02:40 +03:00
:: ind: outer and inner indent level
2017-08-03 02:25:32 +03:00
:: hac: stack of items under construction
:: cur: current item under construction
2017-11-14 05:02:40 +03:00
:: par: current "paragraph" being read in
:: [loc txt]: parsing state
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
=/ verbose &
2017-08-03 02:25:32 +03:00
=| err/(unit hair)
2017-11-14 05:02:40 +03:00
=| ind/{out/@ud inr/@ud}
2017-08-03 02:25:32 +03:00
=| hac/(list item)
=/ cur/item [%down ~]
2017-11-14 05:02:40 +03:00
=| par/(unit (pair hair wall))
|_ {loc/hair txt/tape}
2017-08-03 02:25:32 +03:00
::
++ $ :: resolve
2017-11-14 05:02:40 +03:00
^- (like tarp)
2017-08-03 02:25:32 +03:00
=> line
::
:: if error position is set, produce error
2017-11-14 05:02:40 +03:00
?. =(~ err)
~& err+err
[+.err ~]
2017-08-03 02:25:32 +03:00
::
:: all data was consumed
2017-11-14 05:02:40 +03:00
=- [loc `[- [loc txt]]]
=> close-par
|- ^- tarp
2017-08-03 02:25:32 +03:00
::
:: fold all the way to top
2017-11-14 05:02:40 +03:00
?~ hac cur-to-tarp
$(..^$ close-item)
2017-08-03 02:25:32 +03:00
::
::+|
::
++ cur-indent
?- p.cur
$down 2
$head 0
2017-11-14 05:02:40 +03:00
$lunt 0
2017-08-03 02:25:32 +03:00
$lime 2
$lord 0
$poem 8
$bloc 2
==
::
++ back :: column retreat
|= luc/@ud
^+ +>
2017-11-14 05:02:40 +03:00
?: (gte luc inr.ind) +>
2017-08-03 02:25:32 +03:00
::
:: nex: next backward step that terminates this context
=/ nex/@ud cur-indent ::REVIEW code and poem blocks are handled elsewhere
2017-11-14 05:02:40 +03:00
?: (gth nex (sub inr.ind luc))
2017-08-03 02:25:32 +03:00
::
:: indenting pattern violation
2017-11-14 05:02:40 +03:00
~? verbose indent-pattern-violation+[p.cur nex inr.ind luc]
..^$(inr.ind luc, err `[p.loc luc])
=. ..^$ close-item
$(inr.ind (sub inr.ind nex))
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
++ cur-to-tarp :: item to tarp
^- tarp
2017-08-03 02:25:32 +03:00
?: ?=(?($down $head $expr) p.cur)
(flop q.cur)
=- [[- ~] (flop q.cur)]~
?- p.cur
2017-11-14 05:02:40 +03:00
$lunt %ul
2017-08-03 02:25:32 +03:00
$lord %ol
$lime %li
$poem %div ::REVIEW actual container element?
$bloc %blockquote
==
::
2017-11-14 05:02:40 +03:00
++ close-item ^+ . :: complete and pop
2017-08-03 02:25:32 +03:00
?~ hac .
%= .
hac t.hac
2017-11-14 05:02:40 +03:00
cur [p.i.hac (weld cur-to-tarp q.i.hac)]
2017-08-03 02:25:32 +03:00
==
::
2017-11-14 05:02:40 +03:00
++ read-line :: capture raw line
=| lin/tape
|- ^+ [[lin *(unit _err)] +<.^$] :: parsed tape and halt/error
2017-08-03 02:25:32 +03:00
::
:: no unterminated lines
2017-11-14 05:02:40 +03:00
?~ txt
~? verbose %unterminated-line
[[~ ``loc] +<.^$]
?. =(`@`10 i.txt)
?: (gth inr.ind q.loc)
?. =(' ' i.txt)
~? verbose expected-indent+[inr.ind loc txt]
[[~ ``loc] +<.^$]
$(txt t.txt, q.loc +(q.loc))
2017-08-03 02:25:32 +03:00
::
:: save byte and repeat
2017-11-14 05:02:40 +03:00
$(txt t.txt, q.loc +(q.loc), lin [i.txt lin])
=. lin
2017-08-03 02:25:32 +03:00
::
:: trim trailing spaces
|- ^- tape
2017-11-14 05:02:40 +03:00
?: ?=({$' ' *} lin)
$(lin t.lin)
(flop lin)
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
=/ eat-newline/nail [[+(p.loc) 1] t.txt]
=/ saw look(+<.$ eat-newline)
2017-08-03 02:25:32 +03:00
::
?: ?=({~ @ $end ?($stet $dent)} saw) :: stop on == or dedent
2017-11-14 05:02:40 +03:00
[[lin `~] +<.^$]
[[lin ~] eat-newline]
2017-08-03 02:25:32 +03:00
::
2018-03-29 21:03:14 +03:00
++ look :: inspedt line
2017-08-03 02:25:32 +03:00
^- (unit trig)
2017-11-14 05:02:40 +03:00
%+ bind (wonk (look:parse loc txt))
|= a/trig ^+ a
::
:: treat a non-terminator as a terminator
:: if it's outdented
?: =(%end -.sty.a) a
?: (lth col.a out.ind)
a(sty [%end %dent])
a
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
++ close-par :: make block
2017-08-03 02:25:32 +03:00
^+ .
::
:: empty block, no action
2017-11-14 05:02:40 +03:00
?~ par .
2017-08-03 02:25:32 +03:00
::
:: if block is verse
?: ?=($poem p.cur)
::
:: add break between stanzas
=. q.cur ?~(q.cur q.cur [[[%br ~] ~] q.cur])
2017-11-14 05:02:40 +03:00
=- close-item(par ~, q.cur (weld - q.cur), inr.ind (sub inr.ind 8))
%+ turn q.u.par
2017-08-03 02:25:32 +03:00
|= tape ^- manx
::
:: each line is a paragraph
:- [%p ~]
:_ ~
;/("{+<}\0a")
::
:: yex: block recomposed, with newlines
=/ yex/tape
2017-11-14 05:02:40 +03:00
(zing (turn (flop q.u.par) |=(a/tape (runt [(dec inr.ind) ' '] "{a}\0a"))))
2017-08-03 02:25:32 +03:00
::
:: vex: parse of paragraph
2017-11-14 05:02:40 +03:00
=/ vex/(like tarp)
2017-08-03 02:25:32 +03:00
::
:: either a one-line header or a paragraph
2017-11-14 05:02:40 +03:00
%. [p.u.par yex]
?: ?=($head p.cur)
(full head:parse)
(full para:parse)
2017-08-03 02:25:32 +03:00
::
:: if error, propagate correctly
2017-11-14 05:02:40 +03:00
?~ q.vex
~? verbose [%close-par p.cur yex]
..$(err `p.vex)
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
:: finish tag if it's a header
=< ?:(?=($head p.cur) close-item ..$)
2017-08-03 02:25:32 +03:00
::
:: save good result, clear buffer
2017-11-14 05:02:40 +03:00
..$(par ~, q.cur (weld p.u.q.vex q.cur))
2017-08-03 02:25:32 +03:00
::
++ line ^+ . :: body line loop
::
:: abort after first error
?: !=(~ err) .
::
2017-11-14 05:02:40 +03:00
:: saw: profile of this line
=/ saw look
~? [debug=|] [%look ind=ind saw=saw txt=txt]
2017-08-03 02:25:32 +03:00
::
:: if line is blank
2017-11-14 05:02:40 +03:00
?~ saw
2017-08-03 02:25:32 +03:00
::
:: break section
2017-11-14 05:02:40 +03:00
=^ a/{tape fin/(unit _err)} +<.$ read-line
?^ fin.a
..$(err u.fin.a)
=>(close-par line)
2017-08-03 02:25:32 +03:00
::
:: line is not blank
2017-11-14 05:02:40 +03:00
=> .(saw u.saw)
2017-08-03 02:25:32 +03:00
::
:: if end of input, complete
2017-11-14 05:02:40 +03:00
?: ?=($end -.sty.saw)
..$(q.loc col.saw)
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
=. ind ?~(out.ind [col.saw col.saw] ind) :: init indents
2017-08-03 02:25:32 +03:00
::
?: ?| ?=(~ par) :: if after a paragraph or
2017-11-14 05:02:40 +03:00
?& ?=(?($down $lime $bloc) p.cur) :: unspaced new container
|(!=(%old -.sty.saw) (gth col.saw inr.ind))
== ==
=> .(..$ close-par)
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
:: if column has retreated, adjust stack
=. ..$ (back col.saw)
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
=^ col-ok sty.saw
?+ (sub col.saw inr.ind) [| sty.saw] :: columns advanced
$0 [& sty.saw]
$8 [& %new %poem]
2017-08-03 02:25:32 +03:00
==
2017-11-14 05:02:40 +03:00
?. col-ok
~? verbose [%columns-advanced col.saw inr.ind]
..$(err `[p.loc col.saw])
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
=. inr.ind col.saw
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
:: unless adding a matching item, close lists
=. ..$
?: ?| &(?=($lunt p.cur) !?=($lint +.sty.saw))
&(?=($lord p.cur) !?=($lite +.sty.saw))
==
close-item
..$
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
=< line(par `[loc ~]) ^+ ..$ :: continue with para
?- -.sty.saw
$one (read-one +.sty.saw) :: parse leaves
$new (open-item p.sty.saw) :: open containers
$old ..$ :: just text
==
2017-08-03 02:25:32 +03:00
::
::
2017-11-14 05:02:40 +03:00
::- - - foo
2017-08-03 02:25:32 +03:00
:: detect bad block structure
2017-11-14 05:02:40 +03:00
?. :: first line of container is legal
?~ q.u.par &
?- p.cur
2017-08-03 02:25:32 +03:00
::
:: can't(/directly) contain text
2017-11-14 05:02:40 +03:00
?($lord $lunt) ~|(bad-leaf-container+p.cur !!)
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
:: only one line in a header
$head |
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
:: indented literals need to end with a blank line
$poem (gte col.saw inr.ind)
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
:: text tarps must continue aligned
?($down $lunt $lime $lord $bloc) =(col.saw inr.ind)
2017-08-03 02:25:32 +03:00
==
2017-11-14 05:02:40 +03:00
~? verbose bad-block-structure+[p.cur inr.ind col.saw]
..$(err `[p.loc col.saw])
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
:: accept line and maybe continue
=^ a/{lin/tape fin/(unit _err)} +<.$ read-line
=. par par(q.u [lin.a q.u.par])
?^ fin.a ..$(err u.fin.a)
line
::
2017-11-14 05:02:40 +03:00
++ parse-block :: execute parser
|= fel/$-(nail (like tarp)) ^+ +>
=/ vex/(like tarp) (fel loc txt)
?~ q.vex
~? verbose [%parse-block txt]
+>.$(err `p.vex)
=+ [res loc txt]=u.q.vex
%_ +>.$
loc loc
txt txt
q.cur (weld (flop `tarp`res) q.cur) :: prepend to the stack
==
::
++ read-one :: read %one item
|= sty/?($expr $rule $fens) ^+ +>
?- sty
$expr (parse-block expr:parse)
$rule (parse-block hrul:parse)
$fens (parse-block (fens:parse inr.ind))
==
::
++ open-item :: enter list/quote
|= saw/trig-new
=< +>.$:apex
2017-08-03 02:25:32 +03:00
|%
2017-11-14 05:02:40 +03:00
++ apex ^+ . :: open container
?- saw
$poem (push %poem) :: verse literal
2017-08-03 02:25:32 +03:00
$head (push %head) :: heading
$bloc (entr %bloc) :: blockquote line
2017-11-14 05:02:40 +03:00
$lint (lent %lunt) :: unordered list
$lite (lent %lord) :: ordered list
2017-08-03 02:25:32 +03:00
==
::
2017-11-14 05:02:40 +03:00
++ push :: push context
|=(mite +>(hac [cur hac], cur [+< ~]))
::
2017-08-03 02:25:32 +03:00
++ entr :: enter container
|= typ/mite
^+ +>
::
:: indent by 2
2017-11-14 05:02:40 +03:00
=. inr.ind (add 2 inr.ind)
2017-08-03 02:25:32 +03:00
::
:: "parse" marker
2017-11-14 05:02:40 +03:00
=. txt (slag (sub inr.ind q.loc) txt)
=. q.loc inr.ind
2017-08-03 02:25:32 +03:00
::
(push typ)
::
++ lent :: list entry
2017-11-14 05:02:40 +03:00
|= ord/?($lord $lunt)
2017-08-03 02:25:32 +03:00
^+ +>
2017-11-14 05:02:40 +03:00
=> ?:(=(ord p.cur) +>.$ (push ord)) :: push list if new
(entr %lime)
2017-08-03 02:25:32 +03:00
--
--
::
++ parse :: individual parsers
|%
2017-08-19 04:43:44 +03:00
++ look :: classify line
2017-08-03 02:25:32 +03:00
%+ cook |=(a/(unit trig) a)
;~ pfix (star ace)
2017-11-14 05:02:40 +03:00
%+ here :: report indent
|=({a/pint b/?(~ trig-style)} ?~(b ~ `[q.p.a b]))
2017-08-03 02:25:32 +03:00
;~ pose
(cold ~ (just `@`10)) :: blank line
2017-11-14 05:02:40 +03:00
::
(full (easy [%end %done])) :: end of input
(cold [%end %stet] duz) :: == end of markdown
::
(cold [%one %rule] ;~(plug hep hep hep)) :: --- horizontal ruler
(cold [%one %fens] ;~(plug tec tec tec)) :: ``` code fence
2018-03-14 07:36:10 +03:00
(cold [%one %expr] mic) :: ;sail expression
2017-11-14 05:02:40 +03:00
::
(cold [%new %head] ;~(plug (star hax) ace)) :: # heading
(cold [%new %lint] ;~(plug hep ace)) :: - line item
(cold [%new %lite] ;~(plug lus ace)) :: + line item
(cold [%new %bloc] ;~(plug gar ace)) :: > block-quote
::
(easy [%old %text]) :: anything else
2017-08-03 02:25:32 +03:00
==
==
::
2017-11-14 05:02:40 +03:00
::
2017-08-03 02:25:32 +03:00
++ cash :: escaped fence
|* tem/rule
%- echo
%- star
;~ pose
whit
;~(plug bas tem)
;~(less tem prn)
==
::
++ cool :: reparse
|* $: :: fex: primary parser
:: sab: secondary parser
::
fex/rule
sab/rule
==
2017-11-14 05:02:40 +03:00
|= {loc/hair txt/tape}
2017-08-03 02:25:32 +03:00
^+ *sab
::
:: vex: fenced span
2017-11-14 05:02:40 +03:00
=/ vex/(like tape) (fex loc txt)
2017-08-03 02:25:32 +03:00
?~ q.vex vex
::
:: hav: reparse full fenced text
2017-11-14 05:02:40 +03:00
=/ hav ((full sab) [loc p.u.q.vex])
2017-08-03 02:25:32 +03:00
::
:: reparsed error position is always at start
2017-11-14 05:02:40 +03:00
?~ q.hav [loc ~]
2017-08-03 02:25:32 +03:00
::
2017-11-16 23:44:27 +03:00
:: the complete type with the main product
2017-08-03 02:25:32 +03:00
:- p.vex
`[p.u.q.hav q.u.q.vex]
::
::REVIEW surely there is a less hacky "first or after space" solution
++ easy-sol :: parse start of line
|* a/*
|= b/nail
?: =(1 q.p.b) ((easy a) b)
(fail b)
::
2017-08-03 02:25:32 +03:00
++ echo :: hoon literal
|* sab/rule
2017-11-14 05:02:40 +03:00
|= {loc/hair txt/tape}
2017-08-03 02:25:32 +03:00
^- (like tape)
::
2017-11-17 00:50:03 +03:00
:: vex: result of parsing wide hoon
2017-11-14 05:02:40 +03:00
=/ vex (sab loc txt)
2017-08-03 02:25:32 +03:00
::
:: use result of expression parser
?~ q.vex vex
=- [p.vex `[- q.u.q.vex]]
::
:: but replace payload with bytes consumed
|- ^- tape
2017-11-14 05:02:40 +03:00
?: =(q.q.u.q.vex txt) ~
?~ txt ~
[i.txt $(txt +.txt)]
::
++ non-empty
|* a/rule
|= tub/nail ^+ (a)
=/ vex (a tub)
~! vex
?~ q.vex vex
?. =(tub q.u.q.vex) vex
(fail tub)
2017-08-03 02:25:32 +03:00
::
::
2017-11-14 05:02:40 +03:00
++ word :: tarp parser
2017-08-03 02:25:32 +03:00
%+ knee *(list graf) |. ~+
2018-03-18 04:06:15 +03:00
%+ cook
|= a/$%(graf [%list (list graf)])
^- (list graf)
?:(?=(%list -.a) +.a [a ~])
2017-08-03 02:25:32 +03:00
;~ pose
::
:: ordinary word
::
%+ stag %text
;~(plug ;~(pose low hig) (star ;~(pose nud low hig hep)))
::
:: naked \escape
::
(stag %text ;~(pfix bas (cook trip ;~(less ace prn))))
::
2017-11-14 05:02:40 +03:00
:: trailing \ to add <br>
::
(stag %expr (cold [[%br ~] ~] ;~(plug bas (just '\0a'))))
::
2017-08-03 02:25:32 +03:00
:: *bold literal*
::
(stag %bold (ifix [tar tar] (cool (cash tar) work)))
::
:: _italic literal_
::
(stag %talc (ifix [cab cab] (cool (cash cab) work)))
::
:: "quoted text"
::
2018-04-14 08:31:53 +03:00
(stag %quod (ifix [yel yel] (cool (cash yel) work)))
2017-08-03 02:25:32 +03:00
::
:: `classic markdown quote`
::
(stag %code (ifix [tec tec] (cash tec)))
::
:: ++arm
::
(stag %code ;~(plug lus lus low (star ;~(pose nud low hep))))
::
:: [arbitrary *content*](url)
::
%+ stag %link
;~ (glue (punt whit))
2018-03-14 07:36:10 +03:00
(ifix [lac rac] (cool (cash rac) work))
(ifix [lit rit] (cash rit))
2017-08-03 02:25:32 +03:00
==
::
2017-11-17 00:50:03 +03:00
:: #hoon
2017-08-03 02:25:32 +03:00
::
2018-03-18 04:06:15 +03:00
%+ stag %list
2017-08-03 02:25:32 +03:00
;~ plug
(stag %text ;~(pose (cold " " whit) (easy-sol ~)))
2017-08-03 02:25:32 +03:00
(stag %code ;~(pfix hax (echo wide)))
;~(simu whit (easy ~))
2017-08-03 02:25:32 +03:00
==
::
:: direct hoon constant
::
2018-03-18 04:06:15 +03:00
%+ stag %list
2017-08-03 02:25:32 +03:00
;~ plug
(stag %text ;~(pose (cold " " whit) (easy-sol ~)))
2017-08-03 02:25:32 +03:00
::
%+ stag %code
%- echo
;~ pose
2017-08-10 03:50:06 +03:00
::REVIEW just copy in 0x... parsers directly?
;~(simu ;~(plug (just '0') alp) bisk:so)
::
2017-08-03 02:25:32 +03:00
tash:so
;~(pfix dot perd:so)
;~(pfix sig ;~(pose twid:so (easy [%$ %n 0])))
2018-03-14 07:36:10 +03:00
;~(pfix cen ;~(pose sym buc pad bar qut nuck:so))
2017-08-03 02:25:32 +03:00
==
::
;~(simu whit (easy ~))
2017-08-03 02:25:32 +03:00
==
::
:: whitespace
::
(stag %text (cold " " whit))
::
:: {interpolated} sail
::
(stag %expr inline-embed:(sail |))
::
:: just a byte
::
(stag %text (cook trip ;~(less ace prn)))
==
::
2017-11-14 05:02:40 +03:00
++ work (cook zing (star word)) :: indefinite tarp
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
++ down :: parse inline tarp
%+ knee *tarp |. ~+
2017-08-03 02:25:32 +03:00
=- (cook - work)
::
2017-11-14 05:02:40 +03:00
:: collect raw tarp into xml tags
2017-08-03 02:25:32 +03:00
|= gaf/(list graf)
2017-11-14 05:02:40 +03:00
^- tarp
2017-08-03 02:25:32 +03:00
=< main
|%
++ main
2017-11-14 05:02:40 +03:00
^- tarp
2017-08-03 02:25:32 +03:00
?~ gaf ~
?. ?=($text -.i.gaf)
(weld (item i.gaf) $(gaf t.gaf))
::
:: fip: accumulate text blocks
=/ fip/(list tape) [p.i.gaf]~
2017-11-14 05:02:40 +03:00
|- ^- tarp
2017-08-03 02:25:32 +03:00
?~ t.gaf [;/((zing (flop fip))) ~]
?. ?=($text -.i.t.gaf)
[;/((zing (flop fip))) ^$(gaf t.gaf)]
$(gaf t.gaf, fip :_(fip p.i.t.gaf))
::
++ item
|= nex/graf
2017-11-20 22:17:27 +03:00
^- tarp ::CHECK can be tuna:hoon?
2017-08-03 02:25:32 +03:00
?- -.nex
$text !! :: handled separately
$expr [p.nex]~
$bold [[%b ~] ^$(gaf p.nex)]~
$talc [[%i ~] ^$(gaf p.nex)]~
$code [[%code ~] ;/(p.nex) ~]~
$quod ::
:: smart quotes
%= ^$
gaf
:- [%text (tufa ~-~201c. ~)]
%+ weld p.nex
`(list graf)`[%text (tufa ~-~201d. ~)]~
==
$link [[%a [%href q.nex] ~] ^$(gaf p.nex)]~
==
--
::
++ hrul :: empty besides fence
2017-11-14 05:02:40 +03:00
%+ cold [[%hr ~] ~]~
;~(plug (star ace) hep hep hep (star hep) (just '\0a'))
::
++ tecs
;~(plug tec tec tec (just '\0a'))
::
++ fens
|= col/@u ~+
=/ ind (stun [(dec col) (dec col)] ace)
=/ ind-tecs ;~(plug ind tecs)
%+ cook |=(txt/tape `tarp`[[%pre ~] ;/(txt) ~]~)
::
:: leading outdent is ok since container may
:: have already been parsed and consumed
%+ ifix [;~(plug (star ace) tecs) ind-tecs]
%^ stir "" |=({a/tape b/tape} "{a}\0a{b}")
;~ pose
%+ ifix [ind (just '\0a')]
;~(less tecs (star prn))
::
(cold "" ;~(plug (star ace) (just '\0a')))
==
2017-08-03 02:25:32 +03:00
::
++ para :: paragraph
%+ cook
2017-11-14 05:02:40 +03:00
|=(a/tarp ?~(a ~ [[%p ~] a]~))
;~(pfix (punt whit) down)
2017-08-03 02:25:32 +03:00
::
++ expr :: expression
2017-08-19 04:43:44 +03:00
=> (sail &) :: tall-form
2017-11-14 05:02:40 +03:00
%+ ifix [(star ace) ;~(simu gap (easy))] :: look-ahead for gap
2017-08-19 04:43:44 +03:00
(cook drop-top top-level) :: list of tags
::
2017-08-03 02:25:32 +03:00
::
++ whit :: whitespace
(cold ' ' (plus ;~(pose (just ' ') (just '\0a'))))
::
++ head :: parse heading
%+ cook
2017-11-14 05:02:40 +03:00
|= {haxes/tape kids/tarp} ^- tarp
=/ tag (crip 'h' <(lent haxes)>) :: e.g. ### -> %h3
=/ id (contents-to-id kids)
[[tag [%id id]~] kids]~
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
;~(pfix (star ace) ;~((glue whit) (stun [1 6] hax) down))
2017-08-03 02:25:32 +03:00
::
2017-11-14 05:02:40 +03:00
++ contents-to-id :: # text into elem id
2017-11-17 00:50:03 +03:00
|= a/(list tuna:hoon) ^- tape
2017-08-03 02:25:32 +03:00
=; raw/tape
%+ turn raw
|= @tD
^- @tD
?: ?| &((gte +< 'a') (lte +< 'z'))
&((gte +< '0') (lte +< '9'))
==
+<
?: &((gte +< 'A') (lte +< 'Z'))
(add 32 +<)
'-'
::
2017-11-14 05:02:40 +03:00
:: collect all text in header tarp
2017-08-03 02:25:32 +03:00
|- ^- tape
?~ a ~
%+ weld
^- tape
?- i.a
{{$$ {$$ *} ~} ~} :: text node contents
2017-11-17 00:50:03 +03:00
(murn v.i.a.g.i.a |=(a/beer:hoon ?^(a ~ (some a))))
2017-08-03 02:25:32 +03:00
{^ *} $(a c.i.a) :: concatenate children
{@ *} ~ :: ignore interpolation
==
$(a t.a)
--
--
2017-11-14 05:02:40 +03:00
::
2017-12-01 02:22:05 +03:00
++ scad
2018-03-29 21:03:14 +03:00
%+ knee *spec |. ~+
%- stew
^. stet ^. limo
:~
:- '_'
2017-09-18 02:31:49 +03:00
;~(pfix cab (stag %bccb wide))
:- ','
2018-03-14 07:36:10 +03:00
;~(pfix com (stag %bcmc wide))
:- '$'
;~ pose
;~ pfix buc
;~ pose
2018-03-19 07:18:20 +03:00
:: XX: these are all obsolete in hoon 142
::
(stag %leaf (stag %tas (cold %$ buc)))
(stag %leaf (stag %t qut))
(stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so))
==
==
2018-04-11 07:06:46 +03:00
(stag %like (most col rope))
==
:- '%'
;~ pose
;~ pfix cen
;~ pose
(stag %leaf (stag %tas (cold %$ buc)))
2018-03-14 07:36:10 +03:00
(stag %leaf (stag %f (cold & pad)))
(stag %leaf (stag %f (cold | bar)))
(stag %leaf (stag %t qut))
(stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so))
==
==
==
:- '('
2018-03-29 21:03:14 +03:00
%+ cook |=(spec +<)
%+ stag %make
2018-03-14 07:36:10 +03:00
%+ ifix [lit rit]
2018-03-14 01:22:10 +03:00
;~ plug
wide
;~(pose ;~(pfix ace (most ace wyde)) (easy ~))
2018-03-14 01:22:10 +03:00
==
:- '{'
2018-03-19 06:38:01 +03:00
(stag %bccl (ifix [leb reb] (most ace wyde)))
:- '['
2018-03-14 07:36:10 +03:00
(stag %bccl (ifix [lac rac] (most ace wyde)))
:- '*'
(cold [%base %noun] tar)
2018-04-14 08:31:53 +03:00
:- '/'
;~(pfix net (stag %loop ;~(pose (cold %$ buc) sym)))
:- '@'
2018-03-19 06:38:01 +03:00
;~(pfix vat (stag %base (stag %atom mota)))
:- '?'
;~ pose
2018-03-14 01:22:10 +03:00
%+ stag %bcwt
2018-03-14 07:36:10 +03:00
;~(pfix wut (ifix [lit rit] (most ace wyde)))
2018-03-14 01:22:10 +03:00
::
2018-03-19 06:00:25 +03:00
(cold [%base %flag] wut)
==
2017-10-18 22:55:02 +03:00
:- '~'
(cold [%base %null] sig)
2018-03-31 06:54:04 +03:00
:- '!'
(cold [%base %void] ;~(plug zap zap))
:- '^'
;~ pose
2018-04-11 07:06:46 +03:00
(stag %like (most col rope))
(cold [%base %cell] ket)
==
2017-11-29 21:59:48 +03:00
:- '='
;~ pfix tis
%+ sear
2018-04-17 03:33:42 +03:00
|= mod/spec
(bind ~(autoname ax & +<) |=(term [%bcts +< +>+<]))
2018-04-11 07:06:46 +03:00
wyde
2017-11-29 21:59:48 +03:00
==
:- ['a' 'z']
;~ pose
2018-03-14 07:36:10 +03:00
(stag %bcts ;~(plug sym ;~(pfix ;~(pose net tis) wyde)))
2018-04-11 07:06:46 +03:00
(stag %like (most col rope))
==
==
2016-11-24 07:25:07 +03:00
::
2018-03-14 06:17:30 +03:00
++ scat
2017-11-17 00:50:03 +03:00
%+ knee *hoon |. ~+
2016-11-24 07:25:07 +03:00
%- stew
^. stet ^. limo
:~
:- ','
;~ pose
2018-03-14 06:17:30 +03:00
(stag %bccm ;~(pfix com wyde))
2017-10-24 07:48:07 +03:00
(stag %wing rope)
2016-11-24 07:25:07 +03:00
==
:- '!'
;~ pose
2017-09-21 00:13:10 +03:00
(stag %wtzp ;~(pfix zap wide))
2017-09-21 03:54:04 +03:00
(stag %zpzp (cold ~ ;~(plug zap zap)))
2016-11-24 07:25:07 +03:00
==
:- '_'
2018-03-14 06:17:30 +03:00
;~(pfix cab (stag %bccm (stag %bccb wide)))
2016-11-24 07:25:07 +03:00
:- '$'
;~ pose
;~ pfix buc
;~ pose
2018-03-19 07:18:20 +03:00
:: XX: these are all obsolete in hoon 142
::
2016-11-24 07:25:07 +03:00
(stag %leaf (stag %tas (cold %$ buc)))
(stag %leaf (stag %t qut))
(stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so))
==
==
rump
==
:- '%'
;~ pfix cen
;~ pose
2017-09-18 21:50:10 +03:00
(stag %clsg (sear |~({a/@ud b/tyke} (posh ~ ~ a b)) porc))
2016-11-24 07:25:07 +03:00
(stag %rock (stag %tas (cold %$ buc)))
2018-03-14 07:36:10 +03:00
(stag %rock (stag %f (cold & pad)))
2016-11-24 07:25:07 +03:00
(stag %rock (stag %f (cold | bar)))
(stag %rock (stag %t qut))
(cook (jock &) nuck:so)
2017-09-18 21:50:10 +03:00
(stag %clsg (sear |=(a/(list) (posh ~ ~ (lent a) ~)) (star cen)))
2016-11-24 07:25:07 +03:00
==
==
:- '&'
;~ pose
2017-09-19 03:19:22 +03:00
(cook |=(a/wing [%cnts a ~]) rope)
2018-03-20 05:42:13 +03:00
(stag %wtpd ;~(pfix pad (ifix [lit rit] (most ace wide))))
2018-03-14 07:36:10 +03:00
;~(plug (stag %rock (stag %f (cold & pad))) wede)
(stag %sand (stag %f (cold & pad)))
2016-11-24 07:25:07 +03:00
==
:- '\''
2017-04-17 01:37:40 +03:00
(stag %sand (stag %t qut))
2016-11-24 07:25:07 +03:00
:- '('
2018-03-14 07:36:10 +03:00
(stag %cncl (ifix [lit rit] (most ace wide)))
2016-11-24 07:25:07 +03:00
:- '{'
2018-03-19 06:38:01 +03:00
(stag %bccm (stag %bccl (ifix [leb reb] (most ace wyde))))
2016-11-24 07:25:07 +03:00
:- '*'
;~ pose
2018-03-14 06:17:30 +03:00
(stag %bcdt ;~(pfix tar wyde))
2016-11-24 07:25:07 +03:00
(cold [%base %noun] tar)
==
:- '@'
2018-03-19 06:38:01 +03:00
;~(pfix vat (stag %base (stag %atom mota)))
2016-11-24 07:25:07 +03:00
:- '+'
;~ pose
2018-03-14 07:36:10 +03:00
(stag %dtls ;~(pfix lus (ifix [lit rit] wide)))
2016-11-24 07:25:07 +03:00
::
%+ cook
|= a/(list (list woof))
2018-03-14 06:17:30 +03:00
:- %mcnt
2016-11-24 07:25:07 +03:00
[%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))]
(most dog ;~(pfix lus soil))
::
2017-09-19 03:19:22 +03:00
(cook |=(a/wing [%cnts a ~]) rope)
2016-11-24 07:25:07 +03:00
==
:- '-'
;~ pose
(stag %sand tash:so)
::
%+ cook
|= a/(list (list woof))
2017-09-18 21:50:10 +03:00
[%clsg (phax a)]
2016-11-24 07:25:07 +03:00
(most dog ;~(pfix hep soil))
::
2017-09-19 03:19:22 +03:00
(cook |=(a/wing [%cnts a ~]) rope)
2016-11-24 07:25:07 +03:00
==
:- '.'
;~ pose
(cook (jock |) ;~(pfix dot perd:so))
2017-09-19 03:19:22 +03:00
(cook |=(a/wing [%cnts a ~]) rope)
2016-11-24 07:25:07 +03:00
==
:- ['0' '9']
%+ cook
2017-11-17 00:50:03 +03:00
|= {a/dime b/(unit hoon)}
2016-11-24 07:25:07 +03:00
?~(b [%sand a] [[%rock a] u.b])
;~(plug bisk:so (punt wede))
2016-11-24 07:25:07 +03:00
:- ':'
;~ pfix col
;~ pose
2018-03-14 07:36:10 +03:00
(stag %mccl (ifix [lit rit] (most ace wide)))
;~(pfix net (stag %mcnt wide))
2016-11-24 07:25:07 +03:00
==
==
:- '='
2018-03-14 07:36:10 +03:00
(stag %dtts ;~(pfix tis (ifix [lit rit] ;~(glam wide wide))))
2016-11-24 07:25:07 +03:00
:- '?'
;~ pose
2018-03-14 06:17:30 +03:00
%+ stag %bccm
2018-03-14 07:36:10 +03:00
(stag %bcwt ;~(pfix wut (ifix [lit rit] (most ace wyde))))
::
2018-03-19 06:00:25 +03:00
(cold [%base %flag] wut)
2016-11-24 07:25:07 +03:00
==
:- '['
rupl
:- '^'
;~ pose
(stag %wing rope)
(cold [%base %cell] ket)
==
:- '`'
;~ pfix tec
;~ pose
%+ cook
2017-11-17 00:50:03 +03:00
|=({a/@ta b/hoon} [%ktls [%sand a 0] [%ktls [%sand %$ 0] b]])
2018-03-19 06:38:01 +03:00
;~(pfix vat ;~(plug mota ;~(pfix tec wide)))
2016-11-24 07:25:07 +03:00
;~ pfix tar
2017-09-20 02:24:30 +03:00
(stag %kthp (stag [%base %noun] ;~(pfix tec wide)))
2016-11-24 07:25:07 +03:00
==
2017-10-25 02:50:11 +03:00
(stag %kthp ;~(plug wyde ;~(pfix tec wide)))
2017-09-20 02:24:30 +03:00
(stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tec wide))))
2017-11-17 00:50:03 +03:00
(cook |=(a/hoon [[%rock %n ~] a]) wide)
2016-11-24 07:25:07 +03:00
==
==
:- '"'
%+ cook
|= a/(list (list woof))
[%knit |-(^-((list woof) ?~(a ~ (weld i.a $(a t.a)))))]
(most dog soil)
:- ['a' 'z']
rump
:- '|'
;~ pose
2017-09-19 03:19:22 +03:00
(cook |=(a/wing [%cnts a ~]) rope)
2018-03-14 07:36:10 +03:00
(stag %wtbr ;~(pfix bar (ifix [lit rit] (most ace wide))))
;~(plug (stag %rock (stag %f (cold | bar))) wede)
2016-11-24 07:25:07 +03:00
(stag %sand (stag %f (cold | bar)))
==
:- '~'
;~ pose
rupl
::
;~ pfix sig
;~ pose
2018-03-14 07:36:10 +03:00
(stag %clsg (ifix [lac rac] (most ace wide)))
2016-11-24 07:25:07 +03:00
::
2017-09-19 01:32:35 +03:00
%+ stag %cnsg
2016-11-24 07:25:07 +03:00
%+ ifix
2018-03-14 07:36:10 +03:00
[lit rit]
2016-11-24 07:25:07 +03:00
;~(glam rope wide (most ace wide))
::
(cook (jock |) twid:so)
(stag [%bust %null] wede)
(easy [%bust %null])
2016-11-24 07:25:07 +03:00
==
==
==
:- '/'
rood
:- '<'
(ifix [gal gar] (stag %tell (most ace wide)))
:- '>'
(ifix [gar gal] (stag %yell (most ace wide)))
==
++ soil
;~ pose
;~ less (jest '"""')
2018-04-14 08:31:53 +03:00
%+ ifix [yel yel]
2016-11-24 07:25:07 +03:00
%- star
;~ pose
2018-04-14 08:31:53 +03:00
;~(pfix bas ;~(pose bas yel leb bix:ab))
;~(less yel bas leb prn)
2016-11-24 07:25:07 +03:00
(stag ~ sump)
==
==
::
%- iny %+ ifix
[(jest '"""\0a') (jest '\0a"""')]
%- star
;~ pose
2018-03-19 06:38:01 +03:00
;~(pfix bas ;~(pose bas leb bix:ab))
;~(less bas leb prn)
2016-11-24 07:25:07 +03:00
;~(less (jest '\0a"""') (just `@`10))
(stag ~ sump)
==
==
2018-03-19 06:38:01 +03:00
++ sump (ifix [leb reb] (stag %cltr (most ace wide)))
2016-11-24 07:25:07 +03:00
++ norm :: rune regular form
2018-03-11 23:23:06 +03:00
|= tol/?
|%
++ structure
%- stew
^. stet ^. limo
:~ :- '$'
;~ pfix buc
%- stew
^. stet ^. limo
2018-03-20 05:42:13 +03:00
:~ [':' (rune col %bccl exqs)]
2018-03-11 23:23:06 +03:00
['%' (rune cen %bccn exqs)]
2018-03-19 23:38:19 +03:00
['<' (rune gal %bcgl exqb)]
['>' (rune gar %bcgr exqb)]
2018-03-11 23:23:06 +03:00
['^' (rune ket %bckt exqb)]
['~' (rune sig %bcsg exqd)]
2018-03-20 05:42:13 +03:00
['|' (rune bar %bcbr exqc)]
['&' (rune pad %bcpd exqc)]
['@' (rune vat %bcvt exqb)]
['_' (rune cab %bccb expa)]
2018-03-11 23:23:06 +03:00
['-' (rune hep %bchp exqb)]
['=' (rune tis %bcts exqg)]
['?' (rune wut %bcwt exqs)]
2018-03-14 07:36:10 +03:00
[';' (rune mic %bcmc expa)]
==
2018-03-11 23:23:06 +03:00
==
:- '%'
;~ pfix cen
%- stew
^. stet ^. limo
2018-03-14 01:22:10 +03:00
:~ :- '^'
%+ cook
2018-03-29 21:03:14 +03:00
|= [%cnkt a/hoon b/spec c/spec d/spec]
[%make a b c d ~]
2018-03-14 01:22:10 +03:00
(rune ket %cnkt exqy)
::
:- '+'
%+ cook
2018-03-29 21:03:14 +03:00
|= [%cnls a/hoon b/spec c/spec]
[%make a b c ~]
2018-03-14 01:22:10 +03:00
(rune lus %cnls exqx)
::
:- '-'
%+ cook
2018-03-29 21:03:14 +03:00
|= [%cnhp a/hoon b/spec]
[%make a b ~]
2018-03-14 06:17:30 +03:00
(rune hep %cnhp exqd)
2018-03-14 01:22:10 +03:00
::
:- ':'
%+ cook
2018-03-29 21:03:14 +03:00
|= [%cncl a/hoon b/(list spec)]
[%make a b]
2018-03-14 06:17:30 +03:00
(rune col %cncl exqz)
2018-03-11 23:23:06 +03:00
==
==
2018-03-11 23:23:06 +03:00
==
++ expression
%- stew
^. stet ^. limo
:~ :- '|'
;~ pfix bar
%- stew
^. stet ^. limo
2018-03-13 04:20:48 +03:00
:~ ['_' (runo cab %brcb [~ ~] exqr)]
2018-03-11 23:23:06 +03:00
['%' (runo cen %brcn [~ ~] expe)]
[':' (runo col %brcl [~ ~] expb)]
['.' (runo dot %brdt [~ ~] expa)]
['-' (runo hep %brhp [~ ~] expa)]
['^' (runo ket %brkt [~ ~] expx)]
2018-03-13 04:20:48 +03:00
['~' (runo sig %brsg [~ ~] exqc)]
['*' (runo tar %brtr [~ ~] exqc)]
['=' (runo tis %brts [~ ~] exqc)]
2018-03-11 23:23:06 +03:00
['?' (runo wut %brwt [~ ~] expa)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- '$'
;~ pfix buc
%- stew
^. stet ^. limo
2018-03-19 06:38:01 +03:00
:~ ['@' (stag %bccm (rune vat %bcvt exqb))]
2018-03-14 06:17:30 +03:00
['_' (stag %bccm (rune cab %bccb expa))]
[':' (stag %bccm (rune col %bccl exqs))]
['%' (stag %bccm (rune cen %bccn exqs))]
2018-03-19 23:38:19 +03:00
['<' (stag %bccm (rune gal %bcgl exqb))]
['>' (stag %bccm (rune gar %bcgr exqb))]
2018-03-20 05:42:13 +03:00
['|' (stag %bccm (rune bar %bcbr exqc))]
['&' (stag %bccm (rune pad %bcpd exqc))]
2018-03-14 06:17:30 +03:00
['^' (stag %bccm (rune ket %bckt exqb))]
['~' (stag %bccm (rune sig %bcsg exqd))]
['-' (stag %bccm (rune hep %bchp exqb))]
['=' (stag %bccm (rune tis %bcts exqg))]
['?' (stag %bccm (rune wut %bcwt exqs))]
['.' (rune dot %bcdt exqa)]
[',' (rune com %bccm exqa)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- '%'
;~ pfix cen
%- stew
^. stet ^. limo
:~ ['_' (rune cab %cncb exph)]
['.' (rune dot %cndt expb)]
['^' (rune ket %cnkt expd)]
['+' (rune lus %cnls expc)]
2018-03-14 06:17:30 +03:00
['-' (rune hep %cnhp expb)]
[':' (rune col %cncl expi)]
2018-03-11 23:23:06 +03:00
['~' (rune sig %cnsg expu)]
['*' (rune tar %cntr expm)]
['=' (rune tis %cnts exph)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- ':'
;~ pfix col
%- stew
^. stet ^. limo
:~ ['_' (rune cab %clcb expb)]
['^' (rune ket %clkt expd)]
['+' (rune lus %clls expc)]
['-' (rune hep %clhp expb)]
['~' (rune sig %clsg exps)]
['*' (rune tar %cltr exps)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- '.'
;~ pfix dot
%- stew
^. stet ^. limo
:~ ['+' (rune lus %dtls expa)]
['*' (rune tar %dttr expb)]
['=' (rune tis %dtts expb)]
['?' (rune wut %dtwt expa)]
['^' (rune ket %dtkt exqn)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- '^'
;~ pfix ket
%- stew
^. stet ^. limo
:~ ['|' (rune bar %ktbr expa)]
['.' (rune dot %ktdt expb)]
['-' (rune hep %kthp exqc)]
['+' (rune lus %ktls expb)]
2018-03-14 07:36:10 +03:00
['&' (rune pad %ktpd expa)]
2018-03-11 23:23:06 +03:00
['~' (rune sig %ktsg expa)]
['=' (rune tis %ktts expg)]
['?' (rune wut %ktwt expa)]
['%' (rune cen %ktcn expa)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- '~'
;~ pfix sig
%- stew
^. stet ^. limo
:~ ['|' (rune bar %sgbr expb)]
['$' (rune buc %sgbc expf)]
['_' (rune cab %sgcb expb)]
['%' (rune cen %sgcn hind)]
2018-03-14 07:36:10 +03:00
['/' (rune net %sgnt hine)]
2018-03-11 23:23:06 +03:00
['<' (rune gal %sggl hinb)]
['>' (rune gar %sggr hinb)]
['+' (rune lus %sgls hinc)]
2018-03-20 05:42:13 +03:00
['&' (rune pad %sgpd hinf)]
2018-03-11 23:23:06 +03:00
['?' (rune wut %sgwt hing)]
['=' (rune tis %sgts expb)]
['!' (rune zap %sgzp expb)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- ';'
2018-03-14 07:36:10 +03:00
;~ pfix mic
2018-03-11 23:23:06 +03:00
%- stew
^. stet ^. limo
2018-03-14 06:17:30 +03:00
:~ [':' (rune col %mccl expi)]
2018-03-14 07:36:10 +03:00
['/' (rune net %mcnt expa)]
2018-03-14 06:17:30 +03:00
['~' (rune sig %mcsg expi)]
2018-03-14 07:36:10 +03:00
[';' (rune mic %mcmc expb)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- '='
;~ pfix tis
%- stew
^. stet ^. limo
2018-03-13 04:20:48 +03:00
:~ ['|' (rune bar %tsbr exqc)]
2018-03-11 23:23:06 +03:00
['.' (rune dot %tsdt expq)]
['?' (rune wut %tswt expw)]
2018-03-13 04:20:48 +03:00
['^' (rune ket %tskt expt)]
2018-03-11 23:23:06 +03:00
[':' (rune col %tscl expp)]
2018-03-14 07:36:10 +03:00
['/' (rune net %tsnt expo)]
[';' (rune mic %tsmc expo)]
2018-03-11 23:23:06 +03:00
['<' (rune gal %tsgl expb)]
['>' (rune gar %tsgr expb)]
['-' (rune hep %tshp expb)]
['*' (rune tar %tstr expl)]
[',' (rune com %tscm expb)]
['+' (rune lus %tsls expb)]
['~' (rune sig %tssg expi)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- '?'
;~ pfix wut
%- stew
^. stet ^. limo
:~ ['|' (rune bar %wtbr exps)]
[':' (rune col %wtcl expc)]
['.' (rune dot %wtdt expc)]
['<' (rune gal %wtgl expb)]
['>' (rune gar %wtgr expb)]
2018-03-13 08:56:27 +03:00
['-' ;~(pfix hep (toad txhp))]
2018-03-11 23:23:06 +03:00
['^' ;~(pfix ket (toad tkkt))]
2018-03-13 08:56:27 +03:00
['=' ;~(pfix tis (toad txts))]
['+' ;~(pfix lus (toad txls))]
2018-03-20 05:42:13 +03:00
['&' (rune pad %wtpd exps)]
2018-03-19 06:38:01 +03:00
['@' ;~(pfix vat (toad tkvt))]
2018-03-11 23:23:06 +03:00
['~' ;~(pfix sig (toad tksg))]
['!' (rune zap %wtzp expa)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
:- '!'
;~ pfix zap
%- stew
^. stet ^. limo
:~ [':' ;~(pfix col (toad expz))]
['.' ;~(pfix dot (toad |.(loaf(bug |))))]
[',' (rune com %zpcm expb)]
2018-03-14 07:36:10 +03:00
[';' (rune mic %zpmc expb)]
2018-03-11 23:23:06 +03:00
['>' (rune gar %zpgr expa)]
2018-03-27 02:55:02 +03:00
['@' (rune vat %zpvt expy)]
2018-03-11 23:23:06 +03:00
['=' (rune tis %zpts expa)]
['?' (rune wut %zpwt hinh)]
2016-11-24 07:25:07 +03:00
==
2018-03-11 23:23:06 +03:00
==
==
::
2016-11-24 07:25:07 +03:00
++ boog :: core arms
%+ knee [p=*term q=*(pair what foot)] |. ~+
2017-04-05 03:33:20 +03:00
%+ cook
|= {a/whit b/term c/whit d/foot}
2018-03-27 02:55:02 +03:00
[b ~ d]
:: =+ e=(glom a c)
:: =? boy.e =(~ boy.e)
:: |-(?+(-.p.d ~ $dbug $(p.d q.p.d), %docs `p.p.d))
:: =. p.d
:: |-
:: ?+ p.d ?~(boy.e p.d [%docs u.boy.e p.d])
:: [%dbug ^] p.d(q $(p.d q.p.d))
:: [%docs ^] p.d
:: ==
:: [b boy.e d]
2017-11-16 04:04:48 +03:00
::
2017-04-05 03:33:20 +03:00
;~ plug
apex:docs
;~ pose
%+ cook
2017-11-17 00:50:03 +03:00
|=({a/$ash b/term c/whit d/hoon} [b c a d])
;~ plug
(cold %ash (jest '++'))
;~(pfix gap ;~(pose (cold %$ buc) sym))
apse:docs
;~(pfix gap loaf)
==
::
%+ cook
2017-11-17 00:50:03 +03:00
|=({a/$elm b/term c/whit d/hoon} [b c a d])
;~ plug
(cold %elm (jest '+-'))
;~(pfix gap ;~(pose (cold %$ buc) sym))
apse:docs
;~(pfix gap loaf)
==
::
%+ cook
|=({a/$ash b/term c/whit d/hoon} [b c a d])
;~ plug
(cold %ash (jest '+='))
;~(pfix gap sym)
apse:docs
2018-03-14 06:17:30 +03:00
;~(pfix gap (stag %bccm loan))
==
2016-11-24 07:25:07 +03:00
==
==
::
++ whap :: chapter
%+ cook
|= a=(list (trel term what foot))
%+ roll a
|= [b=(trel term what foot) c=(map term [what foot])]
^+ c
=? p.r.b (~(has by c) p.b) [%eror "duplicate arm {<p.b>}"]
(~(put by c) b)
(most muck boog)
::
++ wasp :: $brcb aliases
2017-12-02 06:02:46 +03:00
;~ pose
%+ ifix
[;~(plug lus tar muck) muck]
(most muck ;~(gunk sym loaf))
::
(easy ~)
==
::
2016-11-24 07:25:07 +03:00
++ wisp :: core tail
?. tol fail
%+ cook
|= a=(list (pair whit (map term [what foot]))) ^- (map @ tomb)
=< tos
%+ roll a
|= $: [wit=whit wap=(map term (pair what foot))]
[all=(map term *) num=@ tos=(map @ tomb)]
==
=. wap
%- ~(urn by wap)
|= b=(trel term what foot) ^+ +.b
?. (~(has by all) p.b) +.b
+.b(p.r [%eror "duplicate arm {<p.b>}"])
::
=. all (~(uni by all) `(map term *)`wap)
[all +(num) (~(put by tos) num [[lab boy]:wit wap])]
::
;~ pose
dun
;~ sfix
;~ pose
2017-11-16 01:39:02 +03:00
(most muck ;~(plug apex:docs ;~(pfix (jest '+|') gap whap)))
;~(plug (stag *whit whap) (easy ~))
==
2017-11-16 01:39:02 +03:00
gap
dun
==
==
2016-11-24 07:25:07 +03:00
::
++ toad :: untrap parser exp
2017-12-14 06:47:01 +03:00
=+ har=expa
|% +- $
2018-03-14 07:36:10 +03:00
=+ dur=(ifix [lit rit] $:har(tol |))
2017-12-14 06:47:01 +03:00
?:(tol ;~(pose ;~(pfix gap $:har(tol &)) dur) dur)
--
2016-11-24 07:25:07 +03:00
::
++ rune :: build rune
2017-12-14 06:47:01 +03:00
=+ [dif=*rule tuq=** har=expa]
|% +- $
;~(pfix dif (stag tuq (toad har)))
--
2016-11-24 07:25:07 +03:00
::
2017-04-17 01:37:40 +03:00
++ runo :: rune plus
2017-12-14 06:47:01 +03:00
=+ [dif=*rule hil=** tuq=** har=expa]
|% +- $
;~(pfix dif (stag hil (stag tuq (toad har))))
--
2017-04-17 01:37:40 +03:00
::
2016-11-24 07:25:07 +03:00
++ glop ~+((glue mash)) :: separated by space
++ gunk ~+((glue muck)) :: separated list
++ butt |* zor/rule :: closing == if tall
?:(tol ;~(sfix zor ;~(plug gap duz)) zor)
++ ulva |* zor/rule :: closing -- and tall
?.(tol fail ;~(sfix zor ;~(plug gap dun)))
2017-11-17 00:50:03 +03:00
++ hank (most muck loaf) :: gapped hoons
2018-03-29 21:03:14 +03:00
++ hunk (most muck loan) :: gapped specs
2017-11-17 00:50:03 +03:00
++ loaf ?:(tol tall wide) :: tall/wide hoon
2018-03-29 21:03:14 +03:00
++ loan ?:(tol till wyde) :: tall/wide spec
2016-11-24 07:25:07 +03:00
++ mash ?:(tol gap ;~(plug com ace)) :: list separator
++ muck ?:(tol gap ace) :: general separator
2017-11-17 00:50:03 +03:00
++ teak %+ knee *tiki |. ~+ :: wing or hoon
2016-11-24 07:25:07 +03:00
=+ ^= gub
2018-03-19 06:54:47 +03:00
|= {a/term b/$%({%& p/wing} {%| p/hoon})}
2016-11-24 07:25:07 +03:00
^- tiki
2018-03-19 06:54:47 +03:00
?-(-.b %& [%& [~ a] p.b], %| [%| [~ a] p.b])
2016-11-24 07:25:07 +03:00
=+ ^= wyp
;~ pose
%+ cook gub
;~ plug
sym
;~(pfix tis ;~(pose (stag %& rope) (stag %| wide)))
==
::
(stag %& (stag ~ rope))
(stag %| (stag ~ wide))
==
?. tol wyp
;~ pose
wyp
::
;~ pfix
;~(plug ket tis gap)
%+ cook gub
;~ plug
sym
;~(pfix gap ;~(pose (stag %& rope) (stag %| tall)))
==
==
::
(stag %| (stag ~ tall))
==
2017-11-17 00:50:03 +03:00
++ rack (most mash ;~(gunk loaf loaf)) :: list [hoon hoon]
2018-03-29 21:03:14 +03:00
++ ruck (most mash ;~(gunk loan loaf)) :: list [spec hoon]
2017-11-17 00:50:03 +03:00
++ rick (most mash ;~(gunk rope loaf)) :: list [wing hoon]
2016-11-24 07:25:07 +03:00
::
2017-11-17 00:50:03 +03:00
:: hoon contents
2016-11-24 07:25:07 +03:00
::
2017-11-17 00:50:03 +03:00
++ expa |.(loaf) :: one hoon
++ expb |.(;~(gunk loaf loaf)) :: two hoons
++ expc |.(;~(gunk loaf loaf loaf)) :: three hoons
++ expd |.(;~(gunk loaf loaf loaf loaf)) :: four hoons
2016-11-24 07:25:07 +03:00
++ expe |.(wisp) :: core tail
2017-11-17 00:50:03 +03:00
++ expf |.(;~(gunk ;~(pfix cen sym) loaf)) :: %term and hoon
++ expg |.(;~(gunk sym loaf)) :: term and hoon
2018-03-29 21:03:14 +03:00
++ exph |.((butt ;~(gunk rope rick))) :: wing, [spec hoon]s
2017-11-17 00:50:03 +03:00
++ expi |.((butt ;~(gunk loaf hank))) :: one or more hoons
++ expk |.(;~(gunk loaf ;~(plug loaf (easy ~)))) :: list of two hoons
++ expl |.(;~(gunk (stag ~ sym) loaf loaf)) :: term, two hoons
2018-03-29 21:03:14 +03:00
++ expm |.((butt ;~(gunk rope loaf rick))) :: several [spec hoon]s
2016-11-24 07:25:07 +03:00
++ expo |.(;~(gunk wise loaf loaf)) :: =;
2017-11-17 00:50:03 +03:00
++ expp |.(;~(gunk (butt rick) loaf)) :: [wing hoon]s, hoon
++ expq |.(;~(gunk rope loaf loaf)) :: wing and two hoons
++ expr |.(;~(gunk loaf wisp)) :: hoon and core tail
++ exps |.((butt hank)) :: closed gapped hoons
2016-11-24 07:25:07 +03:00
++ expt |.(;~(gunk wise rope loaf loaf)) :: =^
2017-11-17 00:50:03 +03:00
++ expu |.(;~(gunk rope loaf (butt hank))) :: wing, hoon, hoons
2016-11-24 07:25:07 +03:00
++ expv |.((butt rick)) :: just changes
2017-11-17 00:50:03 +03:00
++ expw |.(;~(gunk rope loaf loaf loaf)) :: wing and three hoons
++ expx |. ;~ gunk loaf :: hoon and core tail
2017-04-17 01:37:40 +03:00
%+ sear ::
|= a/(map @ tomb) ::
^- (unit (map @ tomb)) ::
=+ fir=(~(got by a) 0) ::
?: (~(has by q.fir) %$) :: %$ in first chapter
~ ::
[~ u=a] ::
2017-04-17 01:37:40 +03:00
wisp ::
== ::
2018-03-27 02:55:02 +03:00
++ expy |.(;~(gunk ropa loaf loaf)) :: wings and two hoons
2017-11-17 00:50:03 +03:00
++ expz |.(loaf(bug &)) :: hoon with tracing
2018-03-29 21:03:14 +03:00
:: spec contents
::
2017-11-17 00:50:03 +03:00
++ exqa |.(loan) :: one hoon
2018-03-29 21:03:14 +03:00
++ exqb |.(;~(gunk loan loan)) :: two specs
++ exqc |.(;~(gunk loan loaf)) :: spec then hoon
++ exqd |.(;~(gunk loaf loan)) :: hoon then spec
++ exqs |.((butt hunk)) :: closed gapped specs
++ exqg |.(;~(gunk sym loan)) :: term and spec
++ exqk |.(;~(gunk loaf ;~(plug loan (easy ~)))) :: hoon with one spec
++ exqr |.(;~(gunk loan ;~(plug wasp wisp))) :: spec/aliases?/tail
2017-11-17 00:50:03 +03:00
++ exqn |.(;~(gunk loan (stag %cltr (butt hank)))):: autoconsed hoons
2018-03-29 21:03:14 +03:00
++ exqw |.(;~(gunk loaf loan)) :: hoon and spec
++ exqx |.(;~(gunk loaf loan loan)) :: hoon, two specs
++ exqy |.(;~(gunk loaf loan loan loan)) :: hoon, three specs
++ exqz |.(;~(gunk loaf (butt hunk))) :: hoon, n specs
::
2016-11-24 07:25:07 +03:00
:: tiki expansion for %wt runes
::
2018-03-29 21:03:14 +03:00
++ txhp |. %+ cook |= {a/tiki b/(list (pair spec hoon))}
(~(wthp ah a) b)
2018-03-12 08:29:13 +03:00
(butt ;~(gunk teak ruck))
2017-11-17 00:50:03 +03:00
++ tkkt |. %+ cook |= {a/tiki b/hoon c/hoon}
2016-11-24 07:25:07 +03:00
(~(wtkt ah a) b c)
;~(gunk teak loaf loaf)
2018-03-29 21:03:14 +03:00
++ txls |. %+ cook |= {a/tiki b/hoon c/(list (pair spec hoon))}
(~(wtls ah a) b c)
2018-03-12 08:29:13 +03:00
(butt ;~(gunk teak loaf ruck))
2018-03-19 05:40:38 +03:00
++ tkvt |. %+ cook |= {a/tiki b/hoon c/hoon}
(~(wtvt ah a) b c)
2016-11-24 07:25:07 +03:00
;~(gunk teak loaf loaf)
2017-11-17 00:50:03 +03:00
++ tksg |. %+ cook |= {a/tiki b/hoon c/hoon}
2016-11-24 07:25:07 +03:00
(~(wtsg ah a) b c)
;~(gunk teak loaf loaf)
2018-03-29 21:03:14 +03:00
++ txts |. %+ cook |= {a/spec b/tiki}
(~(wtts ah b) a)
2018-03-12 08:29:13 +03:00
;~(gunk loan teak)
2016-11-24 07:25:07 +03:00
::
:: hint syntax
::
2017-11-17 00:50:03 +03:00
++ hinb |.(;~(gunk bont loaf)) :: hint and hoon
++ hinc |. :: optional =en, hoon
;~(pose ;~(gunk bony loaf) (stag ~ loaf)) ::
2017-11-17 00:50:03 +03:00
++ hind |.(;~(gunk bonk loaf bonz loaf)) :: jet hoon "bon"s hoon
++ hine |.(;~(gunk bonk loaf)) :: jet-hint and hoon
++ hinf |. :: 0-3 >s, two hoons
2016-11-24 07:25:07 +03:00
;~ pose
;~(gunk (cook lent (stun [1 3] gar)) loaf loaf)
(stag 0 ;~(gunk loaf loaf))
==
2017-11-17 00:50:03 +03:00
++ hing |. :: 0-3 >s, three hoons
2016-11-24 07:25:07 +03:00
;~ pose
;~(gunk (cook lent (stun [1 3] gar)) loaf loaf loaf)
(stag 0 ;~(gunk loaf loaf loaf))
==
++ bonk :: jet signature
;~ pfix cen
;~ pose
;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot ;~(pfix dot dem)))))
;~(plug sym ;~(pfix col ;~(plug sym ;~(pfix dot dem))))
;~(plug sym ;~(pfix dot dem))
sym
==
==
2017-11-17 00:50:03 +03:00
++ hinh |. :: 1/2 numbers, hoon
2016-11-24 07:25:07 +03:00
;~ gunk
;~ pose
dem
2018-03-14 07:36:10 +03:00
(ifix [lac rac] ;~(plug dem ;~(pfix ace dem)))
2016-11-24 07:25:07 +03:00
==
loaf
==
2017-11-17 00:50:03 +03:00
++ bont ;~ (bend) :: term, optional hoon
2016-11-24 07:25:07 +03:00
;~(pfix cen sym)
;~(pfix dot ;~(pose wide ;~(pfix muck loaf)))
==
++ bony (cook |=(a/(list) (lent a)) (plus tis)) :: base 1 =en count
2017-11-17 00:50:03 +03:00
++ bonz :: term-labelled hoons
2016-11-24 07:25:07 +03:00
;~ pose
(cold ~ sig)
%+ ifix
2018-03-14 07:36:10 +03:00
?:(tol [;~(plug duz gap) ;~(plug gap duz)] [lit rit])
2016-11-24 07:25:07 +03:00
(more mash ;~(gunk ;~(pfix cen sym) loaf))
==
--
::
++ lang :: lung sample
2017-11-17 00:50:03 +03:00
$: ros/hoon
2016-11-24 07:25:07 +03:00
$= vil
2017-11-17 00:50:03 +03:00
$% {$tis p/hoon}
{$col p/hoon}
{$ket p/hoon}
2018-03-14 07:36:10 +03:00
{$lit p/(list (pair wing hoon))}
2016-11-24 07:25:07 +03:00
==
==
::
++ lung
~+
%- bend
2017-12-14 06:47:01 +03:00
|: $:lang
2017-11-17 00:50:03 +03:00
^- (unit hoon)
2016-11-24 07:25:07 +03:00
?- -.vil
2018-03-19 06:00:25 +03:00
$col ?:(=([%base %flag] ros) ~ [~ %tsgl ros p.vil])
2018-03-14 07:36:10 +03:00
$lit (bind ~(reek ap ros) |=(hyp/wing [%cnts hyp p.vil]))
2016-11-24 07:25:07 +03:00
$ket [~ ros p.vil]
$tis =+ tog=~(hock ap ros)
2017-09-20 02:24:30 +03:00
?:(=([%0 ~] tog) ~ [~ %ktts tog p.vil])
2016-11-24 07:25:07 +03:00
==
::
++ long
2017-11-17 00:50:03 +03:00
%+ knee *hoon |. ~+
2016-11-24 07:25:07 +03:00
;~ lung
scat
;~ pose
;~(plug (cold %tis tis) wide)
;~(plug (cold %col col) wide)
;~(plug (cold %ket ket) wide)
;~ plug
2018-03-14 07:36:10 +03:00
(easy %lit)
(ifix [lit rit] lobo)
2016-11-24 07:25:07 +03:00
==
==
==
::
++ lobo (most ;~(plug com ace) ;~(glam rope wide))
++ loon (most ;~(plug com ace) ;~(glam wide wide))
++ lute :: tall [] noun
~+
2018-03-13 08:56:27 +03:00
%+ cook |=(hoon +<)
2017-09-18 21:50:10 +03:00
%+ stag %cltr
2016-11-24 07:25:07 +03:00
%+ ifix
2018-03-14 07:36:10 +03:00
[;~(plug lac gap) ;~(plug gap rac)]
2016-11-24 07:25:07 +03:00
(most gap tall)
::
2018-03-27 02:55:02 +03:00
++ ropa (most col rope)
2016-11-24 07:25:07 +03:00
++ rope :: wing form
%+ knee *wing
|. ~+
%+ (slug |=({a/limb b/wing} [a b]))
dot
;~ pose
(cold [%| 0 ~] com)
%+ cook
|=({a/(list) b/term} ?~(a b [%| (lent a) `b]))
;~(plug (star ket) ;~(pose sym (cold %$ buc)))
::
%+ cook
|=(a/axis [%& a])
;~ pose
;~(pfix lus dim:ag)
2018-03-14 07:36:10 +03:00
;~(pfix pad (cook |=(a/@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag))
2016-11-24 07:25:07 +03:00
;~(pfix bar (cook |=(a/@ ?:(=(0 a) 1 +((mul 2 $(a (dec a)))))) dim:ag))
ven
(cold 1 dot)
==
==
::
2018-03-14 07:36:10 +03:00
++ wise ;~(plug sym (punt ;~(pfix ;~(pose net tis) wyde)))
2017-04-05 03:33:20 +03:00
++ wrap
|* fel/rule
%+ cook
2017-11-17 00:50:03 +03:00
|= {a/whit b/hoon c/whit}
^- hoon
2017-04-05 03:33:20 +03:00
~(graf ~(gi ap b) (glom a c))
::
:: XX performance: this makes the parser about 50% slower.
:: because we double-parse most of the spaces in the file.
:: just so we can do a postfix doc-comment.
::
:: the correct solution to this problem is to unify the
:: parsing of docs with the parsing of comments/spaces.
:: but at this point we're pretty much in parser rewrite.
::
:: it should go without saying that ++vast needs a rewrite.
:: it dates to 2011.
::
2017-04-17 01:37:40 +03:00
;~ plug
2017-04-05 03:33:20 +03:00
apex:docs
fel
apse:docs
2017-10-31 22:50:21 +03:00
==
2018-03-11 23:48:32 +03:00
++ wrip
|* fel/rule
%+ cook
2018-03-29 21:03:14 +03:00
|= {a/whit b/spec c/whit}
^- spec
2018-03-11 23:48:32 +03:00
b
::
:: XX performance: this makes the parser about 50% slower.
:: because we double-parse most of the spaces in the file.
:: just so we can do a postfix doc-comment.
::
:: the correct solution to this problem is to unify the
:: parsing of docs with the parsing of comments/spaces.
:: but at this point we're pretty much in parser rewrite.
::
:: it should go without saying that ++vast needs a rewrite.
:: it dates to 2011.
::
;~ plug
apex:docs
fel
apse:docs
==
2017-10-31 04:13:06 +03:00
++ tall :: full tall form
2017-11-17 00:50:03 +03:00
%+ knee *hoon
2018-03-11 23:23:06 +03:00
|.(~+((wart (wrap ;~(pose expression:(norm &) long lute apex:(sail &))))))
2017-10-31 04:13:06 +03:00
++ till :: mold tall form
2018-03-29 21:03:14 +03:00
%+ knee *spec
2018-03-11 23:48:32 +03:00
|.(~+((wert (wrip ;~(pose structure:(norm &) scad)))))
++ wede :: wide bulb
:: XX: lus here is deprecated in Hoon 143
::
2018-03-14 07:36:10 +03:00
;~(pfix ;~(pose lus net) wide)
2017-10-31 04:13:06 +03:00
++ wide :: full wide form
2017-11-17 00:50:03 +03:00
%+ knee *hoon
2018-03-11 23:23:06 +03:00
|.(~+((wart ;~(pose expression:(norm |) long apex:(sail |)))))
2017-10-31 04:13:06 +03:00
++ wyde :: mold wide form
2018-03-29 21:03:14 +03:00
%+ knee *spec
2018-03-11 23:23:06 +03:00
|.(~+((wert ;~(pose structure:(norm |) scad))))
2016-11-24 07:25:07 +03:00
++ wart
|* zor/rule
%+ here
2017-11-17 00:50:03 +03:00
|= {a/pint b/hoon}
2016-11-24 07:25:07 +03:00
?:(bug [%dbug [wer a] b] b)
zor
2018-03-11 23:23:06 +03:00
++ wert
|* zor/rule
%+ here
2018-03-29 21:03:14 +03:00
|= {a/pint b/spec}
2018-03-11 23:23:06 +03:00
?:(bug [%dbug [wer a] b] b)
zor
2016-11-24 07:25:07 +03:00
--
::
++ vest
~/ %vest
|= tub/nail
2017-11-17 00:50:03 +03:00
^- (like hoon)
2016-11-24 07:25:07 +03:00
%. tub
%- full
(ifix [gay gay] tall:vast)
::
++ vice
|= txt/@ta
2017-11-17 00:50:03 +03:00
^- hoon
2016-11-24 07:25:07 +03:00
(rash txt wide:vast)
::
++ make :: compile cord to nock
|= txt/@
q:(~(mint ut %noun) %noun (ream txt))
::
++ rain :: parse with % path
|= {bon/path txt/@}
2017-11-17 00:50:03 +03:00
^- hoon
2016-11-24 07:25:07 +03:00
=+ vaz=vast
~| bon
(scan (trip txt) (full (ifix [gay gay] tall:vaz(wer bon))))
::
2017-11-17 00:50:03 +03:00
++ ream :: parse cord to hoon
2016-11-24 07:25:07 +03:00
|= txt/@
2017-11-17 00:50:03 +03:00
^- hoon
2016-11-24 07:25:07 +03:00
(rash txt vest)
::
++ reck :: parse hoon file
|= bon/path
(rain bon .^(@t %cx (weld bon `path`[%hoon ~])))
::
++ ride :: end-to-end compiler
2017-11-16 23:44:27 +03:00
|= {typ/type txt/@}
^- (pair type nock)
(~(mint ut typ) %noun (ream txt))
2016-11-24 07:25:07 +03:00
::
:::: 5e: caching compiler
::
++ wa !: :: cached compile
|_ worm
2017-11-16 23:44:27 +03:00
++ nell |=(ref/type (nest [%cell %noun %noun] ref)) :: nest in cell
2016-11-24 07:25:07 +03:00
++ nest :: nest:ut
2017-11-16 23:44:27 +03:00
|= {sut/type ref/type}
2016-11-24 07:25:07 +03:00
^- {? worm}
?: (~(has in nes) [sut ref]) [& +>+<]
?. (~(nest ut sut) | ref)
~& %nest-failed
=+ foo=(skol ref)
=+ bar=(skol sut)
~& %nets-need
~> %slog.[0 bar]
~& %nest-have
~> %slog.[0 foo]
[| +>+<.$]
[& +>+<(nes (~(put in nes) [sut ref]))]
::
2017-02-27 06:57:03 +03:00
++ call :: call gate
|= {vax/vase nam/term som/(each vase ^)}
^- {vase worm}
=^ duf +>+<.$ (open vax nam som)
(slap duf [%limb %$])
::
++ open :: assemble door
|= {vax/vase nam/term som/(each vase ^)}
^- {vase worm}
2017-09-19 03:55:32 +03:00
=* key [%cncb [[%& 2] ~] [[[%& 6] ~] [%$ 3]] ~]
2017-02-27 06:57:03 +03:00
=^ dor +>+<.$ (slap vax [%limb nam])
=^ mes +>+<.$ (slot 6 dor)
2017-02-28 01:52:18 +03:00
=^ hip +>+<.$
?- -.som
2018-03-19 06:54:47 +03:00
%& (nest p.mes p.p.som)
%| (nets p.mes -.p.som)
2017-02-28 01:52:18 +03:00
==
2017-02-27 06:57:03 +03:00
?> hip
2017-02-28 01:52:18 +03:00
[[p.dor q.dor(+6 +7.som)] +>+<.$]
2017-02-27 06:57:03 +03:00
::
++ neat :: type compliance
2017-11-16 23:44:27 +03:00
|= {typ/type som/(each vase ^)}
2017-02-27 06:57:03 +03:00
^- worm
=^ hip +>+<.$
?- -.som
2018-03-19 06:54:47 +03:00
%& (nest typ p.p.som)
%| (nets typ -.p.som)
2017-02-27 06:57:03 +03:00
==
?> hip
+>+<.$
::
2017-11-16 23:44:27 +03:00
++ nets :: typeless nest
2016-11-24 07:25:07 +03:00
|= {sut/* ref/*}
^- {? worm}
?: (~(has in nes) [sut ref]) [& +>+<]
2017-11-16 23:44:27 +03:00
=+ gat=|=({a/type b/type} (~(nest ut a) | b))
2016-11-24 07:25:07 +03:00
?. (? .*(gat(+< [sut ref]) -.gat))
~& %nets-failed
=+ tag=`*`skol
=+ foo=(tank .*(tag(+< ref) -.tag))
=+ bar=(tank .*(tag(+< sut) -.tag))
~& %nets-need
~> %slog.[0 bar]
~& %nets-have
~> %slog.[0 foo]
[| +>+<.$]
[& +>+<.$(nes (~(put in nes) [sut ref]))]
2016-11-24 07:25:07 +03:00
::
++ play :: play:ut
2017-11-17 00:50:03 +03:00
|= {sut/type gen/hoon}
2017-11-16 23:44:27 +03:00
^- {type worm}
2016-11-24 07:25:07 +03:00
=+ old=(~(get by pay) [sut gen])
?^ old [u.old +>+<.$]
=+ new=(~(play ut sut) gen)
[new +>+<.$(pay (~(put by pay) [sut gen] new))]
::
++ mint :: mint:ut to noun
2017-11-17 00:50:03 +03:00
|= {sut/type gen/hoon}
2017-11-16 23:44:27 +03:00
^- {(pair type nock) worm}
2016-11-24 07:25:07 +03:00
=+ old=(~(get by mit) [sut gen])
?^ old [u.old +>+<.$]
=+ new=(~(mint ut sut) %noun gen)
[new +>+<.$(mit (~(put by mit) [sut gen] new))]
::
++ slap :: ++slap, cached
2017-11-17 00:50:03 +03:00
|= {vax/vase gen/hoon}
2016-11-24 07:25:07 +03:00
^- {vase worm}
=^ gun +>+< (mint p.vax gen)
[[p.gun .*(q.vax q.gun)] +>+<.$]
::
++ slot :: ++slot, cached
|= {axe/@ vax/vase}
^- {vase worm}
=^ gun +>+< (mint p.vax [%$ axe])
[[p.gun .*(q.vax [0 axe])] +>+<.$]
::
2018-03-29 21:03:14 +03:00
++ sped :: specialize vase
2016-11-24 07:25:07 +03:00
|= vax/vase
^- {vase worm}
2017-11-17 00:50:03 +03:00
=+ ^= gen ^- hoon
2017-09-21 00:13:10 +03:00
?@ q.vax [%wtts [%base [%atom %$]] [%& 1]~]
?@ -.q.vax [%wtts [%leaf %tas -.q.vax] [%& 2]~]
[%wtts [%base %cell] [%& 1]~]
=^ typ +>+<.$ (play p.vax [%wtgr gen [%$ 1]])
2016-11-24 07:25:07 +03:00
[[typ q.vax] +>+<.$]
::
2018-03-29 21:03:14 +03:00
++ spot :: slot then sped
2016-11-24 07:25:07 +03:00
|= {axe/@ vax/vase}
^- {vase worm}
=^ xav +>+< (slot axe vax)
2018-03-29 21:03:14 +03:00
(sped xav)
2016-11-24 07:25:07 +03:00
::
2018-03-29 21:03:14 +03:00
++ stop :: sped then slot
2016-11-24 07:25:07 +03:00
|= {axe/@ vax/vase}
^- {vase worm}
2018-03-29 21:03:14 +03:00
=^ xav +>+< (sped vax)
2016-11-24 07:25:07 +03:00
(slot axe xav)
--
::
:::: 5f: molds and mold builders
::
++ arch {fil/(unit @uvI) dir/(map @ta ~)} :: fundamental node
2016-11-24 07:25:07 +03:00
++ arvo (wind {p/term q/mill} mill) :: arvo card
++ beak {p/ship q/desk r/case} :: path prefix
++ beam {{p/ship q/desk r/case} s/spur} :: global name
2016-11-24 07:25:07 +03:00
++ bone @ud :: opaque duct
++ case :: version
$% {$da p/@da} :: date
{$tas p/@tas} :: label
{$ud p/@ud} :: sequence
== ::
2016-11-24 07:25:07 +03:00
++ desk @tas :: ship desk case spur
++ cage (cask vase) :: global metadata
++ cask |*(a/$-(* *) (pair mark a)) :: global data
++ cuff :: permissions
$: p/(unit (set monk)) :: can be read by
q/(set monk) :: caused or created by
== ::
2017-11-16 23:44:27 +03:00
++ curd {p/@tas q/*} :: typeless card
2016-11-24 07:25:07 +03:00
++ dock (pair @p term) :: message target
++ duct (list wire) :: causal history
2017-11-16 23:44:27 +03:00
++ hypo |*(a/$-(* *) (pair type a)) :: type associated
2016-11-24 07:25:07 +03:00
++ hobo |* a/$-(* *) :: task wrapper
$? $% {$soft p/*} ::
== ::
a ::
== ::
++ kirk (unit (set monk)) :: audience
++ lens :: observation core
$_ ^? ::
|% ++ u *(unit (unit ~)) :: existence
2016-11-24 07:25:07 +03:00
++ v *(unit (unit cage)) :: full history
++ w *(unit (unit (unit cage))) :: latest diff
++ x *(unit (unit cage)) :: data at path
++ y *(unit (unit arch)) :: directory
++ z *(unit (unit cage)) :: current subtree
-- ::
++ mane $@(@tas {@tas @tas}) :: XML name+space
2018-02-11 08:24:22 +03:00
++ manx $~([[%$ ~] ~] {g/marx c/marl}) :: dynamic XML node
2016-11-24 07:25:07 +03:00
++ marc :: structured mark
$@ mark :: plain mark
$% {$tabl p/(list (pair marc marc))} :: map
== ::
2017-11-16 23:44:27 +03:00
++ mark @tas :: content type
2016-11-24 07:25:07 +03:00
++ marl (list manx) :: XML node list
2018-02-11 08:24:22 +03:00
++ mars {t/{n/$$ a/{i/{n/$$ v/tape} t/~}} c/~} :: XML cdata
2016-11-24 07:25:07 +03:00
++ mart (list {n/mane v/tape}) :: XML attributes
2018-02-11 08:24:22 +03:00
++ marx $~([%$ ~] {n/mane a/mart}) :: dynamic XML tag
2016-11-24 07:25:07 +03:00
++ mash |=(* (mass +<)) :: producing mass
++ mass (pair cord (each noun (list mash))) :: memory usage
2016-11-24 07:25:07 +03:00
++ mill (each vase milt) :: vase+metavase
++ milt {p/* q/*} :: metavase
++ mite (list @ta) :: mime type
++ monk (each ship {p/@tas q/@ta}) :: general identity
++ muse {p/@tas q/duct r/arvo} :: sourced move
++ move {p/duct q/arvo} :: arvo move
2017-11-16 23:44:27 +03:00
++ ovum {p/wire q/curd} :: typeless ovum
2016-11-24 07:25:07 +03:00
++ pane (list {p/@tas q/vase}) :: kernel modules
++ pass @ :: public key
++ pone (list {p/@tas q/vise}) :: kernel modules old
++ ring @ :: private key
++ ship @p :: network identity
++ shop (each ship (list @ta)) :: urbit/dns identity
++ sink (trel bone ship path) :: subscription
++ spur path :: ship desk case spur
++ time @da :: galactic time
++ vile :: reflexive constants
2017-11-16 23:44:27 +03:00
$: typ/type :: -:!>(*type)
duc/type :: -:!>(*duct)
pah/type :: -:!>(*path)
mev/type :: -:!>([%meta *vase])
2016-11-24 07:25:07 +03:00
== ::
++ wind :: new kernel action
|* {a/$-(* *) b/$-(* *)} :: forward+reverse
$% {$pass p/path q/a} :: advance
{$slip p/a} :: lateral
{$give p/b} :: retreat
== ::
++ wire path :: event pretext
::
:::: 5g: profiling support (XX move)
::
::
++ pi-heck
|= {nam/@tas day/doss}
^- doss
=+ lam=(~(get by hit.day) nam)
day(hit (~(put by hit.day) nam ?~(lam 1 +(u.lam))))
::
2017-12-02 07:57:53 +03:00
++ pi-noon :: sample trace
2016-11-24 07:25:07 +03:00
|= {mot/term paz/(list path) day/doss}
=| lax/(unit path)
|- ^- doss
?~ paz day(mon (pi-mope mot mon.day))
%= $
paz t.paz
lax `i.paz
cut.day
%+ ~(put by cut.day) i.paz
^- hump
=+ nax=`(unit path)`?~(t.paz ~ `i.t.paz)
=+ hup=`hump`=+(hup=(~(get by cut.day) i.paz) ?^(hup u.hup [*moan ~ ~]))
:+ (pi-mope mot mon.hup)
?~ lax out.hup
=+ hag=(~(get by out.hup) u.lax)
(~(put by out.hup) u.lax ?~(hag 1 +(u.hag)))
?~ nax inn.hup
=+ hag=(~(get by inn.hup) u.nax)
(~(put by inn.hup) u.nax ?~(hag 1 +(u.hag)))
==
++ pi-mope :: add sample
|= {mot/term mon/moan}
?+ mot mon
$fun mon(fun +(fun.mon))
$noc mon(noc +(noc.mon))
$glu mon(glu +(glu.mon))
$mal mon(mal +(mal.mon))
$far mon(far +(far.mon))
$coy mon(coy +(coy.mon))
$euq mon(euq +(euq.mon))
==
++ pi-moth :: count sample
|= mon/moan ^- @ud
:(add fun.mon noc.mon glu.mon mal.mon far.mon coy.mon euq.mon)
::
++ pi-mumm :: print sample
|= mon/moan ^- tape
=+ tot=(pi-moth mon)
;: welp
^- tape
?: =(0 noc.mon) ~
(welp (scow %ud (div (mul 100 noc.mon) tot)) "n ")
::
^- tape
?: =(0 fun.mon) ~
(welp (scow %ud (div (mul 100 fun.mon) tot)) "c ")
::
^- tape
?: =(0 glu.mon) ~
(welp (scow %ud (div (mul 100 glu.mon) tot)) "g ")
::
^- tape
?: =(0 mal.mon) ~
(welp (scow %ud (div (mul 100 mal.mon) tot)) "m ")
::
^- tape
?: =(0 far.mon) ~
(welp (scow %ud (div (mul 100 far.mon) tot)) "f ")
::
^- tape
?: =(0 coy.mon) ~
(welp (scow %ud (div (mul 100 coy.mon) tot)) "y ")
::
^- tape
?: =(0 euq.mon) ~
(welp (scow %ud (div (mul 100 euq.mon) tot)) "e ")
==
::
++ pi-tell :: produce dump
|= day/doss
^- (list tape)
?: =(day *doss) ~
=+ tot=(pi-moth mon.day)
;: welp
[(welp "events: " (pi-mumm mon.day)) ~]
::
%+ turn
%+ sort ~(tap by hit.day)
|= {a/{* @} b/{* @}}
(lth +.a +.b)
2016-11-24 07:25:07 +03:00
|= {nam/term num/@ud}
:(welp (trip nam) ": " (scow %ud num))
["" ~]
::
%- zing
^- (list (list tape))
%+ turn
%+ sort ~(tap by cut.day)
2016-11-24 07:25:07 +03:00
|= {one/(pair path hump) two/(pair path hump)}
(gth (pi-moth mon.q.one) (pi-moth mon.q.two))
|= {pax/path hup/hump}
=+ ott=(pi-moth mon.hup)
;: welp
[(welp "label: " (spud pax)) ~]
[(welp "price: " (scow %ud (div (mul 100 ott) tot))) ~]
[(welp "shape: " (pi-mumm mon.hup)) ~]
::
?: =(~ out.hup) ~
:- "into:"
%+ turn
%+ sort ~(tap by out.hup)
2016-11-24 07:25:07 +03:00
|=({{* a/@ud} {* b/@ud}} (gth a b))
|= {pax/path num/@ud}
^- tape
:(welp " " (spud pax) ": " (scow %ud num))
::
?: =(~ inn.hup) ~
:- "from:"
%+ turn
%+ sort ~(tap by inn.hup)
2016-11-24 07:25:07 +03:00
|=({{* a/@ud} {* b/@ud}} (gth a b))
|= {pax/path num/@ud}
^- tape
:(welp " " (spud pax) ": " (scow %ud num))
::
["" ~]
~
==
==
--