1
0
forked from GitHub/gf-core

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.

This commit is contained in:
kr.angelov
2013-12-10 10:43:13 +00:00
parent 2dda42e4d9
commit 87fffffbdf
5 changed files with 29 additions and 52 deletions

View File

@@ -88,12 +88,12 @@ Library
PGF PGF
PGF.Data PGF.Data
PGF.Macros PGF.Macros
PGF.Binary
PGF.Optimize PGF.Optimize
PGF.Printer PGF.Printer
PGF.Utilities PGF.Utilities
other-modules: other-modules:
PGF.CId PGF.CId
PGF.Binary
PGF.Expr PGF.Expr
PGF.Generate PGF.Generate
PGF.Linearize PGF.Linearize
@@ -219,7 +219,6 @@ Executable gf
GF.Compile.PGFtoProlog GF.Compile.PGFtoProlog
GF.Compile.PGFtoJS GF.Compile.PGFtoJS
GF.Compile GF.Compile
GF.Index
GF.Quiz GF.Quiz
GFC GFC
GFI GFI

View File

@@ -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)

View File

@@ -161,7 +161,7 @@ data Flags = Flags {
optPMCFG :: Bool, optPMCFG :: Bool,
optOptimizations :: Set Optimization, optOptimizations :: Set Optimization,
optOptimizePGF :: Bool, optOptimizePGF :: Bool,
optMkIndexPGF :: Bool, optSplitPGF :: Bool,
optCFGTransforms :: Set CFGTransform, optCFGTransforms :: Set CFGTransform,
optLibraryPath :: [FilePath], optLibraryPath :: [FilePath],
optStartCat :: Maybe String, optStartCat :: Maybe String,
@@ -272,7 +272,7 @@ defaultFlags = Flags {
optPMCFG = True, optPMCFG = True,
optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize], optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize],
optOptimizePGF = False, optOptimizePGF = False,
optMkIndexPGF = False, optSplitPGF = False,
optCFGTransforms = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter, optCFGTransforms = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter,
CFGTopDownFilter, CFGMergeIdentical], CFGTopDownFilter, CFGMergeIdentical],
optLibraryPath = [], optLibraryPath = [],
@@ -367,8 +367,8 @@ optDescr =
"Select an optimization package. OPT = all | values | parametrize | none", "Select an optimization package. OPT = all | values | parametrize | none",
Option [] ["optimize-pgf"] (NoArg (optimize_pgf True)) Option [] ["optimize-pgf"] (NoArg (optimize_pgf True))
"Enable or disable global grammar optimization. This could significantly reduce the size of the final PGF file", "Enable or disable global grammar optimization. This could significantly reduce the size of the final PGF file",
Option [] ["mk-index"] (NoArg (mkIndex True)) Option [] ["split-pgf"] (NoArg (splitPGF True))
"Add an index to the pgf file", "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 [] ["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 [] ["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, ...", 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 Nothing -> fail $ "Unknown optimization package: " ++ x
optimize_pgf x = set $ \o -> o { optOptimizePGF = 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 toggleOptimize x b = set $ setOptimization' x b

View File

@@ -5,7 +5,7 @@ import PGF
--import PGF.CId --import PGF.CId
import PGF.Data import PGF.Data
import PGF.Optimize import PGF.Optimize
import GF.Index import PGF.Binary(putSplitAbs)
import GF.Compile import GF.Compile
import GF.Compile.Export import GF.Compile.Export
@@ -24,7 +24,7 @@ import qualified Data.ByteString.Lazy as BSL
import System.FilePath import System.FilePath
import System.IO import System.IO
import Control.Exception import Control.Exception
import Control.Monad(unless) import Control.Monad(unless,forM_)
mainGFC :: Options -> [FilePath] -> IO () mainGFC :: Options -> [FilePath] -> IO ()
mainGFC opts fs = do mainGFC opts fs = do
@@ -66,10 +66,9 @@ unionPGFFiles :: Options -> [FilePath] -> IOE ()
unionPGFFiles opts fs = unionPGFFiles opts fs =
do pgfs <- mapM readPGFVerbose fs do pgfs <- mapM readPGFVerbose fs
let pgf0 = foldl1 unionPGF pgfs let pgf0 = foldl1 unionPGF pgfs
pgf1 = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0 pgf = if flag optOptimizePGF opts then optimizePGF pgf0 else pgf0
pgf = if flag optMkIndexPGF opts then addIndex pgf1 else pgf1
pgfFile = grammarName opts pgf <.> "pgf" pgfFile = grammarName opts pgf <.> "pgf"
if pgfFile `elem` fs if pgfFile `elem` fs
then putStrLnE $ "Refusing to overwrite " ++ pgfFile then putStrLnE $ "Refusing to overwrite " ++ pgfFile
else writePGF opts pgf else writePGF opts pgf
writeOutputs opts pgf writeOutputs opts pgf
@@ -104,9 +103,16 @@ writeByteCode opts pgf
[(id,addr) | (id,(_,_,_,addr)) <- Map.toList (cats (abstract pgf))] [(id,addr) | (id,(_,_,_,addr)) <- Map.toList (cats (abstract pgf))]
writePGF :: Options -> PGF -> IOE () writePGF :: Options -> PGF -> IOE ()
writePGF opts pgf = do writePGF opts pgf
let outfile = grammarName opts pgf <.> "pgf" | flag optSplitPGF opts = do let outfile = grammarName opts pgf <.> "pgf"
putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ encodeFile outfile 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 :: Options -> PGF -> String
grammarName opts pgf = fromMaybe (showCId (absname pgf)) (flag optName opts) grammarName opts pgf = fromMaybe (showCId (absname pgf)) (flag optName opts)

View File

@@ -49,7 +49,15 @@ instance Binary Abstr where
, cats=fmap (\(x,y,z) -> (x,y,z,0)) cats , cats=fmap (\(x,y,z) -> (x,y,z,0)) cats
, code=BS.empty , 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 instance Binary Concr where
put cnc = do put (cflags cnc) put cnc = do put (cflags cnc)
put (printnames cnc) put (printnames cnc)