GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-24 03:52:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

GF shell: add the start options to GFEnv, turn "reload" into an ordinary command

Browse Source
This commit is contained in:
hallgren
2015-08-17 15:56:39 +00:00
parent 4dce393a90
commit d039147261
2 changed files with 120 additions and 135 deletions
Download Patch File Download Diff File Expand all files Collapse all files

124
src/compiler/GF/Interactive.hs
View File

@@ -5,7 +5,7 @@ import Prelude hiding (putStrLn,print)
import qualified Prelude as P(putStrLn) import qualified Prelude as P(putStrLn)
import GF.Command.Interpreter(CommandEnv(..),mkCommandEnv,interpretCommandLine) import GF.Command.Interpreter(CommandEnv(..),mkCommandEnv,interpretCommandLine)
--import GF.Command.Importing(importSource,importGrammar) --import GF.Command.Importing(importSource,importGrammar)
import GF.Command.Commands(flags,options,PGFEnv,HasPGFEnv(..),pgf,pgfEnv,pgfCommands) import GF.Command.Commands(PGFEnv,HasPGFEnv(..),pgf,pgfEnv,pgfCommands)
import GF.Command.CommonCommands(commonCommands,extend) import GF.Command.CommonCommands(commonCommands,extend)
import GF.Command.SourceCommands import GF.Command.SourceCommands
import GF.Command.CommandInfo import GF.Command.CommandInfo
@@ -54,45 +54,45 @@ mainGFI opts files = do
P.putStrLn welcome P.putStrLn welcome
shell opts files shell opts files
shell opts files = flip evalStateT emptyGFEnv $ shell opts files = flip evalStateT (emptyGFEnv opts) $
do mapStateT runSIO $ importInEnv opts files do mapStateT runSIO $ importInEnv opts files
loop opts loop
#ifdef SERVER_MODE #ifdef SERVER_MODE
-- | Run the GF Server (@gf -server@). -- | Run the GF Server (@gf -server@).
-- The 'Int' argument is the port number for the HTTP service. -- The 'Int' argument is the port number for the HTTP service.
mainServerGFI opts0 port files = mainServerGFI opts0 port files =
server jobs port root execute1' . snd server jobs port root execute1' . snd
=<< runSIO (runStateT (importInEnv opts files) emptyGFEnv) =<< runSIO (runStateT (importInEnv opts files) (emptyGFEnv opts))
where where
root = flag optDocumentRoot opts root = flag optDocumentRoot opts
opts = beQuiet opts0 opts = beQuiet opts0
jobs = join (flag optJobs opts) jobs = join (flag optJobs opts)
execute1' gfenv0 cmd = execute1' gfenv0 cmd =
do (quit,gfenv) <- runStateT (execute1 opts cmd) gfenv0 do (quit,gfenv) <- runStateT (execute1 cmd) gfenv0
return $ if quit then Nothing else Just gfenv return $ if quit then Nothing else Just gfenv
#else #else
mainServerGFI opts files = mainServerGFI opts port files =
error "GF has not been compiled with server mode support" error "GF has not been compiled with server mode support"
#endif #endif
-- | Read end execute commands until it is time to quit -- | Read end execute commands until it is time to quit
loop :: Options -> StateT GFEnv IO () loop :: StateT GFEnv IO ()
loop opts = repeatM $ readAndExecute1 opts loop = repeatM readAndExecute1
-- | Read and execute one command, returning Just an updated environment for -- | Read and execute one command, returning 'True' to continue execution,
-- | the next command, or Nothing when it is time to quit -- | 'False' when it is time to quit
readAndExecute1 :: Options -> StateT GFEnv IO Bool readAndExecute1 :: StateT GFEnv IO Bool
readAndExecute1 opts = readAndExecute1 = mapStateT runSIO . execute1 =<< readCommand
mapStateT runSIO . execute1 opts =<< readCommand opts
-- | Read a command -- | Read a command
readCommand :: Options -> StateT GFEnv IO String readCommand :: StateT GFEnv IO String
readCommand opts = readCommand =
case flag optMode opts of do opts <- gets startOpts
ModeRun -> lift tryGetLine case flag optMode opts of
_ -> lift . fetchCommand =<< get ModeRun -> lift tryGetLine
_ -> lift . fetchCommand =<< get
timeIt act = timeIt act =
do t1 <- liftSIO $ getCPUTime do t1 <- liftSIO $ getCPUTime
@@ -108,22 +108,15 @@ optionallyShowCPUTime opts act
liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec" liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
return r return r
{-
loopOptNewCPU opts gfenv'
| not (verbAtLeast opts Normal) = return gfenv'
| otherwise = do
cpu' <- getCPUTime
putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
return $ gfenv' {cputime = cpu'}
-}
type ShellM = StateT GFEnv SIO type ShellM = StateT GFEnv SIO
-- | Execute a given command, returning Just an updated environment for -- | Execute a given command line, returning 'True' to continue execution,
-- | the next command, or Nothing when it is time to quit -- | 'False' when it is time to quit
execute1 :: Options -> String -> ShellM Bool execute1 :: String -> ShellM Bool
execute1 opts s0 = execute1 s0 =
do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0} do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0}
opts <- gets startOpts
interruptible $ optionallyShowCPUTime opts $ interruptible $ optionallyShowCPUTime opts $
case pwords s0 of case pwords s0 of
-- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands
@@ -131,27 +124,19 @@ execute1 opts s0 =
"q" :_ -> quit "q" :_ -> quit
"!" :ws -> system_command ws "!" :ws -> system_command ws
"eh":ws -> eh ws "eh":ws -> eh ws
"i" :ws -> import_ ws "i" :ws -> do import_ ws; continue
-- other special commands, working on GFEnv -- other special commands, working on GFEnv
"dc":ws -> define_command ws "dc":ws -> define_command ws
"dt":ws -> define_tree ws "dt":ws -> define_tree ws
-- "e" :_ -> empty
-- "ph":_ -> print_history
"r" :_ -> reload_last
-- ordinary commands -- ordinary commands
_ -> do env <- gets commandenv _ -> do env <- gets commandenv
interpretCommandLine env s0 interpretCommandLine env s0
continue continue
where where
-- loopNewCPU = fmap Just . loopOptNewCPU opts
continue,stop :: ShellM Bool continue,stop :: ShellM Bool
continue = return True continue = return True
stop = return False stop = return False
pwords s = case words s of
w:ws -> getCommandOp w :ws
ws -> ws
interruptible :: ShellM Bool -> ShellM Bool interruptible :: ShellM Bool -> ShellM Bool
interruptible act = interruptible act =
do gfenv <- get do gfenv <- get
@@ -161,7 +146,8 @@ execute1 opts s0 =
-- Special commands: -- Special commands:
quit = do when (verbAtLeast opts Normal) $ putStrLnE "See you." quit = do opts <- gets startOpts
when (verbAtLeast opts Normal) $ putStrLnE "See you."
stop stop
system_command ws = do lift $ restrictedSystem $ unwords ws ; continue system_command ws = do lift $ restrictedSystem $ unwords ws ; continue
@@ -178,18 +164,6 @@ execute1 opts s0 =
eh _ = do putStrLnE "eh command not parsed" eh _ = do putStrLnE "eh command not parsed"
continue continue
import_ args =
do case parseOptions args of
Ok (opts',files) -> do
curr_dir <- lift getCurrentDirectory
lib_dir <- lift $ getLibraryDirectory (addOptions opts opts')
importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
continue
Bad err ->
do putStrLnE $ "Command parse error: " ++ err
continue
continue
define_command (f:ws) = define_command (f:ws) =
case readCommandLine (unwords ws) of case readCommandLine (unwords ws) of
Just comm -> Just comm ->
@@ -221,23 +195,27 @@ execute1 opts s0 =
dt_not_parsed = putStrLnE "value definition not parsed" >> continue dt_not_parsed = putStrLnE "value definition not parsed" >> continue
reload_last = do pwords s = case words s of
gfenv0 <- get w:ws -> getCommandOp w :ws
let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]] ws -> ws
case imports of
(s,ws):_ -> do
putStrLnE $ "repeating latest import: " ++ s
import_ ws
_ -> do
putStrLnE $ "no import in history"
continue
import_ args =
do case parseOptions args of
Ok (opts',files) -> do
opts <- gets startOpts
curr_dir <- lift getCurrentDirectory
lib_dir <- lift $ getLibraryDirectory (addOptions opts opts')
importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
Bad err -> putStrLnE $ "Command parse error: " ++ err
-- | Commands that work on 'GFEnv'
moreCommands = [ moreCommands = [
("e", emptyCommandInfo { ("e", emptyCommandInfo {
longname = "empty", longname = "empty",
synopsis = "empty the environment (except the command history)", synopsis = "empty the environment (except the command history)",
exec = \ _ _ -> exec = \ _ _ ->
do modify $ \ gfenv -> emptyGFEnv { history=history gfenv } do modify $ \ gfenv -> (emptyGFEnv (startOpts gfenv))
{ history=history gfenv }
return void return void
}), }),
("ph", emptyCommandInfo { ("ph", emptyCommandInfo {
@@ -253,6 +231,20 @@ moreCommands = [
], ],
exec = \ _ _ -> exec = \ _ _ ->
fmap (fromString . unlines . reverse . drop 1 . history) get fmap (fromString . unlines . reverse . drop 1 . history) get
}),
("r", emptyCommandInfo {
longname = "reload",
synopsis = "repeat the latest import command",
exec = \ _ _ ->
do gfenv0 <- get
let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]
case imports of
(s,ws):_ -> do
putStrLnE $ "repeating latest import: " ++ s
import_ ws
return void
_ -> do putStrLnE $ "no import in history"
return void
}) })
] ]
@@ -309,14 +301,16 @@ prompt env
type CmdEnv = (Grammar,PGFEnv) type CmdEnv = (Grammar,PGFEnv)
data GFEnv = GFEnv { data GFEnv = GFEnv {
startOpts :: Options,
retain :: Bool, -- grammar was imported with -retain flag retain :: Bool, -- grammar was imported with -retain flag
pgfenv :: CmdEnv, pgfenv :: CmdEnv,
commandenv :: CommandEnv ShellM, commandenv :: CommandEnv ShellM,
history :: [String] history :: [String]
} }
emptyGFEnv :: GFEnv emptyGFEnv opts = GFEnv opts False emptyCmdEnv emptyCommandEnv []
emptyGFEnv = GFEnv False (emptyGrammar,pgfEnv emptyPGF) emptyCommandEnv [] {-0-}
emptyCmdEnv = (emptyGrammar,pgfEnv emptyPGF)
emptyCommandEnv = mkCommandEnv allCommands emptyCommandEnv = mkCommandEnv allCommands
multigrammar = pgf . snd . pgfenv multigrammar = pgf . snd . pgfenv

