Some cleanup of deleteAt
authorDavid Feuer <David.Feuer@gmail.com>
Tue, 31 May 2016 03:58:23 +0000 (23:58 -0400)
committerDavid Feuer <David.Feuer@gmail.com>
Tue, 31 May 2016 04:58:06 +0000 (00:58 -0400)
Use arithmetic to avoid inspecting nodes and build some things more
eagerly.

Data/Sequence.hs
benchmarks/Sequence.hs

index ef4e3cc..fbbac6a 100644 (file)
@@ -1765,6 +1765,11 @@ adjustDigit f i (Four a b c d)
 
 -- | /O(log(min(i,n-i)))/. @'insertAt' i x xs@ inserts @x@ into @xs@
 -- at the index @i@, shifting the rest of the sequence over.
+--
+-- @
+-- insertAt 2 x [a,b,c,d] = [a,b,x,c,d]
+-- insertAt 4 x [a,b,c,d] = insertAt 10 x [a,b,c,d] = [a,b,c,d,x]
+-- @
 -- 
 -- prop> insertAt i x xs = take i xs >< singleton x >< drop i xs
 --
@@ -1789,12 +1794,12 @@ insTree f i (Single x) = case f i x of
 insTree f i (Deep s pr m sf)
   | i < spr     = case insLeftDigit f i pr of
      InsLeftDig pr' -> Deep (s + 1) pr' m sf
-     InsDigNode pr' n -> Deep (s + 1) pr' (n `consTree` m) sf
+     InsDigNode pr' n -> m `seq` Deep (s + 1) pr' (n `consTree` m) sf
   | i < spm     = let !m' = insTree (insNode f) (i - spr) m
                   in Deep (s + 1) pr m' sf
   | otherwise   = case insRightDigit f (i - spm) sf of
      InsRightDig sf' -> Deep (s + 1) pr m sf'
-     InsNodeDig n sf' -> Deep (s + 1) pr (m `snocTree` n) sf'
+     InsNodeDig n sf' -> m `seq` Deep (s + 1) pr (m `snocTree` n) sf'
   where
     spr     = size pr
     spm     = spr + size m
@@ -1828,6 +1833,11 @@ insNode f i (Node3 s a b c)
 -- | /O(log(min(i,n-i)))/. Delete the element of a sequence at a given
 -- index. Return the original sequence if the index is out of range.
 --
+-- @
+-- deleteAt 2 [a,b,c,d] = [a,b,d]
+-- deleteAt 4 [a,b,c,d] = deleteAt (-1) [a,b,c,d] = [a,b,c,d]
+-- @
+--
 -- @since 0.5.8
 deleteAt :: Int -> Seq a -> Seq a
 deleteAt i (Seq xs)
@@ -1838,11 +1848,11 @@ delTreeE :: Int -> FingerTree (Elem a) -> FingerTree (Elem a)
 delTreeE !_i EmptyT = EmptyT -- Unreachable
 delTreeE _i Single{} = EmptyT
 delTreeE i (Deep s pr m sf)
-  | i < spr = delLeftDigitE i pr m sf
+  | i < spr = delLeftDigitE i pr m sf
   | i < spm = case delTree delNodeE (i - spr) m of
      FullTree m' -> Deep (s - 1) pr m' sf
-     DefectTree e -> delRebuildMiddle  (s - 1) pr e sf
-  | otherwise = delRightDigitE (i - spm) pr m sf
+     DefectTree e -> delRebuildMiddle (s - 1) pr e sf
+  | otherwise = delRightDigitE (i - spm) pr m sf
   where spr = size pr
         spm = spr + size m
 
@@ -1856,38 +1866,40 @@ delNodeE i (Node2 _ a b) = case i of
   _ -> Defect a
 
 
