mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
Refactor GFI to treat command line files and the i command uniformly. Disable CSE by default in GFI.
This commit is contained in:
@@ -14,6 +14,7 @@ import System.FilePath
|
|||||||
|
|
||||||
-- import a grammar in an environment where it extends an existing grammar
|
-- import a grammar in an environment where it extends an existing grammar
|
||||||
importGrammar :: PGF -> Options -> [FilePath] -> IO PGF
|
importGrammar :: PGF -> Options -> [FilePath] -> IO PGF
|
||||||
|
importGrammar pgf0 _ [] = return pgf0
|
||||||
importGrammar pgf0 opts files =
|
importGrammar pgf0 opts files =
|
||||||
case takeExtensions (last files) of
|
case takeExtensions (last files) of
|
||||||
s | elem s [".gf",".gfo"] -> do
|
s | elem s [".gf",".gfo"] -> do
|
||||||
|
|||||||
@@ -1,5 +1,6 @@
|
|||||||
module GF.Command.Interpreter (
|
module GF.Command.Interpreter (
|
||||||
CommandEnv (..),
|
CommandEnv (..),
|
||||||
|
mkCommandEnv,
|
||||||
interpretCommandLine
|
interpretCommandLine
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@@ -21,6 +22,9 @@ data CommandEnv = CommandEnv {
|
|||||||
commands :: Map.Map String CommandInfo
|
commands :: Map.Map String CommandInfo
|
||||||
}
|
}
|
||||||
|
|
||||||
|
mkCommandEnv :: PGF -> CommandEnv
|
||||||
|
mkCommandEnv pgf = CommandEnv pgf (allCommands pgf)
|
||||||
|
|
||||||
interpretCommandLine :: CommandEnv -> String -> IO ()
|
interpretCommandLine :: CommandEnv -> String -> IO ()
|
||||||
interpretCommandLine env line = case (pCommandLine (myLexer line)) of
|
interpretCommandLine env line = case (pCommandLine (myLexer line)) of
|
||||||
Ok CEmpty -> return ()
|
Ok CEmpty -> return ()
|
||||||
|
|||||||
@@ -20,36 +20,34 @@ import Paths_gf
|
|||||||
mainGFI :: Options -> [FilePath] -> IO ()
|
mainGFI :: Options -> [FilePath] -> IO ()
|
||||||
mainGFI opts files = do
|
mainGFI opts files = do
|
||||||
putStrLn welcome
|
putStrLn welcome
|
||||||
env <- importInEnv emptyPGF opts files
|
gfenv <- importInEnv emptyGFEnv opts files
|
||||||
loop (GFEnv emptyGrammar env [] 0)
|
loop opts gfenv
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
loop :: GFEnv -> IO GFEnv
|
loop :: Options -> GFEnv -> IO GFEnv
|
||||||
loop gfenv0 = do
|
loop opts gfenv0 = do
|
||||||
let env = commandenv gfenv0
|
let env = commandenv gfenv0
|
||||||
let sgr = sourcegrammar gfenv0
|
let sgr = sourcegrammar gfenv0
|
||||||
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
|
||||||
|
putStrLn (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
|
||||||
|
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
|
||||||
"cc":ws -> do
|
"cc":ws -> do
|
||||||
-- FIXME: add options parsing for cc arguments
|
-- FIXME: add options parsing for cc arguments
|
||||||
let (opts,term) = (TermPrintDefault, ws)
|
let (style,term) = (TermPrintDefault, ws)
|
||||||
case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of ---- make pipable
|
case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of ---- make pipable
|
||||||
Ok x -> putStrLn (showTerm opts x)
|
Ok x -> putStrLn (showTerm style x)
|
||||||
Bad s -> putStrLn s
|
Bad s -> putStrLn s
|
||||||
loopNewCPU gfenv
|
loopNewCPU gfenv
|
||||||
"i":args -> do
|
"i":args -> do
|
||||||
case parseOptions args of
|
gfenv' <- case parseOptions args of
|
||||||
Ok (opts,files)
|
Ok (opts',files) -> importInEnv gfenv (addOptions opts opts') files
|
||||||
| flag optRetainResource opts ->
|
Bad err -> do putStrLn $ "Command parse error: " ++ err
|
||||||
do src <- importSource sgr opts files
|
return gfenv
|
||||||
loopNewCPU $ gfenv {sourcegrammar = src}
|
loopNewCPU gfenv
|
||||||
| otherwise ->
|
|
||||||
do env1 <- importInEnv (multigrammar env) opts files
|
|
||||||
loopNewCPU $ gfenv {commandenv = env1}
|
|
||||||
Bad err -> do putStrLn $ "Command parse error: " ++ err
|
|
||||||
loopNewCPU gfenv
|
|
||||||
|
|
||||||
-- other special commands, working on GFEnv
|
-- other special commands, working on GFEnv
|
||||||
"e":_ -> loopNewCPU $ gfenv {commandenv=env{multigrammar=emptyPGF}}
|
"e":_ -> loopNewCPU $ gfenv {commandenv=env{multigrammar=emptyPGF}}
|
||||||
@@ -61,19 +59,17 @@ loop gfenv0 = do
|
|||||||
interpretCommandLine env s
|
interpretCommandLine env s
|
||||||
loopNewCPU gfenv
|
loopNewCPU gfenv
|
||||||
|
|
||||||
loopNewCPU gfenv = do
|
importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv
|
||||||
cpu' <- getCPUTime
|
importInEnv gfenv opts files
|
||||||
putStrLn (show ((cpu' - cputime gfenv) `div` 1000000000) ++ " msec")
|
| flag optRetainResource opts =
|
||||||
loop $ gfenv {cputime = cpu'}
|
do src <- importSource (sourcegrammar gfenv) opts files
|
||||||
|
return $ gfenv {sourcegrammar = src}
|
||||||
importInEnv :: PGF -> Options -> [FilePath] -> IO CommandEnv
|
| otherwise =
|
||||||
importInEnv pgf0 opts files = do
|
do let opts' = addOptions (setOptimization OptCSE False) opts
|
||||||
pgf1 <- case files of
|
pgf0 = multigrammar (commandenv gfenv)
|
||||||
[] -> return pgf0
|
pgf1 <- importGrammar pgf0 opts' files
|
||||||
_ -> importGrammar pgf0 opts files
|
putStrLn $ unwords $ "\nLanguages:" : languages pgf1
|
||||||
let env = CommandEnv pgf1 (allCommands pgf1)
|
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
||||||
putStrLn $ unwords $ "\nLanguages:" : languages pgf1
|
|
||||||
return env
|
|
||||||
|
|
||||||
welcome = unlines [
|
welcome = unlines [
|
||||||
" ",
|
" ",
|
||||||
@@ -103,3 +99,6 @@ data GFEnv = GFEnv {
|
|||||||
history :: [String],
|
history :: [String],
|
||||||
cputime :: Integer
|
cputime :: Integer
|
||||||
}
|
}
|
||||||
|
|
||||||
|
emptyGFEnv :: GFEnv
|
||||||
|
emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] 0
|
||||||
|
|||||||
Reference in New Issue
Block a user