Commit b2b1a6c26c3fe4749ec696490beab73d31b9924c - Turmac

Checkpoint fixing gentape subcommand. Chris Pressey 4 months ago

2 changed file(s) with 29 addition(s) and 29 deletion(s). Raw diff Collapse all Expand all

+16

-21

src/Language/Turmac/GenTape.hs less more

5	5
6	6	import Data.Char (digitToInt)
7	7
8		-- Function to generate Turmac rules for writing a string
9		generateTapeWriter :: String -> String
10		generateTapeWriter input = unlines $
	8	import Language.Turmac.Model
	9
	10
	11	-- Function to generate Turmac rules for writing a sequence of symbols to the tape
	12	generateTapeWriter :: [Symbol] -> [TMRule]
	13	generateTapeWriter symbols = unlines $
11	14	-- Header line
12	15	["in state,if the symbol is,write the symbol,move the head,go to state"] ++
13	16	-- Rules for writing each symbol

16	19	moveBackRules
17	20	where
18	21	-- Generate rules for writing each digit in sequence
19		writeRules = zipWith makeWriteRule [0..] (map digitToInt input)
	22	writeRules = zipWith makeWriteRule [0..] symbols
20	23
21	24	-- Generate rules for moving back to start
22	25	moveBackRules =
23		if null input
	26	if null symbols
24	27	then []
25		else makeBackwardRules (length input) (length input)
	28	else makeBackwardRules (length symbols) (length symbols)
26	29
27		renderRule :: Int -> Int -> Int -> Char -> Int -> String
28		renderRule state1 sym1 sym2 dir state2 =
29		let
30		st1 = "S" ++ (show state1)
31		st2 = if state2 == -1 then "H" else "S" ++ (show state2)
32		in
33		st1 ++ "," ++ (show sym1) ++ "," ++ (show sym2) ++ "," ++ [dir] ++ "," ++ st2
34
35		-- Create a rule for writing a single digit
36		makeWriteRule :: Int -> Int -> String
37		makeWriteRule state digit =
38		renderRule state 0 digit 'R' (state + 1)
	30	-- Create a rule for writing a single symbol
	31	makeWriteRule :: Int -> Symbol -> TMRule
	32	makeWriteRule state symbol =
	33	("S" ++ show state, "_", symbol, "S" ++ show (state + 1), 1)
39	34
40	35	-- Create rules for moving back to start
41		makeBackwardRules :: Int -> Int -> [String]
	36	makeBackwardRules :: StateId -> Int -> [TMRule]
42	37	makeBackwardRules state numMoves =
43	38	let
44	39	moves = replicate numMoves 'L'

47	42	lastState = if null moves then state else state + numMoves
48	43	-- For each state in backtracking phase, generate rules for all possible symbols
49	44	rules = concatMap (\(s, ns, dir) ->
50		[renderRule s sym sym dir ns \| sym <- [0..2]]) -- Handle symbols 0, 1, and 2
	45	[(s, sym, sym, ns, dir) \| sym <- ["S0", "S1", "S2"]]) -- Handle symbols 0, 1, and 2
51	46	(zip3 states (init nextStates) moves)
52	47	-- Final state also needs rules for all symbols
53	48	finalRules =
54		[renderRule (lastState -1) sym sym 'L' (-1) \| sym <- [0..2]]
	49	[((lastState - 1), sym, sym, "H", (-1)) \| sym <- ["S0", "S1", "S2"]]
55	50	in
56	51	rules ++ finalRules

+13

-8

src/Main.hs less more

40	40	trace = False
41	41	}
42	42
	43	-- Note: this is a terrible little hack
	44	splitOnCommas s =
	45	words [if c == ',' then ' ' else c\|c <- s]
	46
43	47	parseFlags flags ("--backend":s:rest) =
44	48	parseFlags flags{ backend = s } rest
45	49	parseFlags flags ("--check-complete":rest) =
46	50	parseFlags flags{ checkComplete = True } rest
47	51	parseFlags flags ("--initial-tape":s:rest) =
48		parseFlags flags{ initialTape = words [if c == ',' then ' ' else c\|c <- s] } rest
	52	parseFlags flags{ initialTape = splitOnCommas s } rest
49	53	parseFlags flags ("--max-steps":n:rest) =
50	54	parseFlags flags{ maxSteps = read n } rest
51	55	parseFlags flags ("--trace":rest) =

111	115	putStrLn $ "Error parsing input file: " ++ errMsg
112	116	exitWith $ ExitFailure 1
113	117
114		["gentape", str] -> do
115		putStr $ generateTapeWriter str
	118	["gentape", tapeContents] -> do
	119	symbols <- splitOnCommas tapeContents
	120	putStr $ generateTapeWriter symbols
116	121	exitWith ExitSuccess
117	122
118	123	_ -> do
119	124	putStrLn "Usage: turmac {flags} simulate <turmac-description-file>"
120	125	putStrLn " turmac {flags} compile <turmac-description-file>"
121		putStrLn " turmac {flags} gentape <string-of-digits>"
	126	putStrLn " turmac {flags} gentape <comma-separated-list-of-symbols>"
122	127	putStrLn " where flags are:"
123		putStrLn " --backend : when compiling, specifies backend to use"
124		putStrLn " --check-complete : check description is complete beforehand"
125		putStrLn " --initial-tape : comma-seperated symbols initially on tape"
126		putStrLn " --trace : when simulating, display each step taken"
	128	putStrLn " --backend when compiling, specifies backend to use"
	129	putStrLn " --check-complete check description is complete beforehand"
	130	putStrLn " --initial-tape when simulating, gives initial contents of tape"
	131	putStrLn " --trace when simulating, display each step taken"
127	132	exitWith $ ExitFailure 2