[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
Mon Feb 19 15:48:05 UTC 2024
Andreas Klebinger pushed to branch wip/andreask/expose-overloaded-unfoldings at Glasgow Haskell Compiler / GHC
Commits:
d904d407 by Andreas Klebinger at 2024-02-19T16:34:45+01: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
-------------------------
- - - - -
12 changed files:
- compiler/GHC/Driver/Config/Tidy.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Tidy.hs
- + compiler/ghc-llvm-version.h
- 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
=====================================
@@ -322,6 +322,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
@@ -573,6 +574,7 @@ codeGenFlags = EnumSet.fromList
-- Flags that affect generated code
, Opt_ExposeAllUnfoldings
+ , Opt_ExposeOverloadedUnfoldings
, Opt_NoTypeableBinds
, Opt_Haddock
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2387,6 +2387,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,8 @@ 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 +369,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.
| ExposeAll -- ^ Expose all unfoldings
deriving (Show,Eq,Ord)
@@ -790,6 +794,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
@@ -797,30 +805,81 @@ 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 || explicity_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 -> True
+ -- Requested by the user through a flag.
+ explicity_requested =
+ case opt_expose_unfoldings opts of
+ 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.
+ ExposeAll -> True
+ 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
+
+ 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.
+-}
+
{-
************************************************************************
* *
=====================================
compiler/ghc-llvm-version.h
=====================================
@@ -0,0 +1,11 @@
+/* compiler/ghc-llvm-version.h. Generated from ghc-llvm-version.h.in by configure. */
+#if !defined(__GHC_LLVM_VERSION_H__)
+#define __GHC_LLVM_VERSION_H__
+
+/* The maximum supported LLVM version number */
+#define sUPPORTED_LLVM_VERSION_MAX (16)
+
+/* The minimum supported LLVM version number */
+#define sUPPORTED_LLVM_VERSION_MIN (13)
+
+#endif /* __GHC_LLVM_VERSION_H__ */
=====================================
docs/users_guide/hints.rst
=====================================
@@ -382,6 +382,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
~~~~~~~~~~~~~~~~~~
@@ -390,8 +392,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
~~~~~~~~~~~~~~~~~~
@@ -430,6 +433,98 @@ 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 blance 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.
+As 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 function 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.
+While the later only makes functions which are overloaded available. 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 generat 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 the specialization was requested through a pragma GHC **will** try to create a specialization.
+* If any of the type class instances have type arguments and :ghc-flag:`-fpolymorphic-specialisation`
+ is not enabled the function **won't** be specialised. The flag is off by default.
+* If the function is imported:
+ + If the unfolding is not available the function **can't** be specialized.
+ + If :ghc-flag:`-fcross-module-specialise` is not enabled the function **won't** be specialised.
+ But the flag is enabled by default with `-O`.
+ + If the flag is enabled, and the function has no INLINABLE/INLINE pragma it **won't** be specialised.
+* If :ghc-flag:`-fspecialise-aggressively` is enabled GHC **will** try to create a specialization.
+* If only some of the type class instances used at the call site it **won't** be specialised.
+* 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 functions have 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`.
@@ -1125,7 +1161,8 @@ as such you shouldn't need to set any of them explicitly. A flag
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.
+ or :ghc-flag:`-fexpose-overloaded-unfoldings` if you want to ensure all calls
+ are specialised.
.. ghc-flag:: -fcross-module-specialise
=====================================
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
=====================================
@@ -332,7 +332,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'])
@@ -364,7 +364,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'])
@@ -514,3 +514,8 @@ test('T23209', [extra_files(['T23209_Aux.hs'])], multimod_compile, ['T23209', '-
test('T24229a', [ grep_errmsg(r'wfoo') ], compile, ['-O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques -dppr-cols=99999'])
test('T24229b', [ grep_errmsg(r'wfoo') ], compile, ['-O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques -dppr-cols=99999'])
test('T24370', normal, compile, ['-O'])
+
+# 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'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d904d4079edfbd4e125ca5ab9fe122a9c54654eb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d904d4079edfbd4e125ca5ab9fe122a9c54654eb
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/20240219/8e5200cf/attachment-0001.html>
More information about the ghc-commits
mailing list