merge GF.Infra.Modules and GF.Grammar.Grammar. This is a preparation for the separate PGF building

gf.cabal

@@ -132,7 +132,6 @@ executable gf
     GF.JavaScript.AbsJS
     GF.JavaScript.PrintJS
     GF.Infra.Ident
-    GF.Infra.Modules
     GF.Infra.GetOpt
     GF.Infra.Option
     GF.Infra.UseIO

src/compiler/GF/Compile.hs

@@ -20,7 +20,6 @@ import GF.Grammar.Binary
 
 import GF.Infra.Ident
 import GF.Infra.Option
-import GF.Infra.Modules
 import GF.Infra.UseIO
 import GF.Infra.CheckM
 
@@ -139,7 +138,7 @@ compileOne opts env@(_,srcgr,_) file = do
     -- also undo common subexp optimization, to enable normal computations
     ".gfo" -> do
        sm00 <- putPointE Verbose opts ("+ reading" +++ file) $ ioeIO (decodeFile file)
-       let sm0 = addOptionsToModule opts sm00
+       let sm0 = (fst sm00, (snd sm00) {mflags = mflags (snd sm00) `addOptions` opts})
 
        intermOut opts DumpSource (ppModule Qualified sm0)
 
@@ -159,7 +158,7 @@ compileOne opts env@(_,srcgr,_) file = do
 
        sm00 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ 
                                            getSourceModule opts file
-       enc <- ioeIO $ mkTextEncoding (renameEncoding (flag optEncoding (flagsModule sm00)))
+       enc <- ioeIO $ mkTextEncoding (renameEncoding (flag optEncoding (mflags (snd sm00))))
        let sm = decodeStringsInModule enc sm00
 
        intermOut opts DumpSource (ppModule Qualified sm)
@@ -229,7 +228,7 @@ generateModuleCode opts file minfo = do
 --reverseModules (MGrammar ms) = MGrammar $ reverse ms
 
 emptyCompileEnv :: CompileEnv
-emptyCompileEnv = (0,emptyMGrammar,Map.empty)
+emptyCompileEnv = (0,emptySourceGrammar,Map.empty)
 
 extendCompileEnvInt (_,gr,menv) k mfile sm = do
   let (mod,imps) = importsOfModule sm

src/compiler/GF/Compile/CheckGrammar.hs

@@ -23,7 +23,6 @@
 module GF.Compile.CheckGrammar(checkModule) where
 
 import GF.Infra.Ident
-import GF.Infra.Modules
 
 import GF.Compile.TypeCheck.Abstract
 import GF.Compile.TypeCheck.Concrete
@@ -56,13 +55,13 @@ checkModule ms m@(name,mo) = checkIn (text "checking module" <+> ppIdent name) $
   where
     updateCheckInfo (name,mo) (i,info) = do
       info <- checkInfo ms (name,mo) i info
-      return (name,updateModule mo i info)
+      return (name,mo{jments=updateTree (i,info) (jments mo)})
 
 -- 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 mos (name,mo) = do
-  let irs = [ii | ii@(_,mi) <- extend mo, mi /= MIAll]  -- names with restr. inh.
+  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
@@ -90,7 +89,7 @@ checkCompleteGrammar gr (am,abs) (cm,cnc) = do
   -- check that all abstract constants are in concrete; build default lin and lincats
   jsc <- foldM checkAbs jsc (tree2list jsa)
   
-  return (cm,replaceJudgements cnc jsc)
+  return (cm,cnc{jments=jsc})
   where
    checkAbs js i@(c,info) =
      case info of

src/compiler/GF/Compile/Coding.hs

@@ -3,7 +3,6 @@ module GF.Compile.Coding where
 import GF.Grammar.Grammar
 import GF.Grammar.Macros
 import GF.Text.Coding
-import GF.Infra.Modules
 import GF.Infra.Option
 import GF.Data.Operations
 
@@ -18,7 +17,7 @@ decodeStringsInModule :: TextEncoding -> SourceModule -> SourceModule
 decodeStringsInModule enc mo = codeSourceModule (decodeUnicode enc . BS.pack) mo
 
 codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
-codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo)))
+codeSourceModule co (id,mo) = (id,mo{jments = mapTree codj (jments mo)})
  where
     codj (c,info) = case info of
       ResOper     pty pt  -> ResOper (codeLTerms co pty) (codeLTerms co pt) 

src/compiler/GF/Compile/Compute/AppPredefined.hs

@@ -17,7 +17,6 @@ module GF.Compile.Compute.AppPredefined (
 		  ) where
 
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Infra.Option
 import GF.Data.Operations
 import GF.Grammar

src/compiler/GF/Compile/Compute/ConcreteLazy.hs

@@ -18,7 +18,6 @@ import GF.Data.Operations
 import GF.Grammar.Grammar
 import GF.Infra.Ident
 import GF.Infra.Option
-import GF.Infra.Modules
 import GF.Data.Str
 import GF.Grammar.ShowTerm
 import GF.Grammar.Printer

src/compiler/GF/Compile/GeneratePMCFG.hs

@@ -17,7 +17,6 @@ import PGF.Data hiding (Type)
 
 import GF.Infra.Option
 import GF.Grammar hiding (Env, mkRecord, mkTable)
-import qualified GF.Infra.Modules as M
 import GF.Grammar.Lookup
 import GF.Grammar.Predef
 import GF.Data.BacktrackM
@@ -53,21 +52,21 @@ convertConcrete opts0 gr am cm = do
   where
     (m,mo) = cm
     
-    opts = addOptions (M.flags (snd am)) opts0
+    opts = addOptions (mflags (snd am)) opts0
 
     pflindefs = [
       ((m,id),term,lincat) |
-        (id,GF.Grammar.CncCat (Just (L _ lincat)) (Just (L _ term)) _) <- Map.toList (M.jments mo)]
+        (id,GF.Grammar.CncCat (Just (L _ lincat)) (Just (L _ term)) _) <- Map.toList (jments mo)]
 
     pfrules = [
       (PFRule id args ([],res) (map (\(_,_,ty) -> ty) cont) val term) |
-        (id,GF.Grammar.CncFun (Just (cat,cont,val)) (Just (L _ term)) _) <- Map.toList (M.jments mo),
+        (id,GF.Grammar.CncFun (Just (cat,cont,val)) (Just (L _ term)) _) <- Map.toList (jments mo),
         let (ctxt,res,_) = err error typeForm (lookupFunType gr (fst am) id)
             args         = [catSkeleton ty | (_,_,ty) <- ctxt]]
 
-    flags   = Map.fromList [(mkCId f,LStr x) | (f,x) <- optionsPGF (M.flags mo)]
+    flags = Map.fromList [(mkCId f,LStr x) | (f,x) <- optionsPGF (mflags mo)]
 
