[Git][ghc/ghc][wip/andreask/expose-overloaded-unfoldings] Tidy: Add flag to expose unfoldings if they take dictionary arguments.
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Fri May 10 09:57:54 UTC 2024
Andreas Klebinger pushed to branch wip/andreask/expose-overloaded-unfoldings at Glasgow Haskell Compiler / GHC
Commits:
cd084b0f by Andreas Klebinger at 2024-05-10T11:42:09+02:00
Tidy: Add flag to expose unfoldings if they take dictionary arguments.
Add the flag `-fexpose-overloaded-unfoldings` to be able to control this
behaviour.
For ghc's boot libraries file size grew by less than 1% when it was
enabled. However I refrained from enabling it by default for now.
I've also added a section on specialization more broadly to the users
guide.
-------------------------
Metric Decrease:
MultiLayerModulesTH_OneShot
Metric Increase:
T12425
T13386
hard_hole_fits
-------------------------
- - - - -
11 changed files:
- compiler/GHC/Driver/Config/Tidy.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Tidy.hs
- docs/users_guide/hints.rst
- docs/users_guide/using-optimisation.rst
- testsuite/tests/dmdanal/should_compile/T23398.stderr
- + testsuite/tests/simplCore/should_compile/ExposeOverloaded.hs
- + testsuite/tests/simplCore/should_compile/ExposeOverloaded.stderr
- testsuite/tests/simplCore/should_compile/T16038/Makefile
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
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
=====================================
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
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2419,6 +2419,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,
=====================================
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,86 @@ 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 -> True
+ -- Overloaded functions like @foo :: Bar a => ...@
+ -- See Note [Exposing overloaded functions]
+ ExposeOverloaded ->
+ not bottoming_fn && isOverloaded id
-- '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.
+ 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.
+-}
+
{-
************************************************************************
* *
=====================================
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,97 @@ 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:
=====================================
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
=====================================
testsuite/tests/dmdanal/should_compile/T23398.stderr
=====================================
@@ -47,7 +47,9 @@ T23398.$wbar [InlPrag=[2], Occ=LoopBreaker]
[GblId[StrictWorker([~, !])],
Arity=4,
Str=<L><SP(A,SC(S,L),A)><1L><L>,
- Unf=OtherCon []]
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [0 30 60 0] 91 70}]
T23398.$wbar
= \ (@a)
(@b)
=====================================
testsuite/tests/simplCore/should_compile/ExposeOverloaded.hs
=====================================
@@ -0,0 +1,31 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -O -fno-worker-wrapper -funfolding-creation-threshold=50 #-}
+
+module ExposeOverloaded where
+
+-- Will get an unfolding because of the Functor
+-- foo :: Functor a => Maybe (Maybe (Maybe (Maybe (Maybe (Maybe a))))) -> (a -> b) -> Maybe (Maybe (Maybe (Maybe (Maybe b))))
+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
+
+bar :: (C a, Enum a) => a -> a -> Bool
+bar a b = fromEnum (succ a) > fromEnum (pred . pred . pred . pred . pred $ 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
=====================================
testsuite/tests/simplCore/should_compile/ExposeOverloaded.stderr
=====================================
@@ -0,0 +1,356 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 212, types: 389, 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_aOm :: * -> *))
+ (@a_aOn)
+ (ds_dVr :: F t_aOm a_aOn)
+ ($dFunctor_aOp :: Functor t_aOm) ->
+ (ds_dVr
+ `cast` (ExposeOverloaded.N:F[0] <t_aOm>_N <a_aOn>_N
+ :: F t_aOm a_aOn ~R# (Functor t_aOm => t_aOm a_aOn)))
+ $dFunctor_aOp
+
+-- 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_aRL :: * -> *))
+ (@a_aRM)
+ (@b_aRN)
+ ($dFunctor_aRO :: Functor f_aRL)
+ (ds_dV6
+ :: Maybe (Maybe (Maybe (Maybe (Maybe (Maybe (f_aRL a_aRM)))))))
+ (f1_aNt :: a_aRM -> b_aRN) ->
+ case ds_dV6 of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (f_aRL b_aRN))));
+ Just ds1_dVi ->
+ case ds1_dVi of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (f_aRL b_aRN))));
+ Just ds2_dVj ->
+ case ds2_dVj of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (f_aRL b_aRN))));
+ Just ds3_dVk ->
+ case ds3_dVk of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (f_aRL b_aRN))));
+ Just ds4_dVl ->
+ case ds4_dVl of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (f_aRL b_aRN))));
+ Just ds5_dVm ->
+ case ds5_dVm of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (f_aRL b_aRN))));
+ Just x_aNs ->
+ GHC.Maybe.Just
+ @(Maybe (Maybe (Maybe (f_aRL b_aRN))))
+ (GHC.Maybe.Just
+ @(Maybe (Maybe (f_aRL b_aRN)))
+ (GHC.Maybe.Just
+ @(Maybe (f_aRL b_aRN))
+ (GHC.Maybe.Just
+ @(f_aRL b_aRN)
+ (fmap @f_aRL $dFunctor_aRO @a_aRM @b_aRN f1_aNt x_aNs))))
+ }
+ }
+ }
+ }
+ }
+ }
+
+-- 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_aQT)
+ _ [Occ=Dead]
+ ($dEnum_aQV :: Enum a_aQT)
+ (a1_aNB :: a_aQT)
+ (b_aNC :: a_aQT) ->
+ case fromEnum @a_aQT $dEnum_aQV (succ @a_aQT $dEnum_aQV a1_aNB) of
+ { GHC.Types.I# x_aWc ->
+ case fromEnum
+ @a_aQT
+ $dEnum_aQV
+ (pred
+ @a_aQT
+ $dEnum_aQV
+ (pred
+ @a_aQT
+ $dEnum_aQV
+ (pred
+ @a_aQT
+ $dEnum_aQV
+ (pred @a_aQT $dEnum_aQV (pred @a_aQT $dEnum_aQV b_aNC)))))
+ of
+ { GHC.Types.I# y_aWf ->
+ GHC.Prim.tagToEnum# @Bool (GHC.Prim.># x_aWc y_aWf)
+ }
+ }
+
+-- 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_aPO :: * -> *))
+ (@a_aPP)
+ (@b_aPQ)
+ (ds_dUH
+ :: Maybe (Maybe (Maybe (Maybe (Maybe (Maybe (F t_aPO a_aPP)))))))
+ (f_aNL :: a_aPP -> b_aPQ) ->
+ case ds_dUH of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (F t_aPO b_aPQ))));
+ Just ds1_dUU ->
+ case ds1_dUU of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (F t_aPO b_aPQ))));
+ Just ds2_dUV ->
+ case ds2_dUV of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (F t_aPO b_aPQ))));
+ Just ds3_dUW ->
+ case ds3_dUW of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (F t_aPO b_aPQ))));
+ Just ds4_dUX ->
+ case ds4_dUX of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (F t_aPO b_aPQ))));
+ Just ds5_dUY ->
+ case ds5_dUY of {
+ Nothing ->
+ GHC.Maybe.Nothing @(Maybe (Maybe (Maybe (F t_aPO b_aPQ))));
+ Just x_aNK ->
+ GHC.Maybe.Just
+ @(Maybe (Maybe (Maybe (F t_aPO b_aPQ))))
+ (GHC.Maybe.Just
+ @(Maybe (Maybe (F t_aPO b_aPQ)))
+ (GHC.Maybe.Just
+ @(Maybe (F t_aPO b_aPQ))
+ (GHC.Maybe.Just
+ @(F t_aPO b_aPQ)
+ ((\ ($dFunctor_aQz :: Functor t_aPO) ->
+ fmap
+ @t_aPO
+ $dFunctor_aQz
+ @a_aPP
+ @b_aPQ
+ f_aNL
+ ((x_aNK
+ `cast` (ExposeOverloaded.N:F[0] <t_aPO>_N <a_aPP>_N
+ :: F t_aPO a_aPP
+ ~R# (Functor t_aPO => t_aPO a_aPP)))
+ $dFunctor_aQz))
+ `cast` (Sym (ExposeOverloaded.N:F[0] <t_aPO>_N <b_aPQ>_N)
+ :: (Functor t_aPO => t_aPO b_aPQ)
+ ~R# F t_aPO b_aPQ)))))
+ }
+ }
+ }
+ }
+ }
+ }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 20 0}]
+ExposeOverloaded.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+ExposeOverloaded.$trModule3
+ = GHC.Types.TrNameS ExposeOverloaded.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 50 0}]
+ExposeOverloaded.$trModule2 = "ExposeOverloaded"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+ExposeOverloaded.$trModule1
+ = GHC.Types.TrNameS ExposeOverloaded.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$trModule :: GHC.Types.Module
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+ExposeOverloaded.$trModule
+ = GHC.Types.Module
+ ExposeOverloaded.$trModule3 ExposeOverloaded.$trModule1
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$tcF1 [InlPrag=[~]] :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+ExposeOverloaded.$tcF1
+ = GHC.Types.KindRepFun GHC.Types.krep$*Arr* GHC.Types.krep$*Arr*
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$krep_rWr :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep_rWr = GHC.Types.KindRepVar 1#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+$krep1_rWs :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep1_rWs = GHC.Types.KindRepVar 0#
+
+-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
+$krep2_rWt :: [GHC.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep2_rWt
+ = GHC.Types.:
+ @GHC.Types.KindRep $krep1_rWs (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep3_rWu :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep3_rWu
+ = GHC.Types.KindRepTyConApp GHC.Base.$tcFunctor $krep2_rWt
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep4_rWv :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep4_rWv = GHC.Types.KindRepApp $krep1_rWs $krep_rWr
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep5_rWw :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep5_rWw = GHC.Types.KindRepFun $krep3_rWu $krep4_rWv
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$tcF3 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 20 0}]
+ExposeOverloaded.$tcF3 = "F"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$tcF2 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+ExposeOverloaded.$tcF2 = GHC.Types.TrNameS ExposeOverloaded.$tcF3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$tcF :: GHC.Types.TyCon
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+ExposeOverloaded.$tcF
+ = GHC.Types.TyCon
+ 12501119209406789822#Word64
+ 801305613953237324#Word64
+ ExposeOverloaded.$trModule
+ ExposeOverloaded.$tcF2
+ 0#
+ ExposeOverloaded.$tcF1
+
+-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
+$krep6_rWx :: [GHC.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep6_rWx
+ = GHC.Types.:
+ @GHC.Types.KindRep $krep_rWr (GHC.Types.[] @GHC.Types.KindRep)
+
+-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
+$krep7_rWy :: [GHC.Types.KindRep]
+[GblId, Unf=OtherCon []]
+$krep7_rWy = GHC.Types.: @GHC.Types.KindRep $krep1_rWs $krep6_rWx
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+$krep8_rWz :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+$krep8_rWz
+ = GHC.Types.KindRepTyConApp ExposeOverloaded.$tcF $krep7_rWy
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$tc'F1 [InlPrag=[~]] :: GHC.Types.KindRep
+[GblId, Unf=OtherCon []]
+ExposeOverloaded.$tc'F1
+ = GHC.Types.KindRepFun $krep5_rWw $krep8_rWz
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$tc'F3 :: GHC.Prim.Addr#
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 20 0}]
+ExposeOverloaded.$tc'F3 = "'F"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$tc'F2 :: GHC.Types.TrName
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+ExposeOverloaded.$tc'F2 = GHC.Types.TrNameS ExposeOverloaded.$tc'F3
+
+-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
+ExposeOverloaded.$tc'F :: GHC.Types.TyCon
+[GblId,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 10 10}]
+ExposeOverloaded.$tc'F
+ = GHC.Types.TyCon
+ 4352013886347538781#Word64
+ 11126594965226303942#Word64
+ ExposeOverloaded.$trModule
+ ExposeOverloaded.$tc'F2
+ 2#
+ ExposeOverloaded.$tc'F1
+
+
+
=====================================
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"
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -34,6 +34,13 @@ 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'])
+# Check if it works for newtypes (currently doesn't)
+test('ExposeOverloadedNewtype', [only_ways('[optasm]'), grep_errmsg('Unf=Unf')], compile, ['-ddump-simpl -dno-suppress-unfoldings -dno-typeable-binds'])
+
+
test('T3118', normal, compile, ['-Wno-overlapping-patterns'])
test('T4203', normal, compile, [''])
@@ -332,7 +339,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 +370,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'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd084b0f2d38f2b4cf89edb244739cc76361d1a9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd084b0f2d38f2b4cf89edb244739cc76361d1a9
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/20240510/4e8332a0/attachment-0001.html>
More information about the ghc-commits
mailing list