refactor the GF.Grammar.Grammar syntax. The obsolete constructions are removed

src/GF/Compile.hs

@@ -39,6 +39,7 @@ import System.Time
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Data.List(nub)
+import Data.Maybe (isNothing)
 
 import PGF.Check
 import PGF.CId
@@ -172,12 +173,9 @@ compileOne opts env@(_,srcgr,_) file = do
           -- sm is optimized before generation, but not in the env
        extendCompileEnvInt env k' (Just gfo) sm1
   where
-   isConcr (_,mi) = case mi of
+   isConcr (_,m) = isModCnc m && mstatus m /= MSIncomplete && isNothing (mwith m)
-     ModMod m -> isModCnc m && mstatus m /= MSIncomplete 
-     _ -> False
 
-compileSourceModule :: Options -> CompileEnv -> 
+compileSourceModule :: Options -> CompileEnv -> SourceModule -> IOE (Int,SourceModule)
-                       SourceModule -> IOE (Int,SourceModule)
 compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do
 
   let putp  = putPointE Normal opts
@@ -191,7 +189,7 @@ compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do
   intermOut opts DumpExtend (prModule mo1b)
 
   case mo1b of
-    (_,ModMod n) | not (isCompleteModule n) -> do
+    (_,n) | not (isCompleteModule n) -> do
       return (k,mo1b)   -- refresh would fail, since not renamed
     _ -> do
       mo2:_ <- putpp "  renaming " $ ioeErr $ renameModule mos mo1b

src/GF/Compile/BackOpt.hs

@@ -32,11 +32,8 @@ import qualified Data.Set as Set
 
 type OptSpec = Set Optimization
 
-shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+shareModule :: OptSpec -> SourceModule -> SourceModule
-shareModule opt (i,m) = case m of
+shareModule opt (i,mo) = (i,M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo)))
-  M.ModMod mo -> 
-    (i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo))))
-  _ -> (i,m)
 
 shareInfo :: OptSpec -> (Ident, Info) -> Info
 shareInfo opt (c, CncCat ty (Yes t) m) = CncCat ty (Yes (shareOptim opt c t)) m

src/GF/Compile/CheckGrammar.hs