-    printnames = Map.fromAscList [(i2i id, name) | (id,info) <- Map.toList (M.jments mo), name <- prn info]
+    printnames = Map.fromAscList [(i2i id, name) | (id,info) <- Map.toList (jments mo), name <- prn info]
       where
         prn (GF.Grammar.CncFun _ _ (Just (L _ tr))) = [flatten tr]
         prn (GF.Grammar.CncCat _ _ (Just (L _ tr))) = [flatten tr]
@@ -519,7 +518,7 @@ emptyGrammarEnv gr (m,mo) =
     lincats =
       Map.insert cVar (Sort cStr) $
       Map.fromAscList 
-        [(c, ty) | (c,GF.Grammar.CncCat (Just (L _ ty)) _ _) <- Map.toList (M.jments mo)]
+        [(c, ty) | (c,GF.Grammar.CncCat (Just (L _ ty)) _ _) <- Map.toList (jments mo)]
 
 addApplication :: GrammarEnv -> FId -> (FunId,[FId]) -> GrammarEnv
 addApplication (GrammarEnv last_id catSet seqSet funSet lindefSet crcSet appSet prodSet) fid p =

src/compiler/GF/Compile/GetGrammar.hs

@@ -12,12 +12,11 @@
 -- this module builds the internal GF grammar that is sent to the type checker
 -----------------------------------------------------------------------------
 
-module GF.Compile.GetGrammar (getSourceModule, addOptionsToModule) where
+module GF.Compile.GetGrammar (getSourceModule) where
 
 import GF.Data.Operations
 
 import GF.Infra.UseIO
-import GF.Infra.Modules
 import GF.Infra.Option
 import GF.Grammar.Lexer
 import GF.Grammar.Parser
@@ -40,16 +39,10 @@ getSourceModule opts file0 = ioe $
          Left (Pn l c,msg) -> do file <- writeTemp tmp
                                  let location = file++":"++show l++":"++show c
                                  return (Bad (location++": "++msg))
-         Right mo          -> do removeTemp tmp
+         Right (i,mi)      -> do removeTemp tmp
-                                 return (Ok (addOptionsToModule opts (setSrcPath file0 mo)))
+                                 return (Ok (i,mi{mflags=mflags mi `addOptions` opts, msrc=file0}))
   `catch` (return . Bad . show)
 
-setSrcPath :: FilePath -> SourceModule -> SourceModule
-setSrcPath fpath = mapSourceModule (\m -> m{msrc=fpath})
-
-addOptionsToModule :: Options -> SourceModule -> SourceModule
-addOptionsToModule opts = mapSourceModule (\m -> m { flags = flags m `addOptions` opts })
-
 runPreprocessor :: Temporary -> String -> IO Temporary
 runPreprocessor tmp0 p =
     maybe external internal (lookup p builtin_preprocessors)
@@ -100,4 +93,4 @@ keepTemp tmp =
       Internal str -> return str
 
 removeTemp (Temp path) = removeFile path
-removeTemp _           = return ()
+removeTemp _           = return ()

src/compiler/GF/Compile/GrammarToPGF.hs

@@ -16,7 +16,6 @@ import qualified GF.Grammar.Lookup as Look
 import qualified GF.Grammar as A
 import qualified GF.Grammar.Macros as GM
 --import qualified GF.Compile.Compute.Concrete as Compute ---- 
-import qualified GF.Infra.Modules as M
 import qualified GF.Infra.Option as O
 
 import GF.Infra.Ident
@@ -40,7 +39,7 @@ traceD s t = t
 mkCanon2pgf :: Options -> Ident -> SourceGrammar -> IO D.PGF
 mkCanon2pgf opts cnc gr = (canon2pgf opts gr . reorder abs) gr
   where
-    abs = err (const cnc) id $ M.abstractOfConcrete gr cnc
+    abs = err (const cnc) id $ abstractOfConcrete gr cnc
 
 -- Generate PGF from grammar.
 
@@ -58,17 +57,17 @@ canon2pgf opts gr (am,cms) = do
   where
     mkAbstr (a,abm) = return (i2i a, D.Abstr flags funs cats)
       where
-        flags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF (M.flags abm)]
+        flags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF (mflags abm)]
         
         funs = Map.fromAscList [(i2i f, (mkType [] ty, mkArrity ma, mkDef pty, 0)) | 
-                                   (f,AbsFun (Just (L _ ty)) ma pty _) <- Map.toAscList (M.jments abm)]
+                                   (f,AbsFun (Just (L _ ty)) ma pty _) <- Map.toAscList (jments abm)]
                                    
         cats = Map.fromAscList [(i2i c, (snd (mkContext [] cont),catfuns c)) |
-                                   (c,AbsCat (Just (L _ cont))) <- Map.toAscList (M.jments abm)]
+                                   (c,AbsCat (Just (L _ cont))) <- Map.toAscList (jments abm)]
 
         catfuns cat =
               (map (\x -> (0,snd x)) . sortBy (compare `on` fst))
-                 [(loc,i2i f) | (f,AbsFun (Just (L loc ty)) _ _ (Just True)) <- tree2list (M.jments abm), snd (GM.valCat ty) == cat]
+                 [(loc,i2i f) | (f,AbsFun (Just (L loc ty)) _ _ (Just True)) <- tree2list (jments abm), snd (GM.valCat ty) == cat]
 
     mkConcr am cm@(lang,mo) = do
       cnc <- convertConcrete opts gr am cm
@@ -154,12 +153,12 @@ compilePatt eqs        = whilePP eqs Map.empty
 reorder :: Ident -> SourceGrammar -> AbsConcsGrammar
 reorder abs cg =
 --  M.MGrammar $
-       ((abs, M.ModInfo M.MTAbstract       M.MSComplete aflags [] Nothing [] [] "" adefs),
+       ((abs, ModInfo MTAbstract       MSComplete aflags [] Nothing [] [] "" adefs),
-      [(cnc, M.ModInfo (M.MTConcrete abs) M.MSComplete cflags [] Nothing [] [] "" cdefs)
+      [(cnc, ModInfo (MTConcrete abs) MSComplete cflags [] Nothing [] [] "" cdefs)
-            | cnc <- M.allConcretes cg abs, let (cflags,cdefs) = concr cnc])
+            | cnc <- allConcretes cg abs, let (cflags,cdefs) = concr cnc])
   where
     aflags = 
-      concatOptions (reverse [M.flags mo | (_,mo) <- M.modules cg, M.isModAbs mo])
+      concatOptions (reverse [mflags mo | (_,mo) <- modules cg, isModAbs mo])
 
     adefs = 
       Map.fromList (predefADefs ++ Look.allOrigInfos cg abs)
@@ -169,8 +168,8 @@ reorder abs cg =
 
     concr la = (flags, Map.fromList (predefCDefs ++ jments))
       where 
