module Picologic.Repl ( repl, stdin, file, runRepl, ) where import Picologic.AST import Picologic.Parser import Picologic.Solver import Picologic.Pretty import Text.PrettyPrint import Control.Monad.State import Data.List (isPrefixOf) import System.Console.Haskeline ------------------------------------------------------------------------------- -- REPL ------------------------------------------------------------------------------- type Repl = StateT IState (InputT IO) data IState = IState { _module :: Maybe Expr , _curFile :: Maybe FilePath } initState :: IState initState = IState Nothing Nothing preamble :: Repl () preamble = liftIO $ do putStrLn "Picologic 0.1" putStrLn "Type :help for help" runRepl :: Repl a -> IO IState runRepl f = runInputT defaultSettings (execStateT (preamble >> f) initState) ------------------------------------------------------------------------------- -- Commands ------------------------------------------------------------------------------- load :: String -> Repl () load arg = do liftIO $ putStrLn $ "Loading " ++ arg file arg modify $ \s -> s { _curFile = Just arg } reload :: Repl () reload = do fname <- gets _curFile case fname of Just fname' -> handleCommand "load" [fname'] Nothing -> liftIO $ putStrLn "No such file" run :: Repl () run = do mod <- gets _module case mod of Nothing -> liftIO $ putStrLn "No expression." Just ex -> liftIO $ do sols <- solveProp ex putStrLn "Solutions:" putStrLn (ppSolutions sols) clauses :: Repl () clauses = do env <- gets _module case env of Just ex -> liftIO $ print (clausesExpr ex) Nothing -> liftIO $ putStrLn "No file loaded." help :: Repl () help = liftIO $ do putStrLn ":clauses Show the SAT solver clauses" putStrLn ":load Load a program from file" ------------------------------------------------------------------------------- -- Test ------------------------------------------------------------------------------- -- evaluate a module modl :: FilePath -> Repl () modl fname = do mod <- liftIO $ parseFile fname case mod of Left err -> liftIO $ print err Right res -> let ex = (simp . cnf $ res) in modify $ \s -> s { _module = Just ex } -- evaluate an expression exec :: String -> Repl () exec source = do let mod = parseExpr source case mod of Left err -> liftIO $ print err Right res -> do let ex = (simp . cnf $ res) liftIO $ putStrLn (render $ ppExprU ex) liftIO $ do sols <- solveProp ex putStrLn "Solutions:" putStrLn (ppSolutions sols) modify $ \s -> s { _module = Just ex } file :: FilePath -> Repl () file fname = modl fname stdin :: IO () stdin = do contents <- getContents case parseExpr contents of Left err -> print err Right ex -> do sols <- solveProp ex putStrLn (ppSolutions sols) handleCommand :: String -> [String] -> Repl () handleCommand cmd args | "ru" `isPrefixOf` cmd = run | "r" `isPrefixOf` cmd = reload | "cl" `isPrefixOf` cmd = clauses | "h" `isPrefixOf` cmd = help | length args == 0 = liftIO $ putStrLn "Not enough arguments" | "l" `isPrefixOf` cmd = load arg | otherwise = liftIO $ putStrLn "Unknown command" where arg = head args repl :: Repl () repl = do minput <- lift $ getInputLine "Logic> " case minput of Nothing -> lift $ outputStrLn "Goodbye." Just (':' : cmds) -> do let (cmd:args) = words cmds handleCommand cmd args repl Just input -> do exec input repl