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:
3
gf.cabal
3
gf.cabal
@@ -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
|
||||||
|
|||||||
@@ -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)
|
|
||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|||||||
Reference in New Issue
Block a user