bug fixes in multigrammar handling and GFCC generation

src/GF/Compile/Compile.hs

@@ -293,7 +293,7 @@ generateModuleCode opts path minfo@(name,info) = do
   let pname = prefixPathName path (prt name)
   minfo0     <- ioeErr $ redModInfo minfo
   let oopts  = addOptions opts (iOpts (flagsModule minfo))
-      optims = maybe "share" id $ getOptVal oopts useOptimizer
+      optims = maybe "all_subs" id $ getOptVal oopts useOptimizer
       optim  = takeWhile (/='_') optims
       subs   = drop 1 (dropWhile (/='_') optims) == "subs"
   minfo1     <- return $ 
@@ -316,7 +316,7 @@ generateModuleCode opts path minfo@(name,info) = do
   case info of
     ModMod m | emitsGFR m && emit && nomulti -> do
       let rminfo = if isCompilable info then minfo 
-                   else (name,emptyModInfo) 
+                   else (name, ModMod emptyModule) 
       let (file,out) = (gfrFile pname, prGrammar (MGrammar [rminfo]))
       putp ("  wrote file" +++ file) $ ioeIO $ writeFile file out
     _ -> return ()

src/GF/Compile/GrammarToCanon.hs

@@ -73,7 +73,8 @@ redModInfo (c,info) = do
       let defs0 = concat defss
       let lgh = length defs0
       defs  <- return $ sorted2tree $ defs0  -- sorted, but reduced
-      let flags' = G.Flg (identC "modulesize") (identC ("n"++show lgh)) : flags
+      let flags1 = if isIncompl then C.flagIncomplete : flags else flags
+      let flags' = G.Flg (identC "modulesize") (identC ("n"++show lgh)) : flags1
       return $ ModMod $ Module mt MSComplete flags' e os defs
   return (c',info')
  where

src/GF/Compile/Optimize.hs

@@ -50,7 +50,7 @@ optimizeModule opts ms mo@(_,mi) = case mi of
   _ -> evalModule oopts ms mo
  where
    oopts = addOptions opts (iOpts (flagsModule mo))
-   optim = maybe "none" id $ getOptVal oopts useOptimizer
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
 
 evalModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) -> 
                Err (Ident,SourceModInfo)
@@ -92,7 +92,7 @@ evalResInfo oopts gr (c,info) = case info of
  where
    comp = if optres then computeConcrete gr else computeConcreteRec gr
    eIn cat = errIn ("Error optimizing" +++ cat +++ prt c +++ ":")
-   optim = maybe "none" id $ getOptVal oopts useOptimizer
+   optim = maybe "all" id $ getOptVal oopts useOptimizer
    optres = case optim of
      "noexpand" -> False
      _ -> True

src/GF/Compile/ShellState.hs

@@ -85,7 +85,7 @@ type Treebank = Map.Map String [String] -- string, trees
 actualConcretes :: ShellState -> [((Ident,Ident),Bool)]
 actualConcretes sh = nub [((c,c),b) | 
   Just a <- [abstract sh],
-  c <- concretesOfAbstract sh a,
+  ((c,_),_) <- concretes sh, ----concretesOfAbstract sh a,
   let b = True -----
   ]
 
@@ -233,7 +233,10 @@ updateShellState opts ign mcnc sh ((_,sgr,gr),rts) = do
   let oldConcrs = map (snd . fst) (concretes sh)
       newConcrs = maybe [] (M.allConcretes gr) abstr0
       toRetain (c,v) = notElem c newConcrs
-  let concrs = nub $ newConcrs ++ oldConcrs
+  let complete m = case M.lookupModule gr m of
+        Ok mo -> not $ isIncompleteCanon (m,mo)
+        _ -> False
+  let concrs = filter complete $ nub $ newConcrs ++ oldConcrs
       concr0 = ifNull Nothing (return . head) concrs
       notInrts f = notElem f $ map fst rts
       subcgr = unSubelimCanon cgr
@@ -317,7 +320,7 @@ purgeShellState sh = ShSt {
   abstract   = abstr,
   concrete   = concrete sh,
   concretes  = concrs,
-  canModules = M.MGrammar $ purge $ M.modules $ canModules sh,
+  canModules = M.MGrammar $ filter complete $ purge $ M.modules $ canModules sh,
   srcModules = M.emptyMGrammar,
   cfs        = cfs sh,
   abstracts  = maybe [] (\a -> [(a,map (snd . fst) concrs)]) abstr,
@@ -341,6 +344,7 @@ purgeShellState sh = ShSt {
    needed = nub $ concatMap (requiredCanModules isSingle (canModules sh)) acncs
    purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
    acncs = maybe [] singleton abstr ++ map (snd . fst) (actualConcretes sh)
+   complete = not . isIncompleteCanon
 
 changeMain :: Maybe Ident -> ShellState -> Err ShellState
 changeMain Nothing (ShSt _ _ cs ms ss cfs old_pis mcfgs fcfgs cfgs pinfos mos tbs pbs os rs acs s trs) =