[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
Sun Nov 26 02:53:39 UTC 2023
Andreas Klebinger pushed to branch wip/andreask/expose-overloaded-unfoldings at Glasgow Haskell Compiler / GHC
Commits:
472f5a88 by Andreas Klebinger at 2023-11-26T03:41:46+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.
-------------------------
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/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
- testsuite/tests/stranal/should_compile/T23398.stderr
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
=====================================
@@ -323,6 +323,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
=====================================
@@ -2370,6 +2370,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,80 @@ 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 -> 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 withing in types like:
+ f :: Int -> forall a. Eq a => blah
+
+We can't simply use isClassPred to check if any of the constraints responds to
+a class dictionary because of programs like the one 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
=====================================
@@ -390,8 +390,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
~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -519,9 +519,42 @@ 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.
+ An flag to expose all unfoldings, even for very large
+ or recursive functions. This allows for all functions to be potentially inlined
+ or specialised. However GHC will still use the usual heuristics to make inlining
+ and specialization choices. This means further measures might be needed to
+ get the desired inlining or specialization behaver. Usual 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 which might be specialised, 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 overloaded 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.
.. ghc-flag:: -ffloat-in
:shortdesc: Turn on the float-in transformation. Implied by :ghc-flag:`-O`.
@@ -1125,7 +1158,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/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'])
@@ -509,3 +509,7 @@ test('T24029', normal, compile, [''])
test('T21348', normal, compile, ['-O'])
test('T21917', normal, compile, ['-O -fkeep-auto-rules -ddump-rules'])
+# 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'])
\ No newline at end of file
=====================================
testsuite/tests/stranal/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)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/472f5a88b655685b779bdec293e3730310a3d347
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/472f5a88b655685b779bdec293e3730310a3d347
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/20231125/477c65ce/attachment-0001.html>
More information about the ghc-commits
mailing list