Better names, less code

1 files changed, 19 insertions, 23 deletions

diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 61bf41db3..5a0359a91 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -312,7 +312,7 @@ getFIds :: ProtoFCat -> [FId]
 getFIds = fidAltsToList . getFIdAlts
 
 getFIdAlts :: ProtoFCat -> FIdAlts
-getFIdAlts = fIdAltsFromKey . fIdKey
+getFIdAlts = fIdAltsFromFactors . fIdFactors
 
 getSingleFId :: ProtoFCat -> FId
 getSingleFId = expectSingleFId "getSingleFId" . getFIdAlts
@@ -342,9 +342,9 @@ testSchema (TestPar m choices) =
   CPar (m, [(EInt choice, choice) | choice <- choices])
 #endif
 
-fIdKey :: ProtoFCat -> FIdKey
-fIdKey (PFCat _ _ schema) =
-  FIdKey (collect schema)
+fIdFactors :: ProtoFCat -> FIdFactors
+fIdFactors (PFCat _ _ schema) =
+  FIdFactors (collect schema)
   where
     collect (CRec rs)         = concatMap (\(lbl,Identity t) -> collect t) rs
     collect (CTbl _ cs)       = concatMap (\(trm,Identity t) -> collect t) cs
@@ -597,15 +597,14 @@ type ProdGroups = Map.Map (FId,FunId) ProdGroup
 type FunSet     = Map.Map (UArray LIndex SeqId) FunId
 
 newtype FIdAlts = FIdAlts (UArray Int FId)
-  deriving (Eq,Ord)
+  deriving (Eq, Ord)
 
-newtype FIdKey = FIdKey [UArray Int FId]
-  deriving (Eq,Ord)
+newtype FIdFactors = FIdFactors [UArray Int FId]
 
 -- Keep exact argument FId products to preserve the old finalizer's duplicate
 -- and product-area semantics, but store each argument list compactly.
 newtype ArgFIdProduct = ArgFIdProduct [FIdAlts]
-  deriving (Eq,Ord)
+  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
@@ -637,6 +636,7 @@ getPMCFG (PMCFGEnv prodGroups funSet) =
     addGroup (fid,funid) (ProdGroup products mArgSets areaSum) prods
       | product (map IntSet.size argSets) == areaSum
                   = Production fid funid (map IntSet.toList argSets) : prods
+      -- We reverse the list for byte-to-byte equivalence with the previous grouping order.
       | otherwise = map (Production fid funid . unpackArgFIdProduct) (reverse (Set.toList products)) ++ prods
       where
         argSets = case mArgSets of
@@ -709,16 +709,16 @@ argFIdProductSize (ArgFIdProduct args) = product (map fidAltsSize args)
 getArgFIdProduct :: [ProtoFCat] -> ArgFIdProduct
 getArgFIdProduct pcats = ArgFIdProduct (fmap getFIdAlts pcats)
 
-fIdAltsFromKey :: FIdKey -> FIdAlts
-fIdAltsFromKey key@(FIdKey comps)
+fIdAltsFromFactors :: FIdFactors -> FIdAlts
+fIdAltsFromFactors factors@(FIdFactors comps)
   | resultSize == 0 = FIdAlts (listArray (0,-1) [])
-  | resultSize == 1 = singletonFId (fIdKeySingleton key)
+  | resultSize == 1 = singletonFId (fIdFactorsSingleton factors)
   | otherwise       = FIdAlts $ runSTUArray $ do
                         arr <- newArray_ (0,resultSize-1)
                         _   <- fillFIds arr 0 0 comps
                         return arr
   where
-    !resultSize = fIdKeyResultSize key
+    !resultSize = fIdFactorsResultSize factors
 
 fillFIds :: STUArray s Int FId -> Int -> FId -> [UArray Int FId] -> ST s Int
 fillFIds arr !offset !sum [] = do
@@ -738,22 +738,22 @@ foldUArrayM f z arr = go (fst bnds) z
       | otherwise = do acc' <- f acc (arr ! i)
                        go (i+1) acc'
 
-fIdKeyResultSize :: FIdKey -> Int
-fIdKeyResultSize (FIdKey comps) = product (map arraySize comps)
+fIdFactorsResultSize :: FIdFactors -> Int
+fIdFactorsResultSize (FIdFactors comps) = product (map (rangeSize . bounds) comps)
 
-fIdKeySingleton :: FIdKey -> FId
-fIdKeySingleton (FIdKey comps) = List.foldl' addChoice 0 comps
+fIdFactorsSingleton :: FIdFactors -> FId
+fIdFactorsSingleton (FIdFactors comps) = List.foldl' addChoice 0 comps
   where
     addChoice :: FId -> UArray Int FId -> FId
     addChoice acc choices
-      | arraySize choices == 1 = acc + choices ! fst (bounds choices)
-      | otherwise              = bug "fIdKeySingleton: non-singleton key"
+      | rangeSize (bounds choices) == 1 = acc + choices ! fst (bounds choices)
+      | otherwise                       = bug "fIdFactorsSingleton: non-singleton factors"
 
 singletonFId :: FId -> FIdAlts
 singletonFId fid = FIdAlts (listArray (0,0) [fid])
 
 fidAltsSize :: FIdAlts -> Int
-fidAltsSize (FIdAlts arr) = arraySize arr
+fidAltsSize (FIdAlts arr) = rangeSize (bounds arr)
 
 fidAltsIndex :: FIdAlts -> Int -> FId
 fidAltsIndex (FIdAlts arr) i = arr ! i
@@ -775,10 +775,6 @@ foldFIdAlts f z (FIdAlts arr) = go (fst bnds) z
       | otherwise = let !acc' = f acc (arr ! i)
                     in go (i+1) acc'
 
-arraySize :: UArray Int FId -> Int
-arraySize arr = let !(lo,hi) = bounds arr
-                in max 0 (hi-lo+1)
-
 ------------------------------------------------------------
 -- updating the MCF rule