[Git][ghc/ghc][wip/three-way-merge-sort] WIP

[Jade (@Jade)]

Jade pushed to branch wip/three-way-merge-sort at Glasgow Haskell Compiler / GHC


Commits:
2459bcd9 by Jade at 2024-04-01T13:07:20+02:00
WIP

- - - - -


1 changed file:

- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs


Changes:

=====================================
libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
=====================================
@@ -1645,15 +1645,8 @@ Further improved using a four-way merge, with an additional performance increase
 https://gitlab.haskell.org/ghc/ghc/issues/24280
 -}
 
-{-# INLINEABLE sort #-}
-sort = actualSort (>)
-
-{-# INLINEABLE sortBy #-}
-sortBy cmp = actualSort (\x y -> cmp x y == GT)
-
-{-# INLINE actualSort #-}
-actualSort :: (a -> a -> Bool) -> [a] -> [a]
-actualSort gt ns
+sort = sortBy compare
+sortBy cmp ns
   | []        <- ns = []
   | [a]       <- ns = [a]
   | [a,b]     <- ns = merge [a] [b]
@@ -1661,6 +1654,8 @@ actualSort gt ns
   | [a,b,c,d] <- ns = merge4 [a] [b] [c] [d]
   | otherwise       = merge_all (sequences ns)
   where
+    x `gt` y = x `cmp` y == GT
+
     sequences (a:b:xs)
       | a `gt` b  = descending b [a]  xs
       | otherwise = ascending  b (a:) xs
@@ -1668,7 +1663,7 @@ actualSort gt ns
 
     descending a as (b:bs)
       | a `gt` b       = descending b (a:as) bs
-    descending a as bs = (a:as) : sequences bs
+    descending a as bs = (a:as): sequences bs
 
     ascending a as (b:bs)
       | not (a `gt` b) = ascending b (\ys -> as (a:ys)) bs
@@ -1676,16 +1671,16 @@ actualSort gt ns
                          in x : sequences bs
 
     merge_all [x] = x
-    merge_all xs  = merge_all (reduce_once xs)
-
-    reduce_once []            = []
-    reduce_once [a]           = [a]
-    reduce_once [a,b]         = [merge a b]
-    reduce_once [a,b,c]       = [merge3 a b c]
-    reduce_once [a,b,c,d,e]   = [merge a b, merge3 c d e]
-    reduce_once [a,b,c,d,e,f] = [merge3 a b c, merge3 d e f]
-    reduce_once (a:b:c:d:xs)  = let !x = merge4 a b c d
-                                in x : reduce_once xs
+    merge_all xs  = merge_all (reduce xs)
+
+    reduce []            = []
+    reduce [a]           = [a]
+    reduce [a,b]         = [merge a b]
+    reduce [a,b,c]       = [merge3 a b c]
+    reduce [a,b,c,d,e]   = [merge a b, merge3 c d e]
+    reduce [a,b,c,d,e,f] = [merge3 a b c, merge3 d e f]
+    reduce (a:b:c:d:xs)  = let !x = merge4 a b c d
+                           in x : reduce xs
 
     merge as@(a:as') bs@(b:bs')
       | a `gt` b  = b : merge as  bs'



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2459bcd9e6ae00359491d9f71a15be45e566c890

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2459bcd9e6ae00359491d9f71a15be45e566c890
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240401/b05c11df/attachment-0001.html>