[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Take more care with unlifted bindings in the specialiser
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Mar 1 00:26:37 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00
Take more care with unlifted bindings in the specialiser
As #22998 showed, we were floating an unlifted binding to top
level, which breaks a Core invariant.
The fix is easy, albeit a little bit conservative. See
Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise
- - - - -
bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00
Account for TYPE vs CONSTRAINT in mkSelCo
As #23018 showed, in mkRuntimeRepCo we need to account for coercions
between TYPE and COERCION.
See Note [mkRuntimeRepCo] in GHC.Core.Coercion.
- - - - -
83a5e53a by Ben Gamari at 2023-02-28T19:26:27-05:00
hadrian: Add dependency from lib/settings to mk/config.mk
In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253
by adding logic to the bindist Makefile to regenerate the `settings`
file from information gleaned by the bindist `configure` script.
However, this fix had no effect as `lib/settings` is shipped in the
binary distribution (to allow in-place use of the binary distribution).
As `lib/settings` already existed and its rule declared no dependencies,
`make` would fail to use the added rule to regenerate it.
Fix this by explicitly declaring a dependency from `lib/settings` on
`mk/config.mk`.
Fixes #22982.
- - - - -
b8140c68 by romes at 2023-02-28T19:26:27-05:00
fix: Consider strictness annotation in rep_bind
Fixes #23036
- - - - -
15 changed files:
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/Coercion/Opt.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/HsToCore/Quote.hs
- hadrian/bindist/Makefile
- + testsuite/tests/simplCore/should_run/T22998.hs
- + testsuite/tests/simplCore/should_run/T22998.stdout
- testsuite/tests/simplCore/should_run/all.T
- + testsuite/tests/th/T23036.hs
- + testsuite/tests/th/T23036.stderr
- testsuite/tests/th/all.T
- + testsuite/tests/typecheck/should_compile/T23018.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core.hs
=====================================
@@ -366,68 +366,32 @@ a Coercion, (sym c).
Note [Core letrec invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The right hand sides of all top-level and recursive @let at s
-/must/ be of lifted type (see "Type#type_classification" for
-the meaning of /lifted/ vs. /unlifted/).
+The Core letrec invariant:
-There is one exception to this rule, top-level @let at s are
-allowed to bind primitive string literals: see
-Note [Core top-level string literals].
+ The right hand sides of all
+ /top-level/ or /recursive/
+ bindings must be of lifted type
-Note [Core top-level string literals]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-As an exception to the usual rule that top-level binders must be lifted,
-we allow binding primitive string literals (of type Addr#) of type Addr# at the
-top level. This allows us to share string literals earlier in the pipeline and
-crucially allows other optimizations in the Core2Core pipeline to fire.
-Consider,
+ There is one exception to this rule, top-level @let at s are
+ allowed to bind primitive string literals: see
+ Note [Core top-level string literals].
- f n = let a::Addr# = "foo"#
- in \x -> blah
+See "Type#type_classification" in GHC.Core.Type
+for the meaning of "lifted" vs. "unlifted").
-In order to be able to inline `f`, we would like to float `a` to the top.
-Another option would be to inline `a`, but that would lead to duplicating string
-literals, which we want to avoid. See #8472.
-
-The solution is simply to allow top-level unlifted binders. We can't allow
-arbitrary unlifted expression at the top-level though, unlifted binders cannot
-be thunks, so we just allow string literals.
-
-We allow the top-level primitive string literals to be wrapped in Ticks
-in the same way they can be wrapped when nested in an expression.
-CoreToSTG currently discards Ticks around top-level primitive string literals.
-See #14779.
-
-Also see Note [Compilation plan for top-level string literals].
-
-Note [Compilation plan for top-level string literals]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Here is a summary on how top-level string literals are handled by various
-parts of the compilation pipeline.
-
-* In the source language, there is no way to bind a primitive string literal
- at the top level.
-
-* In Core, we have a special rule that permits top-level Addr# bindings. See
- Note [Core top-level string literals]. Core-to-core passes may introduce
- new top-level string literals.
-
-* In STG, top-level string literals are explicitly represented in the syntax
- tree.
-
-* A top-level string literal may end up exported from a module. In this case,
- in the object file, the content of the exported literal is given a label with
- the _bytes suffix.
+For the non-top-level, non-recursive case see Note [Core let-can-float invariant].
Note [Core let-can-float invariant]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The let-can-float invariant:
- The right hand side of a non-recursive 'Let'
- /may/ be of unlifted type, but only if
+ The right hand side of a /non-top-level/, /non-recursive/ binding
+ may be of unlifted type, but only if
the expression is ok-for-speculation
or the 'Let' is for a join point.
+ (For top-level or recursive lets see Note [Core letrec invariant].)
+
This means that the let can be floated around
without difficulty. For example, this is OK:
@@ -466,6 +430,53 @@ we need to allow lots of things in the arguments of a call.
TL;DR: we relaxed the let/app invariant to become the let-can-float invariant.
+Note [Core top-level string literals]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As an exception to the usual rule that top-level binders must be lifted,
+we allow binding primitive string literals (of type Addr#) of type Addr# at the
+top level. This allows us to share string literals earlier in the pipeline and
+crucially allows other optimizations in the Core2Core pipeline to fire.
+Consider,
+
+ f n = let a::Addr# = "foo"#
+ in \x -> blah
+
+In order to be able to inline `f`, we would like to float `a` to the top.
+Another option would be to inline `a`, but that would lead to duplicating string
+literals, which we want to avoid. See #8472.
+
+The solution is simply to allow top-level unlifted binders. We can't allow
+arbitrary unlifted expression at the top-level though, unlifted binders cannot
+be thunks, so we just allow string literals.
+
+We allow the top-level primitive string literals to be wrapped in Ticks
+in the same way they can be wrapped when nested in an expression.
+CoreToSTG currently discards Ticks around top-level primitive string literals.
+See #14779.
+
+Also see Note [Compilation plan for top-level string literals].
+
+Note [Compilation plan for top-level string literals]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Here is a summary on how top-level string literals are handled by various
+parts of the compilation pipeline.
+
+* In the source language, there is no way to bind a primitive string literal
+ at the top level.
+
+* In Core, we have a special rule that permits top-level Addr# bindings. See
+ Note [Core top-level string literals]. Core-to-core passes may introduce
+ new top-level string literals.
+
+ See GHC.Core.Utils.exprIsTopLevelBindable, and exprIsTickedString
+
+* In STG, top-level string literals are explicitly represented in the syntax
+ tree.
+
+* A top-level string literal may end up exported from a module. In this case,
+ in the object file, the content of the exported literal is given a label with
+ the _bytes suffix.
+
Note [NON-BOTTOM-DICTS invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It is a global invariant (not checkable by Lint) that
=====================================
compiler/GHC/Core/Coercion.hs
=====================================
@@ -612,14 +612,40 @@ eqTyConRole tc
| otherwise
= pprPanic "eqTyConRole: unknown tycon" (ppr tc)
--- | Given a coercion @co1 :: (a :: TYPE r1) ~ (b :: TYPE r2)@,
--- (or CONSTRAINT instead of TYPE)
--- produce a coercion @rep_co :: r1 ~ r2 at .
+-- | Given a coercion `co :: (t1 :: TYPE r1) ~ (t2 :: TYPE r2)`
+-- produce a coercion `rep_co :: r1 ~ r2`
+-- But actually it is possible that
+-- co :: (t1 :: CONSTRAINT r1) ~ (t2 :: CONSTRAINT r2)
+-- or co :: (t1 :: TYPE r1) ~ (t2 :: CONSTRAINT r2)
+-- or co :: (t1 :: CONSTRAINT r1) ~ (t2 :: TYPE r2)
+-- See Note [mkRuntimeRepCo]
mkRuntimeRepCo :: HasDebugCallStack => Coercion -> Coercion
mkRuntimeRepCo co
- = mkSelCo (SelTyCon 0 Nominal) kind_co
+ = assert (isTYPEorCONSTRAINT k1 && isTYPEorCONSTRAINT k2) $
+ mkSelCo (SelTyCon 0 Nominal) kind_co
where
kind_co = mkKindCo co -- kind_co :: TYPE r1 ~ TYPE r2
+ Pair k1 k2 = coercionKind kind_co
+
+{- Note [mkRuntimeRepCo]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Given
+ class C a where { op :: Maybe a }
+we will get an axiom
+ axC a :: (C a :: CONSTRAINT r1) ~ (Maybe a :: TYPE r2)
+(See Note [Type and Constraint are not apart] in GHC.Builtin.Types.Prim.)
+
+Then we may call mkRuntimeRepCo on (axC ty), and that will return
+ mkSelCo (SelTyCon 0 Nominal) (Kind (axC ty)) :: r1 ~ r2
+
+So mkSelCo needs to be happy with decomposing a coercion of kind
+ CONSTRAINT r1 ~ TYPE r2
+
+Hence the use of `tyConIsTYPEorCONSTRAINT` in the assertion `good_call`
+in `mkSelCo`. See #23018 for a concrete example. (In this context it's
+important that TYPE and CONSTRAINT have the same arity and kind, not
+merely that they are not-apart; otherwise SelCo would not make sense.)
+-}
isReflCoVar_maybe :: Var -> Maybe Coercion
-- If cv :: t~t then isReflCoVar_maybe cv = Just (Refl t)
@@ -1173,7 +1199,8 @@ mkSelCo_maybe cs co
, Just (tc2, tys2) <- splitTyConApp_maybe ty2
, let { len1 = length tys1
; len2 = length tys2 }
- = tc1 == tc2
+ = (tc1 == tc2 || (tyConIsTYPEorCONSTRAINT tc1 && tyConIsTYPEorCONSTRAINT tc2))
+ -- tyConIsTYPEorCONSTRAINT: see Note [mkRuntimeRepCo]
&& len1 == len2
&& n < len1
&& r == tyConRole (coercionRole co) tc1 n
=====================================
compiler/GHC/Core/Coercion/Opt.hs
=====================================
@@ -44,6 +44,13 @@ import Control.Monad ( zipWithM )
%* *
%************************************************************************
+This module does coercion optimisation. See the paper
+
+ Evidence normalization in Systtem FV (RTA'13)
+ https://simon.peytonjones.org/evidence-normalization/
+
+The paper is also in the GHC repo, in docs/opt-coercion.
+
Note [Optimising coercion optimisation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Looking up a coercion's role or kind is linear in the size of the
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -27,7 +27,7 @@ import GHC.Core
import GHC.Core.Make ( mkLitRubbish )
import GHC.Core.Unify ( tcMatchTy )
import GHC.Core.Rules
-import GHC.Core.Utils ( exprIsTrivial
+import GHC.Core.Utils ( exprIsTrivial, exprIsTopLevelBindable
, mkCast, exprType
, stripTicksTop, mkInScopeSetBndrs )
import GHC.Core.FVs
@@ -1515,7 +1515,10 @@ specBind top_lvl env (NonRec fn rhs) do_body
= [mkDB $ NonRec b r | (b,r) <- pairs]
++ fromOL dump_dbs
- ; if float_all then
+ can_float_this_one = exprIsTopLevelBindable rhs (idType fn)
+ -- exprIsTopLevelBindable: see Note [Care with unlifted bindings]
+
+ ; if float_all && can_float_this_one then
-- Rather than discard the calls mentioning the bound variables
-- we float this (dictionary) binding along with the others
return ([], body', all_free_uds `snocDictBinds` final_binds)
@@ -1876,6 +1879,28 @@ even in the case that @x = False@! Instead, we add a dummy 'Void#' argument to
the specialisation '$sfInt' ($sfInt :: Void# -> Array# Int) in order to
preserve laziness.
+Note [Care with unlifted bindings]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider (#22998)
+ f x = let x::ByteArray# = <some literal>
+ n::Natural = NB x
+ in wombat @192827 (n |> co)
+where
+ co :: Natural ~ KnownNat 192827
+ wombat :: forall (n:Nat). KnownNat n => blah
+
+Left to itself, the specialiser would float the bindings for `x` and `n` to top
+level, so we can specialise `wombat`. But we can't have a top-level ByteArray#
+(see Note [Core letrec invariant] in GHC.Core). Boo.
+
+This is pretty exotic, so we take a simple way out: in specBind (the NonRec
+case) do not float the binding itself unless it satisfies exprIsTopLevelBindable.
+This is conservative: maybe the RHS of `x` has a free var that would stop it
+floating to top level anyway; but that is hard to spot (since we don't know what
+the non-top-level in-scope binders are) and rare (since the binding must satisfy
+Note [Core let-can-float invariant] in GHC.Core).
+
+
Note [Specialising Calls]
~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have a function with a complicated type:
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -124,7 +124,7 @@ module GHC.Core.Type (
-- *** Levity and boxity
sORTKind_maybe, typeTypeOrConstraint,
- typeLevity_maybe,
+ typeLevity_maybe, tyConIsTYPEorCONSTRAINT,
isLiftedTypeKind, isUnliftedTypeKind, pickyIsLiftedTypeKind,
isLiftedRuntimeRep, isUnliftedRuntimeRep, runtimeRepLevity_maybe,
isBoxedRuntimeRep,
@@ -2652,13 +2652,18 @@ isPredTy ty = case typeTypeOrConstraint ty of
TypeLike -> False
ConstraintLike -> True
------------------------------------------
-- | Does this classify a type allowed to have values? Responds True to things
-- like *, TYPE Lifted, TYPE IntRep, TYPE v, Constraint.
isTYPEorCONSTRAINT :: Kind -> Bool
-- ^ True of a kind `TYPE _` or `CONSTRAINT _`
isTYPEorCONSTRAINT k = isJust (sORTKind_maybe k)
+tyConIsTYPEorCONSTRAINT :: TyCon -> Bool
+tyConIsTYPEorCONSTRAINT tc
+ = tc_uniq == tYPETyConKey || tc_uniq == cONSTRAINTTyConKey
+ where
+ !tc_uniq = tyConUnique tc
+
isConstraintLikeKind :: Kind -> Bool
-- True of (CONSTRAINT _)
isConstraintLikeKind kind
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1899,12 +1899,18 @@ rep_bind (L loc (FunBind
fun_matches = MG { mg_alts
= (L _ [L _ (Match
{ m_pats = []
- , m_grhss = GRHSs _ guards wheres }
- )]) } }))
+ , m_grhss = GRHSs _ guards wheres
+ -- For a variable declaration I'm pretty
+ -- sure we always have a FunRhs
+ , m_ctxt = FunRhs { mc_strictness = strictessAnn }
+ } )]) } }))
= do { (ss,wherecore) <- repBinds wheres
; guardcore <- addBinds ss (repGuards guards)
; fn' <- lookupNBinder fn
- ; p <- repPvar fn'
+ ; p <- repPvar fn' >>= case strictessAnn of
+ SrcLazy -> repPtilde
+ SrcStrict -> repPbang
+ NoSrcStrict -> pure
; ans <- repVal p guardcore wherecore
; ans' <- wrapGenSyms ss ans
; return (locA loc, ans') }
=====================================
hadrian/bindist/Makefile
=====================================
@@ -77,7 +77,7 @@ endif
WrapperBinsDir=${bindir}
# N.B. this is duplicated from includes/ghc.mk.
-lib/settings :
+lib/settings : config.mk
$(call removeFiles,$@)
@echo '[("GCC extra via C opts", "$(GccExtraViaCOpts)")' >> $@
@echo ',("C compiler command", "$(SettingsCCompilerCommand)")' >> $@
=====================================
testsuite/tests/simplCore/should_run/T22998.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE DataKinds #-}
+module Main where
+
+import Data.Proxy (Proxy(Proxy))
+import GHC.TypeLits (natVal)
+
+main :: IO ()
+main = print x
+ where
+ x = natVal @18446744073709551616 Proxy + natVal @18446744073709551616 Proxy
=====================================
testsuite/tests/simplCore/should_run/T22998.stdout
=====================================
@@ -0,0 +1 @@
+36893488147419103232
=====================================
testsuite/tests/simplCore/should_run/all.T
=====================================
@@ -108,3 +108,5 @@ test('T21575', normal, compile_and_run, ['-O'])
test('T21575b', [], multimod_compile_and_run, ['T21575b', '-O'])
test('T20836', normal, compile_and_run, ['-O0']) # Should not time out; See #20836
test('T22448', normal, compile_and_run, ['-O1'])
+test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint'])
+
=====================================
testsuite/tests/th/T23036.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T23036 where
+
+import Language.Haskell.TH
+
+a, b, c :: ()
+a = $([|let x = undefined in ()|])
+b = $([|let !x = undefined in ()|])
+c = $([|let ~x = undefined in ()|])
+
+-- Test strictness annotations are also correctly handled in function and pattern binders
+d, e, f:: ()
+d = $([|let !(x,y) = undefined in ()|])
+e = $([|let (!x,y,~z) = undefined in ()|])
+f = $([|let f !x ~y z = undefined in ()|])
+
=====================================
testsuite/tests/th/T23036.stderr
=====================================
@@ -0,0 +1,18 @@
+T23036.hs:7:6-34: Splicing expression
+ [| let x = undefined in () |] ======> let x = undefined in ()
+T23036.hs:8:6-35: Splicing expression
+ [| let !x = undefined in () |] ======> let !x = undefined in ()
+T23036.hs:9:6-35: Splicing expression
+ [| let ~x = undefined in () |] ======> let ~x = undefined in ()
+T23036.hs:13:6-39: Splicing expression
+ [| let !(x, y) = undefined in () |]
+ ======>
+ let !(x, y) = undefined in ()
+T23036.hs:14:6-42: Splicing expression
+ [| let (!x, y, ~z) = undefined in () |]
+ ======>
+ let (!x, y, ~z) = undefined in ()
+T23036.hs:15:6-42: Splicing expression
+ [| let f !x ~y z = undefined in () |]
+ ======>
+ let f !x ~y z = undefined in ()
=====================================
testsuite/tests/th/all.T
=====================================
@@ -559,3 +559,4 @@ test('T22784', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T22818', normal, compile, ['-v0'])
test('T22819', normal, compile, ['-v0'])
test('TH_fun_par', normal, compile, [''])
+test('T23036', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
=====================================
testsuite/tests/typecheck/should_compile/T23018.hs
=====================================
@@ -0,0 +1,9 @@
+module T23018 where
+
+import qualified Control.DeepSeq as DeepSeq
+
+class XX f where
+ rnf :: DeepSeq.NFData a => f a -> ()
+
+instance XX Maybe where
+ rnf = DeepSeq.rnf
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -863,3 +863,4 @@ test('T22912', normal, compile, [''])
test('T22924', normal, compile, [''])
test('T22985a', normal, compile, ['-O'])
test('T22985b', normal, compile, [''])
+test('T23018', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe3b7cfa51a74e99166b900f5ce56a36a3c42ffc...b8140c68fb2cbe994f9723e9adc9658b216fcb74
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe3b7cfa51a74e99166b900f5ce56a36a3c42ffc...b8140c68fb2cbe994f9723e9adc9658b216fcb74
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/20230228/c9c99c5e/attachment-0001.html>
More information about the ghc-commits
mailing list