-        flags  = concatOptions [M.flags mo | (i,mo) <- M.modules cg, M.isModCnc mo, 
+        flags  = concatOptions [mflags mo | (i,mo) <- modules cg, isModCnc mo, 
-                                                Just r <- [lookup i (M.allExtendSpecs cg la)]]
+                                                Just r <- [lookup i (allExtendSpecs cg la)]]
         jments = Look.allOrigInfos cg la
         predefCDefs = 
            [(c, CncCat (Just (L NoLoc GM.defLinType)) Nothing Nothing) | c <- [cInt,cFloat,cString]]

src/compiler/GF/Compile/ModDeps.hs

@@ -68,17 +68,15 @@ moduleDeps :: [SourceModule] -> Err Dependencies
 moduleDeps ms = mapM deps ms where
   deps (c,m) = errIn ("checking dependencies of module" +++ prt c) $ case mtype m of
       MTConcrete a -> do
-        aty <- lookupModuleType gr a
+        am <- lookupModuleType gr a
-        testErr (aty == MTAbstract) "the of-module is not an abstract syntax" 
+        testErr (mtype am == MTAbstract) "the of-module is not an abstract syntax" 
         chDep (IdentM c (MTConcrete a)) 
               (extends m) (MTConcrete a) (opens m) MTResource
       t -> chDep (IdentM c t) (extends m) t (opens m) t
 
   chDep it es ety os oty = do
-    ests <- mapM (lookupModuleType gr) es
+    ems <- mapM (lookupModuleType gr) es
-    testErr (all (compatMType ety) ests) "inappropriate extension module type" 
+    testErr (all (compatMType ety . mtype) ests) "inappropriate extension module type" 
-----    osts <- mapM (lookupModuleType gr . openedModule) os
-----    testErr (all (compatOType oty) osts) "inappropriate open module type"
     let ab = case it of
                IdentM _ (MTConcrete a) -> [IdentM a MTAbstract]
                _ -> [] ---- 

src/compiler/GF/Compile/Optimize.hs

@@ -17,7 +17,6 @@ module GF.Compile.Optimize (optimizeModule) where
 
 import GF.Grammar.Grammar
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Grammar.Printer
 import GF.Grammar.Macros
 import GF.Grammar.Lookup
@@ -49,11 +48,11 @@ optimizeModule opts ms m@(name,mi)
       return (name,mi)
   | otherwise = return m
  where
-   oopts = opts `addOptions` flagsModule m
+   oopts = opts `addOptions` mflags mi
 
    updateEvalInfo mi (i,info) = do
-     info' <- evalInfo oopts ms (name,mi) i info
+     info <- evalInfo oopts ms (name,mi) i info
-     return (updateModule mi i info')
+     return (mi{jments=updateTree (i,info) (jments mi)})
 
 evalInfo :: Options -> [SourceModule] -> SourceModule -> Ident -> Info -> Err Info
 evalInfo opts ms m c info = do

src/compiler/GF/Compile/ReadFiles.hs

@@ -26,7 +26,6 @@ module GF.Compile.ReadFiles
 import GF.Infra.UseIO
 import GF.Infra.Option
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Data.Operations
 import GF.Grammar.Lexer
 import GF.Grammar.Parser
@@ -169,10 +168,10 @@ importsOfModule (m,mi) = (modName m,depModInfo mi [])
   where
     depModInfo mi =
       depModType (mtype mi)  .
-      depExtends (extend mi) .
+      depExtends (mextend mi) .
       depWith    (mwith mi)  .
       depExDeps  (mexdeps mi).
-      depOpens   (opens mi)
+      depOpens   (mopens mi)
 
     depModType (MTAbstract)       xs = xs
     depModType (MTResource)       xs = xs

src/compiler/GF/Compile/Refresh.hs

@@ -19,7 +19,6 @@ module GF.Compile.Refresh (refreshTerm, refreshTermN,
 import GF.Data.Operations
 import GF.Grammar.Grammar
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Grammar.Macros
 import Control.Monad
 
@@ -114,7 +113,7 @@ refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule]
 refreshModule (k,ms) mi@(i,mo)
   | isModCnc mo || isModRes mo = do
       (k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo
-      return (k', (i, replaceJudgements mo (buildTree js')) : ms)
+      return (k', (i,mo{jments=buildTree js'}) : ms)
   | otherwise = return (k, mi:ms)
  where
   refreshRes (k,cs) ci@(c,info) = case info of

src/compiler/GF/Compile/Rename.hs

@@ -31,7 +31,6 @@ module GF.Compile.Rename (
 import GF.Grammar.Grammar
 import GF.Grammar.Values
 import GF.Grammar.Predef
-import GF.Infra.Modules
 import GF.Infra.Ident
 import GF.Infra.CheckM
 import GF.Grammar.Macros
@@ -63,7 +62,7 @@ renameModule :: [SourceModule] -> SourceModule -> Check SourceModule
 renameModule ms mo@(m,mi) = checkIn (text "renaming module" <+> ppIdent m) $ do
   status <- buildStatus (mGrammar ms) m mi
   js     <- checkMap (renameInfo status mo) (jments mi)
-  return (m, mi{opens = map forceQualif (opens mi), jments = js})
+  return (m, mi{mopens = map forceQualif (mopens mi), jments = js})
 
 type Status = (StatusTree, [(OpenSpec, StatusTree)])
 
@@ -129,7 +128,7 @@ tree2status o = case o of
 buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Check Status
 buildStatus gr c mo = let mo' = self2status c mo in do
     let gr1 = prependModule gr (c,mo)
-        ops = [OSimple e | e <- allExtends gr1 c] ++ opens mo
+        ops = [OSimple e | e <- allExtends gr1 c] ++ mopens mo
     mods <- checkErr $ mapM (lookupModule gr1 . openedModule) ops
     let sts = map modInfo2status $ zip ops mods    
     return $ if isModCnc mo

src/compiler/GF/Compile/SubExOpt.hs

@@ -27,7 +27,6 @@ import GF.Grammar.Grammar
 import GF.Grammar.Lookup
 import GF.Infra.Ident
 import qualified GF.Grammar.Macros as C
-import qualified GF.Infra.Modules as M
 import GF.Data.Operations
 
 import Control.Monad
@@ -38,17 +37,17 @@ import Data.List
 
 subexpModule :: SourceModule -> SourceModule
 subexpModule (n,mo) = errVal (n,mo) $ do
-  let ljs = tree2list (M.jments mo)
+  let ljs = tree2list (jments mo)
   (tree,_) <- appSTM (getSubtermsMod n ljs) (Map.empty,0)
   js2 <- liftM buildTree $ addSubexpConsts n tree $ ljs
-  return (n,M.replaceJudgements mo js2)
+  return (n,mo{jments=js2})
 
 unsubexpModule :: SourceModule -> SourceModule
 unsubexpModule sm@(i,mo)
-  | hasSub ljs = (i,M.replaceJudgements mo (rebuild (map unparInfo ljs)))
+  | hasSub ljs = (i,mo{jments=rebuild (map unparInfo ljs)})
   | otherwise  = sm
   where
-    ljs = tree2list (M.jments mo) 
+    ljs = tree2list (jments mo) 
 
     -- perform this iff the module has opers
     hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
@@ -61,7 +60,7 @@ unsubexpModule sm@(i,mo)
       Q (m,c) | isOperIdent c -> --- name convention of subexp opers
         errVal t $ liftM unparTerm $ lookupResDef gr (m,c)
       _ -> C.composSafeOp unparTerm t
-    gr = M.mGrammar [sm]
+    gr = mGrammar [sm]
     rebuild = buildTree . concat
 
 -- implementation

src/compiler/GF/Compile/TypeCheck/Concrete.hs

@@ -2,7 +2,6 @@
 module GF.Compile.TypeCheck.Concrete( checkLType, inferLType, computeLType, ppType ) where
 
 import GF.Infra.CheckM
-import GF.Infra.Modules
 import GF.Data.Operations
 
 import GF.Grammar

src/compiler/GF/Compile/Update.hs

@@ -18,7 +18,6 @@ import GF.Infra.Ident
 import GF.Grammar.Grammar
 import GF.Grammar.Printer
 import GF.Grammar.Lookup
-import GF.Infra.Modules
 import GF.Infra.Option
 
 import GF.Data.Operations
@@ -50,7 +49,7 @@ extendModule gr (name,m)
   ---- compiled anyway), extensions are not built for them.
   ---- Should be replaced by real control. AR 4/2/2005
   | mstatus m == MSIncomplete && isModCnc m = return (name,m)
