compilation of functors

src/GF/Compile/CheckGrammar.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/06 22:00:37 $ 
+-- > CVS $Date: 2005/11/11 23:24:33 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.30 $
+-- > CVS $Revision: 1.31 $
 --
 -- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
 --
@@ -148,6 +148,7 @@ checkCompleteGrammar abs cnc = do
          checkWarn $ "Warning: no linearization of" +++ prt c
          return js
      AbsCat (Yes _) _ -> case lookupIdent c js of
+       Ok (AnyInd _ _) -> return js
        Ok (CncCat (Yes _) _ _) -> return js
        Ok (CncCat _ mt mp) -> do
          checkWarn $ 

src/GF/Compile/GrammarToCanon.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/06/22 08:52:02 $ 
+-- > CVS $Date: 2005/11/11 23:24:33 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.22 $
+-- > CVS $Revision: 1.23 $
 --
 -- Code generator from optimized GF source code to GFC.
 -----------------------------------------------------------------------------
@@ -31,6 +31,7 @@ import GF.Canon.MkGFC
 import qualified GF.Canon.PrintGFC as P
 
 import Control.Monad
+import Data.List (nub)
 
 -- compilation of optimized grammars to canonical GF. AR 5/10/2001 -- 12/5/2003
 
@@ -82,7 +83,7 @@ redModInfo (c,info) = do
      os' <- mapM (\o -> case o of 
               OQualif q _ i -> liftM (OSimple q) (redIdent i)
               _ -> prtBad "cannot translate unqualified open in" c) $ opens m
-     return (e',os')
+     return (e',nub os')
    om = oSimple . openedModule --- normalizing away qualif
 
 redInfo :: Ident -> (Ident,Info) -> Err [(Ident,C.Info)]

src/GF/Compile/ModDeps.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:40 $ 
+-- > CVS $Date: 2005/11/11 23:24:34 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.13 $
+-- > CVS $Revision: 1.14 $
 --
 -- Check correctness of module dependencies. Incomplete.
 --
@@ -120,13 +120,17 @@ openInterfaces ds m = do
   let mods = iterFix (concatMap more) (more (m,undefined))
   return $ [i | (i,MTInterface) <- mods]
 
--- | this function finds out what modules are really needed in the canoncal gr.
+-- | this function finds out what modules are really needed in the canonical gr.
 -- its argument is typically a concrete module name
-requiredCanModules :: (Ord i, Show i) => MGrammar i f a -> i -> [i]
+requiredCanModules :: (Ord i, Show i) => Bool -> MGrammar i f a -> i -> [i]
-requiredCanModules gr = nub . iterFix (concatMap more) . allExtends gr where
+requiredCanModules isSingle gr c = nub $ filter notReuse ops ++ exts where
+  exts = allExtends gr c
+  ops  = if isSingle 
+         then map fst (modules gr) 
+         else iterFix (concatMap more) $ exts
   more i = errVal [] $ do
     m <- lookupModMod gr i
-    return $ extends m ++ [o | o <- map openedModule (opens m), notReuse o]
+    return $ extends m ++ [o | o <- map openedModule (opens m)]
   notReuse i = errVal True $ do
     m <- lookupModMod gr i
     return $ isModRes m -- to exclude reused Cnc and Abs from required

src/GF/Compile/ShellState.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/11/09 22:34:01 $ 
+-- > CVS $Date: 2005/11/11 23:24:34 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.51 $
+-- > CVS $Revision: 1.52 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -313,9 +313,10 @@ purgeShellState sh = ShSt {
  where
    abstr = abstract sh
    concrs = [((a,i),b) | ((a,i),b) <- concretes sh, elem i needed]
-   needed = nub $ concatMap (requiredCanModules (canModules sh)) acncs
+   isSingle = length (abstracts sh) == 1
+   needed = nub $ concatMap (requiredCanModules isSingle (canModules sh)) acncs
    purge = nubBy (\x y -> fst x == fst y) . filter (flip elem needed . fst)
-   acncs = maybe [] singleton (abstract sh) ++ map (snd . fst) (actualConcretes sh)
+   acncs = maybe [] singleton abstr ++ map (snd . fst) (actualConcretes sh)
 
 changeMain :: Maybe Ident -> ShellState -> Err ShellState
 changeMain Nothing (ShSt _ _ cs ms ss cfs old_pis mcfgs cfgs pinfos mos pbs os rs acs s) = 
@@ -345,8 +346,8 @@ qualifTop :: StateGrammar -> G.QIdent -> G.QIdent
 qualifTop gr (_,c) = (absId gr,c)
 
 stateGrammarOfLang :: ShellState -> Language -> StateGrammar
-stateGrammarOfLang st l = StGr {
+stateGrammarOfLang st0 l = StGr {
-  absId    = maybe (identC "Abs") id (abstract st), ---
+  absId    = err (const (identC "Abs")) id  $ M.abstractOfConcrete allCan l, ---
   cncId    = l,
   grammar  = can,
   cf       = maybe emptyCF id (lookup l (cfs st)),
@@ -358,9 +359,11 @@ stateGrammarOfLang st l = StGr {
   loptions = errVal noOptions $ lookupOptionsCan can
   }
  where
+   st = purgeShellState $ st0 {concrete = Just l}
    allCan = canModules st
-   can = M.partOfGrammar allCan 
+   can = allCan
-           (l, maybe M.emptyModInfo id (lookup l (M.modules allCan)))
+----   can = M.partOfGrammar allCan 
+----           (l, maybe M.emptyModInfo id (lookup l (M.modules allCan)))
 
 grammarOfLang :: ShellState -> Language -> CanonGrammar
 cfOfLang      :: ShellState -> Language -> CF

src/GF/Grammar/Lockfield.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:22:21 $ 
+-- > CVS $Date: 2005/11/11 23:24:34 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: aarne $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- Creating and using lock fields in reused resource grammars.
 --
@@ -26,8 +26,8 @@ import GF.Data.Operations
 lockRecType :: Ident -> Type -> Err Type
 lockRecType c t@(RecType rs) = 
   let lab = lockLabel c in
-  return $ if elem lab (map fst rs) 
+  return $ if elem lab (map fst rs) || elem (prt c) ["String","Int"]
-    then t --- don't add an extra copy of the lock field
+    then t --- don't add an extra copy of lock field, nor predef cats
     else RecType (rs ++ [(lockLabel c,  RecType [])])
 lockRecType c t = plusRecType t $ RecType [(lockLabel c,  RecType [])]
 

src/GF/Infra/ReadFiles.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/27 10:25:07 $ 
+-- > CVS $Date: 2005/11/11 23:24:34 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.25 $
+-- > CVS $Revision: 1.26 $
 --
 -- Decide what files to read as function of dependencies and time stamps.
 --
@@ -111,14 +111,16 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
     add os = [m | o <- os, Just n <- [lookup o deps],m <- n]
 
   -- only treat reused, interface, or instantiation if needed
-  sfiles = map relevant sfiles0
+  sfiles = sfiles0 ---- map relevant sfiles0
   relevant fp@(f,(p,(st,_))) = 
-    let us = uses f in
+    let us = uses f
-    if not (all noComp us) then
+        isUsed = not (null us)
+    in
+    if not (isUsed && all noComp us) then
       fp else 
     if (elem (typ f) [] ---- MTyIncomplete, MTyIncResource]
         || 
-        (not (null us) && all isAux us)) then
+        (isUsed && all isAux us)) then
       (f,(p,(CSDont,Nothing))) else
       fp