diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index a1b042f00..cbc69e2f6 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/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 $ diff --git a/src/GF/Compile/GrammarToCanon.hs b/src/GF/Compile/GrammarToCanon.hs index 255cfb53f..d5b52d062 100644 --- a/src/GF/Compile/GrammarToCanon.hs +++ b/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)] diff --git a/src/GF/Compile/ModDeps.hs b/src/GF/Compile/ModDeps.hs index 287667ab5..d2d3cbe83 100644 --- a/src/GF/Compile/ModDeps.hs +++ b/src/GF/Compile/ModDeps.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:21:40 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.13 $ +-- > CVS $Date: 2005/11/11 23:24:34 $ +-- > CVS $Author: aarne $ +-- > 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 gr = nub . iterFix (concatMap more) . allExtends gr where +requiredCanModules :: (Ord i, Show i) => Bool -> MGrammar i f a -> i -> [i] +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 diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index 4766bf685..3773d59f9 100644 --- a/src/GF/Compile/ShellState.hs +++ b/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 { - absId = maybe (identC "Abs") id (abstract st), --- +stateGrammarOfLang st0 l = StGr { + 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 - (l, maybe M.emptyModInfo id (lookup l (M.modules allCan))) + can = allCan +---- can = M.partOfGrammar allCan +---- (l, maybe M.emptyModInfo id (lookup l (M.modules allCan))) grammarOfLang :: ShellState -> Language -> CanonGrammar cfOfLang :: ShellState -> Language -> CF diff --git a/src/GF/Grammar/Lockfield.hs b/src/GF/Grammar/Lockfield.hs index e2482363b..960b12983 100644 --- a/src/GF/Grammar/Lockfield.hs +++ b/src/GF/Grammar/Lockfield.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:22:21 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.6 $ +-- > CVS $Date: 2005/11/11 23:24:34 $ +-- > CVS $Author: aarne $ +-- > 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) - then t --- don't add an extra copy of the lock field + return $ if elem lab (map fst rs) || elem (prt c) ["String","Int"] + 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 [])] diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs index 1ab772575..538af5b8f 100644 --- a/src/GF/Infra/ReadFiles.hs +++ b/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 - if not (all noComp us) then + let us = uses f + 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