1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
module Main where
import Control.Concurrent (threadDelay)
import Data.Maybe (fromMaybe)
import Data.Monoid
import System.IO (hFlush, stdout, isEOF)
import Turing.Machine
import Turing.Examples
data Cmd = Exit | Run | Print | Help | Wait (Maybe Int) | Step Int
data SimResult = Ok String | Error String deriving Show
data SimState = SimState { stMConf :: Config
, stStopped :: Maybe SimResult
, stWait :: Int }
mkSimState :: Config -> SimState
mkSimState conf = SimState conf Nothing 0
stFailed, stUserStopped :: SimState -> SimState
stFailed st = st { stStopped = Just (Error "Failed to do transition") }
stUserStopped st = st { stStopped = Just (Ok "Stopped by user") }
sim :: Machine -> Maybe Config -> IO SimResult
sim m conf = prompt $ mkSimState (fromMaybe (mkConfig [SymSpace]) conf)
where
prompt st = do
putStr "> "
hFlush stdout
eof <- isEOF
if eof then return (Ok "Stopped by user")
else do
line <- getLine
case parseCmd (words line) of
Just cmd -> do st' <- execCmd st cmd
case stStopped st' of
Just how -> return how
Nothing -> prompt st'
Nothing -> putStrLn "Unknown command (type 'h' for help)" >>
prompt st
doSteps :: SimState -> Maybe Int -> IO SimState
doSteps st stop = if state (stMConf st) `elem` finals m || stop == Just 0
then return st
else case step (stMConf st) (delta m) of
Nothing -> return $ stFailed st
Just c' -> do print c'
threadDelay (stWait st)
let st' = st { stMConf = c' }
doSteps st' (fmap pred stop)
execCmd :: SimState -> Cmd -> IO SimState
execCmd st cmd =
case cmd of
Exit -> return (stUserStopped st)
Run -> doSteps st Nothing
Print -> print (stMConf st) >> return st
Help -> printHelp >> return st
Wait Nothing -> putStrLn ("t = " ++ show (stWait st) ++ " µs") >>
return st
Wait (Just t) -> let t' = 1000 * t in
putStrLn ("t = " ++ show t' ++ " µs") >>
return (st { stWait = t' })
Step n -> doSteps st (Just n)
parseCmd :: [String] -> Maybe Cmd
parseCmd [] = Just (Step 1)
parseCmd ["q"] = Just Exit
parseCmd ["r"] = Just Run
parseCmd ["p"] = Just Print
parseCmd ["h"] = Just Help
parseCmd ["?"] = Just Help
parseCmd ["t"] = Just (Wait Nothing)
parseCmd ["t", n] = Just (Wait (Just (read n)))
parseCmd ["s", n] = Just (Step (read n))
parseCmd _ = Nothing
printHelp :: IO ()
printHelp = mapM_ (putStrLn . showCmd) cmds
where showCmd (cmd, desc) =
cmd ++ replicate (gap - length cmd) ' ' ++ " - " ++ desc
cmds = [("q","exit the simulation")
,("r","run the simulation until it finishes")
,("p","print the machine")
,("h","print this help")
,("t [<n>]","print/set the current time interval")
,("s <n>","steps <n> times without prompting")]
gap = maximum (map (length . fst) cmds)
main :: IO ()
main = do
let example = mconcat [mWriteStr "_aaaaaa_aaa", mInit, mSub, mDecr]
print example
print =<< sim example Nothing
|
