From faed1348b1d2ba3f6ec4d9f108352e96ab1251a4 Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Tue, 10 Dec 2013 10:43:13 +0000 Subject: [PATCH] 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. --- gf.cabal | 3 +-- src/compiler/GF/Index.hs | 36 ------------------------------- src/compiler/GF/Infra/Option.hs | 10 ++++----- src/compiler/GFC.hs | 22 ++++++++++++------- src/runtime/haskell/PGF/Binary.hs | 10 ++++++++- 5 files changed, 29 insertions(+), 52 deletions(-) delete mode 100644 src/compiler/GF/Index.hs diff --git a/gf.cabal b/gf.cabal index 567daea3a..992d6f568 100644 --- 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 diff --git a/src/compiler/GF/Index.hs b/src/compiler/GF/Index.hs deleted file mode 100644 index eeb8697b3..000000000 --- a/src/compiler/GF/Index.hs +++ /dev/null @@ -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) diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs index fb516a690..7a7f77a1e 100644 --- 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 diff --git a/src/compiler/GFC.hs b/src/compiler/GFC.hs index 99156e16d..cb3fa7afd 100644 --- 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) diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs index bf30e4506..becf5b9de 100644 --- 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)