datatype Dir = L | R

datatype Gamma = TS | BLK | A | B | M

datatype State = S | REJ of string | ACC | Q | F
               | SM | MA | FA | MB | FB

fun trans S TS = SOME (S,TS,R) (* move to the right *)
  | trans S A = SOME (S,A,R)
  | trans S B = SOME (S,B,R)
  | trans S M = SOME (SM,M,R)
  | trans S BLK = SOME (REJ "no mark",BLK,L)
  | trans SM A = SOME (SM,A,R)
  | trans SM B = SOME (SM,B,R)
  | trans SM M = SOME (REJ "too many marks",M,L)
  | trans SM BLK = SOME (Q,BLK,L)
  | trans Q M = SOME (Q,M,L)
  | trans Q A = SOME (Q,A,L)
  | trans Q B = SOME (Q,B,L)
  | trans Q TS = SOME (F,TS,R)
  | trans F M = SOME (F,M,R)
  | trans F BLK = SOME (ACC,BLK,L)
  | trans F A = SOME (FA,M,R)
  | trans F B = SOME (FB,M,R)
  | trans FA A = SOME (FA,A,R)
  | trans FA B = SOME (FA,B,R)
  | trans FA M = SOME (MA,M,R)
  | trans FA BLK = SOME (REJ "mark not centered",BLK,L)
  | trans MA M = SOME (MA,M,R)
  | trans MA BLK = SOME (REJ "mark not centered",BLK,L)
  | trans MA A = SOME (Q,M,L)
  | trans MA B = SOME (REJ "mismatch",B,L)
  | trans FB A = SOME (FB,A,R)
  | trans FB B = SOME (FB,B,R)
  | trans FB M = SOME (MB,M,R)
  | trans FB BLK = SOME (REJ "mark not centered",BLK,L)
  | trans MB M = SOME (MB,M,R)
  | trans MB BLK = SOME (REJ "mark not centered",BLK,L)
  | trans MB A = SOME (REJ "mismatch",A,L)
  | trans MB B = SOME (Q,M,L)
  | trans _ _ = NONE

exception Error

fun run ls ACC rs = (ls,ACC,rs)
  | run ls (REJ e) rs = (ls,(REJ e),rs)
  | run ls q nil = run ls q [BLK]
  | run ls q (r :: rs) = case (trans q r)
                         of SOME (t,a,R) => run (a::ls) t rs
                          | SOME (t,a,L) => (case ls
                                             of (m::ms) => run ms t (m :: a :: rs)
                                              | nil => raise Error)
                          | NONE => (ls,q,(r::rs))

fun exec input = case (run nil S (TS::input))
                 of (ls, ACC, rs) => "input accepted"
                  | (ls, REJ e, rs) => "input rejected: "^e
                  | _ => "machine stuck on input"

val test0 = exec [M]
val test1 = exec [A,B,B,A,M,A,B,B,A]
val test2 = exec [A,B,M,B,A]
val test3 = exec [A,B,A]
val test4 = exec [A,B,M,A]
val test5 = exec [A,B,M,A,M]