module TM2SymTM where import TMType import Data.Set (Set) import qualified Data.Set as Set import Helpers import Text.Regex.TDFA import Data.List (partition) firstPhase :: [State] -> [TapeCommand] -> [[TapeCommand]] -> [State] -> [Set State] -> [State] -> [[TapeCommand]] firstPhase :: [State] -> [TapeCommand] -> [[TapeCommand]] -> [State] -> [Set State] -> [State] -> [[TapeCommand]] firstPhase [State] kplus1tapeStates [TapeCommand] acceptCommand [[TapeCommand]] otherCommands [State] startStates [Set State] multiTapeStates [State] startFirstPhaseStates = do let [State startKPlusOneTapeState, State kplus1tapeState, State finalKPlusOneTapeState] = [State] kplus1tapeStates let generateFirstPhaseCommand :: [TapeCommand] -> [State] -> [TapeCommand] -> [TapeCommand] generateFirstPhaseCommand [TapeCommand] command [State] states [TapeCommand] acc = case [State] states of [] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] reverse ([TapeCommand] -> [TapeCommand]) -> [TapeCommand] -> [TapeCommand] forall a b. (a -> b) -> a -> b $ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square ES, State kplus1tapeState, Square RBS), ([TapeCommand] -> Square BCommand [TapeCommand] command, State kplus1tapeState, Square RBS)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc State s : [State] ss | [TapeCommand] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TapeCommand] acc -> Square -> [TapeCommand] gfpc Square ES | Bool otherwise -> Square -> [TapeCommand] gfpc Square LBS where gfpc :: Square -> [TapeCommand] gfpc Square r = [TapeCommand] -> [State] -> [TapeCommand] -> [TapeCommand] generateFirstPhaseCommand [TapeCommand] command [State] ss ([TapeCommand] -> [TapeCommand]) -> [TapeCommand] -> [TapeCommand] forall a b. (a -> b) -> a -> b $ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square r, State s, Square RBS), (Square r, State s, Square RBS)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc let firstPhaseFinalCommand :: [a] -> [State] -> [State] -> [TapeCommand] -> [TapeCommand] firstPhaseFinalCommand [a] tapeStates [State] states [State] sStates [TapeCommand] acc = case ([a] tapeStates, [State] states, [State] sStates) of ([], [], []) -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] reverse ([TapeCommand] -> [TapeCommand]) -> [TapeCommand] -> [TapeCommand] forall a b. (a -> b) -> a -> b $ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square ES, State kplus1tapeState, Square RBS), (Square ES, State finalKPlusOneTapeState, Square RBS)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc (a _ : [a] tt, State s1 : [State] ss1, State s2 : [State] ss2) | [TapeCommand] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TapeCommand] acc -> Square -> [TapeCommand] fpfc Square ES | Bool otherwise -> Square -> [TapeCommand] fpfc Square LBS where fpfc :: Square -> [TapeCommand] fpfc Square r = [a] -> [State] -> [State] -> [TapeCommand] -> [TapeCommand] firstPhaseFinalCommand [a] tt [State] ss1 [State] ss2 ([TapeCommand] -> [TapeCommand]) -> [TapeCommand] -> [TapeCommand] forall a b. (a -> b) -> a -> b $ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square r, State s1, Square RBS), (Square r, State s2, Square RBS)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc ([a], [State], [State]) _ -> [Char] -> [TapeCommand] forall a. HasCallStack => [Char] -> a error [Char] "States don't match" let firstPhaseStartCommand :: [State] -> [TapeCommand] -> [TapeCommand] firstPhaseStartCommand [State] states [TapeCommand] acc = case [State] states of [] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] reverse ([TapeCommand] -> [TapeCommand]) -> [TapeCommand] -> [TapeCommand] forall a b. (a -> b) -> a -> b $ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square ES, State startKPlusOneTapeState, Square RBS), ([TapeCommand] -> Square BCommand [TapeCommand] acceptCommand, State kplus1tapeState, Square RBS)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc State s : [State] ss | [TapeCommand] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [TapeCommand] acc -> Square -> [TapeCommand] fpsc Square ES | Bool otherwise -> Square -> [TapeCommand] fpsc Square LBS where fpsc :: Square -> [TapeCommand] fpsc Square r = [State] -> [TapeCommand] -> [TapeCommand] firstPhaseStartCommand [State] ss ([TapeCommand] -> [TapeCommand]) -> [TapeCommand] -> [TapeCommand] forall a b. (a -> b) -> a -> b $ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square r, State s, Square RBS), (Square r, State s, Square RBS)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc let firstPhaseInternal :: [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] firstPhaseInternal [[TapeCommand]] commands [[TapeCommand]] acc = case [[TapeCommand]] commands of [] -> [[TapeCommand]] acc [TapeCommand] h : [[TapeCommand]] t -> [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] firstPhaseInternal [[TapeCommand]] t ([[TapeCommand]] -> [[TapeCommand]]) -> [[TapeCommand]] -> [[TapeCommand]] forall a b. (a -> b) -> a -> b $ [TapeCommand] -> [State] -> [TapeCommand] -> [TapeCommand] generateFirstPhaseCommand [TapeCommand] h [State] startFirstPhaseStates [] [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] acc [State] -> [TapeCommand] -> [TapeCommand] firstPhaseStartCommand [State] startFirstPhaseStates [] [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [Set State] -> [State] -> [State] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [State] -> [State] -> [TapeCommand] -> [TapeCommand] firstPhaseFinalCommand [Set State] multiTapeStates [State] startFirstPhaseStates [State] startStates [] [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] firstPhaseInternal [[TapeCommand]] otherCommands [] generateEmptyStayCommands :: [State] -> [TapeCommand] -> [TapeCommand] generateEmptyStayCommands :: [State] -> [TapeCommand] -> [TapeCommand] generateEmptyStayCommands [State] states [TapeCommand] acc = case [State] states of [] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] reverse [TapeCommand] acc State h : [State] t -> [State] -> [TapeCommand] -> [TapeCommand] generateEmptyStayCommands [State] t ([TapeCommand] -> [TapeCommand]) -> [TapeCommand] -> [TapeCommand] forall a b. (a -> b) -> a -> b $ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square LBS, State h, Square RBS), (Square LBS, State h, Square RBS)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc secondPhase :: State -> [[TapeCommand]] -> [State] -> [[TapeCommand]] secondPhase :: State -> [[TapeCommand]] -> [State] -> [[TapeCommand]] secondPhase State finalKPlusOneTapeState [[TapeCommand]] allcommands [State] accessStates = do let addKPlusOneTapeCommands :: [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] addKPlusOneTapeCommands [[TapeCommand]] cmd [[TapeCommand]] acc = case [[TapeCommand]] cmd of [TapeCommand] h : [[TapeCommand]] t -> [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] addKPlusOneTapeCommands [[TapeCommand]] t ([[TapeCommand]] -> [[TapeCommand]]) -> [[TapeCommand]] -> [[TapeCommand]] forall a b. (a -> b) -> a -> b $ ([TapeCommand] h [TapeCommand] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] -> [a] ++ [((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand (([TapeCommand] -> Square BCommand [TapeCommand] h, State finalKPlusOneTapeState, Square ES), (Square ES, State finalKPlusOneTapeState, [TapeCommand] -> Square BCommand [TapeCommand] h))]) [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] acc [] -> [[TapeCommand]] acc let returnToRightEndmarkerCommands :: [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] returnToRightEndmarkerCommands [[TapeCommand]] commands [[TapeCommand]] acc = case [[TapeCommand]] commands of [TapeCommand] h : [[TapeCommand]] t -> [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] returnToRightEndmarkerCommands [[TapeCommand]] t ([[TapeCommand]] -> [[TapeCommand]]) -> [[TapeCommand]] -> [[TapeCommand]] forall a b. (a -> b) -> a -> b $ ([State] -> [TapeCommand] -> [TapeCommand] generateEmptyStayCommands [State] accessStates [] [TapeCommand] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] -> [a] ++ [((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square ES, State finalKPlusOneTapeState, [TapeCommand] -> Square BCommand [TapeCommand] h), ([TapeCommand] -> Square BCommand [TapeCommand] h, State finalKPlusOneTapeState, Square ES))] ) [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] acc [] -> [[TapeCommand]] acc [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] addKPlusOneTapeCommands [[TapeCommand]] allcommands [] [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] forall a. [a] -> [a] -> [a] ++ [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] returnToRightEndmarkerCommands [[TapeCommand]] allcommands [] thirdPhase :: State -> [[TapeCommand]] -> [State] -> [[TapeCommand]] thirdPhase :: State -> [[TapeCommand]] -> [State] -> [[TapeCommand]] thirdPhase State finalKPlusOneTapeState [[TapeCommand]] allcommands [State] accessStates = do let thirdPhaseInternal :: [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] thirdPhaseInternal [[TapeCommand]] commands [[TapeCommand]] acc = case [[TapeCommand]] commands of [TapeCommand] h : [[TapeCommand]] t -> [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] thirdPhaseInternal [[TapeCommand]] t ([[TapeCommand]] -> [[TapeCommand]]) -> [[TapeCommand]] -> [[TapeCommand]] forall a b. (a -> b) -> a -> b $ ([State] -> [TapeCommand] -> [TapeCommand] generateEmptyStayCommands [State] accessStates [] [TapeCommand] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] -> [a] ++ [((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand (([TapeCommand] -> Square BCommand [TapeCommand] h, State finalKPlusOneTapeState, Square RBS), (Square ES, State finalKPlusOneTapeState, Square RBS))] ) [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] acc [] -> [[TapeCommand]] acc [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] thirdPhaseInternal [[TapeCommand]] allcommands [] symCommands :: [[TapeCommand]] -> [[TapeCommand]] symCommands :: [[TapeCommand]] -> [[TapeCommand]] symCommands [[TapeCommand]] allcommands = do let reverseCommands :: [TapeCommand] -> [TapeCommand] -> [TapeCommand] reverseCommands [TapeCommand] commands [TapeCommand] acc = case [TapeCommand] commands of SingleTapeCommand ((Square a, State s, Square b), (Square a1, State s1, Square b1)) : [TapeCommand] t -> [TapeCommand] -> [TapeCommand] -> [TapeCommand] reverseCommands [TapeCommand] t (((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square a1, State s1, Square b1), (Square a, State s, Square b)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc) [] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] reverse [TapeCommand] acc [TapeCommand] _ -> [Char] -> [TapeCommand] forall a. HasCallStack => [Char] -> a error [Char] "Must be SingleTapeCommand" let reverseAllCommands :: [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] reverseAllCommands [[TapeCommand]] commands [[TapeCommand]] acc = case [[TapeCommand]] commands of [TapeCommand] h : [[TapeCommand]] t -> [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] reverseAllCommands [[TapeCommand]] t ([TapeCommand] -> [TapeCommand] -> [TapeCommand] reverseCommands [TapeCommand] h [] [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] acc) [] -> [[TapeCommand]] acc [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] reverseAllCommands [[TapeCommand]] allcommands [[TapeCommand]] allcommands threePhaseProcessing :: TM -> TM threePhaseProcessing :: TM -> TM threePhaseProcessing (TM (InputAlphabet inputAlphabet, [TapeAlphabet] tapeAlphabets, MultiTapeStates [Set State] multiTapeStates, Commands Set [TapeCommand] commands, StartStates [State] startStates, AccessStates [State] accessStates) ) = do let kPlus1 :: Int kPlus1 = Int -> Int -> Int forall a. Num a => a -> a -> a (+) Int 1 (Int -> Int) -> Int -> Int forall a b. (a -> b) -> a -> b $ [Set State] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Set State] multiTapeStates let startKPlusOneTapeState :: State startKPlusOneTapeState = [Char] -> State State ([Char] -> State) -> [Char] -> State forall a b. (a -> b) -> a -> b $ [Char] "q_0^" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ Int -> [Char] forall a. Show a => a -> [Char] show Int kPlus1 let kplus1tapeState :: State kplus1tapeState = [Char] -> State State ([Char] -> State) -> [Char] -> State forall a b. (a -> b) -> a -> b $ [Char] "q_1^" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ Int -> [Char] forall a. Show a => a -> [Char] show Int kPlus1 let finalKPlusOneTapeState :: State finalKPlusOneTapeState = [Char] -> State State ([Char] -> State) -> [Char] -> State forall a b. (a -> b) -> a -> b $ [Char] "q_2^" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ Int -> [Char] forall a. Show a => a -> [Char] show Int kPlus1 let acceptKPlusOneTapeState :: State acceptKPlusOneTapeState = [Char] -> State State ([Char] -> State) -> [Char] -> State forall a b. (a -> b) -> a -> b $ [Char] "q_3^" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ Int -> [Char] forall a. Show a => a -> [Char] show Int kPlus1 let commandsList :: [[TapeCommand]] commandsList = Set [TapeCommand] -> [[TapeCommand]] forall a. Set a -> [a] Set.toList Set [TapeCommand] commands let ([[TapeCommand] acceptCommand], [[TapeCommand]] otherCommands) = if [[TapeCommand]] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [[TapeCommand]] cmds1 then [Char] -> ([[TapeCommand]], [[TapeCommand]]) forall a. HasCallStack => [Char] -> a error [Char] "No accept command" else ([[TapeCommand]] cmds1, [[TapeCommand]] cmds2) where isAcceptCommand :: [TapeCommand] -> Bool isAcceptCommand [TapeCommand] command = ((TapeCommand, State) -> Bool) -> [(TapeCommand, State)] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all (\(SingleTapeCommand ((Square, State, Square) _, (Square _, State sh, Square _)), State ah) -> State sh State -> State -> Bool forall a. Eq a => a -> a -> Bool == State ah) ([(TapeCommand, State)] -> Bool) -> [(TapeCommand, State)] -> Bool forall a b. (a -> b) -> a -> b $ [TapeCommand] -> [State] -> [(TapeCommand, State)] forall a b. [a] -> [b] -> [(a, b)] zip [TapeCommand] command [State] accessStates ([[TapeCommand]] cmds1, [[TapeCommand]] cmds2) = ([TapeCommand] -> Bool) -> [[TapeCommand]] -> ([[TapeCommand]], [[TapeCommand]]) forall a. (a -> Bool) -> [a] -> ([a], [a]) partition [TapeCommand] -> Bool isAcceptCommand [[TapeCommand]] commandsList let startFirstPhaseStates :: [State] startFirstPhaseStates = (Set State -> State) -> [Set State] -> [State] forall a b. (a -> b) -> [a] -> [b] map Set State -> State genNextState [Set State] multiTapeStates let commandsFirstPhase :: [[TapeCommand]] commandsFirstPhase = [State] -> [TapeCommand] -> [[TapeCommand]] -> [State] -> [Set State] -> [State] -> [[TapeCommand]] firstPhase [State startKPlusOneTapeState, State kplus1tapeState, State finalKPlusOneTapeState] [TapeCommand] acceptCommand [[TapeCommand]] otherCommands [State] startStates [Set State] multiTapeStates [State] startFirstPhaseStates let commandsSecondPhase :: [[TapeCommand]] commandsSecondPhase = State -> [[TapeCommand]] -> [State] -> [[TapeCommand]] secondPhase State finalKPlusOneTapeState [[TapeCommand]] commandsList [State] accessStates let commandsThirdPhase :: [[TapeCommand]] commandsThirdPhase = State -> [[TapeCommand]] -> [State] -> [[TapeCommand]] thirdPhase State finalKPlusOneTapeState [[TapeCommand]] commandsList [State] accessStates let tmAcceptCommand :: [TapeCommand] tmAcceptCommand = (State -> TapeCommand) -> [State] -> [TapeCommand] forall a b. (a -> b) -> [a] -> [b] map (\State st -> ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square LBS, State st, Square RBS), (Square LBS, State st, Square RBS))) [State] accessStates [TapeCommand] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] -> [a] ++ [((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square LBS, State finalKPlusOneTapeState, Square RBS), (Square LBS, State acceptKPlusOneTapeState, Square RBS))] let newTMCommands :: Commands newTMCommands = Set [TapeCommand] -> Commands Commands (Set [TapeCommand] -> Commands) -> Set [TapeCommand] -> Commands forall a b. (a -> b) -> a -> b $ [[TapeCommand]] -> Set [TapeCommand] forall a. Ord a => [a] -> Set a Set.fromList ([[TapeCommand]] -> Set [TapeCommand]) -> [[TapeCommand]] -> Set [TapeCommand] forall a b. (a -> b) -> a -> b $ [[TapeCommand]] commandsFirstPhase [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] forall a. [a] -> [a] -> [a] ++ [[TapeCommand]] commandsSecondPhase [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] forall a. [a] -> [a] -> [a] ++ [[TapeCommand]] commandsThirdPhase [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] forall a. [a] -> [a] -> [a] ++ [[TapeCommand] tmAcceptCommand] let newTMTapeAlphabets :: [TapeAlphabet] newTMTapeAlphabets = [TapeAlphabet] tapeAlphabets [TapeAlphabet] -> [TapeAlphabet] -> [TapeAlphabet] forall a. [a] -> [a] -> [a] ++ [Set Square -> TapeAlphabet TapeAlphabet (Set Square -> TapeAlphabet) -> Set Square -> TapeAlphabet forall a b. (a -> b) -> a -> b $ ([TapeCommand] -> Square) -> Set [TapeCommand] -> Set Square forall b a. Ord b => (a -> b) -> Set a -> Set b Set.map [TapeCommand] -> Square BCommand Set [TapeCommand] commands] let newTMStartStates :: StartStates newTMStartStates = [State] -> StartStates StartStates ([State] startFirstPhaseStates [State] -> [State] -> [State] forall a. [a] -> [a] -> [a] ++ [State startKPlusOneTapeState]) let newTMMultiTapeStates :: MultiTapeStates newTMMultiTapeStates = [Set State] -> MultiTapeStates MultiTapeStates ( (State -> Set State -> Set State) -> [State] -> [Set State] -> [Set State] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith State -> Set State -> Set State forall a. Ord a => a -> Set a -> Set a Set.insert [State] startFirstPhaseStates [Set State] multiTapeStates [Set State] -> [Set State] -> [Set State] forall a. [a] -> [a] -> [a] ++ [[State] -> Set State forall a. Ord a => [a] -> Set a Set.fromList [State startKPlusOneTapeState, State kplus1tapeState, State finalKPlusOneTapeState, State acceptKPlusOneTapeState]] ) let newTMAccessStates :: AccessStates newTMAccessStates = [State] -> AccessStates AccessStates ([State] accessStates [State] -> [State] -> [State] forall a. [a] -> [a] -> [a] ++ [State acceptKPlusOneTapeState]) (InputAlphabet, [TapeAlphabet], MultiTapeStates, Commands, StartStates, AccessStates) -> TM TM (InputAlphabet inputAlphabet, [TapeAlphabet] newTMTapeAlphabets, MultiTapeStates newTMMultiTapeStates, Commands newTMCommands, StartStates newTMStartStates, AccessStates newTMAccessStates) doubleCommands :: [State] -> [State] -> [TapeAlphabet] -> [Set State] -> [[TapeCommand]] -> ([State], [State], [TapeAlphabet], [Set State], [[TapeCommand]]) doubleCommands :: [State] -> [State] -> [TapeAlphabet] -> [Set State] -> [[TapeCommand]] -> ([State], [State], [TapeAlphabet], [Set State], [[TapeCommand]]) doubleCommands [State] startStates [State] accessStates [TapeAlphabet] tapeAlphabets [Set State] multiTapeStates [[TapeCommand]] allcommands = do let doubleCommandsStateDisjoinFunction :: State -> State doubleCommandsStateDisjoinFunction State st = [Char] -> State State ([Char] -> State) -> [Char] -> State forall a b. (a -> b) -> a -> b $ [Char] "q_{" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] stateNumber [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] "}^{" [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ Float -> [Char] forall a. Show a => a -> [Char] show Float tapeNumber [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] "}" where getNumber :: State -> [Char] getNumber (State [Char] s) = [Char] n where ([Char] _, [Char] _, [Char] _, [[Char] n]) = [Char] s [Char] -> [Char] -> ([Char], [Char], [Char], [[Char]]) forall source source1 target. (RegexMaker Regex CompOption ExecOption source, RegexContext Regex source1 target) => source1 -> source -> target =~ [Char] "q_{?([0-9]+)}?\\^{?[0-9]+}?" :: (String, String, String, [String]) stateNumber :: [Char] stateNumber = State -> [Char] getNumber State st getTapeNumber :: State -> Float getTapeNumber (State [Char] s) = [Char] -> Float forall a. Read a => [Char] -> a read [Char] n :: Float where ([Char] _, [Char] _, [Char] _, [[Char] n]) = [Char] s [Char] -> [Char] -> ([Char], [Char], [Char], [[Char]]) forall source source1 target. (RegexMaker Regex CompOption ExecOption source, RegexContext Regex source1 target) => source1 -> source -> target =~ [Char] "q_{?[0-9]+}?\\^{?([0-9]+)}?" :: (String, String, String, [String]) tapeNumber :: Float tapeNumber = Float -> Float -> Float forall a. Num a => a -> a -> a (+) Float 0.5 (Float -> Float) -> Float -> Float forall a b. (a -> b) -> a -> b $ State -> Float getTapeNumber State st let divideCommands :: [TapeCommand] -> [TapeCommand] -> [TapeCommand] divideCommands [TapeCommand] commands [TapeCommand] acc = case [TapeCommand] commands of SingleTapeCommand ((Square a, State s, Square b), (Square a1, State s1, Square b1)) : [TapeCommand] t | Square b Square -> Square -> Bool forall a. Eq a => a -> a -> Bool == Square RBS -> [TapeCommand] -> [TapeCommand] -> [TapeCommand] divideCommands [TapeCommand] t ([TapeCommand] acc [TapeCommand] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] -> [a] ++ [ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square a, State s, Square RBS), (Square a1, State s1, Square RBS)), ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square LBS, State -> State doubleCommandsStateDisjoinFunction State s, Square RBS), (Square LBS, State -> State doubleCommandsStateDisjoinFunction State s1, Square RBS)) ]) | Bool otherwise -> [TapeCommand] -> [TapeCommand] -> [TapeCommand] divideCommands [TapeCommand] t ([TapeCommand] acc [TapeCommand] -> [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] -> [a] ++ [ ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square a, State s, Square RBS), (Square a1, State s1, Square RBS)), ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square -> Square getDisjoinSquare2 Square b, State -> State doubleCommandsStateDisjoinFunction State s, Square RBS), (Square -> Square getDisjoinSquare2 Square b1, State -> State doubleCommandsStateDisjoinFunction State s1, Square RBS)) ]) [] -> [TapeCommand] acc [TapeCommand] _ -> [Char] -> [TapeCommand] forall a. HasCallStack => [Char] -> a error [Char] "Must be SingleTapeCommand" let doubleCommandsInternal :: [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] doubleCommandsInternal [[TapeCommand]] commands [[TapeCommand]] acc = case [[TapeCommand]] commands of [TapeCommand] h : [[TapeCommand]] t -> [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] doubleCommandsInternal [[TapeCommand]] t ([TapeCommand] -> [TapeCommand] -> [TapeCommand] divideCommands [TapeCommand] h [] [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] acc) [] -> [[TapeCommand]] acc let doubleMultitapeStates :: Set State -> [Set State] doubleMultitapeStates Set State states = [Set State states, (State -> State) -> Set State -> Set State forall b a. Ord b => (a -> b) -> Set a -> Set b Set.map State -> State doubleCommandsStateDisjoinFunction Set State states] let doubleStates :: State -> [State] doubleStates State st = [State st, State -> State doubleCommandsStateDisjoinFunction State st] let doubleTapeAlphabets :: TapeAlphabet -> [TapeAlphabet] doubleTapeAlphabets TapeAlphabet tapeAlphabet = [TapeAlphabet tapeAlphabet, Set Square -> TapeAlphabet TapeAlphabet (Set Square -> TapeAlphabet) -> Set Square -> TapeAlphabet forall a b. (a -> b) -> a -> b $ (Square -> Square) -> Set Square -> Set Square forall b a. Ord b => (a -> b) -> Set a -> Set b Set.map Square -> Square getDisjoinSquare2 Set Square a] where (TapeAlphabet Set Square a) = TapeAlphabet tapeAlphabet ((State -> [State]) -> [State] -> [State] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap State -> [State] doubleStates [State] startStates, (State -> [State]) -> [State] -> [State] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap State -> [State] doubleStates [State] accessStates, (TapeAlphabet -> [TapeAlphabet]) -> [TapeAlphabet] -> [TapeAlphabet] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap TapeAlphabet -> [TapeAlphabet] doubleTapeAlphabets [TapeAlphabet] tapeAlphabets, (Set State -> [Set State]) -> [Set State] -> [Set State] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap Set State -> [Set State] doubleMultitapeStates [Set State] multiTapeStates, [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] doubleCommandsInternal [[TapeCommand]] allcommands []) one2KCmds :: ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) one2KCmds :: ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) one2KCmds ([Set State] multiTapeStates, [[TapeCommand]] allcommands) = do let getStartAndFinalStatesOfCommand :: [TapeCommand] -> ([State], [State]) -> ([State], [State]) getStartAndFinalStatesOfCommand [TapeCommand] command ([State] starts, [State] finals) = case [TapeCommand] command of SingleTapeCommand ((Square _, State s1, Square _), (Square _, State s2, Square _)) : [TapeCommand] t -> [TapeCommand] -> ([State], [State]) -> ([State], [State]) getStartAndFinalStatesOfCommand [TapeCommand] t (State s1 State -> [State] -> [State] forall a. a -> [a] -> [a] : [State] starts, State s2 State -> [State] -> [State] forall a. a -> [a] -> [a] : [State] finals) [] -> ([State] -> [State] forall a. [a] -> [a] reverse [State] starts, [State] -> [State] forall a. [a] -> [a] reverse [State] finals) [TapeCommand] _ -> [Char] -> ([State], [State]) forall a. HasCallStack => [Char] -> a error [Char] "Must be SingleTapeCommand" let oneActionCommand :: [Set State] -> ([State], [State]) -> [TapeCommand] -> a -> a -> ([Set State], [State], [TapeCommand]) -> ([Set State], [State], [TapeCommand]) oneActionCommand [Set State] states ([State] starts, [State] finals) [TapeCommand] command a n a i ([Set State] newTapeStates, [State] newStarts, [TapeCommand] acc) = case ([Set State] states, [TapeCommand] command, [State] starts, [State] finals) of ([], [], [], []) -> ([Set State] -> [Set State] forall a. [a] -> [a] reverse [Set State] newTapeStates, [State] -> [State] forall a. [a] -> [a] reverse [State] newStarts, [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] reverse [TapeCommand] acc) (Set State tape : [Set State] tt, SingleTapeCommand ((Square l1, State _, Square r1), (Square l2, State _, Square r2)) : [TapeCommand] t, State start : [State] st, State final : [State] ft) | a n a -> a -> Bool forall a. Eq a => a -> a -> Bool == a i Bool -> Bool -> Bool || Square l1 Square -> Square -> Bool forall a. Eq a => a -> a -> Bool == Square ES Bool -> Bool -> Bool && Square l2 Square -> Square -> Bool forall a. Eq a => a -> a -> Bool == Square ES -> [Set State] -> ([State], [State]) -> [TapeCommand] -> a -> a -> ([Set State], [State], [TapeCommand]) -> ([Set State], [State], [TapeCommand]) oneActionCommand [Set State] tt ([State] st, [State] ft) [TapeCommand] t a n (a i a -> a -> a forall a. Num a => a -> a -> a + a 1) (Set State tape Set State -> [Set State] -> [Set State] forall a. a -> [a] -> [a] : [Set State] newTapeStates, State final State -> [State] -> [State] forall a. a -> [a] -> [a] : [State] newStarts, ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square l1, State start, Square r1), (Square l2, State final, Square r2)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc) | a i a -> a -> Bool forall a. Ord a => a -> a -> Bool < a n Bool -> Bool -> Bool && State start State -> State -> Bool forall a. Eq a => a -> a -> Bool == State final -> [Set State] -> ([State], [State]) -> [TapeCommand] -> a -> a -> ([Set State], [State], [TapeCommand]) -> ([Set State], [State], [TapeCommand]) oneActionCommand [Set State] tt ([State] st, [State] ft) [TapeCommand] t a n (a i a -> a -> a forall a. Num a => a -> a -> a + a 1) (Set State tape Set State -> [Set State] -> [Set State] forall a. a -> [a] -> [a] : [Set State] newTapeStates, State final State -> [State] -> [State] forall a. a -> [a] -> [a] : [State] newStarts, ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square ES, State start, Square r1), (Square ES, State final, Square r2)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc) | Bool otherwise -> [Set State] -> ([State], [State]) -> [TapeCommand] -> a -> a -> ([Set State], [State], [TapeCommand]) -> ([Set State], [State], [TapeCommand]) oneActionCommand [Set State] tt ([State] st, [State] ft) [TapeCommand] t a n (a i a -> a -> a forall a. Num a => a -> a -> a + a 1) (State -> Set State -> Set State forall a. Ord a => a -> Set a -> Set a Set.insert State intermediateState Set State tape Set State -> [Set State] -> [Set State] forall a. a -> [a] -> [a] : [Set State] newTapeStates, State intermediateState State -> [State] -> [State] forall a. a -> [a] -> [a] : [State] newStarts, ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square ES, State start, Square r1), (Square ES, State intermediateState, Square r2)) TapeCommand -> [TapeCommand] -> [TapeCommand] forall a. a -> [a] -> [a] : [TapeCommand] acc) where intermediateState :: State intermediateState = Set State -> State genNextState Set State tape ([Set State], [TapeCommand], [State], [State]) _ -> [Char] -> ([Set State], [State], [TapeCommand]) forall a. HasCallStack => [Char] -> a error ([Char] -> ([Set State], [State], [TapeCommand])) -> [Char] -> ([Set State], [State], [TapeCommand]) forall a b. (a -> b) -> a -> b $ [Char] "Non-exhaustive patterns in case " [Char] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ ([Set State], [State], [TapeCommand]) -> [Char] forall a. Show a => a -> [Char] show ([Set State] -> [Set State] forall a. [a] -> [a] reverse [Set State] newTapeStates, [State] -> [State] forall a. [a] -> [a] reverse [State] newStarts, [TapeCommand] -> [TapeCommand] forall a. [a] -> [a] reverse [TapeCommand] acc) let one2KCmd :: [Set State] -> ([State], [State]) -> a -> [TapeCommand] -> [TapeCommand] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) one2KCmd [Set State] states ([State] starts, [State] finals) a i [TapeCommand] command [TapeCommand] immutCommand [[TapeCommand]] acc = case [TapeCommand] command of SingleTapeCommand ((Square l1, State _, Square _), (Square l2, State _, Square _)) : [TapeCommand] t | Square l1 Square -> Square -> Bool forall a. Eq a => a -> a -> Bool == Square ES Bool -> Bool -> Bool && Square l2 Square -> Square -> Bool forall a. Eq a => a -> a -> Bool == Square ES -> [Set State] -> ([State], [State]) -> a -> [TapeCommand] -> [TapeCommand] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) one2KCmd [Set State] states ([State] starts, [State] finals) (a i a -> a -> a forall a. Num a => a -> a -> a + a 1) [TapeCommand] t [TapeCommand] immutCommand [[TapeCommand]] acc | Bool otherwise -> [Set State] -> ([State], [State]) -> a -> [TapeCommand] -> [TapeCommand] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) one2KCmd [Set State] newTapeStates ([State] newStarts, [State] finals) (a i a -> a -> a forall a. Num a => a -> a -> a + a 1) [TapeCommand] t [TapeCommand] immutCommand ([[TapeCommand]] -> ([Set State], [[TapeCommand]])) -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) forall a b. (a -> b) -> a -> b $ [TapeCommand] newCommand [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] acc where ([Set State] newTapeStates, [State] newStarts, [TapeCommand] newCommand) = [Set State] -> ([State], [State]) -> [TapeCommand] -> a -> a -> ([Set State], [State], [TapeCommand]) -> ([Set State], [State], [TapeCommand]) forall a. (Num a, Ord a) => [Set State] -> ([State], [State]) -> [TapeCommand] -> a -> a -> ([Set State], [State], [TapeCommand]) -> ([Set State], [State], [TapeCommand]) oneActionCommand [Set State] states ([State] starts, [State] finals) [TapeCommand] immutCommand a i a 0 ([], [], []) [] -> ([Set State] states, [[TapeCommand]] acc) [TapeCommand] _ -> [Char] -> ([Set State], [[TapeCommand]]) forall a. HasCallStack => [Char] -> a error [Char] "Must be SingleTapeCommand" let one2KCmdsInternal :: [Set State] -> [[TapeCommand]] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) one2KCmdsInternal [Set State] states [[TapeCommand]] commands [[TapeCommand]] acc = case [[TapeCommand]] commands of [TapeCommand] h : [[TapeCommand]] t -> [Set State] -> [[TapeCommand]] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) one2KCmdsInternal [Set State] newTapeStates [[TapeCommand]] t ([[TapeCommand]] -> ([Set State], [[TapeCommand]])) -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) forall a b. (a -> b) -> a -> b $ [[TapeCommand]] newCommands [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] forall a. [a] -> [a] -> [a] ++ [[TapeCommand]] acc where ([State] starts, [State] finals) = [TapeCommand] -> ([State], [State]) -> ([State], [State]) getStartAndFinalStatesOfCommand [TapeCommand] h ([], []) ([Set State] newTapeStates, [[TapeCommand]] newCommands) = [Set State] -> ([State], [State]) -> Integer -> [TapeCommand] -> [TapeCommand] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) forall a. (Num a, Ord a) => [Set State] -> ([State], [State]) -> a -> [TapeCommand] -> [TapeCommand] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) one2KCmd [Set State] states ([State] starts, [State] finals) Integer 0 [TapeCommand] h [TapeCommand] h [] [] -> ([Set State] states, [[TapeCommand]] acc) [Set State] -> [[TapeCommand]] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) one2KCmdsInternal [Set State] multiTapeStates [[TapeCommand]] allcommands [] cmd2SIDCmd :: ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) cmd2SIDCmd :: ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) cmd2SIDCmd ([Set State] tSts, [[TapeCommand]] allcommands) = do let transformCommand :: [Set State] -> [TapeCommand] -> ([Set State], [[TapeCommand]]) transformCommand [Set State] states [TapeCommand] command = ([Set State] newTapeStates, [[TapeCommand] c1, [TapeCommand] c2]) where func :: TapeCommand -> Set State -> (TapeCommand, TapeCommand, Set State) func (SingleTapeCommand ((Square l1, State s1, Square r1), (Square l2, State s2, Square r2))) Set State tape = (((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square l1, State s1, Square r1), (Square ES, State intermediateState, Square r1)), ((Square, State, Square), (Square, State, Square)) -> TapeCommand SingleTapeCommand ((Square ES, State intermediateState, Square r1), (Square l2, State s2, Square r2)), State -> Set State -> Set State forall a. Ord a => a -> Set a -> Set a Set.insert State intermediateState Set State tape) where intermediateState :: State intermediateState = Set State -> State genNextState Set State tape func TapeCommand _ Set State _ = [Char] -> (TapeCommand, TapeCommand, Set State) forall a. HasCallStack => [Char] -> a error [Char] "Must be SingleTapeCommand" ([TapeCommand] c1, [TapeCommand] c2, [Set State] newTapeStates) = [(TapeCommand, TapeCommand, Set State)] -> ([TapeCommand], [TapeCommand], [Set State]) forall a b c. [(a, b, c)] -> ([a], [b], [c]) unzip3 ([(TapeCommand, TapeCommand, Set State)] -> ([TapeCommand], [TapeCommand], [Set State])) -> [(TapeCommand, TapeCommand, Set State)] -> ([TapeCommand], [TapeCommand], [Set State]) forall a b. (a -> b) -> a -> b $ (TapeCommand -> Set State -> (TapeCommand, TapeCommand, Set State)) -> [TapeCommand] -> [Set State] -> [(TapeCommand, TapeCommand, Set State)] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith TapeCommand -> Set State -> (TapeCommand, TapeCommand, Set State) func [TapeCommand] command [Set State] states let checkLeftBounding :: t TapeCommand -> Bool checkLeftBounding t TapeCommand command = (TapeCommand -> Bool) -> t TapeCommand -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all (\(SingleTapeCommand ((Square l1, State _, Square _), (Square l2, State _, Square _))) -> Square l1 Square -> Square -> Bool forall a. Eq a => a -> a -> Bool == Square LBS Bool -> Bool -> Bool || Square l1 Square -> Square -> Bool forall a. Eq a => a -> a -> Bool == Square ES Bool -> Bool -> Bool || Square l2 Square -> Square -> Bool forall a. Eq a => a -> a -> Bool == Square ES) t TapeCommand command let cmd2SIDCmdInternal :: [Set State] -> [[TapeCommand]] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) cmd2SIDCmdInternal [Set State] states [[TapeCommand]] commands [[TapeCommand]] acc = case [[TapeCommand]] commands of [TapeCommand] h : [[TapeCommand]] t | [TapeCommand] -> Bool forall (t :: * -> *). Foldable t => t TapeCommand -> Bool checkLeftBounding [TapeCommand] h -> [Set State] -> [[TapeCommand]] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) cmd2SIDCmdInternal [Set State] states [[TapeCommand]] t ([[TapeCommand]] -> ([Set State], [[TapeCommand]])) -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) forall a b. (a -> b) -> a -> b $ [TapeCommand] h [TapeCommand] -> [[TapeCommand]] -> [[TapeCommand]] forall a. a -> [a] -> [a] : [[TapeCommand]] acc | Bool otherwise -> [Set State] -> [[TapeCommand]] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) cmd2SIDCmdInternal [Set State] newTapeStates [[TapeCommand]] t ([[TapeCommand]] -> ([Set State], [[TapeCommand]])) -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) forall a b. (a -> b) -> a -> b $ [[TapeCommand]] newCommands [[TapeCommand]] -> [[TapeCommand]] -> [[TapeCommand]] forall a. [a] -> [a] -> [a] ++ [[TapeCommand]] acc where ([Set State] newTapeStates, [[TapeCommand]] newCommands) = [Set State] -> [TapeCommand] -> ([Set State], [[TapeCommand]]) transformCommand [Set State] states [TapeCommand] h [] -> ([Set State] states, [[TapeCommand]] acc) [Set State] -> [[TapeCommand]] -> [[TapeCommand]] -> ([Set State], [[TapeCommand]]) cmd2SIDCmdInternal [Set State] tSts [[TapeCommand]] allcommands [] symTM :: TM -> TM symTM :: TM -> TM symTM TM tm = do let (TM (InputAlphabet inputAlphabet, [TapeAlphabet] tapeAlphabets, MultiTapeStates [Set State] multiTapeStates, Commands Set [TapeCommand] commandsSet, StartStates [State] startStates, AccessStates [State] accessStates) ) = TM -> TM threePhaseProcessing TM tm let commands :: [[TapeCommand]] commands = Set [TapeCommand] -> [[TapeCommand]] forall a. Set a -> [a] Set.toList Set [TapeCommand] commandsSet let ([State] newStartStates, [State] newAccessStates, [TapeAlphabet] newTapeAlphabets, [Set State] doubledTapeStates, [[TapeCommand]] doubledCommands) = [State] -> [State] -> [TapeAlphabet] -> [Set State] -> [[TapeCommand]] -> ([State], [State], [TapeAlphabet], [Set State], [[TapeCommand]]) doubleCommands [State] startStates [State] accessStates [TapeAlphabet] tapeAlphabets [Set State] multiTapeStates [[TapeCommand]] commands let ([Set State] newTapeStates, [[TapeCommand]] newTMCommands) = ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) cmd2SIDCmd (([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]])) -> ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) forall a b. (a -> b) -> a -> b $ ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) one2KCmds ([Set State] doubledTapeStates, [[TapeCommand]] doubledCommands) (InputAlphabet, [TapeAlphabet], MultiTapeStates, Commands, StartStates, AccessStates) -> TM TM (InputAlphabet inputAlphabet, [TapeAlphabet] newTapeAlphabets, [Set State] -> MultiTapeStates MultiTapeStates [Set State] newTapeStates, Set [TapeCommand] -> Commands Commands ([[TapeCommand]] -> Set [TapeCommand] forall a. Ord a => [a] -> Set a Set.fromList ([[TapeCommand]] -> Set [TapeCommand]) -> [[TapeCommand]] -> Set [TapeCommand] forall a b. (a -> b) -> a -> b $ [[TapeCommand]] -> [[TapeCommand]] symCommands [[TapeCommand]] newTMCommands), [State] -> StartStates StartStates [State] newStartStates, [State] -> AccessStates AccessStates [State] newAccessStates) symDetTM :: TM -> TM symDetTM :: TM -> TM symDetTM (TM (InputAlphabet inputAlphabet, [TapeAlphabet] tapeAlphabets, MultiTapeStates [Set State] multiTapeStates, Commands Set [TapeCommand] commandsSet, StartStates [State] startStates, AccessStates [State] accessStates) ) = do let commands :: [[TapeCommand]] commands = Set [TapeCommand] -> [[TapeCommand]] forall a. Set a -> [a] Set.toList Set [TapeCommand] commandsSet let ([State] newStartStates, [State] newAccessStates, [TapeAlphabet] newTapeAlphabets, [Set State] doubledTapeStates, [[TapeCommand]] doubledCommands) = [State] -> [State] -> [TapeAlphabet] -> [Set State] -> [[TapeCommand]] -> ([State], [State], [TapeAlphabet], [Set State], [[TapeCommand]]) doubleCommands [State] startStates [State] accessStates [TapeAlphabet] tapeAlphabets [Set State] multiTapeStates [[TapeCommand]] commands let ([Set State] newTapeStates, [[TapeCommand]] newTMCommands) = ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) cmd2SIDCmd (([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]])) -> ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) forall a b. (a -> b) -> a -> b $ ([Set State], [[TapeCommand]]) -> ([Set State], [[TapeCommand]]) one2KCmds ([Set State] doubledTapeStates, [[TapeCommand]] doubledCommands) (InputAlphabet, [TapeAlphabet], MultiTapeStates, Commands, StartStates, AccessStates) -> TM TM (InputAlphabet inputAlphabet, [TapeAlphabet] newTapeAlphabets, [Set State] -> MultiTapeStates MultiTapeStates [Set State] newTapeStates, Set [TapeCommand] -> Commands Commands ([[TapeCommand]] -> Set [TapeCommand] forall a. Ord a => [a] -> Set a Set.fromList ([[TapeCommand]] -> Set [TapeCommand]) -> [[TapeCommand]] -> Set [TapeCommand] forall a b. (a -> b) -> a -> b $ [[TapeCommand]] -> [[TapeCommand]] symCommands [[TapeCommand]] newTMCommands), [State] -> StartStates StartStates [State] newStartStates, [State] -> AccessStates AccessStates [State] newAccessStates)