Tigtening up evaluation in swap functions

sergv · Dec 23, 2024 · 35b5b13 · 35b5b13
1 parent 9b53539
commit 35b5b13
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 17 deletions.
diff --git a/src/Data/Patricia/Word/Strict/Internal.hs b/src/Data/Patricia/Word/Strict/Internal.hs
@@ -1477,19 +1477,25 @@ swap !w a = \t ->
     go t =
       case t of
         Bin p l r
-          | beyond p w -> (# Nothing, join w (Tip w a) p t #)
+          | beyond p w -> let !t' = join w (Tip w a) p t
+                          in (# Nothing, t'#)
 
           | w < p      -> let !(# mb, l' #) = go l
-                          in (# mb, Bin p l' r #)
+                              !t' = Bin p l' r
+                          in (# mb, t' #)
 
           | otherwise  -> let !(# mb, r' #) = go r
-                          in (# mb, Bin p l r' #)
+                              !t' = Bin p l r'
+                          in (# mb, t' #)
 
         Tip k b
-          | k == w    -> (# Just b, Tip k a #)
-          | otherwise -> (# Nothing, join w (Tip w a) k t #)
+          | k == w    -> let !t' = Tip k a
+                         in (# Just b, t' #)
+          | otherwise -> let !t' = join w (Tip w a) k t
+                         in (# Nothing, t' #)
 
-        Nil -> (# Nothing, Tip w a #)
+        Nil -> let !t' = Tip w a
+               in (# Nothing, t' #)
 
 
 

diff --git a/src/Data/RadixNTree/Word8/Strict.hs b/src/Data/RadixNTree/Word8/Strict.hs
@@ -4173,10 +4173,12 @@ swap_ a step = go
                           in (# Nothing, t' #)
 
           | w < p      -> let !(# mb, l' #) = go w s l
-                          in (# mb, Bin p l' r #)
+                              !t' = Bin p l' r
+                          in (# mb, t' #)
 
           | otherwise  -> let !(# mb, r' #) = go w s r
-                          in (# mb, Bin p l r' #)
+                              !t' = Bin p l r'
+                          in (# mb, t' #)
 
         Tip arr mx dx -> goarr w s 0
           where
@@ -4185,36 +4187,37 @@ swap_ a step = go
                   if n + 1 >= sizeofByteArray arr
                     then case step z of
                            More u z' -> let !(# mb, dy #) = go u z' dx
-                                        in (# mb, Tip arr mx dy #)
+                                            !t' = Tip arr mx dy
+                                        in (# mb, t' #)
 
-                           Done      -> let !dy = Tip arr (Just a) dx
-                                        in (# mx, dy #)
+                           Done      -> let !t' = Tip arr (Just a) dx
+                                        in (# mx, t' #)
 
                     else case step z of
                            More u z' -> goarr u z' (n + 1)
                            Done      ->
                              let !(# !brr, !crr #) = splitByteArray 0 (n + 1) arr
 
-                                 !dy = Tip brr (Just a) (Tip crr mx dx)
+                                 !t' = Tip brr (Just a) (Tip crr mx dx)
 
-                             in (# Nothing, dy #)
+                             in (# Nothing, t' #)
 
               | n == 0    =
-                  let !dy = join
+                  let !t' = join
                               (indexByteArray arr 0) t
                               w (singleton_ step w s a)
 
-                  in (# Nothing, dy #)
+                  in (# Nothing, t' #)
 
               | otherwise =
                   let !(# !brr, !crr #) = splitByteArray 0 n arr
 
-                      !dy = Tip brr Nothing $
+                      !t' = Tip brr Nothing $
                               join
                                 (indexByteArray crr 0) (Tip crr mx dx)
                                 v (singleton_ step v z a)
 
-                  in (# Nothing, dy #)
+                  in (# Nothing, t' #)
 
         Nil -> let !t' = singleton_ step w s a
                in (# Nothing, t' #)