Refactor IR.
Chris Pressey
2 months ago
| 92 | 92 |
]
|
| 93 | 93 |
compileStep (CondSymbol branches) =
|
| 94 | 94 |
compileBranches "self.tape.read_symbol()" branches
|
| 95 | |
compileStep (WriteSymbol sym) =
|
| 96 | |
"self.tape.write_symbol(" ++ show sym ++ ")"
|
| 97 | |
compileStep (ChangeState state) =
|
| 98 | |
"self.state = " ++ show state
|
| 99 | |
compileStep MoveLeft = "self.tape.move_left()"
|
| 100 | |
compileStep MoveRight = "self.tape.move_right()"
|
| 101 | |
compileStep Halt = "self.halted = True"
|
|
95 |
compileStep (WriteMoveGoto sym dir state) = unlines [
|
|
96 |
"self.tape.write_symbol(" ++ show sym ++ ")",
|
|
97 |
if dir == -1 then "self.tape.move_left()" else "self.tape.move_right()",
|
|
98 |
if state == "H" then "self.halted = True" else "self.state = " ++ show state
|
|
99 |
]
|
| 102 | 100 |
|
| 103 | 101 |
compileBranches :: String -> [(StateId, Prog)] -> String
|
| 104 | 102 |
compileBranches cond branches = unlines $
|
| 13 | 13 |
| Seq [Prog]
|
| 14 | 14 |
| CondState [(StateId, Prog)]
|
| 15 | 15 |
| CondSymbol [(Symbol, Prog)]
|
| 16 | |
| WriteSymbol Symbol
|
| 17 | |
| ChangeState StateId
|
| 18 | |
| MoveLeft
|
| 19 | |
| MoveRight
|
|
16 |
| WriteMoveGoto Symbol Int StateId
|
| 20 | 17 |
| Halt
|
| 21 | 18 |
deriving (Eq)
|
| 22 | 19 |
|
|
| 29 | 26 |
showProg n (Seq progs) = "Seq\n" ++ concatMap (\p -> indent (n+1) ++ showProg (n+1) p ++ "\n") progs
|
| 30 | 27 |
showProg n (CondState branches) = "CondState\n" ++
|
| 31 | 28 |
concatMap (\(state, p) -> indent (n+1) ++ show state ++ " ->\n" ++
|
| 32 | |
indent (n+2) ++ showProg (n+2) p) branches
|
|
29 |
indent (n+2) ++ showProg (n+2) p) branches
|
| 33 | 30 |
showProg n (CondSymbol branches) = "CondSymbol\n" ++
|
| 34 | 31 |
concatMap (\(sym, p) -> indent (n+1) ++ show sym ++ " ->\n" ++
|
| 35 | |
indent (n+2) ++ showProg (n+2) p) branches
|
| 36 | |
showProg _ (WriteSymbol sym) = "Write " ++ show sym
|
| 37 | |
showProg _ (ChangeState state) = "Goto " ++ show state
|
| 38 | |
showProg _ MoveLeft = "Left"
|
| 39 | |
showProg _ MoveRight = "Right"
|
| 40 | |
showProg _ Halt = "Halt"
|
|
32 |
indent (n+2) ++ showProg (n+2) p) branches
|
|
33 |
showProg n (WriteMoveGoto sym dir state) = "Write " ++ show sym ++ "\n" ++
|
|
34 |
(indent n) ++ showGoto state ++ "\n" ++
|
|
35 |
(indent n) ++ showDir dir
|
|
36 |
|
|
37 |
showDir (-1) = "Left"
|
|
38 |
showDir 1 = "Right"
|
|
39 |
showDir other = "?ERROR(" ++ (show other) ++ ")"
|
|
40 |
|
|
41 |
showGoto "H" = "Halt"
|
|
42 |
showGoto state = "Goto " ++ show state
|
| 17 | 17 |
| state <- states]
|
| 18 | 18 |
where states = nub [s | (s,_,_,_,_) <- rules]
|
| 19 | 19 |
|
| 20 | |
-- Convert direction char to program
|
| 21 | |
dirToProg :: Int -> Prog
|
| 22 | |
dirToProg (-1) = MoveLeft
|
| 23 | |
dirToProg (1) = MoveRight
|
| 24 | |
dirToProg d = error $ "Invalid direction: " ++ (show d)
|
| 25 | |
|
| 26 | 20 |
-- Convert a single state's rules to CondSymbol
|
| 27 | 21 |
stateRulesToProg :: [(Symbol, (Symbol, StateId, Direction))] -> Prog
|
| 28 | 22 |
stateRulesToProg rules =
|
| 29 | |
CondSymbol [(sym, Seq [WriteSymbol newSym,
|
| 30 | |
changeState newState,
|
| 31 | |
dirToProg dir])
|
|
23 |
CondSymbol [(sym, Seq [WriteMoveGoto newSym dir newState])
|
| 32 | 24 |
| (sym, (newSym, newState, dir)) <- rules]
|
| 33 | |
where
|
| 34 | |
changeState "H" = Halt
|
| 35 | |
changeState s = ChangeState s
|
| 36 | 25 |
|
| 37 | 26 |
-- Convert all rules to full program
|
| 38 | 27 |
buildProgram :: [TMRule] -> Prog
|