option --split-pgf replaces option --mk-index. This splits the PGF into one file for the abstract and one more for each concrete syntax. This is a preparation for being able to load only specific languages from the whole grammar.

2013-12-10 10:43:13 +00:00
parent 2dda42e4d9
commit 87fffffbdf
5 changed files with 29 additions and 52 deletions
--- a/gf.cabal
+++ b/gf.cabal
@@ -88,12 +88,12 @@ Library
    PGF
    PGF.Data
    PGF.Macros
+    PGF.Binary
    PGF.Optimize
    PGF.Printer
    PGF.Utilities
  other-modules:
    PGF.CId
-    PGF.Binary
    PGF.Expr
    PGF.Generate
    PGF.Linearize
@@ -219,7 +219,6 @@ Executable gf
    GF.Compile.PGFtoProlog
    GF.Compile.PGFtoJS
    GF.Compile
-    GF.Index
    GF.Quiz
    GFC
    GFI
--- a/src/compiler/GF/Index.hs
+++ b/src/compiler/GF/Index.hs
@@ -1,36 +0,0 @@
-{--
-This module provide a function for indexing a pgf. 
-
-It reads the pgf and add a global flag, called "index", containing a string 
-with concrete names and size in bytes separated by a column.
-ex : "DisambPhrasebookEng:18778 PhrasebookBul:49971 PhrasebookCat:32738..."
--}
-module GF.Index (addIndex) where
-
-import PGF
-import PGF.Data
--import PGF.Binary
-import Data.Binary
-import Data.ByteString.Lazy (length) -- readFile
-import qualified Data.Map as Map
-import Data.Map (toAscList)
-import Data.List (intercalate)
--import qualified Data.ByteString.Lazy as BS
-
-addIndex  :: PGF -> PGF
-addIndex pgf = pgf {gflags = flags}  
-  where flags = Map.insert (mkCId "index") (LStr $ showIndex index) (gflags pgf)
-        index = getIndex pgf
-
-
-showIndex :: [(String,Int)] -> String
-showIndex = intercalate " " . map f
-  where f (name,size) = name ++ ":" ++ show size
-
-getsize :: Binary a => a -> Int
-getsize x = let bs = encode x in fromIntegral $ Data.ByteString.Lazy.length bs
-
-getIndex :: PGF -> [(String,Int)]
-getIndex pgf = cncindex
-  where cncindex = map f $ Data.Map.toAscList $ concretes pgf
-        f (cncname,cnc) = (show cncname, getsize cnc)
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -161,7 +161,7 @@ data Flags = Flags {
      optPMCFG           :: Bool,
      optOptimizations   :: Set Optimization,
      optOptimizePGF     :: Bool,
-      optMkIndexPGF      :: Bool,
+      optSplitPGF        :: Bool,
      optCFGTransforms   :: Set CFGTransform,
      optLibraryPath     :: [FilePath],
      optStartCat        :: Maybe String,
@@ -272,7 +272,7 @@ defaultFlags = Flags {
      optPMCFG           = True,
      optOptimizations   = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize],
      optOptimizePGF     = False,
-      optMkIndexPGF     = False,
+      optSplitPGF        = False,
      optCFGTransforms   = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter, 
                                         CFGTopDownFilter, CFGMergeIdentical],
      optLibraryPath     = [],
@@ -367,8 +367,8 @@ optDescr =
                "Select an optimization package. OPT = all | values | parametrize | none",
     Option [] ["optimize-pgf"] (NoArg (optimize_pgf True))
                "Enable or disable global grammar optimization. This could significantly reduce the size of the final PGF file",
-     Option [] ["mk-index"] (NoArg (mkIndex True))
-                "Add an index to the pgf file",
+     Option [] ["split-pgf"] (NoArg (splitPGF True))
+                "Split the PGF into one file per language. This allows the runtime to load only individual languages",
     Option [] ["stem"] (onOff (toggleOptimize OptStem) True) "Perform stem-suffix analysis (default on).",
     Option [] ["cse"] (onOff (toggleOptimize OptCSE) True) "Perform common sub-expression elimination (default on).",
     Option [] ["cfg"] (ReqArg cfgTransform "TRANS") "Enable or disable specific CFG transformations. TRANS = merge, no-merge, bottomup, no-bottomup, ...",
