diff options
| author | Krasimir Angelov <kr.angelov@gmail.com> | 2017-12-19 10:47:30 +0100 |
|---|---|---|
| committer | Krasimir Angelov <kr.angelov@gmail.com> | 2017-12-19 10:47:30 +0100 |
| commit | a7926835a3a3911ff7455146cb1d0b8f117ba350 (patch) | |
| tree | 500fb84dc12803ebe15123588b28b7a6d4afcfcf | |
| parent | fa8530add196b1481dcd143f183889107e0b4948 (diff) | |
bugfix for random generation with HOAS
| -rw-r--r-- | src/runtime/haskell/PGF/Optimize.hs | 21 |
1 files changed, 11 insertions, 10 deletions
diff --git a/src/runtime/haskell/PGF/Optimize.hs b/src/runtime/haskell/PGF/Optimize.hs index 8739c8665..6e7f51fb2 100644 --- a/src/runtime/haskell/PGF/Optimize.hs +++ b/src/runtime/haskell/PGF/Optimize.hs @@ -21,6 +21,7 @@ import qualified Data.IntMap as IntMap import qualified PGF.TrieMap as TrieMap import qualified Data.List as List import Control.Monad.ST +import Debug.Trace optimizePGF :: PGF -> PGF optimizePGF pgf = pgf{concretes=fmap (updateConcrete (abstract pgf) . @@ -178,26 +179,26 @@ topDownFilter startCat cnc = 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 - | otherwise = filterProductions prods1 hoc1 prods + | otherwise = filterProductions prods1 prods 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) - | Set.null set1 = (prods,hoc) - | otherwise = (IntMap.insert fid set1 prods,hoc1) + foldProdSet fid set !prods + | Set.null set1 = prods + | otherwise = IntMap.insert fid set1 prods where set1 = Set.filter filterRule set - hoc1 = Set.fold accumHOC hoc set1 filterRule (PApply funid args) = all (\(PArg _ fid) -> isLive fid) args filterRule (PCoerce fid) = isLive fid 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 _ hoc = hoc @@ -241,7 +242,7 @@ splitLexicalRules cnc p_prods = seq2prefix (SymALL_CAPIT :syms) = TrieMap.fromList [wf ["&|"]] 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 l_prods = linIndex cnc p_prods0 in cnc{pproductions = p_prods, lproductions = l_prods, lexicon = lex} |