working with interfaces

src/GF/Compile/Compile.hs

@@ -186,18 +186,19 @@ generateModuleCode opts path minfo@(name,info) = do
 
   -- for resource, also emit gfr
   case info of
-    ModMod m | isResourceModule info && isCompilableModule info && emit && nomulti -> do
+    ModMod m | isResourceModule info && isCompilable info && emit && nomulti -> do
       let (file,out) = (gfrFile pname, prGrammar (MGrammar [minfo]))
       ioeIO $ writeFile file out >> putStr ("  wrote file" +++ file)
     _ -> return ()
   (file,out) <- do
       code <- return $ MkGFC.prCanonModInfo minfo'
       return (gfcFile pname, code)
-  if isCompilableModule info && emit && nomulti 
+  if isCompilable info && emit && nomulti 
      then ioeIO $ writeFile file out >> putStr ("  wrote file" +++ file)
      else ioeIO $ putStrFlush "no need to save for this module "
   return minfo'
  where 
+   isCompilable _ = True ---- isCompilableModule ---- emit code for interfaces
    nomulti = not $ oElem makeMulti opts
    emit  = oElem emitCode opts
    optim = oElem optimizeCanon opts

src/GF/Compile/Extend.hs

@@ -15,6 +15,7 @@ import Monad
 -- The top-level function $extendModInfo$
 -- extends a module symbol table by indirections to the module it extends
 
+--- this is not in use 5/11/2003
 extendModInfo :: Ident -> SourceModInfo -> SourceModInfo -> Err SourceModInfo
 extendModInfo name old new = case (old,new) of
   (ModMod m0, ModMod (Module mt st fs _ ops js)) -> do

src/GF/Compile/ModDeps.hs

@@ -82,7 +82,9 @@ moduleDeps ms = mapM deps ms where
     (MTConcrete _, MTConcrete _) -> True
     (MTInstance _, MTInstance _) -> True
     (MTReuse _, MTReuse _) -> True
-    ---- some more
+    (MTInstance _, MTResource) -> True
+    (MTResource, MTInstance _) -> True
+    ---- some more?
     _ -> mt0 == mt
   -- in the same way; this defines what can be opened
   compatOType mt0 mt = case mt0 of

src/GF/Compile/Rebuild.hs

@@ -11,7 +11,8 @@ import Ident
 import Modules
 import Operations
 
--- rebuilding instance + interface, and "with" modules, prior to renaming. AR 24/10/2003
+-- rebuilding instance + interface, and "with" modules, prior to renaming. 
+-- AR 24/10/2003
 
 rebuildModule :: [SourceModule] -> SourceModule -> Err SourceModule
 rebuildModule ms mo@(i,mi) = do
@@ -28,7 +29,7 @@ rebuildModule ms mo@(i,mi) = do
         MTInstance i0 -> do
           m0 <- lookupModule gr i0
           m' <- case m0 of
-            ModMod m1 | mtype m1 == MTInterface -> do
+            ModMod m1 | isResourceModule m0 -> do ---- mtype m1 == MTInterface -> do
 ----              checkCompleteInstance m1 m -- do this later, in CheckGrammar
               js' <- extendMod i (jments m1) (jments m)
               return $ replaceJudgements m js'
@@ -41,7 +42,8 @@ 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) [i | i <- is, notElem i infs]
+      let stat' = ifNull MSComplete (const MSIncomplete) 
+                    [i | i <- is, notElem i infs]
       testErr (stat' == MSComplete || stat == MSIncomplete) 
               ("module" +++ prt i +++ "remains incomplete")
       Module mt0 stat0 fs me ops0 js <- do
@@ -52,7 +54,8 @@ rebuildModule ms mo@(i,mi) = do
       let ops1 = ops ++ [o | o <- ops0, notElem (openedModule o) infs]
                      ++ [oQualif i i | i <- map snd insts] ----
       --- check if me is incomplete
-      return $ ModMod $ Module mt0 stat' fs me ops1 (mapTree (qualifInstanceInfo insts) js)
+      return $ ModMod $ Module mt0 stat' fs me ops1 
+                          (mapTree (qualifInstanceInfo insts) js)
 
     _ -> return mi
   return (i,mi')
@@ -75,8 +78,8 @@ qualifInstanceInfo insts (c,i) = (c,qualInfo i) where
   qualInfo i = case i of
     ResOper pty pt -> ResOper (qualP pty) (qualP pt)
     CncCat  pty pt pp -> CncCat (qualP pty) (qualP pt) (qualP pp)
-    CncFun  mp pt pp -> CncFun mp (qualP pt) (qualP pp) ---- mp
-   -----  ResParam (Yes ps) -> ResParam (yes (map qualParam ps)) 
+    CncFun  mp pt pp -> CncFun (qualLin mp) (qualP pt) (qualP pp) ---- mp
+    ResParam (Yes ps) -> ResParam (yes (map qualParam ps)) 
     ResValue pty ->  ResValue (qualP pty)
     _ -> i
   qualP pt = case pt of
@@ -88,7 +91,9 @@ qualifInstanceInfo insts (c,i) = (c,qualInfo i) where
      Q m c  -> Q  (qualId m) c
      QC m c -> QC (qualId m) c
      _ -> composSafeOp qual t
+  qualParam (p,co) = (p,[(x,qual t) | (x,t) <- co])
+  qualLin (Just (c,(co,t))) = (Just (c,([(x,qual t) | (x,t) <- co], qual t)))
+  qualLin Nothing = Nothing
+
 
    -- NB constructor patterns never appear in interfaces so we need not rename them
-
-

src/GF/Compile/Rename.hs

@@ -121,12 +121,12 @@ buildStatus :: SourceGrammar -> Ident -> SourceModInfo -> Err Status
 buildStatus gr c mo = let mo' = self2status c mo in case mo of
   ModMod m -> do
     let gr1 = MGrammar $ (c,mo) : modules gr 
-        ops = [OSimple OQNormal e | e <- allExtends gr1 c] ++ allOpens m
+        ops = [OSimple OQNormal e | e <- allExtendsPlus gr1 c] ++ allOpens m
     mods <- mapM (lookupModule gr1 . openedModule) ops
     let sts = map modInfo2status $ zip ops mods    
     return $ if isModCnc m
-      then (NT, sts) -- the module itself does not define any names
-      else (mo',sts) -- so the empty ident is not needed
+      then (NT, 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