add command "import -resource"

This commit is contained in:
krangelov
2021-12-24 14:46:07 +01:00
parent cb10e2fe32
commit 39853b3c04
4 changed files with 28 additions and 31 deletions

View File

@@ -6,7 +6,7 @@ import PGF2.Transactions
import GF.Compile import GF.Compile
import GF.Compile.Multi (readMulti) import GF.Compile.Multi (readMulti)
import GF.Compile.GetGrammar (getBNFCRules, getEBNFRules) import GF.Compile.GetGrammar (getBNFCRules, getEBNFRules)
import GF.Grammar (SourceGrammar) -- for cc command import GF.Grammar (ModuleName,SourceGrammar) -- for cc command
import GF.Grammar.BNFC import GF.Grammar.BNFC
import GF.Grammar.EBNF import GF.Grammar.EBNF
import GF.Grammar.CFG import GF.Grammar.CFG
@@ -67,8 +67,8 @@ importPGF opts Nothing f
| otherwise = fmap Just (readPGF f) | otherwise = fmap Just (readPGF f)
importPGF opts (Just pgf) f = fmap Just (modifyPGF pgf (mergePGF f)) importPGF opts (Just pgf) f = fmap Just (modifyPGF pgf (mergePGF f))
importSource :: Options -> [FilePath] -> IO SourceGrammar importSource :: Options -> [FilePath] -> IO (ModuleName,SourceGrammar)
importSource opts files = fmap (snd.snd) (batchCompile opts files) importSource opts files = fmap snd (batchCompile opts files)
-- for different cf formats -- for different cf formats
importCF opts files get convert = impCF importCF opts files get convert = impCF

View File

