[ this ]                    is halt     ( --> halt )
  [ stack ]                   is state    ( --> s )
  [ stack ]                   is machine  ( --> s )

  [ state share echo say ": "
    split
    swap witheach [ echo sp ]
    behead nested echo sp
    witheach [ echo sp ] cr ] is echotape ( tape head --> )

  [ over dip [ unrot poke ] ] is write    ( tape head value --> tape head )

  [ write
    dup 0 = iff
      [ dip [ 0 swap join ] ]
    else [ 1 - ] ]            is left     ( tape head value --> tape head )

  [ write
    1+
    over size over = if
      [ dip [ 0 join ] ] ]    is right    ( tape head value --> tape head )

  [ write ]                   is stay     ( tape head value --> tape head )

  [ 0 state put
    rot machine put
    [ 2dup echotape
      2dup peek
      machine share
      state share peek
      swap peek do
      state replace
      state share
      halt = until ]
    echotape
    state release
    machine release ]         is turing   ( machine tape head --> )

  say "Simple Incrementer"
  cr cr
  ' [ [ [ 1 stay halt ] [ 1 right 0 ] ] ]
  ' [ 1 1 1 ] 0
  turing
  cr cr
  say "Three-state Busy Beaver"
  cr cr
  ' [ [ [ 1 right 1 ] [ 1 left  2    ] ]
      [ [ 1 left  0 ] [ 1 right 1    ] ]
      [ [ 1 left  1 ] [ 1 stay  halt ] ] ]
  ' [ 0 ] 0
  turing