-delLeftDigitE :: Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a)
-delLeftDigitE !_i One{} m sf = pullL (size m + size sf) m sf
-delLeftDigitE i (Two a b) m sf
-  | i == 0 = deep (One b) m sf
-  | otherwise = deep (One a) m sf
-delLeftDigitE i (Three a b c) m sf
-  | i == 0 = deep (Two b c) m sf
-  | i == 1 = deep (Two a c) m sf
-  | otherwise = deep (Two a b) m sf
-delLeftDigitE i (Four a b c d) m sf
-  | i == 0 = deep (Three b c d) m sf
-  | i == 1 = deep (Three a c d) m sf
-  | i == 2 = deep (Three a b d) m sf
-  | otherwise = deep (Three a b c) m sf
-
-delRightDigitE :: Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a)
-delRightDigitE !_i pr m One{} = pullR (size pr + size m) pr m
-delRightDigitE i pr m (Two a b)
-  | i == 0 = deep pr m (One b)
-  | otherwise = deep pr m (One a)
-delRightDigitE i pr m (Three a b c)
-  | i == 0 = deep pr m (Two b c)
-  | i == 1 = deep pr m (Two a c)
+delLeftDigitE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a)
+delLeftDigitE !_i s One{} m sf = pullL (s - 1) m sf
+delLeftDigitE i (Two a b) m sf
+  | i == 0 = Deep (s - 1) (One b) m sf
+  | otherwise = Deep (s - 1) (One a) m sf
+delLeftDigitE i (Three a b c) m sf
+  | i == 0 = Deep (s - 1) (Two b c) m sf
+  | i == 1 = Deep (s - 1) (Two a c) m sf
+  | otherwise = Deep (s - 1) (Two a b) m sf
+delLeftDigitE i (Four a b c d) m sf
+  | i == 0 = Deep (s - 1) (Three b c d) m sf
+  | i == 1 = Deep (s - 1) (Three a c d) m sf
+  | i == 2 = Deep (s - 1) (Three a b d) m sf
+  | otherwise = Deep (s - 1) (Three a b c) m sf
+
+delRightDigitE :: Int -> Int -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a)
+delRightDigitE !_i pr m One{} = pullR (size pr + size m) pr m
+delRightDigitE i pr m (Two a b)
+  | i == 0 = Deep (s - 1) pr m (One b)
+  | otherwise = Deep (s - 1) pr m (One a)
+delRightDigitE i pr m (Three a b c)
+  | i == 0 = Deep (s - 1) pr m (Two b c)
+  | i == 1 = Deep (s - 1) pr m (Two a c)
   | otherwise = deep pr m (Two a b)
-delRightDigitE i pr m (Four a b c d)
-  | i == 0 = deep pr m (Three b c d)
-  | i == 1 = deep pr m (Three a c d)
-  | i == 2 = deep pr m (Three a b d)
-  | otherwise = deep pr m (Three a b c)
+delRightDigitE i pr m (Four a b c d)
+  | i == 0 = Deep (s - 1) pr m (Three b c d)
+  | i == 1 = Deep (s - 1) pr m (Three a c d)
+  | i == 2 = Deep (s - 1) pr m (Three a b d)
+  | otherwise = Deep (s - 1) pr m (Three a b c)
 
 data DelTree a = FullTree !(FingerTree (Node a)) | DefectTree a
 
