From 93e64faa49931bb8beb2e577f79f103084d34ed1 Mon Sep 17 00:00:00 2001 From: adelon <22380201+adelon@users.noreply.github.com> Date: Mon, 18 May 2026 01:37:36 +0200 Subject: Comments, `count` -> `areaSum` --- src/compiler/GF/Compile/GeneratePMCFG.hs | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index 0c081719f..030f8ab6d 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -616,6 +616,11 @@ newtype FIdKey = FIdKey [UArray Int FId] newtype ArgFIdProduct = ArgFIdProduct [FIdAlts] deriving (Eq,Ord) +-- Accumulator type for Productions with the same result FId and function. +-- The set keeps the exact distinct argument products. The optional IntSets +-- cache the per-argument union of FIds when all products have the same arity. +-- The final Int is the sum of product sizes (areaSum). A group can be emitted as one +-- compressed Production exactly when the union area equals this areaSum. data ProdGroup = ProdGroup !(Set.Set ArgFIdProduct) !(Maybe [IntSet.IntSet]) @@ -640,8 +645,8 @@ getPMCFG (PMCFGEnv prodGroups funSet _) = PMCFG (Map.foldrWithKey addGroup [] prodGroups) (mkSetArray funSet) where addGroup :: (FId,FunId) -> ProdGroup -> [Production] -> [Production] - addGroup (fid,funid) (ProdGroup products mArgSets count) prods - | product (map IntSet.size argSets) == count + addGroup (fid,funid) (ProdGroup products mArgSets areaSum) prods + | product (map IntSet.size argSets) == areaSum = Production fid funid (map IntSet.toList argSets) : prods | otherwise = map (Production fid funid . unpackArgFIdProduct) (reverse (Set.toList products)) ++ prods where @@ -674,18 +679,18 @@ singletonProdGroup :: ArgFIdProduct -> ProdGroup singletonProdGroup args = let !products = Set.singleton args !argSets = argFIdProductArgSetsOne args - !count = argFIdProductSize args - in ProdGroup products (Just argSets) count + !areaSum = argFIdProductSize args + in ProdGroup products (Just argSets) areaSum insertArgFIdProduct :: ArgFIdProduct -> ProdGroup -> ProdGroup -insertArgFIdProduct args group@(ProdGroup products mArgSets count) +insertArgFIdProduct args group@(ProdGroup products mArgSets areaSum) | Set.member args products = group | otherwise = let !products' = Set.insert args products !mArgSets' = updateArgSets mArgSets args - !count' = count + argFIdProductSize args - in ProdGroup products' mArgSets' count' + !areaSum' = areaSum + argFIdProductSize args + in ProdGroup products' mArgSets' areaSum' where addArgSet argSet fids = foldFIdAlts (\s fid -> IntSet.insert fid s) argSet fids @@ -742,6 +747,11 @@ getArgFIdProductCached env0 pcats = let !(env',alt) = getFIdAltsCached env pcat in (env',alt:alts) +-- Caching is only a performance optimization and does not affect the generated PMCFG. +-- Rebuilding singleton, single-component, or tiny alternatives is cheap, and +-- caching them would retain expanded arrays for little benefit. +-- Thus, cache only when the schema is a non-trivial product and the expanded result +-- is larger than the compact key that describes it. shouldCacheFIdKey :: FIdKey -> Int -> Bool shouldCacheFIdKey key resultSize = fIdKeyComponents key > 1 && -- cgit v1.2.3