Comments, `count` -> `areaSum`

1 files changed, 17 insertions, 7 deletions

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 &&