git @ Cat's Eye Technologies Turmac / master src / Main.hs
master

Tree @master (Download .tar.gz)

Main.hs @master — raw · history · blame

-- 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