3. The Core Stack

“You take the red pill... you stay in [kernelspace], and I show you how deep the rabbit hole goes.”

Subject-Oriented Programming

Subject Search and Limb Resolution

A face is a label for an axis in a tree. The main use for a face is to label a slot (axis) within a noun of a corresponding type. Without faces, you would have to refer to all data by numeric axis. Faces are a Hoon convention, and Nock knows nothing about labels or faces. These values are stripped out of the Nock result. In fact, it's possible but cumbersome to construct Hoon programs without labels.

From a +$type perspective, a face results from =^ kettis (foo=bar) modifying the enclosed expression to be wrapped in [%face %foo original-type].

> =/  a  b=c=5
 c.b.a
5
> =/  a  b=c=5
 ([%face type] -:!>(a))
> =/  a  b=c=5
 ([%face *] -:!>(a))
[1.701.011.814 98 1.701.011.814 99 1.836.020.833 25.717 0]

An arm name is not the same thing as a face. ++add is the name of an arm in the standard subject. When that arm is fired, the result is the ++add gate, which is then ++slammed by swapping out the sample with an argument and firing the $ arm.

Wings are expressions that compile to an axis. A +$wing is a (list limb), or basically a path to a value in the subject. We can compose wings:

  1. Relatively, using lark syntax (+>).
  2. Absolutely, using numeric syntax (+6, &6, |6).
  3. By name, using faces and arm names.
+$ limb $@ term :: wing element
$% [%& p=axis] :: by geometry
[%| p=@ud q=(unit term)] :: by name
== ::
+$ axis @ :: tree address
+$ wing (list limb) :: search path

Wings are parsed by ++rope (++ven for lark syntax; ++lus+++pam+++bar for numeric syntax). , dot wing resolution is conducted by the ++ax:musk door in the Hoon compiler (invoked by ++open:ap). This resolves a wing against a sample-supplied subject. Wings resolve by depth first (in other words, from the outermost “closest” match towards the inner cores).

