Consistenly use SourceGrammar instead of [SourceModule] when calling compiler passes

src/compiler/GF/Compile.hs

@@ -203,25 +203,24 @@ compileSourceModule opts env@(k,gr,_) mb_gfFile mo@(i,mi) = do
                   Nothing     -> return ()
                 extendCompileEnvInt env k Nothing mo1b
     _ -> do
-      let mos = modules gr
 
-      (mo2,warnings) <- putpp "  renaming " $ ioeErr $ runCheck (renameModule mos mo1b)
+      (mo2,warnings) <- putpp "  renaming " $ ioeErr $ runCheck (renameModule gr mo1b)
       warnOut opts warnings
       intermOut opts DumpRename (ppModule Internal mo2)
 
-      (mo3,warnings) <- putpp "  type checking" $ ioeErr $ runCheck (checkModule opts mos mo2)
+      (mo3,warnings) <- putpp "  type checking" $ ioeErr $ runCheck (checkModule opts gr mo2)
       warnOut opts warnings
       intermOut opts DumpTypeCheck (ppModule Internal mo3)
 
       if not (flag optTagsOnly opts)
-        then do (k',mo3r:_) <- putpp "  refreshing " $ ioeErr $ refreshModule (k,mos) mo3
+        then do (k',mo3r:_) <- putpp "  refreshing " $ ioeErr $ refreshModule (k,gr) mo3
                 intermOut opts DumpRefresh (ppModule Internal mo3r)
 
-                mo4 <- putpp "  optimizing " $ ioeErr $ optimizeModule opts mos mo3r
+                mo4 <- putpp "  optimizing " $ ioeErr $ optimizeModule opts gr mo3r
                 intermOut opts DumpOptimize (ppModule Internal mo4)
 
                 mo5 <- if isModCnc (snd mo4) && flag optPMCFG opts
-                         then putpp "  generating PMCFG " $ ioeIO $ generatePMCFG opts mos mo4
+                         then putpp "  generating PMCFG " $ ioeIO $ generatePMCFG opts gr mo4
                          else return mo4
                 intermOut opts DumpCanon (ppModule Internal mo5)
 

src/compiler/GF/Compile/CheckGrammar.hs

@@ -45,11 +45,11 @@ import Control.Monad
 import Text.PrettyPrint
 
 -- | checking is performed in the dependency order of modules
-checkModule :: Options -> [SourceModule] -> SourceModule -> Check SourceModule
+checkModule :: Options -> SourceGrammar -> SourceModule -> Check SourceModule
-checkModule opts mos mo@(m,mi) = do
+checkModule opts sgr mo@(m,mi) = do
-  checkRestrictedInheritance mos mo
+  checkRestrictedInheritance sgr mo
   mo <- case mtype mi of
-          MTConcrete a -> do let gr = mGrammar (mo:mos)
+          MTConcrete a -> do let gr = prependModule sgr mo
                              abs <- checkErr $ lookupModule gr a
                              checkCompleteGrammar gr (a,abs) mo
           _            -> return mo
@@ -57,18 +57,19 @@ checkModule opts mos mo@(m,mi) = do
   foldM updateCheckInfos mo infoss
   where
     updateCheckInfos mo = fmap (foldl update mo) . parallelCheck . map check
-      where check (i,info) = fmap ((,) i) (checkInfo opts mos mo i info)
+      where check (i,info) = fmap ((,) i) (checkInfo opts sgr mo i info)
     update mo@(m,mi) (i,info) = (m,mi{jments=updateTree (i,info) (jments mi)})
 
 -- check if restricted inheritance modules are still coherent
 -- i.e. that the defs of remaining names don't depend on omitted names
-checkRestrictedInheritance :: [SourceModule] -> SourceModule -> Check ()
+checkRestrictedInheritance :: SourceGrammar -> SourceModule -> Check ()
-checkRestrictedInheritance mos (name,mo) = checkIn (ppLocation (msrc mo) NoLoc <> colon) $ do
+checkRestrictedInheritance sgr (name,mo) = checkIn (ppLocation (msrc mo) NoLoc <> colon) $ do
   let irs = [ii | ii@(_,mi) <- mextend mo, mi /= MIAll]  -- names with restr. inh.
   let mrs = [((i,m),mi) | (i,m) <- mos, Just mi <- [lookup i irs]]
                              -- the restr. modules themself, with restr. infos
   mapM_ checkRem mrs
  where
+   mos = modules sgr
    checkRem ((i,m),mi) = do
      let (incl,excl) = partition (isInherited mi) (map fst (tree2list (jments m)))
      let incld c   = Set.member c (Set.fromList incl)
@@ -153,8 +154,8 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = checkIn (ppLocation (msrc cnc) NoLoc
 
 -- | General Principle: only Just-values are checked. 
 -- A May-value has always been checked in its origin module.
-checkInfo :: Options -> [SourceModule] -> SourceModule -> Ident -> Info -> Check Info
+checkInfo :: Options -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info
-checkInfo opts ms (m,mo) c info = do
+checkInfo opts sgr (m,mo) c info = do
   checkIn (ppLocation (msrc mo) NoLoc <> colon) $
     checkReservedId c
   case info of
@@ -253,7 +254,7 @@ checkInfo opts ms (m,mo) c info = do
 
     _ ->  return info
  where
-   gr = mGrammar ((m,mo) : ms)
+   gr = prependModule sgr (m,mo)
    chIn loc cat = checkIn (ppLocation (msrc mo) loc <> colon $$ 
                            nest 2 (text "Happened in" <+> text cat <+> ppIdent c))
 

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -43,13 +43,13 @@ import Control.Exception
 ----------------------------------------------------------------------
 -- main conversion function
 
-generatePMCFG :: Options -> [SourceModule] -> SourceModule -> IO SourceModule
+generatePMCFG :: Options -> SourceGrammar -> SourceModule -> IO SourceModule
-generatePMCFG opts mos cmo@(cm,cmi) = do
+generatePMCFG opts sgr cmo@(cm,cmi) = do
   (seqs,js) <- mapAccumWithKeyM (addPMCFG opts gr am cm) Map.empty (jments cmi)
   when (verbAtLeast opts Verbose) $ hPutStrLn stderr ""
   return (cm,cmi{mseqs = Just (mkSetArray seqs), jments = js})
   where
-    gr = mGrammar (cmo:mos)
+    gr = prependModule sgr cmo
     MTConcrete am = mtype cmi
 
 mapAccumWithKeyM :: (Monad m, Ord k) => (a -> k -> b -> m (a,c)) -> a

src/compiler/GF/Compile/Optimize.hs

@@ -40,8 +40,8 @@ import qualified Data.ByteString.Char8 as BS
 
 -- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
 
-optimizeModule :: Options -> [SourceModule] -> SourceModule -> Err SourceModule
+optimizeModule :: Options -> SourceGrammar -> SourceModule -> Err SourceModule
-optimizeModule opts ms m@(name,mi)
+optimizeModule opts sgr m@(name,mi)
   | mstatus mi == MSComplete = do
       ids <- topoSortJments m
       mi <- foldM updateEvalInfo mi ids
@@ -51,11 +51,11 @@ optimizeModule opts ms m@(name,mi)
    oopts = opts `addOptions` mflags mi
 
    updateEvalInfo mi (i,info) = do
-     info <- evalInfo oopts ms (name,mi) i info
+     info <- evalInfo oopts sgr (name,mi) i info
      return (mi{jments=updateTree (i,info) (jments mi)})
 
-evalInfo :: Options -> [SourceModule] -> SourceModule -> Ident -> Info -> Err Info
+evalInfo :: Options -> SourceGrammar -> SourceModule -> Ident -> Info -> Err Info
-evalInfo opts ms m c info = do
+evalInfo opts sgr m c info = do
 
  (if verbAtLeast opts Verbose then trace (" " ++ showIdent c) else id) return ()
 
@@ -95,7 +95,7 @@ evalInfo opts ms m c info = do
 
   _ ->  return info
  where
-   gr = mGrammar (m : ms)
+   gr = prependModule sgr m
    optim = flag optOptimizations opts
    param = OptParametrize `Set.member` optim
    eIn cat = errIn (render (text "Error optimizing" <+> cat <+> ppIdent c <+> colon))

src/compiler/GF/Compile/Refresh.hs

@@ -106,15 +106,15 @@ refreshEquation pst = err Bad (return . fst) (appSTM (refr pst) initIdState) whe
 
 -- for concrete and resource in grammar, before optimizing
 
-refreshGrammar :: SourceGrammar -> Err SourceGrammar
+--refreshGrammar :: SourceGrammar -> Err SourceGrammar
-refreshGrammar = liftM (mGrammar . snd) . foldM refreshModule (0,[]) . modules
+--refreshGrammar = liftM (mGrammar . snd) . foldM refreshModule (0,[]) . modules
 
-refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule])
+refreshModule :: (Int,SourceGrammar) -> SourceModule -> Err (Int,[SourceModule])
-refreshModule (k,ms) mi@(i,mo)
+refreshModule (k,sgr) mi@(i,mo)
   | isModCnc mo || isModRes mo = do
       (k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo
-      return (k', (i,mo{jments=buildTree js'}) : ms)
+      return (k', (i,mo{jments=buildTree js'}) : modules sgr)
-  | otherwise = return (k, mi:ms)
+  | otherwise = return (k, mi:modules sgr)
  where
   refreshRes (k,cs) ci@(c,info) = case info of
     ResOper ptyp (Just (L loc trm)) -> do   ---- refresh ptyp

src/compiler/GF/Compile/Rename.hs

@@ -49,9 +49,9 @@ renameSourceTerm g m t = do
   status <- buildStatus g (m,mi)
   renameTerm status [] t
 
-renameModule :: [SourceModule] -> SourceModule -> Check SourceModule
+renameModule :: SourceGrammar -> SourceModule -> Check SourceModule
-renameModule ms mo@(m,mi) = do
+renameModule gr mo@(m,mi) = do
-  status <- buildStatus (mGrammar ms) mo
+  status <- buildStatus gr mo
   js     <- checkMapRecover (renameInfo status mo) (jments mi)
   return (m, mi{jments = js})