fixed a file reading bug ; improved pi

3 files changed, 39 insertions, 27 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
 
diff --git a/src/GF/UseGrammar/Information.hs b/src/GF/UseGrammar/Information.hs
index 094eb698c..900b1b126 100644
--- a/src/GF/UseGrammar/Information.hs
+++ b/src/GF/UseGrammar/Information.hs
@@ -42,7 +42,11 @@ import GF.Infra.UseIO
 showInformation :: Options -> ShellState -> Ident -> IOE ()
 showInformation opts st c = do
   is <- ioeErr $ getInformation opts st c
-  mapM_ (putStrLnE . prInformation opts c) is
+  if null is 
+     then putStrLnE "Identifier not in scope" 
+     else mapM_ (putStrLnE . prInformationM c) is
+ where
+   prInformationM c (i,m) = prInformation opts c i ++ "file:" +++ m ++ "\n"
 
 -- | the data type of different kinds of information
 data Information = 
@@ -71,7 +75,8 @@ prInformation opts c i = unlines $ prt c : case i of
     ]
   ICatAbs m co _ -> [
     "category in abstract module" +++ prt m,
-    "context" +++ prContext co
+    if null co then "not a dependent type" 
+      else "dependent type with context" +++ prContext co
     ]
   ICatCnc m ty cfs tr -> [
     "category in concrete module" +++ prt m,
@@ -102,37 +107,39 @@ prInformation opts c i = unlines $ prt c : case i of
     ]
 
 -- | also finds out if an identifier is defined in many places
-getInformation :: Options -> ShellState -> Ident -> Err [Information]
+getInformation :: Options -> ShellState -> Ident -> Err [(Information,FilePath)]
 getInformation opts st c = allChecks $ [
   do
     m <- lookupModule src c 
     case m of
-      ModMod mo -> return $ IModule mo
+      ModMod mo -> returnm c $ IModule mo
       _ -> prtBad "not a source module" c
   ] ++ map lookInSrc ss ++ map lookInCan cs
  where
    lookInSrc (i,m) = do
      j <- lookupInfo m c 
      case j of
-       AbsCat (Yes co) _ -> return $ ICatAbs i co [] ---
-       AbsFun (Yes ty) _ -> return $ IFunAbs i ty Nothing ---
+       AbsCat (Yes co) _ -> returnm i $ ICatAbs i co [] ---
+       AbsFun (Yes ty) _ -> returnm i $ IFunAbs i ty Nothing ---
        CncCat (Yes ty) _ _ -> do
          ---- let cat = ident2CFCat i c
          ---- rs <- concat [rs | (c,rs) <- cf, ]
-         return $ ICatCnc i ty [] ty ---       
+         returnm i $ ICatCnc i ty [] ty ---       
        CncFun _ (Yes tr) _ -> do
          rs <- return []
-         return $ IFunCnc i tr rs tr ---       
-       ResOper (Yes ty) (Yes tr) -> return $ IOper i ty tr
+         returnm i $ IFunCnc i tr rs tr ---       
+       ResOper (Yes ty) (Yes tr) -> returnm i $ IOper i ty tr
        ResParam (Yes ps) -> do
          ts <- allParamValues src (QC i c)
-         return $ IParam i ps ts
-       ResValue (Yes ty) -> return $ IValue i ty ---
+         returnm i $ IParam i ps ts
+       ResValue (Yes ty) -> returnm i $ IValue i ty ---
        
        _ -> prtBad "nothing available for" i
    lookInCan (i,m) = do
      Bad "nothing available yet in canonical"
 
+   returnm m i = return (i, pathOfModule st m)
+
    src = srcModules st
    can = canModules st
    ss  = [(i,m) | (i,ModMod m) <- modules src]