added positions to Module record; avoided Module constructor where possible; moved Refresh to Compile/

src-3.0/GF/Compile.hs

@@ -12,9 +12,9 @@ import GF.Compile.OptimizeGFCC
 import GF.Compile.GrammarToGFCC
 import GF.Compile.ReadFiles
 import GF.Compile.Update
+import GF.Compile.Refresh
 
 import GF.Grammar.Grammar
-import GF.Grammar.Refresh
 import GF.Grammar.Lookup
 import GF.Grammar.PrGrammar
 

src-3.0/GF/Compile/BackOpt.hs

@@ -34,8 +34,8 @@ type OptSpec = Set Optimization
 
 shareModule :: OptSpec -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
 shareModule opt (i,m) = case m of
-  M.ModMod (M.Module mt st fs me ops js) -> 
+  M.ModMod mo -> 
-    (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
+    (i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo))))
   _ -> (i,m)
 
 shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (shareOptim opt c t)) m)

src-3.0/GF/Compile/CheckGrammar.hs

@@ -29,7 +29,7 @@ import GF.Infra.Modules
 
 import GF.Compile.TypeCheck
 
-import GF.Grammar.Refresh
+import GF.Compile.Refresh
 import GF.Grammar.Grammar
 import GF.Grammar.PrGrammar
 import GF.Grammar.Lookup
