From 632aab83c3111d198f701de9e72878aa0ceb7015 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Fri, 27 Feb 2015 16:42:09 +0000
Subject: [PATCH] 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.
---
 src/compiler/GF/Command/Importing.hs |  5 ++---
 src/compiler/GF/Infra/SIO.hs         |  2 +-
 src/compiler/GF/Interactive.hs       | 16 +++++++++-------
 3 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/compiler/GF/Command/Importing.hs b/src/compiler/GF/Command/Importing.hs
index 4ef966f77..e7b9a076c 100644
--- a/src/compiler/GF/Command/Importing.hs
+++ b/src/compiler/GF/Command/Importing.hs
@@ -44,9 +44,8 @@ ioUnionPGF one two = case msgUnionPGF one two of
   (pgf, Just msg) -> putStrLn msg >> return pgf
   (pgf,_)         -> return pgf
 
-importSource :: SourceGrammar -> Options -> [FilePath] -> IO SourceGrammar
-importSource src0 opts files = do
-  useIOE src0 (fmap (snd.snd) (batchCompile opts files))
+importSource :: Options -> [FilePath] -> IO SourceGrammar
+importSource opts files = fmap (snd.snd) (batchCompile opts files)
 
 -- for different cf formats
 importCF opts files get convert = impCF
diff --git a/src/compiler/GF/Infra/SIO.hs b/src/compiler/GF/Infra/SIO.hs
index ed75f0898..5ca683707 100644
--- a/src/compiler/GF/Infra/SIO.hs
+++ b/src/compiler/GF/Infra/SIO.hs
@@ -95,4 +95,4 @@ runInterruptibly     = lift1   IO.runInterruptibly
 lazySIO              = lift1   lazyIO
 
 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
diff --git a/src/compiler/GF/Interactive.hs b/src/compiler/GF/Interactive.hs
index 15c14bbbe..153e699f5 100644
--- a/src/compiler/GF/Interactive.hs
+++ b/src/compiler/GF/Interactive.hs
@@ -345,7 +345,7 @@ fetchCommand gfenv = do
           Haskeline.historyFile = Just path,
           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
     Left  _        -> return ""
     Right Nothing  -> return "q"
@@ -354,9 +354,10 @@ fetchCommand gfenv = do
 importInEnv :: GFEnv -> Options -> [FilePath] -> SIO GFEnv
 importInEnv gfenv opts files
     | 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
-           return $ gfenv {grammar = src, commandenv = mkCommandEnv pgf}
+           return $ gfenv {grammar = src, retain=True,
+                           commandenv = mkCommandEnv pgf}
     | otherwise =
         do pgf1 <- importPGF
            return $ gfenv { commandenv = mkCommandEnv pgf1 }
@@ -396,21 +397,22 @@ welcome = unlines [
   "Bug reports: http://code.google.com/p/grammatical-framework/issues/list"
   ]
 
-prompt env 
-  | abs == wildCId = "> "
+prompt env
+  | retain env || abs == wildCId = "> "
   | otherwise      = showCId abs ++ "> "
   where
-    abs = abstractName (multigrammar env)
+    abs = abstractName (multigrammar (commandenv env))
 
 data GFEnv = GFEnv {
   grammar :: Grammar, -- gfo grammar -retain
+  retain :: Bool,  -- grammar was imported with -retain flag
   commandenv :: CommandEnv,
   history    :: [String]
   }
 
 emptyGFEnv :: GFEnv
 emptyGFEnv =
-  GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] {-0-}
+  GFEnv emptyGrammar False (mkCommandEnv emptyPGF) [] {-0-}
 
 wordCompletion gfenv (left,right) = do
   case wc_type (reverse left) of