1 files changed, 81 insertions, 0 deletions
diff --git a/TuringMachines.icl b/TuringMachines.icl
new file mode 100644
index 0000000..b37233c
--- /dev/null
+++ b/TuringMachines.icl
@@ -0,0 +1,81 @@
+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 running +++ " turing machine in state " +++ toString state +++ ", tape head at " +++ toString tapeHead +++ ".\nTape: " +++ toString tape
+
+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
+        # 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
+