> (spec +:(ream '$:(a=@ b=@)'))
[ %bccl
   p
 [ i=[%bcts p=term=%a q=[%base p=[%atom p=~.]]]
   t=[i=[%bcts p=term=%b q=[%base p=[%atom p=~.]]] t=~]
 ]
]
:: Produce a bunt of the given spec.
> ~(example ax (spec +:(ream '$:(a=@ b=@)')))
[p=[%ktts p=term=%a q=[%sand p=%$ q=0]] q=[%ktts p=term=%b q=[%sand p=%$ q=0]]]
:: Produce a normalizing gate (mold) for a given spec, as an AST.
> ~(factory ax (spec +:(ream '$:(a=@ b=@)')))
[ %brcl
p
[ %ktsg
p
...

^ skips a match. In the compiler, this corresponds to a number of skips.

> (ream '$')
[%wing p=~[%$]]
> (ream '^$')
[%wing p=~[[%.n p=1 q=[~ %$]]]]
> (ream '^^$')
[%wing p=~[[%.n p=2 q=[~ %$]]]]
> (spec +:(ream '*spec'))
[%like p=~[%spec] q=~]

. dot is Hoon-native syntax (not rune sugar) for a wing resolution search path. : col is a shorthand for => tisgar, and generally results in a longer Hoon AST than the . dot expression would. (The Nock formula may well come out the same.)

> =/  a  [b=42]
 !,(*hoon b.a)
[%wing p=~[%b %a]]
> =/  a  [b=42]
 !,(*hoon b:a)
[%tsgl p=[%wing p=~[%b]] q=[%wing p=~[%a]]]
> =/  a  [b=42]
 !=(b:a)
[0 2]
> =/  a  [b=42]
 !=(b.a)
[0 2]

Since the subject of a core is the core itself, ..add resolves to the core containing ++add (which is Layer 1) and thus exposes mutual visibility between all arms in the core.

We have made some noise in the past about arms and legs. With everything under your belt at this point, you are equipped to really understand the difference:

  • A leg is a noun accessible in the current subject using a Nock Zero call. Thus a value like =/ pi .3.1415926 would be a leg.
  • An arm is a noun which requires a Nock Nine call. Thus ++ pi .3.1415926 would be an arm even tho it is an atom simpliciter.

When the compiler dereferences a limb, it either finds an arm (in the battery of a core) or a leg (anywhere else). For an arm, it must be computed against the whole core (Nock Nine) or simply retrieved (Nock Zero).

Arms are only pulled by name. If you retrieve them by axis or lark syntax then they are treated as raw nouns. The name of an arm is not a face.

> =>
|%
++ $ .+ 100
--
+2
[4 1 100]
> =>
|%
++ $ .+ 100
--
$
101

Structure Mode

Most Hoon is written in value mode, meaning that sugar syntax like [] resolves to a : col family rune. However, +$spec values are written in structure mode.

> !,(*hoon [a=@ b=@])
[ %cltr
p
[ i=[%ktts p=term=%a q=[%base p=[%atom p=~.]]]
t=[i=[%ktts p=term=%b q=[%base p=[%atom p=~.]]] t=~]
]
]
> !,(*hoon $:(a=@ b=@))
[ %ktcl
p
[ %bccl
p
[ i=[%bcts p=term=%a q=[%base p=[%atom p=~.]]]
t=[i=[%bcts p=term=%b q=[%base p=[%atom p=~.]]] t=~]
]
]
]

The Hoon parser can be switched from one to the other using a leading , com.

> !,(*hoon ,[a=@ b=@])
[ %ktcl
p
[ %bccl
p
[ i=[%bcts p=term=%a q=[%base p=[%atom p=~.]]]
t=[i=[%bcts p=term=%b q=[%base p=[%atom p=~.]]] t=~]
]
]
]

The root type of a structure mode quantity is a +$spec:

+$ spec :: structure definition
$~ [%base %null] ::
$% [%base p=base] :: base type
[%dbug p=spot q=spec] :: set debug
[%gist p=[%help p=help] q=spec] :: formal comment
[%leaf p=term q=@] :: constant atom
[%like p=wing q=(list wing)] :: reference
[%loop p=term] :: hygienic reference
[%made p=(pair term (list term)) q=spec] :: annotate synthetic
[%make p=hoon q=(list spec)] :: composed spec
[%name p=term q=spec] :: annotate simple
[%over p=wing q=spec] :: relative to subject
:: ::
[%bcgr p=spec q=spec] :: $>, filter: require
[%bcbc p=spec q=(map term spec)] :: $$, recursion
[%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
[%bcdt p=spec q=(map term spec)] :: $., read-write core
[%bcgl p=spec q=spec] :: $<, filter: exclude
[%bchp p=spec q=spec] :: $-, function core
[%bckt p=spec q=spec] :: $^, cons pick
[%bcls p=stud q=spec] :: $+, standard
[%bcfs p=spec q=(map term spec)] :: $/, write-only core
[%bcmc p=hoon] :: $;, manual
[%bcpm p=spec q=hoon] :: $&, repair
[%bcsg p=hoon q=spec] :: $~, default
[%bctc p=spec q=(map term spec)] :: $`, read-only core
[%bcts p=skin q=spec] :: $=, name
[%bcpt p=spec q=spec] :: $@, atom pick
[%bcwt p=[i=spec t=(list spec)]] :: $?, full pick
[%bczp p=spec q=(map term spec)] :: $!, opaque core

A spec produces a mold, thus a %core with a $ arm, rather than e.g. a %cell.

> -<:!>(,[a=@ b=@])
%core
> -<:!>([a=@ b=@])
%cell
> (,[%const *] [%const 10])
[%const 10]
> $:,[%const *]
[%const 0]
> -:,[%const *]
[ 8
[[6 [5 [0 12] 1 500.152.823.651] [1 500.152.823.651] 0 0] 0 13]
8
[5 [0 14] 0 2]
0
6
]
> +6:,[%const *]
[500.152.823.651 0]
> $:@
0
> !<(@ (slam !>(@) !>(5)))
5

Cores

In the AST, a %core consists of a lot of information about the behavior of various components.

+$ type ...
$: %core
$= p
$: p=(unit term)
q=?(%wet %dry)
r=?(%gold %iron %lead %zinc))
==
$= q
$: $= p
$: p=(unit term)
q=?(%wet %dry)
r=?(%gold %iron %lead %zinc))
==
$= q type
$= r (pair seminoun (map term tome))
==
+$ tome (pair what (map term hoon))

The core variance is repeated because of the dry/wet gate distinction. Core variance starts to make more sense once you've popped the cover off of cores this way.

“Suppose this core was actually compiled using the modified payload instead of the one it was originally built with? Would the Nock formula we generated for the original template actually work for the modified payload?”

What we're saying, in other words, is that if you produced Nock using a wet gate via more than one input, would that Nock end up the same? If so, then for a wet gate it's valid. Wetness is handled at three points in the compiler:

  1. ++hemp dispatches the Nock formula generation slightly differently, turning off vet (sample nesting) in ++mint:ut.
  2. ++mint:ut when it builds |@ barpat wet doors and |* bartar wet gates.
  3. ++dext:crop:ar when %core types are handled, enforcing the condition that for %wet gates =(q.r.q.sut q.r.q.ref), that the formula results are the same.

Variance matters when comparing structural nesting. For instance, the main Gall agent type should permit checking the type of the door since it will be used as examples for building actual agent cores, but should not be reliant on things like the sample. Thus in /sys/lull, ++agent is marked as %iron using ^| ketbar.

In /sys/lull, several shared representations like vane interfaces and ++http are marked as %lead using ^? ketwut. Bivariance here permits any kind of nesting, useful for examples for types.

In ++deem:nest:ut we can see how the %read/%rite permissions are directly set.

++ deem
|= [mel=vair ram=vair]
^- ?
?. |(=(mel ram) =(%lead mel) =(%gold ram)) |
?- mel
%lead &
%gold meet
%iron dext(sut (peek(sut ref) %rite 2), ref (peek %rite 2))
%zinc dext(sut (peek %read 2), ref (peek(sut ref) %read 2))
==

Likewise in ++peel:ut:

++ peel
|= [way=vial met=?(%gold %iron %lead %zinc)]
^- [sam=? con=?]
?: ?=(%gold met) [& &]
?- way
%both [| |]
%free [& &]
%read [?=(%zinc met) |]
%rite [?=(%iron met) |]
==

Those permissions sets are the ones actually used in core behavior checks. In kernelspace, you are not strictly limited by the core type system—but you will have to manually construct handlers for other wetness/metallic behaviors and extend things to get the behavior you are aiming for.

Aside: Constructing Gates

Gates are special $-armed instances of doors. It's interesting to see how that particular sausage is made in ++mint:ut:

[%brts *] :+ %brcb p.gen
=- [~ [[%$ ~ -] ~ ~]]
(~(put by *(map term hoon)) %$ q.gen)
[%brcb *] :+ %tsls [%kttr p.gen]
:+ %brcn ~
%- ~(run by r.gen)
|= =tome
:- p.tome
%- ~(run by q.tome)
|= =hoon
?~ q.gen hoon
[%tstr [p.i.q.gen ~] q.i.q.gen $(q.gen t.q.gen)]

Arvo-Supplied Values

Arvo values such as our, eny, and now are simply supplied at axes in the subject (rather than being scries). (This is why they must be explicitly provided for in generators.) Compare the following Nock results on a fakeship ~zod.

> !=(=(0 ~zod))
[5 [1 0] 1 0]
> !=(=(0 our))
[5 [1 0] 0 12]

In the latter, our refers to a slot in the subject which needs to be looked up (at 12) and replaced into the final evaluated noun.

  • our is at 12
  • now is at 26
  • eny is at 27

Dynamic Dispatch

Static dispatch (or early binding) happens when I know at compile time which function body will be executed when I call a method. In contrast, dynamic dispatch (or run-time dispatch or virtual method call or late binding) happens when I defer that decision to run time.

The conventional behavior of Urbit's Hoon language is to statically dispatch against limb labels known at compile time. It's somewhat difficult to get around this in userspace; for instance, to retrieve a list of faces in a core and selectively run against those that exist. Why? As we showed a moment ago, a face or an arm name is a compile-time construct that stands in for an axis in the subject.

With a subject and the slap/slop algebra, we can effect dynamic (runtime) dispatch for an interactive interface via slam. For instance, Dojo does this for every input. (Cf. ll. 530–539 in /app/dojo.hoon.)

-test Thread

  • The /ted/test thread invokes arms beginning with test in the context of the subject provided in the core. How does it do this?

Kelvin Versioning

The innermost core of Hoon is the root marker for the language version. Not every part of a system should be subject to kelvin versioning: userspace generally will not be, and even in the %base desk many portions will not be subject to kelvin versioning.

Deep, onion-like layering is essential. A thin layer has no room to grow. A good example of this principle is the difference between Urbit and Lisp machines. Both Nock and Lisp are very simple axiomatic definitions of computing. But practical Lisp systems expand by extending the model, whereas Urbit layers over a frozen axiom system. ~sorreg-namtyv, ~ravmel-ropdyl, “Towards a Frozen Operating System”

The parts of the system subject to kelvin versioning are:

  • Nock, %4 (liquid helium, 4.15 K).
  • Hoon, %138 (about liquid krypton, 115.8 K). (%140 in December 2020).
  • Arvo, %237 (about liquid mercury, 234.4 K). (%240 in December 2020).
  • Lull, %323, (about gaseous water, 373.1 K). (%330 in December 2020).
  • Zuse, %411, which in a sense represents the most important kelvin for userspace developers since it's what they peg releases against. (%420 in December 2020.)

What parts are subject to kelvin versioning? Essentially, the things we see as platform: as you can see, the language, the event handler, and parts of the standard library.

What results in a kelvin change? Not every release, even a change in a system file, motivates a kelvin decrement. The rule of thumb is that something which changes the specification of the platform burns a kelvin. In practice, although there are many kelvins yet to burn, it is more straightforward to bundle breaking changes together. This is both frugal of platform changes and generous to userspace developers.

Formally, /? faswut is used to pin a version number; in practice, it is not enforced at the compiler level.

Telescoping Kelvins

The rules of telescoping are simple:

  1. If tool B sits on platform A, either both A and B must be at absolute zero, or B must be warmer than A.
  2. Whenever the temperature of A (the platform) declines, the temperature of B (the tool) must also decline.
  3. B must state the version of A it was developed against. A, when loading B, must state its own current version, and the warmest version of itself with which it's backward-compatible. ~sorreg-namtyv, ~ravmel-ropdyl, “Towards a Frozen Operating System”

Thus if you introduced a tool into kernelspace which relies on Nock alone, you could version it at anything above 4. If it relies on Hoon, then it should be above 139. And preferably a fair bit above—fat onion rings are tastier than paper-thin ones.

The Structure of Kernelspace

The kernel is constructed of nested cores from the innermost /sys/hoon definitions out to /sys/zuse. All of userspace runs outside of these cores.

Although Arvo (ca03) is the operational core of Urbit, we actually require a boot process (see the boot lesson) building on the definition of Hoon itself. Thus we begin with hoon.hoon, zuse.hoon, and lull.hoon today before proceeding into Arvo proper.

Core 0

The first core consists of the Hoon version tag, currently %139. Since there are no documentation references to this core, we call it 0, the “version stub”.

=> %139 =>
:: ::
:::: 0: version stub ::
:: ::
~% %k.139 ~ ~ ::
|%
++ hoon-version +
-- =>
  1. This resolves down to ++ hoon-version %139 in a circuitous way.

  2. The ~% sigcen tag starts a jet registration tree. Unlike other jet registrations we have seen and will see later, this one is the root jet registration, meaning it has no parent and exports no named formulas, although it contains all of hoon.hoon.

    Since we refer to a “parent core” and imply a “child core“, we need to clarify something a bit counterintuitive about Urbit's subject-oriented nature. We say that the child core contains the parent core, through its context; and we refer to the parent core as the “inner” core, the child being “outer”. In fact, the parent/inner core is a leg in the child/outer core.

    Compare the expansion of ~/ sigfas: ~%(p +7 ~ q).

Thus, all things considered, Core 0 layer-0 is the innermost core of all of Urbit. It appears at the rightmost side when the prettyprinter shows a core:

> add
<1.otf [[a=@ b=@] <33.sam 1.pnw %139>]>
> +7:add
<33.sam 1.pnw %139>
> +7:+7:add
%139

Core 1

The next core contains arithmetic. Since each core can only access limbs present in its payload (+3), and in particular its context (+7), each core builds outwards on its predecessors, in this case on a foundation of straightforward integer arithmetic.

++ add
++ dec
++ div
++ dvr
++ gte
++ gth
++ lte
++ lth
++ max
++ min
++ mod
++ mul
++ sub

The next block are for binary tree calculations:

++ cap
++ mas
++ peg

Then we have some standard definitions of types and values for mold building and handling types like units.

+$ bite
+$ bloq
++ each
+$ gate
++ list
++ lone
++ lest
+$ mold
++ pair
++ pole
++ qual
++ quip
++ step
++ trap
++ tree
++ trel
++ unit
  • Several of these, like trel and qual, are hardly used even in hoon.hoon but standardize named faces.
  • We particularly draw your attention to pole, which is a faceless list. This has more recently shown up in contexts where it is helpful to replace supplied faces with your own, as in ++on-peek ?+ wutlus statements.
  • each allows you to discriminate between values on type using a flag. (This is useful when returning structures out of a parser for instance, like (each manx marl) where manx is a structure and marl is a list.)
> ((each @ ^) [%& 6])
[%.y p=6]
> ((each @ ^) [%| [6 7]])
[%.n p=[6 7]]

Core 2

Many practical tools live in layer-2, including functional tools, maps, sets, list operators, and string and formatted text operators.

Unit Logic

First up, the unit tools. While units are often just stripped off in userspace, there is a full-featured algebra handling units. (I'm of the opinion that these are probably underutilized because it can be hard to reason correctly with units.)

++  biff                                                ::  apply
++  bind                                                ::  argue
++  bond                                                ::  replace
++  both                                                ::  all the above
++  clap                                                ::  combine
++  clef                                                ::  compose
++  drop                                                ::  enlist
++  fall                                                ::  default
++  flit                                                ::  make filter
++  hunt                                                ::  first of units
++  lift                                                ::  lift mold (fmap)
++  mate                                                ::  choose
++  need                                                ::  demand
++  some                                                ::  lift (pure)
  • In particular, check out the definitions of ++biff, ++bond, ++flit, and ++lift, which apply wet gates and deferred traps.
List Logic
++  snoc
++  lure
++  fand                                                ::  all indices
++  find                                                ::  first index
++  flop                                                ::  reverse
++  gulf                                                ::  range inclusive
++  homo                                                ::  homogenize
++  join
++  bake
++  lent                                                ::  length
++  levy
++  lien                                                ::  some of
++  limo                                                ::  listify
++  murn                                                ::  maybe transform
++  oust                                                ::  remove
++  reap                                                ::  replicate
++  rear                                                ::  last item of list
++  reel                                                ::  right fold
++  roll                                                ::  left fold
++  scag                                                ::  prefix
++  skid                                                ::  separate
++  skim                                                ::  only
++  skip                                                ::  except
++  slag                                                ::  suffix
++  snag                                                ::  index
++  snip                                                ::  drop tail off list
++  sort                                              ::  quicksort
++  spin                                                ::  stateful turn
++  spun                                                ::  internal spin
++  swag                                                ::  slice
++  turn
++  weld                                                ::  concatenate
++  snap                                               ::  replace item
++  into                                               ::  insert item
++  welp                                                ::  faceless weld
++  zing                                                ::  promote
  • You are likely familiar with all of these except ++lure, which is a list builder that's unused in the system.
  • Note that ++sort (quicksort) turns off the stack trace because feedback from such a crash is liable to be a mess.
++ sort !. :: quicksort
~/ %sort
|* [a=(list) b=$-([* *] ?)]
=> .(a ^.(homo a))
|- ^+ a
?~ a ~
=+ s=(skid t.a |:(c=i.a (b c i.a)))
%+ weld
$(a p.s)
^+ t.a
[i.a $(a q.s)]
Bitwise Logic
++  bex                                                 ::  binary exponent
++  can                                                 ::  assemble
++  cat                                                 ::  concatenate
++  cut                                                 ::  slice
++  end                                                 ::  tail
++  fil                                                 ::  fill bloqstream
++  lsh                                                 ::  left-shift
++  met                                                 ::  measure
++  rap                                                 ::  assemble variable
++  rep                                                 ::  assemble fixed
++  rev
++  rip                                                 ::  disassemble
++  rsh                                                 ::  right-shift
++  run                                                 ::  +turn into atom
++  rut                                                 ::  +turn into list
++  sew                                                 ::  stitch into
++  swp                                                 ::  naive rev bloq order
++  xeb                                                 ::  binary logarithm
++  fe                                                  ::  modulo bloq
 ++  dif                                               ::  difference
 ++  inv  |=(b=@ (sub (dec out) (sit b)))              ::  inverse
 ++  net  |=  b=@  ^-  @                               ::  flip byte endianness
 ++  out  (bex (bex a))                                ::  mod value
 ++  rol  |=  [b=bloq c=@ d=@]  ^-  @                  ::  roll left
 ++  ror  |=  [b=bloq c=@ d=@]  ^-  @                  ::  roll right
 ++  sum  |=([b=@ c=@] (sit (add b c)))                ::  wrapping add
 ++  sit  |=(b=@ (end a b))                            ::  enforce modulo
++  con                                                 ::  binary or
++  dis                                                 ::  binary and
++  mix                                                 ::  binary xor
++  not  |=  [a=bloq b=@ c=@]                           ::  binary not (sized)
  • These provide bitwise operators for atoms. ++fe is barely used but seems like it could be used to organize some of the logic.
  • Optional exercise: Produce ++rip and ++sew.
Insecure Hashing
++  muk                                                 ::  standard murmur3
++  mug                                                 ::  mug with murmur3
++  aor
++  dor
++  gor
++  mor
  • These provide simple hashing and ordering algorithms.

The Murmur3 algorithm is non-cryptographic hash function. ++muk implements the 32-bit version. In pseudocode from Wikipedia:

algorithm Murmur3_32 is
// Note: In this version, all arithmetic is performed with unsigned 32-bit integers.
// In the case of overflow, the result is reduced modulo 232.
input: key, len, seed
c1 ← 0xcc9e2d51
c2 ← 0x1b873593
r1 ← 15
r2 ← 13
m ← 5
n ← 0xe6546b64
hash ← seed
for each fourByteChunk of key do
k ← fourByteChunk
k ← k × c1
k ← k ROL r1
k ← k × c2
hash ← hash XOR k
hash ← hash ROL r2
hash ← (hash × m) + n
with any remainingBytesInKey do
remainingBytes ← SwapToLittleEndian(remainingBytesInKey)
// Note: Endian swapping is only necessary on big-endian machines.
// The purpose is to place the meaningful digits towards the low end of the value,
// so that these digits have the greatest potential to affect the low range digits
// in the subsequent multiplication. Consider that locating the meaningful digits
// in the high range would produce a greater effect upon the high digits of the
// multiplication, and notably, that such high digits are likely to be discarded
// by the modulo arithmetic under overflow. We don't want that.
remainingBytes ← remainingBytes × c1
remainingBytes ← remainingBytes ROL r1
remainingBytes ← remainingBytes × c2
hash ← hash XOR remainingBytes
hash ← hash XOR len
hash ← hash XOR (hash >> 16)
hash ← hash × 0x85ebca6b
hash ← hash XOR (hash >> 13)
hash ← hash × 0xc2b2ae35
hash ← hash XOR (hash >> 16)
Unsigned Powers
++  pow                                                 ::  unsigned exponent
++  sqt                                                 ::  unsigned sqrt/rem
Container Logic
++  jar          ::  map of lists
++  jug          ::  map of sets
++  map
++  qeu
++  set
++  in                                                 ::  set engine
 ++  all                                               ::  logical AND
 ++  any                                               ::  logical OR
 ++  apt                                               ::  check correctness
 ++  bif                                               ::  splits a by b
 ++  del                                               ::  b without any a
 ++  dif                                               ::  difference
 ++  dig                                               ::  axis of a in b
 ++  gas                                               ::  concatenate
 ++  has
 ++  int                                               ::  intersection
 ++  put                                               ::  puts b in a, sorted
 ++  rep                                               ::  reduce to product
 ++  run                                               ::  apply gate to values
 ++  tap                                               ::  convert to list
 ++  uni                                               ::  union
 ++  wyt                                               ::  size of set
++  by                                                 ::  map engine
 ++  all                                               ::  logical AND
 ++  any                                               ::  logical OR
 ++  bif                                               ::  splits a by b
 ++  del                                               ::  delete at key b
 ++  dif                                               ::  difference
 ++  dig                                               ::  axis of b key
 ++  apt                                               ::  check correctness
 ++  gas                                               ::  concatenate
 ++  get                                               ::  grab value by key
 ++  got                                               ::  need value by key
 ++  gut                                               ::  fall value by key
 ++  has                                               ::  key existence check
 ++  int                                               ::  intersection
 ++  jab
 ++  mar                                               ::  add with validation
 ++  put                                               ::  adds key-value pair
 ++  rep                                               ::  reduce to product
 ++  rib                                               ::  transform + product
 ++  run                                               ::  apply gate to values
 ++  rut                                               ::  apply gate to nodes
 ++  tap                                               ::  listify pairs
 ++  uni                                               ::  union, merge
 ++  uno                                               ::  general union
 ++  urn                                               ::  apply gate to nodes
 ++  wyt                                               ::  depth of map
 ++  key                                               ::  set of keys
 ++  val                                               ::  list of vals
++  ja                                                 ::  jar engine
 ++  get                                               ::  gets list by key
 ++  add                                               ::  adds key-list pair
++  ju                                                 ::  jug engine
 ++  del                                               ::  del key-set pair
 ++  gas                                               ::  concatenate
 ++  get                                               ::  gets set by key
 ++  has                                               ::  existence check
 ++  put                                               ::  add key-set pair
++  to                                                 ::  queue engine
 ++  apt                                               ::  check correctness
 ++  bal
 ++  dep                                               ::  max depth of queue
 ++  gas                                               ::  insert list to que
 ++  get                                               ::  head-rest pair
 ++  nip                                               ::  removes root
 ++  nap                                               ::  removes root
 ++  put                                               ::  insert new tail
 ++  tap                                               ::  adds list to end
 ++  top                                               ::  produces head
++  malt                                               ::  map from list
++  molt                                               ::  map from pair list
++  silt                                               ::  set from list
++  ly                                                 ::  list from raw noun
++  my                                                 ::  map from raw noun
++  sy                                                 ::  set from raw noun
++  nl :: noun-to-container ops
  • Jars and jugs seem oddly specific, and are only invoked in a couple of special contexts in the base distribution.
  • We don't see ++ly used often. What are the difference in these constructed lists?
> -:!>((ly ~[1 2 3]))
#t/it(?(@ud ?(@ud ?(@ud #!))))
> -:!>((homo ~[1 2 3]))
#t/it(@ud)
> -:!>((limo ~[1 2 3]))
#t/^#3.?([i=@ud t=#3] ^#2.?([i=@ud t=#2] it(@ud)))
> -:!>(`(list @ud)`~[1 2 3])
#t/it(@ud)
  • ++ly uses the crash type for an empty list.
> (scag 0 ((list @) ~))
~
> (scag 0 (ly ~))
mull-grow
-find.b
find-fork
dojo: hoon expression failed
Serialization
++  cue                                                 ::  unpack
++  jam                                                 ::  pack
++  mat                                                 ::  length-encode
++  rub                                                 ::  length-decode
  • ++jam and ++cue are critically important for noun communication operations.

Here is an annotated version of ++jam. The basic idea is to produce a serial noun (in order of head/tail):

  1. One bit marks cell or atom.
  2. Next entry marks bit length of value.
  3. Then the actual value.

(++cue distinguishes the bit length from the value by unary until the first 0.)

> `@ub`(jam ~)
0b10
:: start at LSB, so `0` for atom, `1` for length, `0` for value (head-trimmed zero)
> `@ub`(jam 1)
0b1100
:: start at LSB, so `0` for atom, `01`
> `@ub`(jam [0 0])
0b10.1001
:: start at LSB, so `01` for cell, then `0` for head atom, length `1`, value `0`, repeat
> `@ub`(jam [0 1])
0b1100.1001
> `@ub`(jam [1 0])
0b1011.0001

Functional programming combinators:

++  aftr          ::  pair after
++  cork           ::  compose forward
++  corl                                                ::  compose backwards
++  cury                                                ::  curry left
++  curr                                                ::  curry right
++  fore  |*(a=$-(* *) |*(b=$-(* *) (pair a b)))        ::  pair before
++  head  |*(^ ,:+<-)                                   ::  get head
++  same  |*(* +<)                                      ::  identity
++  succ  |=(@ +(+<))                                   ::  successor
++  tail  |*(^ ,:+<+)                                   ::  get tail
++  test  |=(^ =(+<- +<+))                              ::  equality
++  lead  |*(* |*(* [+>+< +<]))                         ::  put head
++  late  |*(* |*(* [+< +>+<]))                         ::  put tail
Various Type Definitions
++  fn  ::    float, infinity, or NaN
++  dn  ::    decimal float, infinity, or NaN
++  rn  ::    parsed decimal float
+$  axis  @                                             ::  tree address
+$  bean  ?                                             ::  0=&=yes, 1=|=no
+$  flag  ?
+$  char  @t                                            ::  UTF8 byte
+$  cord  @t                                            ::  UTF8, LSB first
+$  byts  [wid=@ud dat=@]                               ::  bytes, MSB first
+$  date  [[a=? y=@ud] m=@ud t=tarp]                    ::  parsed date
+$  knot  @ta                                           ::  ASCII text
+$  noun  *                                             ::  any noun
+$  path  (list knot)                                   ::  like unix path
+$  pith  (list iota)                                   ::  typed urbit path
+$  stud                                                ::  standard name
+$  tang  (list tank)                                   ::  bottom-first error
+$  iota                                                ::  typed path segment
+$  tank
+$  tape  (list @tD)                                    ::  utf8 string as list
+$  tour  (list @c)                                     ::  utf32 clusters
+$  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
  • Floating-point structs
  • Paths
  • Strings

Core 3

++  egcd                                                ::  schneier's egcd
++  fo                                                  ::  modulo prime
 ++  dif
 ++  exp
 ++  fra
 ++  inv
 ++  pro
 ++  sit
 ++  sum
++  si                                                  ::  signed integer
 ++  abs  |=(a=@s (add (end 0 a) (rsh 0 a)))           ::  absolute value
 ++  dif  |=  [a=@s b=@s]                              ::  subtraction
 ++  dul  |=  [a=@s b=@]                               ::  modulus
 ++  fra  |=  [a=@s b=@s]                              ::  divide
 ++  new  |=  [a=? b=@]                                ::  [sign value] to @s
 ++  old  |=(a=@s [(syn a) (abs a)])                   ::  [sign value]
 ++  pro  |=  [a=@s b=@s]                              ::  multiplication
 ++  rem  |=([a=@s b=@s] (dif a (pro b (fra a b))))    ::  remainder
 ++  sum  |=  [a=@s b=@s]                              ::  addition
 ++  sun  |=(a=@u (mul 2 a))                           ::  @u to @s
 ++  syn  |=(a=@s =(0 (end 0 a)))                      ::  sign test
 ++  cmp  |=  [a=@s b=@s]                              ::  compare
++  fl                                                  ::  arb. precision fp
   ++  rou
   ++  rau
   ++  add                                             ::  add; exact if e
   ++  sub                                             ::  subtract; exact if e
   ++  mul                                             ::  multiply
   ++  div                                             ::  divide
   ++  sqt                                             ::  square root
   ++  lth                                             ::  less-than
   ++  equ                                             ::  equals
   ++  ibl
   ++  uni
   ++  xpd
   ++  lug
   ++  drg                                             ::  dragon4; get
   ++  toj                                             ::  round to integer
   ++  ned                                             ::  require ?=([%f *] a)
   ++  shf                                             ::  a * 2^b; no rounding
   ++  fli                                             ::  flip sign
   ++  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
 ++  syn                                               ::  get sign
 ++  abs                                               ::  absolute value
 ++  add                                               ::  add
 ++  ead                                               ::  exact add
 ++  sub                                               ::  subtract
 ++  mul                                               ::  multiply
 ++  emu                                               ::  exact multiply
 ++  div                                               ::  divide
 ++  fma                                               ::  fused multiply-add
 ++  sqt                                               ::  square root
 ++  inv                                               ::  inverse
 ++  sun                                               ::  uns integer to float
 ++  san                                               ::  sgn integer to float
 ++  lth                                               ::  less-than
 ++  lte                                               ::  less-equal
 ++  equ                                               ::  equal
 ++  gte                                               ::  greater-equal
 ++  gth                                               ::  greater-than
 ++  drg                                               ::  float to decimal
 ++  grd                                               ::  decimal to float
 ++  toi                                               ::  round to integer @s
 ++  toj                                               ::  round to integer fn
::  provided to ++rd, ++rs, ++rq, and ++rh
::  r=rounding mode: same as in ++fl
++  ff                                                  ::  ieee 754 format fp
 ++  sb  (bex (^add w p))                              ::  sign bit
 ++  me  (dif:si (dif:si --1 b) (sun:si p))            ::  minimum exponent
 ++  pa
 ++  sea                                               ::  @r to fn
 ++  bit  |=  [a=fn]  (bif (rou:pa a))                 ::  fn to @r w+ rounding
 ++  bif                                               ::  fn to @r no rounding
 ++  sig                                               ::  get sign
 ++  exp                                               ::  get exponent
 ++  add                                               ::  add
 ++  sub                                               ::  subtract
 ++  mul                                               ::  multiply
 ++  div                                               ::  divide
 ++  fma                                               ::  fused multiply-add
 ++  sqt                                               ::  square root
 ++  lth                                               ::  less-than
 ++  lte                                               ::  less-equals
 ++  equ                                               ::  equals
 ++  gte                                               ::  greater-equals
 ++  gth                                               ::  greater-than
 ++  sun                                               ::  uns integer to @r
 ++  san                                               ::  signed integer to @r
 ++  toi                                               ::  round to integer
 ++  drg                                               ::  @r to decimal float
 ++  grd                                               ::  decimal float to @r
++  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
 ++  ma
 ++  sea                                               ::  @rd to fn
 ++  bit                                               ::  fn to @rd
 ++  add  ~/  %add                                     ::  add
 ++  sub  ~/  %sub                                     ::  subtract
 ++  mul  ~/  %mul                                     ::  multiply
 ++  div  ~/  %div                                     ::  divide
 ++  fma  ~/  %fma                                     ::  fused multiply-add
 ++  sqt  ~/  %sqt                                     ::  square root
 ++  lth  ~/  %lth                                     ::  less-than
 ++  lte  ~/  %lte                                     ::  less-equals
 ++  equ  ~/  %equ                                     ::  equals
 ++  gte  ~/  %gte                                     ::  greater-equals
 ++  gth  ~/  %gth                                     ::  greater-than
 ++  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
 ++  ma
 ++  sea                                               ::  @rs to fn
 ++  bit                                               ::  fn to @rs
 ++  add  ~/  %add                                     ::  add
 ++  sub  ~/  %sub                                     ::  subtract
 ++  mul  ~/  %mul                                     ::  multiply
 ++  div  ~/  %div                                     ::  divide
 ++  fma  ~/  %fma                                     ::  fused multiply-add
 ++  sqt  ~/  %sqt                                     ::  square root
 ++  lth  ~/  %lth                                     ::  less-than
 ++  lte  ~/  %lte                                     ::  less-equals
 ++  equ  ~/  %equ                                     ::  equals
 ++  gte  ~/  %gte                                     ::  greater-equals
 ++  gth  ~/  %gth                                     ::  greater-than
 ++  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
 ++  ma
 ++  sea                                               ::  @rq to fn
 ++  bit                                               ::  fn to @rq
 ++  add  ~/  %add                                     ::  add
 ++  sub  ~/  %sub                                     ::  subtract
 ++  mul  ~/  %mul                                     ::  multiply
 ++  div  ~/  %div                                     ::  divide
 ++  fma  ~/  %fma                                     ::  fused multiply-add
 ++  sqt  ~/  %sqt                                     ::  square root
 ++  lth  ~/  %lth                                     ::  less-than
 ++  lte  ~/  %lte                                     ::  less-equals
 ++  equ  ~/  %equ                                     ::  equals
 ++  gte  ~/  %gte                                     ::  greater-equals
 ++  gth  ~/  %gth                                     ::  greater-than
 ++  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
 ++  ma
 ++  sea                                               ::  @rh to fn
 ++  bit                                               ::  fn to @rh
 ++  add  ~/  %add                                     ::  add
 ++  sub  ~/  %sub                                     ::  subtract
 ++  mul  ~/  %mul                                     ::  multiply
 ++  div  ~/  %div                                     ::  divide
 ++  fma  ~/  %fma                                     ::  fused multiply-add
 ++  sqt  ~/  %sqt                                     ::  square root
 ++  lth  ~/  %lth                                     ::  less-than
 ++  lte  ~/  %lte                                     ::  less-equals
 ++  equ  ~/  %equ                                     ::  equals
 ++  gte  ~/  %gte                                     ::  greater-equals
 ++  gth  ~/  %gth                                     ::  greater-than
 ++  tos                                               ::  @rh to @rs
 ++  fos                                               ::  @rs to @rh
 ++  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
++  year                                                ::  date to @d
++  yore                                                ::  @d to date
++  yell                                                ::  tarp from @d
++  yule                                                ::  time atom
++  yall                                                ::  day / to day of year
++  yawn                                                ::  days since Jesus
++  yelp                                                ::  leap year
++  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)
++  shad  |=(ruz=@ (shax (shax ruz)))                   ::  double sha-256
++  shaf                                                ::  half sha-256
++  sham                                                ::  128bit noun hash
++  shas                                                ::  salted hash
++  shax                                                ::  sha-256
++  shay                                                ::  sha-256 with length
++  shaw                                                ::  hash to nbits
++  shaz                                                ::  sha-512
++  shal                                                ::  sha-512 with length
++  shan                                                ::  sha-1 (deprecated)
++  og                                                  ::  shax-powered rng
 ++  rad                                               ::  random in range
 ++  rads                                              ::  random continuation
 ++  raw                                               ::  random bits
 ++  raws                                              ::  random bits
++  sha                                                 ::  correct byte-order
     ++  flin  |=(a=@ (swp 3 a))                       ::  flip input
     ++  flim  |=(byts [wid (rev 3 wid dat)])          ::  flip input w= length
     ++  flip  |=(w=@u (cury (cury rev 3) w))          ::  flip output of size
     ++  meet  |=(a=@ [(met 3 a) a])                   ::  measure input size
 ++  sha-1     (cork meet sha-1l)
 ++  sha-256   :(cork flin shax (flip 32))
 ++  sha-512   :(cork flin shaz (flip 64))
 ++  sha-256l  :(cork flim shay (flip 32))
 ++  sha-512l  :(cork flim shal (flip 64))
 ++  sha-1l
++  un                                                  ::  =(x (wred (wren x)))
 ++  wren                                              ::  conceal structure
 ++  wred                                              ::  restore structure
 ++  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
 ++  zart                                              ::  reverse 255-sbox
 ++  zyft                                              ::  forward 256-sbox
 ++  zyrt                                              ::  reverse 256-sbox
++  ob
 ++  fein
 ++  fynd
 ++  feis
 ++  tail
 ++  fee
 ++  feen
 ++  fe
 ++  fen
 ++  eff
 ++  raku
+$  coin  $~  [%$ %ud 0]                                ::  print format
+$  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
+$  nail  [p=hair q=tape]                               ::  parsing input
+$  pint  [p=[p=@ q=@] q=[p=@ q=@]]                     ::  line+column range
+$  rule  _|:($:nail $:edge)                            ::  parsing rule
+$  spot  [p=path q=pint]                               ::  range in file
+$  tone  $%  [%0 product=*]                            ::  success
+$  toon  $%  [%0 p=*]                                  ::  success
++  wonk  |*  veq=_$:edge                                ::  product from edge

Core 4

++ po :: phonetic base
++ ins ~/ %ins :: parse prefix
++ ind ~/ %ind :: parse suffix
++ tos ~/ %tos :: fetch prefix
++ tod ~/ %tod :: fetch suffix
++ fa :: base58check
++ at :: basic printing
++ cass :: lowercase
++ cuss :: uppercase
++ crip |=(a=tape `@t`(rap 3 a)) :: tape to cord
++ mesc :: ctrl code escape
++ runt :: prepend repeatedly
++ sand :: atom sanity
++ sane :: atom sanity
++ ruth :: biblical sanity
++ trim :: tape split
++ trip :: cord to tape
++ teff :: length utf8
++ taft :: utf8 to utf32
++ tuba :: utf8 to utf32 tape
++ tufa :: utf32 to utf8 tape
++ tuft :: utf32 to utf8 text
++ wack :: knot escape
++ wick :: knot unescape
++ woad :: cord unescape
++ wood :: cord escape
++ wash :: render tank at width
++ re
++ ram
++ win
++ rig
++ wig
++ show :: XX deprecated!
++ shep
++ shop
++ shol
++ last |= [zyc=hair naz=hair] :: farther trace
++ lust |= [weq=char naz=hair] :: detect newline
++ bend :: conditional comp
++ comp
++ fail |=(tub=nail [p=p.tub q=~]) :: never parse
++ glue :: add rule
++ less :: no first and second
++ pfix :: discard first rule
++ plug :: first then second
++ pose :: first or second
++ simu :: first and second
++ sfix :: discard second rule
++ bass :: leftmost base
++ boss :: rightmost base
++ cold :: replace w+ constant
++ cook :: apply gate
++ easy :: always parse
++ fuss
++ full :: has to fully parse
++ funk :: add to tape first
++ here :: place-based apply
++ inde |* sef=rule :: indentation block
++ ifix
++ jest :: match a cord
++ just :: XX redundant, jest
++ knee :: callbacks
++ mask :: match char in set
++ more :: separated, *
++ most :: separated, +
++ next :: consume a char
++ perk :: parse cube fork
++ pick :: rule for ++each
++ plus |*(fel=rule ;~(plug fel (star fel))) ::
++ punt |*([a=rule] ;~(pose (stag ~ a) (easy ~))) ::
++ sear :: conditional cook
++ shim :: match char in range
++ stag :: add a label
++ stet ::
++ stew :: switch by first char
++ slug ::
++ star :: 0 or more times
++ stir
++ stun :: parse several times
++ rash |*([naf=@ sab=rule] (scan (trip naf) sab))
++ rose |* [los=tape sab=rule]
++ rush |*([naf=@ sab=rule] (rust (trip naf) sab))
++ rust |* [los=tape sab=rule]
++ scan |* [los=tape sab=rule]
++ ace (just ' ') :: spACE
++ bar (just '|') :: vertical BAR
++ bas (just '\\') :: Back Slash (escaped)
++ buc (just '$') :: dollars BUCks
++ cab (just '_') :: CABoose
++ cen (just '%') :: perCENt
++ col (just ':') :: COLon
++ com (just ',') :: COMma
++ doq (just '"') :: Double Quote
++ dot (just '.') :: dot dot dot ...
++ fas (just '/') :: Forward Slash
++ gal (just '<') :: Greater Left
++ gar (just '>') :: Greater Right
++ hax (just '#') :: Hash
++ hep (just '-') :: HyPhen
++ kel (just '{') :: Curly Left
++ ker (just '}') :: Curly Right
++ ket (just '^') :: CareT
++ lus (just '+') :: pLUS
++ mic (just ';') :: seMIColon
++ pal (just '(') :: Paren Left
++ pam (just '&') :: AMPersand pampersand
++ par (just ')') :: Paren Right
++ pat (just '@') :: AT pat
++ sel (just '[') :: Square Left
++ ser (just ']') :: Square Right
++ sig (just '~') :: SIGnature squiggle
++ soq (just '\'') :: Single Quote
++ tar (just '*') :: sTAR
++ tic (just '`') :: backTiCk
++ tis (just '=') :: 'tis tis, it is
++ wut (just '?') :: wut, what?
++ zap (just '!') :: zap! bang! crash!!
++ 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
++ dof ;~(plug hep gay) :: - @q 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
++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white
++ gay ;~(pose gap (easy ~)) ::
++ gon ;~(pose ;~(plug bas gay fas) (easy ~)) :: long numbers \ /
++ gul ;~(pose (cold 2 gal) (cold 3 gar)) :: axis syntax < >
++ hex (bass 16 (most gon hit)) :: hex to atom
++ hig (shim 'A' 'Z') :: uppercase
++ hit ;~ pose :: hex digits
++ iny :: indentation block
++ low (shim 'a' 'z') :: lowercase
++ mes %+ cook :: hexbyte
++ nix (boss 256 (star ;~(pose aln cab))) ::
++ nud (shim '0' '9') :: numeric
++ prn ;~(less (just `@`127) (shim 32 256)) :: non-control
++ qat ;~ pose :: chars in blockcord
++ qit ;~ pose :: chars in a cord
++ qut ;~ simu soq :: cord
++ soz ;~(plug soq soq soq) :: delimiting '''
++ sym :: symbol
++ mixed-case-symbol
++ ven ;~ (comp |=([a=@ b=@] (peg a b))) :: +>- axis syntax
++ vit :: base64 digit
++ vul %+ cold ~ :: comments
++ 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)))
++ 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
++ 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
++ urt %+ cook
++ urx %+ cook
++ voy ;~(pfix bas ;~(pose bas soq bix))
++ ag
++ ape |*(fel=rule ;~(pose (cold `@`0 (just '0')) fel))
++ bay (ape (bass 16 ;~(plug qeb:ab (star ;~(pfix dog qib:ab)))))
++ bip =+ tod=(ape qex:ab)
++ 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 fynd:ob
++ feq %+ cook |=(a=(list @) (rep 4 (flop a)))
++ 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)
++ mot ;~ pose
++ 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
++ zag [p=(end 4 (add top bot)) q=bot]
++ zig [p=(end 4 (add top (sub 0x1.0000 bot))) q=bot]
++ zug (mix (lsh 4 top) bot)
++ ne
++ 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)))
++ co
++ rear |=(rom=tape rend(rep rom))
++ rent ~+ `@ta`(rap 3 rend)
++ rend
++ 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
++ s-co
++ 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
++ ed-co
++ ox-co
++ ro-co
++ so
++ bisk
++ crub
++ nuck
++ nusk
++ perd
++ royl
++ royl-rh (cook rylh ;~(pfix ;~(plug sig sig) (cook royl-cell royl-rn)))
++ royl-rq (cook rylq ;~(pfix ;~(plug sig sig sig) (cook royl-cell royl-rn)))
++ royl-rd (cook ryld ;~(pfix sig (cook royl-cell royl-rn)))
++ royl-rs (cook ryls (cook royl-cell royl-rn))
++ royl-rn
++ royl-cell
++ tash
++ twid
++ when
++ zust
++ scot
++ scow
++ slat |=(mod=@tas |=(txt=@ta (slaw mod txt)))
++ slav |=([mod=@tas txt=@ta] (need (slaw mod txt)))
++ slaw
++ slay
++ smyt :: pretty print path
++ spat |=(pax=path (crip (spud pax))) :: render path to cord
++ spud |=(pax=path ~(ram re (smyt pax))) :: render path to tape
++ stab |=(zep=@t `path`(rash zep stap)) :: parse cord to path
++ stap :: path parser
++ stip :: typed path parser
++ swot |=(n=nail (;~(pfix fas (more fas spot)) n))
++ spot
++ pout
++ pave
++ mack
++ mink !.
++ frag
++ edit
++ mock
++ mook
++ skip
++ rend
++ mole
++ mong
++ mule
++ mure
++ mute
++ slum
++ soft

If you encounter a biblical name (+$abel, +$onan, etc.) then you're in the prettyprinter.

+$ abel typo :: original sin: type
+$ alas (list (pair term hoon)) :: alias list
+$ atom @ :: just an atom
+$ aura @ta :: atom format
+$ base :: base mold
+$ woof $@(@ [~ p=hoon]) :: simple embed
+$ chum $? lef=term :: jet name
+$ coil $: p=garb :: name, wet=dry, vary
+$ garb (trel (unit term) poly vair) :: core
+$ poly ?(%wet %dry) :: polarity
+$ foot $% [%dry p=hoon] :: dry arm, geometric
+$ link :: lexical segment
+$ cuff (list link) :: parsed lex segments
+$ crib [summary=cord details=(list sect)] ::
+$ help [=cuff =crib] :: documentation
+$ limb $@ term :: wing element
+$ null ~ :: null, nil, etc
+$ onyx (list (pair type foot)) :: arm activation
+$ opal :: limb match
+$ pica (pair ? cord) :: & prose, | code
+$ palo (pair vein opal) :: wing trace, match
+$ pock (pair axis nock) :: changes
+$ port (each palo (pair type nock)) :: successful match
+$ spec :: structure definition
+$ tent :: model builder
+$ tiki :: test case
+$ skin :: texture
+$ tome (pair what (map term hoon)) :: core chapter
+$ tope :: topographic type
++ hoot :: hoon tools
+$ beer $@(char [~ p=hoon]) :: simple embed
+$ mane $@(@tas [@tas @tas]) :: XML name+space
+$ manx $~([[%$ ~] ~] [g=marx c=marl]) :: dynamic XML node
+$ marl (list tuna) :: dynamic XML nodes
+$ mart (list [n=mane v=(list beer)]) :: dynamic XML attrs
+$ marx $~([%$ ~] [n=mane a=mart]) :: dynamic XML tag
+$ mare (each manx marl) :: node or nodes
+$ maru (each tuna marl) :: interp or nodes
+$ tuna :: maybe interpolation
+$ hoon :: hoon AST
+$ tyre (list [p=term q=hoon]) ::
+$ tyke (list (unit hoon)) ::
+$ nock $^ [p=nock q=nock] :: autocons
+$ note :: type annotation
+$ type $~ %noun ::
+$ tony :: ++tone done right
+$ tine :: partial noun
+$ tool $@(term tune) :: type decoration
+$ tune :: complex
+$ 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 :: prefix docs parse
+$ whiz cord :: postfix doc parse
+$ what (unit (pair cord (list sect))) :: help slogan/section
+$ wing (list limb) :: search path
+$ block
+$ result
+$ thunk
+$ seminoun
+$ stencil
+$ output
+$ doss
+$ moan :: sample metric
+$ hump

Core 5

Parsing and Compiler
++  musk  !.                                            ::  nock with block set
 ++  abet
 ++  araw
 ++  apex
 ++  combine
 ++  complete
 ++  fragment
 ++  mutate
 ++  require
 ++  squash
++  bool  `type`(fork [%atom %f `0] [%atom %f `1] ~)    ::  make loobean
++  cell                                                ::  make %cell type
++  core                                                ::  make %core type
++  hint
++  face                                                ::  make %face type
++  fork                                                ::  make %fork type
++  cove                                                ::  extract [0 *] axis
++  comb                                                ::  combine two formulas
++  cond                                                ::  ?:  compile
++  cons                                                ::  make formula cell
++  fitz                                                ::  odor compatibility
++  flan                                                ::  loobean  &
++  flip                                                ::  loobean negation
++  flor                                                ::  loobean  |
++  hike
 ++  contains
 ++  parent
 ++  sibling
 ++  insert
++  jock
++  look
++  loot
++  ah                                                  ::  tiki engine
 ++  blue
 ++  teal
 ++  tele
 ++  gray
 ++  puce
 ++  wthp  |=  opt=(list (pair spec hoon))
 ++  wtkt  |=([sic=hoon non=hoon] (gray [%wtkt puce (blue sic) (blue non)]))
 ++  wtls  |=  [gen=hoon opt=(list (pair spec hoon))]
 ++  wtpt  |=([sic=hoon non=hoon] (gray [%wtpt puce (blue sic) (blue non)]))
 ++  wtsg  |=([sic=hoon non=hoon] (gray [%wtsg puce (blue sic) (blue non)]))
 ++  wthx  |=(syn=skin (gray [%wthx (tele syn) puce]))
 ++  wtts  |=(mod=spec (gray [%wtts (teal mod) puce]))
++  ax
 ++  autoname
 ++  function
 ++  interface
 ++  home
 ++  clear
 ++  basal
 ++  unfold
 ++  unreel
 ++  descend
 ++  decorate
 ++  pieces
 ++  spore
 ++  example
 ++  factory
 ++  analyze
   ++  basic
   ++  clear
   ++  fetch
   ++  fetch-wing
   ++  choice
   ++  switch
   ++  relative
++  ap                                                  ::  hoon engine
 ++  grip
 ++  name
 ++  feck
 ::  not used at present; see comment at %csng in ++open
::++  hail
 ++  half
 ++  flay
 ++  open
     ++  open-mane
     ++  open-mart
 ++  rake  ~>(%mean.'rake-hoon' (need reek))
 ++  reek
 ++  rusk
++  ut
 ++  clip
 ++  ar  !:
   ++  fish
   ++  gain
   ++  lose
 ++  blow
 ++  bran
 ++  burp
 ++  busk
 ++  buss
 ++  crop
   ++  dext
   ++  sint
 ++  cool
 ++  duck  ^-(tank ~(duck us sut))
 ++  dune  |.(duck)
 ++  dunk
 ++  elbo
 ++  ergo
 ++  endo
 ++  et
   ++  play
   ++  mint
   ++  mull
 ++  epla
 ++  emin
 ++  emul
 ++  felt  !!
 ++  feel                                              ::  detect existence
 ++  fond
       ++  pony                                        ::  raw match
     |%  ++  here  ?:  =(0 p.heg)
         ++  lose  [%| %& p.heg]
         ++  stop  ?~(q.heg here lose)
         ++  twin  |=  [hax=pony yor=pony]
         ++  $
             ++  main
             ++  next
 ++  find
 ++  fund
 ++  fine
 ++  fire
 ++  fish
 ++  fuse
 ++  gain
 ++  hemp
 ++  laze
   ++  chapter
 ++  lose
 ++  chip
 ++  bake
 ++  balk
 ++  mile
 ++  mine
   +$  gol-type
   ++  core-check
   ++  chapters-check
   ++  get-tomes
   ++  get-arms
   ++  arms-check
   ++  get-arm-type
   ++  nice
 ++  mint
   ++  nice
   ++  grow
 ++  moot
 ++  mull
   ++  beth
   ++  nice
   ++  grow
 ++  meet  |=(ref=type &((nest | ref) (nest(sut ref) | sut)))
 ++  miss                                              ::  nonintersection
   ++  dext
   ++  sint
 ++  mite  |=(ref=type |((nest | ref) (nest(sut ref) & sut)))
 ++  nest
   ++  deem
   ++  deep
   ++  dext
   ++  meet  &(dext dext(sut ref, ref sut))
   ++  sint
 ++  peek
 ++  peel
 ++  play
 ++  redo                                              ::  refurbish faces
   ++  dear                                            ::  resolve tool stack
   ++  dext                                            ::  subject traverse
   ++  done                                            ::  complete assembly
   ++  sint                                            ::  reduce by reference
 ++  repo
 ++  rest
 ++  sink
   ++  mup  |=(* (scot %p (mug +<)))
 ++  take
 ++  tack
 ++  tend
 ++  toss
 ++  wrap
++  us                                                  ::  prettyprinter
     +$  cape  [p=(map @ud wine) q=wine]               ::
     +$  wine                                          ::
 ++  dash
 ++  deal  |=(lum=* (dish dole lum))
 ++  dial
   ++  many
   ++  $
 ++  dish  !:
 ++  doge
 ++  dole
 ++  duck  (dial dole)
++  cain  sell                                          ::  $-(vase tank)
++  noah  text                                          ::  $-(vase tape)
++  onan  seer                                          ::  $-(vise vase)
++  levi                                                ::  $-([type type] ?)
++  text                                                ::  tape pretty-print
++  seem  |=(toy=typo `type`toy)                        ::  promote typo
++  seer  |=(vix=vise `vase`vix)                        ::  promote vise
++  sell
++  skol
++  slam                                                ::  slam a gate
++  slab                                                ::  test if contains
++  slap
++  slog                                                ::  deify printf
++  mean                                                ::  crash with trace
++  road
++  slew                                                ::  get axis in vase
++  slim                                                ::  identical to seer?
++  slit                                                ::  type of slam
++  slob                                                ::  superficial arm
++  sloe                                                ::  get arms in core
++  slop                                                ::  cons two vases
++  slot                                                ::  got axis in vase
++  slym                                                ::  slam w+o sample-type
++  sped                                                ::  reconstruct type
++  swat
++  vang
++  vast                                                ::  main parsing core
 ++  gash  %+  cook                                    ::  parse path
 ++  gasp  ;~  pose                                    ::  parse =path= etc.
 ++  glam  ~+((glue ace))
 ++  hasp  ;~  pose                                    ::  path element
 ++  limp  %+  cook
 ++  mota  %+  cook
 ++  docs
   ++  apex
   ++  apse
   ++  leap                                            ::  whitespace w/o docs
   ++  smol
   ++  larg
   ++  rant
   ++  skip                                            ::  non-doccord comment
   ++  null  (cold ~ (star ace))
   ++  text  (pick line code)
   ++  teyt  (pick line ;~(pfix step code))
   ++  line  ;~(less ace (cook crip (star prn)))
   ++  code  ;~(pfix step ;~(less ace (cook crip (star prn))))
   ++  step  ;~(plug ace ace)
   ++  into
   ++  en-link
 ++  clad                                              ::  hoon doccords
 ++  coat                                              ::  spec doccords
 ++  scye                                              ::  with prefix doccords
 ++  seam                                              ::  with doccords
 ++  plex                                              ::  reparse static path
 ++  phax
 ++  posh
 ++  poof                                              ::  path -> (list hoon)
 ++  poon                                              ::  try to replace '='s
 ++  poor
 ++  porc
 ++  rump
 ++  rood
 ++  reed
 ++  stem
   ++  slip  |*(r=rule (stag %hoon r))
   ++  slot  |*(r=rule (sear (soft iota) r))
   ++  spit
 ++  rupl
Sail and XML Parsing
++  sail                                              ::  xml template
   ++  apex                                            ::  product hoon
   ++  top-level                                       ::  entry-point
   ++  inline-embed                                    ::  brace interpolation
   ++  script-or-style                                 ::  script or style
   ++  tuna-mode                                       ::  xml node(s) kind
   ++  wide-top                                        ::  wide outer top
   ++  wide-inner-top                                  ::  wide inner top
   ++  wide-attrs                                      ::  wide attributes
   ++  wide-tail                                       ::  wide elements
   ++  wide-elems                                      ::  wide elements
   ++  wide-paren-elems                                ::  wide flow
   ++  drop-top
   ++  join-tops
   ++  wide-quote                                      ::  wide quote
   ++  quote-innards                                   ::  wide+tall flow
   ++  bracketed-elem                                  ::  bracketed element
   ++  wrapped-elems                                   ::  wrapped tuna
   ++  a-mane                                          ::  mane as hoon
   ++  en-class
   ++  tag-head                                        ::  tag head
   ++  tall-top                                        ::  tall top
   ++  tall-attrs                                      ::  tall attributes
   ++  tall-elem                                       ::  tall preface
   ++  hopefully-quote                                 :: prefer "quote" form
   ++  script-style-tail                               ::  unescaped tall tail
   ++  tall-tail                                       ::  tall tail
   ++  tall-kids                                       ::  child elements
   ++  collapse-chars                                  ::  group consec chars
 ++  cram                                              ::  parse unmark
+$  mane  $@(@tas [@tas @tas])                          ::  XML name+space
+$  manx  $~([[%$ ~] ~] [g=marx c=marl])                ::  dynamic XML node
+$  marl  (list manx)                                   ::  XML node list
+$  mars  [t=[n=%$ a=[i=[n=%$ v=tape] t=~]] c=~]        ::  XML cdata
+$  mart  (list [n=mane v=tape])                        ::  XML attributes
+$  marx  $~([%$ ~] [n=mane a=mart])                    ::  dynamic XML tag
Compiler
++  scad
 ++  scat
 ++  soil
 ++  sump  (ifix [kel ker] (stag %cltr (most ace wide)))
 ++  norm                                              ::  rune regular form
   ++  structure
   ++  expression
   ++  boog  !:
   ++  bola                                           ::  ++  arms
     ;~  pfix  (jest '++')
   ++  boba                                           ::  +$  arms
     ;~  pfix  (jest '+$')
  ++  lynx
   ++  whap  !:                                        ::  chapter
   ++  glow
       ::  we only support ++ and +$ batch comments right now
   ++  whip                                            ::  chapter declare
   ++  wasp                                            ::  $brcb aliases
   ++  wisp  !:                                        ::  core tail
   ++  toad                                            ::  untrap parser expr
   ++  rune                                            ::  build rune
   ++  runo                                            ::  rune plus
   ++  runq                                            ::  wide or tall if tol
   ++  butt  |*  zor=rule                              ::  closing == if tall
   ++  ulva  |*  zor=rule                              ::  closing -- and tall
   ++  glop  ~+((glue mash))                           ::  separated by space
   ++  gunk  ~+((glue muck))                           ::  separated list
   ++  goop  ~+((glue mush))                           ::  separator list & docs
   ++  hank  (most mush loaf)                          ::  gapped hoons
   ++  hunk  (most mush loan)                          ::  gapped specs
   ++  jump  ;~(pose leap:docs gap)                    ::  gap before docs
   ++  loaf  ?:(tol tall wide)                         ::  hoon
   ++  loll  ?:(tol tall(doc |) wide(doc |))           ::  hoon without docs
   ++  loan  ?:(tol till wyde)                         ::  spec
   ++  lore  (sear |=(=hoon ~(flay ap hoon)) loaf)     ::  skin
   ++  lomp  ;~(plug sym (punt ;~(pfix tis wyde)))     ::  typeable name
   ++  mash  ?:(tol gap ;~(plug com ace))              ::  list separator
   ++  muss  ?:(tol jump ;~(plug com ace))             ::  list w/ doccords
   ++  muck  ?:(tol gap ace)                           ::  general separator
   ++  mush  ?:(tol jump ace)                          ::  separator w/ docs
   ++  teak  %+  knee  *tiki  |.  ~+                   ::  wing or hoon
   ++  rack  (most muss ;~(goop loaf loaf))            ::  list [hoon hoon]
   ++  ruck  (most muss ;~(goop loan loaf))            ::  list [spec hoon]
   ++  rick  (most mash ;~(goop rope loaf))            ::  list [wing hoon]
   ++  expa  |.(loaf)                                  ::  one hoon
   ++  expb  |.(;~(goop loaf loaf))                    ::  two hoons
   ++  expc  |.(;~(goop loaf loaf loaf))               ::  three hoons
   ++  expd  |.(;~(goop loaf loaf loaf loaf))          ::  four hoons
   ++  expe  |.(wisp)                                  ::  core tail
   ++  expf  |.(;~(goop ;~(pfix cen sym) loaf))        ::  %term and hoon
   ++  expg  |.(;~(gunk lomp loll loaf))               ::  term/spec, two hoons
   ++  exph  |.((butt ;~(gunk rope rick)))             ::  wing, [wing hoon]s
   ++  expi  |.((butt ;~(goop loaf hank)))             ::  one or more hoons
   ++  expj  |.(;~(goop lore loaf))                    ::  skin and hoon
  :: ++  expk  |.(;~(gunk loaf ;~(plug loaf (easy ~))))::  list of two hoons
  :: ++  expl  |.(;~(gunk sym loaf loaf))              ::  term, two hoons
   ++  expm  |.((butt ;~(gunk rope loaf rick)))        ::  several [spec hoon]s
   ++  expn  |.  ;~  gunk  rope  loaf                  ::  wing, hoon,
   ++  expo  |.(;~(goop wise loaf loaf))               ::  =;
   ++  expp  |.(;~(goop (butt rick) loaf))             ::  [wing hoon]s, hoon
   ++  expq  |.(;~(goop rope loaf loaf))               ::  wing and two hoons
   ++  expr  |.(;~(goop loaf wisp))                    ::  hoon and core tail
   ++  exps  |.((butt hank))                           ::  closed gapped hoons
   ++  expt  |.(;~(gunk wise rope loaf loaf))          ::  =^
   ++  expu  |.(;~(gunk rope loaf (butt hank)))        ::  wing, hoon, hoons
  :: ++  expv  |.((butt rick))                         ::  just changes
   ++  expw  |.(;~(goop rope loaf loaf loaf))          ::  wing and three hoons
   ++  expx  |.(;~(goop ropa loaf loaf))               ::  wings and two hoons
   ++  expy  |.(loaf(bug &))                           ::  hoon with tracing
   ++  expz  |.(;~(goop loan loaf loaf loaf))          ::  spec and three hoons
   ++  exqa  |.(loan)                                  ::  one spec
   ++  exqb  |.(;~(goop loan loan))                    ::  two specs
   ++  exqc  |.(;~(goop loan loaf))                    ::  spec then hoon
   ++  exqd  |.(;~(goop loaf loan))                    ::  hoon then spec
   ++  exqe  |.(;~(goop lynx loan))                    ::  list of names then spec
   ++  exqs  |.((butt hunk))                           ::  closed gapped specs
   ++  exqg  |.(;~(goop sym loan))                     ::  term and spec
   ::++  exqk  |.(;~(goop loaf ;~(plug loan (easy ~))))::  hoon with one spec
   ++  exqn  |.(;~(gunk loan (stag %cltr (butt hank))))::  autoconsed hoons
   ++  exqr  |.(;~(gunk loan ;~(plug wasp wisp)))      ::  spec/aliases?/tail
   ::++  exqw  |.(;~(goop loaf loan))                  ::  hoon and spec
   ++  exqx  |.(;~(goop loaf loan loan))               ::  hoon, two specs
   ++  exqy  |.(;~(goop loaf loan loan loan))          ::  hoon, three specs
   ++  exqz  |.(;~(goop loaf (butt hunk)))             ::  hoon, n specs
   ++  txhp  |.  %+  cook  |=  [a=tiki b=(list (pair spec hoon))]
   ++  tkkt  |.  %+  cook  |=  [a=tiki b=hoon c=hoon]
   ++  txls  |.  %+  cook  |=  [a=tiki b=hoon c=(list (pair spec hoon))]
   ++  tkvt  |.  %+  cook  |=  [a=tiki b=hoon c=hoon]
   ++  tksg  |.  %+  cook  |=  [a=tiki b=hoon c=hoon]
   ++  txts  |.  %+  cook  |=  [a=spec b=tiki]
   ++  txhx  |.  %+  cook  |=  [a=skin b=tiki]
   ++  hinb  |.(;~(goop bont loaf))                    ::  hint and hoon
   ++  hinc  |.                                        ::  optional =en, hoon
   ++  hind  |.(;~(gunk bonk loaf ;~(goop bonz loaf))) ::  jet hoon "bon"s hoon
   ++  hine  |.(;~(goop bonk loaf))                    ::  jet-hint and hoon
   ++  hinf  |.                                        ::  0-3 >s, two hoons
   ++  hing  |.                                        ::  0-3 >s, three hoons
   ++  bonk                                            ::  jet signature
   ++  hinh  |.                                        ::  1/2 numbers, hoon
   ++  bont  ;~  (bend)                                ::  term, optional hoon
   ++  bony  (cook |=(a=(list) (lent a)) (plus tis))   ::  base 1 =en count
   ++  bonz                                            ::  term-labelled hoons
 ++  lang                                              ::  lung sample
 ++  lung
 ++  long
 ++  lobo  (most ;~(plug com ace) ;~(glam rope wide))
 ++  loon  (most ;~(plug com ace) ;~(glam wide wide))
 ++  lute                                              ::  tall [] noun
 ++  ropa  (most col rope)
 ++  rope                                              ::  wing form
 ++  wise
 ++  tall                                              ::  full tall form
 ++  till                                              ::  mold tall form
 ++  wede                                              ::  wide bulb
 ++  wide                                              ::  full wide form
 ++  wyde                                              ::  mold wide form
 ++  wart
 ++  wert
++  vest
++  vice
++  make                                                ::  compile cord to nock
++  rain                                                ::  parse with % path
++  ream                                                ::  parse cord to hoon
++  reck                                                ::  parse hoon file
++  ride                                                ::  end-to-end compiler
+$  mite  (list @ta)                                    ::  mime type
+$  pass  @                                             ::  public key
+$  ring  @                                             ::  private key
+$  ship  @p                                            ::  network identity
+$  shop  (each ship (list @ta))                        ::  urbit/dns identity
+$  spur  path                                          ::  ship desk case spur
+$  time  @da                                           ::  galactic time
++  pi-heck
++  pi-noon                                             ::  sample trace
++  pi-mope                                             ::  add sample
++  pi-moth                                             ::  count sample
++  pi-mumm                                             ::  print sample
++  pi-tell                                             ::  produce dump

Core 6

Hoon is the root of the whole system—you cannot parse and build Arvo or anything else without these definitions. As part of ca01, you examined how +$hoon types are built and how the AST is implemented for a basic rune.

Outside of the language-necessary components, the %lull core provides kernel-wide structures (essentially, a header file) and the %zuse core provides a kernel-appropriate standard library. %zuse organizes its cores into what it terms “engines”.

%lull

Models
:: +capped-queue: a +qeu with a maximum number of entries
++ capped-queue
::
:: +clock: polymorphic cache type for use with the clock replacement algorithm
++ clock
::
:: +mop, +on: ordered map engine
++  mop
++  on
 ++  all :: apply logical AND on all values
 ++  any :: apply logical OR on all values
 ++  apt :: verify horz/vert orderings
 ++  bap :: convert to list, right-to-left
 ++  del :: delete key if it exists
 ++  dip :: partial inorder traversal
 ++  gas :: put a list of items
 ++  get :: get value at key (unit)
 ++  got :: get value at key (crash)
 ++  has :: check for key existence
 ++  lot :: take subset range
 ++  nip :: remove root (internal)
 ++  pop :: produce head and rest
 ++  pry :: produce head or null
 ++  put :: insert ordered item
 ++  ram :: produce tail or null
 ++  run :: apply gate to all values
 ++  tab :: tabulate subset to max count
 ++  tap :: convert to list, left-to-right
 ++  uni :: unify two ordered maps
 ++  wyt :: measure size
  • ++on provides the services for ++mop ordered maps.
+$  deco  ?(~ %bl %br %un)                              ::  text decoration
+$  json                                                ::  normal json value
+$  life  @ud                                           ::  ship key revision
+$  rift  @ud                                           ::  ship continuity
+$  mime  (pair mite octs)                              ::  mimetyped data
+$  octs  (pair @ud @)                                  ::  octet-stream
+$  sock  (pair ship ship)                              ::  outgoing [our his]
+$  stub  (list (pair stye (list @c)))                  ::  styled unicode
+$  stye  (pair (set deco) (pair tint tint))            ::  decos/bg/fg
+$  styl  %+  pair  (unit deco)                         ::  cascading style
+$  styx  (list $@(@t (pair styl styx)))                ::  styled text
+$  tint  $@  ?(%r %g %b %c %m %y %k %w %~)             ::  text color
+$  turf  (list @t)                                     ::  domain, tld first
++  ethereum-types
 ++  address  @ux
 +$  event-id  [block=@ud log=@ud]
 ++  events  (set event-id)
::
++  azimuth-types
 ++  point
 +$  dnses  [pri=@t sec=@t ter=@t]
 ++  diff-azimuth
 ++  diff-point
+$  vane-task
::
++  http  ^?
 +$  header-list
 +$  method
 +$  request
 +$  response-header
 +$  http-event
 ++  get-header
 ++  set-header
 ++  delete-header
 ++  unpack-header
 +$  simple-payload
  • Common structures: Ethereum, Azimuth, HTTP.
Networking (Ames)

After this point, %lull defines types and interfaces for interacting with vanes. We will skip lightly over these, but come back to them in the appropriate lessons.

::::                    ++ames                            ::  (1a) network
++  ames
Timekeeping (Behn)
::::                    ++behn                            ::  (1b) timekeeping
++  behn
Versioning (Clay)
::::                    ++clay                            ::  (1c) versioning
++  clay
Console (Dill)
::::                    ++dill                            ::  (1d) console
++  dill
HTTP Server (Eyre)
::::                    ++eyre                            ::  (1e) http-server
++  eyre
Extensions (Gall)
::::                    ++gall                            ::  (1g) extensions
++  gall  ^?
HTTP Client (Iris)
:: %iris http-client interface
++  iris
Security (Jael)
::::                    ++jael                          ::  (1h) security
++  jael
  ++  pki
Threads (Khan)
::::                    ++khan                            ::  (1i) threads
++  khan
IPC (Lick)
:::: ++lick :: (1j) IPC
++ lick
Computation

Various definitions for cards, strands, and moves.

++  rand                                                ::  computation
+$  gift-arvo                                           ::  out result <-$
+$  task-arvo                                           ::  in request ->$
+$  note-arvo                                           ::  out request $->
+$  sign-arvo                                           ::  in result $<-
+$  unix-task                                           ::  input from unix

%zuse

Cryptography

One of the most important components of %zuse is the crypto library. This supplies modular arithmetic (++fu) and several specific algorithms. (In general, signed arithmetic in Urbit uses different names (like ++sum instead of ++add) to prevent accidental confusion.) Some significant portions of this include:

++ number ^?
++ fu :: modulo (mul p q)
++ dif :: subtract
++ exp :: exponent
++ out :: garner's formula
++ pro :: multiply
++ sum :: add
++ sit :: represent
++ curt :: curve25519
++ crypto :: (2b) cryptography
++ aes
++ keccak :: (2b7) keccak family
++ keccak-224
++ keccak-256
++ keccak-384
++ keccak-512
++ keccak
++ sha3-224
++ sha3-256
++ sha3-384
++ sha3-512
++ sha3
++ hmac :: (2b8) hmac family
++ hmac-sha1
++ hmac-sha256
++ hmac-sha512
++ hmac-sha1t
++ hmac-sha256t
++ hmac-sha512t
++ hmac-sha1l
++ hmac-sha256l
++ hmac-sha512l
++ hmac
++ secp
++ secp256k1
++ sign :: schnorr signature
++ verify :: schnorr verify
++ blake
++ blake2b
++ argon2
++ ripemd
++ ripemd-160
++ pbkdf
++ hmac-sha1
++ hmac-sha256
++ hmac-sha512
++ hmac-sha1t
++ hmac-sha256t
++ hmac-sha512t
++ hmac-sha1l
++ hmac-sha256l
++ hmac-sha512l
++ hmac-sha1d
++ hmac-sha256d
++ hmac-sha512d
++ pbkdf

Notes on the above:

Units

After cryptography, there are a number of library utility functions.

++ unity :: (2c) unit promotion
++ drop-list :: collapse unit list
++ drop-map :: collapse unit map
++ drop-pole :: collapse to tuple
  • I don't see units used a lot outside of standard functions, but there are some convenience operators for them:
> (drop-list:unity `(list (unit @))`~[`1 `2 `3])
[~ [i=1 t=~[2 3]]]
> (drop-list:unity `(list (unit @))`~[`1 `2 ~])
~
Formatting Text and JSON Reparsing
++ format :: (2d) common formats
++ to-wain :: cord to line list
++ of-wain :: line list to cord
++ of-wall :: line list to tape
++ json-rn :: json to rn parser
++ enjs :: json encoders
++ frond :: object from k-v pair
++ pairs :: object from k-v list
++ tape :: string from tape
++ wall :: string from wall
++ ship :: string from ship
++ numb :: number from unsigned
++ sect :: s timestamp
++ time :: ms timestamp
++ path :: string from path
++ tank :: tank as string arr
++ dejs :: json reparser
++ ar :: array as list
++ as :: array as set
++ at :: array as tuple
++ bo :: boolean
++ bu :: boolean not
++ ci :: maybe transform
++ cu :: transform
++ di :: millisecond date
++ du :: second date
++ mu :: true unit
++ ne :: number as real
++ ni :: number as integer
++ ns :: number as signed
++ no :: number as cord
++ nu :: parse number as hex
++ of :: object as frond
++ ot :: object as tuple
++ ou :: object of units
++ oj :: object as jug
++ om :: object as map
++ op :: parse keys of map
++ pa :: string as path
++ pe :: prefix
++ sa :: string as tape
++ sd :: string @ud as date
++ se :: string as aura
++ so :: string as cord
++ su :: parse string
++ uf :: unit fall
++ un :: unit need
++ ul :: null
++ za :: full unit pole
++ zl :: collapse unit list
++ zp :: unit tuple
++ zm :: collapse unit map
++ klr :: styx/stub engine
++ cloy
  • ++enjs:format supports noun-to-JSON conversions.
  • ++dejs:format are the reparsers (see ++de:json:html for the parser). Notably this is where many noun-to-text converters live.
  • ++dejs-soft offers non-crashing versions of the ++dejs arms (thus, returning units).
Diffs

Diff tools, using the Hunt-McIlroy algorithm:

++ differ :: (2d) hunt-mcilroy
++ berk :: invert diff patch
++ loss :: longest subsequence
++ lurk :: apply list patch
++ lusk :: lcs to list patch
Web Text (HTML &c.)
++ html :: (2e) text encodings
++ mimes :: (2e1) MIME
++ as-octs :: atom to octstream
++ as-octt :: tape to octstream
++ en-mite :: mime type to text
++ base16 :: MSB hex strings
++ base64 :: flexible le base64 encoding
++ en-base58 :: Bitcoin base-58 address, encode
++ de-base58 :: Bitcoin base-58 address, decode

More JSON, this time the parser:

++ html
++ json :: (2e2) JSON
++ en :: encode JSON to tape
++ de :: parse cord to JSON
++ abox :: array
++ apex :: any value
++ bool :: boolean
++ esca :: escaped character
++ expo :: exponent
++ frac :: fraction
++ jcha :: string character
++ mayb :: optional
++ numb :: number
++ obje :: object list
++ obox :: object
++ pear :: key-value
++ piec :: listify
++ stri :: string
++ spac :: whitespace
++ unic :: escaped UTF16
++ utfe :: UTF-8 sequence
++ wish :: with whitespace
++ sune :: cord UTF-8 sanity
++ sung :: char UTF-8 sanity
++ teff :: UTF-8 length
  • ++json:html tools are reparsers (see ++dejs:format for the reparsers).
  • Since JSON do not have a single canonical form as text, these parsers provide an opportunity to see how to parse something structurally when whitespace doesn't matter.
++ html
++ en-xml :: xml printer
++ apex :: top level
++ attr :: attributes to tape
++ escp :: escape for xml
++ many :: nodelist to tape
++ name :: name to tape
++ clot :: self-closing tags
++ de-xml :: xml parser
++ apex :: top level
++ attr :: attributes
++ cdat :: CDATA section
++ chrd :: character data
++ comt :: comments
++ decl :: ++decl:de-xml:html
++ escp ::
++ enty :: entity
++ empt :: self-closing tag
++ head :: opening tag
++ many :: contents
++ name :: tag name
++ tail :: closing tag
++ whit :: whitespace
++ en-urlt :: url encode
++ de-urlt :: url decode
++ en-purl :: print purl
++ de-purl :: url+header parser
++ en-turf :: encode as TLD-last string
++ de-turf :: decode from TLD-last string
++ fuel :: parse urbit fcgi
Wires
++ wired :: wire formatting
++ dray :: load tuple in path
++ raid :: demand path odors
Identity

Retrieve your mathematical sponsor, convert a number to a rank, etc.

++ title :: (2j) identity
++ sein
++ clan :: ship to rank
+$ rank ?(%czar %king %duke %earl %pawn) :: ship width class
++ name :: identity
++ saxo :: autocanon
++ sein :: autoboss
++ cite :: render ship
++ saxo :: autocanon
++ sein :: autoboss
++ team :: her
++ moon :: her moon
Millisecond Timing

Some time-related tools (currently used for timing in Eyre):

++ milly :: (2k) milliseconds
++ around :: relative msec
++ about :: unit relative msec
++ mill :: msec diff
++ msec :: @dr to @ud ms
++ mull :: unit msec diff
++ contain
++ by-clock
++ to-capped-queue
Userlib

More userspace stuff. (At this point, %zuse is a grab bag of things that people have added over the years, and it's not clear who needs what or if it's even in contemporary use.)

++ userlib :: (2u) non-vane utils
++ chrono :: (2uB) time
++ from-unix
++ from-unix-ms
++ dawn :: Jan 1 weekday
++ daws :: date weekday
++ deal :: to leap sec time
++ lead :: from leap sec time
++ dust :: print UTC format
++ stud :: parse UTC format
++ unm :: Urbit to Unix ms
++ unt :: Urbit to Unix time
++ yu :: UTC format constants
++ space :: (2uC) file utils
++ feel :: simple file write
++ file :: simple file load
++ foal :: high-level write
++ fray :: high-level delete
++ furl :: unify changes
++ unix :: (2uD) unix line-list
++ lune :: cord by unix line
++ nule :: lines to unix cord
++ scanf :: (2uF) exterpolation
  • ++chrono:userlib provides tools to print and parse basic UTC time statements.
> (dust:chrono:userlib (yore now))
"Wed, 13 Sep 2023 20:9:38 +0000"
> (stud:chrono:userlib '13 Sep 2023 20:9:38 +0000')
[~ [[a=%.y y=2.023] m=9 t=[d=13 h=20 m=9 s=38 f=~]]]
> (stud:chrono:userlib 'Sep 13, 2023 20:9:38 +0000')
[~ [[a=%.y y=2.023] m=9 t=[d=13 h=20 m=9 s=38 f=~]]

(Overheard memo to self: work this into whatever /lib/chronos becomes.)

  • ++space:userlib is used by the Hood tools like |mv.

The Compilation Subject

Ford uses %zuse (thus the full standard library) as the compilation subject for a hoon file. Typically a userspace file will produce a core (or, in the case of some generators, a head tag and a core). That core will contain the standard library in its context because | bar runes (the only runes that produce cores) return cores containing the original subject in their payloads.

Ford also allows you to modify the compilation subject by imports. (This is why you have to import files at the top of a hoon file, and why you do it in a particular order.) Each import is prepended to the compilation subject, so in general your compilation subject will look like [lib1 lib2 sur1 sur2 zuse].

You can see this process in ++run-prelude:ford in /sys/vane/clay. (/ fas Ford runes are actually parsed in ++parse-pile using ++pile-rule. This is also where /? faswut is ignored.) In ca10 we'll take a deep dive through Clay.

/lib/tiny

The whole standard library is included in every piece of userspace Hoon, unless you go out of your way to remove it from the subject. This is only rarely a good idea, but you *can* build a small working Hoon against a minimalist subject. For instance, this is done for the naïve rollup smart contract code and Sword (née Ares) development using /lib/tiny.

> =>  tiny  (add 1 1)
2
> =>  tiny  (add:rs 1 1)
-find.rs
dojo: hoon expression failed

Exercises

  • Implement a custom aura, @uo (octal/byte encoding). At one level, simply implementing an aura requires no overhead. However, the rune must have a unique parsed format for input, and should have a corresponding output. (The rules around this are laxer for more complex nouns like sets and trees.) One format which would be compatible with the restrictions on atom syntax as well as not shadow any current atom types is 0o1234.5670 (89acbdef are not valid characters in octal). You can model heavily on @ux to implement this aura. (I have a tutorial which I have not finished for a degree–minute–second implementation.)
  • ++sloe is intended to receive a +$type and return a list of the named arms in that type. Modeling on ++sloe, produce a gate ++beau which retrieves each face in the sample of a supplied gate argument and produces a list of them.
> (sloe -:!>(..add))
~[%sub %gte %mod %min %mul %gth %add %div %lth %dec %dvr %max %lte
%mas %cap %peg %list %lest %trap %mold %tree %bloq %step %pair
%gate %bite %each %lone %qual %unit %pole %quip %trel]
> (sloe -:!>(add))
~[%$]

Hint:

> ([%cell *] +<+<:~(repo ut ~(repo ut -:!>(add))))
[ 1.819.043.171
[1.701.011.814 97 1.836.020.833 0 0]
1.701.011.814
98
1.836.020.833
0
0
]