#lang racket

;State table entry has form
; (symbol state next-symbol next-state dir)

(define @ vector-ref)

(define blank 'b)

(define (find-entry table sym state)
  (define result #f)
  (for ((entry table))
    (when (and (eq? sym (@ entry 0))
               (eq? state (@ entry 1)))
      (set! result entry)))
  (when (not result)
    (printf "[Error: entry not found: ~s]" (list sym state)))
  result)

(define (run-tm state-table
                start-state
                stop-states
                init-tape
                init-tape-index)
  (let ((state start-state)
        (tape init-tape)
        (index init-tape-index))
    (define (iterate)
      (if (member state stop-states)
          (list state
                (vector-filter (lambda (x) (not (eq? x blank))) (vector-drop tape index))
                index)
          (let* ((sym (@ tape index))
                 (entry (find-entry state-table sym state))
                 (next-symbol (@ entry 2))
                 (next-state (@ entry 3))
                 (dir (@ entry 4)))
            (when (not (eq? next-symbol blank))
              (vector-set! tape index next-symbol))
            (set! state next-state)
            (when (eq? dir 'l)
              (set! index (- index 1)))
            (when (eq? dir 'r)
              (set! index (+ index 1)))
            (when (>= index (vector-length tape))
              (set! tape
                    (vector-append tape (make-vector (vector-length tape) blank))))
            (when (< index 0)
              (let ((len (vector-length tape)))
                (set! tape
                      (vector-append (make-vector len blank) tape))
                (set! index (+ index len))))
            (iterate))))
    (iterate)))

;Program for Turing Machine to add 1 to binary number
;alphabet = '(0 1)
;states = (1 2 3 4 'STOP)
;start-state = 1
;stop-states = 'STOP

(define table-plus1
  #(#(1 1 1 1 r)
    #(0 1 0 1 r)
    #(b 1 b 2 l)
    #(1 2 0 2 l)
    #(0 2 1 3 l)
    #(b 2 1 stop n)
    #(0 3 0 3 l)
    #(1 3 1 3 l)
    #(b 3 b stop r)))

;Run Turing Machine with adder program
(run-tm table-plus1
        1
        '(stop)
        (vector 1 0 1 1 1 0 1 1)
        0)