implementation module TuringMachines

import StdEnv
import StdMaybe
import IterableClass

instance toString Direction
where
    toString Left = "Left"
    toString Right = "Right"

instance toString (TuringMachineMove a) | toString a
where
    toString Halt = "Halt"
    toString (Step i Nothing dir) = "Step in q" +++ toString i +++ "; write B; move " +++ toString dir
    toString (Step i (Just a) dir) = "Step in q" +++ toString i +++ "; write " +++ toString a +++ "; move " +++ toString dir

instance toString TuringMachineTermination
where
    toString Running = "Running"
    toString Normal = "Normally terminated"
    toString Abnormal = "Abnormally terminated"

instance toString (Tape a) | toString a
where
    toString [] = ""
    toString [Nothing:tape] = "B" +++ toString tape
    toString [Just a:tape] = toString a +++ toString tape

instance toString (TuringMachineState a) | toString a
where
    toString st=:{state,tapeHead,tape,running}
    = toString (take tapeHead tape) +++
        "[q" +++ toString state +++ "]" +++
        toString (drop tapeHead tape) +++
        " (" +++ toString running +++ ")"

instance == Direction
where
    (==) Left Left = True
    (==) Right Right = True
    (==) _ _ = False

instance == (TuringMachineMove a) | == a
where
    (==) Halt Halt = True
    (==) (Step i a dir) (Step i2 a2 dir2) = i == i2 && a == a2 && dir == dir2
    (==) _ _ = False

instance == TuringMachineTermination
where
    (==) Running Running = True
    (==) Normal Normal = True
    (==) Abnormal Abnormal = True
    (==) _ _ = False

instance step (TuringMachineState a) | == a
where
    step st=:{machine,state,tapeHead,tape,running}
        | running <> Running    = st
        # tape                  = if (length tape < tapeHead + 1) (tape ++ [Nothing]) tape
        # move                  = machine.transition state (tape!!tapeHead)
        | move == Halt          = {st & running = Normal}
        # (Step state write dir) = move
        # tape                  = updateAt tapeHead write tape
        # tapeHead              = if (dir == Left) (-) (+) tapeHead 1
        | tapeHead < 0          = {st & running = Abnormal}
        = {st & state=state, tapeHead=tapeHead, tape=tape}
       

initTuringMachine :: (TuringMachine a) (Tape a) -> TuringMachineState a | Eq a
initTuringMachine def tape 
| invalid tape  = abort "Invalid symbols on input"
| otherwise     = {machine=def, state=0, tapeHead=0, tape=[Nothing:tape]++[Nothing], running=Running}
where
    invalid []              = False
    invalid [Nothing:tape]  = invalid tape
    invalid [Just c:tape]   = not (isMember c def.inputs) || invalid tape

run :: (TuringMachineState a) -> TuringMachineState a | == a
run m
# m                     = step m
| m.running == Running  = run m
| otherwise             = m