@@ -63,9 +63,7 @@ mapsCheckTree f = checkErr . mapsErrTree (\t -> checkStart (f t) >>= return . fs
 
 -- | checking is performed in the dependency order of modules
 checkModule :: [SourceModule] -> SourceModule -> Check [SourceModule]
-checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of
+checkModule ms (name,mo) = checkIn ("checking module" +++ prt name) $ do
-
-  ModMod mo -> do
     let js = jments mo
     checkRestrictedInheritance ms (name, mo)
     js' <- case mtype mo of
@@ -77,29 +75,25 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod
 
       MTConcrete a -> do
         checkErr $ topoSortOpers $ allOperDependencies name js
-        ModMod abs <- checkErr $ lookupModule gr a
+        abs <- checkErr $ lookupModule gr a
         js1 <- checkCompleteGrammar abs mo
         mapsCheckTree (checkCncInfo gr name mo (a,abs)) js1
 
       MTInterface -> mapsCheckTree (checkResInfo gr name mo) js
 
       MTInstance a -> do
-        -- ModMod abs <- checkErr $ lookupModule gr a
-        -- checkCompleteInstance abs mo -- this is done in Rebuild
         mapsCheckTree (checkResInfo gr name mo) js
 
-    return $ (name, ModMod (replaceJudgements mo js')) : ms
+    return $ (name, replaceJudgements mo js') : ms
-
-  _ -> return $ (name,mod) : ms
  where
-   gr  = MGrammar $ (name,mod):ms
+   gr  = MGrammar $ (name,mo):ms
 
 -- 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 :: [SourceModule] -> SourceModule -> Check ()
 checkRestrictedInheritance mos (name,mo) = do
   let irs = [ii | ii@(_,mi) <- extend mo, mi /= MIAll]  -- names with restr. inh.
-  let mrs = [((i,m),mi) | (i,ModMod m) <- mos, Just mi <- [lookup i irs]] 
+  let mrs = [((i,m),mi) | (i,m) <- mos, Just mi <- [lookup i irs]] 
                              -- the restr. modules themself, with restr. infos
   mapM_ checkRem mrs
  where
@@ -115,10 +109,7 @@ checkRestrictedInheritance mos (name,mo) = do
                ", dependence of excluded constants:" ++++
                unlines ["  " ++ prt f +++ "on" +++ unwords (map prt is) | 
                               (f,is) <- cs]
-   allDeps = ---- transClosure $ Map.fromList $ 
+   allDeps = concatMap (allDependencies (const True) . jments . snd) mos
-             concatMap (allDependencies (const True)) 
-                              [jments m | (_,ModMod m) <- mos]
-   transClosure ds = ds ---- TODO: check in deeper modules
 
 -- | check if a term is typable
 justCheckLTerm :: SourceGrammar -> Term -> Err Term
@@ -127,7 +118,7 @@ justCheckLTerm src t = do
   return t'
 
 checkAbsInfo :: 
-  SourceGrammar -> Ident -> Module Ident Info -> (Ident,Info) -> Check (Ident,Info)
+  SourceGrammar -> Ident -> SourceModInfo -> (Ident,Info) -> Check (Ident,Info)
 checkAbsInfo st m mo (c,info) = do
 ---- checkReservedId c
  case info of
@@ -183,7 +174,7 @@ checkAbsInfo st m mo (c,info) = do
      R fs -> mkApp t (map (snd . snd) fs)
      _ -> mkApp t [a]
 
-checkCompleteGrammar :: SourceAbs -> SourceCnc -> Check (BinTree Ident Info)
+checkCompleteGrammar :: SourceModInfo -> SourceModInfo -> Check (BinTree Ident Info)
 checkCompleteGrammar abs cnc = do
   let jsa = jments abs
   let fsa = tree2list jsa
@@ -227,8 +218,7 @@ checkCompleteGrammar abs cnc = do
 
 -- | General Principle: only Yes-values are checked. 
 -- A May-value has always been checked in its origin module.
-checkResInfo :: 
+checkResInfo :: SourceGrammar -> Ident -> SourceModInfo -> (Ident,Info) -> Check (Ident,Info)
-  SourceGrammar -> Ident -> Module Ident Info -> (Ident,Info) -> Check (Ident,Info)
 checkResInfo gr mo mm (c,info) = do
   checkReservedId c
   case info of
@@ -281,8 +271,8 @@ checkResInfo gr mo mm (c,info) = do
      _ -> return ()
 
 
-checkCncInfo :: SourceGrammar -> Ident -> Module Ident Info -> 
+checkCncInfo :: SourceGrammar -> Ident -> SourceModInfo -> 
-                (Ident,SourceAbs) -> 
+                (Ident,SourceModInfo) -> 
                 (Ident,Info) -> Check (Ident,Info)
 checkCncInfo gr m mo (a,abs) (c,info) = do
   checkReservedId c

src/GF/Compile/Coding.hs

@@ -14,17 +14,14 @@ encodeStringsInModule :: SourceModule -> SourceModule
 encodeStringsInModule = codeSourceModule encodeUTF8
 
 decodeStringsInModule :: SourceModule -> SourceModule
-decodeStringsInModule mo = case mo of
+decodeStringsInModule mo =
-  (_,ModMod m) -> case flag optEncoding (flags m) of
+  case flag optEncoding (flagsModule mo) of
     UTF_8   -> codeSourceModule decodeUTF8   mo
     CP_1251 -> codeSourceModule decodeCP1251 mo
     _       -> mo
-  _ -> mo
 
 codeSourceModule :: (String -> String) -> SourceModule -> SourceModule
-codeSourceModule co (id,moi) = case moi of
+codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo)))
-  ModMod mo -> (id, ModMod $ replaceJudgements mo (mapTree codj (jments mo)))
-  _ -> (id,moi)
  where
     codj (c,info) = case info of
       ResOper     pty pt  -> ResOper (mapP codt pty) (mapP codt pt) 

src/GF/Compile/Extend.hs

@@ -29,20 +29,17 @@ import GF.Data.Operations
 import Control.Monad
 
 extendModule :: [SourceModule] -> SourceModule -> Err SourceModule
-extendModule ms (name,mod) = case mod of
+extendModule ms (name,m)
-
   ---- Just to allow inheritance in incomplete concrete (which are not
   ---- compiled anyway), extensions are not built for them.
   ---- Should be replaced by real control. AR 4/2/2005
-  ModMod m | mstatus m == MSIncomplete && isModCnc m -> return (name,mod)
+  | mstatus m == MSIncomplete && isModCnc m = return (name,m)
-
+  | otherwise                               = do m' <- foldM extOne m (extend m) 
-  ModMod m -> do
+                                                 return (name,m')
-    mod' <- foldM extOne m (extend m) 
-    return (name,ModMod mod') 
  where
    extOne mo (n,cond) = do
         (m0,isCompl) <- do
-          m <- lookupModMod  (MGrammar ms) n
+          m <- lookupModule (MGrammar ms) n
 
           -- test that the module types match, and find out if the old is complete
           testErr (sameMType (mtype m) (mtype mo)) 

src/GF/Compile/GrammarToGFCC.hs

@@ -58,7 +58,7 @@ addParsers opts pgf = CM.mapConcretes conv pgf
 -- this assumes a grammar translated by canon2canon
 
 canon2gfcc :: Options -> (Ident -> Ident -> C.Term) -> SourceGrammar -> D.PGF
-canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = 
+canon2gfcc opts pars cgr@(M.MGrammar ((a,abm):cms)) = 
   (if dump opts DumpCanon then trace (prGrammar cgr) else id) $
      D.PGF an cns gflags abs cncs 
  where
@@ -82,7 +82,7 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) =
   catfuns = Map.fromList 
     [(cat,[f | (f, (C.DTyp _ c _,_)) <- lfuns, c==cat]) | (cat,_) <- lcats]
 
-  cncs  = Map.fromList [mkConcr lang (i2i lang) mo | (lang,M.ModMod mo) <- cms]
+  cncs  = Map.fromList [mkConcr lang (i2i lang) mo | (lang,mo) <- cms]
   mkConcr lang0 lang mo = 
       (lang,D.Concr flags lins opers lincats lindefs printnames params fcfg)
     where
@@ -223,20 +223,18 @@ mkParamLincat sgr lang cat = errVal (C.R [C.S []]) $ do
 
 reorder :: Ident -> SourceGrammar -> SourceGrammar
 reorder abs cg = M.MGrammar $ 
-    (abs, M.ModMod $ 
+    (abs, M.ModInfo M.MTAbstract M.MSComplete aflags [] Nothing [] adefs poss):
-          M.Module M.MTAbstract M.MSComplete aflags [] [] adefs poss):
+      [(c, M.ModInfo (M.MTConcrete abs) M.MSComplete fs [] Nothing [] (sorted2tree js) poss)
-      [(c, M.ModMod $ 
-          M.Module (M.MTConcrete abs) M.MSComplete fs [] [] (sorted2tree js) poss) 
             | (c,(fs,js)) <- cncs] 
      where
        poss = emptyBinTree -- positions no longer needed
-       mos = M.allModMod cg
+       mos = M.modules cg
        adefs = sorted2tree $ sortIds $
                  predefADefs ++ Look.allOrigInfos cg abs
        predefADefs = 
          [(c, AbsCat (Yes []) Nope) | c <- [cFloat,cInt,cString]]
        aflags = 
-         concatOptions [M.flags mo | (_,mo) <- M.allModMod cg, M.isModAbs mo]
+         concatOptions [M.flags mo | (_,mo) <- M.modules cg, M.isModAbs mo]
 
        cncs = sortIds [(lang, concr lang) | lang <- M.allConcretes cg abs]
        concr la = (flags, 
@@ -257,7 +255,7 @@ reorder abs cg = M.MGrammar $
 repartition :: Ident -> SourceGrammar -> [SourceGrammar]
 repartition abs cg = 
   [M.partOfGrammar cg (lang,mo) | 
-    let mos = M.allModMod cg,
+    let mos = M.modules cg,
     lang <- case M.allConcretes cg abs of
       [] -> [abs]  -- to make pgf nonempty even when there are no concretes
       cncs -> cncs,
@@ -276,10 +274,8 @@ canon2canon opts abs cg0 =
     
   js2js ms = map (c2c (j2j (M.MGrammar ms))) ms
 
-  c2c f2 (c,m) = case m of
+  c2c f2 (c,mo) = (c, M.replaceJudgements mo $ mapTree f2 (M.jments mo))
-      M.ModMod mo ->
+
-        (c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 (M.jments mo))
-      _ -> (c,m)    
   j2j cg (f,j) = 
     let debug = if verbAtLeast opts Verbose then trace ("+ " ++ prt f) else id in
     case j of
@@ -323,7 +319,7 @@ purgeGrammar abstr gr =
   needed = nub $ concatMap (requiredCanModules isSingle gr) acncs
   acncs = abstr : M.allConcretes gr abstr
   isSingle = True
-  complete (i,M.ModMod m) = M.isCompleteModule m --- not . isIncompleteCanon
+  complete (i,m) = M.isCompleteModule m --- not . isIncompleteCanon
   unopt = unshareModule gr -- subexp elim undone when compiled
 
 type ParamEnv =
@@ -373,7 +369,7 @@ paramValues cgr = (labels,untyps,typs) where
       updateSTM (ty:) >> mapM_ typsFromTrm [t | (_, t) <- cs] >> return tr
     _ -> GM.composOp typsFromTrm tr
 
-  mods = traceD (unwords (map (prt . fst) ms)) ms where ms = M.allModMod cgr
+  mods = traceD (unwords (map (prt . fst) ms)) ms where ms = M.modules cgr
 
   jments = 
     [(m,j) | (m,mo) <- mods, j <- tree2list $ M.jments mo]
@@ -555,8 +551,8 @@ requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
          then map fst (M.modules gr) 
          else iterFix (concatMap more) $ exts
   more i = errVal [] $ do
-    m <- M.lookupModMod gr i
+    m <- M.lookupModule gr i
     return $ M.extends m ++ [o | o <- map M.openedModule (M.opens m)]
   notReuse i = errVal True $ do
-    m <- M.lookupModMod gr i
+    m <- M.lookupModule gr i
     return $ M.isModRes m -- to exclude reused Cnc and Abs from required

src/GF/Compile/ModDeps.hs

@@ -36,7 +36,7 @@ import Data.List
 -- | to check uniqueness of module names and import names, the
 -- appropriateness of import and extend types,
 -- to build a dependency graph of modules, and to sort them topologically
-mkSourceGrammar :: [(Ident,SourceModInfo)] -> Err SourceGrammar
+mkSourceGrammar :: [SourceModule] -> Err SourceGrammar
 mkSourceGrammar ms = do
   let ns = map fst ms
   checkUniqueErr ns
@@ -55,23 +55,18 @@ checkUniqueErr ms = do
 
 -- | check that import names don't clash with module names
 checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err ()
-checkUniqueImportNames ns mo = case mo of
+checkUniqueImportNames ns mo = test [n | OQualif n v <- opens mo, n /= v]
-  ModMod m -> test [n | OQualif _ n v <- opens m, n /= v]
-  _ -> return () --- Bad $ "bug: ModDeps does not treat" +++ show mo
  where
-
    test ms = testErr (all (`notElem` ns) ms)
-                    ("import names clashing with module names among" +++ 
+                     ("import names clashing with module names among" +++ unwords (map prt ms))
-                       unwords (map prt ms))
 
 type Dependencies = [(IdentM Ident,[IdentM Ident])]
 
 -- | to decide what modules immediately depend on what, and check if the
 -- dependencies are appropriate
-moduleDeps :: [(Ident,SourceModInfo)] -> Err Dependencies
+moduleDeps :: [SourceModule] -> Err Dependencies
 moduleDeps ms = mapM deps ms where
-  deps (c,mi) = errIn ("checking dependencies of module" +++ prt c) $ case mi of
+  deps (c,m) = errIn ("checking dependencies of module" +++ prt c) $ case mtype m of
-    ModMod m -> case mtype m of
       MTConcrete a -> do
         aty <- lookupModuleType gr a
         testErr (aty == MTAbstract) "the of-module is not an abstract syntax" 
@@ -98,7 +93,6 @@ moduleDeps ms = mapM deps ms where
     (MTInterface,  MTAbstract)   -> True
     (MTConcrete _, MTConcrete _) -> True
     (MTInstance _, MTInstance _) -> True
-    (MTReuse _, MTReuse _) -> True
     (MTInstance _, MTResource) -> True
     (MTResource, MTInstance _) -> True
     ---- some more?
@@ -109,7 +103,6 @@ moduleDeps ms = mapM deps ms where
     MTTransfer _ _ -> mt == MTAbstract
     _ -> case mt of
       MTResource -> True
-      MTReuse _ -> True
       MTInterface -> True
       MTInstance _ -> True
       _ -> False      
@@ -132,10 +125,10 @@ requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
          then map fst (modules gr)
          else iterFix (concatMap more) $ exts
   more i = errVal [] $ do
-    m <- lookupModMod gr i
+    m <- lookupModule gr i
     return $ extends m ++ [o | o <- map openedModule (opens m)]
   notReuse i = errVal True $ do
-    m <- lookupModMod gr i
+    m <- lookupModule gr i
     return $ isModRes m -- to exclude reused Cnc and Abs from required
 
 

src/GF/Compile/Optimize.hs

@@ -49,23 +49,21 @@ prtIf b t = if b then trace (" " ++ prt t) t else t
 type EEnv = () --- not used
 
 -- only do this for resource: concrete is optimized in gfc form
-optimizeModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> 
+optimizeModule :: Options -> ([SourceModule],EEnv) -> SourceModule -> Err (SourceModule,EEnv)
-                  (Ident,SourceModInfo) -> Err ((Ident,SourceModInfo),EEnv)
+optimizeModule opts mse@(ms,eenv) mo@(_,mi)
-optimizeModule opts mse@(ms,eenv) mo@(_,mi) = case mi of
+  | mstatus mi == MSComplete && isModRes mi = do
-  ModMod m0 | mstatus m0 == MSComplete && isModRes m0 -> do
       (mo1,_) <- evalModule oopts mse mo
       let mo2 = shareModule optim mo1
       return (mo2,eenv)
-  _ -> evalModule oopts mse mo
+  | otherwise = evalModule oopts mse mo
  where
    oopts = opts `addOptions` flagsModule mo
    optim = flag optOptimizations oopts
 
-evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo) -> 
+evalModule :: Options -> ([SourceModule],EEnv) -> SourceModule -> Err (SourceModule,EEnv)
-               Err ((Ident,SourceModInfo),EEnv)
+evalModule oopts (ms,eenv) mo@(name,m0)
-evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
+  | mstatus m0 == MSComplete =
-
+      case mtype m0 of
-  ModMod m0 | mstatus m0 == MSComplete -> case mtype m0 of
          _ | isModRes m0 -> do
                let deps = allOperDependencies name (jments m0)
                ids <- topoSortOpers deps
@@ -74,15 +72,15 @@ evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
 
          MTConcrete a -> do
                js' <- mapMTree (evalCncInfo oopts gr name a) (jments m0)
-      return $ ((name, ModMod (replaceJudgements m0 js')),eenv)
+               return $ ((name,replaceJudgements m0 js'),eenv)
 
-    _ -> return $ ((name,mod),eenv)
+         _ -> return $ (mo,eenv)
-  _ -> return $ ((name,mod),eenv)
+  | otherwise = return $ (mo,eenv)
  where
    gr0 = MGrammar $ ms
-   gr  = MGrammar $ (name,mod) : ms
+   gr  = MGrammar $ mo : ms
 
-   evalOp g@(MGrammar ((_, ModMod m) : _)) i = do
+   evalOp g@(MGrammar ((_,m) : _)) i = do
      info  <- lookupTree prt i $ jments m
      info' <- evalResInfo oopts gr (i,info)
      return $ updateRes g name i info'

src/GF/Compile/OptimizeGF.hs

@@ -33,23 +33,19 @@ import qualified Data.Map as Map
 import qualified Data.ByteString.Char8 as BS
 import Data.List
 
-optModule :: (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+optModule :: SourceModule -> SourceModule
 optModule = subexpModule . shareModule
 
 shareModule = processModule optim
 
-unoptModule :: SourceGrammar -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+unoptModule :: SourceGrammar -> SourceModule -> SourceModule
 unoptModule gr = unshareModule gr . unsubexpModule
 
-unshareModule :: SourceGrammar -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+unshareModule :: SourceGrammar -> SourceModule -> SourceModule
 unshareModule gr = processModule (const (unoptim gr))
 
-processModule :: 
+processModule :: (Ident -> Term -> Term) -> SourceModule -> SourceModule
-  (Ident -> Term -> Term) -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
+processModule opt (i,mo) = (i,M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo)))
-processModule opt (i,m) = case m of
-  M.ModMod mo -> 
-    (i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo))))
-  _ -> (i,m)
 
 shareInfo :: (Ident -> Term -> Term) -> (Ident,Info) -> Info
 shareInfo opt (c, CncCat ty (Yes t) m) = CncCat ty (Yes (opt c t)) m
@@ -169,22 +165,19 @@ cse is possible in the grammar. It is used by the flag pg -printer=subs.
 -}
 
 subexpModule :: SourceModule -> SourceModule
-subexpModule (n,m) = errVal (n,m) $ case m of
+subexpModule (n,mo) = errVal (n,mo) $ do
-  M.ModMod mo -> do
   let ljs = tree2list (M.jments mo)
   (tree,_) <- appSTM (getSubtermsMod n ljs) (Map.empty,0)
   js2 <- liftM buildTree $ addSubexpConsts n tree $ ljs
-    return (n,M.ModMod (M.replaceJudgements mo js2))
+  return (n,M.replaceJudgements mo js2)
-  _ -> return (n,m)
 
 unsubexpModule :: SourceModule -> SourceModule
-unsubexpModule sm@(i,m) = case m of
+unsubexpModule sm@(i,mo)
-    M.ModMod mo | hasSub ljs ->
+  | hasSub ljs = (i,M.replaceJudgements mo (rebuild (map unparInfo ljs)))
-      (i, M.ModMod (M.replaceJudgements mo
+  | otherwise  = sm
-                     (rebuild (map unparInfo ljs)))) 
-                        where ljs = tree2list (M.jments mo)
-    _ -> (i,m)
   where
+    ljs = tree2list (M.jments mo) 
+
     -- perform this iff the module has opers
     hasSub ljs = not $ null [c | (c,ResOper _ _) <- ljs]
     unparInfo (c,info) = case info of

src/GF/Compile/Rebuild.hs

@@ -27,6 +27,7 @@ import GF.Infra.Option
 import GF.Data.Operations
 
 import Data.List (nub)
+import Data.Maybe (isNothing)
 
 -- | rebuilding instance + interface, and "with" modules, prior to renaming. 
 -- AR 24/10/2003
@@ -39,13 +40,13 @@ rebuildModule ms mo@(i,mi) = do
   mi'  <- case mi of
 
     -- add the information given in interface into an instance module
-    ModMod m -> do
+    m | isNothing (mwith m) -> do
       testErr (null is || mstatus m == MSIncomplete) 
               ("module" +++ prt i +++ 
                "has open interfaces and must therefore be declared incomplete") 
       case mtype m of
         MTInstance i0 -> do
-          m1 <- lookupModMod gr i0
+          m1 <- lookupModule gr i0
           testErr (isModRes m1) ("interface expected instead of" +++ prt i0)
           m' <- do
             js' <- extendMod False (i0,const True) i (jments m1) (jments m)
@@ -53,7 +54,7 @@ rebuildModule ms mo@(i,mi) = do
             case extends m of
               [] -> return $ replaceJudgements m js'
               j0s -> do 
-                m0s <- mapM (lookupModMod gr) j0s
+                m0s <- mapM (lookupModule gr) j0s
                 let notInM0 c _  = all (not . isInBinTree c . jments) m0s
                 let js2 = filterBinTree notInM0 js'
                 return $ (replaceJudgements m js2) 
@@ -61,37 +62,35 @@ rebuildModule ms mo@(i,mi) = do
                     buildTree (tree2list (positions m1) ++ 
                                tree2list (positions m))}
 --          checkCompleteInstance m1 m'
-          return $ ModMod m'
+          return m'
         _ -> return mi
 
     -- add the instance opens to an incomplete module "with" instances
-    --      ModWith mt stat ext me ops -> do
+    ModInfo mt stat fs_ me (Just (ext,incl,ops)) ops_ js_ ps_ -> do
-    ModWith (Module mt stat fs_ me ops_ js_ ps_) (ext,incl) ops -> do
+      let insts = [(inf,inst) | OQualif inf inst <- ops]
-      let insts = [(inf,inst) | OQualif _ inf inst <- ops]
       let infs  = map fst insts
       let stat' = ifNull MSComplete (const MSIncomplete)
                     [i | i <- is, notElem i infs]
       testErr (stat' == MSComplete || stat == MSIncomplete) 
               ("module" +++ prt i +++ "remains incomplete")
-      Module mt0 _ fs me' ops0 js ps0 <- lookupModMod gr ext
+      ModInfo mt0 _ fs me' _ ops0 js ps0 <- lookupModule gr ext
       let ops1 = nub $
                    ops_ ++ -- N.B. js has been name-resolved already
                    ops ++ [o | o <- ops0, notElem (openedModule o) infs]
-                       ++ [oQualif i i | i <- map snd insts] ----
+                       ++ [OQualif i i | i <- map snd insts] ----
-                       ++ [oSimple i   | i <- map snd insts] ----
+                       ++ [OSimple i   | i <- map snd insts] ----
 
       --- check if me is incomplete
       let fs1 = fs `addOptions` fs_                           -- new flags have priority
       let js0 = [ci | ci@(c,_) <- tree2list js, isInherited incl c]
       let js1 = buildTree (tree2list js_ ++ js0)
       let ps1 = buildTree (tree2list ps_ ++ tree2list ps0)
-      return $ ModMod $ Module mt0 stat' fs1 me ops1 js1 ps1 
+      return $ ModInfo mt0 stat' fs1 me Nothing ops1 js1 ps1
-                          ---- (mapTree (qualifInstanceInfo insts) js) -- not needed
 
     _ -> return mi
   return (i,mi')
 
-checkCompleteInstance :: SourceRes -> SourceRes -> Err ()
+checkCompleteInstance :: SourceModInfo -> SourceModInfo -> Err ()
 checkCompleteInstance abs cnc = ifNull (return ()) (Bad . unlines) $
   checkComplete [f | (f, ResOper (Yes _) _) <- abs'] cnc'
    where

src/GF/Compile/Refresh.hs

@@ -109,11 +109,11 @@ refreshGrammar :: SourceGrammar -> Err SourceGrammar
 refreshGrammar = liftM (MGrammar . snd) . foldM refreshModule (0,[]) . modules
 
 refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule])
-refreshModule (k,ms) mi@(i,m) = case m of
+refreshModule (k,ms) mi@(i,mo)
-    ModMod mo | (isModCnc mo || isModRes mo) -> do
+  | isModCnc mo || isModRes mo = do
       (k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo
-      return (k', (i, ModMod(replaceJudgements mo (buildTree js'))) : ms)
+      return (k', (i, replaceJudgements mo (buildTree js')) : ms)
-    _ -> return (k, mi:ms)
+  | otherwise = return (k, mi:ms)
  where
   refreshRes (k,cs) ci@(c,info) = case info of
     ResOper ptyp (Yes trm) -> do   ---- refresh ptyp

