forked from GitHub/gf-core
GF shell: fixed problems with previous change of the -retain flag
Because the prompt included the name of the abstract syntax, the loading of the PGF was forced even if -retain was used. Even worse, if an error occured while loading the PGF, it was repeated and caught every time the prompt was printed, creating an infite loop. The solution is to not print the name of the abstract syntax when the grammar is imported with -retain, which is the way things were before anyway.
This commit is contained in:
@@ -44,9 +44,8 @@ ioUnionPGF one two = case msgUnionPGF one two of
|
|||||||
(pgf, Just msg) -> putStrLn msg >> return pgf
|
(pgf, Just msg) -> putStrLn msg >> return pgf
|
||||||
(pgf,_) -> return pgf
|
(pgf,_) -> return pgf
|
||||||
|
|
||||||
importSource :: SourceGrammar -> Options -> [FilePath] -> IO SourceGrammar
|
importSource :: Options -> [FilePath] -> IO SourceGrammar
|
||||||
importSource src0 opts files = do
|
importSource opts files = fmap (snd.snd) (batchCompile opts files)
|
||||||
useIOE src0 (fmap (snd.snd) (batchCompile opts files))
|
|
||||||
|
|
||||||
-- for different cf formats
|
-- for different cf formats
|
||||||
importCF opts files get convert = impCF
|
importCF opts files get convert = impCF
|
||||||
|
|||||||
@@ -95,4 +95,4 @@ runInterruptibly = lift1 IO.runInterruptibly
|
|||||||
lazySIO = lift1 lazyIO
|
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 opts files = lift0 $ GF.importSource opts files
|
||||||
|
|||||||
@@ -345,7 +345,7 @@ fetchCommand gfenv = do
|
|||||||
Haskeline.historyFile = Just path,
|
Haskeline.historyFile = Just path,
|
||||||
Haskeline.autoAddHistory = True
|
Haskeline.autoAddHistory = True
|
||||||
}
|
}
|
||||||
res <- IO.runInterruptibly $ Haskeline.runInputT settings (Haskeline.getInputLine (prompt (commandenv gfenv)))
|
res <- IO.runInterruptibly $ Haskeline.runInputT settings (Haskeline.getInputLine (prompt gfenv))
|
||||||
case res of
|
case res of
|
||||||
Left _ -> return ""
|
Left _ -> return ""
|
||||||
Right Nothing -> return "q"
|
Right Nothing -> return "q"
|
||||||
@@ -354,9 +354,10 @@ fetchCommand gfenv = do
|
|||||||
importInEnv :: GFEnv -> Options -> [FilePath] -> SIO GFEnv
|
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 opts files
|
||||||
pgf <- lazySIO importPGF -- duplicates some work, better to link src
|
pgf <- lazySIO importPGF -- duplicates some work, better to link src
|
||||||
return $ gfenv {grammar = src, commandenv = mkCommandEnv pgf}
|
return $ gfenv {grammar = src, retain=True,
|
||||||
|
commandenv = mkCommandEnv pgf}
|
||||||
| otherwise =
|
| otherwise =
|
||||||
do pgf1 <- importPGF
|
do pgf1 <- importPGF
|
||||||
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
return $ gfenv { commandenv = mkCommandEnv pgf1 }
|
||||||
@@ -396,21 +397,22 @@ welcome = unlines [
|
|||||||
"Bug reports: http://code.google.com/p/grammatical-framework/issues/list"
|
"Bug reports: http://code.google.com/p/grammatical-framework/issues/list"
|
||||||
]
|
]
|
||||||
|
|
||||||
prompt env
|
prompt env
|
||||||
| abs == wildCId = "> "
|
| retain env || abs == wildCId = "> "
|
||||||
| otherwise = showCId abs ++ "> "
|
| otherwise = showCId abs ++ "> "
|
||||||
where
|
where
|
||||||
abs = abstractName (multigrammar env)
|
abs = abstractName (multigrammar (commandenv env))
|
||||||
|
|
||||||
data GFEnv = GFEnv {
|
data GFEnv = GFEnv {
|
||||||
grammar :: Grammar, -- gfo grammar -retain
|
grammar :: Grammar, -- gfo grammar -retain
|
||||||
|
retain :: Bool, -- grammar was imported with -retain flag
|
||||||
commandenv :: CommandEnv,
|
commandenv :: CommandEnv,
|
||||||
history :: [String]
|
history :: [String]
|
||||||
}
|
}
|
||||||
|
|
||||||
emptyGFEnv :: GFEnv
|
emptyGFEnv :: GFEnv
|
||||||
emptyGFEnv =
|
emptyGFEnv =
|
||||||
GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] {-0-}
|
GFEnv emptyGrammar False (mkCommandEnv emptyPGF) [] {-0-}
|
||||||
|
|
||||||
wordCompletion gfenv (left,right) = do
|
wordCompletion gfenv (left,right) = do
|
||||||
case wc_type (reverse left) of
|
case wc_type (reverse left) of
|
||||||
|
|||||||
Reference in New Issue
Block a user