From c5146d06143c9b93e40bb2b1265ab58134be36d7 Mon Sep 17 00:00:00 2001
From: aarne <unknown>
Date: Thu, 13 Nov 2003 16:02:25 +0000
Subject: Improved interface and instance compilation.

Improved interface and instance compilation.
Restored an optimization of the optimizer: up to 4x faster now.
---
 src/GF/Compile/Compile.hs  |  5 +++--
 src/GF/Compile/Optimize.hs |  4 ++--
 src/GF/Compile/Rebuild.hs  | 11 +++++++++--
 3 files changed, 14 insertions(+), 6 deletions(-)

(limited to 'src/GF/Compile')

diff --git a/src/GF/Compile/Compile.hs b/src/GF/Compile/Compile.hs
index cc327be37..4364b7b2c 100644
--- a/src/GF/Compile/Compile.hs
+++ b/src/GF/Compile/Compile.hs
@@ -168,10 +168,11 @@ compileSourceModule opts env@(k,gr,can) mo@(i,mi) = do
   mo1   <- ioeErr $ rebuildModule mos mo
 
   mo1b  <- ioeErr $ extendModule mos mo1
-  ---- prDebug mo1b
+  ----  prDebug mo1b
 
   case mo1b of
-    (_,ModMod n) | not (isCompleteModule n) -> return (k,mo1b)
+    (_,ModMod n) | not (isCompleteModule n) -> do
+      return (k,mo1b)   -- refresh would fail, since not renamed
     _ -> do
       mo2:_ <- putp "  renaming " $ ioeErr $ renameModule mos mo1b
 
diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs
index fe9b6b1af..77cbcdbdf 100644
--- a/src/GF/Compile/Optimize.hs
+++ b/src/GF/Compile/Optimize.hs
@@ -29,8 +29,8 @@ evalModule :: [(Ident,SourceModInfo)] -> (Ident,SourceModInfo) ->
                Err [(Ident,SourceModInfo)]
 evalModule ms mo@(name,mod) = case mod of
 
-  ModMod (Module mt st fs me ops js) | st == MSComplete -> case mt of
-    MTResource -> do
+  ModMod m0@(Module mt st fs me ops js) | st == MSComplete -> case mt of
+    _ | isModRes m0 -> do
       let deps = allOperDependencies name js
       ids <- topoSortOpers deps
       MGrammar (mod' : _) <- foldM evalOp gr ids
diff --git a/src/GF/Compile/Rebuild.hs b/src/GF/Compile/Rebuild.hs
index d0e750e09..048af3c7c 100644
--- a/src/GF/Compile/Rebuild.hs
+++ b/src/GF/Compile/Rebuild.hs
@@ -32,7 +32,14 @@ rebuildModule ms mo@(i,mi) = do
           testErr (isModRes m1) ("interface expected instead of" +++ prt i0)
           m' <- do
             js' <- extendMod False i0 (jments m1) (jments m)
-            return $ replaceJudgements m js'
+            --- to avoid double inclusions, in instance I of I0 = J0 ** ...
+            case extends m of
+              Nothing -> return $ replaceJudgements m js'
+              Just j0 -> do 
+                m0 <- lookupModMod gr j0
+                let notInM0 c = not $ isInBinTree (fst c) $ mapTree fst $ jments m0
+                let js2 = sorted2tree $ filter notInM0 $ tree2list js'
+                return $ replaceJudgements m js2
           return $ ModMod m'
         _ -> return mi
 
@@ -40,7 +47,7 @@ rebuildModule ms mo@(i,mi) = do
     ModWith mt stat ext ops -> do
       let insts = [(inf,inst) | OQualif _ inf inst <- ops]
       let infs  = map fst insts
-      let stat' = ifNull MSComplete (const MSIncomplete) 
+      let stat' = ifNull MSComplete (const MSIncomplete)
                     [i | i <- is, notElem i infs]
       testErr (stat' == MSComplete || stat == MSIncomplete) 
               ("module" +++ prt i +++ "remains incomplete")
-- 
cgit v1.2.3