@@ -4,7 +4,7 @@ module GF.Infra.Option
-- *** Option types -- *** Option types
Options, Options,
Flags(..), Flags(..),
Mode(..), Phase(..), Verbosity(..), Mode(..), Phase(..), Verbosity(..), RetainMode(..),
OutputFormat(..), OutputFormat(..),
SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..), SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..),
Dump(..), Pass(..), Recomp(..), Dump(..), Pass(..), Recomp(..),
@@ -146,6 +146,9 @@ data Pass = Source | Rebuild | Extend | Rename | TypeCheck | Refresh | Optimize
data Recomp = AlwaysRecomp | RecompIfNewer | NeverRecomp data Recomp = AlwaysRecomp | RecompIfNewer | NeverRecomp
deriving (Show,Eq,Ord) deriving (Show,Eq,Ord)
data RetainMode = RetainAll | RetainSource | RetainCompiled
deriving Show
data Flags = Flags { data Flags = Flags {
optMode :: Mode, optMode :: Mode,
optStopAfterPhase :: Phase, optStopAfterPhase :: Phase,
@@ -164,7 +167,7 @@ data Flags = Flags {
optDocumentRoot :: Maybe FilePath, -- For --server mode optDocumentRoot :: Maybe FilePath, -- For --server mode
optRecomp :: Recomp, optRecomp :: Recomp,
optProbsFile :: Maybe FilePath, optProbsFile :: Maybe FilePath,
optRetainResource :: Bool, optRetainResource :: RetainMode,
optName :: Maybe String, optName :: Maybe String,
optPreprocessors :: [String], optPreprocessors :: [String],
optEncoding :: Maybe String, optEncoding :: Maybe String,
@@ -185,7 +188,7 @@ data Flags = Flags {
optPlusAsBind :: Bool, optPlusAsBind :: Bool,
optJobs :: Maybe (Maybe Int) optJobs :: Maybe (Maybe Int)
} }
deriving (Show) deriving Show
newtype Options = Options (Flags -> Flags) newtype Options = Options (Flags -> Flags)
@@ -274,7 +277,7 @@ defaultFlags = Flags {
optDocumentRoot = Nothing, optDocumentRoot = Nothing,
optRecomp = RecompIfNewer, optRecomp = RecompIfNewer,
optProbsFile = Nothing, optProbsFile = Nothing,
optRetainResource = False, optRetainResource = RetainCompiled,
optName = Nothing, optName = Nothing,
optPreprocessors = [], optPreprocessors = [],
@@ -352,7 +355,8 @@ optDescr =
"(default) Recompile from source if the source is newer than the .gfo file.", "(default) Recompile from source if the source is newer than the .gfo file.",
Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp)) Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp))
"Never recompile from source, if there is already .gfo file.", "Never recompile from source, if there is already .gfo file.",
Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = True })) "Retain opers.", Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = RetainAll })) "Retain the source and well as the compiled grammar.",
Option [] ["resource"] (NoArg (set $ \o -> o { optRetainResource = RetainSource })) "Load the source grammar as a resource only.",
Option [] ["probs"] (ReqArg probsFile "file.probs") "Read probabilities from file.", Option [] ["probs"] (ReqArg probsFile "file.probs") "Read probabilities from file.",
Option ['n'] ["name"] (ReqArg name "NAME") Option ['n'] ["name"] (ReqArg name "NAME")
(unlines ["Use NAME as the name of the output. This is used in the output file names, ", (unlines ["Use NAME as the name of the output. This is used in the output file names, ",

View File

@@ -11,8 +11,8 @@ module GF.Infra.SIO(
getCPUTime,getCurrentDirectory,getLibraryDirectory, getCPUTime,getCurrentDirectory,getLibraryDirectory,
newStdGen,print,putStr,putStrLn, newStdGen,print,putStr,putStrLn,
-- ** Specific to GF -- ** Specific to GF
importGrammar,importSource, importGrammar,importSource, link,
putStrLnFlush,runInterruptibly,lazySIO, putStrLnFlush,runInterruptibly,
modifyPGF, checkoutPGF, modifyPGF, checkoutPGF,
-- * 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
@@ -30,7 +30,6 @@ 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 GF.Infra.UseIO(Output(..)) import GF.Infra.UseIO(Output(..))
import GF.Data.Operations(ErrorMonad(..)) import GF.Data.Operations(ErrorMonad(..))
import qualified System.CPUTime as IO(getCPUTime) import qualified System.CPUTime as IO(getCPUTime)
@@ -39,6 +38,7 @@ import qualified System.Random as IO(newStdGen)
import qualified GF.Infra.UseIO as IO(getLibraryDirectory) import qualified GF.Infra.UseIO as IO(getLibraryDirectory)
import qualified GF.System.Signal as IO(runInterruptibly) import qualified GF.System.Signal as IO(runInterruptibly)
import qualified GF.Command.Importing as GF(importGrammar, importSource) import qualified GF.Command.Importing as GF(importGrammar, importSource)
import qualified GF.Compile as GF(link)
import qualified Control.Monad.Fail as Fail import qualified Control.Monad.Fail as Fail
import qualified PGF2.Transactions as PGFT import qualified PGF2.Transactions as PGFT
import Control.Exception import Control.Exception
@@ -130,10 +130,10 @@ 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 opts files = lift0 $ GF.importSource opts files importSource opts files = lift0 $ GF.importSource opts files
link opts pgf src = lift0 $ GF.link opts pgf src
modifyPGF gr t = lift0 (PGFT.modifyPGF gr t) modifyPGF gr t = lift0 (PGFT.modifyPGF gr t)
checkoutPGF gr b = lift0 (PGFT.checkoutPGF gr b) checkoutPGF gr b = lift0 (PGFT.checkoutPGF gr b)

View File

@@ -169,11 +169,6 @@ execute1' s0 =
system_command ws = do lift $ restrictedSystem $ unwords ws ; continue system_command ws = do lift $ restrictedSystem $ unwords ws ; continue
{-"eh":w:_ -> do
cs <- readFile w >>= return . map words . lines
gfenv' <- foldM (flip (process False benv)) gfenv cs
loopNewCPU gfenv' -}
execute_history [w] = execute_history [w] =
do execute . lines =<< lift (restricted (readFile w)) do execute . lines =<< lift (restricted (readFile w))
continue continue
@@ -349,13 +344,14 @@ fetchCommand gfenv = do
importInEnv :: Options -> [FilePath] -> ShellM () importInEnv :: Options -> [FilePath] -> ShellM ()
importInEnv opts files = importInEnv opts files =
do pgf0 <- gets multigrammar do pgf0 <- gets multigrammar
if flag optRetainResource opts case flag optRetainResource opts of
then do src <- lift $ importSource opts files RetainAll -> do src <- lift $ importSource opts files
pgf <- lift . lazySIO $ importPGF pgf0 -- duplicates some work, better to link src pgf <- lift $ link opts pgf0 src
modify $ \ gfenv -> gfenv {retain=True, pgfenv = (src,pgf)} modify $ \gfenv -> gfenv{pgfenv = (snd src,Just pgf)}
else do pgf1 <- lift $ importPGF pgf0 RetainSource -> do src <- lift $ importSource opts files
modify $ \ gfenv->gfenv { retain=False, modify $ \gfenv -> gfenv{pgfenv = (snd src,snd (pgfenv gfenv))}
pgfenv = (emptyGrammar,pgf1) } RetainCompiled -> do pgf <- lift $ importPGF pgf0
modify $ \gfenv -> gfenv{pgfenv = (emptyGrammar,pgf)}
where where
importPGF pgf0 = importPGF pgf0 =
do let opts' = addOptions (setOptimization OptCSE False) opts do let opts' = addOptions (setOptimization OptCSE False) opts
@@ -373,23 +369,20 @@ tryGetLine = do
Left (e :: SomeException) -> return "q" Left (e :: SomeException) -> return "q"
Right l -> return l Right l -> return l
prompt env prompt env = case multigrammar env of
| retain env = "> " Just pgf -> abstractName pgf ++ "> "
| otherwise = case multigrammar env of Nothing -> "> "
Just pgf -> abstractName pgf ++ "> "
Nothing -> "> "
type CmdEnv = (Grammar,Maybe PGF) type CmdEnv = (Grammar,Maybe PGF)
data GFEnv = GFEnv { data GFEnv = GFEnv {
startOpts :: Options, startOpts :: Options,
retain :: Bool, -- grammar was imported with -retain flag
pgfenv :: CmdEnv, pgfenv :: CmdEnv,
commandenv :: CommandEnv ShellM, commandenv :: CommandEnv ShellM,
history :: [String] history :: [String]
} }
emptyGFEnv opts = GFEnv opts False emptyCmdEnv emptyCommandEnv [] emptyGFEnv opts = GFEnv opts emptyCmdEnv emptyCommandEnv []
emptyCmdEnv = (emptyGrammar,Nothing) emptyCmdEnv = (emptyGrammar,Nothing)