diff --git a/compiler/GHC/Driver/Config/Tidy.hs b/compiler/GHC/Driver/Config/Tidy.hs
index 6d75de5beff91e7e59ea7f518a9f7c1b69c405ed..568df1e2bd3f62992e1e60a5fe17b0baa5eb3cf3 100644
--- a/compiler/GHC/Driver/Config/Tidy.hs
+++ b/compiler/GHC/Driver/Config/Tidy.hs
@@ -36,6 +36,7 @@ initTidyOpts hsc_env = do
, opt_unfolding_opts = unfoldingOpts dflags
, opt_expose_unfoldings = if | gopt Opt_OmitInterfacePragmas dflags -> ExposeNone
| gopt Opt_ExposeAllUnfoldings dflags -> ExposeAll
+ | gopt Opt_ExposeOverloadedUnfoldings dflags -> ExposeOverloaded
| otherwise -> ExposeSome
, opt_expose_rules = not (gopt Opt_OmitInterfacePragmas dflags)
, opt_trim_ids = gopt Opt_OmitInterfacePragmas dflags
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 39c8fb330cff0794bafee430b467afded97be9c8..d2117779e677e062888369b44b909681ee85db18 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -328,6 +328,7 @@ data GeneralFlag
| Opt_IgnoreInterfacePragmas
| Opt_OmitInterfacePragmas
| Opt_ExposeAllUnfoldings
+ | Opt_ExposeOverloadedUnfoldings
| Opt_KeepAutoRules -- ^Keep auto-generated rules even if they seem to have become useless
| Opt_WriteInterface -- forces .hi files to be written even with -fno-code
| Opt_WriteHie -- generate .hie files
@@ -581,6 +582,7 @@ codeGenFlags = EnumSet.fromList
-- Flags that affect generated code
, Opt_ExposeAllUnfoldings
+ , Opt_ExposeOverloadedUnfoldings
, Opt_NoTypeableBinds
, Opt_Haddock
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index b7bec8cff860f68c1ecca8a27a330fba42c2bb76..7b3a1bc0945f6ef00587e4ee75b298822427bf3e 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -2442,6 +2442,7 @@ fFlagsDeps = [
flagSpec "error-spans" Opt_ErrorSpans,
flagSpec "excess-precision" Opt_ExcessPrecision,
flagSpec "expose-all-unfoldings" Opt_ExposeAllUnfoldings,
+ flagSpec "expose-overloaded-unfoldings" Opt_ExposeOverloadedUnfoldings,
flagSpec "keep-auto-rules" Opt_KeepAutoRules,
flagSpec "expose-internal-symbols" Opt_ExposeInternalSymbols,
flagSpec "external-dynamic-refs" Opt_ExternalDynamicRefs,
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 26194d9d1c3994b4ee8e558dd7da592a6c0fbb04..a9d3dee27f6921fd363dd2bfea61c5800304f5c8 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -57,7 +57,7 @@ import GHC.Core.Tidy
import GHC.Core.Seq ( seqBinds )
import GHC.Core.Opt.Arity ( exprArity, typeArity, exprBotStrictness_maybe )
import GHC.Core.InstEnv
-import GHC.Core.Type ( Type, tidyTopType )
+import GHC.Core.Type
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core.Class
@@ -87,6 +87,7 @@ import GHC.Types.Name.Cache
import GHC.Types.Avail
import GHC.Types.Tickish
import GHC.Types.TypeEnv
+import GHC.Tc.Utils.TcType (tcSplitNestedSigmaTys)
import GHC.Unit.Module
import GHC.Unit.Module.ModGuts
@@ -367,7 +368,9 @@ three places this is actioned:
data UnfoldingExposure
= ExposeNone -- ^ Don't expose unfoldings
- | ExposeSome -- ^ Only expose required unfoldings
+ | ExposeSome -- ^ Expose mandatory unfoldings and those meeting inlining thresholds.
+ | ExposeOverloaded -- ^ Expose unfoldings useful for inlinings and those which
+ -- which might be specialised. See Note [Exposing overloaded functions]
| ExposeAll -- ^ Expose all unfoldings
deriving (Show,Eq,Ord)
@@ -793,6 +796,10 @@ addExternal opts id
show_unfold = show_unfolding unfolding
never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
loop_breaker = isStrongLoopBreaker (occInfo idinfo)
+ -- bottoming_fn: don't inline bottoming functions, unless the
+ -- RHS is very small or trivial (UnfWhen), in which case we
+ -- may as well do so. For example, a cast might cancel with
+ -- the call site.
bottoming_fn = isDeadEndSig (dmdSigInfo idinfo)
-- Stuff to do with the Id's unfolding
@@ -800,30 +807,87 @@ addExternal opts id
-- In GHCi the unfolding is used by importers
show_unfolding (CoreUnfolding { uf_src = src, uf_guidance = guidance })
- = opt_expose_unfoldings opts == ExposeAll
+ = stable || profitable || explicitly_requested
+ where
+ -- Always expose things whose
+ -- source is an inline rule
+ stable = isStableSource src
+ -- Good for perf as it might inline
+ profitable
+ | never_active = False
+ | loop_breaker = False
+ | otherwise =
+ case guidance of
+ UnfWhen {} -> True
+ UnfIfGoodArgs {} -> not bottoming_fn
+ UnfNever -> False
+ -- Requested by the user through a flag.
+ explicitly_requested =
+ case opt_expose_unfoldings opts of
-- 'ExposeAll' says to expose all
-- unfoldings willy-nilly
-
- || isStableSource src -- Always expose things whose
- -- source is an inline rule
-
- || not dont_inline
- where
- dont_inline
- | never_active = True -- Will never inline
- | loop_breaker = True -- Ditto
- | otherwise = case guidance of
- UnfWhen {} -> False
- UnfIfGoodArgs {} -> bottoming_fn
- UnfNever {} -> True
- -- bottoming_fn: don't inline bottoming functions, unless the
- -- RHS is very small or trivial (UnfWhen), in which case we
- -- may as well do so For example, a cast might cancel with
- -- the call site.
+ ExposeAll -> True
+ -- Overloaded functions like @foo :: Bar a => ...@
+ -- See Note [Exposing overloaded functions]
+ ExposeOverloaded ->
+ not bottoming_fn && isOverloaded id
+ ExposeSome -> False
+ ExposeNone -> False
show_unfolding (DFunUnfolding {}) = True
show_unfolding _ = False
+isOverloaded :: Id -> Bool
+isOverloaded fn =
+ let fun_type = idType fn
+ -- TODO: The specialiser currently doesn't handle newtypes of the
+ -- form `newtype T x = T (C x => x)` well. So we don't bother
+ -- looking through newtypes for constraints.
+ -- (Newtypes are opaque to tcSplitNestedSigmaTys)
+ -- If the specialiser ever starts looking through newtypes properly
+ -- we might want to use a version of tcSplitNestedSigmaTys that looks
+ -- through newtypes.
+ (_ty_vars, constraints, _ty) = tcSplitNestedSigmaTys fun_type
+ -- NB: This will consider functions with only equality constraints overloaded.
+ -- While these sorts of constraints aren't currently useful for specialization
+ -- it's simpler to just include them.
+ in not . null $ constraints
+
+{- Note [Exposing overloaded functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+See also #13090 and #22942.
+
+The basic idea is that exposing only overloaded function is reasonably cheap
+but allows the specializer to fire more often as unfoldings for overloaded
+functions will generally be available. So we make the unfoldings of overloaded
+functions available when `-fexpose-overloaded-unfoldings is enabled.
+
+We use `tcSplitNestedSigmaTys` to see the constraints deep within in types like:
+ f :: Int -> forall a. Eq a => blah
+
+We could simply use isClassPred to check if any of the constraints responds to
+a class dictionary, but that would miss (perhaps obscure) opportunities
+like the one in the program below:
+
+ type family C a where
+ C Int = Eq Int
+ C Bool = Ord Bool
+
+
+ bar :: C a => a -> a -> Bool
+ bar = undefined
+ {-# SPECIALIZE bar :: Int -> Int -> Bool #-}
+
+GHC will specialize `bar` properly. However `C a =>` isn't recognized as class
+predicate since it's a type family in the definition. To ensure it's exposed
+anyway we allow for some false positives and simply expose all functions which
+have a constraint. This means we might expose more unhelpful unfoldings. But
+it seems like the better choice.
+
+Currently this option is off by default and has to be enabled manually. But
+we might change this in the future.
+-}
+
{-
************************************************************************
* *
diff --git a/docs/users_guide/9.12.1-notes.rst b/docs/users_guide/9.12.1-notes.rst
index fb3ee09d41c1a81a1b9b79778d5c1fbbb72b2f7c..a92c9ba5d3e5f962f722854daaadb84794aed753 100644
--- a/docs/users_guide/9.12.1-notes.rst
+++ b/docs/users_guide/9.12.1-notes.rst
@@ -44,6 +44,7 @@ and the migration guide.
The tradeoff is that calling `whoCreated` on top level value definitions like `foo` will be less informative.
+- A new flag ``-fexpose-overloaded-unfoldings`` has been added providing a lightweight alternative to ``-fexpose-all-unfoldings``.
GHCi
~~~~
diff --git a/docs/users_guide/hints.rst b/docs/users_guide/hints.rst
index a1cc4e9784c0ac9df1b47df7460c73250c5cd6dd..366ac2d2355ca1ad4dbc938e1bfa6b676b8c82f0 100644
--- a/docs/users_guide/hints.rst
+++ b/docs/users_guide/hints.rst
@@ -366,6 +366,8 @@ extreme cases making it impossible to compile certain code.
For this reason GHC offers various ways to tune inlining
behaviour.
+.. _inlining-unfolding-creation:
+
Unfolding creation
~~~~~~~~~~~~~~~~~~
@@ -374,8 +376,9 @@ GHC requires the functions unfolding. The following flags can
be used to control unfolding creation. Making their creation more
or less likely:
-* :ghc-flag:`-fexpose-all-unfoldings`
* :ghc-flag:`-funfolding-creation-threshold=⟨n⟩`
+* :ghc-flag:`-fexpose-overloaded-unfoldings`
+* :ghc-flag:`-fexpose-all-unfoldings`
Inlining decisions
~~~~~~~~~~~~~~~~~~
@@ -414,6 +417,96 @@ There are also flags specific to the inlining of generics:
* :ghc-flag:`-finline-generics`
* :ghc-flag:`-finline-generics-aggressively`
+.. _control-specialization:
+
+Controlling specialization
+--------------------------------------------
+
+.. index::
+ single: specialize-pragma, controlling, specialization
+ single: unfolding, controlling
+
+GHC has the ability to optimize polymorphic code for specific type class instances
+at the use site. We call this specialisation and it's enabled through :ghc-flag:`-fspecialise`
+which is enabled by default at `-O1` or higher.
+
+GHC does this by creating a copy of the overloaded function, optimizing this copy
+for a given type class instance. Calls to the overloaded function using a statically
+known typeclass we created a specialization for will then be replaced by a call
+to the specialized version of the function.
+
+This can often be crucial to avoid overhead at runtime. However since this
+involves potentially making many copies of overloaded functions GHC doesn't
+always apply this optimization by default even in cases where it could do so.
+
+For GHC to be able to specialise, at a miminum the instance it specializes for
+must be known and the overloaded functions unfolding must be available.
+
+Commonly used flag/pragma combinations
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For applications which aren't very compute heavy the defaults are often good enough
+as they try to strike a reasonable balance between compile time and runtime.
+
+For libraries, if exported functions would benefit significantly from specialization,
+it's recommended to enable :ghc-flag:`-fexpose-overloaded-unfoldings` or manually
+attach INLINEABLE pragmas to performance relevant functions.
+This will ensure downstream users can specialize any overloaded functions exposed
+by the library if it's beneficial.
+
+If there are key parts of an application which rely on specialization for performance
+using `SPECIALIZE` pragmas in combination with either :ghc-flag:`-fexpose-overloaded-unfoldings`
+or `INLINEABLE` on key overloaded functions should allow for these functions to
+specialize without affecting overall compile times too much.
+
+For compute heavy code reliant on elimination of as much overhead as possible it's
+recommended to use a combination of :ghc-flag:`-fspecialise-aggressively` and
+:ghc-flag:`-fexpose-overloaded-unfoldings` or :ghc-flag:`-fexpose-all-unfoldings`.
+However this comes at a big cost to compile time.
+
+Unfolding availabiliy
+~~~~~~~~~~~~~~~~~~~~~
+
+Unfolding availabiliy is primarily determined by :ref:`these flags <inlining-unfolding-creation>`.
+
+Of particular interest for specialization are:
+
+* :ghc-flag:`-fexpose-all-unfoldings`
+* :ghc-flag:`-fexpose-overloaded-unfoldings`
+
+The former making *all* unfoldings available, potentially at high compile time cost.
+The later only makes available the functions that are overloaded. It's generally
+better to use :ghc-flag:`-fexpose-overloaded-unfoldings` over :ghc-flag:`-fexpose-all-unfoldings`
+when the goal is to ensure specializations.
+
+When does GHC generate specializations
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Functions get considered for specialization either implicitly when GHC sees a use
+of an overloaded function used with concrete typeclass instances or explicitly
+when a user requests it through pragmas, see :ref:`specialize-pragma` and :ref:`specialize-instance-pragma`.
+
+The specializer then checks a number of conditions *in order* to decide weither or not
+specialization should happen. Below is a best effort of the list of conditions GHC checks
+currently.
+
+* If any of the type class instances have type arguments and :ghc-flag:`-fpolymorphic-specialisation`
+ is not enabled (off by default) the function **won't** be specialised, otherwise
+* if the specialization was requested through a pragma GHC **will** try to create a specialization, otherwise
+* if the function is imported and:
+ + if the unfolding is not available the function **can't** be specialized, otherwise
+ + if :ghc-flag:`-fcross-module-specialise` is not enabled (enabled by `-O`) the function **won't** be specialised, otherwise
+ + if the flag is enabled, and the function has no INLINABLE/INLINE pragma it **won't** be specialised, otherwise
+* if :ghc-flag:`-fspecialise-aggressively` is enabled GHC **will** try to create a specialization, otherwise
+* if the overloaded function is defined in the current module, and all type class instances
+ are statically known it **will** be specialized, otherwise
+* the function **won't** be specialized.
+
+Note that there are some cases in which GHC will try to specialize a function and fail.
+For example if a functions has an OPAQUE pragma or the unfolding is not available.
+
+Once a function is specialized GHC will create a rule, similar to these created by `RULE` pragmas
+which will fire at call sites involving known instances, replacing calls to the overloaded
+function with calls to the specialized function when possible.
.. _hints-os-memory:
diff --git a/docs/users_guide/using-optimisation.rst b/docs/users_guide/using-optimisation.rst
index dd214a6d64e8386975ede3e316bd18383e161b1c..fc777f3381e00045e928ad8b88bf970a18871a48 100644
--- a/docs/users_guide/using-optimisation.rst
+++ b/docs/users_guide/using-optimisation.rst
@@ -519,9 +519,45 @@ as such you shouldn't need to set any of them explicitly. A flag
:default: off
- An experimental flag to expose all unfoldings, even for very large
- or recursive functions. This allows for all functions to be inlined
- while usually GHC would avoid inlining larger functions.
+ A flag to expose all unfoldings, even for very large or recursive functions.
+
+ However GHC will still use the usual heuristics to make inlining
+ and specialization choices. This means further measures are needed to
+ get benefits at use sites. Usually this involves one of:
+
+ * :ghc-flag:`-fspecialise-aggressively` to force as much specialization
+ as possible.
+ * `{-# SPECIALIZE #-}` pragmas to ensure specialization to specific types.
+ * Use of the magic `inline` function to force inlining.
+
+.. ghc-flag:: -fexpose-overloaded-unfoldings
+ :shortdesc: Expose unfoldings carrying constraints, even for very large or recursive functions.
+ :type: dynamic
+ :reverse: -fno-expose-overloaded-unfoldings
+ :category:
+
+ :default: off
+
+ This experimental flag is a slightly less heavy weight alternative
+ to :ghc-flag:`-fexpose-all-unfoldings`.
+
+ Instead of exposing all functions it only aims at exposing constrained functions.
+ This is intended to be used for cases where specialization is considered
+ crucial but :ghc-flag:`-fexpose-all-unfoldings` imposes too much compile
+ time cost.
+
+ Currently this won't expose unfoldings where a type class is hidden under a
+ newtype. That is for cases like: ::
+
+ newtype NT a = NT (Integral a => a)
+
+ foo :: NT a -> T1 -> TR
+
+ GHC won't recognise `foo` as specialisable and won't expose the unfolding
+ even with :ghc-flag:`-fexpose-overloaded-unfoldings` enabled.
+
+ All the other caveats about :ghc-flag:`-fexpose-overloaded-unfoldings`
+ still apply, so please see there for more details.
.. ghc-flag:: -ffloat-in
:shortdesc: Turn on the float-in transformation. Implied by :ghc-flag:`-O`.
@@ -1120,13 +1156,14 @@ as such you shouldn't need to set any of them explicitly. A flag
:default: off
- By default only type class methods and methods marked ``INLINABLE`` or
- ``INLINE`` are specialised. This flag will specialise any overloaded function
- regardless of size if its unfolding is available. This flag is not
- included in any optimisation level as it can massively increase code
- size. It can be used in conjunction with :ghc-flag:`-fexpose-all-unfoldings`
- if you want to ensure all calls are specialised.
+ This flag controls the specialisation of *imported* functions only. By default, an imported function
+ is only specialised if it is marked ``INLINEABLE`` or ``INLINE``.
+ But with :ghc-flag:`-fspecialise-aggressively`, an imported function is specialised
+ if its unfolding is available in the interface file. (Use :ghc-flag:`-fexpose-all-unfoldings`
+ or :ghc-flag:`-fexpose-overloaded-unfoldings` to ensure that the unfolding is put into the interface file.)
+ :ghc-flag:`-fspecialise-aggressively` is not included in any optimisation level
+ as it can massively increase code size.
.. ghc-flag:: -fcross-module-specialise
:shortdesc: Turn on specialisation of overloaded functions imported from
diff --git a/testsuite/tests/simplCore/should_compile/ExposeOverloaded.hs b/testsuite/tests/simplCore/should_compile/ExposeOverloaded.hs
new file mode 100644
index 0000000000000000000000000000000000000000..caff13ad798c51b7be1f5ce33f5e0fbdb43a2b79
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/ExposeOverloaded.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -O -fno-worker-wrapper -funfolding-creation-threshold=50 #-}
+{-# OPTIONS_GHC -dno-typeable-binds -fexpose-overloaded-unfoldings #-}
+
+module ExposeOverloaded where
+
+-- Will get an unfolding because of the Functor
+foo :: Functor f => Maybe (Maybe (Maybe (Maybe (Maybe (Maybe (f a))))))
+ -> (a -> b)
+ -> Maybe (Maybe (Maybe (Maybe (f b))))
+foo (Just (Just (Just (Just (Just (Just x)))))) f = Just $ Just $ Just $ Just $ fmap f x
+foo _ _ = Nothing
+
+type family C a where
+ C Int = Eq Int
+ C Bool = Ord Bool
+
+-- The Enum constraint should cause bars unfolding to be exposed.
+bar :: (C a, Enum a) => a -> a -> Bool
+bar a b = fromEnum (succ a) > fromEnum (pred . pred . pred . pred . pred $ b)
+
+-- But even if there is just *a* constraint that's not obviously a class the
+-- unfolding should be expose.
+fam :: (C a) => a -> Char -> Int -> (Bool, a)
+fam c a b = (fromEnum (succ a) > fromEnum (pred . pred . pred . pred . pred $ b), c)
+
+-- While the constraint itself is useless to the specialiser, this still gets exposed
+-- by -fexpose-overloaded-unfoldings since we check for the presence of a constraint
+-- and not it's usefulness.
+{-# NOINLINE eq_constraint #-}
+eq_constraint :: (a~b) => a -> b -> (a,b)
+eq_constraint a b = (a,b)
+
+newtype F t a = F {unF :: (Functor t => t a) }
+
+-- Will get NO unfolding currently since the class dictionary is hidden under the newtype.
+-- We might fix this eventually. But since the specializer doesn't handle this well
+-- this isn't important yet.
+baz :: Maybe (Maybe (Maybe (Maybe (Maybe (Maybe (F t a))))))
+ -> (a -> b)
+ -> Maybe (Maybe (Maybe (Maybe (F t b))))
+baz (Just (Just (Just (Just (Just (Just (x))))))) f = Just $ Just $ Just $ Just $ F $ fmap f (unF x)
+baz _ _ = Nothing
\ No newline at end of file
diff --git a/testsuite/tests/simplCore/should_compile/ExposeOverloaded.stderr b/testsuite/tests/simplCore/should_compile/ExposeOverloaded.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..9b1da94eccb8b0f5bad5eeac0bf4926eee29a9d6
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/ExposeOverloaded.stderr
@@ -0,0 +1,254 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 186, types: 410, coercions: 10, joins: 0/0}
+
+-- RHS size: {terms: 6, types: 8, coercions: 3, joins: 0/0}
+unF :: forall (t :: * -> *) a. F t a -> Functor t => t a
+[GblId[[RecSel]],
+ Arity=2,
+ Str=<1C(1,L)><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}]
+unF
+ = \ (@(t_aPM :: * -> *))
+ (@a_aPN)
+ (ds_d14Y :: F t_aPM a_aPN)
+ ($dFunctor_aPP :: Functor t_aPM) ->
+ (ds_d14Y
+ `cast` (ExposeOverloaded.N:F[0] <t_aPM>_N <a_aPN>_N
+ :: F t_aPM a_aPN ~R# (Functor t_aPM => t_aPM a_aPN)))
+ $dFunctor_aPP
+
+-- RHS size: {terms: 44, types: 123, coercions: 0, joins: 0/0}
+foo
+ :: forall (f :: * -> *) a b.
+ Functor f =>
+ Maybe (Maybe (Maybe (Maybe (Maybe (Maybe (f a))))))
+ -> (a -> b) -> Maybe (Maybe (Maybe (Maybe (f b))))
+[GblId,
+ Arity=3,
+ Str=<MP(1C(1,C(1,L)),A)><1L><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=NEVER}]
+foo
+ = \ (@(f_a11y :: * -> *))
+ (@a_a11z)
+ (@b_a11A)
+ ($dFunctor_a11B :: Functor f_a11y)
+ (ds_d14D
+ :: Maybe (Maybe (Maybe (Maybe (Maybe (Maybe (f_a11y a_a11z)))))))
+ (f1_aON :: a_a11z -> b_a11A) ->
+ case ds_d14D of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (f_a11y b_a11A))));
+ Just ds1_d14P ->
+ case ds1_d14P of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (f_a11y b_a11A))));
+ Just ds2_d14Q ->
+ case ds2_d14Q of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (f_a11y b_a11A))));
+ Just ds3_d14R ->
+ case ds3_d14R of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (f_a11y b_a11A))));
+ Just ds4_d14S ->
+ case ds4_d14S of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (f_a11y b_a11A))));
+ Just ds5_d14T ->
+ case ds5_d14T of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (f_a11y b_a11A))));
+ Just x_aOM ->
+ GHC.Internal.Maybe.Just
+ @(Maybe (Maybe (Maybe (f_a11y b_a11A))))
+ (GHC.Internal.Maybe.Just
+ @(Maybe (Maybe (f_a11y b_a11A)))
+ (GHC.Internal.Maybe.Just
+ @(Maybe (f_a11y b_a11A))
+ (GHC.Internal.Maybe.Just
+ @(f_a11y b_a11A)
+ (fmap
+ @f_a11y $dFunctor_a11B @a_a11z @b_a11A f1_aON x_aOM))))
+ }
+ }
+ }
+ }
+ }
+ }
+
+-- RHS size: {terms: 31, types: 20, coercions: 0, joins: 0/0}
+bar :: forall a. (C a, Enum a) => a -> a -> Bool
+[GblId,
+ Arity=4,
+ Str=<A><SP(MC(1,L),LC(S,L),A,SC(S,L),A,A,A,A)><L><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=NEVER}]
+bar
+ = \ (@a_a10F)
+ _ [Occ=Dead]
+ ($dEnum_a10H :: Enum a_a10F)
+ (a1_aOV :: a_a10F)
+ (b_aOW :: a_a10F) ->
+ case fromEnum @a_a10F $dEnum_a10H (succ @a_a10F $dEnum_a10H a1_aOV)
+ of
+ { GHC.Types.I# x_a15W ->
+ case fromEnum
+ @a_a10F
+ $dEnum_a10H
+ (pred
+ @a_a10F
+ $dEnum_a10H
+ (pred
+ @a_a10F
+ $dEnum_a10H
+ (pred
+ @a_a10F
+ $dEnum_a10H
+ (pred @a_a10F $dEnum_a10H (pred @a_a10F $dEnum_a10H b_aOW)))))
+ of
+ { GHC.Types.I# y_a15Z ->
+ GHC.Prim.tagToEnum# @Bool (GHC.Prim.># x_a15W y_a15Z)
+ }
+ }
+
+-- RHS size: {terms: 46, types: 21, coercions: 0, joins: 0/0}
+fam :: forall a. C a => a -> Char -> Int -> (Bool, a)
+[GblId,
+ Arity=4,
+ Str=<A><L><ML><MP(1L)>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=NEVER}]
+fam
+ = \ (@a_aZM)
+ _ [Occ=Dead]
+ (c_aP4 :: a_aZM)
+ (a1_aP5 :: Char)
+ (b_aP6 :: Int) ->
+ (case a1_aP5 of { GHC.Types.C# c#_a15M ->
+ case GHC.Prim.ord# c#_a15M of wild1_a15O {
+ __DEFAULT ->
+ case b_aP6 of { GHC.Types.I# x1_a15B ->
+ case x1_a15B of wild3_a15D {
+ __DEFAULT ->
+ GHC.Prim.tagToEnum#
+ @Bool
+ (GHC.Prim.>#
+ (GHC.Prim.+# wild1_a15O 1#) (GHC.Prim.-# wild3_a15D 5#));
+ -9223372036854775808# -> case GHC.Internal.Enum.$fEnumInt1 of {};
+ -9223372036854775807# -> case GHC.Internal.Enum.$fEnumInt1 of {};
+ -9223372036854775806# -> case GHC.Internal.Enum.$fEnumInt1 of {};
+ -9223372036854775805# -> case GHC.Internal.Enum.$fEnumInt1 of {};
+ -9223372036854775804# -> case GHC.Internal.Enum.$fEnumInt1 of {}
+ }
+ };
+ 1114111# -> case GHC.Internal.Enum.$fEnumChar2 of {}
+ }
+ },
+ c_aP4)
+
+-- RHS size: {terms: 8, types: 10, coercions: 0, joins: 0/0}
+eq_constraint [InlPrag=NOINLINE]
+ :: forall a b. (a ~ b) => a -> b -> (a, b)
+[GblId,
+ Arity=3,
+ Str=<A><L><L>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=True)}]
+eq_constraint
+ = \ (@a_aZD)
+ (@b_aZE)
+ _ [Occ=Dead]
+ (a1_aP7 :: a_aZD)
+ (b1_aP8 :: b_aZE) ->
+ (a1_aP7, b1_aP8)
+
+-- RHS size: {terms: 45, types: 146, coercions: 7, joins: 0/0}
+baz
+ :: forall (t :: * -> *) a b.
+ Maybe (Maybe (Maybe (Maybe (Maybe (Maybe (F t a))))))
+ -> (a -> b) -> Maybe (Maybe (Maybe (Maybe (F t b))))
+[GblId, Arity=2, Str=<1L><L>, Unf=OtherCon []]
+baz
+ = \ (@(t_aYx :: * -> *))
+ (@a_aYy)
+ (@b_aYz)
+ (ds_d148
+ :: Maybe (Maybe (Maybe (Maybe (Maybe (Maybe (F t_aYx a_aYy)))))))
+ (f_aPa :: a_aYy -> b_aYz) ->
+ case ds_d148 of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (F t_aYx b_aYz))));
+ Just ds1_d14m ->
+ case ds1_d14m of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (F t_aYx b_aYz))));
+ Just ds2_d14n ->
+ case ds2_d14n of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (F t_aYx b_aYz))));
+ Just ds3_d14o ->
+ case ds3_d14o of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (F t_aYx b_aYz))));
+ Just ds4_d14p ->
+ case ds4_d14p of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (F t_aYx b_aYz))));
+ Just ds5_d14q ->
+ case ds5_d14q of {
+ Nothing ->
+ GHC.Internal.Maybe.Nothing
+ @(Maybe (Maybe (Maybe (F t_aYx b_aYz))));
+ Just x_aP9 ->
+ GHC.Internal.Maybe.Just
+ @(Maybe (Maybe (Maybe (F t_aYx b_aYz))))
+ (GHC.Internal.Maybe.Just
+ @(Maybe (Maybe (F t_aYx b_aYz)))
+ (GHC.Internal.Maybe.Just
+ @(Maybe (F t_aYx b_aYz))
+ (GHC.Internal.Maybe.Just
+ @(F t_aYx b_aYz)
+ ((\ ($dFunctor_aZi :: Functor t_aYx) ->
+ fmap
+ @t_aYx
+ $dFunctor_aZi
+ @a_aYy
+ @b_aYz
+ f_aPa
+ ((x_aP9
+ `cast` (ExposeOverloaded.N:F[0] <t_aYx>_N <a_aYy>_N
+ :: F t_aYx a_aYy
+ ~R# (Functor t_aYx => t_aYx a_aYy)))
+ $dFunctor_aZi))
+ `cast` (Sym (ExposeOverloaded.N:F[0] <t_aYx>_N <b_aYz>_N)
+ :: (Functor t_aYx => t_aYx b_aYz)
+ ~R# F t_aYx b_aYz)))))
+ }
+ }
+ }
+ }
+ }
+ }
+
+
+
diff --git a/testsuite/tests/simplCore/should_compile/T16038/Makefile b/testsuite/tests/simplCore/should_compile/T16038/Makefile
index 73ddc7b0aed16367b4470bb19ca013c0806b7f70..a4dce9895f60eddb93196a00d4dfa6e27dfe74b3 100644
--- a/testsuite/tests/simplCore/should_compile/T16038/Makefile
+++ b/testsuite/tests/simplCore/should_compile/T16038/Makefile
@@ -6,5 +6,5 @@ T16038:
'$(TEST_HC)' $(TEST_HC_OPTS) -O -c A.hs-boot
'$(TEST_HC)' $(TEST_HC_OPTS) -O -c B.hs
# All `fEqHsExpr` bindings should be in one recursive group:
- '$(TEST_HC)' $(TEST_HC_OPTS) -O -c A.hs -ddump-simpl -dsuppress-all | \
+ '$(TEST_HC)' $(TEST_HC_OPTS) -O -c A.hs -ddump-simpl -dsuppress-all -fno-expose-overloaded-unfoldings | \
grep -e "^\$$fEqHsExpr" -e "Rec"
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 8e956b54dba8aec71b8f081e4fa38acfcbad850f..a5704f7ef20e68c5987332920385bd2375fe7099 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -34,6 +34,10 @@ test('T7162', normal, compile, [''])
test('dfun-loop', normal, compile, [''])
test('strict-float', normal, compile, [''])
+
+# Check if overloaded functions get unfoldings
+test('ExposeOverloaded', [only_ways('[optasm]'), grep_errmsg('Unf=Unf')], compile, ['-ddump-simpl -dno-suppress-unfoldings'])
+
test('T3118', normal, compile, ['-Wno-overlapping-patterns'])
test('T4203', normal, compile, [''])
@@ -332,7 +336,7 @@ test('T18231', [ only_ways(['optasm']), grep_errmsg(r'^[\w\.]+ ::.*->.*') ], com
# Cast WW
test('T17673', [ only_ways(['optasm']), grep_errmsg(r'^\w+\.\$wf') ], compile, ['-ddump-simpl -dsuppress-uniques -dppr-cols=9999'])
test('T18078', [ only_ways(['optasm']), grep_errmsg(r'^\w+\.\$wf') ], compile, ['-ddump-simpl -dsuppress-uniques -dppr-cols=9999'])
-test('T18328', [ only_ways(['optasm']), grep_errmsg(r'Arity=') ], compile, ['-ddump-simpl -dsuppress-uniques'])
+test('T18328', [ only_ways(['optasm']), grep_errmsg(r'(Arity=2)',1) ], compile, ['-ddump-simpl -dsuppress-uniques'])
test('T18347', normal, compile, ['-dcore-lint -O'])
test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T18399', normal, compile, ['-dcore-lint -O'])
@@ -363,7 +367,7 @@ test('T19599a', normal, compile, ['-O -ddump-rules'])
# Look for a specialisation rule for wimwam
test('T19672', normal, compile, ['-O2 -ddump-rules'])
-test('T20103', [ grep_errmsg(r'Arity') ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
+test('T20103', [ grep_errmsg(r'(Arity=[0-9]*)',[1]) ], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T19780', normal, compile, ['-O2'])
test('T19794', normal, compile, ['-O'])
test('T19890', [ grep_errmsg(r'= T19890.foo1') ], compile, ['-O -ddump-simpl'])