msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

bugfix for random generation with HOAS

Browse Source
This commit is contained in:
Krasimir Angelov
2017-12-19 10:47:30 +01:00
parent fa8530add1
commit a7926835a3
1 changed files with 11 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
src/runtime/haskell/PGF/Optimize.hs
View File

@@ -21,6 +21,7 @@ import qualified Data.IntMap as IntMap
import qualified PGF.TrieMap as TrieMap import qualified PGF.TrieMap as TrieMap
import qualified Data.List as List import qualified Data.List as List
import Control.Monad.ST import Control.Monad.ST
import Debug.Trace
optimizePGF :: PGF -> PGF optimizePGF :: PGF -> PGF
optimizePGF pgf = pgf{concretes=fmap (updateConcrete (abstract pgf) . optimizePGF pgf = pgf{concretes=fmap (updateConcrete (abstract pgf) .
@@ -178,26 +179,26 @@ topDownFilter startCat cnc =
bottomUpFilter :: Concr -> Concr bottomUpFilter :: Concr -> Concr
bottomUpFilter cnc = cnc{productions=filterProductions IntMap.empty IntSet.empty (productions cnc)} bottomUpFilter cnc = cnc{productions=filterProductions IntMap.empty (productions cnc)}
filterProductions prods0 hoc0 prods filterProductions prods0 prods
| prods0 == prods1 = prods0 | prods0 == prods1 = prods0
| otherwise = filterProductions prods1 hoc1 prods | otherwise = filterProductions prods1 prods
where where
(prods1,hoc1) = IntMap.foldWithKey foldProdSet (IntMap.empty,IntSet.empty) prods prods1 = IntMap.foldWithKey foldProdSet IntMap.empty prods
hoc = IntMap.fold (\set !hoc -> Set.fold accumHOC hoc set) IntSet.empty prods
foldProdSet fid set (!prods,!hoc) foldProdSet fid set !prods
| Set.null set1 = (prods,hoc) | Set.null set1 = prods
| otherwise = (IntMap.insert fid set1 prods,hoc1) | otherwise = IntMap.insert fid set1 prods
where where
set1 = Set.filter filterRule set set1 = Set.filter filterRule set
hoc1 = Set.fold accumHOC hoc set1
filterRule (PApply funid args) = all (\(PArg _ fid) -> isLive fid) args filterRule (PApply funid args) = all (\(PArg _ fid) -> isLive fid) args
filterRule (PCoerce fid) = isLive fid filterRule (PCoerce fid) = isLive fid
filterRule _ = True filterRule _ = True
isLive fid = isPredefFId fid || IntMap.member fid prods0 || IntSet.member fid hoc0 isLive fid = isPredefFId fid || IntMap.member fid prods0 || IntSet.member fid hoc
accumHOC (PApply funid args) hoc = List.foldl' (\hoc (PArg hypos _) -> List.foldl' (\hoc (_,fid) -> IntSet.insert fid hoc) hoc hypos) hoc args accumHOC (PApply funid args) hoc = List.foldl' (\hoc (PArg hypos _) -> List.foldl' (\hoc (_,fid) -> IntSet.insert fid hoc) hoc hypos) hoc args
accumHOC _ hoc = hoc accumHOC _ hoc = hoc
@@ -241,7 +242,7 @@ splitLexicalRules cnc p_prods =
seq2prefix (SymALL_CAPIT :syms) = TrieMap.fromList [wf ["&|"]] seq2prefix (SymALL_CAPIT :syms) = TrieMap.fromList [wf ["&|"]]
updateConcrete abs cnc = updateConcrete abs cnc =
let p_prods0 = filterProductions IntMap.empty IntSet.empty (productions cnc) let p_prods0 = filterProductions IntMap.empty (productions cnc)
(lex,p_prods) = splitLexicalRules cnc p_prods0 (lex,p_prods) = splitLexicalRules cnc p_prods0
l_prods = linIndex cnc p_prods0 l_prods = linIndex cnc p_prods0
in cnc{pproductions = p_prods, lproductions = l_prods, lexicon = lex} in cnc{pproductions = p_prods, lproductions = l_prods, lexicon = lex}