shrub/gen/al.hoon

!:
:-  %say
|=  *
:-  %noun
=-  %hello
=>  |%
    ++  tope                                            ::  topographic type
      $@  $?  %&                                        ::  cell or atom
              %|                                        ::  atom
          ==                                            ::
      (pair tope tope)                                  ::  cell
    --
|%
++  ax
  =+  :*  dom=`axis`1
          doc=*(list what)
      ==
  |_  mod/tile
  ++  home
    ::  express a hoon against the original subject
    ::
    |=(gen/hoon ^-(hoon ?:(=(1 dom) gen [%tsgr [%$ dom] gen])))
  ::
  ++  default
    ::  produce a hoon that makes the model's default value, untyped
    ::
    |-  ^-  hoon
    ?-    mod
        {^ *}
      [$(mod -.mod) $(mod +.mod)]
    ::
        {$axil *}
      ?+  p.mod  [%rock %$ 0]
        $cell  [[%rock %$ 0] [%rock %$ 0]]
        $void  [%zpzp ~]
      ==
    ::
        {$bark *}
      $(mod q.mod)
    ::
        {$herb *}
      =+  cys=~(boil ap p.mod)
      ?:  ?=($herb -.cys)
        (home [%tsgl [%limb %$] p.mod])
      $(mod cys)
    ::
        {$deet *}
      $(mod q.mod)
    ::
        {$fern *}
      ::  last entry is the default value
      ::
      |-  ^-  hoon
      ?~(t.p.mod ^$(mod i.p.mod) $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod))
    ::
        {$kelp *}
      ::  last entry is the default value
      ::
      |-  ^-  hoon
      ?~(t.p.mod ^$(mod i.p.mod) $(i.p.mod i.t.p.mod, t.p.mod t.t.p.mod))
    ::
        {$leaf *}
      [%rock p.mod q.mod]
    ::
        {$plow *}
      $(mod q.mod)
    ::
        {$reed *}
      $(mod p.mod)
    ::
        {$vine *}
      $(mod q.mod)
    ::
        {$weed *}
      (home p.mod)
    ==
  ::
  ++  trivial
    ::  ersatz by trivial construction
    ::
    ^-  hoon
    :+  %tsls
      [%bust %noun]
    ~(construct sample [2 %|])
  ::
  ++  basic
    |=  bas/base
    ?-    bas
    ::
        {$atom *}
      ::  trivial zero
      ::
      [%sand p.bas 0]
    ::
        $noun
      ::  raw nock produces noun type
      ::
      =+([%rock %$ 0] [%ktls [%dttr - - [%rock %$ 1]] -])
    ::
        $cell
      ::  reduce to pair of nouns
      ::
      =+($(mod [%axil %noun]) [- -])
    ::
        $bean
      ::  comparison produces boolean type
      ::
      =+([%rock %$ 0] [%ktls [%dtts - -] -])
    ::
        $null
      [%rock %n 0]
    ::
        $void
      ::  should not actually be a thing
      ::
      [%zpzp ~]
    ==
  ::
  ++  decorate
    ::  document
    ::
    |=  gen/hoon
    ^-  hoon
    ?~  doc  gen
    =/  fin  $(doc t.doc)
    ?~(i.doc gen [%docs u.i.doc gen])
  ::
  ++  ersatz
    ::  produce a correctly typed instance without subject
    ::
    ^-  hoon
    ?-    mod
        {^ *}
      %-  decorate
      =.  doc  ~
      [ersatz(mod -.mod) ersatz(mod +.mod)]
    ::
        {$axil *}
      (decorate (basic p.mod))
    ::
        {$bark *}
      [%ktts p.mod ersatz(mod q.mod)]
    ::
        {$herb *}
      %-  decorate
      =.  doc  ~
      =+  cys=~(boil ap p.mod)
      ?:  ?=($herb -.cys)
        (home [%tsgl [%limb %$] p.mod])
      ersatz(mod cys)
    ::
        {$deet *}
      [%dbug p.mod ersatz(mod q.mod)]
    ::
        {$fern *}
      trivial
    ::
        {$kelp *}
      trivial
    ::
        {$leaf *}
      (decorate [%rock p.mod q.mod])
    ::
        {$plow *}
      ersatz(mod q.mod, doc [p.mod doc])
    ::  atom/cell, $@
    ::
        {$reed *}
      trivial
    ::  pair/switch, $^
    ::
        {$vine *}
      trivial
    ::
        {$weed *}
      (home p.mod)
    ==
  ::
  ++  factory
    ::  produce a normalizing gate (mold)
    ::
    ^-  hoon
    :^  %brts  ~^~
      [%base %noun]
    ~(construct sample [6 %&])
  ::
  ++  sample
    ::  normalize a sample of the subject
    ::
    |_  $:  ::  axe: axis to sample
            ::  top: topographic type of sample
            ::
            axe/axis
            top/tope
        ==
    ++  basic
      |=  bas/base
      ::  apply documentation
      ::
      ?^  doc  document
      ?-    bas
          {%atom *}
        ::  rez: fake instance
        ::
        =/  rez  ersatz
        ?^  top  rez
        ?:  =(%| top)
          ::  xx sanitize
          ::
          fetch
        [%wtpt fetch-wing fetch rez]
      ::
          $noun
        fetch
      ::
          $cell
        ?^  top  fetch
        ::  rez: fake instance
        ::
        =/  rez  ersatz
        ?:  =(%| top)
          rez
        [%wtpt fetch-wing rez fetch]
      ::
          $bean
        ?^  top  ersatz
        :^    %wtcl
            [%dtts [%rock %$ |] [%$ axe]]
          [%rock %f |]
        [%rock %f &]
      ::
          $null
        ersatz
      ::
          $void
        ersatz
      ==
    ++  fetch
      ::  load the sample
      ::
      ^-  hoon
      [%$ axe]
    ::
    ++  fetch-wing
      ::  load, as a wing
      ::
      ^-  wing
      [[%& axe] ~]
    ::
    ++  choice
      ::  match full models, by trying them
      ::
      |=  $:  ::  one: first option
              ::  rep: other options
              ::
              one/tile
              rep/(list tile)
          ==
      ^-  hoon
      ::  if no other choices, construct head
      ::
      ?~  rep  construct(mod one)
      ::  fin: loop completion
      ::
      =/  fin/hoon  $(one i.rep, rep t.rep)
      ::  new: trial product
      ::  old: original subject
      ::
      =/  new  [%$ 2]
      =*  old  [%$ 3]
      ::  build trial noun
      ::
      :+  %tsls
        ::  build the sample with the first option
        ::
        construct(mod one)
      ::  build test
      ::
      :^    %wtcl
          ::  if the trial noun equals the sample
          ::
          [%dtts new fetch]
        ::  produce the trial noun
        ::
        new
      ::  continue with the original subject
      ::
      [%tsgr old fin]
    ::
    ++  switch
      |=  $:  ::  one: first format
              ::  two: more formats
              ::
              one/line
              rep/(list line)
          ==
      ^-  hoon
      ::  if no other choices, construct head
      ::
      ?~  rep  construct(mod `tile`one)
      ::  fin: loop completion
      ::
      =/  fin/hoon  $(one i.rep, rep t.rep)
      ::  interrogate this instance
      ::
      :^    %wtcl
          ::  test if we match this wing
          ::
          [%wtts p.i.rep fetch-wing]
        ::  use this format
        ::
        :-  `hoon`p.i.rep
        construct(mod q.i.rep, top &, axe (peg axe 3))
      ::  continue in the loop
      ::
      fin
    ::
    ++  probe
      ::  probe for cell or default
      ::
      ^-  hoon
      ::  against constructor
      ::
      :+  %tsgr
        ::  constructor trap
        ::
        :+  %brdt  ~^~
        ::  construct within trap
        ::
        %=  construct
        ::  old context within trap context
        ::
          dom  (peg 3 dom)
        ::  old sample within trap sample
        ::
          axe  (peg 3 axe)
        ::  only kick trap if sample is known cell
        ::
          top  [& &]
        ==
      ::  boc: call constructor
      ::  but: default, but coerce type to call
      ::
      =/  boc/hoon  [%limb %$]
      =/  but/hoon  [%ktls boc default]
      ?:  =(& top)
        ::  may be atom or cell; default or construct
        ::
        [%wtpt fetch-wing but boc]
      ::  must be atom; construct
      ::
      but
    ::
    ++  document
      ::  document and construct
      ::
      |-  ^-  hoon
      ?~  doc  construct
      =/  fin  $(doc t.doc)
      ?~(i.doc fin [%docs u.i.doc fin])
    ::
    ++  construct
      ::  constructor at arbitrary sample
      ::
      ^-  hoon
      ?-    mod
      ::
      ::  cell
      ::
          {^ *}
        ::  apply help
        ::
        ?^  doc  document
        ::  probe unless we know the sample is a cell
        ::
        ?@  top  probe
        ::  if known cell, descend directly
        ::
        :-  construct(mod -.mod, top p.top, axe (peg axe 2))
        construct(mod +.mod, top q.top, axe (peg axe 3))
      ::
      ::  base
      ::
          {$axil *}
        (basic p.mod)
      ::
      ::  name, $=
      ::
          {$bark *}
        [%ktts p.mod construct(mod q.mod)]
      ::
      ::  debug
      ::
          {$deet *}
        [%dbug p.mod construct(mod q.mod)]
      ::
      ::  choice, $?
      ::
          {$fern *}
        (choice i.p.mod t.p.mod)
      ::
      ::  synthesis, $;
      ::
          {$herb *}
        ?^  doc  document
        =+  cys=~(boil ap p.mod)
        ?:  ?=($herb -.cys)
          [%cnhp (home p.mod) fetch ~]
        construct(mod cys)
      ::
      ::  switch, $%
      ::
          {$kelp *}
        ::  if atom or unknown, probe
        ::
        ?@  top  probe
        ::  if cell, enter switch directly
        ::
        (switch i.p.mod t.p.mod)
      ::
      ::  constant
      ::
          {$leaf *}
        (decorate [%rock p.mod q.mod])
      ::
      ::  documentation
      ::
          {$plow *}
        construct(doc [p.mod doc], mod q.mod)
      ::
      ::  branch, $@
      ::
          {$reed *}
        ?^  doc  document
        ?@  top
          ?:  =(%| top)
            construct(mod p.mod)
          [%wtpt fetch-wing construct(mod p.mod) construct(mod q.mod)]
        construct(mod q.mod)
      ::
      ::  bridge, $^
      ::
          {$vine *}
        ?^  doc  document
        ?@  top  probe
        :^    %wtpt
            fetch-wing(axe (peg axe 2))
          construct(mod q.mod)
        construct(mod p.mod)
      ::
      ::  weed, $_
      ::
          {$weed *}
        (decorate (home p.mod))
      ==
    --
  --
--