SSTG-0.1.1.2: app/Main.hs

module Main where

import SSTG

import qualified Data.Char as C
import qualified Data.List as L
import qualified Data.Map  as M

import System.Environment
import Text.Read

trim :: String -> String
trim = L.dropWhileEnd C.isSpace . L.dropWhile C.isSpace

trimSlash :: String -> String
trimSlash str = case trim str of
    ""      -> ""
    trimmed -> case last trimmed of 
        '/' -> trimSlash (init trimmed)
        _   -> trimmed

matchArg :: String -> [String] -> (String -> a) -> a -> a
matchArg tgt args fun def = case L.elemIndex tgt args of
    Nothing -> def
    Just i  -> if i >= length args
                   then error ("Invalid use of " ++ tgt)
                   else fun (args !! (i + 1)) -- fun (args !! (i + 1))

parseStepCount :: [String] -> Int
parseStepCount args = matchArg "--n" args read 200

parseStepType :: [String] -> StepType
parseStepType args = case matched of { Just t -> t; Nothing -> BFS }
  where matched = matchArg "--method" args (\a -> M.lookup a types) Nothing
        types = M.fromList [ ("bfs",     BFS)
                           , ("bfs-log", BFSLogged)
                           , ("dfs",     DFS)
                           , ("dfs-log", DFSLogged) ]

parseDumpDir :: [String] -> Maybe FilePath
parseDumpDir args = case matchArg "--dump" args (readMaybe . show) Nothing of
    Nothing  -> Nothing
    Just raw -> case trimSlash raw of
                    "" -> error ("Invalid use of " ++ raw)
                    ok -> Just ok

parseFlags :: [String] -> RunFlags
parseFlags args = RunFlags { flag_step_count = parseStepCount args
                           , flag_step_type  = parseStepType  args
                           , flag_dump_dir   = parseDumpDir   args }

injDumpLocs :: String -> Int -> FilePath -> [FilePath]
injDumpLocs entry n dir = map (\i -> start ++ (show i) ++ ".txt") [1..n]
  where start = dir ++ "/" ++ entry

main :: IO ()
main = do
    -- Get command line arguments.
    (proj:src:tail_args) <- getArgs
    -- Make bindings.
    binds <- mkTargetBinds proj src
    -- Configure entry.
    let entry = if length tail_args > 0 then tail_args !! 0 else "main"
    -- Get the flags.
    let flags = parseFlags tail_args
    -- Do the loading.
    let load_result = loadStateEntry entry (Program binds)
    putStrLn $ "binds: " ++ show (length binds)
    -- Get the state from the loader.
    state <- case load_result of
                 LoadError str         -> error str
                 LoadOkay state        -> return state
                 LoadGuess state cands -> do
                    putStrLn "Other possible candidates:"
                    putStrLn $ show cands
                    return state
    putStrLn $ show flags
    -- Execution!
    let ldss  = execute flags state
    case flag_dump_dir flags of
        -- Dump to terminal.
        Nothing  -> mapM_ (putStrLn . pprLivesDeadsStr) ldss
        -- Dump to file.
        Just dir -> do
            let locs = injDumpLocs entry (length ldss) dir
            putStrLn $ show (length ldss)
            mapM_ (\(fp, lds) -> writePrettyState fp lds) (zip locs ldss)