improved make facility: remember state if fails; does not need source

2 files changed, 56 insertions, 34 deletions

diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index cfe8376ec..fa2e65a3c 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -53,8 +53,8 @@ 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 (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
+compileModule :: Options -> ShellState -> FilePath -> IOE TimedCompileEnv
+----             IOE (GFC.CanonGrammar, (SourceGrammar,[(FilePath,ModTime)]))
 
 compileModule opts st0 file | 
      oElem showOld opts || 
@@ -68,15 +68,17 @@ compileModule opts st0 file |
               else putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
   let mods = modules grammar1
   let env = compileEnvShSt st0 []
-  (_,sgr,cgr) <- foldM (comp putp path) env mods
-  return $ (reverseModules cgr,       -- to preserve dependency order
-            (reverseModules sgr,[]))
+  foldM (comp putp path) env mods
+----  (_,sgr,cgr) <- foldM (comp putp path) env mods
+----  return $ (reverseModules cgr,       -- to preserve dependency order
+----            (reverseModules sgr,[]))
  where
    suff = fileSuffix file
    comp putp path env sm0 = do
-     (k',sm)  <- makeSourceModule opts env sm0
+     (k',sm)  <- makeSourceModule opts (fst env) sm0
      cm  <- putp "  generating code... " $ generateModuleCode opts path sm
-     extendCompileEnvInt env (k',sm,cm)
+     ft <- getReadTimes file ---
+     extendCompileEnvInt env (k',sm,cm) ft
 
 compileModule opts1 st0 file = do
   opts0 <- ioeIO $ getOptionsFromFile file
@@ -98,6 +100,11 @@ compileModule opts1 st0 file = do
   let names = map justModuleName files
   ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
   let env0 = compileEnvShSt st names
+  (e,mm) <- foldIOE (compileOne opts) env0 files
+  maybe (return ()) putStrLnE mm
+  return e
+
+{- ----
   (_,sgr,cgr) <- foldM (compileOne opts) env0 files
   t <- ioeIO getNowTime
   return $ (reverseModules cgr,       -- to preserve dependency order
@@ -105,12 +112,20 @@ compileModule opts1 st0 file = do
              [(justModuleName f,t) | f <- files]   -- pass on the time of reading
           ++ [(resModName (justModuleName f),t)    -- also #file if file.(gf|gfr)
                                    | f <- files, not (isGFC f)]))
-compileEnvShSt :: ShellState -> [ModName] -> CompileEnv
-compileEnvShSt st fs = (0,sgr,cgr) where
+-}
+
+getReadTimes file = do
+  t <- ioeIO getNowTime
+  let m = justModuleName file
+  return $ (m,t) : [(resModName m,t) | not (isGFC file)]
+
+compileEnvShSt :: ShellState -> [ModName] -> TimedCompileEnv
+compileEnvShSt st fs = ((0,sgr,cgr),fts) where
   cgr = MGrammar [m | m@(i,_) <- modules (canModules st), notInc i]
   sgr = MGrammar [m | m@(i,_) <- modules (srcModules st), notIns i]
   notInc i = notElem (prt i) $ map fileBody fs
   notIns i = notElem (prt i) $ map fileBody fs
+  fts = readFiles st
 
 pathListOpts :: Options -> [InitPath]
 pathListOpts opts = maybe [""] pFilePaths $ getOptVal opts pathList
@@ -128,18 +143,20 @@ keepResModules opts gr =
 
 type CompileEnv = (Int,SourceGrammar, GFC.CanonGrammar)
 
-emptyCompileEnv :: CompileEnv
-emptyCompileEnv = (0,emptyMGrammar,emptyMGrammar)
+emptyCompileEnv :: TimedCompileEnv
+emptyCompileEnv = ((0,emptyMGrammar,emptyMGrammar),[])
+
+extendCompileEnvInt ((_,MGrammar ss, MGrammar cs),fts) (k,sm,cm) ft = 
+  return ((k,MGrammar (sm:ss), MGrammar (cm:cs)),ft++fts) --- reverse later
 
-extendCompileEnvInt (_,MGrammar ss, MGrammar cs) (k,sm,cm) = 
-  return (k,MGrammar (sm:ss), MGrammar (cm:cs)) --- reverse later
+extendCompileEnv e@((k,_,_),_) (sm,cm) = extendCompileEnvInt e (k,sm,cm)
 
-extendCompileEnv (k,s,c) (sm,cm) = extendCompileEnvInt (k,s,c) (k,sm,cm)
+extendCompileEnvCanon ((k,s,c),fts) cgr ft = 
+  return ((k,s, MGrammar (modules cgr ++ modules c)),ft++fts)
 
-extendCompileEnvCanon (k,s,c) cgr = 
-  return (k,s, MGrammar (modules cgr ++ modules c))
+type TimedCompileEnv = (CompileEnv,[(FilePath,ModTime)])
 
-compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
+compileOne :: Options -> TimedCompileEnv -> FullPath -> IOE TimedCompileEnv
 compileOne opts env file = do
 
   let putp = putPointE opts
@@ -151,29 +168,33 @@ compileOne opts env file = do
     -- for multilingual canonical gf, just read the file and update environment
     "gfcm" -> do
        cgr <- putp ("+ reading" +++ file) $ getCanonGrammar file
-       extendCompileEnvCanon env cgr
+       ft <- getReadTimes file
+       extendCompileEnvCanon env cgr ft
 
     -- for canonical gf, read the file and update environment, also source env
     "gfc" -> do
        cm <- putp ("+ reading" +++ file) $ getCanonModule file
        sm <- ioeErr $ CG.canon2sourceModule cm
-       extendCompileEnv env (sm, cm)
+       ft <- getReadTimes file
+       extendCompileEnv env (sm, cm) ft
 
     -- for compiled resource, parse and organize, then update environment
     "gfr" -> do
        sm0  <- putp ("| parsing" +++ file) $ getSourceModule file
-       let mos = case env of (_,gr,_) -> modules gr
+       let mos = case env of ((_,gr,_),_) -> modules gr
        sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm0
        let gfc = gfcFile name 
        cm <- putp ("+ reading" +++ gfc) $ getCanonModule gfc
-       extendCompileEnv env (sm,cm)
+       ft <- getReadTimes file
+       extendCompileEnv env (sm,cm) ft
 
     -- for gf source, do full compilation
     _ -> do
        sm0 <- putp ("- parsing" +++ file) $ getSourceModule file
-       (k',sm)  <- makeSourceModule opts env sm0
+       (k',sm)  <- makeSourceModule opts (fst env) sm0
        cm  <- putp "  generating code... " $ generateModuleCode opts path sm
-       extendCompileEnvInt env (k',sm,cm)
+       ft <- getReadTimes file
+       extendCompileEnvInt env (k',sm,cm) ft
 
 -- dispatch reused resource at early stage
 
@@ -268,7 +289,7 @@ compileOld opts file = do
   let putp = putPointE opts
   grammar1 <- putp ("- parsing old gf" +++ file) $ getOldGrammar opts file
   files <- mapM writeNewGF $ modules grammar1
-  (_,_,grammar) <- foldM (compileOne opts) emptyCompileEnv files
+  ((_,_,grammar),_) <- foldM (compileOne opts) emptyCompileEnv files
   return grammar
 
 writeNewGF :: SourceModule -> IOE FilePath
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index bc5bc1d33..6a25ed1cb 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -107,16 +107,17 @@ cncModuleIdST = stateGrammarST
 
 grammar2shellState :: Options -> (CanonGrammar, G.SourceGrammar) -> Err ShellState 
 grammar2shellState opts (gr,sgr) = 
-  updateShellState opts emptyShellState (gr,(sgr,[]))
+  updateShellState opts emptyShellState ((0,sgr,gr),[]) --- is 0 safe?
 
 -- update a shell state from a canonical grammar
 
 updateShellState :: Options -> ShellState -> 
-                    (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) -> 
+                    ((Int,G.SourceGrammar,CanonGrammar),[(FilePath,ModTime)]) ->
+               ---- (CanonGrammar,(G.SourceGrammar,[(FilePath,ModTime)])) -> 
                     Err ShellState 
-updateShellState opts sh (gr,(sgr,rts)) = do 
+updateShellState opts sh ((_,sgr,gr),rts) = do 
   let cgr0 = M.updateMGrammar (canModules sh) gr
-      a' = ifNull Nothing (return . last) $ allAbstracts cgr0
+      a' = ifNull Nothing (return . head) $ allAbstracts cgr0
   abstr0 <- case abstract sh of
     Just a -> do
       --- test that abstract is compatible
@@ -124,7 +125,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
     _ -> return a'
   let cgr = filterAbstracts abstr0 cgr0
   let concrs = maybe [] (allConcretes cgr) abstr0
-      concr0 = ifNull Nothing (return . last) concrs
+      concr0 = ifNull Nothing (return . head) concrs
       notInrts f = notElem f $ map fst rts
   cfs <- mapM (canon2cf opts cgr) concrs --- would not need to update all...
 
@@ -149,7 +150,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
     cfs        = zip concrs cfs,
     pInfos     = pinfos, -- peb 8/6
     morphos    = zip concrs (map (mkMorpho cgr) concrs),
-    gloptions  = opts,
+    gloptions  = gloptions sh, --- opts, -- this would be command-line options
     readFiles  = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
     absCats    = csi,
     statistics = [StDepTypes deps,StBoundVars binds]
@@ -216,22 +217,22 @@ grammar2stateGrammar opts gr = do
 allAbstracts :: CanonGrammar -> [Ident]
 allAbstracts gr = [i | (i,M.ModMod m) <- M.modules gr, M.mtype m == M.MTAbstract]
 
--- the last abstract in dependency order
+-- the last abstract in dependency order (head of list)
 greatestAbstract :: CanonGrammar -> Maybe Ident
 greatestAbstract gr = case allAbstracts gr of
   [] -> Nothing
-  a -> return $ last a
+  a -> return $ head a
 
 -- all resource modules
 allResources :: G.SourceGrammar -> [Ident]
 allResources gr = [i | (i,M.ModMod m) <- M.modules gr, M.mtype m == M.MTResource]
 
 
--- the last resource in dependency order
+-- the greatest resource in dependency order
 greatestResource :: G.SourceGrammar -> Maybe Ident
 greatestResource gr = case allResources gr of
   [] -> Nothing
-  a -> return $ last a
+  a -> return $ head a
 
 resourceOfShellState :: ShellState -> Maybe Ident
 resourceOfShellState = greatestResource . srcModules