131
src/compiler/GF/Interactive2.hs
View File

@@ -4,7 +4,7 @@ module GF.Interactive2 (mainGFI,mainRunGFI{-,mainServerGFI-}) where
import Prelude hiding (putStrLn,print) import Prelude hiding (putStrLn,print)
import qualified Prelude as P(putStrLn) import qualified Prelude as P(putStrLn)
import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,interpretCommandLine) import GF.Command.Interpreter(CommandEnv(..),commands,mkCommandEnv,interpretCommandLine)
import GF.Command.Commands2(flags,options,PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands) import GF.Command.Commands2(PGFEnv,HasPGFEnv(..),pgf,concs,pgfEnv,emptyPGFEnv,pgfCommands)
import GF.Command.CommonCommands import GF.Command.CommonCommands
import GF.Command.CommandInfo import GF.Command.CommandInfo
import GF.Command.Help(helpCommand) import GF.Command.Help(helpCommand)
@@ -59,9 +59,9 @@ mainGFI opts files = do
P.putStrLn "This shell uses the C run-time system. See help for available commands." P.putStrLn "This shell uses the C run-time system. See help for available commands."
shell opts files shell opts files
shell opts files = flip evalStateT emptyGFEnv $ shell opts files = flip evalStateT (emptyGFEnv opts) $
do mapStateT runSIO $ importInEnv opts files do mapStateT runSIO $ importInEnv opts files
loop opts loop
{- {-
#ifdef SERVER_MODE #ifdef SERVER_MODE
@@ -69,32 +69,32 @@ shell opts files = flip evalStateT emptyGFEnv $
-- The 'Int' argument is the port number for the HTTP service. -- The 'Int' argument is the port number for the HTTP service.
mainServerGFI opts0 port files = mainServerGFI opts0 port files =
server jobs port root (execute1 opts) server jobs port root (execute1 opts)
=<< runSIO (importInEnv emptyGFEnv opts files) =<< runSIO (importInEnv (emptyGFEnv opts) opts files)
where where
root = flag optDocumentRoot opts root = flag optDocumentRoot opts
opts = beQuiet opts0 opts = beQuiet opts0
jobs = join (flag optJobs opts) jobs = join (flag optJobs opts)
#else #else
mainServerGFI opts files = mainServerGFI opts port files =
error "GF has not been compiled with server mode support" error "GF has not been compiled with server mode support"
#endif #endif
-} -}
-- | Read end execute commands until it is time to quit -- | Read end execute commands until it is time to quit
loop :: Options -> StateT GFEnv IO () loop :: StateT GFEnv IO ()
loop opts = repeatM $ readAndExecute1 opts loop = repeatM readAndExecute1
-- | Read and execute one command, returning Just an updated environment for -- | Read and execute one command, returning 'True' to continue execution,
-- | the next command, or Nothing when it is time to quit -- | 'False' when it is time to quit
readAndExecute1 :: Options -> StateT GFEnv IO Bool readAndExecute1 :: StateT GFEnv IO Bool
readAndExecute1 opts = readAndExecute1 = mapStateT runSIO . execute1 =<< readCommand
mapStateT runSIO . execute1 opts =<< readCommand opts
-- | Read a command -- | Read a command
readCommand :: Options -> StateT GFEnv IO String readCommand :: StateT GFEnv IO String
readCommand opts = readCommand =
case flag optMode opts of do opts <- gets startOpts
ModeRun -> lift tryGetLine case flag optMode opts of
_ -> lift . fetchCommand =<< get ModeRun -> lift tryGetLine
_ -> lift . fetchCommand =<< get
timeIt act = timeIt act =
do t1 <- liftSIO $ getCPUTime do t1 <- liftSIO $ getCPUTime
@@ -110,22 +110,14 @@ optionallyShowCPUTime opts act
liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec" liftSIO $ putStrLnFlush $ show (dt `div` 1000000000) ++ " msec"
return r return r
{-
loopOptNewCPU opts gfenv'
| not (verbAtLeast opts Normal) = return gfenv'
| otherwise = do
cpu' <- getCPUTime
putStrLnE (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec")
return $ gfenv' {cputime = cpu'}
-}
type ShellM = StateT GFEnv SIO type ShellM = StateT GFEnv SIO
-- | Execute a given command, returning Just an updated environment for -- | Execute a given command line, returning 'True' to continue execution,
-- | the next command, or Nothing when it is time to quit -- | 'False' when it is time to quit
execute1 :: Options -> String -> ShellM Bool execute1 :: String -> ShellM Bool
execute1 opts s0 = execute1 s0 =
do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0} do modify $ \ gfenv0 -> gfenv0 {history = s0 : history gfenv0}
opts <- gets startOpts
interruptible $ optionallyShowCPUTime opts $ interruptible $ optionallyShowCPUTime opts $
case pwords s0 of case pwords s0 of
-- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands -- cc, sd, so, ss and dg are now in GF.Commands.SourceCommands
@@ -133,27 +125,19 @@ execute1 opts s0 =
"q" :_ -> quit "q" :_ -> quit
"!" :ws -> system_command ws "!" :ws -> system_command ws
"eh":ws -> eh ws "eh":ws -> eh ws
"i" :ws -> import_ ws "i" :ws -> do import_ ws; continue
-- other special commands, working on GFEnv -- other special commands, working on GFEnv
"dc":ws -> define_command ws "dc":ws -> define_command ws
"dt":ws -> define_tree ws "dt":ws -> define_tree ws
-- "e" :_ -> empty
-- "ph":_ -> print_history
"r" :_ -> reload_last
-- ordinary commands -- ordinary commands
_ -> do env <- gets commandenv _ -> do env <- gets commandenv
interpretCommandLine env s0 interpretCommandLine env s0
continue continue
where where
-- loopNewCPU = fmap Just . loopOptNewCPU opts
continue,stop :: ShellM Bool continue,stop :: ShellM Bool
continue = return True continue = return True
stop = return False stop = return False
pwords s = case words s of
w:ws -> getCommandOp w :ws
ws -> ws
interruptible :: ShellM Bool -> ShellM Bool interruptible :: ShellM Bool -> ShellM Bool
interruptible act = interruptible act =
do gfenv <- get do gfenv <- get
@@ -163,7 +147,8 @@ execute1 opts s0 =
-- Special commands: -- Special commands:
quit = do when (verbAtLeast opts Normal) $ putStrLnE "See you." quit = do opts <- gets startOpts
when (verbAtLeast opts Normal) $ putStrLnE "See you."
stop stop
system_command ws = do lift $ restrictedSystem $ unwords ws ; continue system_command ws = do lift $ restrictedSystem $ unwords ws ; continue
@@ -180,18 +165,6 @@ execute1 opts s0 =
eh _ = do putStrLnE "eh command not parsed" eh _ = do putStrLnE "eh command not parsed"
continue continue
import_ args =
do case parseOptions args of
Ok (opts',files) -> do
curr_dir <- lift getCurrentDirectory
lib_dir <- lift $ getLibraryDirectory (addOptions opts opts')
importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
continue
Bad err ->
do putStrLnE $ "Command parse error: " ++ err
continue
continue
define_command (f:ws) = define_command (f:ws) =
case readCommandLine (unwords ws) of case readCommandLine (unwords ws) of
Just comm -> Just comm ->
@@ -223,23 +196,27 @@ execute1 opts s0 =
dt_not_parsed = putStrLnE "value definition not parsed" >> continue dt_not_parsed = putStrLnE "value definition not parsed" >> continue
reload_last = do pwords s = case words s of
gfenv0 <- get w:ws -> getCommandOp w :ws
let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]] ws -> ws
case imports of import_ args =
(s,ws):_ -> do do case parseOptions args of
putStrLnE $ "repeating latest import: " ++ s Ok (opts',files) -> do
import_ ws opts <- gets startOpts
_ -> do curr_dir <- lift getCurrentDirectory
putStrLnE $ "no import in history" lib_dir <- lift $ getLibraryDirectory (addOptions opts opts')
continue importInEnv (addOptions opts (fixRelativeLibPaths curr_dir lib_dir opts')) files
Bad err ->
do putStrLnE $ "Command parse error: " ++ err
-- | Commands that work on 'GFEnv'
moreCommands = [ moreCommands = [
("e", emptyCommandInfo { ("e", emptyCommandInfo {
longname = "empty", longname = "empty",
synopsis = "empty the environment (except the command history)", synopsis = "empty the environment (except the command history)",
exec = \ _ _ -> exec = \ _ _ ->
do modify $ \ gfenv -> emptyGFEnv { history=history gfenv } do modify $ \ gfenv -> (emptyGFEnv (startOpts gfenv))
{ history=history gfenv }
return void return void
}), }),
("ph", emptyCommandInfo { ("ph", emptyCommandInfo {
@@ -255,6 +232,20 @@ moreCommands = [
], ],
exec = \ _ _ -> exec = \ _ _ ->
fmap (fromString . unlines . reverse . drop 1 . history) get fmap (fromString . unlines . reverse . drop 1 . history) get
}),
("r", emptyCommandInfo {
longname = "reload",
synopsis = "repeat the latest import command",
exec = \ _ _ ->
do gfenv0 <- get
let imports = [(s,ws) | s <- history gfenv0, ("i":ws) <- [pwords s]]
case imports of
(s,ws):_ -> do
putStrLnE $ "repeating latest import: " ++ s
import_ ws
_ -> do
putStrLnE $ "no import in history"
return void
}) })
] ]
@@ -308,15 +299,15 @@ prompt env = abs ++ "> "
abs = maybe "" C.abstractName (multigrammar env) abs = maybe "" C.abstractName (multigrammar env)
data GFEnv = GFEnv { data GFEnv = GFEnv {
--grammar :: (), -- gfo grammar -retain startOpts :: Options,
--retain :: (), -- grammar was imported with -retain flag --grammar :: (), -- gfo grammar -retain
pgfenv :: PGFEnv, --retain :: (), -- grammar was imported with -retain flag
commandenv :: CommandEnv ShellM, pgfenv :: PGFEnv,
history :: [String] commandenv :: CommandEnv ShellM,
history :: [String]
} }
emptyGFEnv :: GFEnv emptyGFEnv opts = GFEnv opts {-() ()-} emptyPGFEnv emptyCommandEnv []
emptyGFEnv = GFEnv {-() ()-} emptyPGFEnv emptyCommandEnv [] {-0-}
emptyCommandEnv = mkCommandEnv allCommands emptyCommandEnv = mkCommandEnv allCommands
multigrammar = pgf . pgfenv multigrammar = pgf . pgfenv