@@ -65,9 +65,10 @@ mapsCheckTree f = checkErr . mapsErrTree (\t -> checkStart (f t) >>= return . fs
 checkModule :: [SourceModule] -> SourceModule -> Check [SourceModule]
 checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod of
 
-  ModMod mo@(Module mt st fs me ops js) -> do
+  ModMod mo -> do
+    let js = jments mo
     checkRestrictedInheritance ms (name, mo)
-    js' <- case mt of
+    js' <- case mtype mo of
       MTAbstract -> mapsCheckTree (checkAbsInfo gr name) js
 
       MTTransfer a b -> mapsCheckTree (checkAbsInfo gr name) js
@@ -87,7 +88,7 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod
         -- checkCompleteInstance abs mo -- this is done in Rebuild
         mapsCheckTree (checkResInfo gr name) js
 
-    return $ (name, ModMod (Module mt st fs me ops js')) : ms
+    return $ (name, ModMod (replaceJudgements mo js')) : ms
 
   _ -> return $ (name,mod) : ms
  where

src-3.0/GF/Compile/Compute.hs

@@ -24,7 +24,7 @@ import GF.Infra.Modules
 import GF.Grammar.Predef
 import GF.Grammar.Macros
 import GF.Grammar.Lookup
-import GF.Grammar.Refresh
+import GF.Compile.Refresh
 import GF.Grammar.PatternMatch
 import GF.Grammar.Lockfield (isLockLabel) ----
 

src-3.0/GF/Compile/Extend.hs

@@ -40,22 +40,22 @@ extendModule ms (name,mod) = case mod of
     mod' <- foldM extOne m (extend m) 
     return (name,ModMod mod') 
  where
-   extOne mod@(Module mt st fs es ops js) (n,cond) = do
+   extOne mo (n,cond) = do
         (m0,isCompl) <- do
           m <- lookupModMod  (MGrammar ms) n
 
           -- test that the module types match, and find out if the old is complete
-          testErr (sameMType (mtype m) mt) 
+          testErr (sameMType (mtype m) (mtype mo)) 
                     ("illegal extension type to module" +++ prt name)
           return (m, isCompleteModule m)
-----       return (m, if (isCompleteModule m) then True else not (isCompleteModule mod))
 
         -- build extension in a way depending on whether the old module is complete
-        js1 <- extendMod isCompl (n, isInherited cond) name (jments m0) js
+        js1 <- extendMod isCompl (n, isInherited cond) name (jments m0) (jments mo)
 
         -- if incomplete, throw away extension information
-        let me' = if isCompl then es else (filter ((/=n) . fst) es) 
+        let es  = extend mo
-        return $ Module mt st fs me' ops js1
+        let es' = if isCompl then es else (filter ((/=n) . fst) es) 
+        return $ mo {extend = es', jments = js1}
 
 -- | When extending a complete module: new information is inserted,
 -- and the process is interrupted if unification fails.

src-3.0/GF/Compile/GrammarToGFCC.hs

@@ -218,11 +218,12 @@ mkParamLincat sgr lang cat = errVal (C.R [C.S []]) $ do
 reorder :: Ident -> SourceGrammar -> SourceGrammar
 reorder abs cg = M.MGrammar $ 
     (abs, M.ModMod $ 
-          M.Module M.MTAbstract M.MSComplete aflags [] [] adefs):
+          M.Module M.MTAbstract M.MSComplete aflags [] [] adefs poss):
       [(c, M.ModMod $ 
-          M.Module (M.MTConcrete abs) M.MSComplete fs [] [] (sorted2tree js)) 
+          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
        adefs = sorted2tree $ sortIds $
                  predefADefs ++ Look.allOrigInfos cg abs
@@ -268,8 +269,8 @@ canon2canon abs =
   js2js ms = map (c2c (j2j (M.MGrammar ms))) ms
 
   c2c f2 (c,m) = case m of
-      M.ModMod mo@(M.Module _ _ _ _ _ js) ->
+      M.ModMod mo ->
-        (c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 js)
+        (c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 (M.jments mo))
       _ -> (c,m)    
   j2j cg (f,j) = case j of
       CncFun x (Yes tr) z -> (f,CncFun x (Yes (trace ("+ " ++ prt f) (t2t tr))) z)

src-3.0/GF/Compile/Optimize.hs

@@ -22,7 +22,7 @@ import GF.Grammar.PrGrammar
 import GF.Grammar.Macros
 import GF.Grammar.Lookup
 import GF.Grammar.Predef
-import GF.Grammar.Refresh
+import GF.Compile.Refresh
 import GF.Compile.Compute
 import GF.Compile.BackOpt
 import GF.Compile.CheckGrammar
@@ -52,8 +52,7 @@ type EEnv = () --- not used
 optimizeModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> 
                   (Ident,SourceModInfo) -> Err ((Ident,SourceModInfo),EEnv)
 optimizeModule opts mse@(ms,eenv) mo@(_,mi) = case mi of
-  ModMod m0@(Module mt st fs me ops js) | 
+  ModMod m0 | mstatus m0 == MSComplete && isModRes m0 -> do
-    st == MSComplete && isModRes m0 -> do
       (mo1,_) <- evalModule oopts mse mo
       let mo2 = shareModule optim mo1
       return (mo2,eenv)
@@ -66,16 +65,16 @@ evalModule :: Options -> ([(Ident,SourceModInfo)],EEnv) -> (Ident,SourceModInfo)
                Err ((Ident,SourceModInfo),EEnv)
 evalModule oopts (ms,eenv) mo@(name,mod) = case mod of
 
-  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
+  ModMod m0 | mstatus m0 == MSComplete -> case mtype m0 of
     _ | isModRes m0 -> do
-      let deps = allOperDependencies name js
+      let deps = allOperDependencies name (jments m0)
       ids <- topoSortOpers deps
       MGrammar (mod' : _) <- foldM evalOp gr ids
       return $ (mod',eenv)
 
     MTConcrete a -> do
-      js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005
+      js' <- mapMTree (evalCncInfo oopts gr name a) (jments m0)
-      return $ ((name, ModMod (Module mt st fs me ops js')),eenv)
+      return $ ((name, ModMod (replaceJudgements m0 js')),eenv)
 
     _ -> return $ ((name,mod),eenv)
   _ -> return $ ((name,mod),eenv)

src-3.0/GF/Compile/OptimizeGF.hs

@@ -47,8 +47,8 @@ unshareModule gr = processModule (const (unoptim gr))
 processModule :: 
   (Ident -> Term -> Term) -> (Ident, SourceModInfo) -> (Ident, SourceModInfo)
 processModule opt (i,m) = case m of
-  M.ModMod (M.Module mt st fs me ops js) -> 
+  M.ModMod mo -> 
-    (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
+    (i,M.ModMod (M.replaceJudgements mo (mapTree (shareInfo opt) (M.jments mo))))
   _ -> (i,m)
 
 shareInfo opt (c, CncCat ty (Yes t) m) = (c,CncCat ty (Yes (opt c t)) m)
@@ -168,19 +168,20 @@ cse is possible in the grammar. It is used by the flag pg -printer=subs.
 -}
 
 subexpModule :: SourceModule -> SourceModule
-subexpModule (mo,m) = errVal (mo,m) $ case m of
+subexpModule (n,m) = errVal (n,m) $ case m of
-  M.ModMod (M.Module mt st fs me ops js) -> do
+  M.ModMod mo -> do
-    (tree,_) <- appSTM (getSubtermsMod mo (tree2list js)) (Map.empty,0)
+    let ljs = tree2list (M.jments mo)
-    js2 <- liftM buildTree $ addSubexpConsts mo tree $ tree2list js
+    (tree,_) <- appSTM (getSubtermsMod n ljs) (Map.empty,0)
-    return (mo,M.ModMod (M.Module mt st fs me ops js2))
+    js2 <- liftM buildTree $ addSubexpConsts n tree $ ljs
-  _ -> return (mo,m)
+    return (n,M.ModMod (M.replaceJudgements mo js2))
+  _ -> return (n,m)
 
 unsubexpModule :: SourceModule -> SourceModule
-unsubexpModule mo@(i,m) = case m of
+unsubexpModule sm@(i,m) = case m of
-    M.ModMod (M.Module mt st fs me ops js) | hasSub ljs ->
+    M.ModMod mo | hasSub ljs ->
-      (i, M.ModMod (M.Module mt st fs me ops 
+      (i, M.ModMod (M.replaceJudgements mo
                      (rebuild (map unparInfo ljs)))) 
-                        where ljs = tree2list js
+                        where ljs = tree2list (M.jments mo)
     _ -> (i,m)
   where
     -- perform this iff the module has opers
@@ -194,7 +195,7 @@ unsubexpModule mo@(i,m) = case m of
       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 [mo] 
+    gr = M.MGrammar [sm] 
     rebuild = buildTree . concat
 
 -- implementation

src-3.0/GF/Compile/Rebuild.hs

@@ -62,14 +62,14 @@ rebuildModule ms mo@(i,mi) = do
 
     -- add the instance opens to an incomplete module "with" instances
     --      ModWith mt stat ext me ops -> do
-    ModWith (Module mt stat fs_ me ops_ js_) (ext,incl) ops -> do
+    ModWith (Module mt stat fs_ me ops_ js_ ps_) (ext,incl) ops -> do
       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 <- lookupModMod gr ext
+      Module mt0 _ fs me' ops0 js ps0 <- lookupModMod gr ext
       let ops1 = nub $
                    ops_ ++ -- N.B. js has been name-resolved already
                    ops ++ [o | o <- ops0, notElem (openedModule o) infs]
@@ -80,7 +80,8 @@ rebuildModule ms mo@(i,mi) = do
       let fs1 = addModuleOptions fs fs_                           -- new flags have priority
       let js0 = [ci | ci@(c,_) <- tree2list js, isInherited incl c]
       let js1 = buildTree (tree2list js_ ++ js0)
-      return $ ModMod $ Module mt0 stat' fs1 me ops1 js1 
+      let ps1 = buildTree (tree2list ps_ ++ tree2list ps0)
+      return $ ModMod $ Module mt0 stat' fs1 me ops1 js1 ps1 
                           ---- (mapTree (qualifInstanceInfo insts) js) -- not needed
 
     _ -> return mi

src-3.0/GF/Compile/Refresh.hs

@@ -12,7 +12,7 @@
 -- (Description of the module)
 -----------------------------------------------------------------------------
 
-module GF.Grammar.Refresh (refreshTerm, refreshTermN,
+module GF.Compile.Refresh (refreshTerm, refreshTermN,
 		refreshModule
 	       ) where
 
@@ -110,9 +110,9 @@ refreshGrammar = liftM (MGrammar . snd) . foldM refreshModule (0,[]) . modules
 
 refreshModule :: (Int,[SourceModule]) -> SourceModule -> Err (Int,[SourceModule])
 refreshModule (k,ms) mi@(i,m) = case m of
-    ModMod mo@(Module mt fs st me ops js) | (isModCnc mo || isModRes mo) -> do
+    ModMod mo | (isModCnc mo || isModRes mo) -> do
-      (k',js') <- foldM refreshRes (k,[]) $ tree2list js
+      (k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo
-      return (k', (i, ModMod(Module mt fs st me ops (buildTree js'))) : ms)
+      return (k', (i, ModMod(replaceJudgements mo (buildTree js'))) : ms)
     _ -> return (k, mi:ms)
  where
   refreshRes (k,cs) ci@(c,info) = case info of

src-3.0/GF/Compile/RemoveLiT.hs

@@ -34,9 +34,9 @@ removeLiT gr = liftM MGrammar $ mapM (remlModule gr) (modules gr)
 
 remlModule :: SourceGrammar -> (Ident,SourceModInfo) -> Err (Ident,SourceModInfo)
 remlModule gr mi@(name,mod) = case mod of
-  ModMod (Module mt st fs me ops js) -> do
+  ModMod mo -> do
-    js1 <- mapMTree (remlResInfo gr) js
+    js1 <- mapMTree (remlResInfo gr) (jments mo)
-    let mod2 = ModMod $ Module mt st fs me ops js1
+    let mod2 = ModMod $ mo {jments = js1}
     return $ (name,mod2)
   _ -> return mi
 

src-3.0/GF/Compile/Rename.hs

@@ -55,11 +55,11 @@ renameSourceTerm g m t = do
 
 renameModule :: [SourceModule] -> SourceModule -> Err [SourceModule]
 renameModule ms (name,mod) = errIn ("renaming module" +++ prt name) $ case mod of
-  ModMod m@(Module mt st fs me ops js) -> do
+  ModMod mo -> do
-    let js1 = jments m
+    let js1 = jments mo
     status <- buildStatus (MGrammar ms) name mod
     js2    <- mapsErrTree (renameInfo status) js1
-    let mod2 = ModMod $ Module mt st fs me (map forceQualif ops) js2
+    let mod2 = ModMod $ mo {opens = map forceQualif (opens mo), jments = js2}
     return $ (name,mod2) : ms
 
 type Status = (StatusTree, [(OpenSpec Ident, StatusTree)])

src-3.0/GF/Compile/TypeCheck.hs

@@ -23,7 +23,7 @@ import GF.Data.Operations
 import GF.Data.Zipper
 
 import GF.Grammar.Abstract
-import GF.Grammar.Refresh
+import GF.Compile.Refresh
 import GF.Grammar.LookAbs
 import qualified GF.Grammar.Lookup as Lookup ---
 import GF.Grammar.Unify ---

src-3.0/GF/Grammar/MMacros.hs

@@ -20,7 +20,7 @@ import GF.Data.Zipper
 import GF.Grammar.Grammar
 import GF.Grammar.PrGrammar
 import GF.Infra.Ident
-import GF.Grammar.Refresh
+import GF.Compile.Refresh
 import GF.Grammar.Values
 ----import GrammarST
 import GF.Grammar.Macros

src-3.0/GF/Infra/Modules.hs

@@ -68,7 +68,8 @@ data Module i a = Module {
     flags   :: ModuleOptions,
     extend  :: [(i,MInclude i)],
     opens   :: [OpenSpec i] ,
-    jments  :: BinTree i a
+    jments  :: BinTree i a ,
+    positions :: BinTree i (String,(Int,Int)) -- file, first line, last line
   }
 ---  deriving Show
 instance Show (Module i a) where
@@ -116,15 +117,15 @@ updateMGrammar old new = MGrammar $
    ns = modules new
 
 updateModule :: Ord i => Module i t -> i -> t -> Module i t
-updateModule (Module  mt ms fs me ops js) i t = 
+updateModule (Module  mt ms fs me ops js ps) i t = 
-  Module mt ms fs me ops (updateTree (i,t) js)
+  Module mt ms fs me ops (updateTree (i,t) js) ps
 
 replaceJudgements :: Module i t -> BinTree i t -> Module i t
-replaceJudgements (Module mt ms fs me ops _) js = Module mt ms fs me ops js
+replaceJudgements (Module mt ms fs me ops _ ps) js = Module mt ms fs me ops js ps
 
 addOpenQualif :: i -> i -> Module i t -> Module i t
-addOpenQualif i j (Module mt ms fs me ops js) = 
+addOpenQualif i j (Module mt ms fs me ops js ps) = 
-  Module mt ms fs me (oQualif i j : ops) js
+  Module mt ms fs me (oQualif i j : ops) js ps
 
 addFlag :: ModuleOptions -> Module i t -> Module i t
 addFlag f mo = mo {flags = addModuleOptions (flags mo) f} 
@@ -267,7 +268,8 @@ emptyModInfo :: ModInfo i a
 emptyModInfo = ModMod emptyModule
 
 emptyModule :: Module i a
-emptyModule = Module MTResource MSComplete noModuleOptions [] [] emptyBinTree
+emptyModule = Module 
+  MTResource MSComplete noModuleOptions [] [] emptyBinTree emptyBinTree
 
 -- | we store the module type with the identifier
 data IdentM i = IdentM {

src-3.0/GF/Source/SourceToGrammar.hs

@@ -99,6 +99,8 @@ transModDef x = case x of
 
     mkBody (mstat', trDef, mtyp', id') body
   where
+      poss = emptyBinTree ----
+
       mkBody xx@(mstat', trDef, mtyp', id') bod = case bod of 
        MNoBody incls -> do
         mkBody xx $ MBody (Ext incls) NoOpens []
@@ -108,13 +110,13 @@ transModDef x = case x of
         defs0    <- mapM trDef $ getTopDefs defs
         defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
         flags'   <- return $ concatModuleOptions [o | Right o <- defs0]
-        return (id',GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs'))
+        return (id',GM.ModMod (GM.Module mtyp' mstat' flags' extends' opens' defs' poss))
        MReuse _ -> do
-        return (id', GM.ModMod (GM.Module mtyp' mstat' noModuleOptions [] [] emptyBinTree))
+        return (id', GM.ModMod (GM.Module mtyp' mstat' noModuleOptions [] [] emptyBinTree poss))
        MUnion imps -> do
         imps' <- mapM transIncluded imps        
         return (id', 
-          GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' noModuleOptions [] [] emptyBinTree))
+          GM.ModMod (GM.Module (GM.MTUnion mtyp' imps') mstat' noModuleOptions [] [] emptyBinTree poss))
 
        MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens []
        MWithBody m insts opens defs -> mkBody xx $ MWithEBody [] m insts opens defs
@@ -128,7 +130,7 @@ transModDef x = case x of
         defs'    <- U.buildAnyTree [d | Left  ds <- defs0, d <- ds]
         flags'   <- return $ concatModuleOptions [o | Right o <- defs0]
         return (id',
-          GM.ModWith (GM.Module mtyp' mstat' flags' extends' opens' defs') m' insts')
+          GM.ModWith (GM.Module mtyp' mstat' flags' extends' opens' defs' poss) m' insts')
 
       mkModRes id mtyp body = do
          id' <- transIdent id