about summary refs log tree commit diff
diff options
context:
space:
mode:
authorGriffin Smith <grfn@gws.fyi>2020-06-22T00·26-0400
committerglittershark <grfn@gws.fyi>2020-06-22T00·40+0000
commit0367e8c3037a4c449054b86a08f7924b7e6f006d (patch)
tree1bc208c38dd3cdb7494bb514952a35f1b6b0b134
parentfbbb284444a7307245b6157033ab58b4dd871b9f (diff)
fix(xanthous): Make floodFill faster r/1059
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 <grfn@gws.fyi>
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Generators/Util.hs5
1 files changed, 4 insertions, 1 deletions
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