GenTape module, and sequentially execute multiple TMs. Untested.
Chris Pressey
3 months ago
| 0 | in state,if the symbol is,write the symbol,move the head,go to state | |
| 1 | 0,0,0,R,3 | |
| 2 | 0,1,1,R,4 | |
| 3 | 0,2,2,R,5 | |
| 4 | 3,0,0,R,3 | |
| 5 | 3,1,1,R,3 | |
| 6 | 3,2,2,R,6 | |
| 7 | 4,0,0,R,4 | |
| 8 | 4,1,1,R,4 | |
| 9 | 4,2,2,R,7 | |
| 10 | 5,2,2,L,8 | |
| 11 | 6,0,0,R,6 | |
| 12 | 6,1,1,R,6 | |
| 13 | 6,2,2,L,9 | |
| 14 | 7,0,0,R,7 | |
| 15 | 7,1,1,R,7 | |
| 16 | 7,2,2,L,10 | |
| 17 | 8,0,0,L,8 | |
| 18 | 8,1,1,L,8 | |
| 19 | 8,2,2,L,0 | |
| 20 | 9,0,0,0,R,H | |
| 21 | 9,1,1,0,R,H | |
| 22 | 9,2,2,0,R,H | |
| 23 | 10,0,0,1,R,H | |
| 24 | 10,1,1,1,R,H | |
| 25 | 10,2,2,1,R,H |
| 0 | module Language.Turmac.GenTape where | |
| 1 | ||
| 2 | import Data.Char (digitToInt) | |
| 3 | ||
| 4 | -- Function to generate Turmac rules for writing a string | |
| 5 | generateTapeWriter :: String -> String | |
| 6 | generateTapeWriter input = unlines $ | |
| 7 | -- Header line | |
| 8 | ["in state,if the symbol is,write the symbol,move the head,go to state"] ++ | |
| 9 | -- Rules for writing each symbol | |
| 10 | writeRules ++ | |
| 11 | -- Rules for moving back | |
| 12 | moveBackRules | |
| 13 | where | |
| 14 | -- Generate rules for writing each digit in sequence | |
| 15 | writeRules = zipWith makeWriteRule [0..] (map digitToInt input) | |
| 16 | ||
| 17 | -- Generate rules for moving back to start | |
| 18 | moveBackRules = | |
| 19 | if null input | |
| 20 | then [] | |
| 21 | else makeBackwardRules (length input) (length input) | |
| 22 | ||
| 23 | -- Create a rule for writing a single digit | |
| 24 | makeWriteRule :: Int -> Int -> String | |
| 25 | makeWriteRule state digit = | |
| 26 | let nextState = state + 1 | |
| 27 | in show state ++ ",0," ++ show digit ++ ",R," ++ show nextState | |
| 28 | ||
| 29 | -- Create rules for moving back to start | |
| 30 | makeBackwardRules :: Int -> Int -> [String] | |
| 31 | makeBackwardRules state numMoves = | |
| 32 | let moves = replicate numMoves 'L' | |
| 33 | states = [state .. state + numMoves - 1] | |
| 34 | nextStates = [state + 1 .. state + numMoves] | |
| 35 | lastState = if null moves then state else state + numMoves | |
| 36 | rules = zipWith3 makeBackRule states (init nextStates) moves | |
| 37 | finalRule = show (lastState - 1) ++ ",0,0,L,H" | |
| 38 | in rules ++ [finalRule] | |
| 39 | where | |
| 40 | makeBackRule s ns dir = | |
| 41 | show s ++ ",0,0," ++ [dir] ++ "," ++ show ns |
| 7 | 7 | import Language.Turmac.IR |
| 8 | 8 | import Language.Turmac.Analyzer (isComplete) |
| 9 | 9 | import Language.Turmac.Interpreter |
| 10 | ||
| 10 | import Language.Turmac.GenTape | |
| 11 | 11 | |
| 12 | 12 | -- |
| 13 | 13 | -- Parse to IR |
| 23 | 23 | else Right $ buildProgram rules |
| 24 | 24 | |
| 25 | 25 | -- |
| 26 | -- Sequential execution | |
| 27 | -- | |
| 28 | ||
| 29 | runSequentially :: [Prog] -> [Int] -> ([Int], TMState) | |
| 30 | runSequentially [] input = | |
| 31 | (input, initTMStateWithInput input) | |
| 32 | runSequentially (prog:progs) input = | |
| 33 | let | |
| 34 | (result, finalState) = run prog input | |
| 35 | in | |
| 36 | runSequentially progs result | |
| 37 | ||
| 38 | -- | |
| 26 | 39 | -- Driver |
| 27 | 40 | -- |
| 28 | 41 | |
| 29 | 42 | main = do |
| 30 | 43 | args <- getArgs |
| 31 | 44 | case args of |
| 32 | ["parse", fileName] -> do | |
| 45 | "parse":fileName:_ -> do | |
| 33 | 46 | prog <- readFile fileName |
| 34 | 47 | case parse prog of |
| 35 | 48 | Right ast -> do |
| 38 | 51 | Left errMsg -> do |
| 39 | 52 | putStrLn errMsg |
| 40 | 53 | exitWith $ ExitFailure 1 |
| 41 | ["simulate", fileName] -> do | |
| 42 | prog <- readFile fileName | |
| 43 | case parse prog of | |
| 44 | Right ast -> do | |
| 45 | let (result, finalState) = run ast [] | |
| 54 | "simulate":fileNames@(_:_) -> do | |
| 55 | -- Read and parse all programs | |
| 56 | programs <- mapM readFile fileNames | |
| 57 | let parseResults = map parse programs | |
| 58 | ||
| 59 | -- Check for parsing errors | |
| 60 | case sequence parseResults of | |
| 61 | Right progs -> do | |
| 62 | let (result, finalState) = runSequentially progs [] | |
| 46 | 63 | putStrLn $ "Final tape contents: " ++ intercalate " " (map show result) |
| 47 | 64 | putStrLn $ "Final state: " ++ show (tmState finalState) |
| 48 | 65 | putStrLn $ "Halted: " ++ show (tmHalted finalState) |
| 49 | 66 | exitWith ExitSuccess |
| 50 | 67 | Left errMsg -> do |
| 51 | putStrLn errMsg | |
| 68 | putStrLn $ "Error parsing one of the input files: " ++ errMsg | |
| 52 | 69 | exitWith $ ExitFailure 1 |
| 70 | ["gentape", str] -> do | |
| 71 | putStr $ generateTapeWriter str | |
| 72 | exitWith ExitSuccess | |
| 53 | 73 | _ -> do |
| 54 | putStrLn "Usage: turmac (parse|simulate) <turmac-description-file>" | |
| 55 | exitWith $ ExitFailure 2 | |
| 74 | putStrLn "Usage: turmac parse <turmac-description-file>" | |
| 75 | putStrLn " turmac simulate <turmac-description-file>..." | |
| 76 | putStrLn " turmac gentape <string-of-digits>" | |
| 77 | exitWith $ ExitFailure 2⏎ | |