diff options
| author | adelon <22380201+adelon@users.noreply.github.com> | 2026-06-11 01:01:52 +0200 |
|---|---|---|
| committer | adelon <22380201+adelon@users.noreply.github.com> | 2026-06-11 01:01:52 +0200 |
| commit | eb9f72dad4f9a95aa39b260ddd85bdf597797767 (patch) | |
| tree | 2307e1f0e997ef3b1d41dd80acbc23a8f9c1d63c /src/compiler/GF/Compile | |
| parent | 74a526789228ca3d10070fb0129cb8c5e1b70c44 (diff) | |
Clean up `getSingleFId`, drop one `reverse` which should not matter semantically
Diffstat (limited to 'src/compiler/GF/Compile')
| -rw-r--r-- | src/compiler/GF/Compile/GeneratePMCFG.hs | 24 |
1 files changed, 10 insertions, 14 deletions
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index aa25db870..d94e67e5d 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -315,7 +315,11 @@ getFIdAlts :: ProtoFCat -> FIdAlts getFIdAlts = fIdAltsFromFactors . fIdFactors getSingleFId :: ProtoFCat -> FId -getSingleFId = expectSingleFId "getSingleFId" . getFIdAlts +getSingleFId pcat = + let !factors = fIdFactors pcat + in case fIdFactorsResultSize factors of + 1 -> fIdFactorsSingleton factors + _ -> bug "getSingleFId: expected singleton category" #ifdef PMCFG_TEST_HOOKS pmcfgTestGetFIds :: TestSchema -> [FId] @@ -693,7 +697,7 @@ insertArgFIdProduct argProduct group@(ProdGroup products mArgSets areaSum) argFIdProductArgSets :: Set.Set ArgFIdProduct -> [IntSet.IntSet] argFIdProductArgSets products = - List.foldl' addProduct (repeat IntSet.empty) (reverse (Set.toList products)) + List.foldl' addProduct (repeat IntSet.empty) (Set.toList products) where addProduct argSets (ArgFIdProduct args) = zipWith addArgSet argSets args addArgSet argSet fids = insertFIdAlts argSet fids @@ -719,13 +723,13 @@ fIdAltsFromFactors factors@(FIdFactors comps) !resultSize = fIdFactorsResultSize factors fillFIds :: STUArray s Int FId -> Int -> FId -> [UArray Int FId] -> ST s Int -fillFIds arr !offset !acc [] = do - writeArray arr offset acc +fillFIds arr !offset !fidAcc [] = do + writeArray arr offset fidAcc return (offset + 1) -- Components are ordered outer-to-inner. This must match the old -- reverse (solutions (variants schema) ()) ordering. -fillFIds arr !offset !acc (choices : choices') = - foldUArrayM (\offset' choice -> fillFIds arr offset' (acc + choice) choices') offset choices +fillFIds arr !offset !fidAcc (factor : factors) = + foldUArrayM (\offset' fidDelta -> fillFIds arr offset' (fidAcc + fidDelta) factors) offset factor foldUArrayM :: Monad m => (a -> FId -> m a) -> a -> UArray Int FId -> m a foldUArrayM f z arr = go (fst bnds) z @@ -753,14 +757,6 @@ singletonFId fid = FIdAlts (listArray (0,0) [fid]) fidAltsSize :: FIdAlts -> Int fidAltsSize (FIdAlts arr) = rangeSize (bounds arr) -fidAltsIndex :: FIdAlts -> Int -> FId -fidAltsIndex (FIdAlts arr) i = arr ! i - -expectSingleFId :: String -> FIdAlts -> FId -expectSingleFId label alts - | fidAltsSize alts == 1 = fidAltsIndex alts 0 - | otherwise = bug (label++": expected singleton category") - fidAltsToList :: FIdAlts -> [FId] fidAltsToList (FIdAlts arr) = elems arr |