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 Just i -> if i >= length args then error ("Invalid use of " ++ tgt) else fun (args !! (i + 1)) -- fun (args !! (i + 1)) Nothing -> def 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 Just raw -> case trimSlash raw of "" -> error ("Invalid use of " ++ raw) ok -> Just ok Nothing -> Nothing 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. bindss <- mkTargetBindss 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 bindss) putStrLn $ "binds: " ++ show (length bindss) -- 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 file. Just dir -> do let locs = injDumpLocs entry (length ldss) dir putStrLn $ show (length ldss) mapM_ (\(fp, lds) -> writePrettyState fp lds) (zip locs ldss) -- Dump to terminal. Nothing -> mapM_ (putStrLn . pprLivesDeadsStr) ldss