-  | otherwise                               = do m' <- foldM extOne m (extend m) 
+  | otherwise                               = do m' <- foldM extOne m (mextend m) 
                                                  return (name,m')
  where
    extOne mo (n,cond) = do
@@ -69,7 +68,7 @@ extendModule gr (name,m)
      return $ 
           if isCompl
             then mo {jments = js1}
-            else mo {extend = filter ((/=n) . fst) (extend mo)
+            else mo {mextend= filter ((/=n) . fst) (mextend mo)
                     ,mexdeps= nub (n : mexdeps mo)
                     ,jments = js1
                     }
@@ -95,12 +94,12 @@ rebuildModule gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ src_ js_)) = do
           js' <- extendMod gr False ((i0,m1), isInherited mincl) i (jments mi)
           --- to avoid double inclusions, in instance I of I0 = J0 ** ...
           case extends mi of
-            []  -> return $ replaceJudgements mi js'
+            []  -> return mi{jments=js'}
             j0s -> do
                 m0s <- mapM (lookupModule gr) j0s
                 let notInM0 c _  = all (not . isInBinTree c . jments) m0s
                 let js2 = filterBinTree notInM0 js'
-                return $ replaceJudgements mi js2
+                return mi{jments=js2}
         _ -> return mi
 
     -- add the instance opens to an incomplete module "with" instances

src/compiler/GF/Grammar/Analyse.hs

@@ -11,7 +11,6 @@ module GF.Grammar.Analyse (
 import GF.Grammar.Grammar
 import GF.Infra.Ident
 import GF.Infra.Option ---
-import GF.Infra.Modules
 import GF.Grammar.Macros
 import GF.Grammar.Lookup
 

src/compiler/GF/Grammar/Binary.hs

@@ -16,7 +16,6 @@ import qualified Data.ByteString.Char8 as BS
 import GF.Data.Operations
 import GF.Infra.Ident
 import GF.Infra.Option
-import GF.Infra.Modules
 import GF.Grammar.Grammar
 
 instance Binary Ident where
@@ -26,12 +25,12 @@ instance Binary Ident where
                 then return identW
                 else return (identC bs)
 
-instance Binary a => Binary (MGrammar a) where
+instance Binary SourceGrammar where
   put = put . modules
   get = fmap mGrammar get
 
-instance Binary a => Binary (ModInfo a) where
+instance Binary SourceModInfo where
-  put mi = do put (mtype mi,mstatus mi,flags mi,extend mi,mwith mi,opens mi,mexdeps mi,msrc mi,jments mi)
+  put mi = do put (mtype mi,mstatus mi,mflags mi,mextend mi,mwith mi,mopens mi,mexdeps mi,msrc mi,jments mi)
   get    = do (mtype,mstatus,flags,extend,mwith,opens,med,src,jments) <- get
               return (ModInfo mtype mstatus flags extend mwith opens med src jments)
 

src/compiler/GF/Grammar/CF.hs

@@ -17,7 +17,6 @@ module GF.Grammar.CF (getCF,CFItem,CFCat,CFFun,cf2gf,CFRule) where
 import GF.Grammar.Grammar
 import GF.Grammar.Macros
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Infra.Option
 import GF.Infra.UseIO
 
@@ -84,9 +83,8 @@ type CFFun = String
 
 cf2gf :: FilePath -> CF -> SourceGrammar
 cf2gf fpath cf = mGrammar [
-  (aname, addFlag (modifyFlags (\fs -> fs{optStartCat = Just cat}))
+  (aname, ModInfo MTAbstract MSComplete (modifyFlags (\fs -> fs{optStartCat = Just cat})) [] Nothing [] [] fpath abs),
-          (emptyModInfo{mtype = MTAbstract, msrc=fpath, jments = abs})),
+  (cname, ModInfo (MTConcrete aname) MSComplete noOptions [] Nothing [] [] fpath cnc)
-  (cname, emptyModInfo{mtype = MTConcrete aname, msrc=fpath, jments = cnc})
   ]
  where
    name = justModuleName fpath

src/compiler/GF/Grammar/Grammar.hs

@@ -14,11 +14,25 @@
 -- AR 23\/1\/2000 -- 30\/5\/2001 -- 4\/5\/2003
 -----------------------------------------------------------------------------
 
-module GF.Grammar.Grammar (SourceGrammar,
+module GF.Grammar.Grammar (
-        emptySourceGrammar,mGrammar,
+        SourceGrammar, SourceModInfo(..), SourceModule, ModuleType(..),
-        SourceModInfo,
+        emptySourceGrammar, mGrammar, modules, prependModule,
-        SourceModule,
+
-        mapSourceModule,
+        MInclude (..), OpenSpec(..),
+        extends, isInherited, inheritAll,
+        openedModule, depPathModule, allDepsModule, partOfGrammar,
+        allExtends, allExtendSpecs, allExtendsPlus, allExtensions, 
+        searchPathModule,
+        
+        lookupModule,
+        isModAbs, isModRes, isModCnc,
+        sameMType, isCompilableModule, isCompleteModule,
+        allAbstracts, greatestAbstract, allResources,
+        greatestResource, allConcretes, allConcreteModules,
+        abstractOfConcrete,
+
+        ModuleStatus(..),
+
         Info(..),
         Location(..), L(..), unLoc,
         Type,
@@ -47,23 +61,258 @@ module GF.Grammar.Grammar (SourceGrammar,
 
 import GF.Infra.Ident
 import GF.Infra.Option ---
-import GF.Infra.Modules
 
 import GF.Data.Operations
 
+import Data.List
+import qualified Data.Map as Map
 import qualified Data.ByteString.Char8 as BS
+import Text.PrettyPrint
+import System.FilePath
 
--- | grammar as presented to the compiler
-type SourceGrammar = MGrammar Info
 
-emptySourceGrammar = emptyMGrammar
+data SourceGrammar = MGrammar { 
+    moduleMap :: Map.Map Ident SourceModInfo,
+    modules :: [(Ident,SourceModInfo)]
+  }
+  deriving Show
 
-type SourceModInfo = ModInfo Info
+data SourceModInfo = ModInfo {
+    mtype   :: ModuleType,
+    mstatus :: ModuleStatus,
+    mflags  :: Options,
+    mextend :: [(Ident,MInclude)],
+    mwith   :: Maybe (Ident,MInclude,[(Ident,Ident)]),
+    mopens  :: [OpenSpec],
+    mexdeps :: [Ident],
+    msrc    :: FilePath,
+    jments  :: Map.Map Ident Info
+  }
+  deriving Show
 
 type SourceModule = (Ident, SourceModInfo)
 
-mapSourceModule :: (SourceModInfo -> SourceModInfo) -> (SourceModule -> SourceModule)
+-- | encoding the type of the module
-mapSourceModule f (i,mi) = (i, f mi)
+data ModuleType = 
+    MTAbstract 
+  | MTResource
+  | MTConcrete Ident
+  | MTInterface
+  | MTInstance (Ident,MInclude)
+  deriving (Eq,Show)
+
+data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident]
+  deriving (Eq,Show)
+
+extends :: SourceModInfo -> [Ident]
+extends = map fst . mextend
+
+isInherited :: MInclude -> Ident -> Bool
+isInherited c i = case c of
+  MIAll -> True
+  MIOnly is -> elem i is
+  MIExcept is -> notElem i is
+
+inheritAll :: Ident -> (Ident,MInclude)
+inheritAll i = (i,MIAll)
+
+addOpenQualif :: Ident -> Ident -> SourceModInfo -> SourceModInfo
+addOpenQualif i j (ModInfo mt ms fs me mw ops med src js) = ModInfo mt ms fs me mw (OQualif i j : ops) med src js
+
+data OpenSpec = 
+   OSimple Ident
+ | OQualif Ident Ident
+  deriving (Eq,Show)
+
+data ModuleStatus = 
+   MSComplete 
+ | MSIncomplete 
+  deriving (Eq,Ord,Show)
+
+openedModule :: OpenSpec -> Ident
+openedModule o = case o of
+  OSimple m -> m
+  OQualif _ m -> m
+
+-- | initial dependency list
+depPathModule :: SourceModInfo -> [OpenSpec]
+depPathModule m = fors m ++ exts m ++ mopens m
+  where
+    fors m = 
+      case mtype m of
+        MTConcrete i   -> [OSimple i]
+        MTInstance (i,_)   -> [OSimple i]
+        _              -> []
+    exts m = map OSimple (extends m)
+
+-- | all dependencies
+allDepsModule :: SourceGrammar -> SourceModInfo -> [OpenSpec]
+allDepsModule gr m = iterFix add os0 where
+  os0 = depPathModule m
+  add os = [m | o <- os, Just n <- [lookup (openedModule o) mods], 
+                m <- depPathModule n]
+  mods = modules gr
+
+-- | select just those modules that a given one depends on, including itself
+partOfGrammar :: SourceGrammar -> (Ident,SourceModInfo) -> SourceGrammar
+partOfGrammar gr (i,m) = mGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
+  where
+    mods = modules gr
+    modsFor = (i:) $ map openedModule $ allDepsModule gr m
+
+-- | all modules that a module extends, directly or indirectly, without restricts
+allExtends :: SourceGrammar -> Ident -> [Ident]
+allExtends gr i =
+  case lookupModule gr i of
+    Ok m -> case extends m of 
+              [] -> [i]
+              is -> i : concatMap (allExtends gr) is
+    _    -> []
+
+-- | all modules that a module extends, directly or indirectly, with restricts
+allExtendSpecs :: SourceGrammar -> Ident -> [(Ident,MInclude)]
+allExtendSpecs gr i =
+  case lookupModule gr i of
+    Ok m -> case mextend m of 
+              [] -> [(i,MIAll)]
+              is ->  (i,MIAll) : concatMap (allExtendSpecs gr . fst) is
+    _    -> []
+
+-- | this plus that an instance extends its interface
+allExtendsPlus :: SourceGrammar -> Ident -> [Ident]
+allExtendsPlus gr i =
+  case lookupModule gr i of
+    Ok m -> i : concatMap (allExtendsPlus gr) (exts m)
+    _    -> []
+  where
+    exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]]
+
+-- | conversely: all modules that extend a given module, incl. instances of interface
+allExtensions :: SourceGrammar -> Ident -> [Ident]
+allExtensions gr i =
+  case lookupModule gr i of
+    Ok m -> let es = exts i in es ++ concatMap (allExtensions gr) es
+    _    -> []
+ where
+   exts i = [j | (j,m) <- mods, elem i (extends m) || isInstanceOf i m]
+   mods = modules gr
+   isInstanceOf i m = case mtype m of
+     MTInstance (j,_) -> j == i
+     _ -> False
+
+-- | initial search path: the nonqualified dependencies
+searchPathModule :: SourceModInfo -> [Ident]
+searchPathModule m = [i | OSimple i <- depPathModule m]
+
+prependModule (MGrammar mm ms) im@(i,m) = MGrammar (Map.insert i m mm) (im:ms)
+
+emptySourceGrammar :: SourceGrammar
+emptySourceGrammar = mGrammar []
+
+mGrammar ms = MGrammar (Map.fromList ms) ms
+
+
+-- | we store the module type with the identifier
+
+abstractOfConcrete :: SourceGrammar -> Ident -> Err Ident
+abstractOfConcrete gr c = do
+  n <- lookupModule gr c
+  case mtype n of
+    MTConcrete a -> return a
+    _ -> Bad $ render (text "expected concrete" <+> ppIdent c)
+
+lookupModule :: SourceGrammar -> Ident -> Err SourceModInfo
+lookupModule gr m = case Map.lookup m (moduleMap gr) of
+  Just i  -> return i
+  Nothing -> Bad $ render (text "unknown module" <+> ppIdent m <+> text "among" <+> hsep (map (ppIdent . fst) (modules gr)))
+
+isModAbs :: SourceModInfo -> Bool
+isModAbs m =
+  case mtype m of
+    MTAbstract -> True
+    _          -> False
+
+isModRes :: SourceModInfo -> Bool
+isModRes m =
+  case mtype m of
+    MTResource   -> True
+    MTInterface  -> True ---
+    MTInstance _ -> True
+    _            -> False
+
+isModCnc :: SourceModInfo -> Bool
+isModCnc m =
+  case mtype m of
+    MTConcrete _ -> True
+    _            -> False
+
+sameMType :: ModuleType -> ModuleType -> Bool
+sameMType m n =
+  case (n,m) of
+    (MTConcrete _, MTConcrete _) -> True
+
+    (MTInstance _, MTInstance _) -> True
+    (MTInstance _, MTResource)   -> True
+    (MTInstance _, MTConcrete _) -> True
+
+    (MTInterface,  MTInstance _) -> True
+    (MTInterface,  MTResource)   -> True    -- for reuse
+    (MTInterface,  MTAbstract)   -> True    -- for reuse
+    (MTInterface,  MTConcrete _) -> True    -- for reuse
+
+    (MTResource,   MTInstance _) -> True
+    (MTResource,   MTConcrete _) -> True    -- for reuse
+
+    _                            -> m == n
+
+-- | don't generate code for interfaces and for incomplete modules
+isCompilableModule :: SourceModInfo -> Bool
+isCompilableModule m =
+  case mtype m of
+    MTInterface -> False
+    _           -> mstatus m == MSComplete
+
+-- | interface and "incomplete M" are not complete
+isCompleteModule :: SourceModInfo -> Bool
+isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
+
+
+-- | all abstract modules sorted from least to most dependent
+allAbstracts :: SourceGrammar -> [Ident]
+allAbstracts gr = 
+ case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of
+   Left  is     -> is
+   Right cycles -> error $ render (text "Cyclic abstract modules:" <+> vcat (map (hsep . map ppIdent) cycles))
+
+-- | the last abstract in dependency order (head of list)
+greatestAbstract :: SourceGrammar -> Maybe Ident
+greatestAbstract gr =
+  case allAbstracts gr of
+    [] -> Nothing
+    as -> return $ last as
+
+-- | all resource modules
+allResources :: SourceGrammar -> [Ident]
+allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m]
+
+-- | the greatest resource in dependency order
+greatestResource :: SourceGrammar -> Maybe Ident
+greatestResource gr =
+  case allResources gr of
+    [] -> Nothing
+    a  -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008
+
+-- | all concretes for a given abstract
+allConcretes :: SourceGrammar -> Ident -> [Ident]
+allConcretes gr a =
+  [i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
+
+-- | all concrete modules for any abstract
+allConcreteModules :: SourceGrammar -> [Ident]
+allConcreteModules gr =
+  [i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
+
+
 
 -- | the constructors are judgements in 
 --

src/compiler/GF/Grammar/Lookup.hs

@@ -17,7 +17,6 @@
 
 module GF.Grammar.Lookup (
            lookupIdent,
---         lookupIdentInfo,
            lookupOrigInfo,
            allOrigInfos,
            lookupResDef,
@@ -34,7 +33,6 @@ module GF.Grammar.Lookup (
 
 import GF.Data.Operations
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Grammar.Macros
 import GF.Grammar.Grammar
 import GF.Grammar.Printer
@@ -57,10 +55,10 @@ lookupIdent c t =
     Ok v  -> return v
     Bad _ -> Bad ("unknown identifier" +++ showIdent c)
 
-lookupIdentInfo :: ModInfo a -> Ident -> Err a
+lookupIdentInfo :: SourceModInfo -> Ident -> Err Info
 lookupIdentInfo mo i = lookupIdent i (jments mo)
 
-lookupQIdentInfo :: MGrammar info -> QIdent -> Err info
+lookupQIdentInfo :: SourceGrammar -> QIdent -> Err Info
 lookupQIdentInfo gr (m,c) = flip lookupIdentInfo c =<< lookupModule gr m
 
 lookupResDef :: SourceGrammar -> QIdent -> Err Term

src/compiler/GF/Grammar/Macros.hs

@@ -21,7 +21,6 @@ module GF.Grammar.Macros where
 import GF.Data.Operations
 import GF.Data.Str
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Grammar.Grammar
 import GF.Grammar.Values
 import GF.Grammar.Predef
@@ -584,4 +583,4 @@ pSeq p1 p2 =
     (PSeq p11 (PString s1),PSeq (PString s2) p22) ->
         PSeq p11 (PSeq (PString (s1++s2)) p22)
     _ -> PSeq p1 p2
--}
+-}

src/compiler/GF/Grammar/Parser.y

@@ -9,7 +9,6 @@ module GF.Grammar.Parser
          ) where
 
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Infra.Option
 import GF.Data.Operations
 import GF.Grammar.Predef

src/compiler/GF/Grammar/Printer.hs

@@ -22,7 +22,6 @@ module GF.Grammar.Printer
            ) where
 
 import GF.Infra.Ident
-import GF.Infra.Modules
 import GF.Infra.Option
 import GF.Grammar.Values
 import GF.Grammar.Grammar

src/compiler/GF/Infra/Dependencies.hs

@@ -3,7 +3,6 @@ module GF.Infra.Dependencies (
   ) where
 
 import GF.Grammar.Grammar
-import GF.Infra.Modules
 import GF.Infra.Ident
 
 import Data.List (nub,isPrefixOf)
@@ -60,8 +59,8 @@ grammar2moddeps monly gr = [(i,depMod i m) | (i,m) <- modules gr, yes i]
                      MTConcrete i -> [i | yes i]
                      MTInstance (i,_) -> [i | yes i]
                      _ -> [],
-          extendeds = nub $ filter yes $ map fst (extend m),
+          extendeds = nub $ filter yes $ map fst (mextend m),
-          openeds = nub $ filter yes $ map openedModule (opens m),
+          openeds = nub $ filter yes $ map openedModule (mopens m),
           extrads = nub $ filter yes $ mexdeps m
           }
     yes i = case monly of 

