First commit

1 files changed, 94 insertions, 0 deletions

diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..01cf1e1
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,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