fixed a file reading bug ; improved pi

2 files changed, 21 insertions, 16 deletions

diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index c79dd2b4d..1805a6cff 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -74,7 +74,7 @@ batchCompileOld f = compileOld defOpts f
 -- As for path: if it is read from file, the file path is prepended to each name.
 -- If from command line, it is used as it is.
 compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
-----             IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
+----             IOE (GFC.CanonGrammar, (SourceGrammar,[(String,(FilePath,ModTime))]))
 
 compileModule opts st0 file | 
      oElem showOld opts || 
@@ -113,7 +113,7 @@ compileModule opts1 st0 file = do
   let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
   ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
   let st = st0 --- if useFileOpt then emptyShellState else st0
-  let rfs = readFiles st
+  let rfs = [(m,t) | (m,(_,t)) <- readFiles st]
   let file' = if useFileOpt then justFileName file else file -- to find file itself
   files <- getAllFiles opts ps rfs file'
   ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
@@ -127,7 +127,7 @@ compileModule opts1 st0 file = do
 getReadTimes file = do
   t <- ioeIO getNowTime
   let m = justModuleName file
-  return $ (m,t) : [(resModName m,t) | not (isGFC file)]
+  return $ (m,(file,t)) : [(resModName m,(file,t)) | not (isGFC file)]
 
 compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv
 compileEnvShSt st fs = ((0,sgr,cgr),fts) where
@@ -163,7 +163,7 @@ extendCompileEnv e@((k,_,_),_) (sm,cm) = extendCompileEnvInt e (k,sm,cm)
 extendCompileEnvCanon ((k,s,c),fts) cgr ft = 
   return ((k,s, MGrammar (modules cgr ++ modules c)),ft++fts)
 
-type TimedCompileEnv = (CompileEnv,[(FilePath,ModTime)])
+type TimedCompileEnv = (CompileEnv,[(String,(FilePath,ModTime))])
 
 compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv
 compileOne opts env@((_,srcgr,cancgr0),_) file = do
@@ -207,7 +207,16 @@ compileOne opts env@((_,srcgr,cancgr0),_) file = do
        extendCompileEnv env (sm,cm) ft
 
     -- for gf source, do full compilation
+
     _ -> do
+
+      --- hack fix to a bug in ReadFiles with reused concrete
+
+      b <- ioeIO $ doesFileExist file
+      if not b 
+        then compileOne opts env $ gfcFile (init (init file))
+        else do
+
        sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ 
                                            getSourceModule opts file
        (k',sm)  <- makeSourceModule opts (fst env) sm0
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index c4798f8d9..3a7115b34 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -35,6 +35,7 @@ import GF.Probabilistic.Probabilistic
 import GF.Compile.NoParse
 import GF.Infra.Option
 import GF.Infra.Ident
+import GF.Infra.UseIO (justModuleName)
 import GF.System.Arch (ModTime)
 
 import qualified Transfer.InterpreterAPI as T
@@ -69,7 +70,7 @@ data ShellState = ShSt {
   treebanks  :: [(Ident,Treebank)],  -- ^ treebanks
   probss     :: [(Ident,Probs)],     -- ^ probability distributions
   gloptions  :: Options,             -- ^ global options
-  readFiles  :: [(FilePath,ModTime)],-- ^ files read
+  readFiles  :: [(String,(FilePath,ModTime))],-- ^ files read
   absCats    :: [(G.Cat,(G.Context,
                   [(G.Fun,G.Type)],
                   [((G.Fun,Int),G.Type)]))],   -- ^ cats, (their contexts, 
@@ -197,8 +198,8 @@ grammar2shellState opts (gr,sgr) =
 
 -- | update a shell state from a canonical grammar
 updateShellState :: Options -> NoParse -> Maybe Ident -> ShellState -> 
-                    ((Int,G.SourceGrammar,CanonGrammar),[(FilePath,ModTime)]) ->
-               ---- (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) -> 
+                    ((Int,G.SourceGrammar,CanonGrammar),[(String,(FilePath,ModTime))]) ->
+               ---- (CanonGrammar,(G.SourceGrammar,[(String,(FilePath,ModTime))])) -> 
                     Err ShellState 
 updateShellState opts ign mcnc sh ((_,sgr,gr),rts) = do 
   let cgr0 = M.updateMGrammar (canModules sh) gr
@@ -271,7 +272,7 @@ updateShellState opts ign mcnc sh ((_,sgr,gr),rts) = do
     treebanks  = treebanks sh,
     probss     = zip concrs probss,
     gloptions  = gloptions sh, --- opts, -- this would be command-line options
-    readFiles  = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
+    readFiles  = [ft | ft@(_,(f,_)) <- readFiles sh, notInrts f] ++ rts,
     absCats    = csi,
     statistics = [StDepTypes deps,StBoundVars binds],
     transfers  = transfers sh
@@ -455,6 +456,9 @@ allActiveStateGrammarsWithNames st =
 
 allActiveGrammars = map snd . allActiveStateGrammarsWithNames
 
+pathOfModule :: ShellState -> Ident -> FilePath
+pathOfModule sh m = maybe "module not found" fst $ lookup (P.prt m) $ readFiles sh
+
 -- command-line option -lang=foo overrides the actual grammar in state
 grammarOfOptState :: Options -> ShellState -> StateGrammar
 grammarOfOptState opts st = 
@@ -531,14 +535,6 @@ changeOptions :: (Options -> Options) -> ShellStateOper
 ---                                      __________ this is OBSOLETE
 changeOptions f sh = sh {gloptions = f (gloptions sh)}
 
-changeModTimes :: [(FilePath,ModTime)] -> ShellStateOper
----                                         __________ this is OBSOLETE
-changeModTimes mfs
- (ShSt a c cs can src cfs old_pinfos mcfgs fcfgs cfgs pinfos ms tbs pbs os ff ts ss trs) = 
-  ShSt a c cs can src cfs old_pinfos mcfgs fcfgs cfgs pinfos ms tbs pbs os ff' ts ss trs
- where
-   ff' = mfs ++ [mf | mf@(f,_) <- ff, notElem f (map fst mfs)]
-
 addGlobalOptions :: Options -> ShellStateOper
 addGlobalOptions = changeOptions . addOptions