src/GF/Compile/RemoveLiT.hs

@@ -32,13 +32,10 @@ import Control.Monad
 removeLiT :: SourceGrammar -> Err SourceGrammar
 removeLiT gr = liftM MGrammar $ mapM (remlModule gr) (modules gr)
 
-remlModule :: SourceGrammar -> (Ident,SourceModInfo) -> Err (Ident,SourceModInfo)
+remlModule :: SourceGrammar -> SourceModule -> Err SourceModule
-remlModule gr mi@(name,mod) = case mod of
+remlModule gr mi@(name,mo) = do
-  ModMod mo -> do
   js1 <- mapMTree (remlResInfo gr) (jments mo)
-    let mod2 = ModMod $ mo {jments = js1}
+  return (name,mo{jments = js1})
-    return $ (name,mod2)
-  _ -> return mi
 
 remlResInfo :: SourceGrammar -> (Ident,Info) -> Err Info
 remlResInfo gr (i,info) = case info of
@@ -59,6 +56,6 @@ remlTerm gr trm = case trm of
   _ -> composOp (remlTerm gr) trm
  where
    look c = err (const $ return defLinType) return $ lookupLincat gr m c
-   m = case [cnc | (cnc,ModMod m) <- modules gr, isModCnc m] of
+   m = case [cnc | (cnc,m) <- modules gr, isModCnc m] of
      cnc:_ -> cnc   -- actually there is always exactly one
      _     -> cCNC