+{-# SPECIALIZE delTree :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> FingerTree (Node (Elem a)) -> DelTree (Elem a) #-}
+{-# SPECIALIZE delTree :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> FingerTree (Node (Node a)) -> DelTree (Node a) #-}
 delTree :: Sized a => (Int -> Node a -> Del a) -> Int -> FingerTree (Node a) -> DelTree a
 delTree _f !_i EmptyT = FullTree EmptyT -- Unreachable
 delTree f i (Single a) = case f i a of
@@ -1897,100 +1909,123 @@ delTree f i (Deep s pr m sf)
   | i < spr = case delDigit f i pr of
      FullDig pr' -> FullTree $ Deep (s - 1) pr' m sf
      DefectDig e -> case viewLTree m of
-                      EmptyLTree -> FullTree $ delRebuildRightDigit e sf
-                      ConsLTree n m' -> FullTree $ delRebuildLeftSide e n m' sf
+                      EmptyLTree -> FullTree $ delRebuildRightDigit (s - 1) e sf
+                      ConsLTree n m' -> FullTree $ delRebuildLeftSide (s - 1) e n m' sf
   | i < spm = case delTree (delNode f) (i - spr) m of
      FullTree m' -> FullTree (Deep (s - 1) pr m' sf)
      DefectTree e -> FullTree $ delRebuildMiddle (s - 1) pr e sf
   | otherwise = case delDigit f (i - spm) sf of
      FullDig sf' -> FullTree $ Deep (s - 1) pr m sf'
      DefectDig e -> case viewRTree m of
-                      EmptyRTree -> FullTree $ delRebuildLeftDigit pr e
-                      SnocRTree m' n -> FullTree $ delRebuildRightSide pr m' n e
+                      EmptyRTree -> FullTree $ delRebuildLeftDigit (s - 1) pr e
+                      SnocRTree m' n -> FullTree $ delRebuildRightSide (s - 1) pr m' n e
   where spr = size pr
         spm = spr + size m
 
 data Del a = Full !(Node a) | Defect a
--- TODO: strictify node construction and use arithmetic for sizes
+
+{-# SPECIALIZE delNode :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> Node (Node (Elem a)) -> Del (Node (Elem a)) #-}
+{-# SPECIALIZE delNode :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> Node (Node (Node a)) -> Del (Node (Node a)) #-}
 delNode :: Sized a => (Int -> Node a -> Del a) -> Int -> Node (Node a) -> Del (Node a)
 delNode f i (Node3 s a b c)
   | i < sa = case f i a of
      Full a' -> Full $ Node3 (s - 1) a' b c
-     Defect e -> case b of
-       Node3 _ x y z -> Full $ Node3 (s - 1) (node2 e x) (node2 y z) c
-       Node2 _ x y -> Full $ Node2 (s - 1) (node3 e x y) c
+     Defect e -> let !se = size e in case b of
+       Node3 sxyz x y z -> Full $ Node3 (s - 1) (Node2 (se + sx) e x) (Node2 (sxyz - sx) y z) c
+         where !sx = size x
+       Node2 sxy x y -> Full $ Node2 (s - 1) (Node3 (sxy + se) e x y) c
   | i < sab = case f (i - sa) b of
      Full b' -> Full $ Node3 (s - 1) a b' c
-     Defect e -> case a of
-       Node3 _ x y z -> Full $ Node3 (s - 1) (node2 x y) (node2 z e) c
-       Node2 _ x y -> Full $ Node2 (s - 1) (node3 x y e) c
+     Defect e -> let !se = size e in case a of
+       Node3 sxyz x y z -> Full $ Node3 (s - 1) (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e) c
+         where !sz = size z
+       Node2 sxy x y -> Full $ Node2 (s - 1) (Node3 (sxy + se) x y e) c
   | otherwise = case f (i - sab) c of
      Full c' -> Full $ Node3 (s - 1) a b c'
-     Defect e -> case b of
-       Node3 _ x y z -> Full $ Node3 (s - 1) a (node2 x y) (node2 z e)
-       Node2 _ x y -> Full $ Node2 (s - 1) a (node3 x y e)
+     Defect e -> let !se = size e in case b of
+       Node3 sxyz x y z -> Full $ Node3 (s - 1) a (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e)
+         where !sz = size z
+       Node2 sxy x y -> Full $ Node2 (s - 1) a (Node3 (sxy + se) x y e)
   where sa = size a
         sab = sa + size b
 delNode f i (Node2 s a b)
   | i < sa = case f i a of
      Full a' -> Full $ Node2 (s - 1) a' b
-     Defect e -> case b of
-       Node3 _ x y z -> Full $ Node2 (s - 1) (node2 e x) (node2 y z)
+     Defect e -> let !se = size e in case b of
+       Node3 sxyz x y z -> Full $ Node2 (s - 1) (Node2 (se + sx) e x) (Node2 (sxyz - sx) y z)
+        where !sx = size x
        Node2 _ x y -> Defect $ Node3 (s - 1) e x y
   | otherwise = case f (i - sa) b of
      Full b' -> Full $ Node2 (s - 1) a b'
-     Defect e -> case a of
-       Node3 _ x y z -> Full $ Node2 (s - 1) (node2 x y) (node2 z e)
+     Defect e -> let !se = size e in case a of
+       Node3 sxyz x y z -> Full $ Node2 (s - 1) (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e)
+         where !sz = size z
        Node2 _ x y -> Defect $ Node3 (s - 1) x y e
   where sa = size a
 
-delRebuildRightDigit :: Sized a => a -> Digit (Node a) -> FingerTree (Node a)
-delRebuildRightDigit p (One a) = case a of
-  Node3 _ x y z -> deep (One (node2 p x)) EmptyT (One (node2 y z))
-  Node2 _ x y -> Single (node3 p x y)
-delRebuildRightDigit p (Two a b) = case a of
-  Node3 _ x y z -> deep (Two (node2 p x) (node2 y z)) EmptyT (One b)
-  Node2 _ x y -> deep (One (node3 p x y)) EmptyT (One b)
-delRebuildRightDigit p (Three a b c) = case a of
-  Node3 _ x y z -> deep (Two (node2 p x) (node2 y z)) EmptyT (Two b c)
-  Node2 _ x y -> deep (Two (node3 p x y) b) EmptyT (One c)
-delRebuildRightDigit p (Four a b c d) = case a of
-  Node3 _ x y z -> deep (Three (node2 p x) (node2 y z) b) EmptyT (Two c d)
-  Node2 _ x y -> deep (Two (node3 p x y) b) EmptyT (Two c d)
-
-delRebuildLeftDigit :: Sized a => Digit (Node a) -> a -> FingerTree (Node a)
-delRebuildLeftDigit (One a) p = case a of
-  Node3 _ x y z -> deep (One (node2 x y)) EmptyT (One (node2 z p))
-  Node2 _ x y -> Single (node3 x y p)
-delRebuildLeftDigit (Two a b) p = case b of
-  Node3 _ x y z -> deep (Two a (node2 x y)) EmptyT (One (node2 z p))
-  Node2 _ x y -> deep (One a) EmptyT (One (node3 x y p))
-delRebuildLeftDigit (Three a b c) p = case c of
-  Node3 _ x y z -> deep (Two a b) EmptyT (Two (node2 x y) (node2 z p))
-  Node2 _ x y -> deep (Two a b) EmptyT (One (node3 x y p))
-delRebuildLeftDigit (Four a b c d) p = case d of
-  Node3 _ x y z -> deep (Three a b c) EmptyT (Two (node2 x y) (node2 z p))
-  Node2 _ x y -> deep (Two a b) EmptyT (Two c (node3 x y p))
+{-# SPECIALIZE delRebuildRightDigit :: Int -> Elem a -> Digit (Node (Elem a)) -> FingerTree (Node (Elem a)) #-}
+{-# SPECIALIZE delRebuildRightDigit :: Int -> Node a -> Digit (Node (Node a)) -> FingerTree (Node (Node a)) #-}
+delRebuildRightDigit :: Sized a => Int -> a -> Digit (Node a) -> FingerTree (Node a)
+delRebuildRightDigit s p (One a) = let !sp = size p in case a of
+  Node3 sxyz x y z -> Deep s (One (Node2 (sp + sx) p x)) EmptyT (One (Node2 (sxyz - sx) y z))
+    where !sx = size x
+  Node2 sxy x y -> Single (Node3 (sp + sxy) p x y)
+delRebuildRightDigit s p (Two a b) = let !sp = size p in case a of
+  Node3 sxyz x y z -> Deep s (Two (Node2 (sp + sx) p x) (Node2 (sxyz - sx) y z)) EmptyT (One b)
+    where !sx = size x
+  Node2 sxy x y -> Deep s (One (Node3 (sp + sxy) p x y)) EmptyT (One b)
+delRebuildRightDigit s p (Three a b c) = let !sp = size p in case a of
+  Node3 sxyz x y z -> Deep s (Two (Node2 (sp + sx) p x) (Node2 (sxyz - sx) y z)) EmptyT (Two b c)
+    where !sx = size x
+  Node2 sxy x y -> Deep s (Two (Node3 (sp + sxy) p x y) b) EmptyT (One c)
+delRebuildRightDigit s p (Four a b c d) = let !sp = size p in case a of
+  Node3 sxyz x y z -> Deep s (Three (Node2 (sp + sx) p x) (Node2 (sxyz - sx) y z) b) EmptyT (Two c d)
+    where !sx = size x
+  Node2 sxy x y -> Deep s (Two (Node3 (sp + sxy) p x y) b) EmptyT (Two c d)
+
+{-# SPECIALIZE delRebuildLeftDigit :: Int -> Digit (Node (Elem a)) -> Elem a -> FingerTree (Node (Elem a)) #-}
+{-# SPECIALIZE delRebuildLeftDigit :: Int -> Digit (Node (Node a)) -> Node a -> FingerTree (Node (Node a)) #-}
+delRebuildLeftDigit :: Sized a => Int -> Digit (Node a) -> a -> FingerTree (Node a)
+delRebuildLeftDigit s (One a) p = let !sp = size p in case a of
+  Node3 sxyz x y z -> Deep s (One (Node2 (sxyz - sz) x y)) EmptyT (One (Node2 (sz + sp) z p))
+    where !sz = size z
+  Node2 sxy x y -> Single (Node3 (sxy + sp) x y p)
+delRebuildLeftDigit s (Two a b) p = let !sp = size p in case b of
+  Node3 sxyz x y z -> Deep s (Two a (Node2 (sxyz - sz) x y)) EmptyT (One (Node2 (sz + sp) z p))
+    where !sz = size z
+  Node2 sxy x y -> Deep s (One a) EmptyT (One (Node3 (sxy + sp) x y p))
+delRebuildLeftDigit s (Three a b c) p = let !sp = size p in case c of
+  Node3 sxyz x y z -> Deep s (Two a b) EmptyT (Two (Node2 (sxyz - sz) x y) (Node2 (sz + sp) z p))
+    where !sz = size z
+  Node2 sxy x y -> Deep s (Two a b) EmptyT (One (Node3 (sxy + sp) x y p))
+delRebuildLeftDigit s (Four a b c d) p = let !sp = size p in case d of
+  Node3 sxyz x y z -> Deep s (Three a b c) EmptyT (Two (Node2 (sxyz - sz) x y) (Node2 (sz + sp) z p))
+    where !sz = size z
+  Node2 sxy x y -> Deep s (Two a b) EmptyT (Two c (Node3 (sxy + sp) x y p))
 
 delRebuildLeftSide :: Sized a
-                   => a -> Node (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a)
+                   => Int -> a -> Node (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a)
                    -> FingerTree (Node a)
-delRebuildLeftSide p (Node2 _ a b) m sf = case a of
-  Node2 _ x y -> deep (Two (node3 p x y) b) m sf
-  Node3 _ x y z -> deep (Three (node2 p x) (node2 y z) b) m sf
-delRebuildLeftSide p (Node3 _ a b c) m sf = case a of
-  Node2 _ x y -> deep (Three (node3 p x y) b c) m sf
-  Node3 _ x y z -> deep (Four (node2 p x) (node2 y z) b c) m sf
+delRebuildLeftSide s p (Node2 _ a b) m sf = let !sp = size p in case a of
+  Node2 sxy x y -> Deep s (Two (Node3 (sp + sxy) p x y) b) m sf
+  Node3 sxyz x y z -> Deep s (Three (Node2 (sp + sx) p x) (Node2 (sxyz - sx) y z) b) m sf
+    where !sx = size x
+delRebuildLeftSide s p (Node3 _ a b c) m sf = let !sp = size p in case a of
+  Node2 sxy x y -> Deep s (Three (Node3 (sp + sxy) p x y) b c) m sf
+  Node3 sxyz x y z -> Deep s (Four (Node2 (sp + sx) p x) (Node2 (sxyz - sx) y z) b c) m sf
+    where !sx = size x
 
 delRebuildRightSide :: Sized a
-                    => Digit (Node a) -> FingerTree (Node (Node a)) -> Node (Node a) -> a
+                    => Int -> Digit (Node a) -> FingerTree (Node (Node a)) -> Node (Node a) -> a
                     -> FingerTree (Node a)
-delRebuildRightSide pr m (Node2 _ a b) p = case b of
-  Node2 _ x y -> deep pr m (Two a (node3 x y p))
-  Node3 _ x y z -> deep pr m (Three a (node2 x y) (node2 z p))
-delRebuildRightSide pr m (Node3 _ a b c) p = case c of
-  Node2 _ x y -> deep pr m (Three a b (node3 x y p))
-  Node3 _ x y z -> deep pr m (Four a b (node2 x y) (node2 z p))
+delRebuildRightSide s pr m (Node2 _ a b) p = let !sp = size p in case b of
+  Node2 sxy x y -> Deep s pr m (Two a (Node3 (sxy + sp) x y p))
+  Node3 sxyz x y z -> Deep s pr m (Three a (Node2 (sxyz - sz) x y) (Node2 (sz + sp) z p))
+    where !sz = size z
+delRebuildRightSide s pr m (Node3 _ a b c) p = let !sp = size p in case c of
+  Node2 sxy x y -> Deep s pr m (Three a b (Node3 (sxy + sp) x y p))
+  Node3 sxyz x y z -> Deep s pr m (Four a b (Node2 (sxyz - sz) x y) (Node2 (sz + sp) z p))
+    where !sz = size z
 
 delRebuildMiddle :: Sized a
                  => Int -> Digit a -> a -> Digit a
@@ -2000,8 +2035,10 @@ delRebuildMiddle s (Two a b) e sf = Deep s (Three a b e) EmptyT sf
 delRebuildMiddle s (Three a b c) e sf = Deep s (Four a b c e) EmptyT sf
 delRebuildMiddle s (Four a b c d) e sf = Deep s (Two a b) (Single (node3 c d e)) sf
 
-
 data DelDig a = FullDig !(Digit (Node a)) | DefectDig a
+
+{-# SPECIALIZE delDigit :: (Int -> Node (Elem a) -> Del (Elem a)) -> Int -> Digit (Node (Elem a)) -> DelDig (Elem a) #-}
+{-# SPECIALIZE delDigit :: (Int -> Node (Node a) -> Del (Node a)) -> Int -> Digit (Node (Node a)) -> DelDig (Node a) #-}
 delDigit :: Sized a => (Int -> Node a -> Del a) -> Int -> Digit (Node a) -> DelDig a
 delDigit f !i (One a) = case f i a of
   Full a' -> FullDig $ One a'
@@ -2009,54 +2046,63 @@ delDigit f !i (One a) = case f i a of
 delDigit f i (Two a b)
   | i < sa = case f i a of
      Full a' -> FullDig $ Two a' b
-     Defect e -> case b of
-       Node3 _ x y z -> FullDig $ Two (node2 e x) (node2 y z)
-       Node2 _ x y -> FullDig $ One (node3 e x y)
+     Defect e -> let !se = size e in case b of
+       Node3 sxyz x y z -> FullDig $ Two (Node2 (se + sx) e x) (Node2 (sxyz - sx) y z)
+         where !sx = size x
+       Node2 sxy x y -> FullDig $ One (Node3 (se + sxy) e x y)
   | otherwise = case f (i - sa) b of
      Full b' -> FullDig $ Two a b'
-     Defect e -> case a of
-       Node3 _ x y z -> FullDig $ Two (node2 x y) (node2 z e)
-       Node2 _ x y -> FullDig $ One (node3 x y e)
+     Defect e -> let !se = size e in case a of
+       Node3 sxyz x y z -> FullDig $ Two (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e)
+         where !sz = size z
+       Node2 sxy x y -> FullDig $ One (Node3 (sxy + se) x y e)
   where sa = size a
 delDigit f i (Three a b c)
   | i < sa = case f i a of
      Full a' -> FullDig $ Three a' b c
-     Defect e -> case b of
-       Node3 _ x y z -> FullDig $ Three (node2 e x) (node2 y z) c
-       Node2 _ x y -> FullDig $ Two (node3 e x y) c
+     Defect e -> let !se = size e in case b of
+       Node3 sxyz x y z -> FullDig $ Three (Node2 (se + sx) e x) (Node2 (sxyz - sx) y z) c
+         where !sx = size x
+       Node2 sxy x y -> FullDig $ Two (Node3 (se + sxy) e x y) c
   | i < sab = case f (i - sa) b of
      Full b' -> FullDig $ Three a b' c
-     Defect e -> case a of
-       Node3 _ x y z -> FullDig $ Three (node2 x y) (node2 z e) c
-       Node2 _ x y -> FullDig $ Two (node3 x y e) c
+     Defect e -> let !se = size e in case a of
+       Node3 sxyz x y z -> FullDig $ Three (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e) c
+         where !sz = size z
+       Node2 sxy x y -> FullDig $ Two (Node3 (sxy + se) x y e) c
   | otherwise = case f (i - sab) c of
      Full c' -> FullDig $ Three a b c'
-     Defect e -> case b of
-       Node3 _ x y z -> FullDig $ Three a (node2 x y) (node2 z e)
-       Node2 _ x y -> FullDig $ Two a (node3 x y e)
+     Defect e -> let !se = size e in case b of
+       Node3 sxyz x y z -> FullDig $ Three a (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e)
+         where !sz = size z
+       Node2 sxy x y -> FullDig $ Two a (Node3 (sxy + se) x y e)
   where sa = size a
         sab = sa + size b
 delDigit f i (Four a b c d)
   | i < sa = case f i a of
      Full a' -> FullDig $ Four a' b c d
-     Defect e -> case b of
-       Node3 _ x y z -> FullDig $ Four (node2 e x) (node2 y z) c d
-       Node2 _ x y -> FullDig $ Three (node3 e x y) c d
+     Defect e -> let !se = size e in case b of
+       Node3 sxyz x y z -> FullDig $ Four (Node2 (se + sx) e x) (Node2 (sxyz - sx) y z) c d
+         where !sx = size x
+       Node2 sxy x y -> FullDig $ Three (Node3 (se + sxy) e x y) c d
   | i < sab = case f (i - sa) b of
      Full b' -> FullDig $ Four a b' c d
-     Defect e -> case a of
-       Node3 _ x y z -> FullDig $ Four (node2 x y) (node2 z e) c d
-       Node2 _ x y -> FullDig $ Three (node3 x y e) c d
+     Defect e -> let !se = size e in case a of
+       Node3 sxyz x y z -> FullDig $ Four (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e) c d
+         where !sz = size z
+       Node2 sxy x y -> FullDig $ Three (Node3 (sxy + se) x y e) c d
   | i < sabc = case f (i - sab) c of
      Full c' -> FullDig $ Four a b c' d
-     Defect e -> case b of
-       Node3 _ x y z -> FullDig $ Four a (node2 x y) (node2 z e) d
-       Node2 _ x y -> FullDig $ Three a (node3 x y e) d
+     Defect e -> let !se = size e in case b of
+       Node3 sxyz x y z -> FullDig $ Four a (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e) d
+         where !sz = size z
+       Node2 sxy x y -> FullDig $ Three a (Node3 (sxy + se) x y e) d
   | otherwise = case f (i - sabc) d of
      Full d' -> FullDig $ Four a b c d'
-     Defect e -> case c of
-       Node3 _ x y z -> FullDig $ Four a b (node2 x y) (node2 z e)
-       Node2 _ x y -> FullDig $ Three a b (node3 x y e)
+     Defect e -> let !se = size e in case c of
+       Node3 sxyz x y z -> FullDig $ Four a b (Node2 (sxyz - sz) x y) (Node2 (sz + se) z e)
+         where !sz = size z
+       Node2 sxy x y -> FullDig $ Three a b (Node3 (sxy + se) x y e)
   where sa = size a
         sab = sa + size b
         sabc = sab + size c
index 280a947..a6cb60a 100644 (file)
@@ -111,6 +111,10 @@ deleteAtPoints points xs =
   foldl' (\acc k -> S.deleteAt k acc) xs points
 
 {-
+fakedeleteAtPoints :: [Int] -> S.Seq a -> S.Seq a
+fakedeleteAtPoints points xs =
+  foldl' (\acc k -> fakeDeleteAt k acc) xs points
+
 -- For comparison with deleteAt. deleteAt is several
 -- times faster for long sequences.
 fakeDeleteAt :: Int -> S.Seq a -> S.Seq a