5a: Compiler Utilities

These functions are used internally by the compiler. They should not be used directly and are only listed here for completeness.

+musk

Nock with block set

Source

This function is extremely large, please refer to hoon.hoon for the source.

---

+bool

Make loobean

Source

++  bool  `type`(fork [%atom %f `0] [%atom %f `1] ~)

---

+cell

Make %cell type

Source

++  cell
  ~/  %cell
  |=  [hed=type tal=type]
  ^-  type
  ?:(=(%void hed) %void ?:(=(%void tal) %void [%cell hed tal]))

---

+core

Make %core type

Source

++  core
  ~/  %core
  |=  [pac=type con=coil]
  ^-  type
  ?:(=(%void pac) %void [%core pac con])

---

+hint

Make %hint type

Source

++  hint
  |=  [p=(pair type note) q=type]
  ^-  type
  ?:  =(%void q)  %void
  ?:  =(%noun q)  %noun
  [%hint p q]

---

+face

Make %face type

Source

++  face
  ~/  %face
  |=  [giz=$@(term tune) der=type]
  ^-  type
  ?:  =(%void der)
    %void
  [%face giz der]

---

+fork

Make %fork type

Source

++  fork
  ~/  %fork
  |=  yed=(list type)
  =|  lez=(set type)
  |-  ^-  type
  ?~  yed
    ?~  lez  %void
    ?:  ?=([* ~ ~] lez)  n.lez
    [%fork lez]
  %=    $
      yed  t.yed
      lez
    ?:  =(%void i.yed)  lez
    ?:  ?=([%fork *] i.yed)  (~(uni in lez) p.i.yed)
    (~(put in lez) i.yed)
  ==

---

+cove

Extract [0 *] axis

Source

++  cove
  |=  nug=nock
  ?-    nug
      [%0 *]   p.nug
      [%11 *]  $(nug q.nug)
      *        ~_(leaf+"cove" !!)
  ==

---

+comb

Combine two formulas

Source

++  comb
  ~/  %comb
  |=  [mal=nock buz=nock]
  ^-  nock
  ?:  ?&(?=([%0 *] mal) !=(0 p.mal))
    ?:  ?&(?=([%0 *] buz) !=(0 p.buz))
      [%0 (peg p.mal p.buz)]
    ?:  ?=([%2 [%0 *] [%0 *]] buz)
      [%2 [%0 (peg p.mal p.p.buz)] [%0 (peg p.mal p.q.buz)]]
    [%7 mal buz]
  ?:  ?=([^ [%0 %1]] mal)
    [%8 p.mal buz]
  ?:  =([%0 %1] buz)
    mal
  [%7 mal buz]

---

+cond

?: compile

Source

++  cond
  ~/  %cond
  |=  [pex=nock yom=nock woq=nock]
  ^-  nock
  ?-  pex
    [%1 %0]  yom
    [%1 %1]  woq
    *        [%6 pex yom woq]
  ==

---

+cons

Make formula cell

Source

++  cons
  ~/  %cons
  |=  [vur=nock sed=nock]
  ^-  nock
  ::  this optimization can remove crashes which are essential
  ::
  ::  ?:  ?=([[%0 *] [%0 *]] +<)
  ::  ?:  ?&(=(+(p.vur) p.sed) =((div p.vur 2) (div p.sed 2)))
  ::    [%0 (div p.vur 2)]
  ::  [vur sed]
  ?:  ?=([[%1 *] [%1 *]] +<)
    [%1 p.vur p.sed]
  [vur sed]

---

+fitz

Aura compatibility

Source

++  fitz
  ~/  %fitz
  |=  [yaz=term wix=term]
  =+  ^=  fiz
      |=  mot=@ta  ^-  [p=@ q=@ta]
      =+  len=(met 3 mot)
      ?:  =(0 len)
        [0 %$]
      =+  tyl=(rsh [3 (dec len)] mot)
      ?:  &((gte tyl 'A') (lte tyl 'Z'))
        [(sub tyl 64) (end [3 (dec len)] mot)]
      [0 mot]
  =+  [yoz=(fiz yaz) wux=(fiz wix)]
  ?&  ?|  =(0 p.yoz)
          =(0 p.wux)
          &(!=(0 p.wux) (lte p.wux p.yoz))
      ==
      |-  ?|  =(%$ p.yoz)
              =(%$ p.wux)
              ?&  =((end 3 p.yoz) (end 3 p.wux))
                  $(p.yoz (rsh 3 p.yoz), p.wux (rsh 3 p.wux))
              ==
          ==
  ==

---

+flan

Loobean &

Source

++  flan
  ~/  %flan
  |=  [bos=nock nif=nock]
  ^-  nock
  ?:  =(bos nif)  bos
  ?:  =([%0 0] bos)  nif
  ?:  =([%0 0] nif)  bos
  ?-    bos
      [%1 %1]   bos
      [%1 %0]   nif
      *
    ?-    nif
        [%1 %1]   nif
        [%1 %0]   bos
        *       [%6 bos nif [%1 1]]
    ==
  ==

---

+flip

Loobean negation

Source

++  flip
  ~/  %flip
  |=  dyr=nock
  ?:  =([%0 0] dyr)  dyr
  [%6 dyr [%1 1] [%1 0]]

---

+flor

