added filtering for useless productions in PMCFG

4 files changed, 22 insertions, 6 deletions

diff --git a/src/GF/Compile/GenerateFCFG.hs b/src/GF/Compile/GenerateFCFG.hs
index 26fd2a4d9..bb8ba9452 100644
--- a/src/GF/Compile/GenerateFCFG.hs
+++ b/src/GF/Compile/GenerateFCFG.hs
@@ -329,6 +329,7 @@ getParserInfo :: GrammarEnv -> ParserInfo
 getParserInfo (GrammarEnv last_id catSet seqSet funSet prodSet) =
   ParserInfo { functions   = mkArray funSet
              , sequences   = mkArray seqSet
+	     , productions0= prodSet
 	     , productions = prodSet
 	     , startCats   = Map.map getFCatList catSet
 	     , totalCats   = last_id+1
diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs
index e29fce754..bb3215102 100644
--- a/src/GF/Compile/GeneratePMCFG.hs
+++ b/src/GF/Compile/GeneratePMCFG.hs
@@ -405,13 +405,15 @@ getParserInfo :: GrammarEnv -> ParserInfo
 getParserInfo (GrammarEnv last_id catSet seqSet funSet crcSet prodSet) =
   ParserInfo { functions   = mkArray funSet
              , sequences   = mkArray seqSet
-	     , productions = IntMap.union prodSet coercions
+	     , productions0= productions0
+	     , productions = filterProductions productions0
 	     , startCats   = maybe Map.empty (Map.map (\(start,end,_) -> range (start,end))) (IntMap.lookup 0 catSet)
 	     , totalCats   = last_id+1
 	     }
   where
     mkArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
     
+    productions0 = IntMap.union prodSet coercions
     coercions = IntMap.fromList [(fcat,Set.fromList (map FCoerce sub_fcats)) | (sub_fcats,fcat) <- Map.toList crcSet]
 
 getFCats :: GrammarEnv -> ProtoFCat -> [FCat]
diff --git a/src/PGF/Binary.hs b/src/PGF/Binary.hs
index acbff2309..9df9be146 100644
--- a/src/PGF/Binary.hs
+++ b/src/PGF/Binary.hs
@@ -7,6 +7,8 @@ import Data.Binary.Put
 import Data.Binary.Get

 import qualified Data.ByteString as BS

 import qualified Data.Map as Map

+import qualified Data.IntMap as IntMap

+import qualified Data.Set as Set

 import Control.Monad

 

 pgfMajorVersion, pgfMinorVersion :: Word16

@@ -159,13 +161,15 @@ instance Binary Production where
              _ -> decodingError

 

 instance Binary ParserInfo where

-  put p = put (functions p, sequences p, productions p, totalCats p, startCats p)

+  put p = put (functions p, sequences p, productions0 p, totalCats p, startCats p)

   get = do functions   <- get

            sequences   <- get

-           productions <- get

+           productions0<- get

            totalCats   <- get

            startCats   <- get

-           return (ParserInfo{functions=functions,sequences=sequences,productions=productions

+           return (ParserInfo{functions=functions,sequences=sequences

+                             ,productions0=productions0

+                             ,productions =filterProductions productions0

                              ,totalCats=totalCats,startCats=startCats})

 

 decodingError = fail "This PGF file was compiled with different version of GF"

diff --git a/src/PGF/PMCFG.hs b/src/PGF/PMCFG.hs
index 3196674ee..9a0dfa98e 100644
--- a/src/PGF/PMCFG.hs
+++ b/src/PGF/PMCFG.hs
@@ -41,7 +41,8 @@ data Alternative =
 data ParserInfo

     = ParserInfo { functions   :: Array FunId FFun

                  , sequences   :: Array SeqId FSeq

-	         , productions :: IntMap.IntMap (Set.Set Production)

+	         , productions0:: IntMap.IntMap (Set.Set Production)    -- this are the original productions as they are loaded from the PGF file

+	         , productions :: IntMap.IntMap (Set.Set Production)    -- this are the productions after the filtering for useless productions

 	         , startCats   :: Map.Map CId [FCat]

 	         , totalCats   :: {-# UNPACK #-} !FCat

 	         }

@@ -57,7 +58,7 @@ fcatVar    = (-4)
 ppPMCFG :: ParserInfo -> Doc

 ppPMCFG pinfo =

   text "productions" $$

-  nest 2 (vcat [ppProduction (fcat,prod) | (fcat,set) <- IntMap.toList (productions pinfo), prod <- Set.toList set]) $$

+  nest 2 (vcat [ppProduction (fcat,prod) | (fcat,set) <- IntMap.toList (productions0 pinfo), prod <- Set.toList set]) $$

   text "functions" $$

   nest 2 (vcat (map ppFun (assocs (functions pinfo)))) $$

   text "sequences" $$

@@ -101,3 +102,11 @@ ppFCat  fcat
 

 ppFunId funid = char 'F' <> int funid

 ppSeqId seqid = char 'S' <> int seqid

+

+

+filterProductions prods =

+  fmap (Set.filter filterRule) prods

+  where

+    filterRule (FApply funid args) = all (\fcat -> IntMap.member fcat prods) args

+    filterRule (FCoerce _)         = True

+    filterRule _                   = True