diff --git a/patches/basement-0.0.11.patch b/patches/basement-0.0.12.patch
similarity index 97%
rename from patches/basement-0.0.11.patch
rename to patches/basement-0.0.12.patch
index 4e03b97b91d1817cd1f22d3a5240c4184eb8968a..0366431a6d08c9b557788c92f239205d53e1ac78 100644
--- a/patches/basement-0.0.11.patch
+++ b/patches/basement-0.0.12.patch
@@ -398,32 +398,6 @@ index f304a86..9a48c3c 100644
  
  -- Int64 ----------------------------------------------------------------------
  
-diff --git a/Basement/Block/Base.hs b/Basement/Block/Base.hs
-index 2780529..77d1978 100644
---- a/Basement/Block/Base.hs
-+++ b/Basement/Block/Base.hs
-@@ -36,7 +36,7 @@ module Basement.Block.Base
-     , unsafeRecast
-     ) where
- 
--import           GHC.Prim
-+import           GHC.Exts
- import           GHC.Types
- import           GHC.ST
- import           GHC.IO
-diff --git a/Basement/BoxedArray.hs b/Basement/BoxedArray.hs
-index e73a0c4..a4fa1c5 100644
---- a/Basement/BoxedArray.hs
-+++ b/Basement/BoxedArray.hs
-@@ -74,7 +74,7 @@ module Basement.BoxedArray
-     , builderBuild_
-     ) where
- 
--import           GHC.Prim
-+import           GHC.Exts
- import           GHC.Types
- import           GHC.ST
- import           Data.Proxy
 diff --git a/Basement/Cast.hs b/Basement/Cast.hs
 index ecccba1..e8e9de2 100644
 --- a/Basement/Cast.hs
@@ -465,19 +439,6 @@ index ecccba1..e8e9de2 100644
  instance Cast Word64 Int64 where
      cast = word64ToInt64
  instance Cast Word   Int where
-diff --git a/Basement/FinalPtr.hs b/Basement/FinalPtr.hs
-index 1b3582c..ec77d94 100644
---- a/Basement/FinalPtr.hs
-+++ b/Basement/FinalPtr.hs
-@@ -25,7 +25,7 @@ module Basement.FinalPtr
-     ) where
- 
- import GHC.Ptr
--import GHC.ForeignPtr
-+import GHC.ForeignPtr (ForeignPtr, castForeignPtr, touchForeignPtr, unsafeForeignPtrToPtr)
- import GHC.IO
- import Basement.Monad
- import Basement.Compat.Primitive
 diff --git a/Basement/From.hs b/Basement/From.hs
 index 4f51154..53c0653 100644
 --- a/Basement/From.hs
@@ -909,24 +870,11 @@ index aff92b1..ed99b1d 100644
      integralDownsizeCheck = integralDownsizeBounded integralDownsize
  
  instance IntegralDownsize Integer Int8 where
-diff --git a/Basement/Monad.hs b/Basement/Monad.hs
-index 6433f60..806819d 100644
---- a/Basement/Monad.hs
-+++ b/Basement/Monad.hs
-@@ -33,7 +33,7 @@ import           GHC.ST
- import           GHC.STRef
- import           GHC.IORef
- import           GHC.IO
--import           GHC.Prim
-+import           GHC.Exts
- import           Basement.Compat.Base (Exception, (.), ($), Applicative, Monad)
- 
- -- | Primitive monad that can handle mutation.
 diff --git a/Basement/Numerical/Additive.hs b/Basement/Numerical/Additive.hs
-index c21d77a..22af1e0 100644
+index 7973887..1fd2091 100644
 --- a/Basement/Numerical/Additive.hs
 +++ b/Basement/Numerical/Additive.hs
-@@ -19,6 +19,7 @@ import           GHC.Prim
+@@ -21,6 +21,7 @@ import           GHC.Prim
  import           GHC.Int
  import           GHC.Word
  import           Basement.Bounded
@@ -934,7 +882,7 @@ index c21d77a..22af1e0 100644
  import           Basement.Nat
  import           Basement.Types.Word128 (Word128)
  import           Basement.Types.Word256 (Word256)
-@@ -63,15 +64,15 @@ instance Additive Int where
+@@ -65,15 +66,15 @@ instance Additive Int where
      scale = scaleNum
  instance Additive Int8 where
      azero = 0
@@ -953,7 +901,7 @@ index c21d77a..22af1e0 100644
      scale = scaleNum
  instance Additive Int64 where
      azero = 0
-@@ -91,15 +92,15 @@ instance Additive Natural where
+@@ -93,15 +94,15 @@ instance Additive Natural where
      scale = scaleNum
  instance Additive Word8 where
      azero = 0
@@ -994,7 +942,7 @@ index a86d195..9fc0005 100644
  word64ToWord32s :: Word64 -> Word32x2
  word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord# w64))
 diff --git a/Basement/String.hs b/Basement/String.hs
-index e097e7b..607806a 100644
+index 980434f..4d2edce 100644
 --- a/Basement/String.hs
 +++ b/Basement/String.hs
 @@ -129,6 +129,7 @@ import qualified Basement.Alg.UTF8 as UTF8
