diff --git a/CHANGES.md b/CHANGES.md index ece3451..3b4148c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,10 @@ Unreleased ===== +* [#265](https://github.com/serokell/universum/issues/265): + Make `SuperComposition` inference less brittle, and give it four + type parameters. + * [#252](https://github.com/serokell/universum/pull/252): Remove `Option` re-export. Use `Maybe` instead. diff --git a/benchmark/Main.hs b/benchmark/Main.hs index b507209..71703a2 100644 --- a/benchmark/Main.hs +++ b/benchmark/Main.hs @@ -112,7 +112,7 @@ bgroupSuperComposition = bgroup "(...)" where super10 :: [()] -> Bool super10 = null - ... ((: []) ... Unsafe.head ... pure ... Unsafe.head + ... ((: []) ... Unsafe.head ... (:[]) ... Unsafe.head ... (: [(), (), (), ()]) ... Unsafe.head ... (: []) ... Unsafe.head ... (: [()]) ... Unsafe.head ... (: [(), ()]) ... Unsafe.head :: [()] -> [()]) diff --git a/src/Universum/VarArg.hs b/src/Universum/VarArg.hs index 18f7cae..1572ea9 100644 --- a/src/Universum/VarArg.hs +++ b/src/Universum/VarArg.hs @@ -19,17 +19,21 @@ module Universum.VarArg -- >>> import Data.List (zip5) -- | This type class allows to implement variadic composition operator. -class SuperComposition a b c | a b -> c where +class SuperComposition x y b r | x y b -> r where -- | Allows to apply function to result of another function with multiple -- arguments. -- - -- >>> (show ... (+)) 1 2 + -- >>> (show ... (+)) (1 :: Int) 2 -- "3" - -- >>> show ... 5 + -- >>> show ... (5 :: Int) -- "5" -- >>> (null ... zip5) [1] [2] [3] [] [5] -- True -- + -- Note that the arity of the second argument must be apparent to the type + -- checker, which is why the above examples require type annotations for numeric + -- literals. + -- -- Inspired by . -- -- ==== Performance @@ -45,16 +49,16 @@ class SuperComposition a b c | a b -> c where -- disappear due to very general inferred type. However, functions without type -- specification but with applied @INLINE@ pragma are fast again. -- - (...) :: a -> b -> c + (...) :: (x -> y) -> b -> r infixl 8 ... -instance {-# INCOHERENT #-} (a ~ c, r ~ b) => - SuperComposition (a -> b) c r where +instance {-# OVERLAPPABLE #-} (x ~ b, y ~ r) => + SuperComposition x y b r where f ... g = f g {-# INLINE (...) #-} -instance {-# INCOHERENT #-} (SuperComposition (a -> b) d r1, r ~ (c -> r1)) => - SuperComposition (a -> b) (c -> d) r where +instance {-# OVERLAPPING #-} (SuperComposition x y d r1, r ~ (c -> r1)) => + SuperComposition x y (c -> d) r where (f ... g) c = f ... g c {-# INLINE (...) #-}