explanation, and better name, for helper function bit_pattern

Author: jwaldmann

containers/src/Data/Set/Internal.hs

@@ -1831,6 +1831,10 @@ powerSet :: Set a -> Set (Set a)
 powerSet xs =
   let !w = length xs
       !u = A.listArray (0, w-1) $ toList xs
+      -- v ! m is the set with bit pattern m,
+      -- e.g., for xs = [1,2,3],
+      -- we have  fmap Foldable.toList v =  array (0,7)
+      -- [(0,[]),(1,[3]),(2,[2]),(3,[2,3]),(4,[1]),(5,[1,3]),(6,[1,2]),(7,[1,2,3])]
       !v = generateA (0, 2^w -1) $ \ m ->
         if m == 0
         then Tip
@@ -1840,26 +1844,34 @@ powerSet xs =
       make !begin !s =
         if s == 0 then Tip
         else let !sl = div (s-1) 2; !sr = s - 1 - sl
-             in  bin (v A.! forw w (begin + sl))
+                 -- @bit_pattern@ puts sets in lexicographic order
+             in  bin (v A.! bit_pattern w (begin + sl))
                      (make begin sl)
                      (make (begin + sl+1) sr)
   in  make 0 (2^w)
 
 generateA :: A.Ix i => (i,i) -> (i -> a) -> A.Array i a
 generateA bnd f = A.listArray bnd $ fmap f $ A.range bnd
 
-forw :: Int -> Int -> Int
-forw 0 _ = 0
-forw !width !n = fr_go_branch (bit $ width-1) n 0
-
-fr_go_branch :: Int -> Int -> Int -> Int
-fr_go_branch !topmask !n !set =
-  if n == 0 then set
-  else if 0 == ((n-1) .&. topmask)
-  then fr_go_branch (shiftR topmask 1)
-         (n-1) (set .|. topmask)
-  else fr_go_branch (shiftR topmask 1)
-         (n .&. complement topmask) set
+-- | @bit_pattern w i@ is the bit pattern at position i
+-- in the lexicographic enumeration of their meanings as sets.
+-- map (bit_pattern  3) [0..7]
+-- = [0,4,6,7,5,2,3,1]
+-- = [000,100,110,111,101,010,011,001]
+-- This function is called often. It takes 1/3 of run-time,
+-- but it does not allocate.
+bit_pattern :: Int -> Int -> Int
+bit_pattern 0 _ = 0
+bit_pattern !width !i =
+  let go :: Int -> Int -> Int -> Int
+      go !topmask !n !set =
+        if n == 0 then set
+        else if 0 == ((n-1) .&. topmask)
+        then go (shiftR topmask 1)
+             (n-1) (set .|. topmask)
+        else go (shiftR topmask 1)
+             (n .&. complement topmask) set
+  in  go (bit $ width-1) i 0
 
 data StrictTriple = ST !Int !Int !Int