Introduced output of stripped format gfcm.

src/GF/Compile/Compile.hs

@@ -125,6 +125,9 @@ extendCompileEnvInt (_,MGrammar ss, MGrammar cs) (k,sm,cm) =
 
 extendCompileEnv (k,s,c) (sm,cm) = extendCompileEnvInt (k,s,c) (k,sm,cm)
 
+extendCompileEnvCanon (k,s,c) cgr = 
+  return (k,s, MGrammar (modules cgr ++ modules c))
+
 compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
 compileOne opts env file = do
 
@@ -134,7 +137,12 @@ compileOne opts env file = do
   let name = fileBody file
 
   case gf of
-    -- for canonical gf, just read the file and update environment
+    -- for multilingual canonical gf, just read the file and update environment
+    "gfcm" -> do
+       cgr <- putp ("+ reading" +++ file) $ getCanonGrammar file
+       extendCompileEnvCanon env cgr
+
+    -- 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
@@ -180,6 +188,12 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
   let putp = putPointE opts
       mos  = modules gr
 
+  if (oElem showOld opts && oElem emitCode opts) 
+    then do
+      let (file,out) = (gfFile (prt i), prGrammar (MGrammar [mo]))
+      ioeIO $ writeFile file out >> putStr ("  wrote file" +++ file)
+    else return ()
+
   mo1   <- ioeErr $ rebuildModule mos mo
 
   mo1b  <- ioeErr $ extendModule mos mo1

src/GF/Compile/ModDeps.hs

@@ -11,6 +11,7 @@ import Modules
 import Operations
 
 import Monad
+import List
 
 -- AR 13/5/2003
 
@@ -106,6 +107,17 @@ openInterfaces ds m = do
   let mods = iterFix (concatMap more) (more (m,undefined))
   return $ [i | (i,MTInterface) <- mods]
 
+-- this function finds out what modules are really needed in the canoncal gr.
+-- its argument is typically a concrete module name
+
+requiredCanModules :: (Eq i, Show i) => MGrammar i f a -> i -> [i]
+requiredCanModules gr = nub . iterFix (concatMap more) . singleton where
+  more i = errVal [] $ do
+    m <- lookupModMod gr i
+    return $ maybe [] return (extends m) ++ map openedModule (opens m)
+
+
+
 {-
 -- to test
 exampleDeps = [
@@ -117,3 +129,4 @@ exampleDeps = [
 ii s = IdentM (IC s) MTInterface
 ir s = IdentM (IC s) MTResource
 -}
+

src/GF/Compile/ShellState.hs

@@ -8,6 +8,7 @@ import MMacros
 
 import Look
 import LookAbs
+import ModDeps
 import qualified Modules as M
 import qualified Grammar as G
 import qualified PrGrammar as P
@@ -19,6 +20,8 @@ import Option
 import Ident
 import Arch (ModTime)
 
+import List (nub,nubBy)
+
 -- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished
 
 -- multilingual state with grammars and options
@@ -169,6 +172,26 @@ filterAbstracts abstr cgr = M.MGrammar [m | m <- ms, needed m] where
     Just _ -> a : []
     _ -> []
 
+
+purgeShellState :: ShellState -> ShellState
+purgeShellState sh = ShSt {
+  abstract   = abstract sh,
+  concrete   = concrete sh,
+  concretes  = [(a,i) | (a,i) <- concretes sh, elem i needed],
+  canModules = M.MGrammar $ purge $ M.modules $ canModules sh,
+  srcModules = M.emptyMGrammar,
+  cfs        = cfs sh,
+  morphos    = morphos sh,
+  gloptions  = gloptions sh,
+  readFiles  = [],
+  absCats    = absCats sh,
+  statistics = statistics sh
+  }
+ where
+   needed = nub $ concatMap (requiredCanModules (canModules sh)) acncs
+   purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
+   acncs = maybe [] singleton (abstract sh) ++ map snd (concretes sh)
+
 -- form just one state grammar, if unique, from a canonical grammar
 
 grammar2stateGrammar :: Options -> CanonGrammar -> Err StateGrammar