-- SPDX-FileCopyrightText: Chris Pressey, the creator of this work, has dedicated it to the public domain.
-- For more information, please refer to <https://unlicense.org/>
-- SPDX-License-Identifier: Unlicense
module Main where
import Data.Char (digitToInt)
import System.Environment
import System.Exit
import Language.Turmac.Model
import Language.Turmac.IR
import Language.Turmac.Parser
import Language.Turmac.Analyzer (checkComplete, checkDeterministic)
import Language.Turmac.Simulator
import Language.Turmac.Renderer (renderConfig, renderTrace)
import Language.Turmac.GenTape
import Language.Turmac.Normalizer
import Language.Turmac.Backend.IRDump
import Language.Turmac.Backend.Turmac
import Language.Turmac.Backend.Python
--
-- Command-line flags
--
data Flags = Flags {
initialTape :: [Symbol],
maxSteps :: Integer,
trace :: Bool
} deriving (Show, Ord, Eq)
defaultFlags = Flags{
initialTape = [],
maxSteps = 0,
trace = False
}
-- Note: this is a terrible little hack
splitOnCommas s =
words [if c == ',' then ' ' else c|c <- s]
-- | Parses the flags accepted by 'simulate'.
parseFlags flags ("--initial-tape":s:rest) =
parseFlags flags{ initialTape = splitOnCommas s } rest
parseFlags flags ("--max-steps":n:rest) =
parseFlags flags{ maxSteps = read n } rest
parseFlags flags ("--trace":rest) =
parseFlags flags{ trace = True } rest
parseFlags flags other = (flags, other)
compileTo :: String -> ([TMRule] -> String)
compileTo "ir-dump" = compileToIRDump
compileTo "turmac" = compileToTurmac
compileTo "python" = compileToPython
compileTo other = error $ "Unknown backend: " ++ show other ++ "; must be one of: 'ir-dump', 'turmac', or 'python'"
--
-- Driver
--
main = do
args <- getArgs
case args of
("--version":_) -> do
putStrLn "turmac 0.4"
exitWith ExitSuccess
("simulate":rest) -> do
let (flags, args') = parseFlags defaultFlags rest
case args' of
[fileName] -> do
turmacText <- readFile fileName
let tmRules = parseRules turmacText
config = initConfigurationWithInput (initialTape flags)
(configs, finalConfig) = simulate tmRules config
case trace flags of
True -> do
putStr $ renderTrace configs
False -> do
putStr $ renderConfig (-1) finalConfig
exitWith ExitSuccess
_ -> usage
["compile", backendName, fileName] -> do
turmacText <- readFile fileName
let tmRules = parseRules turmacText
putStr $ compileTo backendName tmRules
exitWith ExitSuccess
["check-complete", fileName] -> do
turmacText <- readFile fileName
let tmRules = parseRules turmacText
case checkComplete tmRules of
Left _ -> do
error "Incomplete Turmac description"
Right _ -> do
exitWith ExitSuccess
["check-deterministic", fileName] -> do
turmacText <- readFile fileName
let tmRules = parseRules turmacText
case checkDeterministic tmRules of
Left _ -> do
error "Nondeterministic Turmac description"
Right _ -> do
exitWith ExitSuccess
["normalize", fileName] -> do
turmacText <- readFile fileName
let tmRules = parseRules turmacText
case checkComplete tmRules of
Left _ -> do
error "Incomplete Turmac description"
Right tmRules' -> do
let normalizedRules = normalizeRules tmRules'
putStr $ compileToTurmac normalizedRules
exitWith ExitSuccess
["gentape", tapeContents] -> do
let symbols = splitOnCommas tapeContents
tmRules = generateTapeWriter symbols
putStr $ compileToTurmac tmRules
exitWith ExitSuccess
_ -> usage
usage = do
putStrLn "Usage: turmac simulate {flags} <turmac-description-file>"
putStrLn " turmac compile <backend> <turmac-description-file>"
putStrLn " turmac check-complete <turmac-description-file>"
putStrLn " turmac check-deterministic <turmac-description-file>"
putStrLn " turmac normalize <turmac-description-file>"
putStrLn " turmac gentape <comma-separated-list-of-symbols>"
putStrLn " where flags (for simulate) are:"
putStrLn " --initial-tape gives initial contents of tape"
putStrLn " --trace display each step taken"
exitWith $ ExitFailure 2