test: add new scaffolding for advanced pills

hoon/scaffolding/playpen.hoon

@@ -0,0 +1,628 @@
+::  This file aims to approach hoon.hoon, as the pieces necessary to run a live
+::  ship with Ares as Serf are written. Required to run toddler.hoon as an Arvo.
+::
+!.
+=>  %a50
+~%  %a.50  ~  ~
+|%
+::  Types
+::
++$  ship  @p
++$  life  @ud
++$  rift  @ud
++$  pass  @
++$  bloq  @
++$  step  _`@u`1
++$  bite  $@(bloq [=bloq =step])
++$  octs  [p=@ud q=@]
++$  mold  $~(* $-(* *))
+++  unit  |$  [item]  $@(~ [~ u=item])
+++  list  |$  [item]  $@(~ [i=item t=(list item)])
+++  lest  |$  [item]  [i=item t=(list item)]
+++  tree  |$  [node]  $@(~ [n=node l=(tree node) r=(tree node)])
+++  pair  |$  [head tail]  [p=head q=tail]
+++  map
+  |$  [key value]
+  $|  (tree (pair key value))
+  |=(a=(tree (pair)) ?:(=(~ a) & ~(apt by a)))
+::
+++  set
+  |$  [item]
+  $|  (tree item)
+  |=(a=(tree) ?:(=(~ a) & ~(apt in a)))
+::
+++  jug   |$  [key value]  (map key (set value))
+::
+::  Basic arithmetic
+::
+++  add                                                 ::  unsigned addition
+  ~/  %add
+  |=  [a=@ b=@]
+  ~>  %sham.%add
+  ^-  @
+  ?:  =(0 a)  b
+  $(a (dec a), b +(b))
+::
+++  dec                                                 ::  decrement
+  ~/  %dec
+  |=  a=@
+  ~>  %sham.%dec
+  ~_  leaf+"decrement-underflow"
+  ?<  =(0 a)
+  =+  b=0
+  |-  ^-  @
+  ?:  =(a +(b))  b
+  $(b +(b))
+::
+++  div                                                 ::  divide
+  ~/  %div
+  |:  [a=`@`1 b=`@`1]
+  ~>  %sham.%div
+  ^-  @
+  ~_  leaf+"divide-by-zero"
+  ?<  =(0 b)
+  =+  c=0
+  |-
+  ?:  (lth a b)  c
+  $(a (sub a b), c +(c))
+::
+++  dvr                                                 ::  divide w/remainder
+  ~/  %dvr
+  |:  [a=`@`1 b=`@`1]
+  ~>  %sham.%dvr
+  ^-  [p=@ q=@]
+  [(div a b) (mod a b)]
+::
+++  gte                                                 ::  greater or equal
+  ~/  %gte
+  |=  [a=@ b=@]
+  ~>  %sham.%gte
+  ^-  ?
+  !(lth a b)
+::
+++  gth                                                 ::  greater
+  ~/  %gth
+  |=  [a=@ b=@]
+  ~>  %sham.%gth
+  ^-  ?
+  !(lte a b)
+::
+++  lte                                                 ::  less or equal
+  ~/  %lte
+  |=  [a=@ b=@]
+  ~>  %sham.%lte
+  |(=(a b) (lth a b))
+::
+++  lth                                                 ::  less
+  ~/  %lth
+  |=  [a=@ b=@]
+  ~>  %sham.%lth
+  ^-  ?
+  ?&  !=(a b)
+      |-
+      ?|  =(0 a)
+          ?&  !=(0 b)
+              $(a (dec a), b (dec b))
+  ==  ==  ==
+::
+++  mod                                                 ::  modulus
+  ~/  %mod
+  |:  [a=`@`1 b=`@`1]
+  ~>  %sham.%mod
+  ^-  @
+  ?<  =(0 b)
+  (sub a (mul b (div a b)))
+::
+++  mul                                                 ::  multiply
+  ~/  %mul
+  |:  [a=`@`1 b=`@`1]
+  ~>  %sham.%mul
+  ^-  @
+  =+  c=0
+  |-
+  ?:  =(0 a)  c
+  $(a (dec a), c (add b c))
+::
+++  sub                                                 ::  subtract
+  ~/  %sub
+  |=  [a=@ b=@]
+  ~>  %sham.%sub
+  ~_  leaf+"subtract-underflow"
+  ::  difference
+  ^-  @
+  ?:  =(0 b)  a
+  $(a (dec a), b (dec b))
+::
+::  List logic
+::
+++  flop                                                ::  reverse
+  ~/  %flop
+  |*  a=(list)
+  ~>  %sham.%flop
+  =>  .(a (homo a))
+  ^+  a
+  =+  b=`_a`~
+  |-
+  ?~  a  b
+  $(a t.a, b [i.a b])
+::
+++  lent                                                ::  length
+  ~/  %lent
+  |=  a=(list)
+  ~>  %sham.%lent
+  ^-  @
+  =+  b=0
+  |-
+  ?~  a  b
+  $(a t.a, b +(b))
+::
+++  reap                                                ::  replicate
+  ~/  %reap
+  |*  [a=@ b=*]
+  ~>  %sham.%reap
+  |-  ^-  (list _b)
+  ?~  a  ~
+  [b $(a (dec a))]
+::
+++  slag                                                ::  suffix
+  ~/  %slag
+  |*  [a=@ b=(list)]
+  ~>  %sham.%slag
+  |-  ^+  b
+  ?:  =(0 a)  b
+  ?~  b  ~
+  $(b t.b, a (dec a))
+::
+++  snag                                                ::  index
+  ~/  %snag
+  |*  [a=@ b=(list)]
+  ~>  %sham.%snag
+  |-  ^+  ?>(?=(^ b) i.b)
+  ?~  b
+    ~_  leaf+"snag-fail"
+    !!
+  ?:  =(0 a)  i.b
+  $(b t.b, a (dec a))
+::
+++  welp                                                ::  concatenate
+  ~/  %welp
+  =|  [* *]
+  ~>  %sham.%welp
+  |@
+  ++  $
+    ?~  +<-
+      +<-(. +<+)
+    +<-(+ $(+<- +<->))
+  --
+::
+::  Bit arithmetic
+::
+++  bex                                                 ::  binary exponent
+  ~/  %bex
+  |=  a=bloq
+  ~>  %sham.%bex
+  ^-  @
+  ?:  =(0 a)  1
+  (mul 2 $(a (dec a)))
+++  can                                                 ::  assemble
+  ~/  %can
+  |=  [a=bloq b=(list [p=step q=@])]
+  ~>  %sham.%can
+  ^-  @
+  ?~  b  0
+  (add (end [a p.i.b] q.i.b) (lsh [a p.i.b] $(b t.b)))
+::
+++  cat                                                 ::  concatenate
+  ~/  %cat
+  |=  [a=bloq b=@ c=@]
+  ~>  %sham.%cat
+  (add (lsh [a (met a b)] c) b)
+::
+++  cut                                                 ::  slice
+  ~/  %cut
+  |=  [a=bloq [b=step c=step] d=@]
+  ~>  %sham.%cut
+  (end [a c] (rsh [a b] d))
+::
+++  end                                                 ::  tail
+  ~/  %end
+  |=  [a=bite b=@]
+  ~>  %sham.%end
+  =/  [=bloq =step]  ?^(a a [a *step])
+  (mod b (bex (mul (bex bloq) step)))
+::
+++  lsh                                                 ::  left-shift
+  ~/  %lsh
+  |=  [a=bite b=@]
+  ~>  %sham.%lsh
+  =/  [=bloq =step]  ?^(a a [a *step])
+  (mul b (bex (mul (bex bloq) step)))
+::
+++  met                                                 ::  measure
+  ~/  %met
+  |=  [a=bloq b=@]
+  ~>  %sham.%met
+  ^-  @
+  =+  c=0
+  |-
+  ?:  =(0 b)  c
+  $(b (rsh a b), c +(c))
+::
+++  rep                                                 ::  assemble fixed
+  ~/  %rep
+  |=  [a=bite b=(list @)]
+  ~>  %sham.%rep
+  =/  [=bloq =step]  ?^(a a [a *step])
+  =|  i=@ud
+  |-  ^-  @
+  ?~  b   0
+  %+  add  $(i +(i), b t.b)
+  (lsh [bloq (mul step i)] (end [bloq step] i.b))
+::
+++  rip                                                 ::  disassemble
+  ~/  %rip
+  |=  [a=bite b=@]
+  ~>  %sham.%rip
+  ^-  (list @)
+  ?:  =(0 b)  ~
+  [(end a b) $(b (rsh a b))]
+::
+++  rsh                                                 ::  right-shift
+  ~/  %rsh
+  |=  [a=bite b=@]
+  ~>  %sham.%rsh
+  =/  [=bloq =step]  ?^(a a [a *step])
+  (div b (bex (mul (bex bloq) step)))
+::
+++  swp                                                 ::  naive rev bloq order
+  ~/  %swp
+  |=  [a=bloq b=@]
+  ~>  %sham.%swp
+  (rep a (flop (rip a b)))
+::
+::  Modular arithmetic
+::
+++  fe                                                  ::  modulo bloq
+  |_  a=bloq
+  ++  rol  |=  [b=bloq c=@ d=@]  ^-  @                  ::  roll left
+           =+  e=(sit d)
+           =+  f=(bex (sub a b))
+           =+  g=(mod c f)
+           (sit (con (lsh [b g] e) (rsh [b (sub f g)] e)))
+  ++  sum  |=([b=@ c=@] (sit (add b c)))                ::  wrapping add
+  ++  sit  |=(b=@ (end a b))                            ::  enforce modulo
+  --
+::
+::  Bit logic
+::
+++  con                                                 ::  binary or
+  ~/  %con
+  |=  [a=@ b=@]
+  ~>  %sham.%con
+  =+  [c=0 d=0]
+  |-  ^-  @
+  ?:  ?&(=(0 a) =(0 b))  d
+  %=  $
+    a   (rsh 0 a)
+    b   (rsh 0 b)
+    c   +(c)
+    d   %+  add  d
+          %+  lsh  [0 c]
+          ?&  =(0 (end 0 a))
+              =(0 (end 0 b))
+          ==
+  ==
+::
+++  dis                                                 ::  binary and
+  ~/  %dis
+  |=  [a=@ b=@]
+  ~>  %sham.%dis
+  =|  [c=@ d=@]
+  |-  ^-  @
+  ?:  ?|(=(0 a) =(0 b))  d
+  %=  $
+    a   (rsh 0 a)
+    b   (rsh 0 b)
+    c   +(c)
+    d   %+  add  d
+          %+  lsh  [0 c]
+          ?|  =(0 (end 0 a))
+              =(0 (end 0 b))
+          ==
+  ==
+::
+++  mix                                                 ::  binary xor
+  ~/  %mix
+  |=  [a=@ b=@]
+  ~>  %sham.%mix
+  ^-  @
+  =+  [c=0 d=0]
+  |-
+  ?:  ?&(=(0 a) =(0 b))  d
+  %=  $
+    a   (rsh 0 a)
+    b   (rsh 0 b)
+    c   +(c)
+    d   (add d (lsh [0 c] =((end 0 a) (end 0 b))))
+  ==
+::
+::  Hashes
+::
+++  mug                                                 ::  mug with murmur3
+  ~/  %mug
+  |=  a=*
+  ~>  %sham.%mug
+  |^  ?@  a  (mum 0xcafe.babe 0x7fff a)
+      =/  b  (cat 5 $(a -.a) $(a +.a))
+      (mum 0xdead.beef 0xfffe b)
+  ::
+  ++  mum
+    |=  [syd=@uxF fal=@F key=@]
+    =/  wyd  (met 3 key)
+    =|  i=@ud
+    |-  ^-  @F
+    ?:  =(8 i)  fal
+    =/  haz=@F  (muk syd wyd key)
+    =/  ham=@F  (mix (rsh [0 31] haz) (end [0 31] haz))
+    ?.(=(0 ham) ham $(i +(i), syd +(syd)))
+  --
+::
+++  muk                                                 ::  standard murmur3
+  ~%  %muk  ..muk  ~
+  =+  ~(. fe 5)
+  |=  [syd=@ len=@ key=@]
+  =.  syd      (end 5 syd)
+  =/  pad      (sub len (met 3 key))
+  =/  data     (welp (rip 3 key) (reap pad 0))
+  =/  nblocks  (div len 4)  ::  intentionally off-by-one
+  =/  h1  syd
+  =+  [c1=0xcc9e.2d51 c2=0x1b87.3593]
+  =/  blocks  (rip 5 key)
+  =/  i  nblocks
+  =.  h1  =/  hi  h1  |-
+    ?:  =(0 i)  hi
+    =/  k1  (snag (sub nblocks i) blocks)  ::  negative array index
+    =.  k1  (sit (mul k1 c1))
+    =.  k1  (rol 0 15 k1)
+    =.  k1  (sit (mul k1 c2))
+    =.  hi  (mix hi k1)
+    =.  hi  (rol 0 13 hi)
+    =.  hi  (sum (sit (mul hi 5)) 0xe654.6b64)
+    $(i (dec i))
+  =/  tail  (slag (mul 4 nblocks) data)
+  =/  k1    0
+  =/  tlen  (dis len 3)
+  =.  h1
+    ?+  tlen  h1  ::  fallthrough switch
+      %3  =.  k1  (mix k1 (lsh [0 16] (snag 2 tail)))
+          =.  k1  (mix k1 (lsh [0 8] (snag 1 tail)))
+          =.  k1  (mix k1 (snag 0 tail))
+          =.  k1  (sit (mul k1 c1))
+          =.  k1  (rol 0 15 k1)
+          =.  k1  (sit (mul k1 c2))
+          (mix h1 k1)
+      %2  =.  k1  (mix k1 (lsh [0 8] (snag 1 tail)))
+          =.  k1  (mix k1 (snag 0 tail))
+          =.  k1  (sit (mul k1 c1))
+          =.  k1  (rol 0 15 k1)
+          =.  k1  (sit (mul k1 c2))
+          (mix h1 k1)
+      %1  =.  k1  (mix k1 (snag 0 tail))
+          =.  k1  (sit (mul k1 c1))
+          =.  k1  (rol 0 15 k1)
+          =.  k1  (sit (mul k1 c2))
+          (mix h1 k1)
+    ==
+  =.  h1  (mix h1 len)
+  |^  (fmix32 h1)
+  ++  fmix32
+    |=  h=@
+    =.  h  (mix h (rsh [0 16] h))
+    =.  h  (sit (mul h 0x85eb.ca6b))
+    =.  h  (mix h (rsh [0 13] h))
+    =.  h  (sit (mul h 0xc2b2.ae35))
+    =.  h  (mix h (rsh [0 16] h))
+    h
+  --
+::
+::  Noun Ordering
+::
+++  dor                                                 ::  tree order
+  ~/  %dor
+  |=  [a=* b=*]
+  ~>  %sham.%dor
+  ^-  ?
+  ?:  =(a b)  &
+  ?.  ?=(@ a)
+    ?:  ?=(@ b)  |
+    ?:  =(-.a -.b)
+      $(a +.a, b +.b)
+    $(a -.a, b -.b)
+  ?.  ?=(@ b)  &
+  (lth a b)
+::
+++  gor                                                 ::  mug order
+  ~/  %gor
+  |=  [a=* b=*]
+  ~>  %sham.%gor
+  ^-  ?
+  =+  [c=(mug a) d=(mug b)]
+  ?:  =(c d)
+    (dor a b)
+  (lth c d)
+::
+++  mor                                                 ::  more mug order
+  ~/  %mor
+  |=  [a=* b=*]
+  ~>  %sham.%mor
+  ^-  ?
+  =+  [c=(mug (mug a)) d=(mug (mug b))]
+  ?:  =(c d)
+    (dor a b)
+  (lth c d)
+::
+::  Set logic
+::
+++  in
+  ~/  %in
+  =|  a=(tree)  :: (set)
+  ~>  %sham.%in
+  |@
+  ++  apt
+    =<  $
+    ~/  %apt
+    =|  [l=(unit) r=(unit)]
+    ~>  %sham.%apt
+    |.  ^-  ?
+    ?~  a   &
+    ?&  ?~(l & (gor n.a u.l))
+        ?~(r & (gor u.r n.a))
+        ?~(l.a & ?&((mor n.a n.l.a) $(a l.a, l `n.a)))
+        ?~(r.a & ?&((mor n.a n.r.a) $(a r.a, r `n.a)))
+    ==
+  ::
+  ++  del
+    ~/  %del
+    |*  b=*
+    ~>  %sham.%del
+    |-  ^+  a
+    ?~  a
+      ~
+    ?.  =(b n.a)
+      ?:  (gor b n.a)
+        a(l $(a l.a))
+      a(r $(a r.a))
+    |-  ^-  [$?(~ _a)]
+    ?~  l.a  r.a
+    ?~  r.a  l.a
+    ?:  (mor n.l.a n.r.a)
+      l.a(r $(l.a r.l.a))
+    r.a(l $(r.a l.r.a))
+  ::
+  ++  put
+    ~/  %put
+    |*  b=*
+    ~>  %sham.%put
+    |-  ^+  a
+    ?~  a
+      [b ~ ~]
+    ?:  =(b n.a)
+      a
+    ?:  (gor b n.a)
+      =+  c=$(a l.a)
+      ?>  ?=(^ c)
+      ?:  (mor n.a n.c)
+        a(l c)
+      c(r a(l r.c))
+    =+  c=$(a r.a)
+    ?>  ?=(^ c)
+    ?:  (mor n.a n.c)
+      a(r c)
+    c(l a(r l.c))
+  --
+::
+::  Map logic
+::
+++  by
+  ~/  %by
+  =|  a=(tree (pair))  ::  (map)
+  ~>  %sham.%by
+  =*  node  ?>(?=(^ a) n.a)
+  |@
+  ++  del
+    ~/  %del
+    |*  b=*
+    ~>  %sham.%del
+    |-  ^+  a
+    ?~  a
+      ~
+    ?.  =(b p.n.a)
+      ?:  (gor b p.n.a)
+        a(l $(a l.a))
+      a(r $(a r.a))
+    |-  ^-  [$?(~ _a)]
+    ?~  l.a  r.a
+    ?~  r.a  l.a
+    ?:  (mor p.n.l.a p.n.r.a)
+      l.a(r $(l.a r.l.a))
+    r.a(l $(r.a l.r.a))
+  ::
+  ++  apt
+    =<  $
+    ~/  %apt
+    =|  [l=(unit) r=(unit)]
+    ~>  %sham.%apt
+    |.  ^-  ?
+    ?~  a   &
+    ?&  ?~(l & &((gor p.n.a u.l) !=(p.n.a u.l)))
+        ?~(r & &((gor u.r p.n.a) !=(u.r p.n.a)))
+        ?~  l.a   &
+        &((mor p.n.a p.n.l.a) !=(p.n.a p.n.l.a) $(a l.a, l `p.n.a))
+        ?~  r.a   &
+        &((mor p.n.a p.n.r.a) !=(p.n.a p.n.r.a) $(a r.a, r `p.n.a))
+    ==
+  ::
+  ++  get
+    ~/  %get
+    |*  b=*
+    ~>  %sham.%get
+    =>  .(b `_?>(?=(^ a) p.n.a)`b)
+    |-  ^-  (unit _?>(?=(^ a) q.n.a))
+    ?~  a
+      ~
+    ?:  =(b p.n.a)
+      `q.n.a
+    ?:  (gor b p.n.a)
+      $(a l.a)
+    $(a r.a)
+  ::
+  ++  put
+    ~/  %put
+    |*  [b=* c=*]
+    ~>  %sham.%put
+    |-  ^+  a
+    ?~  a
+      [[b c] ~ ~]
+    ?:  =(b p.n.a)
+      ?:  =(c q.n.a)
+        a
+      a(n [b c])
+    ?:  (gor b p.n.a)
+      =+  d=$(a l.a)
+      ?>  ?=(^ d)
+      ?:  (mor p.n.a p.n.d)
+        a(l d)
+      d(r a(l r.d))
+    =+  d=$(a r.a)
+    ?>  ?=(^ d)
+    ?:  (mor p.n.a p.n.d)
+      a(r d)
+    d(l a(r l.d))
+  --
+::
+::  Jug logic
+::
+++  ju
+  =|  a=(tree (pair * (tree)))  ::  (jug)
+  |@
+  ++  del
+    |*  [b=* c=*]
+    ^+  a
+    =+  d=(get b)
+    =+  e=(~(del in d) c)
+    ?~  e
+      (~(del by a) b)
+    (~(put by a) b e)
+  ::
+  ++  get
+    |*  b=*
+    =+  c=(~(get by a) b)
+    ?~(c ~ u.c)
+  ::
+  ++  put
+    |*  [b=* c=*]
+    ^+  a
+    =+  d=(get b)
+    (~(put by a) b (~(put in d) c))
+  --
+--

hoon/scaffolding/toddler.hoon

@@ -0,0 +1,51 @@
+::  A working pill that grows towards arvo.hoon. Requires playpen.hoon from this
+::  scaffolding directory.
+::
+/+  cradle
+!.
+=/  core
+  =>  cradle
+  !=
+  =>
+  |%
+  +$  card  (cask)
+  ++  cask  |$  [a]  (pair mark a)
+  +$  knot  @ta
+  ++  list  |$  [item]  $@(~ [i=item t=(list item)])
+  +$  mark  @tas
+  +$  ovum  [=wire =card]
+  ++  pair  |$  [head tail]  [p=head q=tail]
+  +$  path  (list knot)
+  +$  wire  path
+  --  =>
+  ::
+  |%
+  ++  load  !!
+  ++  peek  _~
+  ++  wish  !!
+  ++  poke
+    |=  [now=@da ovo=ovum]
+    ^-  ^
+    :: ~>  %slog.[0 'got']
+    :: ~>  %slog.[0 -.card.ovo]
+    =/  fec  [//term/1 %blit [%put "effect"] [%nel ~] ~]
+    [[fec ~] ..poke]
+  --
+  ::
+  |=  [now=@da ovo=ovum]
+  ^-  *
+  .(+> +:(poke now ovo))
+::
+|%
+++  aeon
+  ^-  *
+  =>  *[arvo=* epic=*]
+  !=
+  |-  ^-  *
+  ?@  epic  arvo
+  %=  $
+    epic  +.epic
+    arvo  .*([arvo -.epic] [%9 2 %10 [6 %0 3] %0 2])
+  ==
+--
+[%pill %baby [aeon .*(cradle core) ~] ~ ~]