src/GF/Compile/Rename.hs

@@ -49,18 +49,16 @@ renameGrammar g = liftM (MGrammar . reverse) $ foldM renameModule [] (modules g)
 -- | this gives top-level access to renaming term input in the cc command
 renameSourceTerm :: SourceGrammar -> Ident -> Term -> Err Term
 renameSourceTerm g m t = do
-  mo     <- lookupErr m (modules g)
+  mo     <- lookupModule g m
   status <- buildStatus g m mo
   renameTerm status [] t
 
 renameModule :: [SourceModule] -> SourceModule -> Err [SourceModule]
-renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of
+renameModule ms (name,mo) = errIn ("renaming module" +++ prt name) $ do
-  ModMod mo -> do
   let js1 = jments mo
-    status <- buildStatus (MGrammar ms) name mod
+  status <- buildStatus (MGrammar ms) name mo
   js2    <- mapsErrTree (renameInfo mo status) js1
-    let mod2 = ModMod $ mo {opens = map forceQualif (opens mo), jments = js2}
+  return $ (name, mo {opens = map forceQualif (opens mo), jments = js2}) : ms
-    return $ (name,mod2) : ms
 
 type Status = (StatusTree, [(OpenSpec Ident, StatusTree)])
 
@@ -86,9 +84,9 @@ renameIdentTerm env@(act,imps) t =
     return $ f c
   _ -> return t
  where
-   opens  = [st  | (OSimple _ _,st) <- imps]
+   opens  = [st  | (OSimple _,st) <- imps]
-   qualifs = [(m, st) | (OQualif _ m _, st) <- imps] ++ 
+   qualifs = [(m, st) | (OQualif m _, st) <- imps] ++ 
-             [(m, st) | (OSimple _ m, st) <- imps] -- qualif is always possible
+             [(m, st) | (OSimple m, st) <- imps] -- qualif is always possible
 
    -- this facility is mainly for BWC with GF1: you need not import PredefAbs
    predefAbs c s
@@ -126,47 +124,38 @@ info2status mq (c,i) = case i of
 
 tree2status :: OpenSpec Ident -> BinTree Ident Info -> BinTree Ident StatusInfo
 tree2status o = case o of
-  OSimple _ i   -> mapTree (info2status (Just i))
+  OSimple i   -> mapTree (info2status (Just i))
-  OQualif _ i j -> mapTree (info2status (Just j))
+  OQualif i j -> mapTree (info2status (Just j))
 
 buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status
-buildStatus gr c mo = let mo' = self2status c mo in case mo of
+buildStatus gr c mo = let mo' = self2status c mo in do
-  ModMod m -> do
+    let gr1 = MGrammar ((c,mo) : modules gr)
-    let gr1 = MGrammar $ (c,mo) : modules gr 
+        ops = [OSimple e | e <- allExtends gr1 c] ++ allOpens mo
-        ops = [OSimple OQNormal e | e <- allExtends gr1 c] ++ allOpens m
     mods <- mapM (lookupModule gr1 . openedModule) ops
     let sts = map modInfo2status $ zip ops mods    