Loobean |

Source

++  flor
  ~/  %flor
  |=  [bos=nock nif=nock]
  ^-  nock
  ?:  =(bos nif)  bos
  ?:  =([%0 0] bos)  nif
  ?:  =([%0 0] nif)  bos
  ?-  bos
      [%1 %1]   nif
      [%1 %0]   bos
      *
    ?-  nif
        [%1 %1]   bos
        [%1 %0]   nif
        *         [%6 bos [%1 0] nif]
    ==
  ==

---

+hike

Compiler utility

Source

++  hike
  ~/  %hike
  |=  [a=axis pac=(list (pair axis nock))]
  |^  =/  rel=(map axis nock)  (roll pac insert)
      =/  ord=(list axis)      (sort ~(tap in ~(key by rel)) gth)
      |-  ^-  nock
      ?~  ord
        [%0 a]
      =/  b=axis  i.ord
      =/  c=nock  (~(got by rel) b)
      =/  d=nock  $(ord t.ord)
      [%10 [b c] d]
  ::
  ++  contains
    |=  [container=axis contained=axis]
    ^-  ?
    =/  big=@    (met 0 container)
    =/  small=@  (met 0 contained)
    ?:  (lte small big)  |
    =/  dif=@  (sub small big)
    =(container (rsh [0 dif] contained))
  ::
  ++  parent
    |=  a=axis
    `axis`(rsh 0 a)
  ::
  ++  sibling
    |=  a=axis
    ^-  axis
    ?~  (mod a 2)
      +(a)
    (dec a)
  ::
  ++  insert
    |=  [e=[axe=axis fol=nock] n=(map axis nock)]
    ^-  (map axis nock)
    ?:  =/  a=axis  axe.e
        |-  ^-  ?
        ?:  =(1 a)  |
        ?:  (~(has by n) a)
          &
        $(a (parent a))
      ::  parent already in
      n
    =.  n
      ::  remove children
      %+  roll  ~(tap by n)
      |=  [[axe=axis fol=nock] m=_n]
      ?.  (contains axe.e axe)  m
      (~(del by m) axe)
    =/  sib  (sibling axe.e)
    =/  un   (~(get by n) sib)
    ?~  un   (~(put by n) axe.e fol.e)
    ::  replace sibling with parent
    %=  $
      n  (~(del by n) sib)
      e  :-  (parent sib)
         ?:  (gth sib axe.e)
           (cons fol.e u.un)
         (cons u.un fol.e)
    ==
  --

---

+jock

Compiler utility

Source

++  jock
  |=  rad=?
  |=  lot=coin  ^-  hoon
  ?-    -.lot
      ~
    ?:(rad [%rock p.lot] [%sand p.lot])
  ::
      %blob
    ?:  rad
      [%rock %$ p.lot]
    ?@(p.lot [%sand %$ p.lot] [$(p.lot -.p.lot) $(p.lot +.p.lot)])
  ::
      %many
    [%cltr (turn p.lot |=(a=coin ^$(lot a)))]
  ==

---

+look

Compiler utility

Source

++  look
  ~/  %look
  |=  [cog=term dab=(map term hoon)]
  =+  axe=1
  |-  ^-  (unit [p=axis q=hoon])
  ?-  dab
      ~  ~
  ::
      [* ~ ~]
    ?:(=(cog p.n.dab) [~ axe q.n.dab] ~)
  ::
      [* ~ *]
    ?:  =(cog p.n.dab)
      [~ (peg axe 2) q.n.dab]
    ?:  (gor cog p.n.dab)
      ~
    $(axe (peg axe 3), dab r.dab)
  ::
      [* * ~]
    ?:  =(cog p.n.dab)
      [~ (peg axe 2) q.n.dab]
    ?:  (gor cog p.n.dab)
      $(axe (peg axe 3), dab l.dab)
    ~
  ::
      [* * *]
    ?:  =(cog p.n.dab)
      [~ (peg axe 2) q.n.dab]
    ?:  (gor cog p.n.dab)
      $(axe (peg axe 6), dab l.dab)
    $(axe (peg axe 7), dab r.dab)
  ==

---

+loot

Compiler utility

Source

++  loot
  ~/  %loot
  |=  [cog=term dom=(map term tome)]
  =+  axe=1
  |-  ^-  (unit [p=axis q=hoon])
  ?-  dom
      ~  ~
  ::
      [* ~ ~]
    %+  bind  (look cog q.q.n.dom)
    |=((pair axis hoon) [(peg axe p) q])
  ::
      [* ~ *]
    =+  yep=(look cog q.q.n.dom)
    ?^  yep
      [~ (peg (peg axe 2) p.u.yep) q.u.yep]
    $(axe (peg axe 3), dom r.dom)
  ::
      [* * ~]
    =+  yep=(look cog q.q.n.dom)
    ?^  yep
      [~ (peg (peg axe 2) p.u.yep) q.u.yep]
    $(axe (peg axe 3), dom l.dom)
  ::
      [* * *]
    =+  yep=(look cog q.q.n.dom)
    ?^  yep
      [~ (peg (peg axe 2) p.u.yep) q.u.yep]
    =+  pey=$(axe (peg axe 6), dom l.dom)
    ?^  pey  pey
    $(axe (peg axe 7), dom r.dom)
  ==

---