@@ -1541,7 +1489,7 @@ index 6d59102..ffeef82 100644
  
  data Table = Table { unTable :: !Addr# }
 diff --git a/basement.cabal b/basement.cabal
-index ad166c6..c09b557 100644
+index 89b2794..05b8d9b 100644
 --- a/basement.cabal
 +++ b/basement.cabal
 @@ -136,6 +136,8 @@ library
diff --git a/patches/combinat-0.2.9.0.patch b/patches/combinat-0.2.10.0.patch
similarity index 88%
rename from patches/combinat-0.2.9.0.patch
rename to patches/combinat-0.2.10.0.patch
index a0374baf8b63fb3fb6758ca945f1ac4dda651c11..b18b61f1c1e42217067bdfc43f32c3de4f20fc69 100644
--- a/patches/combinat-0.2.9.0.patch
+++ b/patches/combinat-0.2.10.0.patch
@@ -1,16 +1,3 @@
-diff --git a/Math/Combinat/Groups/Braid.hs b/Math/Combinat/Groups/Braid.hs
-index 3760cac..7030ea2 100644
---- a/Math/Combinat/Groups/Braid.hs
-+++ b/Math/Combinat/Groups/Braid.hs
-@@ -282,7 +282,7 @@ isPureBraid braid = (braidPermutation braid == P.identity n) where
- -- we got the two-line notation of the permutation.
- --
- braidPermutation :: KnownNat n => Braid n -> Permutation
--braidPermutation braid@ (Braid gens) = perm where
-+braidPermutation braid@(Braid gens) = perm where
-   n    = numberOfStrands braid
-   perm = _braidPermutation n (map brGenIdx gens)
- 
 diff --git a/Math/Combinat/Groups/Thompson/F.hs b/Math/Combinat/Groups/Thompson/F.hs
 index c500238..9fa4426 100644
 --- a/Math/Combinat/Groups/Thompson/F.hs
@@ -296,7 +283,7 @@ index c500238..9fa4426 100644
  asciiTDiag :: TDiag -> ASCII
  asciiTDiag (TDiag _ top bot) = vCatWith HLeft (VSepString " ") [asciiT' False top , asciiT' True bot]
 diff --git a/Math/Combinat/Helper.hs b/Math/Combinat/Helper.hs
-index 1acd3f3..8c8e91a 100644
+index ca37bad..bff4e8b 100644
 --- a/Math/Combinat/Helper.hs
 +++ b/Math/Combinat/Helper.hs
 @@ -10,7 +10,7 @@ import Control.Monad
@@ -308,6 +295,204 @@ index 1acd3f3..8c8e91a 100644
  import Data.Ord
  import Data.Proxy
  
+@@ -58,7 +58,7 @@ interleave [x]    []     = x : []
+ interleave []     []     = []
+ interleave _      _      = error "interleave: shouldn't happen"
+ 
+-evens, odds :: [a] -> [a] 
++evens, odds :: [a] -> [a]
+ evens (x:xs) = x : odds xs
+ evens [] = []
+ odds (x:xs) = evens xs
+@@ -79,7 +79,7 @@ productInterleaved = go where
+ -- | Faster implementation of @product [ i | i <- [a+1..b] ]@
+ productFromTo :: Integral a => a -> a -> Integer
+ productFromTo = go where
+-  go !a !b 
++  go !a !b
+     | dif < 1     = 1
+     | dif < 5     = product [ fromIntegral i | i<-[a+1..b] ]
+     | otherwise   = go a half * go half b
+@@ -90,7 +90,7 @@ productFromTo = go where
+ -- | Faster implementation of product @[ i | i <- [a+1,a+3,..b] ]@
+ productFromToStride2 :: Integral a => a -> a -> Integer
+ productFromToStride2 = go where
+-  go !a !b 
++  go !a !b
+     | dif < 1     = 1
+     | dif < 9     = product [ fromIntegral i | i<-[a+1,a+3..b] ]
+     | otherwise   = go a half * go half b
+@@ -99,7 +99,7 @@ productFromToStride2 = go where
+       half = a + 2*(div dif 4)
+ 
+ --------------------------------------------------------------------------------
+--- * equality and ordering 
++-- * equality and ordering
+ 
+ equating :: Eq b => (a -> b) -> a -> a -> Bool
+ equating f x y = (f x == f y)
+@@ -119,12 +119,12 @@ reverseSort :: Ord a => [a] -> [a]
+ reverseSort = sortBy reverseCompare
+ 
+ groupSortBy :: (Eq b, Ord b) => (a -> b) -> [a] -> [[a]]
+-groupSortBy f = groupBy (equating f) . sortBy (comparing f) 
++groupSortBy f = groupBy (equating f) . sortBy (comparing f)
+ 
+ nubOrd :: Ord a => [a] -> [a]
+ nubOrd = worker Set.empty where
+   worker _ [] = []
+-  worker s (x:xs) 
++  worker s (x:xs)
+     | Set.member x s = worker s xs
+     | otherwise      = x : worker (Set.insert x s) xs
+ 
+@@ -134,7 +134,7 @@ nubOrd = worker Set.empty where
+ {-# SPECIALIZE isWeaklyIncreasing :: [Int] -> Bool #-}
+ isWeaklyIncreasing :: Ord a => [a] -> Bool
+ isWeaklyIncreasing = go where
+-  go xs = case xs of 
++  go xs = case xs of
+     (a:rest@(b:_)) -> a <= b && go rest
+     [_]            -> True
+     []             -> True
+@@ -142,7 +142,7 @@ isWeaklyIncreasing = go where
+ {-# SPECIALIZE isStrictlyIncreasing :: [Int] -> Bool #-}
+ isStrictlyIncreasing :: Ord a => [a] -> Bool
+ isStrictlyIncreasing = go where
+-  go xs = case xs of 
++  go xs = case xs of
+     (a:rest@(b:_)) -> a < b && go rest
+     [_]            -> True
+     []             -> True
+@@ -150,7 +150,7 @@ isStrictlyIncreasing = go where
+ {-# SPECIALIZE isWeaklyDecreasing :: [Int] -> Bool #-}
+ isWeaklyDecreasing :: Ord a => [a] -> Bool
+ isWeaklyDecreasing = go where
+-  go xs = case xs of 
++  go xs = case xs of
+     (a:rest@(b:_)) -> a >= b && go rest
+     [_]            -> True
+     []             -> True
+@@ -158,13 +158,13 @@ isWeaklyDecreasing = go where
+ {-# SPECIALIZE isStrictlyDecreasing :: [Int] -> Bool #-}
+ isStrictlyDecreasing :: Ord a => [a] -> Bool
+ isStrictlyDecreasing = go where
+-  go xs = case xs of 
++  go xs = case xs of
+     (a:rest@(b:_)) -> a > b && go rest
+     [_]            -> True
+     []             -> True
+ 
+ --------------------------------------------------------------------------------
+--- * first \/ last 
++-- * first \/ last
+ 
+ -- | The boolean argument will @True@ only for the last element
+ mapWithLast :: (Bool -> a -> b) -> [a] -> [b]
+@@ -174,8 +174,8 @@ mapWithLast f = go where
+ 
+ mapWithFirst :: (Bool -> a -> b) -> [a] -> [b]
+ mapWithFirst f = go True where
+-  go b (x:xs) = f b x : go False xs 
+-  
++  go b (x:xs) = f b x : go False xs
++
+ mapWithFirstLast :: (Bool -> Bool -> a -> b) -> [a] -> [b]
+ mapWithFirstLast f = go True where
+   go b (x : []) = f b True  x : []
+@@ -196,26 +196,26 @@ mkBlocksUniformHeight old = zipWith worker ls old where
+   ls = map length old
+   m  = maximum ls
+   worker l s = s ++ replicate (m-l) ""
+-    
+-mkUniformBlocks :: [[String]] -> [[String]] 
++
++mkUniformBlocks :: [[String]] -> [[String]]
+ mkUniformBlocks = map mkLinesUniformWidth . mkBlocksUniformHeight
+-    
++
+ hConcatLines :: [[String]] -> [String]
+ hConcatLines = map concat . transpose . mkUniformBlocks
+ 
+-vConcatLines :: [[String]] -> [String]  
++vConcatLines :: [[String]] -> [String]
+ vConcatLines = concat
+ 
+ --------------------------------------------------------------------------------
+ -- * counting
+ 
+--- helps testing the random rutines 
++-- helps testing the random rutines
+ count :: Eq a => a -> [a] -> Int
+ count x xs = length $ filter (==x) xs
+ 
+ histogram :: (Eq a, Ord a) => [a] -> [(a,Int)]
+ histogram xs = Map.toList table where
+-  table = Map.fromListWith (+) [ (x,1) | x<-xs ] 
++  table = Map.fromListWith (+) [ (x,1) | x<-xs ]
+ 
+ --------------------------------------------------------------------------------
+ -- * maybe
+@@ -232,25 +232,25 @@ intToBool 0 = False
+ intToBool 1 = True
+ intToBool _ = error "intToBool"
+ 
+-boolToInt :: Bool -> Int 
++boolToInt :: Bool -> Int
+ boolToInt False = 0
+ boolToInt True  = 1
+ 
+ --------------------------------------------------------------------------------
+ -- * iteration
+-    
++
+ -- iterated function application
+ nest :: Int -> (a -> a) -> a -> a
+ nest !0 _ x = x
+ nest !n f x = nest (n-1) f (f x)
+ 
+ unfold1 :: (a -> Maybe a) -> a -> [a]
+-unfold1 f x = case f x of 
+-  Nothing -> [x] 
+-  Just y  -> x : unfold1 f y 
+-  
++unfold1 f x = case f x of
++  Nothing -> [x]
++  Just y  -> x : unfold1 f y
++
+ unfold :: (b -> (a,Maybe b)) -> b -> [a]
+-unfold f y = let (x,m) = f y in case m of 
++unfold f y = let (x,m) = f y in case m of
+   Nothing -> [x]
+   Just y' -> x : unfold f y'
+ 
+@@ -258,7 +258,7 @@ unfoldEither :: (b -> Either c (b,a)) -> b -> (c,[a])
+ unfoldEither f y = case f y of
+   Left z -> (z,[])
+   Right (y,x) -> let (z,xs) = unfoldEither f y in (z,x:xs)
+-  
++
+ unfoldM :: Monad m => (b -> m (a,Maybe b)) -> b -> m [a]
+ unfoldM f y = do
+   (x,m) <- f y
+@@ -276,7 +276,7 @@ mapAccumM f s (x:xs) = do
+   return (s2, y:ys)
+ 
+ --------------------------------------------------------------------------------
+--- * long zipwith    
++-- * long zipwith
+ 
+ longZipWith :: a -> b -> (a -> b -> c) -> [a] -> [b] -> [c]
+ longZipWith a0 b0 f = go where
+@@ -286,7 +286,7 @@ longZipWith a0 b0 f = go where
+ 
+ {-
+ longZipWithZero :: (Num a, Num b) => (a -> b -> c) -> [a] -> [b] -> [c]
+-longZipWithZero = longZipWith 0 0 
++longZipWithZero = longZipWith 0 0
+ -}
+ 
+ --------------------------------------------------------------------------------
 diff --git a/Math/Combinat/LatticePaths.hs b/Math/Combinat/LatticePaths.hs
 index 741dc1c..0831baa 100644
 --- a/Math/Combinat/LatticePaths.hs
@@ -592,23 +777,6 @@ index 741dc1c..0831baa 100644
    | m == 0    = if k==0 then 1 else 0
    | k <= 0    = 0
    | m <  0    = 0
-diff --git a/Math/Combinat/Numbers/Primes.hs b/Math/Combinat/Numbers/Primes.hs
-index 6cf837f..0122d6d 100644
---- a/Math/Combinat/Numbers/Primes.hs
-+++ b/Math/Combinat/Numbers/Primes.hs
-@@ -54,10 +54,10 @@ primesTMWE = 2:3:5:7: gaps 11 wheel (fold3t $ roll 11 wheel primes') where
-   pairs ((x:xs):ys:t) = (x : union xs ys) : pairs t 
-   wheel = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2:  
-           4:8:6:4:6:2:4:6:2:6:6:4:2:4:6:2:6:4:2:4:2:10:2:10:wheel 
--  gaps k ws@(w:t) cs@ ~(c:u) 
-+  gaps k ws@(w:t) cs@(~(c:u)) 
-     | k==c  = gaps (k+w) t u              
-     | True  = k : gaps (k+w) t cs  
--  roll k ws@(w:t) ps@ ~(p:u) 
-+  roll k ws@(w:t) ps@(~(p:u)) 
-     | k==p  = scanl (\c d->c+p*d) (p*p) ws : roll (k+w) t u              
-     | True  = roll (k+w) t ps   
- 
 diff --git a/Math/Combinat/Numbers/Series.hs b/Math/Combinat/Numbers/Series.hs
 index c31d1b1..8f940c8 100644
 --- a/Math/Combinat/Numbers/Series.hs
@@ -906,10 +1074,10 @@ index c31d1b1..8f940c8 100644
  
  
 diff --git a/Math/Combinat/Partitions/Integer.hs b/Math/Combinat/Partitions/Integer.hs
-index 1b25e0b..35e38e1 100644
+index 2749a5e..d02370d 100644
 --- a/Math/Combinat/Partitions/Integer.hs
 +++ b/Math/Combinat/Partitions/Integer.hs
-@@ -15,61 +15,61 @@
+@@ -15,20 +15,20 @@
  -- can be represented by the (English notation) Ferrers diagram:
  --
  -- <<svg/ferrers.svg>>
@@ -934,7 +1102,10 @@ index 1b25e0b..35e38e1 100644
 +  , toPartition
 +  , toPartitionUnsafe
 +  , isPartition
-     -- * Union and sum
+     -- * Conversion to\/from exponent vectors
+   , toExponentVector
+   , fromExponentVector
+@@ -37,47 +37,47 @@ module Math.Combinat.Partitions.Integer
    , unionOfPartitions
    , sumOfPartitions
      -- * Generating partitions
@@ -960,10 +1131,16 @@ index 1b25e0b..35e38e1 100644
    , randomPartition
    , randomPartitions
      -- * Dominating \/ dominated partitions
+   , dominanceCompare
 -  , dominatedPartitions 
 -  , dominatingPartitions 
 +  , dominatedPartitions
 +  , dominatingPartitions
+     -- * Conjugate lexicographic ordering
+-  , conjugateLexicographicCompare 
+-  , ConjLex (..) , fromConjLex 
++  , conjugateLexicographicCompare
++  , ConjLex (..) , fromConjLex
      -- * Partitions with given number of parts
    , partitionsWithKParts
      -- * Partitions with only odd\/distinct parts
@@ -988,11 +1165,11 @@ index 1b25e0b..35e38e1 100644
  --------------------------------------------------------------------------------
  
 -import Data.List
-+import Data.List (sortBy)
++import Data.List (group, sortBy)
  import Control.Monad ( liftM , replicateM )
  
  -- import Data.Map (Map)
-@@ -92,7 +92,7 @@ import Math.Combinat.Partitions.Integer.Count
+@@ -100,7 +100,7 @@ import Math.Combinat.Partitions.Integer.Count
  
  fromPartition :: Partition -> [Int]
  fromPartition (Partition_ part) = part
@@ -1001,7 +1178,7 @@ index 1b25e0b..35e38e1 100644
  -- | Sorts the input, and cuts the nonpositive elements.
  mkPartition :: [Int] -> Partition
  mkPartition xs = toPartitionUnsafe $ sortBy (reverseCompare) $ filter (>0) xs
-@@ -106,8 +106,8 @@ toPartition xs = if isPartition xs
+@@ -114,8 +114,8 @@ toPartition xs = if isPartition xs
  -- | Assumes that the input is decreasing.
  toPartitionUnsafe :: [Int] -> Partition
  toPartitionUnsafe = Partition_
@@ -1012,7 +1189,38 @@ index 1b25e0b..35e38e1 100644
  -- /positive/ integers (possibly empty); @False@ otherwise.
  --
  isPartition :: [Int] -> Bool
-@@ -118,13 +118,13 @@ isPartition (x:xs@(y:_)) = (x >= y) && isPartition xs
+@@ -125,10 +125,10 @@ isPartition (x:xs@(y:_)) = (x >= y) && isPartition xs
+ 
+ --------------------------------------------------------------------------------
+ -- * Conversion to\/from exponent vectors
+-     
++
+ -- | Converts a partition to an exponent vector.
+ --
+--- For example, 
++-- For example,
+ --
+ -- > toExponentVector (Partition [4,4,2,2,2,1]) == [1,3,0,2]
+ --
+@@ -137,7 +137,7 @@ isPartition (x:xs@(y:_)) = (x >= y) && isPartition xs
+ toExponentVector :: Partition -> [Int]
+ toExponentVector part = fun 1 $ reverse $ group (fromPartition part) where
+   fun _  [] = []
+-  fun !k gs@(this@(i:_):rest) 
++  fun !k gs@(this@(i:_):rest)
+     | k < i      = replicate (i-k) 0 ++ fun i gs
+     | otherwise  = length this : fun (k+1) rest
+ 
+@@ -153,7 +153,7 @@ dropTailingZeros = reverse . dropWhile (==0) . reverse
+ toExponentialVector2 :: Partition -> [Int]
+ toExponentialVector2 p = go 1 (toExponentialForm p) where
+   go _  []              = []
+-  go !i ef@((j,e):rest) = if i<j 
++  go !i ef@((j,e):rest) = if i<j
+     then 0 : go (i+1) ef
+     else e : go (i+1) rest
+ -}
+@@ -161,13 +161,13 @@ toExponentialVector2 p = go 1 (toExponentialForm p) where
  --------------------------------------------------------------------------------
  -- * Union and sum
  
@@ -1028,7 +1236,7 @@ index 1b25e0b..35e38e1 100644
  unionOfPartitions (Partition_ xs) (Partition_ ys) = mkPartition (xs ++ ys)
  
  -- | Pointwise sum of the parts. For example:
-@@ -133,7 +133,7 @@ unionOfPartitions (Partition_ xs) (Partition_ ys) = mkPartition (xs ++ ys)
+@@ -176,7 +176,7 @@ unionOfPartitions (Partition_ xs) (Partition_ ys) = mkPartition (xs ++ ys)
  --
  -- Note: This is the dual of 'unionOfPartitions'
  --
@@ -1037,7 +1245,7 @@ index 1b25e0b..35e38e1 100644
  sumOfPartitions (Partition_ xs) (Partition_ ys) = Partition_ (longZipWith 0 0 (+) xs ys)
  
  --------------------------------------------------------------------------------
-@@ -144,11 +144,11 @@ partitions :: Int -> [Partition]
+@@ -187,11 +187,11 @@ partitions :: Int -> [Partition]
  partitions = map toPartitionUnsafe . _partitions
  
  -- | Partitions of d, fitting into a given rectangle. The order is again lexicographic.
@@ -1051,7 +1259,7 @@ index 1b25e0b..35e38e1 100644
  
  --------------------------------------------------------------------------------
  
-@@ -162,13 +162,13 @@ allPartitionsGrouped :: Int -> [[Partition]]
+@@ -205,13 +205,13 @@ allPartitionsGrouped :: Int -> [[Partition]]
  allPartitionsGrouped d = [ partitions i | i <- [0..d] ]
  
  -- | All integer partitions fitting into a given rectangle.
@@ -1067,7 +1275,7 @@ index 1b25e0b..35e38e1 100644
    :: (Int,Int)        -- ^ (height,width)
    -> [[Partition]]
  allPartitionsGrouped' (h,w) = [ partitions' (h,w) i | i <- [0..d] ] where d = h*w
-@@ -177,7 +177,7 @@ allPartitionsGrouped' (h,w) = [ partitions' (h,w) i | i <- [0..d] ] where d = h*
+@@ -220,7 +220,7 @@ allPartitionsGrouped' (h,w) = [ partitions' (h,w) i | i <- [0..d] ] where d = h*
  ---------------------------------------------------------------------------------
  -- * Random partitions
  
@@ -1076,7 +1284,7 @@ index 1b25e0b..35e38e1 100644
  --
  -- NOTE: This algorithm is effective for small @n@-s (say @n@ up to a few hundred \/ one thousand it should work nicely),
  -- and the first time it is executed may be slower (as it needs to build the table of partitions counts first)
-@@ -195,19 +195,19 @@ randomPartition n g = (p, g') where
+@@ -238,19 +238,19 @@ randomPartition n g = (p, g') where
  -- | Generates several uniformly random partitions of @n@ at the same time.
  -- Should be a little bit faster then generating them individually.
  --
@@ -1100,7 +1308,7 @@ index 1b25e0b..35e38e1 100644
    fi = fromIntegral
  
    find_jd :: Int -> Integer -> (Int,Int)
-@@ -215,9 +215,9 @@ randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+@@ -258,9 +258,9 @@ randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
      go :: Integer -> [(Int,Int)] -> (Int,Int)
      go !s []   = (1,1)       -- ??
      go !s [jd] = jd          -- ??
@@ -1113,7 +1321,16 @@ index 1b25e0b..35e38e1 100644
          else go s' rest
        where
          s' = s + fi d * cnt (m - j*d)
-@@ -236,16 +236,16 @@ randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+@@ -277,7 +277,7 @@ randomPartitions howmany n = runRand $ replicateM howmany (worker n []) where
+ 
+ -- | Dominance partial ordering as a partial ordering.
+ dominanceCompare :: Partition -> Partition -> Maybe Ordering
+-dominanceCompare p q  
++dominanceCompare p q
+   | p==q             = Just EQ
+   | p `dominates` q  = Just GT
+   | q `dominates` p  = Just LT
+@@ -287,23 +287,23 @@ dominanceCompare p q
  -- (that is, all partial sums are less or equal):
  --
  -- > dominatedPartitions lam == [ mu | mu <- partitions (weight lam), lam `dominates` mu ]
@@ -1134,7 +1351,15 @@ index 1b25e0b..35e38e1 100644
  dominatingPartitions (Partition_ mu) = map Partition_ (_dominatingPartitions mu)
  
  --------------------------------------------------------------------------------
-@@ -257,7 +257,7 @@ dominatingPartitions (Partition_ mu) = map Partition_ (_dominatingPartitions mu)
+ -- * Conjugate lexicographic ordering
+ 
+ conjugateLexicographicCompare :: Partition -> Partition -> Ordering
+-conjugateLexicographicCompare p q = compare (dualPartition q) (dualPartition p) 
++conjugateLexicographicCompare p q = compare (dualPartition q) (dualPartition p)
+ 
+ newtype ConjLex = ConjLex Partition deriving (Eq,Show)
+ 
+@@ -330,7 +330,7 @@ instance Ord ConjLex where
  --
  -- Naive recursive algorithm.
  --
@@ -1143,7 +1368,7 @@ index 1b25e0b..35e38e1 100644
    :: Int    -- ^ @k@ = number of parts
    -> Int    -- ^ @n@ = the integer we partition
    -> [Partition]
-@@ -267,7 +267,7 @@ partitionsWithKParts k n = map Partition_ $ go n k n where
+@@ -340,7 +340,7 @@ partitionsWithKParts k n = map Partition_ $ go n k n where
    k = number of parts
    n = integer
  -}
@@ -1152,7 +1377,7 @@ index 1b25e0b..35e38e1 100644
      | k <  0     = []
      | k == 0     = if h>=0 && n==0 then [[] ] else []
      | k == 1     = if h>=n && n>=1 then [[n]] else []
-@@ -294,7 +294,7 @@ partitionsWithEvenParts d = map Partition (go d d) where
+@@ -367,7 +367,7 @@ partitionsWithEvenParts d = map Partition (go d d) where
  -}
  
  -- | Partitions of @n@ with distinct parts.
@@ -1161,7 +1386,7 @@ index 1b25e0b..35e38e1 100644
  -- Note:
  --
  -- > length (partitionsWithDistinctParts d) == length (partitionsWithOddParts d)
-@@ -324,7 +324,7 @@ allSubPartitions (Partition_ ps) = map Partition_ (_allSubPartitions ps)
+@@ -397,7 +397,7 @@ allSubPartitions (Partition_ ps) = map Partition_ (_allSubPartitions ps)
  --
  superPartitions :: Int -> Partition -> [Partition]
  superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps)
@@ -1170,7 +1395,7 @@ index 1b25e0b..35e38e1 100644
  
  --------------------------------------------------------------------------------
  -- * ASCII Ferrers diagrams
-@@ -333,7 +333,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
+@@ -406,7 +406,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
  -- For example, the partition [5,4,1] corrsponds to:
  --
  -- In standard English notation:
@@ -1179,7 +1404,7 @@ index 1b25e0b..35e38e1 100644
  -- >  @@@@@
  -- >  @@@@
  -- >  @
-@@ -341,7 +341,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
+@@ -414,7 +414,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
  --
  -- In English notation rotated by 90 degrees counter-clockwise:
  --
@@ -1188,7 +1413,7 @@ index 1b25e0b..35e38e1 100644
  -- > @@
  -- > @@
  -- > @@
-@@ -350,7 +350,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
+@@ -423,7 +423,7 @@ superPartitions d (Partition_ ps) = map toPartitionUnsafe (_superPartitions d ps
  --
  -- And in French notation:
  --
@@ -1197,7 +1422,7 @@ index 1b25e0b..35e38e1 100644
  -- >  @
  -- >  @@@@
  -- >  @@@@@
-@@ -373,7 +373,7 @@ asciiFerrersDiagram = asciiFerrersDiagram' EnglishNotation '@'
+@@ -446,7 +446,7 @@ asciiFerrersDiagram = asciiFerrersDiagram' EnglishNotation '@'
  
  asciiFerrersDiagram' :: PartitionConvention -> Char -> Partition -> ASCII
  asciiFerrersDiagram' conv ch part = ASCII.asciiFromLines (map f ys) where
@@ -1617,10 +1842,10 @@ index 0da13ac..fbb6c6c 100644
  
  --------------------------------------------------------------------------------
 diff --git a/Math/Combinat/Partitions/Integer/Naive.hs b/Math/Combinat/Partitions/Integer/Naive.hs
-index 55b9466..113e9ae 100644
+index 7a6842f..ed4223d 100644
 --- a/Math/Combinat/Partitions/Integer/Naive.hs
 +++ b/Math/Combinat/Partitions/Integer/Naive.hs
-@@ -5,14 +5,13 @@
+@@ -5,14 +5,14 @@
  --
  -- This is an internal module, you are not supposed to import it directly.
  --
@@ -1633,10 +1858,11 @@ index 55b9466..113e9ae 100644
  --------------------------------------------------------------------------------
  
 -import Data.List 
++import Data.List (sortBy)
  import Control.Monad ( liftM , replicateM )
  
  -- import Data.Map (Map)
-@@ -32,7 +31,7 @@ import Math.Combinat.Partitions.Integer.Count ( countPartitions )
+@@ -32,7 +32,7 @@ import Math.Combinat.Partitions.Integer.Count ( countPartitions )
  --------------------------------------------------------------------------------
  -- * Type and basic stuff
  
@@ -1645,7 +1871,16 @@ index 55b9466..113e9ae 100644
  -- are monotone decreasing sequences of /positive/ integers. The @Ord@ instance is lexicographical.
  newtype Partition = Partition [Int] deriving (Eq,Ord,Show,Read)
  
-@@ -56,33 +55,33 @@ partitionHeight :: Partition -> Int
+@@ -44,7 +44,7 @@ instance HasNumberOfParts Partition where
+ toList :: Partition -> [Int]
+ toList (Partition xs) = xs
+ 
+-fromList :: [Int] -> Partition 
++fromList :: [Int] -> Partition
+ fromList = mkPartition where
+   mkPartition xs = Partition $ sortBy (reverseCompare) $ filter (>0) xs
+ 
+@@ -68,33 +68,33 @@ partitionHeight :: Partition -> Int
  partitionHeight (Partition part) = case part of
    (p:_) -> p
    []    -> 0
@@ -1684,7 +1919,7 @@ index 55b9466..113e9ae 100644
    dual = dualPartition
  
  -- | Example:
-@@ -97,7 +96,7 @@ elements :: Partition -> [(Int,Int)]
+@@ -109,7 +109,7 @@ elements :: Partition -> [(Int,Int)]
  elements (Partition part) = _elements part
  
  --------------------------------------------------------------------------------
@@ -1693,7 +1928,7 @@ index 55b9466..113e9ae 100644
  
  -- | Pattern sysnonyms allows us to use existing code with minimal modifications
  pattern Nil :: Partition
-@@ -108,19 +107,19 @@ pattern Cons :: Int -> Partition -> Partition
+@@ -120,19 +120,19 @@ pattern Cons :: Int -> Partition -> Partition
  pattern Cons x xs  <- (unconsPartition -> Just (x,xs)) where
          Cons x (Partition xs) = Partition (x:xs)
  
@@ -1718,7 +1953,7 @@ index 55b9466..113e9ae 100644
  ---------------------------------------------------------------------------------
  -- * Exponential form
  
-@@ -142,7 +141,7 @@ fromExponentialForm = Partition . _fromExponentialForm where
+@@ -154,7 +154,7 @@ fromExponentialForm = Partition . _fromExponentialForm where
  -- @[a1-a2,a2-a3,...,an-0]@
  diffSequence :: Partition -> [Int]
  diffSequence = go . toDescList where
@@ -1727,7 +1962,7 @@ index 55b9466..113e9ae 100644
    go [x] = [x]
    go []  = []
  
-@@ -155,7 +154,7 @@ toDescList :: Partition -> [Int]
+@@ -167,7 +167,7 @@ toDescList :: Partition -> [Int]
  toDescList (Partition xs) = xs
  
  ---------------------------------------------------------------------------------
@@ -1736,7 +1971,7 @@ index 55b9466..113e9ae 100644
  
  -- | @q \`dominates\` p@ returns @True@ if @q >= p@ in the dominance order of partitions
  -- (this is partial ordering on the set of partitions of @n@).
-@@ -163,7 +162,7 @@ toDescList (Partition xs) = xs
+@@ -175,7 +175,7 @@ toDescList (Partition xs) = xs
  -- See <http://en.wikipedia.org/wiki/Dominance_order>
  --
  dominates :: Partition -> Partition -> Bool
@@ -1745,7 +1980,7 @@ index 55b9466..113e9ae 100644
    = and $ zipWith (>=) (sums (qs ++ repeat 0)) (sums ps)
    where
      sums = scanl (+) 0
-@@ -182,7 +181,7 @@ isSubPartitionOf (Partition ps) (Partition qs) = and $ zipWith (<=) ps (qs ++ re
+@@ -194,7 +194,7 @@ isSubPartitionOf (Partition ps) (Partition qs) = and $ zipWith (<=) ps (qs ++ re
  --
  isSuperPartitionOf :: Partition -> Partition -> Bool
  isSuperPartitionOf (Partition qs) (Partition ps) = and $ zipWith (<=) ps (qs ++ repeat 0)
@@ -1754,7 +1989,7 @@ index 55b9466..113e9ae 100644
  --------------------------------------------------------------------------------
  -- * The Pieri rule
  
-@@ -190,11 +189,11 @@ isSuperPartitionOf (Partition qs) (Partition ps) = and $ zipWith (<=) ps (qs ++
+@@ -202,11 +202,11 @@ isSuperPartitionOf (Partition qs) (Partition ps) = and $ zipWith (<=) ps (qs ++
  --
  -- See for example <http://en.wikipedia.org/wiki/Pieri's_formula>
  --
@@ -2537,7 +2772,7 @@ index 2715f31..60081c4 100644
        else           subtract_b rest
      where w = u - v
 diff --git a/Math/Combinat/Permutations.hs b/Math/Combinat/Permutations.hs
-index 0d615b8..2f37437 100644
+index 239ad67..017fa27 100644
 --- a/Math/Combinat/Permutations.hs
 +++ b/Math/Combinat/Permutations.hs
 @@ -1,5 +1,5 @@
@@ -2556,7 +2791,7 @@ index 0d615b8..2f37437 100644
    ( -- * The Permutation type
      Permutation (..)
    , fromPermutation
-@@ -34,8 +34,8 @@ module Math.Combinat.Permutations
+@@ -36,8 +36,8 @@ module Math.Combinat.Permutations
    , isReversePermutation
    , isEvenPermutation
    , isOddPermutation
@@ -2567,19 +2802,15 @@ index 0d615b8..2f37437 100644
    , module Math.Combinat.Sign   --  , Sign(..)
    , isCyclicPermutation
      -- * Some concrete permutations
-@@ -57,20 +57,20 @@ module Math.Combinat.Permutations
-   , identity
-   , inverse
-   , multiply
--  , multiplyMany 
-+  , multiplyMany
-   , multiplyMany'
+@@ -62,17 +62,17 @@ module Math.Combinat.Permutations
+   , productOfPermutations
+   , productOfPermutations'
      -- * Action of the permutation group
--  , permute 
-+  , permute
+-  , permuteArray 
++  , permuteArray
    , permuteList
-   , permuteLeft , permuteRight
-   , permuteLeftList , permuteRightList
+   , permuteArrayLeft , permuteArrayRight
+   , permuteListLeft  , permuteListRight
      -- * Sorting
 -  , sortingPermutationAsc 
 +  , sortingPermutationAsc
@@ -2592,7 +2823,7 @@ index 0d615b8..2f37437 100644
    , inverseTwoLineNotation
    , genericTwoLineNotation
      -- * List of permutations
-@@ -90,7 +90,7 @@ module Math.Combinat.Permutations
+@@ -92,7 +92,7 @@ module Math.Combinat.Permutations
    , permuteMultiset
    , countPermuteMultiset
    , fasc2B_algorithm_L
@@ -2601,7 +2832,7 @@ index 0d615b8..2f37437 100644
    where
  
  --------------------------------------------------------------------------------
-@@ -98,7 +98,7 @@ module Math.Combinat.Permutations
+@@ -100,7 +100,7 @@ module Math.Combinat.Permutations
  import Control.Monad
  import Control.Monad.ST
  
@@ -2610,21 +2841,29 @@ index 0d615b8..2f37437 100644
  import Data.Ord ( comparing )
  
  import Data.Array (Array)
-@@ -119,10 +119,10 @@ import System.Random
+@@ -152,7 +152,7 @@ _assocs vec = zip [1..] (_elems vec)
+ _bound :: WordVec -> Int
+ _bound = V.vecLen
+ 
+-{- 
++{-
+ -- the old internal representation (UArray Int Int)
+ 
+ _elems :: UArray Int Int -> [Int]
+@@ -172,10 +172,10 @@ toPermN n xs = Permutation (fromPermListN n xs)
  --------------------------------------------------------------------------------
  -- * Types
  
---- | A permutation. Internally it is an (unboxed) array of the integers @[1..n]@, with 
---- indexing range also being @(1,n)@. 
-+-- | A permutation. Internally it is an (unboxed) array of the integers @[1..n]@, with
-+-- indexing range also being @(1,n)@.
+--- | A permutation. Internally it is an (compact) vector 
++-- | A permutation. Internally it is an (compact) vector
+ -- of the integers @[1..n]@.
  --
 --- If this array of integers is @[p1,p2,...,pn]@, then in two-line 
 +-- If this array of integers is @[p1,p2,...,pn]@, then in two-line
  -- notations, that represents the permutation
  --
  -- > ( 1  2  3  ... n  )
-@@ -131,7 +131,7 @@ import System.Random
+@@ -184,7 +184,7 @@ toPermN n xs = Permutation (fromPermListN n xs)
  -- That is, it is the permutation @sigma@ whose (right) action on the set @[1..n]@ is
  --
  -- > sigma(1) = p1
@@ -2633,15 +2872,15 @@ index 0d615b8..2f37437 100644
  -- > ...
  --
  -- (NOTE: this changed at version 0.2.8.0!)
-@@ -139,16 +139,16 @@ import System.Random
- newtype Permutation = Permutation (UArray Int Int) deriving (Eq,Ord) -- ,Show,Read)
+@@ -192,16 +192,16 @@ toPermN n xs = Permutation (fromPermListN n xs)
+ newtype Permutation = Permutation WordVec deriving (Eq,Ord) -- ,Show,Read)
  
  instance Show Permutation where
 -  showsPrec d (Permutation arr) 
 -    = showParen (d > 10)  
 +  showsPrec d (Permutation arr)
 +    = showParen (d > 10)
-     $ showString "toPermutation " . showsPrec 11 (elems arr)       -- app_prec = 10
+     $ showString "toPermutation " . showsPrec 11 (_elems arr)       -- app_prec = 10
  
  instance Read Permutation where
    readsPrec d r = readParen (d > 10) fun r where
@@ -2654,10 +2893,24 @@ index 0d615b8..2f37437 100644
  
  instance DrawASCII Permutation where
    ascii = asciiPermutation
-@@ -201,15 +201,15 @@ maybePermutation input = runST action where
+@@ -228,11 +228,11 @@ permutationArray (Permutation ar) = listArray (1,n) (_elems ar) where
+ 
+ -- | Assumes that the input is a permutation of the numbers @[1..n]@.
+ toPermutationUnsafe :: [Int] -> Permutation
+-toPermutationUnsafe xs = Permutation (fromPermList xs) 
++toPermutationUnsafe xs = Permutation (fromPermList xs)
+ 
+ -- | This is faster than 'toPermutationUnsafe', but you need to supply @n@.
+ toPermutationUnsafeN :: Int -> [Int] -> Permutation
+-toPermutationUnsafeN n xs = Permutation (fromPermListN n xs) 
++toPermutationUnsafeN n xs = Permutation (fromPermListN n xs)
+ 
+ -- | Note: Indexing starts from 1.
+ uarrayToPermutationUnsafe :: UArray Int Int -> Permutation
+@@ -255,15 +255,15 @@ maybePermutation input = runST action where
    action = do
      ar <- newArray (1,n) 0 :: ST s (STUArray s Int Int)
-     let go []     = return $ Just (Permutation $ listArray (1,n) input)
+     let go []     = return $ Just (toPermutationUnsafe input)
 -        go (j:js) = if j<1 || j>n 
 +        go (j:js) = if j<1 || j>n
            then return Nothing
@@ -2673,7 +2926,16 @@ index 0d615b8..2f37437 100644
  -- | Checks the input.
  toPermutation :: [Int] -> Permutation
  toPermutation xs = case maybePermutation xs of
-@@ -234,7 +234,7 @@ isIdentityPermutation (Permutation ar) = (elems ar == [1..n]) where
+@@ -275,7 +275,7 @@ permutationSize :: Permutation -> Int
+ permutationSize (Permutation ar) = _bound ar
+ 
+ -- | Returns the image @sigma(k)@ of @k@ under the permutation @sigma@.
+--- 
++--
+ -- Note: we don't check the bounds! It may even crash if you index out of bounds!
+ lookupPermutation :: Permutation -> Int -> Int
+ lookupPermutation (Permutation ar) idx = ar .! idx
+@@ -300,7 +300,7 @@ isIdentityPermutation (Permutation ar) = (_elems ar == [1..n]) where
  --
  -- > permuteList p1 xs ++ permuteList p2 ys == permuteList (concatPermutations p1 p2) (xs++ys)
  --
@@ -2682,7 +2944,7 @@ index 0d615b8..2f37437 100644
  concatPermutations perm1 perm2 = toPermutationUnsafe list where
    n    = permutationSize perm1
    list = fromPermutation perm1 ++ map (+n) (fromPermutation perm2)
-@@ -244,11 +244,11 @@ concatPermutations perm1 perm2 = toPermutationUnsafe list where
+@@ -310,11 +310,11 @@ concatPermutations perm1 perm2 = toPermutationUnsafe list where
  
  -- | Synonym for 'twoLineNotation'
  asciiPermutation :: Permutation -> ASCII
@@ -2696,9 +2958,9 @@ index 0d615b8..2f37437 100644
    boxes = [ genericTwoLineNotation (f cyc) | cyc <- cycles ]
    f cyc = pairs (cyc ++ [head cyc])
  
-@@ -257,16 +257,16 @@ asciiDisjointCycles (DisjointCycles cycles) = final where
+@@ -323,16 +323,16 @@ asciiDisjointCycles (DisjointCycles cycles) = final where
  twoLineNotation :: Permutation -> ASCII
- twoLineNotation (Permutation arr) = genericTwoLineNotation $ zip [1..] (elems arr)
+ twoLineNotation (Permutation arr) = genericTwoLineNotation $ zip [1..] (_elems arr)
  
 --- | The inverse two-line notation, where the it\'s the bottom line 
 +-- | The inverse two-line notation, where the it\'s the bottom line
@@ -2707,16 +2969,16 @@ index 0d615b8..2f37437 100644
  --
 --- Remark: the top row of @inverseTwoLineNotation perm@ is the same 
 +-- Remark: the top row of @inverseTwoLineNotation perm@ is the same
- -- as the bottom row of @twoLineNotation (inverse perm)@.
+ -- as the bottom row of @twoLineNotation (inversePermutation perm)@.
  --
  inverseTwoLineNotation :: Permutation -> ASCII
  inverseTwoLineNotation (Permutation arr) =
--  genericTwoLineNotation $ sortBy (comparing snd) $ zip [1..] (elems arr) 
-+  genericTwoLineNotation $ sortBy (comparing snd) $ zip [1..] (elems arr)
+-  genericTwoLineNotation $ sortBy (comparing snd) $ zip [1..] (_elems arr) 
++  genericTwoLineNotation $ sortBy (comparing snd) $ zip [1..] (_elems arr)
  
  -- | Two-line notation for any set of numbers
  genericTwoLineNotation :: [(Int,Int)] -> ASCII
-@@ -274,9 +274,9 @@ genericTwoLineNotation xys = asciiFromLines [ topLine, botLine ] where
+@@ -340,9 +340,9 @@ genericTwoLineNotation xys = asciiFromLines [ topLine, botLine ] where
    topLine = "( " ++ intercalate " " us ++ " )"
    botLine = "( " ++ intercalate " " vs ++ " )"
    pairs   = [ (show x, show y) | (x,y) <- xys ]
@@ -2728,7 +2990,7 @@ index 0d615b8..2f37437 100644
      b = length t
      c = max a b
      s' = replicate (c-a) ' ' ++ s
-@@ -288,7 +288,7 @@ genericTwoLineNotation xys = asciiFromLines [ topLine, botLine ] where
+@@ -354,7 +354,7 @@ genericTwoLineNotation xys = asciiFromLines [ topLine, botLine ] where
  fromDisjointCycles :: DisjointCycles -> [[Int]]
  fromDisjointCycles (DisjointCycles cycles) = cycles
  
@@ -2737,14 +2999,14 @@ index 0d615b8..2f37437 100644
  disjointCyclesUnsafe = DisjointCycles
  
  instance DrawASCII DisjointCycles where
-@@ -299,33 +299,33 @@ instance HasNumberOfCycles DisjointCycles where
+@@ -365,33 +365,33 @@ instance HasNumberOfCycles DisjointCycles where
  
  instance HasNumberOfCycles Permutation where
    numberOfCycles = numberOfCycles . permutationToDisjointCycles
 -  
 +
  disjointCyclesToPermutation :: Int -> DisjointCycles -> Permutation
- disjointCyclesToPermutation n (DisjointCycles cycles) = Permutation perm where
+ disjointCyclesToPermutation n (DisjointCycles cycles) = Permutation $ fromUArray perm where
  
    pairs :: [Int] -> [(Int,Int)]
    pairs xs@(x:_) = worker (xs++[x]) where
@@ -2778,7 +3040,7 @@ index 0d615b8..2f37437 100644
  permutationToDisjointCycles :: Permutation -> DisjointCycles
  permutationToDisjointCycles (Permutation perm) = res where
  
-@@ -335,62 +335,62 @@ permutationToDisjointCycles (Permutation perm) = res where
+@@ -401,62 +401,62 @@ permutationToDisjointCycles (Permutation perm) = res where
    f :: [Int] -> Bool
    f [_] = False
    f _ = True
@@ -2814,7 +3076,7 @@ index 0d615b8..2f37437 100644
    worker :: STUArray s Int Bool -> Int -> Int -> [Int] -> ST s [Int]
    worker tag k l cyc = do
      writeArray tag l True
-     let m = perm ! l
+     let m = perm .! l
 -    if m == k 
 +    if m == k
        then return cyc
@@ -2824,7 +3086,7 @@ index 0d615b8..2f37437 100644
  isEvenPermutation :: Permutation -> Bool
  isEvenPermutation (Permutation perm) = res where
  
-   (1,n) = bounds perm
+   n = _bound perm
    res = runST $ do
 -    tag <- newArray (1,n) False 
 -    cycles <- unfoldM (step tag) 1 
@@ -2853,7 +3115,7 @@ index 0d615b8..2f37437 100644
    worker :: STUArray s Int Bool -> Int -> Int -> Int -> ST s Int
    worker tag k l cyclen = do
      writeArray tag l True
-     let m = perm ! l
+     let m = perm .! l
 -    if m == k 
 +    if m == k
        then return cyclen
@@ -2862,7 +3124,7 @@ index 0d615b8..2f37437 100644
  
  isOddPermutation :: Permutation -> Bool
  isOddPermutation = not . isEvenPermutation
-@@ -405,14 +405,14 @@ signOfPermutation perm = case isEvenPermutation perm of
+@@ -471,14 +471,14 @@ signOfPermutation perm = case isEvenPermutation perm of
  {-# SPECIALIZE signValueOfPermutation :: Permutation -> Integer #-}
  signValueOfPermutation :: Num a => Permutation -> a
  signValueOfPermutation = signValue . signOfPermutation
@@ -2880,16 +3142,16 @@ index 0d615b8..2f37437 100644
      n = permutationSize perm
      DisjointCycles cycles = permutationToDisjointCycles perm
  
-@@ -444,7 +444,7 @@ numberOfInversions = numberOfInversionsMerge
+@@ -510,7 +510,7 @@ numberOfInversions = numberOfInversionsMerge
  numberOfInversionsMerge :: Permutation -> Int
- numberOfInversionsMerge (Permutation arr) = fst (sortCnt n $ elems arr) where
-   (_,n) = bounds arr
+ numberOfInversionsMerge (Permutation arr) = fst (sortCnt n $ _elems arr) where
+   n = _bound arr
 -                                        
 +
    -- | First argument is length of the list.
    -- Returns also the inversion count.
    sortCnt :: Int -> [Int] -> (Int,[Int])
-@@ -453,13 +453,13 @@ numberOfInversionsMerge (Permutation arr) = fst (sortCnt n $ elems arr) where
+@@ -519,13 +519,13 @@ numberOfInversionsMerge (Permutation arr) = fst (sortCnt n $ _elems arr) where
    sortCnt 2 [x,y] = if x>y then (1,[y,x]) else (0,[x,y])
    sortCnt n xs    = mergeCnt (sortCnt k us) (sortCnt l vs) where
      k = div n 2
@@ -2905,7 +3167,7 @@ index 0d615b8..2f37437 100644
  
      go !k xs [] = ( k*length xs , xs )
      go _  [] ys = ( 0 , ys)
-@@ -478,7 +478,7 @@ numberOfInversionsNaive (Permutation arr) = length list where
+@@ -544,7 +544,7 @@ numberOfInversionsNaive (Permutation arr) = length list where
  --
  -- > multiplyMany' n (map (transposition n) $ bubbleSort2 perm) == perm
  --
@@ -2914,16 +3176,16 @@ index 0d615b8..2f37437 100644
  -- equals the number of inversions.
  --
  bubbleSort2 :: Permutation -> [(Int,Int)]
-@@ -504,7 +504,7 @@ bubbleSort perm@(Permutation tgt) = runST action where
+@@ -570,7 +570,7 @@ bubbleSort perm@(Permutation tgt) = runST action where
  
-       let k = tgt ! x        -- we take the number which will be at the @x@-th position at the end
+       let k = tgt .! x       -- we take the number which will be at the @x@-th position at the end
        i <- readArray inv k   -- number @k@ is at the moment at position @i@
 -      let j = x              -- but the final place is at @x@      
 +      let j = x              -- but the final place is at @x@
  
        let swaps = move i j
        forM_ swaps $ \y -> do
-@@ -520,7 +520,7 @@ bubbleSort perm@(Permutation tgt) = runST action where
+@@ -586,7 +586,7 @@ bubbleSort perm@(Permutation tgt) = runST action where
          writeArray inv a v
  
        return swaps
@@ -2932,9 +3194,9 @@ index 0d615b8..2f37437 100644
      return (concat list)
  
    move :: Int -> Int -> [Int]
-@@ -540,13 +540,13 @@ reversePermutation n = Permutation $ listArray (1,n) [n,n-1..1]
+@@ -606,13 +606,13 @@ reversePermutation n = Permutation $ fromPermListN n [n,n-1..1]
  isReversePermutation :: Permutation -> Bool
- isReversePermutation (Permutation arr) = elems arr == [n,n-1..1] where (1,n) = bounds arr
+ isReversePermutation (Permutation arr) = _elems arr == [n,n-1..1] where n = _bound arr
  
 --- | A transposition (swapping two elements). 
 +-- | A transposition (swapping two elements).
@@ -2946,10 +3208,10 @@ index 0d615b8..2f37437 100644
 -  if i>=1 && j>=1 && i<=n && j<=n 
 +transposition n (i,j) =
 +  if i>=1 && j>=1 && i<=n && j<=n
-     then Permutation $ listArray (1,n) [ f k | k<-[1..n] ]
+     then Permutation $ fromPermListN n [ f k | k<-[1..n] ]
      else error "transposition: index out of range"
    where
-@@ -563,19 +563,19 @@ transpositions n list = Permutation (runSTUArray action) where
+@@ -629,19 +629,19 @@ transpositions n list = Permutation (fromUArray $ runSTUArray action) where
  
    action :: ST s (STUArray s Int Int)
    action = do
@@ -2973,7 +3235,7 @@ index 0d615b8..2f37437 100644
    | k>0 && k<n  = transposition n (k,k+1)
    | otherwise   = error "adjacentTransposition: index out of range"
  
-@@ -588,42 +588,42 @@ adjacentTranspositions n list = Permutation (runSTUArray action) where
+@@ -654,42 +654,42 @@ adjacentTranspositions n list = Permutation (fromUArray $ runSTUArray action) wh
  
    action :: ST s (STUArray s Int Int)
    action = do
@@ -3004,7 +3266,7 @@ index 0d615b8..2f37437 100644
 --- 
 +--
  cycleLeft :: Int -> Permutation
- cycleLeft n = Permutation $ listArray (1,n) $ [2..n] ++ [1]
+ cycleLeft n = Permutation $ fromPermListN n ([2..n] ++ [1])
  
  -- | The permutation which cycles a list right by one step:
 --- 
@@ -3018,68 +3280,68 @@ index 0d615b8..2f37437 100644
 --- 
 +--
  cycleRight :: Int -> Permutation
- cycleRight n = Permutation $ listArray (1,n) $ n : [1..n-1]
+ cycleRight n = Permutation $ fromPermListN n (n : [1..n-1])
 -   
 +
  --------------------------------------------------------------------------------
  -- * Permutation groups
  
-@@ -631,55 +631,55 @@ cycleRight n = Permutation $ listArray (1,n) $ n : [1..n-1]
+@@ -697,55 +697,55 @@ cycleRight n = Permutation $ fromPermListN n (n : [1..n-1])
  -- means the permutation when we first apply @p@, and then @q@
  -- (that is, the natural action is the /right/ action)
  --
---- See also 'permute' for our conventions.  
-+-- See also 'permute' for our conventions.
+--- See also 'permuteArray' for our conventions.  
++-- See also 'permuteArray' for our conventions.
  --
- multiply :: Permutation -> Permutation -> Permutation
--multiply pi1@(Permutation perm1) pi2@(Permutation perm2) = 
+ multiplyPermutation :: Permutation -> Permutation -> Permutation
+-multiplyPermutation pi1@(Permutation perm1) pi2@(Permutation perm2) = 
 -  if (n==m) 
-+multiply pi1@(Permutation perm1) pi2@(Permutation perm2) =
++multiplyPermutation pi1@(Permutation perm1) pi2@(Permutation perm2) =
 +  if (n==m)
-     then Permutation result
--    else error "multiply: permutations of different sets"  
-+    else error "multiply: permutations of different sets"
+     then Permutation $ fromUArray result
+-    else error "multiplyPermutation: permutations of different sets"  
++    else error "multiplyPermutation: permutations of different sets"
    where
-     (_,n) = bounds perm1
--    (_,m) = bounds perm2    
-+    (_,m) = bounds perm2
-     result = permute pi2 perm1
+     n = _bound perm1
+-    m = _bound perm2    
++    m = _bound perm2
+     result = permuteArray pi2 (toUArray perm1)
 -  
--infixr 7 `multiply`  
+-infixr 7 `multiplyPermutation`  
 +
-+infixr 7 `multiply`
++infixr 7 `multiplyPermutation`
  
  -- | The inverse permutation.
--inverse :: Permutation -> Permutation    
-+inverse :: Permutation -> Permutation
- inverse (Permutation perm1) = Permutation result
+-inversePermutation :: Permutation -> Permutation    
++inversePermutation :: Permutation -> Permutation
+ inversePermutation (Permutation perm1) = Permutation $ fromUArray result
    where
-     result = array (1,n) $ map swap $ assocs perm1
-     (_,n) = bounds perm1
+     result = array (1,n) $ map swap $ _assocs perm1
+     n = _bound perm1
 -    
 +
  -- | The identity (or trivial) permutation.
--identity :: Int -> Permutation 
-+identity :: Int -> Permutation
- identity n = Permutation $ listArray (1,n) [1..n]
+-identityPermutation :: Int -> Permutation 
++identityPermutation :: Int -> Permutation
+ identityPermutation n = Permutation $ fromPermListN n [1..n]
  
  -- | Multiply together a /non-empty/ list of permutations (the reason for requiring the list to
  -- be non-empty is that we don\'t know the size of the result). See also 'multiplyMany''.
--multiplyMany :: [Permutation] -> Permutation 
-+multiplyMany :: [Permutation] -> Permutation
- multiplyMany [] = error "multiplyMany: empty list, we don't know size of the result"
--multiplyMany ps = foldl1' multiply ps    
-+multiplyMany ps = foldl1' multiply ps
+-productOfPermutations :: [Permutation] -> Permutation 
++productOfPermutations :: [Permutation] -> Permutation
+ productOfPermutations [] = error "productOfPermutations: empty list, we don't know size of the result"
+-productOfPermutations ps = foldl1' multiplyPermutation ps    
++productOfPermutations ps = foldl1' multiplyPermutation ps
  
  -- | Multiply together a (possibly empty) list of permutations, all of which has size @n@
--multiplyMany' :: Int -> [Permutation] -> Permutation 
-+multiplyMany' :: Int -> [Permutation] -> Permutation
- multiplyMany' n []       = identity n
--multiplyMany' n ps@(p:_) = if n == permutationSize p 
--  then foldl1' multiply ps    
-+multiplyMany' n ps@(p:_) = if n == permutationSize p
-+  then foldl1' multiply ps
-   else error "multiplyMany': incompatible permutation size(s)"
+-productOfPermutations' :: Int -> [Permutation] -> Permutation 
++productOfPermutations' :: Int -> [Permutation] -> Permutation
+ productOfPermutations' n []       = identityPermutation n
+-productOfPermutations' n ps@(p:_) = if n == permutationSize p 
+-  then foldl1' multiplyPermutation ps    
++productOfPermutations' n ps@(p:_) = if n == permutationSize p
++  then foldl1' multiplyPermutation ps
+   else error "productOfPermutations': incompatible permutation size(s)"
  
  --------------------------------------------------------------------------------
  -- * Action of the permutation group
@@ -3096,89 +3358,87 @@ index 0d615b8..2f37437 100644
 +-- We adopt the convention that permutations act /on the right/
  -- (as in Knuth):
  --
- -- > permute pi2 (permute pi1 set) == permute (pi1 `multiply` pi2) set
-@@ -688,37 +688,37 @@ multiplyMany' n ps@(p:_) = if n == permutationSize p
+ -- > permuteArray pi2 (permuteArray pi1 set) == permuteArray (pi1 `multiplyPermutation` pi2) set
+@@ -754,37 +754,37 @@ productOfPermutations' n ps@(p:_) = if n == permutationSize p
  --
- {-# SPECIALIZE permute :: Permutation -> Array  Int b   -> Array  Int b   #-}
- {-# SPECIALIZE permute :: Permutation -> UArray Int Int -> UArray Int Int #-}
--permute :: IArray arr b => Permutation -> arr Int b -> arr Int b    
-+permute :: IArray arr b => Permutation -> arr Int b -> arr Int b
- permute = permuteRight
+ {-# SPECIALIZE permuteArray :: Permutation -> Array  Int b   -> Array  Int b   #-}
+ {-# SPECIALIZE permuteArray :: Permutation -> UArray Int Int -> UArray Int Int #-}
+-permuteArray :: IArray arr b => Permutation -> arr Int b -> arr Int b    
++permuteArray :: IArray arr b => Permutation -> arr Int b -> arr Int b
+ permuteArray = permuteArrayRight
  
  -- | Right action on lists. Synonym to 'permuteListRight'
  --
  permuteList :: Permutation -> [a] -> [a]
- permuteList = permuteRightList
+ permuteList = permuteListRight
 -    
 --- | The right (standard) action of permutations on sets. 
 --- 
 +
 +-- | The right (standard) action of permutations on sets.
 +--
- -- > permuteRight pi2 (permuteRight pi1 set) == permuteRight (pi1 `multiply` pi2) set
+ -- > permuteArrayRight pi2 (permuteArrayRight pi1 set) == permuteArrayRight (pi1 `multiplyPermutation` pi2) set
 ---   
 +--
  -- The second argument should be an array with bounds @(1,n)@.
  -- The function checks the array bounds.
  --
- {-# SPECIALIZE permuteRight :: Permutation -> Array  Int b   -> Array  Int b   #-}
- {-# SPECIALIZE permuteRight :: Permutation -> UArray Int Int -> UArray Int Int #-}
--permuteRight :: IArray arr b => Permutation -> arr Int b -> arr Int b    
--permuteRight pi@(Permutation perm) ar = 
+ {-# SPECIALIZE permuteArrayRight :: Permutation -> Array  Int b   -> Array  Int b   #-}
+ {-# SPECIALIZE permuteArrayRight :: Permutation -> UArray Int Int -> UArray Int Int #-}
+-permuteArrayRight :: IArray arr b => Permutation -> arr Int b -> arr Int b    
+-permuteArrayRight pi@(Permutation perm) ar = 
 -  if (a==1) && (b==n) 
--    then listArray (1,n) [ ar!(perm!i) | i <- [1..n] ] 
-+permuteRight :: IArray arr b => Permutation -> arr Int b -> arr Int b
-+permuteRight pi@(Permutation perm) ar =
+-    then listArray (1,n) [ ar!(perm.!i) | i <- [1..n] ] 
++permuteArrayRight :: IArray arr b => Permutation -> arr Int b -> arr Int b
++permuteArrayRight pi@(Permutation perm) ar =
 +  if (a==1) && (b==n)
-+    then listArray (1,n) [ ar!(perm!i) | i <- [1..n] ]
-     else error "permuteRight: array bounds do not match"
++    then listArray (1,n) [ ar!(perm.!i) | i <- [1..n] ]
+     else error "permuteArrayRight: array bounds do not match"
    where
--    (_,n) = bounds perm  
+     n     = _bound perm
 -    (a,b) = bounds ar   
-+    (_,n) = bounds perm
 +    (a,b) = bounds ar
  
  -- | The right (standard) action on a list. The list should be of length @n@.
  --
- -- > fromPermutation perm == permuteRightList perm [1..n]
+ -- > fromPermutation perm == permuteListRight perm [1..n]
 --- 
--permuteRightList :: forall a . Permutation -> [a] -> [a]    
+-permuteListRight :: forall a . Permutation -> [a] -> [a]    
 +--
-+permuteRightList :: forall a . Permutation -> [a] -> [a]
- permuteRightList perm xs = elems $ permuteRight perm $ arr where
++permuteListRight :: forall a . Permutation -> [a] -> [a]
+ permuteListRight perm xs = elems $ permuteArrayRight perm $ arr where
    arr = listArray (1,n) xs :: Array Int a
    n   = permutationSize perm
-@@ -734,22 +734,22 @@ permuteRightList perm xs = elems $ permuteRight perm $ arr where
- --
- {-# SPECIALIZE permuteLeft :: Permutation -> Array  Int b   -> Array  Int b   #-}
- {-# SPECIALIZE permuteLeft :: Permutation -> UArray Int Int -> UArray Int Int #-}
--permuteLeft :: IArray arr b => Permutation -> arr Int b -> arr Int b    
--permuteLeft pi@(Permutation perm) ar =    
-+permuteLeft :: IArray arr b => Permutation -> arr Int b -> arr Int b
-+permuteLeft pi@(Permutation perm) ar =
+@@ -800,22 +800,22 @@ permuteListRight perm xs = elems $ permuteArrayRight perm $ arr where
+ --
+ {-# SPECIALIZE permuteArrayLeft :: Permutation -> Array  Int b   -> Array  Int b   #-}
+ {-# SPECIALIZE permuteArrayLeft :: Permutation -> UArray Int Int -> UArray Int Int #-}
+-permuteArrayLeft :: IArray arr b => Permutation -> arr Int b -> arr Int b    
+-permuteArrayLeft pi@(Permutation perm) ar =    
++permuteArrayLeft :: IArray arr b => Permutation -> arr Int b -> arr Int b
++permuteArrayLeft pi@(Permutation perm) ar =
    -- permuteRight (inverse pi) ar
 -  if (a==1) && (b==n) 
--    then array (1,n) [ ( perm!i , ar!i ) | i <- [1..n] ] 
+-    then array (1,n) [ ( perm.!i , ar!i ) | i <- [1..n] ] 
 +  if (a==1) && (b==n)
-+    then array (1,n) [ ( perm!i , ar!i ) | i <- [1..n] ]
-     else error "permuteLeft: array bounds do not match"
++    then array (1,n) [ ( perm.!i , ar!i ) | i <- [1..n] ]
+     else error "permuteArrayLeft: array bounds do not match"
    where
--    (_,n) = bounds perm  
+     n     = _bound perm
 -    (a,b) = bounds ar   
-+    (_,n) = bounds perm
 +    (a,b) = bounds ar
  
  -- | The left (opposite) action on a list. The list should be of length @n@.
  --
- -- > permuteLeftList perm set == permuteList (inverse perm) set
- -- > fromPermutation (inverse perm) == permuteLeftList perm [1..n]
+ -- > permuteListLeft perm set == permuteList (inversePermutation perm) set
+ -- > fromPermutation (inversePermutation perm) == permuteListLeft perm [1..n]
  --
--permuteLeftList :: forall a. Permutation -> [a] -> [a]    
-+permuteLeftList :: forall a. Permutation -> [a] -> [a]
- permuteLeftList perm xs = elems $ permuteLeft perm $ arr where
+-permuteListLeft :: forall a. Permutation -> [a] -> [a]    
++permuteListLeft :: forall a. Permutation -> [a] -> [a]
+ permuteListLeft perm xs = elems $ permuteArrayLeft perm $ arr where
    arr = listArray (1,n) xs :: Array Int a
    n   = permutationSize perm
-@@ -792,9 +792,9 @@ _permutations = _permutationsNaive
+@@ -858,9 +858,9 @@ _permutations = _permutationsNaive
  
  -- | All permutations of @[1..n]@ in lexicographic order, naive algorithm.
  permutationsNaive :: Int -> [Permutation]
@@ -3190,7 +3450,7 @@ index 0d615b8..2f37437 100644
  _permutationsNaive 0 = [[]]
  _permutationsNaive 1 = [[1]]
  _permutationsNaive n = helper [1..n] where
-@@ -802,7 +802,7 @@ _permutationsNaive n = helper [1..n] where
+@@ -868,7 +868,7 @@ _permutationsNaive n = helper [1..n] where
    helper xs = [ i : ys | i <- xs , ys <- helper (xs `minus` i) ]
    minus [] _ = []
    minus (x:xs) i = if x < i then x : minus xs i else xs
@@ -3199,7 +3459,7 @@ index 0d615b8..2f37437 100644
  -- | # = n!
  countPermutations :: Int -> Integer
  countPermutations = factorial
-@@ -816,7 +816,7 @@ randomPermutation = randomPermutationDurstenfeld
+@@ -882,7 +882,7 @@ randomPermutation = randomPermutationDurstenfeld
  
  _randomPermutation :: RandomGen g => Int -> g -> ([Int],g)
  _randomPermutation n rndgen = (fromPermutation perm, rndgen') where
@@ -3208,7 +3468,7 @@ index 0d615b8..2f37437 100644
  
  -- | A synonym for 'randomCyclicPermutationSattolo'.
  randomCyclicPermutation :: RandomGen g => Int -> g -> (Permutation,g)
-@@ -824,7 +824,7 @@ randomCyclicPermutation = randomCyclicPermutationSattolo
+@@ -890,7 +890,7 @@ randomCyclicPermutation = randomCyclicPermutationSattolo
  
  _randomCyclicPermutation :: RandomGen g => Int -> g -> ([Int],g)
  _randomCyclicPermutation n rndgen = (fromPermutation perm, rndgen') where
@@ -3217,7 +3477,7 @@ index 0d615b8..2f37437 100644
  
  -- | Generates a uniformly random permutation of @[1..n]@.
  -- Durstenfeld's algorithm (see <http://en.wikipedia.org/wiki/Knuth_shuffle>).
-@@ -839,65 +839,65 @@ randomCyclicPermutationSattolo = randomPermutationDurstenfeldSattolo True
+@@ -905,65 +905,65 @@ randomCyclicPermutationSattolo = randomPermutationDurstenfeldSattolo True
  randomPermutationDurstenfeldSattolo :: RandomGen g => Bool -> Int -> g -> (Permutation,g)
  randomPermutationDurstenfeldSattolo isSattolo n rnd = res where
    res = runST $ do
@@ -3227,7 +3487,7 @@ index 0d615b8..2f37437 100644
 -    rnd' <- worker n (if isSattolo then n-1 else n) rnd ar 
 +    rnd' <- worker n (if isSattolo then n-1 else n) rnd ar
      perm <- Data.Array.Unsafe.unsafeFreeze ar
-     return (Permutation perm, rnd')
+     return (Permutation (fromUArray perm), rnd')
 -  worker :: RandomGen g => Int -> Int -> g -> STUArray s Int Int -> ST s g 
 -  worker n m rnd ar = 
 -    if n==1 
@@ -3308,6 +3568,153 @@ index 0d615b8..2f37437 100644
  --------------------------------------------------------------------------------
  
  
+diff --git a/Math/Combinat/RootSystems.hs b/Math/Combinat/RootSystems.hs
+index c894010..f86b4e2 100644
+--- a/Math/Combinat/RootSystems.hs
++++ b/Math/Combinat/RootSystems.hs
+@@ -15,7 +15,7 @@ import Data.Array
+ import Data.Set (Set)
+ import qualified Data.Set as Set
+ 
+-import Data.List
++import Data.List (foldl')
+ import Data.Ord
+ 
+ import Math.Combinat.Numbers.Primes
+@@ -27,8 +27,8 @@ import Math.Combinat.Sets
+ -- | The type of half-integers (internally represented by their double)
+ --
+ -- TODO: refactor this into its own module
+-newtype HalfInt 
+-  = HalfInt Int  
++newtype HalfInt
++  = HalfInt Int
+   deriving (Eq,Ord)
+ 
+ half :: HalfInt
+@@ -74,7 +74,7 @@ instance Num HalfVec where
+   abs    = map abs
+   signum = map signum
+ 
+-scaleVec :: Int -> HalfVec -> HalfVec  
++scaleVec :: Int -> HalfVec -> HalfVec
+ scaleVec k = map (scaleBy k)
+ 
+ negateVec :: HalfVec -> HalfVec
+@@ -119,7 +119,7 @@ ambientDim d = case d of
+   G2  -> 3     -- it's a 2 dimensional subspace of 3 dimensions
+ 
+ simpleRootsOf :: Dynkin -> [HalfVec]
+-simpleRootsOf d = 
++simpleRootsOf d =
+ 
+   case d of
+ 
+@@ -133,7 +133,7 @@ simpleRootsOf d =
+ 
+     E6  -> simpleRootsE6_123
+     E7  -> simpleRootsE7_12
+-    E8  -> simpleRootsE8_even 
++    E8  -> simpleRootsE8_even
+ 
+     F4  -> [ [ 1,-1, 0, 0]
+            , [ 0, 1,-1, 0]
+@@ -176,7 +176,7 @@ findPositiveHyperplane vs = w where
+   w  = zipWith (+) w0 perturb
+   perturb = map small $ map fromIntegral $ take n primes
+   small :: Double -> Double
+-  small x = x / (10**10) 
++  small x = x / (10**10)
+ 
+ positiveRoots :: [HalfVec] -> Set HalfVec
+ positiveRoots simples = Set.fromList pos where
+@@ -195,9 +195,9 @@ basisOfPositives set = Set.toList (Set.difference set set2) where
+ --------------------------------------------------------------------------------
+ -- * Operations on half-integer vectors
+ 
+--- | bracket b a = (a,b)/(a,a) 
++-- | bracket b a = (a,b)/(a,a)
+ bracket :: HalfVec -> HalfVec -> HalfInt
+-bracket b a = 
++bracket b a =
+   case divMod (2*a_dot_b) (a_dot_a) of
+     (n,0) -> divByTwo n
+     _     -> error "bracket: result is not a half-integer"
+@@ -227,14 +227,14 @@ printMatrix arr = do
+     extendTo n s = replicate (n-length s) ' ' ++ s
+ 
+ --------------------------------------------------------------------------------
+--- * Mirroring 
++-- * Mirroring
+ 
+ -- | We mirror stuff until there is no more things happening
+ -- (very naive algorithm, but seems to work)
+ mirrorClosure :: [HalfVec] -> Set HalfVec
+-mirrorClosure = go . Set.fromList where 
+-  
+-  go set 
++mirrorClosure = go . Set.fromList where
++
++  go set
+     | n'  > n   = go set'
+     | n'' > n   = go set''
+     | otherwise = set
+@@ -243,17 +243,17 @@ mirrorClosure = go . Set.fromList where
+       n'  = Set.size set'
+       n'' = Set.size set''
+       set'  = mirrorStep set
+-      set'' = Set.union set (Set.map negateVec set) 
++      set'' = Set.union set (Set.map negateVec set)
+ 
+ mirrorStep :: Set HalfVec -> Set HalfVec
+ mirrorStep old = Set.union old new where
+-  new = Set.fromList [ mirror b a | [a,b] <- choose 2 $ Set.toList old ] 
++  new = Set.fromList [ mirror b a | [a,b] <- choose 2 $ Set.toList old ]
+ 
+ --------------------------------------------------------------------------------
+ -- * E6, E7 and E8
+ 
+ -- | This is a basis of E6 as the subset of the even E8 root system
+--- where the first three coordinates agree (they are consolidated 
++-- where the first three coordinates agree (they are consolidated
+ -- into the first coordinate here)
+ simpleRootsE6_123:: [HalfVec]
+ simpleRootsE6_123 = roots where
+@@ -268,7 +268,7 @@ simpleRootsE6_123 = roots where
+     ]
+ 
+ -- | This is a basis of E8 as the subset of the even E8 root system
+--- where the first two coordinates agree (they are consolidated 
++-- where the first two coordinates agree (they are consolidated
+ -- into the first coordinate here)
+ simpleRootsE7_12:: [HalfVec]
+ simpleRootsE7_12 = roots where
+@@ -292,7 +292,7 @@ simpleRootsE7_diag = roots where
+   n = 8
+ 
+   e :: Int -> HalfVec
+-  e i = replicate (i-1) 0 ++ [1] ++ replicate (n-i) 0 
++  e i = replicate (i-1) 0 ++ [1] ++ replicate (n-i) 0
+ 
+ simpleRootsE8_even :: [HalfVec]
+ simpleRootsE8_even = roots where
+@@ -300,7 +300,7 @@ simpleRootsE8_even = roots where
+ 
+   [v1,v2,v3,v4,v5,v6,v7,v8] = roots0
+   roots0 = [ e i - e (i+1) | i <-[1..6] ] ++ [ e 6 + e 7 , replicate 8 (-h)  ]
+-    
++
+   h = half
+   n = 8
+ 
+@@ -314,6 +314,6 @@ simpleRootsE8_odd = roots where
+   n = 8
+ 
+   e :: Int -> HalfVec
+-  e i = replicate (i-1) 0 ++ [1] ++ replicate (n-i) 0 
++  e i = replicate (i-1) 0 ++ [1] ++ replicate (n-i) 0
+ 
+ --------------------------------------------------------------------------------
 diff --git a/Math/Combinat/Sets/VennDiagrams.hs b/Math/Combinat/Sets/VennDiagrams.hs
 index ca53acf..af56d9e 100644
 --- a/Math/Combinat/Sets/VennDiagrams.hs
@@ -4017,7 +4424,7 @@ index efc51f8..7f91afc 100644
  
  --------------------------------------------------------------------------------
 diff --git a/Math/Combinat/Tableaux/LittlewoodRichardson.hs b/Math/Combinat/Tableaux/LittlewoodRichardson.hs
-index a6a58e3..d5489ce 100644
+index 0583bb0..842d2e3 100644
 --- a/Math/Combinat/Tableaux/LittlewoodRichardson.hs
 +++ b/Math/Combinat/Tableaux/LittlewoodRichardson.hs
 @@ -1,17 +1,17 @@
@@ -4170,12 +4577,12 @@ index a6a58e3..d5489ce 100644
  lrScalar lambdaMu alphaBeta = _lrScalar (fromSkewPartition lambdaMu) (fromSkewPartition alphaBeta)
  
  _lrScalar :: (Partition,Partition) -> (Partition,Partition) -> Int
--_lrScalar (plam  @(Partition lam  ) , pmu  @(Partition mu0)  ) 
--         (palpha@(Partition alpha) , pbeta@(Partition beta)) = 
+-_lrScalar ( plam@(  Partition lam  ) , pmu@(  Partition mu0 ) ) 
+-          ( palpha@(Partition alpha) , pbeta@(Partition beta) ) = 
 -  if    not (pmu   `isSubPartitionOf` plam  ) 
 -     || not (pbeta `isSubPartitionOf` palpha) 
-+_lrScalar (plam@(Partition lam  ) , pmu@(Partition mu0)  )
-+         (palpha@(Partition alpha) , pbeta@(Partition beta)) =
++_lrScalar ( plam@(  Partition lam  ) , pmu@(  Partition mu0 ) )
++          ( palpha@(Partition alpha) , pbeta@(Partition beta) ) =
 +  if    not (pmu   `isSubPartitionOf` plam  )
 +     || not (pbeta `isSubPartitionOf` palpha)
       || (sum' lam + sum' beta) /= (sum' alpha + sum' mu0)     -- equivalent to (lambda-mu) /= (alpha-beta)
diff --git a/patches/foundation-0.0.25.patch b/patches/foundation-0.0.25.patch
deleted file mode 100644
index 9325ccb994fb7666adbf9213b63cfb28485aef23..0000000000000000000000000000000000000000
--- a/patches/foundation-0.0.25.patch
+++ /dev/null
@@ -1,13 +0,0 @@
-diff --git a/Foundation/Conduit/Internal.hs b/Foundation/Conduit/Internal.hs
-index 9c22ee1..04a46e3 100644
---- a/Foundation/Conduit/Internal.hs
-+++ b/Foundation/Conduit/Internal.hs
-@@ -126,7 +126,7 @@ instance MonadThrow m => MonadThrow (Conduit i o m) where
- instance MonadCatch m => MonadCatch (Conduit i o m) where
-     catch (Conduit c0) onExc = Conduit $ \rest -> let
-         go (PipeM m) =
--            PipeM $ catch (liftM go m) (return . flip unConduit rest . onExc)
-+            PipeM $ catch (liftM go m) (return . (\x -> unConduit x rest) . onExc)
-         go (Done r) = rest r
-         go (Await p c) = Await (go . p) (go . c)
-         go (Yield p m o) = Yield (go p) m o
diff --git a/patches/http2-2.0.6.patch b/patches/http2-3.0.1.patch
similarity index 84%
rename from patches/http2-2.0.6.patch
rename to patches/http2-3.0.1.patch
index b75fb0b6c63fe01115af3feabb050575926e6e31..291d5c587c536ed65dc3a89c317e726d064ea7e6 100644
--- a/patches/http2-2.0.6.patch
+++ b/patches/http2-3.0.1.patch
@@ -1,8 +1,8 @@
 diff --git a/Imports.hs b/Imports.hs
-index 45bb5fb..f7d6c9e 100644
+index 407a131..307d9a2 100644
 --- a/Imports.hs
 +++ b/Imports.hs
-@@ -19,7 +19,7 @@ import Data.Bits hiding (Bits)
+@@ -22,7 +22,7 @@ import Data.Bits hiding (Bits)
  import Data.ByteString.Internal (ByteString(..))
  import Data.Foldable
  import Data.Int
diff --git a/patches/inspection-testing-0.4.3.0.patch b/patches/inspection-testing-0.4.5.0.patch
similarity index 69%
rename from patches/inspection-testing-0.4.3.0.patch
rename to patches/inspection-testing-0.4.5.0.patch
index e89b5ec97cd2e934a41d848d3e196852e119eff7..00c4b38c9021e21656fdf75041ad828624e00cec 100644
--- a/patches/inspection-testing-0.4.3.0.patch
+++ b/patches/inspection-testing-0.4.5.0.patch
@@ -1,5 +1,5 @@
 diff --git a/src/Test/Inspection/Core.hs b/src/Test/Inspection/Core.hs
-index 7816010..45ec4b6 100644
+index e745975..244362d 100644
 --- a/src/Test/Inspection/Core.hs
 +++ b/src/Test/Inspection/Core.hs
 @@ -44,6 +44,10 @@ import DataCon
@@ -27,7 +27,30 @@ index 7816010..45ec4b6 100644
  
  -- | Pretty-print a slice
  pprSlice :: Slice -> SDoc
-@@ -211,14 +220,22 @@ eqSlice it slice1 slice2
+@@ -155,7 +164,9 @@ eqSlice it slice1 slice2
+     essentiallyVar (App e a)  | it, isTyCoArg a = essentiallyVar e
+     essentiallyVar (Lam v e)  | it, isTyCoVar v = essentiallyVar e
+     essentiallyVar (Cast e _) | it              = essentiallyVar e
+-#if MIN_VERSION_ghc(9,0,0)
++#if MIN_VERSION_ghc(9,2,0)
++    essentiallyVar (Case s _ _ [Alt _ _ e]) | it, isUnsafeEqualityProof s = essentiallyVar e
++#elif MIN_VERSION_ghc(9,0,0)
+     essentiallyVar (Case s _ _ [(_, _, e)]) | it, isUnsafeEqualityProof s = essentiallyVar e
+ #endif
+     essentiallyVar (Var v)                      = Just v
+@@ -171,7 +182,10 @@ eqSlice it slice1 slice2
+ 
+     go env (Cast e1 _) e2 | it             = go env e1 e2
+     go env e1 (Cast e2 _) | it             = go env e1 e2
+-#if MIN_VERSION_ghc(9,0,0)
++#if MIN_VERSION_ghc(9,2,0)
++    go env (Case s _ _ [Alt _ _ e1]) e2 | it, isUnsafeEqualityProof s = go env e1 e2
++    go env e1 (Case s _ _ [Alt _ _ e2]) | it, isUnsafeEqualityProof s = go env e1 e2
++#elif MIN_VERSION_ghc(9,0,0)
+     go env (Case s _ _ [(_, _, e1)]) e2 | it, isUnsafeEqualityProof s = go env e1 e2
+     go env e1 (Case s _ _ [(_, _, e2)]) | it, isUnsafeEqualityProof s = go env e1 e2
+ #endif
+@@ -218,14 +232,22 @@ eqSlice it slice1 slice2
      go _ _ _ = guard False
  
      -----------
@@ -52,7 +75,7 @@ index 7816010..45ec4b6 100644
  
  
  -- | Returns @True@ if the given core expression mentions no type constructor
-@@ -250,7 +267,12 @@ allTyCons ignore slice =
+@@ -257,7 +279,12 @@ allTyCons ignore slice =
  
      goB (b, e) = goV b ++ go e
  
@@ -66,7 +89,7 @@ index 7816010..45ec4b6 100644
  
      goT (TyVarTy _)      = []
      goT (AppTy t1 t2)    = goT t1 ++ goT t2
-@@ -296,7 +318,12 @@ freeOfTerm slice needles = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]
+@@ -303,7 +330,12 @@ freeOfTerm slice needles = listToMaybe [ (v,e) | (v,e) <- slice, not (go e) ]
  
      goB (_, e) = go e
  
@@ -80,7 +103,7 @@ index 7816010..45ec4b6 100644
  
      goAltCon (DataAlt dc) | isNeedle (dataConName dc) = False
      goAltCon _ = True
-@@ -343,7 +370,12 @@ doesNotAllocate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go (idArity v
+@@ -350,7 +382,12 @@ doesNotAllocate slice = listToMaybe [ (v,e) | (v,e) <- slice, not (go (idArity v
          -- A let binding allocates if any variable is not a join point and not
          -- unlifted
  
@@ -95,10 +118,10 @@ index 7816010..45ec4b6 100644
  doesNotContainTypeClasses :: Slice -> [Name] -> Maybe (Var, CoreExpr, [TyCon])
  doesNotContainTypeClasses slice tcNs
 diff --git a/src/Test/Inspection/Plugin.hs b/src/Test/Inspection/Plugin.hs
-index e84a26c..bd953af 100644
+index ee16f46..60e7158 100644
 --- a/src/Test/Inspection/Plugin.hs
 +++ b/src/Test/Inspection/Plugin.hs
-@@ -12,7 +12,7 @@ import System.Exit
+@@ -17,7 +17,7 @@ import System.Exit
  import Data.Either
  import Data.Maybe
  import Data.Bifunctor
@@ -107,7 +130,7 @@ index e84a26c..bd953af 100644
  import qualified Data.Map.Strict as M
  import qualified Language.Haskell.TH.Syntax as TH
  
-@@ -24,6 +24,14 @@ import GhcPlugins hiding (SrcLoc)
+@@ -29,6 +29,14 @@ import GhcPlugins hiding (SrcLoc)
  import Outputable
  #endif
  
@@ -122,7 +145,7 @@ index e84a26c..bd953af 100644
  import Test.Inspection (Obligation(..), Property(..), Result(..))
  import Test.Inspection.Core
  
-@@ -313,9 +321,13 @@ proofPass upon_failure report guts = do
+@@ -319,9 +327,13 @@ proofPass upon_failure report guts = do
          (True, SkipO0) -> pure guts
          (_   , _     ) -> do
              when noopt $ do
diff --git a/patches/proto3-wire-1.2.0.patch b/patches/proto3-wire-1.2.1.patch
similarity index 85%
rename from patches/proto3-wire-1.2.0.patch
rename to patches/proto3-wire-1.2.1.patch
index 7fc7fe9d86bfb12e8ecc52e09a37067114a739ce..e2b7c6a733bed0473f88ba33102783c566819ab4 100644
--- a/patches/proto3-wire-1.2.0.patch
+++ b/patches/proto3-wire-1.2.1.patch
@@ -1,16 +1,3 @@
-diff --git a/src/Proto3/Wire/Decode.hs b/src/Proto3/Wire/Decode.hs
-index dd47743..2f7cbed 100644
---- a/src/Proto3/Wire/Decode.hs
-+++ b/src/Proto3/Wire/Decode.hs
-@@ -199,7 +199,7 @@ gwireType 2 = return LengthDelimited
- gwireType wt = Left $ "wireType got unknown wire type: " ++ show wt
- 
- safeSplit :: Int -> B.ByteString -> Either String (B.ByteString, B.ByteString)
--safeSplit !i! b | B.length b < i = Left "failed to parse varint128: not enough bytes"
-+safeSplit !i !b | B.length b < i = Left "failed to parse varint128: not enough bytes"
-                 | otherwise = Right $ B.splitAt i b
- 
- takeWT :: WireType -> B.ByteString -> Either String (ParsedField, B.ByteString)
 diff --git a/src/Proto3/Wire/Reverse/Prim.hs b/src/Proto3/Wire/Reverse/Prim.hs
 index 3113baa..31deb68 100644
 --- a/src/Proto3/Wire/Reverse/Prim.hs
diff --git a/patches/warp-3.3.14.patch b/patches/warp-3.3.15.patch
similarity index 98%
rename from patches/warp-3.3.14.patch
rename to patches/warp-3.3.15.patch
index b993ee02faed202f5a09f31fa7db65d8cc004a9e..796bd7cbc803ea08d7470022a1e4b5e5c9ca1b21 100644
--- a/patches/warp-3.3.14.patch
+++ b/patches/warp-3.3.15.patch
@@ -52,7 +52,7 @@ index 25cf498..2783c2e 100644
      !(Table addr) = table
      table :: Table
 diff --git a/warp.cabal b/warp.cabal
-index 43ab944..98cf4b9 100644
+index d08caba..366c806 100644
 --- a/warp.cabal
 +++ b/warp.cabal
 @@ -74,6 +74,7 @@ Library