src/compiler/GF/Infra/Modules.hs

@@ -1,340 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Modules
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/09 15:14:30 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.26 $
---
--- Datastructures and functions for modules, common to GF and GFC.
---
--- AR 29\/4\/2003
---
--- The same structure will be used in both source code and canonical.
--- The parameters tell what kind of data is involved.
------------------------------------------------------------------------------
-
-module GF.Infra.Modules (
-        MGrammar, ModInfo(..), ModuleType(..),
-        MInclude (..),
-        mGrammar,modules,prependModule,
-        extends, isInherited,inheritAll, 
-        updateModule, replaceJudgements, addFlag,
-        addOpenQualif, flagsModule, allFlags,
-        OpenSpec(..),
-        ModuleStatus(..),
-        openedModule, depPathModule, allDepsModule, partOfGrammar,
-        allExtends, allExtendSpecs, allExtendsPlus, allExtensions, 
-        searchPathModule,
-     -- addModule, mapModules, updateMGrammar, 
-        emptyMGrammar, emptyModInfo,
-        abstractOfConcrete, abstractModOfConcrete,
-        lookupModule, lookupModuleType, lookupInfo,
-        isModAbs, isModRes, isModCnc,
-        sameMType, isCompilableModule, isCompleteModule,
-        allAbstracts, greatestAbstract, allResources,
-        greatestResource, allConcretes, allConcreteModules
-        ) where
-
-import GF.Infra.Ident
-import GF.Infra.Option
-import GF.Data.Operations
-
-import Data.List
-import qualified Data.Map as Map
-import Text.PrettyPrint
-import System.FilePath
-
-
--- Invariant: modules are stored in dependency order
-
-data MGrammar a = MGrammar { moduleMap :: Map.Map Ident (ModInfo a),
-                             modules :: [(Ident,ModInfo a)] }
-  deriving Show
-mGrammar ms = MGrammar (Map.fromList ms) ms
-
-data ModInfo a = ModInfo {
-    mtype   :: ModuleType,
-    mstatus :: ModuleStatus,
-    flags   :: Options,
-    extend  :: [(Ident,MInclude)],
-    mwith   :: Maybe (Ident,MInclude,[(Ident,Ident)]),
-    opens   :: [OpenSpec],
-    mexdeps :: [Ident],
-    msrc    :: FilePath,
-    jments  :: Map.Map Ident a
-  }
-  deriving Show
-
--- | encoding the type of the module
-data ModuleType = 
-    MTAbstract 
-  | MTResource
-  | MTConcrete Ident
-    -- ^ up to this, also used in GFO. Below, source only.
-  | MTInterface
-  | MTInstance (Ident,MInclude)
-  deriving (Eq,Show)
-
-data MInclude = MIAll | MIOnly [Ident] | MIExcept [Ident]
-  deriving (Eq,Show)
-
-extends :: ModInfo a -> [Ident]
-extends = map fst . extend
-
-isInherited :: MInclude -> Ident -> Bool
-isInherited c i = case c of
-  MIAll -> True
-  MIOnly is -> elem i is
-  MIExcept is -> notElem i is
-
-inheritAll :: Ident -> (Ident,MInclude)
-inheritAll i = (i,MIAll)
-
--- destructive update
-{-
--- | dep order preserved since old cannot depend on new
-updateMGrammar :: MGrammar a -> MGrammar a -> MGrammar a
-updateMGrammar (MGrammar omap os) (MGrammar nmap ns) =
-  MGrammar (Map.union nmap omap) -- Map.union is left-biased
-           ([im | im@(i,m) <- os, i `notElem` nis] ++ ns)
-  where
-    nis = map fst ns
--}
-updateModule :: ModInfo t -> Ident -> t -> ModInfo t
-updateModule (ModInfo mt ms fs me mw ops med src js) i t = ModInfo mt ms fs me mw ops med src (updateTree (i,t) js)
-
-replaceJudgements :: ModInfo t -> Map.Map Ident t -> ModInfo t
-replaceJudgements (ModInfo mt ms fs me mw ops med src _) js = ModInfo mt ms fs me mw ops med src js
-
-addOpenQualif :: Ident -> Ident -> ModInfo t -> ModInfo t
-addOpenQualif i j (ModInfo mt ms fs me mw ops med src js) = ModInfo mt ms fs me mw (OQualif i j : ops) med src js
-
-addFlag :: Options -> ModInfo t -> ModInfo t
-addFlag f mo = mo {flags = flags mo `addOptions` f} 
-
-flagsModule :: (Ident,ModInfo a) -> Options
-flagsModule (_,mi) = flags mi
-
-allFlags :: MGrammar a -> Options
-allFlags gr = concatOptions [flags m | (_,m) <- modules gr]
-{-
-mapModules :: (ModInfo a -> ModInfo a) -> MGrammar a -> MGrammar a 
-mapModules f = mGrammar . map (onSnd f) . modules
--}
-data OpenSpec = 
-   OSimple Ident
- | OQualif Ident Ident
-  deriving (Eq,Show)
-
-data ModuleStatus = 
-   MSComplete 
- | MSIncomplete 
-  deriving (Eq,Ord,Show)
-
-openedModule :: OpenSpec -> Ident
-openedModule o = case o of
-  OSimple m -> m
-  OQualif _ m -> m
-
--- | initial dependency list
-depPathModule :: ModInfo a -> [OpenSpec]
-depPathModule m = fors m ++ exts m ++ opens m
-  where
-    fors m = 
-      case mtype m of
-        MTConcrete i   -> [OSimple i]
-        MTInstance (i,_)   -> [OSimple i]
-        _              -> []
-    exts m = map OSimple (extends m)
-
--- | all dependencies
-allDepsModule :: MGrammar a -> ModInfo a -> [OpenSpec]
-allDepsModule gr m = iterFix add os0 where
-  os0 = depPathModule m
-  add os = [m | o <- os, Just n <- [lookup (openedModule o) mods], 
-                m <- depPathModule n]
-  mods = modules gr
-
--- | select just those modules that a given one depends on, including itself
-partOfGrammar :: MGrammar a -> (Ident,ModInfo a) -> MGrammar a
-partOfGrammar gr (i,m) = mGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
-  where
-    mods = modules gr
-    modsFor = (i:) $ map openedModule $ allDepsModule gr m
-
--- | all modules that a module extends, directly or indirectly, without restricts
-allExtends :: MGrammar a -> Ident -> [Ident]
-allExtends gr i =
-  case lookupModule gr i of
-    Ok m -> case extends m of 
-              [] -> [i]
-              is -> i : concatMap (allExtends gr) is
-    _    -> []
-
--- | all modules that a module extends, directly or indirectly, with restricts
-allExtendSpecs :: MGrammar a -> Ident -> [(Ident,MInclude)]
-allExtendSpecs gr i =
-  case lookupModule gr i of
-    Ok m -> case extend m of 
-              [] -> [(i,MIAll)]
-              is ->  (i,MIAll) : concatMap (allExtendSpecs gr . fst) is
-    _    -> []
-
--- | this plus that an instance extends its interface
-allExtendsPlus :: MGrammar a -> Ident -> [Ident]
-allExtendsPlus gr i =
-  case lookupModule gr i of
-    Ok m -> i : concatMap (allExtendsPlus gr) (exts m)
-    _    -> []
-  where
-    exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]]
-
--- | conversely: all modules that extend a given module, incl. instances of interface
-allExtensions :: MGrammar a -> Ident -> [Ident]
-allExtensions gr i =
-  case lookupModule gr i of
-    Ok m -> let es = exts i in es ++ concatMap (allExtensions gr) es
-    _    -> []
- where
-   exts i = [j | (j,m) <- mods, elem i (extends m) || isInstanceOf i m]
-   mods = modules gr
-   isInstanceOf i m = case mtype m of
-     MTInstance (j,_) -> j == i
-     _ -> False
-
--- | initial search path: the nonqualified dependencies
-searchPathModule :: ModInfo a -> [Ident]
-searchPathModule m = [i | OSimple i <- depPathModule m]
-
-{-
--- | a new module can safely be added to the end, since nothing old can depend on it
-addModule :: MGrammar a -> Ident -> ModInfo a -> MGrammar a
---addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
-addModule gr name mi = MGrammar $ Map.insert name mi (moduleMap gr)
--}
-
-prependModule (MGrammar mm ms) im@(i,m) = MGrammar (Map.insert i m mm) (im:ms)
-
-emptyMGrammar :: MGrammar a
-emptyMGrammar = mGrammar []
-
-emptyModInfo :: ModInfo a
-emptyModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] "" emptyBinTree
-
--- | we store the module type with the identifier
-
-abstractOfConcrete :: MGrammar a -> Ident -> Err Ident
-abstractOfConcrete gr c = do
-  n <- lookupModule gr c
-  case mtype n of
-    MTConcrete a -> return a
-    _ -> Bad $ render (text "expected concrete" <+> ppIdent c)
-
-abstractModOfConcrete :: MGrammar a -> Ident -> Err (ModInfo a)
-abstractModOfConcrete gr c = lookupModule gr =<< abstractOfConcrete gr c
-
--- the canonical file name
-
---- canonFileName s = prt s ++ ".gfc"
-
-lookupModule :: MGrammar a -> Ident -> Err (ModInfo a)
---lookupModule gr m = case lookup m (modules gr) of
-lookupModule gr m = case Map.lookup m (moduleMap gr) of
-  Just i  -> return i
-  Nothing -> Bad $ render (text "unknown module" <+> ppIdent m <+> text "among" <+> hsep (map (ppIdent . fst) (modules gr)))
-
-lookupModuleType :: MGrammar a -> Ident -> Err ModuleType
-lookupModuleType gr m = mtype `fmap` lookupModule gr m
-
-lookupInfo :: ModInfo a -> Ident -> Err a
-lookupInfo mo i = lookupTree showIdent i (jments mo)
-
-isModAbs :: ModInfo a -> Bool
-isModAbs m =
-  case mtype m of
-    MTAbstract -> True
-    _          -> False
-
-isModRes :: ModInfo a -> Bool
-isModRes m =
-  case mtype m of
-    MTResource   -> True
-    MTInterface  -> True ---
-    MTInstance _ -> True
-    _            -> False
-
-isModCnc :: ModInfo a -> Bool
-isModCnc m =
-  case mtype m of
-    MTConcrete _ -> True
-    _            -> False
-
-sameMType :: ModuleType -> ModuleType -> Bool
-sameMType m n =
-  case (n,m) of
-    (MTConcrete _, MTConcrete _) -> True
-
-    (MTInstance _, MTInstance _) -> True
-    (MTInstance _, MTResource)   -> True
-    (MTInstance _, MTConcrete _) -> True
-
-    (MTInterface,  MTInstance _) -> True
-    (MTInterface,  MTResource)   -> True    -- for reuse
-    (MTInterface,  MTAbstract)   -> True    -- for reuse
-    (MTInterface,  MTConcrete _) -> True    -- for reuse
-
-    (MTResource,   MTInstance _) -> True
-    (MTResource,   MTConcrete _) -> True    -- for reuse
-
-    _                            -> m == n
-
--- | don't generate code for interfaces and for incomplete modules
-isCompilableModule :: ModInfo a -> Bool
-isCompilableModule m =
-  case mtype m of
-    MTInterface -> False
-    _           -> mstatus m == MSComplete
-
--- | interface and "incomplete M" are not complete
-isCompleteModule :: ModInfo a -> Bool
-isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
-
-
--- | all abstract modules sorted from least to most dependent
-allAbstracts :: MGrammar a -> [Ident]
-allAbstracts gr = 
- case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of
-   Left  is     -> is
-   Right cycles -> error $ render (text "Cyclic abstract modules:" <+> vcat (map (hsep . map ppIdent) cycles))
-
--- | the last abstract in dependency order (head of list)
-greatestAbstract :: MGrammar a -> Maybe Ident
-greatestAbstract gr =
-  case allAbstracts gr of
-    [] -> Nothing
-    as -> return $ last as
-
--- | all resource modules
-allResources :: MGrammar a -> [Ident]
-allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m]
-
--- | the greatest resource in dependency order
-greatestResource :: MGrammar a -> Maybe Ident
-greatestResource gr =
-  case allResources gr of
-    [] -> Nothing
-    a  -> return $ head a ---- why not last as in Abstract? works though AR 24/5/2008
-
--- | all concretes for a given abstract
-allConcretes :: MGrammar a -> Ident -> [Ident]
-allConcretes gr a =
-  [i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
-
--- | all concrete modules for any abstract
-allConcreteModules :: MGrammar a -> [Ident]
-allConcreteModules gr =
-  [i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]

src/compiler/GF/Speech/VoiceXML.hs

@@ -11,7 +11,6 @@ import GF.Data.Str (sstrV)
 import GF.Data.Utilities
 import GF.Data.XML
 import GF.Infra.Ident
-import GF.Infra.Modules
 import PGF
 import PGF.Data
 import PGF.Macros

src/compiler/GFI.hs

@@ -21,7 +21,6 @@ import GF.Infra.Dependencies
 import GF.Infra.CheckM
 import GF.Infra.UseIO
 import GF.Infra.Option
-import GF.Infra.Modules (greatestResource, modules, emptyModInfo, mGrammar)
 import GF.Infra.Ident (showIdent)
 import GF.Infra.BuildInfo (buildInfo)
 import qualified System.Console.Haskeline as Haskeline
@@ -402,13 +401,12 @@ prompt env
 data GFEnv = GFEnv {
   sourcegrammar :: SourceGrammar, -- gfo grammar -retain
   commandenv :: CommandEnv,
-  history    :: [String]--,
+  history    :: [String]
---cputime    :: Integer
   }
 
 emptyGFEnv :: GFEnv
 emptyGFEnv =
-  GFEnv (mGrammar [(identW,emptyModInfo)]) (mkCommandEnv emptyPGF) [] {-0-}
+  GFEnv emptySourceGrammar (mkCommandEnv emptyPGF) [] {-0-}
 
 wordCompletion gfenv (left,right) = do
   case wc_type (reverse left) of

src/compiler/GFTags.hs

@@ -1,7 +1,6 @@
 module GFTags where
 
 import GF.Infra.Option
-import GF.Infra.Modules
 import GF.Infra.UseIO
 import GF.Grammar
 import GF.Compile