summaryrefslogtreecommitdiff
path: root/src/GF/Compile/Rebuild.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Compile/Rebuild.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/Compile/Rebuild.hs')
-rw-r--r--src/GF/Compile/Rebuild.hs99
1 files changed, 0 insertions, 99 deletions
diff --git a/src/GF/Compile/Rebuild.hs b/src/GF/Compile/Rebuild.hs
deleted file mode 100644
index 152983b96..000000000
--- a/src/GF/Compile/Rebuild.hs
+++ /dev/null
@@ -1,99 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : Rebuild
--- Maintainer : AR
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/05/30 21:08:14 $
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.14 $
---
--- Rebuild a source module from incomplete and its with-instance.
------------------------------------------------------------------------------
-
-module GF.Compile.Rebuild (rebuildModule) where
-
-import GF.Grammar.Grammar
-import GF.Compile.ModDeps
-import GF.Grammar.PrGrammar
-import GF.Grammar.Lookup
-import GF.Compile.Extend
-import GF.Grammar.Macros
-
-import GF.Infra.Ident
-import GF.Infra.Modules
-import GF.Data.Operations
-
-import Data.List (nub)
-
--- | rebuilding instance + interface, and "with" modules, prior to renaming.
--- AR 24/10/2003
-rebuildModule :: [SourceModule] -> SourceModule -> Err SourceModule
-rebuildModule ms mo@(i,mi) = do
- let gr = MGrammar ms
----- deps <- moduleDeps ms
----- is <- openInterfaces deps i
- let is = [] ---- the method above is buggy: try "i -src" for two grs. AR 8/3/2005
- mi' <- case mi of
-
- -- add the information given in interface into an instance module
- ModMod 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
- testErr (isModRes m1) ("interface expected instead of" +++ prt i0)
- m' <- do
- js' <- extendMod False (i0,const True) i (jments m1) (jments m)
- --- to avoid double inclusions, in instance I of I0 = J0 ** ...
- case extends m of
- [] -> return $ replaceJudgements m js'
- j0s -> do
- m0s <- mapM (lookupModMod gr) j0s
- let notInM0 c _ = all (not . isInBinTree c . jments) m0s
- let js2 = filterBinTree notInM0 js'
- return $ replaceJudgements m js2
- return $ ModMod m'
- _ -> return mi
-
- -- 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
- 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
- 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] ----
- ++ [oSimple i | i <- map snd insts] ----
-
- --- check if me is incomplete
- let fs1 = 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
- ---- (mapTree (qualifInstanceInfo insts) js) -- not needed
-
- _ -> return mi
- return (i,mi')
-
-checkCompleteInstance :: SourceRes -> SourceRes -> Err ()
-checkCompleteInstance abs cnc = ifNull (return ()) (Bad . unlines) $
- checkComplete [f | (f, ResOper (Yes _) _) <- abs'] cnc'
- where
- abs' = tree2list $ jments abs
- cnc' = jments cnc
- checkComplete sought given = foldr ckOne [] sought
- where
- ckOne f = if isInBinTree f given
- then id
- else (("Error: no definition given to" +++ prt f):)
-