mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 03:32:51 -06:00
prompt and CPU time in experimental shell
This commit is contained in:
@@ -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
|
||||||
|
}
|
||||||
|
|||||||
@@ -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 ()
|
||||||
|
|||||||
@@ -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)))]
|
||||||
|
|||||||
Reference in New Issue
Block a user