summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-05-31 14:40:46 +0000
committeraarne <aarne@cs.chalmers.se>2008-05-31 14:40:46 +0000
commit9229c157642c3503d365f42fe5ecac414958ab9b (patch)
tree422dd9f790ddc0d970e6a03783486616d7c4eb14
parent66c04672013a8d031ffe53012ed7e843bb54b750 (diff)
added positions to Module record; avoided Module constructor where possible; moved Refresh to Compile/
-rw-r--r--src-3.0/GF/Compile.hs2
-rw-r--r--src-3.0/GF/Compile/BackOpt.hs4
-rw-r--r--src-3.0/GF/Compile/CheckGrammar.hs9
-rw-r--r--src-3.0/GF/Compile/Compute.hs2
-rw-r--r--src-3.0/GF/Compile/Extend.hs12
-rw-r--r--src-3.0/GF/Compile/GrammarToGFCC.hs9
-rw-r--r--src-3.0/GF/Compile/Optimize.hs13
-rw-r--r--src-3.0/GF/Compile/OptimizeGF.hs27
-rw-r--r--src-3.0/GF/Compile/Rebuild.hs7
-rw-r--r--src-3.0/GF/Compile/Refresh.hs (renamed from src-3.0/GF/Grammar/Refresh.hs)8
-rw-r--r--src-3.0/GF/Compile/RemoveLiT.hs6
-rw-r--r--src-3.0/GF/Compile/Rename.hs6
-rw-r--r--src-3.0/GF/Compile/TypeCheck.hs2
-rw-r--r--src-3.0/GF/Grammar/MMacros.hs2
-rw-r--r--src-3.0/GF/Infra/Modules.hs16
-rw-r--r--src-3.0/GF/Source/SourceToGrammar.hs10
16 files changed, 71 insertions, 64 deletions
diff --git a/src-3.0/GF/Compile.hs b/src-3.0/GF/Compile.hs
index 0119b2107..71eb35bb4 100644
--- a/src-3.0/GF/Compile.hs
+++ b/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
diff --git a/src-3.0/GF/Compile/BackOpt.hs b/src-3.0/GF/Compile/BackOpt.hs
index 2814448b4..8667023c0 100644
--- a/src-3.0/GF/Compile/BackOpt.hs
+++ b/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) ->
- (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
+ M.ModMod mo ->
+ (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)
diff --git a/src-3.0/GF/Compile/CheckGrammar.hs b/src-3.0/GF/Compile/CheckGrammar.hs
index f8383ea9f..587c2bf18 100644
--- a/src-3.0/GF/Compile/CheckGrammar.hs
+++ b/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
diff --git a/src-3.0/GF/Compile/Compute.hs b/src-3.0/GF/Compile/Compute.hs
index 1c68de71b..f35e7c6a9 100644
--- a/src-3.0/GF/Compile/Compute.hs
+++ b/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) ----
diff --git a/src-3.0/GF/Compile/Extend.hs b/src-3.0/GF/Compile/Extend.hs
index ae87b3e71..0dcde340a 100644
--- a/src-3.0/GF/Compile/Extend.hs
+++ b/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)
- return $ Module mt st fs me' ops js1
+ let es = extend mo
+ 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.
diff --git a/src-3.0/GF/Compile/GrammarToGFCC.hs b/src-3.0/GF/Compile/GrammarToGFCC.hs
index bf87d42fe..637f40ed8 100644
--- a/src-3.0/GF/Compile/GrammarToGFCC.hs
+++ b/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) ->
- (c, M.ModMod $ M.replaceJudgements mo $ mapTree f2 js)
+ M.ModMod mo ->
+ (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)
diff --git a/src-3.0/GF/Compile/Optimize.hs b/src-3.0/GF/Compile/Optimize.hs
index 80ceed16d..d2b303bc6 100644
--- a/src-3.0/GF/Compile/Optimize.hs
+++ b/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) |
- st == MSComplete && isModRes m0 -> do
+ ModMod m0 | mstatus m0 == 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
- return $ ((name, ModMod (Module mt st fs me ops js')),eenv)
+ js' <- mapMTree (evalCncInfo oopts gr name a) (jments m0)
+ return $ ((name, ModMod (replaceJudgements m0 js')),eenv)
_ -> return $ ((name,mod),eenv)
_ -> return $ ((name,mod),eenv)
diff --git a/src-3.0/GF/Compile/OptimizeGF.hs b/src-3.0/GF/Compile/OptimizeGF.hs
index 8872a5105..41b828aa3 100644
--- a/src-3.0/GF/Compile/OptimizeGF.hs
+++ b/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) ->
- (i,M.ModMod (M.Module mt st fs me ops (mapTree (shareInfo opt) js)))
+ M.ModMod mo ->
+ (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
- M.ModMod (M.Module mt st fs me ops js) -> do
- (tree,_) <- appSTM (getSubtermsMod mo (tree2list js)) (Map.empty,0)
- js2 <- liftM buildTree $ addSubexpConsts mo tree $ tree2list js
- return (mo,M.ModMod (M.Module mt st fs me ops js2))
- _ -> return (mo,m)
+subexpModule (n,m) = errVal (n,m) $ case m of
+ 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)
unsubexpModule :: SourceModule -> SourceModule
-unsubexpModule mo@(i,m) = case m of
- M.ModMod (M.Module mt st fs me ops js) | hasSub ljs ->
- (i, M.ModMod (M.Module mt st fs me ops
+unsubexpModule sm@(i,m) = case m of
+ M.ModMod mo | hasSub ljs ->
+ (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
diff --git a/src-3.0/GF/Compile/Rebuild.hs b/src-3.0/GF/Compile/Rebuild.hs
index b24373ba4..6dd6cf204 100644
--- a/src-3.0/GF/Compile/Rebuild.hs
+++ b/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
diff --git a/src-3.0/GF/Grammar/Refresh.hs b/src-3.0/GF/Compile/Refresh.hs
index bc77c1837..09c384266 100644
--- a/src-3.0/GF/Grammar/Refresh.hs
+++ b/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
- (k',js') <- foldM refreshRes (k,[]) $ tree2list js
- return (k', (i, ModMod(Module mt fs st me ops (buildTree js'))) : ms)
+ ModMod mo | (isModCnc mo || isModRes mo) -> do
+ (k',js') <- foldM refreshRes (k,[]) $ tree2list $ jments mo
+ return (k', (i, ModMod(replaceJudgements mo (buildTree js'))) : ms)
_ -> return (k, mi:ms)
where
refreshRes (k,cs) ci@(c,info) = case info of
diff --git a/src-3.0/GF/Compile/RemoveLiT.hs b/src-3.0/GF/Compile/RemoveLiT.hs
index 02ff58bc7..d06b80400 100644
--- a/src-3.0/GF/Compile/RemoveLiT.hs
+++ b/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
- js1 <- mapMTree (remlResInfo gr) js
- let mod2 = ModMod $ Module mt st fs me ops js1
+ ModMod mo -> do
+ js1 <- mapMTree (remlResInfo gr) (jments mo)
+ let mod2 = ModMod $ mo {jments = js1}
return $ (name,mod2)
_ -> return mi
diff --git a/src-3.0/GF/Compile/Rename.hs b/src-3.0/GF/Compile/Rename.hs
index 312dcb2dd..83bb97d50 100644
--- a/src-3.0/GF/Compile/Rename.hs
+++ b/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
- let js1 = jments m
+ ModMod mo -> do
+ 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)])
diff --git a/src-3.0/GF/Compile/TypeCheck.hs b/src-3.0/GF/Compile/TypeCheck.hs
index 0347dbab8..2d58a33ee 100644
--- a/src-3.0/GF/Compile/TypeCheck.hs
+++ b/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 ---
diff --git a/src-3.0/GF/Grammar/MMacros.hs b/src-3.0/GF/Grammar/MMacros.hs
index a7b9bad94..f2a0f2cb2 100644
--- a/src-3.0/GF/Grammar/MMacros.hs
+++ b/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
diff --git a/src-3.0/GF/Infra/Modules.hs b/src-3.0/GF/Infra/Modules.hs
index 8f9edbc68..001818d46 100644
--- a/src-3.0/GF/Infra/Modules.hs
+++ b/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 =
- Module mt ms fs me ops (updateTree (i,t) js)
+updateModule (Module mt ms fs me ops js ps) i t =
+ 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) =
- Module mt ms fs me (oQualif i j : ops) js
+addOpenQualif i j (Module mt ms fs me ops js ps) =
+ 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 {
diff --git a/src-3.0/GF/Source/SourceToGrammar.hs b/src-3.0/GF/Source/SourceToGrammar.hs
index 2ab1d58ac..ca4f488ea 100644
--- a/src-3.0/GF/Source/SourceToGrammar.hs
+++ b/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