From 0367e8c3037a4c449054b86a08f7924b7e6f006d Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 21 Jun 2020 20:26:34 -0400 Subject: fix(xanthous): Make floodFill faster Speed up the floodFill algorithm by sprinkling in some strictness and specializing it to the only type it's currently called at anyway. Change-Id: I4557fc51b1c1036c127bfd5bee50748d8692ae74 Reviewed-on: https://cl.tvl.fyi/c/depot/+/555 Reviewed-by: glittershark --- users/glittershark/xanthous/src/Xanthous/Generators/Util.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs index cdac568e40..70d94860dc 100644 --- a/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs +++ b/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs @@ -163,9 +163,11 @@ floodFill = go mempty (if y == maxBound then y else succ y)] in foldl' (\r idx' -> if arr ! idx' - then r <> go (r & contains idx' .~ True) arr idx' + then r <> (let r' = r & contains idx' .~ True + in r' `seq` go r' arr idx') else r) (res & contains idx .~ True) neighbors +{-# SPECIALIZE floodFill :: UArray (Word, Word) Bool -> (Word, Word) -> Set (Word, Word) #-} -- | Gives a list of all the disconnected regions in a cell array, represented -- each as lists of points @@ -188,6 +190,7 @@ regions arr where findFirstPoint :: a (i, j) Bool -> Maybe (i, j) findFirstPoint = fmap fst . headMay . filter snd . assocs +{-# SPECIALIZE regions :: UArray (Word, Word) Bool -> [Set (Word, Word)] #-} fillAll :: (IArray a Bool, Ix i, Foldable f) => f i -> a i Bool -> a i Bool fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes -- cgit 1.4.1