Section 33 Want more of a challenge? View in iconic form (experimental)

---

       # 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 (= (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] (= (extract-tape /
            turing
             (tm-binary-increment)
             right
             halt
             (make-tape /
              vector 1 0 0 1))
           (vector 1 0 1 0));

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

[hear] (= (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));