forked from GitHub/gf-core
GF shell: create a PGF also when the -retain flag is used
The commands available in the shell after import -retain are now a superset of the commands available after import without -retain. The PGF is created lazily, so there should be no performance penalty if the PGF isn't needed. If there are errors, they won't be reported until a command that uses the PGF is entered.
This commit is contained in:
@@ -11,7 +11,7 @@ module GF.Infra.SIO(
|
|||||||
newStdGen,print,putStrLn,
|
newStdGen,print,putStrLn,
|
||||||
-- ** Specific to GF
|
-- ** Specific to GF
|
||||||
importGrammar,importSource,
|
importGrammar,importSource,
|
||||||
putStrLnFlush,runInterruptibly,
|
putStrLnFlush,runInterruptibly,lazySIO,
|
||||||
-- * Restricted accesss to arbitrary (potentially unsafe) IO operations
|
-- * Restricted accesss to arbitrary (potentially unsafe) IO operations
|
||||||
-- | If the environment variable GF_RESTRICTED is defined, these
|
-- | If the environment variable GF_RESTRICTED is defined, these
|
||||||
-- operations will fail. Otherwise, they will be executed normally.
|
-- operations will fail. Otherwise, they will be executed normally.
|
||||||
@@ -26,6 +26,7 @@ import GF.System.Catch(try)
|
|||||||
import System.Process(system)
|
import System.Process(system)
|
||||||
import System.Environment(getEnv)
|
import System.Environment(getEnv)
|
||||||
import Control.Concurrent.Chan(newChan,writeChan,getChanContents)
|
import Control.Concurrent.Chan(newChan,writeChan,getChanContents)
|
||||||
|
import GF.Infra.Concurrency(lazyIO)
|
||||||
import qualified System.CPUTime as IO(getCPUTime)
|
import qualified System.CPUTime as IO(getCPUTime)
|
||||||
import qualified System.Directory as IO(getCurrentDirectory)
|
import qualified System.Directory as IO(getCurrentDirectory)
|
||||||
import qualified System.Random as IO(newStdGen)
|
import qualified System.Random as IO(newStdGen)
|
||||||
@@ -91,6 +92,7 @@ getCurrentDirectory = lift0 IO.getCurrentDirectory
|
|||||||
getLibraryDirectory = lift0 . IO.getLibraryDirectory
|
getLibraryDirectory = lift0 . IO.getLibraryDirectory
|
||||||
newStdGen = lift0 IO.newStdGen
|
newStdGen = lift0 IO.newStdGen
|
||||||
runInterruptibly = lift1 IO.runInterruptibly
|
runInterruptibly = lift1 IO.runInterruptibly
|
||||||
|
lazySIO = lift1 lazyIO
|
||||||
|
|
||||||
importGrammar pgf opts files = lift0 $ GF.importGrammar pgf opts files
|
importGrammar pgf opts files = lift0 $ GF.importGrammar pgf opts files
|
||||||
importSource src opts files = lift0 $ GF.importSource src opts files
|
importSource src opts files = lift0 $ GF.importSource src opts files
|
||||||
|
|||||||
@@ -355,15 +355,21 @@ importInEnv :: GFEnv -> Options -> [FilePath] -> SIO GFEnv
|
|||||||
importInEnv gfenv opts files
|
importInEnv gfenv opts files
|
||||||
| flag optRetainResource opts =
|
| flag optRetainResource opts =
|
||||||
do src <- importSource (grammar gfenv) opts files
|
do src <- importSource (grammar gfenv) opts files
|
||||||
return $ gfenv {grammar = src}
|
pgf <- lazySIO importPGF -- duplicates some work, better to link src
|
||||||
|
return $ gfenv {grammar = src, commandenv = mkCommandEnv pgf}
|
||||||
| otherwise =
|
| otherwise =
|
||||||
do let opts' = addOptions (setOptimization OptCSE False) opts
|
do pgf1 <- importPGF
|
||||||
pgf0 = multigrammar (commandenv gfenv)
|
|
||||||
pgf1 <- importGrammar pgf0 opts' files
|
|
||||||
if (verbAtLeast opts Normal)
|
|
||||||
then putStrLnFlush $ unwords $ "\nLanguages:" : map showCId (languages pgf1)
|
|
||||||
else done
|
|
||||||
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
||||||
|
where
|
||||||
|
importPGF =
|
||||||
|
do let opts' = addOptions (setOptimization OptCSE False) opts
|
||||||
|
pgf0 = multigrammar (commandenv gfenv)
|
||||||
|
pgf1 <- importGrammar pgf0 opts' files
|
||||||
|
if (verbAtLeast opts Normal)
|
||||||
|
then putStrLnFlush $
|
||||||
|
unwords $ "\nLanguages:" : map showCId (languages pgf1)
|
||||||
|
else done
|
||||||
|
return pgf1
|
||||||
|
|
||||||
tryGetLine = do
|
tryGetLine = do
|
||||||
res <- try getLine
|
res <- try getLine
|
||||||
|
|||||||
Reference in New Issue
Block a user