mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
force the interpreter to flush the output. usefull for the testsuite
This commit is contained in:
@@ -11,6 +11,7 @@ import PGF
|
|||||||
import PGF.Data
|
import PGF.Data
|
||||||
import PGF.Macros
|
import PGF.Macros
|
||||||
import GF.System.Signal
|
import GF.System.Signal
|
||||||
|
import GF.Infra.UseIO
|
||||||
|
|
||||||
import GF.Data.ErrM ----
|
import GF.Data.ErrM ----
|
||||||
|
|
||||||
@@ -30,13 +31,13 @@ interpretCommandLine env line =
|
|||||||
Just [] -> return ()
|
Just [] -> return ()
|
||||||
Just pipes -> do res <- runInterruptibly (mapM_ interPipe pipes)
|
Just pipes -> do res <- runInterruptibly (mapM_ interPipe pipes)
|
||||||
case res of
|
case res of
|
||||||
Left ex -> print ex
|
Left ex -> putStrLnFlush (show ex)
|
||||||
Right x -> return x
|
Right x -> return x
|
||||||
Nothing -> putStrLn "command not parsed"
|
Nothing -> putStrLnFlush "command not parsed"
|
||||||
where
|
where
|
||||||
interPipe cs = do
|
interPipe cs = do
|
||||||
(_,s) <- intercs ([],"") cs
|
(_,s) <- intercs ([],"") cs
|
||||||
putStrLn s
|
putStrLnFlush s
|
||||||
intercs treess [] = return treess
|
intercs treess [] = return treess
|
||||||
intercs (trees,_) (c:cs) = do
|
intercs (trees,_) (c:cs) = do
|
||||||
treess2 <- interc trees c
|
treess2 <- interc trees c
|
||||||
|
|||||||
@@ -41,7 +41,7 @@ loop opts gfenv0 = do
|
|||||||
s <- fetchCommand (prompt env)
|
s <- fetchCommand (prompt env)
|
||||||
let gfenv = gfenv0 {history = s : history gfenv0}
|
let gfenv = gfenv0 {history = s : history gfenv0}
|
||||||
let loopNewCPU gfenv' = do cpu' <- getCPUTime
|
let loopNewCPU gfenv' = do cpu' <- getCPUTime
|
||||||
putStrLn (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
|
putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
|
||||||
loop opts $ gfenv' {cputime = cpu'}
|
loop opts $ gfenv' {cputime = cpu'}
|
||||||
case words s of
|
case words s of
|
||||||
-- special commands, requiring source grammar in env
|
-- special commands, requiring source grammar in env
|
||||||
@@ -78,7 +78,7 @@ importInEnv gfenv opts files
|
|||||||
do let opts' = addOptions (setOptimization OptCSE False) opts
|
do let opts' = addOptions (setOptimization OptCSE False) opts
|
||||||
pgf0 = multigrammar (commandenv gfenv)
|
pgf0 = multigrammar (commandenv gfenv)
|
||||||
pgf1 <- importGrammar pgf0 opts' files
|
pgf1 <- importGrammar pgf0 opts' files
|
||||||
putStrLn $ unwords $ "\nLanguages:" : languages pgf1
|
putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
|
||||||
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
||||||
|
|
||||||
welcome = unlines [
|
welcome = unlines [
|
||||||
|
|||||||
Reference in New Issue
Block a user