diff options
| author | adelon <22380201+adelon@users.noreply.github.com> | 2026-05-18 15:04:01 +0200 |
|---|---|---|
| committer | adelon <22380201+adelon@users.noreply.github.com> | 2026-05-18 15:04:01 +0200 |
| commit | 01fcbab7e65acb849db42a126ecd2ed17943a86f (patch) | |
| tree | 400ccddd0c36ff9faaaf0fe988c09b8fadc69442 /src/compiler/GF/Compile | |
| parent | 0e0168f26743429b7c06db300332ad6fca6533cf (diff) | |
Use non-strict functions (makes little difference)
Diffstat (limited to 'src/compiler/GF/Compile')
| -rw-r--r-- | src/compiler/GF/Compile/GeneratePMCFG.hs | 21 |
1 files changed, 4 insertions, 17 deletions
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index 3f8eeb213..61bf41db3 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -649,7 +649,7 @@ pmcfgTestBuildPMCFG = getPMCFG . List.foldl' addTestProduction emptyPMCFGEnv where addTestProduction env (TestProduction fid seqs args) = - addFunction env fid (mkArray seqs) (ArgFIdProduct (mapStrict fIdAltsFromList args)) + addFunction env fid (mkArray seqs) (ArgFIdProduct (fmap fIdAltsFromList args)) fIdAltsFromList :: [FId] -> FIdAlts fIdAltsFromList fids = FIdAlts (listArray (0,length fids-1) fids) @@ -685,7 +685,7 @@ insertArgFIdProduct argProduct group@(ProdGroup products mArgSets areaSum) updateArgSets Nothing _ = Nothing updateArgSets (Just argSets) (ArgFIdProduct argFIds) - | length argSets == length argFIds = let !argSets' = zipWithStrict addArgSet argSets argFIds + | length argSets == length argFIds = let !argSets' = zipWith addArgSet argSets argFIds in Just argSets' | otherwise = Nothing @@ -698,7 +698,7 @@ argFIdProductArgSets products = argFIdProductArgSetsOne :: ArgFIdProduct -> [IntSet.IntSet] argFIdProductArgSetsOne (ArgFIdProduct args) = - mapStrict (foldFIdAlts (\s fid -> IntSet.insert fid s) IntSet.empty) args + fmap (foldFIdAlts (\s fid -> IntSet.insert fid s) IntSet.empty) args unpackArgFIdProduct :: ArgFIdProduct -> [[FId]] unpackArgFIdProduct (ArgFIdProduct args) = map fidAltsToList args @@ -707,7 +707,7 @@ argFIdProductSize :: ArgFIdProduct -> Int argFIdProductSize (ArgFIdProduct args) = product (map fidAltsSize args) getArgFIdProduct :: [ProtoFCat] -> ArgFIdProduct -getArgFIdProduct pcats = ArgFIdProduct (mapStrict getFIdAlts pcats) +getArgFIdProduct pcats = ArgFIdProduct (fmap getFIdAlts pcats) fIdAltsFromKey :: FIdKey -> FIdAlts fIdAltsFromKey key@(FIdKey comps) @@ -779,19 +779,6 @@ arraySize :: UArray Int FId -> Int arraySize arr = let !(lo,hi) = bounds arr in max 0 (hi-lo+1) -mapStrict :: (a -> b) -> [a] -> [b] -mapStrict f [] = [] -mapStrict f (x:xs) = let !y = f x - !ys = mapStrict f xs - in y:ys - -zipWithStrict :: (a -> b -> c) -> [a] -> [b] -> [c] -zipWithStrict f [] [] = [] -zipWithStrict f (x:xs) (y:ys) = let !z = f x y - !zs = zipWithStrict f xs ys - in z:zs -zipWithStrict f _ _ = bug "zipWithStrict: inconsistent list lengths" - ------------------------------------------------------------ -- updating the MCF rule |