---

       # TURING introduce turing machine model
       # just for fun!
[hear] (define safe-tail /
         ? x /
         if (> (list-length / x) 0)
          (if (> (list-length / x) 1)
            (tail /
             x)
            (vector /
             vector))
          (vector /
           vector));

[hear] (define safe-head /
         ? x /
         if (> (list-length / x) 0)
          (head /
           x)
          (vector));

[hear] (define tape-read /
         ? tape /
         let ((x (second / tape)))
          (if (> (list-length / x) 0)
            (head /
             x)
            (vector)));

[hear] (define tape-transition /
         lambda (tape shift value)
          (if (= (shift) 1)
            (pair (prepend (value) (first / tape))
                  (safe-tail /
                   second /
                   tape))
            (if (= (shift) 0)
              (pair (safe-tail /
                     first /
                     tape)
                    (prepend
                      (safe-head /
                       first /
                       tape)
                      (prepend (value) (safe-tail / second / tape))))
              (pair (first /
                     tape)
                    (prepend (value) (safe-tail / second / tape))))));

[hear] (define turing /
         lambda (machine current last tape)
          (if (= (current) (last))
            (tape)
            (let ((next (machine (current) (tape-read / tape))))
              (turing
                (machine)
                (list-ref (next) 0)
                (last)
                (tape-transition
                  (tape)
                  (list-ref (next) 1)
                  (list-ref (next) 2))))));

[hear] (define make-tape /
         ? x /
         pair (vector) (x));

[hear] (define remove-trail /
         ? x /
         ? lst /
         if (> (list-length / lst) 0)
          (if (equal (last / lst) (x))
            (remove-trail (x) (except-last / lst))
            (lst))
          (lst));

[hear] (define extract-tape /
         ? x /
         remove-trail (vector) (second / x));

[hear] (define tm-binary-increment /
         make-hash /
         vector
          (pair right
                (make-hash /
                 vector
                  (pair 0 (vector right 1 0))
                  (pair 1 (vector right 1 1))
                  (pair (vector) (vector inc 0 (vector)))))
          (pair inc
                (make-hash /
                 vector
                  (pair 0 (vector noinc 0 1))
                  (pair 1 (vector inc 0 0))
                  (pair (vector) (vector halt 2 1))))
          (pair noinc
                (make-hash /
                 vector
                  (pair 0 (vector noinc 0 0))
                  (pair 1 (vector noinc 0 1))
                  (pair (vector) (vector halt 1 (vector)))))
          (pair halt (make-hash / vector)));

[hear] (list= (extract-tape /
                turing
                 (tm-binary-increment)
                 right
                 halt
                 (make-tape /
                  vector 1 0 0 1))
               (vector 1 0 1 0));

[hear] (list= (extract-tape /
                turing
                 (tm-binary-increment)
                 right
                 halt
                 (make-tape /
                  vector 1 1 1))
               (vector 1 0 0 0));

[hear] (list= (extract-tape /
                turing
                 (tm-binary-increment)
                 right
                 halt
                 (make-tape /
                  vector 1 1 1 0 0 0 1 1 1))
               (vector 1 1 1 0 0 1 0 0 0));