From: Anders Mörtberg Date: Mon, 4 May 2015 23:55:08 +0000 (+0200) Subject: Add -t flag X-Git-Url: https://git.ak3n.com/?a=commitdiff_plain;h=55d5e6193250096f2059fb106f63a1829e1224d9;p=cubicaltt.git Add -t flag --- diff --git a/Main.hs b/Main.hs index 0dee3c0..f36f6ba 100644 --- a/Main.hs +++ b/Main.hs @@ -4,12 +4,14 @@ import Control.Monad.Reader import Control.Monad.Except import Control.Exception (try) import Data.List +import Data.Time import System.Directory import System.FilePath import System.Environment import System.Console.GetOpt import System.Console.Haskeline import System.Console.Haskeline.History +import Text.Printf import Exp.Lex import Exp.Par @@ -26,13 +28,14 @@ import qualified Eval as E type Interpreter a = InputT IO a -- Flag handling -data Flag = Debug | Help | Version +data Flag = Debug | Help | Version | Time deriving (Eq,Show) options :: [OptDescr Flag] -options = [ Option "d" ["debug"] (NoArg Debug) "run in debugging mode" - , Option "" ["help"] (NoArg Help) "print help" - , Option "" ["version"] (NoArg Version) "print version number" ] +options = [ Option "d" ["debug"] (NoArg Debug) "run in debugging mode" + , Option "" ["help"] (NoArg Help) "print help" + , Option "-t" ["time"] (NoArg Time) "measure time spent computing" + , Option "" ["version"] (NoArg Version) "print version number" ] -- Version number, welcome message, usage and prompt strings version, welcome, usage, prompt :: String @@ -130,11 +133,24 @@ loop flags f names tenv = do Left err -> do outputStrLn ("Could not type-check: " ++ err) loop flags f names tenv Right _ -> do + start <- liftIO getCurrentTime let e = mod $ E.eval (TC.env tenv) body + -- Let's not crash if the evaluation raises an error: liftIO $ catch (putStrLn (msg ++ show e)) (\e -> putStrLn ("Exception: " ++ show (e :: SomeException))) + stop <- liftIO getCurrentTime + -- Compute time and print nicely + let time = diffUTCTime stop start + secs = read (takeWhile (/='.') (init (show time))) + rest = read ('0':dropWhile (/='.') (init (show time))) + mins = secs `quot` 60 + sec = printf "%.3f" (fromInteger (secs `rem` 60) + rest :: Float) + when (Time `elem` flags) $ + outputStrLn $ "Time: " ++ show mins ++ "m" ++ sec ++ "s" + -- Only print in seconds: + -- when (Time `elem` flags) $ outputStrLn $ "Time: " ++ show time loop flags f names tenv -- (not ok,loaded,already loaded defs) -> to load ->