@@ -437,7 +437,7 @@ optDescr =
                         Nothing -> fail $ "Unknown optimization package: " ++ x
                         
       optimize_pgf x = set $ \o -> o { optOptimizePGF = x }
-       mkIndex x = set $ \o -> o { optMkIndexPGF = x }
+       splitPGF x = set $ \o -> o { optSplitPGF = x }

       toggleOptimize x b = set $ setOptimization' x b

--- a/src/compiler/GFC.hs
+++ b/src/compiler/GFC.hs
@@ -5,7 +5,7 @@ import PGF
 --import PGF.CId
 import PGF.Data
 import PGF.Optimize
-import GF.Index
+import PGF.Binary(putSplitAbs)
 import GF.Compile
 import GF.Compile.Export

@@ -24,7 +24,7 @@ import qualified Data.ByteString.Lazy as BSL
 import System.FilePath
 import System.IO
 import Control.Exception
-import Control.Monad(unless)
+import Control.Monad(unless,forM_)

 mainGFC :: Options -> [FilePath] -> IO ()
 mainGFC opts fs = do
@@ -66,10 +66,9 @@ unionPGFFiles :: Options -> [FilePath] -> IOE ()
 unionPGFFiles opts fs = 
    do pgfs <- mapM readPGFVerbose fs
       let pgf0 = foldl1 unionPGF pgfs
-           pgf1 = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
-           pgf = if flag optMkIndexPGF opts then addIndex pgf1 else pgf1
+           pgf  = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
           pgfFile = grammarName opts pgf <.> "pgf"
-       if pgfFile `elem` fs 
+       if pgfFile `elem` fs
         then putStrLnE $ "Refusing to overwrite " ++ pgfFile
         else writePGF opts pgf
       writeOutputs opts pgf
@@ -104,9 +103,16 @@ writeByteCode opts pgf
      [(id,addr) | (id,(_,_,_,addr))     <- Map.toList (cats (abstract pgf))]

 writePGF :: Options -> PGF -> IOE ()
-writePGF opts pgf = do
-  let outfile = grammarName opts pgf <.> "pgf"
-  putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ encodeFile outfile pgf
+writePGF opts pgf
+  | flag optSplitPGF opts = do let outfile = grammarName opts pgf <.> "pgf"
+                               putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ do
+                                 encodeFile_ outfile (putSplitAbs pgf)
+                               forM_ (Map.toList (concretes pgf)) $ \cnc -> do
+                                 let outfile = showCId (fst cnc) <.> "pgf_c"
+                                 putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ encodeFile outfile cnc
+                               return ()
+  | otherwise             = do let outfile = grammarName opts pgf <.> "pgf"
+                               putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ encodeFile outfile pgf

 grammarName :: Options -> PGF -> String
 grammarName opts pgf = fromMaybe (showCId (absname pgf)) (flag optName opts)
--- a/src/runtime/haskell/PGF/Binary.hs
+++ b/src/runtime/haskell/PGF/Binary.hs
@@ -49,7 +49,15 @@ instance Binary Abstr where
                        , cats=fmap (\(x,y,z) -> (x,y,z,0)) cats
                        , code=BS.empty                        
                        })
-  
+
+putSplitAbs :: PGF -> Put
+putSplitAbs pgf = do
+  putWord16be pgfMajorVersion
+  putWord16be pgfMinorVersion
+  put (Map.insert (mkCId "index") (LStr "true") (gflags pgf))
+  put (absname pgf, abstract pgf)
+  put [(name,cflags cnc) | (name,cnc) <- Map.toList (concretes pgf)]
+
 instance Binary Concr where
  put cnc = do put (cflags cnc)
               put (printnames cnc)