-    return $ if isModCnc m
+    return $ if isModCnc mo
       then (emptyBinTree, reverse sts) -- the module itself does not define any names
       else (mo',reverse sts) -- so the empty ident is not needed
 
 modInfo2status :: (OpenSpec Ident,SourceModInfo) -> (OpenSpec Ident, StatusTree)
-modInfo2status (o,i) = (o,case i of
+modInfo2status (o,mo) = (o,tree2status o (jments mo))
-  ModMod m -> tree2status o (jments m)
-  )
 
 self2status :: Ident -> SourceModInfo -> StatusTree
-self2status c i = mapTree (info2status (Just c)) js where   -- qualify internal
+self2status c m = mapTree (info2status (Just c)) js where   -- qualify internal
-  js = case i of
+  js | isModTrans m = sorted2tree $ tree2list $ jments m 
-    ModMod m 
+     | otherwise    = jments m
-      | isModTrans m -> sorted2tree $ filter noTrans $ tree2list $ jments m 
-      | otherwise -> jments m
-  noTrans (_,d) = case d of  -- to enable other than transfer js in transfer module 
-    AbsTrans _ -> False
-    _ -> True
 
 forceQualif o = case o of
-  OSimple q i   -> OQualif q i i
+  OSimple i   -> OQualif i i
-  OQualif q _ i -> OQualif q i i
+  OQualif _ i -> OQualif i i
   
-renameInfo :: Module Ident Info -> Status -> (Ident,Info) -> Err (Ident,Info)
+renameInfo :: SourceModInfo -> Status -> (Ident,Info) -> Err (Ident,Info)
 renameInfo mo status (i,info) = errIn 
     ("renaming definition of" +++ prt i +++ showPosition mo i) $ 
                                 liftM ((,) i) $ case info of
   AbsCat pco pfs -> liftM2 AbsCat (renPerh (renameContext status) pco)
                                   (renPerh (mapM rent) pfs)
   AbsFun pty ptr -> liftM2 AbsFun (ren pty) (ren ptr)
-  AbsTrans f -> liftM AbsTrans (rent f)
 
   ResOper pty ptr -> liftM2 ResOper (ren pty) (ren ptr)
   ResOverload os tysts -> 

src/GF/Compile/Update.hs

@@ -32,11 +32,9 @@ import Control.Monad
 -- | update a resource module by adding a new or changing an old definition
 updateRes :: SourceGrammar -> Ident -> Ident -> Info -> SourceGrammar
 updateRes gr@(MGrammar ms) m i info = MGrammar $ map upd ms where
-  upd (n,mod) 
+  upd (n,mo)
-    | n /= m = (n,mod)
+    | n /= m = (n,mo)
-    | n == m = case mod of
+    | n == m = (n,updateModule mo i info)
-       ModMod r -> (m,ModMod $ updateModule r i info)
-       _ -> (n,mod) --- no error msg
 
 -- | combine a list of definitions into a balanced binary search tree
 buildAnyTree :: [(Ident,Info)] -> Err (BinTree Ident Info)

src/GF/Grammar/Grammar.hs

@@ -18,9 +18,6 @@ module GF.Grammar.Grammar (SourceGrammar,
                 emptySourceGrammar,                
 		SourceModInfo,
 		SourceModule,
-		SourceAbs,
-		SourceRes,
-		SourceCnc,
                 mapSourceModule,
 		Info(..),
                 PValues,
@@ -72,12 +69,8 @@ type SourceModInfo = ModInfo Ident Info
 
 type SourceModule = (Ident, SourceModInfo)
 
-type SourceAbs = Module Ident Info
+mapSourceModule :: (SourceModInfo -> SourceModInfo) -> (SourceModule -> SourceModule)
-type SourceRes = Module Ident Info
+mapSourceModule f (i,mi) = (i, f mi)
-type SourceCnc = Module Ident Info
-
-mapSourceModule :: (Module Ident Info -> Module Ident Info) -> SourceModule -> SourceModule
-mapSourceModule f (i,mi) = (i, mapModules' f mi)
 
 -- this is created in CheckGrammar, and so are Val and PVal
 type PValues = [Term]
@@ -95,7 +88,6 @@ data Info =
 -- judgements in abstract syntax
    AbsCat   (Perh Context) (Perh [Term])   -- ^ (/ABS/) constructors; must be 'Id' or 'QId'
  | AbsFun   (Perh Type) (Perh Term)        -- ^ (/ABS/) 'Yes f' = canonical
- | AbsTrans Term                           -- ^ (/ABS/)
 
 -- judgements in resource
  | ResParam (Perh ([Param],Maybe PValues)) -- ^ (/RES/)

src/GF/Grammar/LookAbs.hs

@@ -29,25 +29,19 @@ import Control.Monad
 -- | this is needed at compile time
 lookupFunType :: Grammar -> Ident -> Ident -> Err Type
 lookupFunType gr m c = do
-  mi   <- lookupModule gr m
+  mo <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
   info <- lookupIdentInfo mo c
   case info of
     AbsFun (Yes t) _  -> return t
     AnyInd _ n  -> lookupFunType gr n c
     _ -> prtBad "cannot find type of" c
-    _ -> Bad $ prt m +++ "is not an abstract module"
 
 -- | this is needed at compile time
 lookupCatContext :: Grammar -> Ident -> Ident -> Err Context
 lookupCatContext gr m c = do
-  mi   <- lookupModule gr m
+  mo <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
   info <- lookupIdentInfo mo c
   case info of
     AbsCat (Yes co) _ -> return co
     AnyInd _ n        -> lookupCatContext gr n c
     _                 -> prtBad "unknown category" c
-    _ -> Bad $ prt m +++ "is not an abstract module"

src/GF/Grammar/Lookup.hs

@@ -56,9 +56,7 @@ lookupResDefKind gr m c
    ---- was PredefAbs till 3/9/2008, with explanation: need this in gf3 12/6/2008 
  | otherwise = look True m c where 
   look isTop m c = do
-    mi   <- lookupModule gr m
+    mo <- lookupModule gr m
-    case mi of
-      ModMod mo -> do
     info <- lookupIdentInfoIn mo m c
     case info of
       ResOper _ (Yes t) -> return (qualifAnnot m t, 0) 
@@ -75,15 +73,12 @@ lookupResDefKind gr m c
       ResParam _        -> return (QC m c,2)
       ResValue _        -> return (QC m c,2)
       _   -> Bad $ prt c +++ "is not defined in resource" +++ prt m
-      _ -> Bad $ prt m +++ "is not a resource"
   lookExt m c =
     checks ([look False n c | n <- allExtensions gr m] ++ [return (Q m c,3)])
 
 lookupResType :: SourceGrammar -> Ident -> Ident -> Err Type
 lookupResType gr m c = do
-  mi   <- lookupModule gr m
+  mo <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
   info <- lookupIdentInfo mo c
   case info of
     ResOper (Yes t) _ -> return $ qualifAnnot m t
@@ -99,13 +94,12 @@ lookupResType gr m c = do
     ResParam _        -> return $ typePType
     ResValue (Yes (t,_))  -> return $ qualifAnnotPar m t
     _   -> Bad $ prt c +++ "has no type defined in resource" +++ prt m
-    _ -> Bad $ prt m +++ "is not a resource"
   where
     lookFunType e m c = do
           a  <- abstractOfConcrete gr m
           lookFun e m c a
     lookFun e m c a = do
-          mu <- lookupModMod gr a
+          mu <- lookupModule gr a
           info <- lookupIdentInfo mu c
           case info of
             AbsFun (Yes ty) _ -> return $ redirectTerm e ty 
@@ -115,9 +109,7 @@ lookupResType gr m c = do
 
 lookupOverload :: SourceGrammar -> Ident -> Ident -> Err [([Type],(Type,Term))]
 lookupOverload gr m c = do
-    mi   <- lookupModule gr m
+    mo <- lookupModule gr m
-    case mi of
-      ModMod mo -> do
     info <- lookupIdentInfo mo c
     case info of
       ResOverload os tysts -> do
@@ -128,31 +120,24 @@ lookupOverload gr m c = do
 
       AnyInd _ n  -> lookupOverload gr n c
       _   -> Bad $ prt c +++ "is not an overloaded operation"
-      _ -> Bad $ prt m +++ "is not a resource"
 
 lookupOrigInfo :: SourceGrammar -> Ident -> Ident -> Err Info
 lookupOrigInfo gr m c = do
-    mi   <- lookupModule gr m
+    mo <- lookupModule gr m
-    case mi of
-      ModMod mo -> do
     info <- lookupIdentInfo mo c
     case info of
       AnyInd _ n  -> lookupOrigInfo gr n c
       i           -> return i
-      _ -> Bad $ prt m +++ "is not run-time module"
 
 lookupParams :: SourceGrammar -> Ident -> Ident -> Err ([Param],Maybe PValues)
 lookupParams gr = look True where 
   look isTop m c = do
-    mi   <- lookupModule gr m
+    mo <- lookupModule gr m
-    case mi of
-      ModMod mo -> do
     info <- lookupIdentInfo mo c
     case info of
       ResParam (Yes psm) -> return psm
       AnyInd _ n         -> look False n c
       _                  -> Bad $ prt c +++ "has no parameters defined in resource" +++ prt m
-      _ -> Bad $ prt m +++ "is not a resource"
   lookExt m c =
     checks [look False n c | n <- allExtensions gr m]
 
@@ -190,9 +175,8 @@ lookupIndexValue gr ty i = do
 
 allOrigInfos :: SourceGrammar -> Ident -> [(Ident,Info)]
 allOrigInfos gr m = errVal [] $ do
-  mi <- lookupModule gr m
+  mo <- lookupModule gr m
-  case mi of
+  return [(c,i) | (c,_) <- tree2list (jments mo), Ok i <- [look c]]
-    ModMod mo -> return [(c,i) | (c,_) <- tree2list (jments mo), Ok i <- [look c]]
   where
     look = lookupOrigInfo gr m
 
@@ -225,36 +209,29 @@ qualifAnnotPar m t = case t of
 
 lookupAbsDef :: SourceGrammar -> Ident -> Ident -> Err (Maybe Term)
 lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
-  mi   <- lookupModule gr m
+  mo <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
   info <- lookupIdentInfo mo c
   case info of
-        AbsFun _ (Yes t)  -> return $ return t
+    AbsFun _ (Yes t) -> return (Just t)
     AnyInd _ n       -> lookupAbsDef gr n c
     _                -> return Nothing
-    _ -> Bad $ prt m +++ "is not an abstract module"
 
 lookupLincat :: SourceGrammar -> Ident -> Ident -> Err Type
 lookupLincat gr m c | isPredefCat c = return defLinType --- ad hoc; not needed?
 lookupLincat gr m c = do
-  mi <- lookupModule gr m
+  mo <- lookupModule gr m
-  case mi of
-    ModMod mo -> do
   info <- lookupIdentInfo mo c
   case info of
     CncCat (Yes t) _ _ -> return t
     AnyInd _ n         -> lookupLincat gr n c
     _                  -> Bad $ prt c +++ "has no linearization type in" +++ prt m
-    _ -> Bad $ prt m +++ "is not concrete"
-
 
 -- The first type argument is uncomputed, usually a category symbol.
 -- This is a hack to find implicit (= reused) opers.
 
 opersForType :: SourceGrammar -> Type -> Type -> [(QIdent,Term)]
 opersForType gr orig val = 
-  [((i,f),ty) | (i,m) <- allModMod gr, (f,ty) <- opers i m val] where
+  [((i,f),ty) | (i,m) <- modules gr, (f,ty) <- opers i m val] where
     opers i m val = 
       [(f,ty) |
         (f,ResOper (Yes ty) _) <- tree2list $ jments m,
@@ -263,7 +240,7 @@ opersForType gr orig val =
         ] ++
       let cat = err error snd (valCat orig) in --- ignore module
       [(f,ty) |
-        Ok a <- [abstractOfConcrete gr i >>= lookupModMod gr],
+        Ok a <- [abstractOfConcrete gr i >>= lookupModule gr],
         (f, AbsFun (Yes ty0) _) <- tree2list $ jments a,
         let ty = redirectTerm i ty0,
         Ok valt  <- [valCat ty],

src/GF/Grammar/PrGrammar.hs

@@ -78,7 +78,7 @@ pprintTree = compactPrint . P.printTree
 prGrammar :: SourceGrammar -> String
 prGrammar = pprintTree . trGrammar
 
-prModule :: (Ident, SourceModInfo) -> String
+prModule :: SourceModule -> String
 prModule  = pprintTree . trModule
 
 instance Print Term where
@@ -254,10 +254,10 @@ lookupIdent c t = case lookupTree prt c t of
   Ok v -> return v
   _ -> prtBad "unknown identifier" c
 
-lookupIdentInfo :: Module Ident a -> Ident -> Err a
+lookupIdentInfo :: ModInfo Ident a -> Ident -> Err a
 lookupIdentInfo mo i = lookupIdent i (jments mo)
 
-lookupIdentInfoIn :: Module Ident a -> Ident -> Ident -> Err a
+lookupIdentInfoIn :: ModInfo Ident a -> Ident -> Ident -> Err a
 lookupIdentInfoIn mo m i = 
   err (\s -> Bad (s +++ "in module" +++ prt m)) return $ lookupIdentInfo mo i
 

src/GF/Infra/Dependencies.hs

@@ -46,7 +46,7 @@ data ModDeps = ModDeps {
 noModDeps = ModDeps MTAbstract [] [] [] [] [] []
 
 grammar2moddeps :: SourceGrammar -> [(Ident,ModDeps)]
-grammar2moddeps gr = [(i,depMod m) | (i,ModMod m) <- modules gr] where
+grammar2moddeps gr = [(i,depMod m) | (i,m) <- modules gr] where
   depMod m = noModDeps{
     modtype = mtype m,
     ofs     = case mtype m of 

src/GF/Infra/Modules.hs

@@ -19,23 +19,22 @@
 -----------------------------------------------------------------------------
 
 module GF.Infra.Modules (
-		MGrammar(..), ModInfo(..), Module(..), ModuleType(..),
+		MGrammar(..), ModInfo(..), ModuleType(..),
-		MReuseType(..), MInclude (..),
+		MInclude (..),
 		extends, isInherited,inheritAll, 
                 updateMGrammar, updateModule, replaceJudgements, addFlag,
-		addOpenQualif, flagsModule, allFlags, mapModules, mapModules',
+		addOpenQualif, flagsModule, allFlags, mapModules,
-		MainGrammar(..), MainConcreteSpec(..), OpenSpec(..), OpenQualif(..),
+		OpenSpec(..),
-		oSimple, oQualif,
 		ModuleStatus(..),
 		openedModule, allOpens, depPathModule, allDepsModule, partOfGrammar,
 		allExtends, allExtendSpecs, allExtendsPlus, allExtensions, 
                 searchPathModule, addModule,
-		emptyMGrammar, emptyModInfo, emptyModule,
+		emptyMGrammar, emptyModInfo,
 		IdentM(..),
-		typeOfModule, abstractOfConcrete, abstractModOfConcrete,
+		abstractOfConcrete, abstractModOfConcrete,
-		lookupModule, lookupModuleType, lookupModMod, lookupInfo,
+		lookupModule, lookupModuleType, lookupInfo,
                 lookupPosition, showPosition,
-		allModMod, isModAbs, isModRes, isModCnc, isModTrans,
+		isModAbs, isModRes, isModCnc, isModTrans,
 		sameMType, isCompilableModule, isCompleteModule,
 		allAbstracts, greatestAbstract, allResources,
 		greatestResource, allConcretes, allConcreteModules
@@ -54,27 +53,22 @@ import Data.List
 -- The parameters tell what kind of data is involved.
 -- Invariant: modules are stored in dependency order
 
-data MGrammar i a = MGrammar {modules :: [(i,ModInfo i a)]}
+newtype MGrammar i a = MGrammar {modules :: [(i,ModInfo i a)]}
   deriving Show
 
-data ModInfo i a =
+data ModInfo i a = ModInfo {
-    ModMainGrammar (MainGrammar i)
-  | ModMod  (Module i a)
-  | ModWith (Module i a) (i,MInclude i) [OpenSpec i]
-  deriving Show
-
-data Module i a = Module {
     mtype   :: ModuleType i ,
     mstatus :: ModuleStatus ,
     flags   :: Options,
     extend  :: [(i,MInclude i)],
+    mwith   :: Maybe (i,MInclude i,[OpenSpec i]),
     opens   :: [OpenSpec i] ,
     jments  :: BinTree i a ,
     positions :: BinTree i (String,(Int,Int)) -- file, first line, last line
   }
 ---  deriving Show
-instance Show (Module i a) where
+instance Show (ModInfo i a) where
-  show _ = "cannot show Module with FiniteMap"
+  show _ = "cannot show ModInfo with FiniteMap"
 
 -- | encoding the type of the module
 data ModuleType i = 
@@ -85,17 +79,12 @@ data ModuleType i =
     -- ^ up to this, also used in GFC. Below, source only.
   | MTInterface
   | MTInstance i 
-  | MTReuse (MReuseType i)
-  | MTUnion (ModuleType i) [(i,[i])] -- ^ not meant to be recursive
-  deriving (Eq,Ord,Show)
-
-data MReuseType i = MRInterface i | MRInstance i i | MRResource i
   deriving (Eq,Ord,Show)
 
 data MInclude i = MIAll | MIOnly [i] | MIExcept [i]
   deriving (Eq,Ord,Show)
 
-extends :: Module i a -> [i]
+extends :: ModInfo i a -> [i]
 extends = map fst . extend
 
 isInherited :: Eq i => MInclude i -> i -> Bool
@@ -117,68 +106,32 @@ updateMGrammar old new = MGrammar $
    os = modules old
    ns = modules new
 
-updateModule :: Ord i => Module i t -> i -> t -> Module i t
+updateModule :: Ord i => ModInfo i t -> i -> t -> ModInfo i t
-updateModule (Module  mt ms fs me ops js ps) i t = 
+updateModule (ModInfo mt ms fs me mw ops js ps) i t = ModInfo mt ms fs me mw ops (updateTree (i,t) js) ps
-  Module mt ms fs me ops (updateTree (i,t) js) ps
 
-replaceJudgements :: Module i t -> BinTree i t -> Module i t
+replaceJudgements :: ModInfo i t -> BinTree i t -> ModInfo i t
-replaceJudgements (Module mt ms fs me ops _ ps) js = Module mt ms fs me ops js ps
+replaceJudgements (ModInfo mt ms fs me mw ops _ ps) js = ModInfo mt ms fs me mw ops js ps
 
-addOpenQualif :: i -> i -> Module i t -> Module i t
+addOpenQualif :: i -> i -> ModInfo i t -> ModInfo i t
-addOpenQualif i j (Module mt ms fs me ops js ps) = 
+addOpenQualif i j (ModInfo mt ms fs me mw ops js ps) = ModInfo mt ms fs me mw (OQualif i j : ops) js ps
-  Module mt ms fs me (oQualif i j : ops) js ps
 
-addFlag :: Options -> Module i t -> Module i t
+addFlag :: Options -> ModInfo i t -> ModInfo i t
 addFlag f mo = mo {flags = flags mo `addOptions` f} 
 
 flagsModule :: (i,ModInfo i a) -> Options
-flagsModule (_,mi) = case mi of
+flagsModule (_,mi) = flags mi
-  ModMod m -> flags m
-  _ -> noOptions
 
 allFlags :: MGrammar i a -> Options
-allFlags gr = concatOptions $ map flags $ [m | (_, ModMod m) <- modules gr]
+allFlags gr = concatOptions [flags m | (_,m) <- modules gr]
 
-mapModules :: (Module i a -> Module i a) 
+mapModules :: (ModInfo i a -> ModInfo i a) -> MGrammar i a -> MGrammar i a 
-	   -> MGrammar i a -> MGrammar i a 
+mapModules f (MGrammar ms) = MGrammar (map (onSnd f) ms)
-mapModules f = MGrammar . map (onSnd (mapModules' f)) . modules
-
-mapModules' :: (Module i a -> Module i a) 
-	   -> ModInfo i a -> ModInfo i a 
-mapModules' f (ModMod m) = ModMod (f m)
-mapModules' _ m = m
-
-data MainGrammar i = MainGrammar {
-    mainAbstract  :: i ,
-    mainConcretes :: [MainConcreteSpec i]
-  }
-  deriving Show
-
-data MainConcreteSpec i = MainConcreteSpec {
-    concretePrintname :: i ,
-    concreteName :: i ,
-    transferIn   :: Maybe (OpenSpec i) ,  -- ^ if there is an in-transfer
-    transferOut  :: Maybe (OpenSpec i)    -- ^ if there is an out-transfer
-  }
-  deriving Show
 
 data OpenSpec i = 
-   OSimple OpenQualif i 
+   OSimple i 
- | OQualif OpenQualif i i
+ | OQualif i i
   deriving (Eq,Ord,Show)
 
-data OpenQualif =
-   OQNormal
- | OQInterface
- | OQIncomplete
-  deriving (Eq,Ord,Show)
-
-oSimple :: i -> OpenSpec i
-oSimple = OSimple OQNormal
-
-oQualif :: i -> i -> OpenSpec i
-oQualif = OQualif OQNormal
-
 data ModuleStatus = 
    MSComplete 
  | MSIncomplete 
@@ -186,29 +139,31 @@ data ModuleStatus =
 
 openedModule :: OpenSpec i -> i
 openedModule o = case o of
-  OSimple _ m -> m
+  OSimple m -> m
-  OQualif _ _ m -> m
+  OQualif _ m -> m
 
-allOpens :: Module i a -> [OpenSpec i]
+allOpens :: ModInfo i a -> [OpenSpec i]
 allOpens m = case mtype m of
   MTTransfer a b -> a : b : opens m
   _ -> opens m
 
 -- | initial dependency list
-depPathModule :: Ord i => Module i a -> [OpenSpec i]
+depPathModule :: Ord i => ModInfo i a -> [OpenSpec i]
-depPathModule m = fors m ++ exts m ++ opens m where
+depPathModule m = fors m ++ exts m ++ opens m
-  fors m = case mtype m of
+  where
+    fors m = 
+      case mtype m of
         MTTransfer i j -> [i,j]
-    MTConcrete i   -> [oSimple i]
+        MTConcrete i   -> [OSimple i]
-    MTInstance i   -> [oSimple i]
+        MTInstance i   -> [OSimple i]
         _              -> []
-  exts m = map oSimple $ extends m
+    exts m = map OSimple (extends m)
 
 -- | all dependencies
-allDepsModule :: Ord i => MGrammar i a -> Module i a -> [OpenSpec i]
+allDepsModule :: Ord i => MGrammar i a -> ModInfo i a -> [OpenSpec i]
 allDepsModule gr m = iterFix add os0 where
   os0 = depPathModule m
-  add os = [m | o <- os, Just (ModMod n) <- [lookup (openedModule o) mods], 
+  add os = [m | o <- os, Just n <- [lookup (openedModule o) mods], 
                 m <- depPathModule n]
   mods = modules gr
 
@@ -217,48 +172,49 @@ partOfGrammar :: Ord i => MGrammar i a -> (i,ModInfo i a) -> MGrammar i a
 partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor] 
   where
     mods = modules gr
-    modsFor = case m of
+    modsFor = (i:) $ map openedModule $ allDepsModule gr m
-      ModMod n -> (i:) $ map openedModule $ allDepsModule gr n
-      ---- ModWith n i os -> i : map openedModule os ++ partOfGrammar (ModMod n) ----
-      _ -> [i]
 
 -- | all modules that a module extends, directly or indirectly, without restricts
 allExtends :: (Show i,Ord i) => MGrammar i a -> i -> [i]
-allExtends gr i = case lookupModule gr i of
+allExtends gr i =
-  Ok (ModMod m) -> case extends m of 
+  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 :: (Show i,Ord i) => MGrammar i a -> i -> [(i,MInclude i)]
-allExtendSpecs gr i = case lookupModule gr i of
+allExtendSpecs gr i =
-  Ok (ModMod m) -> case extend m of 
+  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 :: (Show i,Ord i) => MGrammar i a -> i -> [i]
-allExtendsPlus gr i = case lookupModule gr i of
+allExtendsPlus gr i =
-  Ok (ModMod m) -> i : concatMap (allExtendsPlus gr) (exts m)
+  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 :: (Show i,Ord i) => MGrammar i a -> i -> [i]
-allExtensions gr i = case lookupModule gr i of
+allExtensions gr i =
-  Ok (ModMod m) -> let es = exts i in es ++ concatMap (allExtensions gr) es
+  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) 
                              || elem (MTInstance i) [mtype m]]
-   mods = [(j,m) | (j,ModMod m) <- modules gr]
+   mods = modules gr
 
 -- | initial search path: the nonqualified dependencies
-searchPathModule :: Ord i => Module i a -> [i]
+searchPathModule :: Ord i => ModInfo i a -> [i]
-searchPathModule m = [i | OSimple _ i <- depPathModule m]
+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 :: Ord i => 
@@ -269,11 +225,7 @@ emptyMGrammar :: MGrammar i a
 emptyMGrammar = MGrammar []
 
 emptyModInfo :: ModInfo i a
-emptyModInfo = ModMod emptyModule
+emptyModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] emptyBinTree emptyBinTree
-
-emptyModule :: Module i a
-emptyModule = Module 
-  MTResource MSComplete noOptions [] [] emptyBinTree emptyBinTree
 
 -- | we store the module type with the identifier
 data IdentM i = IdentM {
@@ -282,27 +234,18 @@ data IdentM i = IdentM {
   }
   deriving (Eq,Ord,Show)
 
-typeOfModule :: ModInfo i a -> ModuleType i
-typeOfModule mi = case mi of
-  ModMod m -> mtype m
-
 abstractOfConcrete :: (Show i, Eq i) => MGrammar i a -> i -> Err i
 abstractOfConcrete gr c = do
-  m <- lookupModule gr c
+  n <- lookupModule gr c
-  case m of
+  case mtype n of
-    ModMod n -> case mtype n of
     MTConcrete a -> return a
     _ -> Bad $ "expected concrete" +++ show c
-    _ -> Bad $ "expected concrete" +++ show c
 
 abstractModOfConcrete :: (Show i, Eq i) => 
-                         MGrammar i a -> i -> Err (Module i a)
+                         MGrammar i a -> i -> Err (ModInfo i a)
 abstractModOfConcrete gr c = do
   a <- abstractOfConcrete gr c
-  m <- lookupModule gr a
+  lookupModule gr a
-  case m of
-    ModMod n -> return n
-    _ -> Bad $ "expected abstract" +++ show c
 
 
 -- the canonical file name
@@ -318,56 +261,41 @@ lookupModule gr m = case lookup m (modules gr) of
 lookupModuleType :: (Show i,Eq i) => MGrammar i a -> i -> Err (ModuleType i)
 lookupModuleType gr m = do
   mi <- lookupModule gr m
-  return $ typeOfModule mi
+  return $ mtype mi
 
-lookupModMod :: (Show i,Eq i) => MGrammar i a -> i -> Err (Module i a)
+lookupInfo :: (Show i, Ord i) => ModInfo i a -> i -> Err a
-lookupModMod gr i = do
-  mo <- lookupModule gr i
-  case mo of 
-    ModMod m -> return m
-    _ -> Bad $ "expected proper module, not" +++ show i
-
-lookupInfo :: (Show i, Ord i) => Module i a -> i -> Err a
 lookupInfo mo i = lookupTree show i (jments mo)
 
-lookupPosition :: (Show i, Ord i) => Module i a -> i -> Err (String,(Int,Int))
+lookupPosition :: (Show i, Ord i) => ModInfo i a -> i -> Err (String,(Int,Int))
 lookupPosition mo i = lookupTree show i (positions mo)
 
-showPosition :: (Show i, Ord i) => Module i a -> i -> String
+showPosition :: (Show i, Ord i) => ModInfo i a -> i -> String
 showPosition mo i = case lookupPosition mo i of
   Ok (f,(b,e)) | b == e -> "in" +++ f ++ ", line" +++ show b
   Ok (f,(b,e)) -> "in" +++ f ++ ", lines" +++ show b ++ "-" ++ show e
   _ -> ""
 
-
+isModAbs :: ModInfo i a -> Bool
-allModMod :: (Show i,Eq i) => MGrammar i a -> [(i,Module i a)]
-allModMod gr = [(i,m) | (i, ModMod m) <- modules gr]
-
-isModAbs :: Module i a -> Bool
 isModAbs m = case mtype m of
   MTAbstract -> True
 ----  MTUnion t -> isModAbs t
   _ -> False
 
-isModRes :: Module i a -> Bool
+isModRes :: ModInfo i a -> Bool
 isModRes m = case mtype m of
   MTResource -> True
-  MTReuse _ -> True
-----  MTUnion t -> isModRes t --- maybe not needed, since eliminated early
   MTInterface -> True ---
   MTInstance _ -> True
   _ -> False
 
-isModCnc :: Module i a -> Bool
+isModCnc :: ModInfo i a -> Bool
 isModCnc m = case mtype m of
   MTConcrete _ -> True
-----  MTUnion t -> isModCnc t
   _ -> False
 
-isModTrans :: Module i a -> Bool
+isModTrans :: ModInfo i a -> Bool
 isModTrans m = case mtype m of
   MTTransfer _ _ -> True
-----  MTUnion t -> isModTrans t
   _ -> False
 
 sameMType :: Eq i => ModuleType i -> ModuleType i -> Bool
@@ -390,21 +318,20 @@ sameMType m n = case (n,m) of
 
 -- | don't generate code for interfaces and for incomplete modules
 isCompilableModule :: ModInfo i a -> Bool
-isCompilableModule m = case m of
+isCompilableModule m =
-  ModMod m -> case mtype m of
+  case mtype m of
     MTInterface -> False
     _           -> mstatus m == MSComplete
-  _ -> False ---
 
 -- | interface and "incomplete M" are not complete
-isCompleteModule :: (Eq i) =>  Module i a -> Bool
+isCompleteModule :: (Eq i) =>  ModInfo i a -> Bool
 isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
 
 
 -- | all abstract modules sorted from least to most dependent
 allAbstracts :: (Ord i, Show i) => MGrammar i a -> [i]
 allAbstracts gr = 
- case topoTest [(i,extends m) | (i,ModMod m) <- modules gr, mtype m == MTAbstract] of
+ case topoTest [(i,extends m) | (i,m) <- modules gr, mtype m == MTAbstract] of
    Left is -> is
    Right cycles -> error $ "Cyclic abstract modules: " ++ show cycles
 
@@ -416,7 +343,7 @@ greatestAbstract gr = case allAbstracts gr of
 
 -- | all resource modules
 allResources :: MGrammar i a -> [i]
-allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m || isModCnc m]
+allResources gr = [i | (i,m) <- modules gr, isModRes m || isModCnc m]
 
 -- | the greatest resource in dependency order
 greatestResource :: MGrammar i a -> Maybe i
@@ -427,9 +354,9 @@ greatestResource gr = case allResources gr of
 -- | all concretes for a given abstract
 allConcretes :: Eq i => MGrammar i a -> i -> [i]
 allConcretes gr a = 
-  [i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
+  [i | (i, m) <- modules gr, mtype m == MTConcrete a, isCompleteModule m]
 
 -- | all concrete modules for any abstract
 allConcreteModules :: Eq i => MGrammar i a -> [i]
 allConcreteModules gr = 
-  [i | (i, ModMod m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]
+  [i | (i, m) <- modules gr, MTConcrete _ <- [mtype m], isCompleteModule m]

src/GF/Source/CF.hs

@@ -81,8 +81,8 @@ type CFFun = String
 
 cf2gf :: String -> CF -> SourceGrammar
 cf2gf name cf = MGrammar [
-  (aname, ModMod (emptyModule {mtype = MTAbstract,       jments = abs})),
+  (aname, emptyModInfo{mtype = MTAbstract,       jments = abs}),
-  (cname, ModMod (emptyModule {mtype = MTConcrete aname, jments = cnc}))
+  (cname, emptyModInfo{mtype = MTConcrete aname, jments = cnc})
   ]
  where
    (abs,cnc) = cf2grammar cf

src/GF/Source/GrammarToSource.hs

@@ -35,13 +35,13 @@ trGrammar :: SourceGrammar -> P.Grammar
 trGrammar (MGrammar ms) = P.Gr (map trModule ms) -- no includes
 
 trModule :: (Ident,SourceModInfo) -> P.ModDef
-trModule (i,mo) = case mo of
+trModule (i,m) = P.MModule compl typ body
-  ModMod m -> P.MModule compl typ body where
+  where
     compl = case mstatus m of
       MSIncomplete -> P.CMIncompl
       _ -> P.CMCompl
     i' = tri i
-    typ = case typeOfModule mo of
+    typ = case mtype m of
       MTResource -> P.MTResource i'
       MTAbstract -> P.MTAbstract i'
       MTConcrete a -> P.MTConcrete i' (tri a)
@@ -66,15 +66,8 @@ forName (MTConcrete a) = tri a
 
 trOpen :: OpenSpec Ident -> P.Open
 trOpen o = case o of
-  OSimple OQNormal i -> P.OName (tri i)
+  OSimple i   -> P.OName (tri i)
-  OSimple q i -> P.OQualQO (trQualOpen q) (tri i)
+  OQualif i j -> P.OQual P.QOCompl (tri i) (tri j)
-  OQualif q i j -> P.OQual (trQualOpen q) (tri i) (tri j)
-
-trQualOpen q = case q of
-  OQNormal -> P.QOCompl
-  OQIncomplete -> P.QOIncompl
-  OQInterface -> P.QOInterface
-
 
 mkOpens ds = if null ds then P.NoOpens else P.OpenIn ds
 mkTopDefs ds = ds
@@ -87,8 +80,6 @@ trAnyDef (i,info) = let i' = tri i in case info of
     Yes t -> [P.DefDef [P.DDef [mkName i'] (trt t)]]
     _ -> []
   AbsFun (May b)  _ -> [P.DefFun [P.FunDef [i'] (P.EIndir (tri b))]]
-  ---- don't destroy definitions!
-  AbsTrans f -> [P.DefTrans [P.DDef [mkName i'] (trt f)]]
 
   ResOper pty ptr -> [P.DefOper [trDef i' pty ptr]]
   ResParam pp -> [P.DefPar [case pp of

src/GF/Source/SourceToGrammar.hs

@@ -70,15 +70,9 @@ transGrammar x = case x of
     moddefs' <- mapM transModDef moddefs
     GD.mkSourceGrammar moddefs'
 
-transModDef :: ModDef -> Err (Ident, G.SourceModInfo)
+transModDef :: ModDef -> Err G.SourceModule
 transModDef x = case x of
 
-  MMain id0 id concspecs  -> do
-    id0' <- transIdent id0
-    id'  <- transIdent id
-    concspecs' <- mapM transConcSpec concspecs
-    return $ (id0', GM.ModMainGrammar (GM.MainGrammar id' concspecs'))
-
   MModule compl mtyp body -> do
 
     let mstat' = transComplMod compl
@@ -117,14 +111,7 @@ transModDef x = case x of
         defs'    <- U.buildAnyTree [(i,d) | Left  ds <- defs0, (i,_,d) <- ds]
         flags'   <- return $ concatOptions [o | Right o <- defs0]
         let poss1 = buildPosTree id' poss0
-        return (id',
+        return (id', GM.ModInfo mtyp' mstat' flags' extends' Nothing opens' defs' poss1)
-          GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs' poss1))
-       MReuse _ -> do
-        return (id', GM.ModMod (GM.Module mtyp' mstat' noOptions [] [] emptyBinTree poss))
-       MUnion imps -> do
-        imps' <- mapM transIncluded imps        
-        return (id', 
-          GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' noOptions [] [] emptyBinTree poss))
 
        MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens []
        MWithBody m insts opens defs -> mkBody xx $ MWithEBody [] m insts opens defs
@@ -139,21 +126,11 @@ transModDef x = case x of
         defs'    <- U.buildAnyTree [(i,d) | Left  ds <- defs0, (i,_,d) <- ds]
         flags'   <- return $ concatOptions [o | Right o <- defs0]
         let poss1 = buildPosTree id' poss0
-        return (id',
+        return (id', GM.ModInfo mtyp' mstat' flags' extends' (Just (fst m',snd m',insts')) opens' defs' poss1)
-          GM.ModWith (GM.Module mtyp' mstat' flags' extends' opens' defs' poss1) m' insts')
 
       mkModRes id mtyp body = do
          id' <- transIdent id
-         case body of
+         return (transResDef, mtyp, id')
-           MReuse c -> do
-             c' <- transIdent c
-             mtyp' <- trMReuseType mtyp c'
-             return (transResDef, GM.MTReuse mtyp', id')
-           _ -> return (transResDef, mtyp, id')
-      trMReuseType mtyp c = case mtyp of
-         GM.MTInterface -> return $ GM.MRInterface c
-         GM.MTInstance op -> return $ GM.MRInstance c op
-         GM.MTResource -> return $ GM.MRResource c
 
 
 transComplMod :: ComplMod -> GM.ModuleStatus
@@ -164,13 +141,6 @@ transComplMod x = case x of
 getTopDefs :: [TopDef] -> [TopDef]
 getTopDefs x = x
 
-transConcSpec :: ConcSpec -> Err (GM.MainConcreteSpec Ident)
-transConcSpec x = case x of
-  ConcSpec id concexp  -> do
-    id' <- transIdent id
-    (m,mi,mo) <- transConcExp concexp
-    return $ GM.MainConcreteSpec id' m mi mo
-
 transConcExp :: ConcExp -> 
        Err (Ident, Maybe (GM.OpenSpec Ident),Maybe (GM.OpenSpec Ident))
 transConcExp x = case x of
@@ -205,15 +175,9 @@ transOpens x = case x of
 
 transOpen :: Open -> Err (GM.OpenSpec Ident)
 transOpen x = case x of
-  OName id     -> liftM   (GM.OSimple GM.OQNormal) $ transIdent id
+  OName id     -> liftM  GM.OSimple (transIdent id)
-  OQualQO q id -> liftM2  GM.OSimple (transQualOpen q) (transIdent id)
+  OQualQO q id -> liftM  GM.OSimple (transIdent id)
-  OQual q id m -> liftM3  GM.OQualif  (transQualOpen q) (transIdent id) (transIdent m)
+  OQual q id m -> liftM2 GM.OQualif (transIdent id) (transIdent m)
-
-transQualOpen :: QualOpen -> Err GM.OpenQualif
-transQualOpen x = case x of
-  QOCompl  -> return GM.OQNormal
-  QOInterface  -> return GM.OQInterface
-  QOIncompl  -> return GM.OQIncomplete
 
 transIncluded :: Included -> Err (Ident,[Ident])
 transIncluded x = case x of
@@ -261,9 +225,6 @@ transAbsDef x = case x of
     returnl $ 
       [(c, nopos, G.AbsCat nope (yes ps)) | (c,ps) <- ds'] ++
       [(f, nopos, G.AbsFun nope (yes G.EData))  | (_,fs) <- ds', tf <- fs, f <- funs tf]
-  DefTrans defs  -> do
-    defs' <- liftM concat $ mapM getDefsGen defs
-    returnl [(c, nopos, G.AbsTrans f) | ((c,p),(_,Yes f)) <- defs']
   DefFlag defs -> liftM (Right . concatOptions) $ mapM transFlagDef defs
   _ -> Bad $ "illegal definition in abstract module:" ++++ printTree x
  where

src/exper/Evaluate.hs

@@ -386,7 +386,7 @@ evalConcrete gr mo = mapMTree evaldef mo where
     Bad s -> raise s
 
   noExpand p = errVal False $ do
-    mo <- lookupModMod gr p
+    mo <- lookupModule gr p
     return $ case getOptVal (iOpts (flags mo)) useOptimizer of
       Just "noexpand" -> True
       _ -> False

src/exper/Optimize.hs

@@ -37,10 +37,10 @@ import Data.List
 
 -- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
 -- only do this for resource: concrete is optimized in gfc form
-optimizeModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) -> 
+optimizeModule :: Options -> [(Ident,SourceModule)] -> (Ident,SourceModule) -> 
-                  Err (Ident,SourceModInfo)
+                  Err (Ident,SourceModule)
 optimizeModule opts ms mo@(_,mi) = case mi of
-  ModMod m0@(Module mt st fs me ops js) | st == MSComplete && isModRes m0 -> do
+  m0@(Module mt st fs me ops js) | st == MSComplete && isModRes m0 -> do
       mo1 <- evalModule oopts ms mo
       return $ case optim of
         "parametrize" -> shareModule paramOpt mo1  -- parametrization and sharing
@@ -54,11 +54,10 @@ optimizeModule opts ms mo@(_,mi) = case mi of
    oopts = addOptions opts (iOpts (flagsModule mo))
    optim = maybe "all" id $ getOptVal oopts useOptimizer
 
-evalModule :: Options -> [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) -> 
+evalModule :: Options -> [(Ident,SourceModule)] -> (Ident,SourceModule) -> Err (Ident,SourceModule)
-               Err (Ident,SourceModInfo)
 evalModule oopts ms mo@(name,mod) = case mod of
 
-  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
+  m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
 {-
     -- now: don't optimize resource
 
@@ -72,7 +71,7 @@ evalModule oopts ms mo@(name,mod) = case mod of
 -----      
       js0 <- appEvalConcrete gr js
       js' <- mapMTree (evalCncInfo oopts gr name a) js0 ---- <- gr0 6/12/2005 
-      return $ (name, ModMod (Module mt st fs me ops js'))
+      return $ (name, Module mt st fs me ops js')
 
     _ -> return $ (name,mod)
   _ -> return $ (name,mod)
@@ -80,7 +79,7 @@ evalModule oopts ms mo@(name,mod) = case mod of
    gr0 = MGrammar $ ms
    gr  = MGrammar $ (name,mod) : ms
 
-   evalOp g@(MGrammar ((_, ModMod m) : _)) i = do
+   evalOp g@(MGrammar ((_, m) : _)) i = do
      info  <- lookupTree prt i $ jments m
      info' <- evalResInfo oopts gr (i,info)
      return $ updateRes g name i info'