Time for an 2014 update…

Task/Universal-Turing-machine/Haskell/universal-turing-machine-1.hs

@@ -0,0 +1,28 @@
+-- Some elementary types for Turing Machine
+data Move = MLeft | MRight | Stay deriving (Show, Eq)
+data Tape a = Tape a [a] [a]
+data Action state val = Action val Move state deriving (Show)
+
+instance (Show a) => Show (Tape a) where
+  show (Tape x lts rts) = concat $ left ++ [hd] ++ right
+                          where hd = "[" ++ show x ++ "]"
+                                left = map show $ reverse $ take 10 lts
+                                right = map show $ take 10 rts
+
+-- new tape
+tape blank lts rts | null rts = Tape blank left blanks
+                   | otherwise = Tape (head rts) left right
+                   where blanks = repeat blank
+                         left = reverse lts ++ blanks
+                         right = tail rts ++ blanks
+
+-- Turing Machine
+step rules (state, Tape x (lh:lts) (rh:rts)) = (state', tape')
+     where  Action x' dir state' = rules state x
+            tape' = move dir
+            move Stay = Tape x' (lh:lts) (rh:rts)
+            move MLeft = Tape lh lts (x':rh:rts)
+            move MRight = Tape rh (x':lh:lts) rts
+
+runUTM rules stop start tape = steps ++ [final]
+      where (steps, final:_) = break ((== stop) . fst) $ iterate (step rules) (start, tape)

Task/Universal-Turing-machine/Haskell/universal-turing-machine-2.hs

@@ -0,0 +1,5 @@
+incr "q0" 1 = Action 1 MRight "q0"
+incr "q0" 0 = Action 1 Stay "qf"
+
+tape1 = tape 0 [] [1,1, 1]
+machine1 = runUTM incr "qf" "q0" tape1

Task/Universal-Turing-machine/Haskell/universal-turing-machine-3.hs

@@ -0,0 +1,6 @@
+*Main> mapM_ print machine1
+("q0",0000000000[1]1100000000)
+("q0",0000000001[1]1000000000)
+("q0",0000000011[1]0000000000)
+("q0",0000000111[0]0000000000)
+("qf",0000000111[1]0000000000)

Task/Universal-Turing-machine/Haskell/universal-turing-machine-4.hs

@@ -0,0 +1,9 @@
+beaver "a" 0 = Action 1 MRight "b"
+beaver "a" 1 = Action 1 MLeft  "c"
+beaver "b" 0 = Action 1 MLeft  "a"
+beaver "b" 1 = Action 1 MRight "b"
+beaver "c" 0 = Action 1 MLeft  "b"
+beaver "c" 1 = Action 1 Stay   "halt"
+
+tape2 = tape 0 [] []
+machine2 = runUTM beaver "halt" "a" tape2

Task/Universal-Turing-machine/Haskell/universal-turing-machine-5.hs

@@ -0,0 +1,17 @@
+sorting "A" 1 = Action 1 MRight "A"
+sorting "A" 2 = Action 3 MRight "B"
+sorting "A" 0 = Action 0 MLeft  "E"
+sorting "B" 1 = Action 1 MRight "B"
+sorting "B" 2 = Action 2 MRight "B"
+sorting "B" 0 = Action 0 MLeft  "C"
+sorting "C" 1 = Action 2 MLeft  "D"
+sorting "C" 2 = Action 2 MLeft  "C"
+sorting "C" 3 = Action 2 MLeft  "E"
+sorting "D" 1 = Action 1 MLeft  "D"
+sorting "D" 2 = Action 2 MLeft  "D"
+sorting "D" 3 = Action 1 MRight "A"
+sorting "E" 1 = Action 1 MLeft  "E"
+sorting "E" 0 = Action 0 MRight "STOP"
+
+tape3 = tape 0 [] [2,2,2,1,2,2,1,2,1,2,1,2,1,2]
+machine3 = runUTM sorting "STOP" "A" tape3