prompt and CPU time in experimental shell

This commit is contained in:
aarne
2007-11-06 17:27:20 +00:00
parent 2b1d5a4d51
commit 2c4d34af28
3 changed files with 29 additions and 6 deletions

View File

@@ -5,6 +5,8 @@ import GF.Command.Importing
import GF.Command.Commands import GF.Command.Commands
import GF.GFCC.API import GF.GFCC.API
import GF.Devel.UseIO
import GF.Devel.Arch
import GF.Infra.Option ---- Haskell's option lib import GF.Infra.Option ---- Haskell's option lib
import System (getArgs) import System (getArgs)
@@ -14,20 +16,27 @@ main = do
putStrLn welcome putStrLn welcome
xx <- getArgs xx <- getArgs
env <- importInEnv emptyMultiGrammar xx env <- importInEnv emptyMultiGrammar xx
loop env loop (GFEnv env [] 0)
return () return ()
loop :: CommandEnv -> IO CommandEnv loop :: GFEnv -> IO GFEnv
loop env = do loop gfenv0 = do
let env = commandenv gfenv0
putStrFlush (prompt env)
s <- getLine s <- getLine
let gfenv = gfenv0 {history = s : history gfenv0}
case words s of case words s of
"q":_ -> return env "q":_ -> return gfenv
"i":args -> do "i":args -> do
env1 <- importInEnv (multigrammar env) args env1 <- importInEnv (multigrammar env) args
loop env1 loopNewCPU $ gfenv {commandenv = env1}
_ -> do _ -> do
interpretCommandLine env s interpretCommandLine env s
loop env loopNewCPU gfenv
loopNewCPU gfenv = do
cpu <- prCPU $ cputime gfenv
loop $ gfenv {cputime = cpu}
importInEnv mgr0 xx = do importInEnv mgr0 xx = do
let (opts,files) = getOptions "-" xx let (opts,files) = getOptions "-" xx
@@ -42,3 +51,11 @@ welcome = unlines [
"This is GF version 3.0 alpha.", "This is GF version 3.0 alpha.",
"Some things may work." "Some things may work."
] ]
prompt env = abstractName (multigrammar env) ++ "> "
data GFEnv = GFEnv {
commandenv :: CommandEnv,
history :: [String],
cputime :: Integer
}

View File

@@ -23,6 +23,7 @@ import System.Directory
import System.IO import System.IO
import System.IO.Error import System.IO.Error
import System.Environment import System.Environment
import System.CPUTime
import Control.Monad import Control.Monad
putShow' :: Show a => (c -> a) -> c -> IO () putShow' :: Show a => (c -> a) -> c -> IO ()

View File

@@ -112,6 +112,11 @@ readTree _ = pTree
showTree = prExp showTree = prExp
prIdent :: CId -> String
prIdent (CId s) = s
abstractName mgr = prIdent (absname (gfcc mgr))
languages mgr = [l | CId l <- cncnames (gfcc mgr)] languages mgr = [l | CId l <- cncnames (gfcc mgr)]
categories mgr = [c | CId c <- Map.keys (cats (abstract (gfcc mgr)))] categories mgr = [c | CId c <- Map.keys (cats (abstract (gfcc mgr)))]